Kernel-Infrastructure.st 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119
  1. Smalltalk createPackage: 'Kernel-Infrastructure'!
  2. Object subclass: #AmberBootstrapInitialization
  3. instanceVariableNames: ''
  4. package: 'Kernel-Infrastructure'!
  5. !AmberBootstrapInitialization class methodsFor: 'initialization'!
  6. initializeClasses
  7. Smalltalk classes do: [ :each |
  8. each = SmalltalkImage ifFalse: [ each initialize ] ]
  9. ! !
  10. !AmberBootstrapInitialization class methodsFor: 'organization'!
  11. organizeClasses
  12. Smalltalk classes do: [ :each | each enterOrganization ]
  13. !
  14. organizeMethods
  15. Smalltalk classes do: [ :eachClass |
  16. eachClass definedMethods do: [ :eachMethod |
  17. eachMethod methodClass methodOrganizationEnter: eachMethod andLeave: nil ] ]
  18. ! !
  19. !AmberBootstrapInitialization class methodsFor: 'public api'!
  20. run
  21. SmalltalkImage initialize.
  22. Smalltalk adoptPackageDictionary.
  23. self
  24. organizeClasses;
  25. organizeMethods;
  26. initializeClasses
  27. ! !
  28. ProtoObject subclass: #JSObjectProxy
  29. instanceVariableNames: 'jsObject'
  30. package: 'Kernel-Infrastructure'!
  31. !JSObjectProxy commentStamp!
  32. I handle sending messages to JavaScript objects, making JavaScript object accessing from Amber fully transparent.
  33. My instances make intensive use of `#doesNotUnderstand:`.
  34. My instances are automatically created by Amber whenever a message is sent to a JavaScript object.
  35. ## Usage examples
  36. JSObjectProxy objects are instanciated by Amber when a Smalltalk message is sent to a JavaScript object.
  37. window alert: 'hello world'.
  38. window inspect.
  39. (window jQuery: 'body') append: 'hello world'
  40. Amber messages sends are converted to JavaScript function calls or object property access _(in this order)_. If n one of them match, a `MessageNotUnderstood` error will be thrown.
  41. ## Message conversion rules
  42. - `someUser name` becomes `someUser.name`
  43. - `someUser name: 'John'` becomes `someUser name = "John"`
  44. - `console log: 'hello world'` becomes `console.log('hello world')`
  45. - `(window jQuery: 'foo') css: 'background' color: 'red'` becomes `window.jQuery('foo').css('background', 'red')`
  46. __Note:__ For keyword-based messages, only the first keyword is kept: `window foo: 1 bar: 2` is equivalent to `window foo: 1 baz: 2`.!
  47. !JSObjectProxy methodsFor: 'accessing'!
  48. at: aString
  49. <inlineJS: 'return $self[''@jsObject''][aString]'>
  50. !
  51. at: aString ifAbsent: aBlock
  52. "return the aString property or evaluate aBlock if the property is not defined on the object"
  53. <inlineJS: '
  54. var obj = $self[''@jsObject''];
  55. return aString in obj ? obj[aString] : aBlock._value();
  56. '>
  57. !
  58. at: aString ifPresent: aBlock
  59. "return the evaluation of aBlock with the value if the property is defined or return nil"
  60. <inlineJS: '
  61. var obj = $self[''@jsObject''];
  62. return aString in obj ? aBlock._value_(obj[aString]) : nil;
  63. '>
  64. !
  65. at: aString ifPresent: aBlock ifAbsent: anotherBlock
  66. "return the evaluation of aBlock with the value if the property is defined
  67. or return value of anotherBlock"
  68. <inlineJS: '
  69. var obj = $self[''@jsObject''];
  70. return aString in obj ? aBlock._value_(obj[aString]) : anotherBlock._value();
  71. '>
  72. !
  73. at: aString put: anObject
  74. <inlineJS: 'return $self[''@jsObject''][aString] = anObject'>
  75. !
  76. in: aValuable
  77. ^ aValuable value: jsObject
  78. !
  79. jsObject
  80. ^ jsObject
  81. ! !
  82. !JSObjectProxy methodsFor: 'comparing'!
  83. = anObject
  84. anObject class == self class ifFalse: [ ^ false ].
  85. ^ JSObjectProxy compareJSObjectOfProxy: self withProxy: anObject
  86. ! !
  87. !JSObjectProxy methodsFor: 'converting'!
  88. asJavaScriptObject
  89. "Answers the receiver in a stringify-friendly fashion"
  90. ^ jsObject
  91. ! !
  92. !JSObjectProxy methodsFor: 'enumerating'!
  93. keysAndValuesDo: aBlock
  94. <inlineJS: '
  95. var o = $self[''@jsObject''];
  96. for(var i in o) {
  97. aBlock._value_value_(i, o[i]);
  98. }
  99. '>
  100. ! !
  101. !JSObjectProxy methodsFor: 'printing'!
  102. printOn: aStream
  103. aStream nextPutAll: self printString
  104. !
  105. printString
  106. <inlineJS: '
  107. var js = $self[''@jsObject''];
  108. return js.toString
  109. ? js.toString()
  110. : Object.prototype.toString.call(js)
  111. '>
  112. ! !
  113. !JSObjectProxy methodsFor: 'promises'!
  114. catch: aBlock
  115. (NativeFunction isNativeFunction: (self at: #then))
  116. ifTrue: [ ^ (TThenable >> #catch:) sendTo: jsObject arguments: {aBlock} ]
  117. ifFalse: [ ^ super catch: aBlock ]
  118. !
  119. on: aClass do: aBlock
  120. (NativeFunction isNativeFunction: (self at: #then))
  121. ifTrue: [ ^ (TThenable >> #on:do:) sendTo: jsObject arguments: {aClass. aBlock} ]
  122. ifFalse: [ ^ super on: aClass do: aBlock ]
  123. !
  124. then: aBlockOrArray
  125. (NativeFunction isNativeFunction: (self at: #then))
  126. ifTrue: [ ^ (TThenable >> #then:) sendTo: jsObject arguments: {aBlockOrArray} ]
  127. ifFalse: [ ^ super then: aBlockOrArray ]
  128. ! !
  129. !JSObjectProxy methodsFor: 'proxy'!
  130. doesNotUnderstand: aMessage
  131. ^ (JSObjectProxy lookupProperty: aMessage selector asJavaScriptPropertyName ofProxy: self)
  132. ifNil: [ super doesNotUnderstand: aMessage ]
  133. ifNotNil: [ :jsSelector |
  134. JSObjectProxy
  135. forwardMessage: jsSelector
  136. withArguments: aMessage arguments
  137. ofProxy: self ]
  138. ! !
  139. !JSObjectProxy methodsFor: 'streaming'!
  140. putOn: aStream
  141. aStream nextPutJSObject: jsObject
  142. ! !
  143. !JSObjectProxy class methodsFor: 'instance creation'!
  144. on: aJSObject
  145. | instance |
  146. instance := self new.
  147. self jsObject: aJSObject ofProxy: instance.
  148. ^ instance
  149. ! !
  150. !JSObjectProxy class methodsFor: 'proxy'!
  151. addObjectVariablesTo: aDictionary ofProxy: aProxy
  152. <inlineJS: '
  153. var jsObject = aProxy[''@jsObject''];
  154. for(var i in jsObject) {
  155. aDictionary._at_put_(i, jsObject[i]);
  156. }
  157. '>
  158. !
  159. compareJSObjectOfProxy: aProxy withProxy: anotherProxy
  160. <inlineJS: '
  161. var anotherJSObject = anotherProxy.a$cls ? anotherProxy["@jsObject"] : anotherProxy;
  162. return aProxy["@jsObject"] === anotherJSObject
  163. '>
  164. !
  165. forwardMessage: aString withArguments: anArray ofProxy: aProxy
  166. <inlineJS: '
  167. return $core.accessJavaScript(aProxy._jsObject(), aString, anArray);
  168. '>
  169. !
  170. jsObject: aJSObject ofProxy: aProxy
  171. <inlineJS: 'aProxy[''@jsObject''] = aJSObject'>
  172. !
  173. lookupProperty: aString ofProxy: aProxy
  174. "Looks up a property in JS object.
  175. Answer the property if it is present, or nil if it is not present."
  176. <inlineJS: 'return aString in aProxy._jsObject() ? aString : nil'>
  177. ! !
  178. Object subclass: #Organizer
  179. instanceVariableNames: 'elements'
  180. package: 'Kernel-Infrastructure'!
  181. !Organizer commentStamp!
  182. I represent categorization information.
  183. ## API
  184. Use `#addElement:` and `#removeElement:` to manipulate instances.!
  185. !Organizer methodsFor: 'accessing'!
  186. addElement: anObject
  187. self elements add: anObject
  188. !
  189. elements
  190. ^ elements
  191. !
  192. removeElement: anObject
  193. self elements remove: anObject ifAbsent: []
  194. ! !
  195. !Organizer methodsFor: 'initialization'!
  196. initialize
  197. super initialize.
  198. elements := Set new
  199. ! !
  200. Organizer subclass: #ClassOrganizer
  201. instanceVariableNames: 'traitOrBehavior'
  202. package: 'Kernel-Infrastructure'!
  203. !ClassOrganizer commentStamp!
  204. I am an organizer specific to classes. I hold method categorization information for classes.!
  205. !ClassOrganizer methodsFor: 'accessing'!
  206. addElement: aString
  207. super addElement: aString.
  208. SystemAnnouncer current announce: (ProtocolAdded new
  209. protocol: aString;
  210. theClass: self theClass;
  211. yourself)
  212. !
  213. removeElement: aString
  214. super removeElement: aString.
  215. SystemAnnouncer current announce: (ProtocolRemoved new
  216. protocol: aString;
  217. theClass: self theClass;
  218. yourself)
  219. !
  220. theClass
  221. ^ traitOrBehavior
  222. !
  223. theClass: aClass
  224. traitOrBehavior := aClass
  225. ! !
  226. !ClassOrganizer class methodsFor: 'instance creation'!
  227. on: aClass
  228. ^ self new
  229. theClass: aClass;
  230. yourself
  231. ! !
  232. Organizer subclass: #PackageOrganizer
  233. instanceVariableNames: ''
  234. package: 'Kernel-Infrastructure'!
  235. !PackageOrganizer commentStamp!
  236. I am an organizer specific to packages. I hold classes categorization information.!
  237. Object subclass: #Package
  238. instanceVariableNames: 'evalBlock basicTransport name transport imports dirty organization'
  239. package: 'Kernel-Infrastructure'!
  240. !Package commentStamp!
  241. I am similar to a "class category" typically found in other Smalltalks like Pharo or Squeak. Amber does not have class categories anymore, it had in the beginning but now each class in the system knows which package it belongs to.
  242. Each package has a name and can be queried for its classes, but it will then resort to a reverse scan of all classes to find them.
  243. ## API
  244. Packages are manipulated through "Smalltalk current", like for example finding one based on a name or with `Package class >> #name` directly:
  245. Smalltalk current packageAt: 'Kernel'
  246. Package named: 'Kernel'
  247. A package differs slightly from a Monticello package which can span multiple class categories using a naming convention based on hyphenation. But just as in Monticello a package supports "class extensions" so a package can define behaviors in foreign classes using a naming convention for method categories where the category starts with an asterisk and then the name of the owning package follows.
  248. You can fetch a package from the server:
  249. Package load: 'Additional-Examples'!
  250. !Package methodsFor: 'accessing'!
  251. beClean
  252. dirty := false.
  253. SystemAnnouncer current announce: (PackageClean new
  254. package: self;
  255. yourself)
  256. !
  257. beDirty
  258. dirty := true.
  259. SystemAnnouncer current announce: (PackageDirty new
  260. package: self;
  261. yourself)
  262. !
  263. classTemplate
  264. ^ String streamContents: [ :stream | stream
  265. write: 'Object subclass: #NameOfSubclass'; lf;
  266. tab; write: 'instanceVariableNames: '''''; lf;
  267. tab; write: 'package: '; print: self name ]
  268. !
  269. definition
  270. ^ String streamContents: [ :stream | stream
  271. write: self class name; lf;
  272. tab; write: 'named: '; print: self name; lf;
  273. tab; write: { 'imports: '. self importsDefinition }; lf;
  274. tab; write: { 'transport: ('. self transport definition. ')' } ]
  275. !
  276. evalBlock
  277. ^ evalBlock
  278. !
  279. evalBlock: aBlock
  280. evalBlock := aBlock
  281. !
  282. imports
  283. ^ imports ifNil: [
  284. self imports: #().
  285. imports ]
  286. !
  287. imports: anArray
  288. self validateImports: anArray.
  289. imports := anArray asSet
  290. !
  291. importsDefinition
  292. ^ String streamContents: [ :stream |
  293. stream write: '{'.
  294. self sortedImportsAsArray
  295. do: [ :each | stream print: each ]
  296. separatedBy: [ stream write: '. ' ].
  297. stream write: '}' ]
  298. !
  299. javaScriptDescriptor: anObject
  300. | basicEval basicImports |
  301. basicEval := (anObject at: 'innerEval' ifAbsent: [ nil asJavaScriptObject ]).
  302. basicImports := (anObject at: 'imports' ifAbsent: [ #() ]).
  303. basicTransport := (anObject at: 'transport' ifAbsent: []).
  304. self
  305. evalBlock: basicEval;
  306. imports: (self importsFromJson: basicImports)
  307. !
  308. name
  309. ^ name
  310. !
  311. name: aString
  312. name := aString
  313. !
  314. organization
  315. ^ organization
  316. !
  317. transport
  318. ^ transport ifNil: [
  319. self transport: (PackageTransport fromJson: self basicTransport).
  320. transport ]
  321. !
  322. transport: aPackageTransport
  323. transport := aPackageTransport.
  324. aPackageTransport package: self
  325. ! !
  326. !Package methodsFor: 'classes'!
  327. classes
  328. ^ self organization elements copy
  329. !
  330. setupClasses
  331. self classes do: [ :each | each initialize ]
  332. !
  333. sortedClasses
  334. "Answer all classes in the receiver, sorted by superclass/subclasses and by class name for common subclasses (Issue #143)."
  335. ^ self class sortedClasses: self classes
  336. ! !
  337. !Package methodsFor: 'converting'!
  338. importsAsJson
  339. ^ self sortedImportsAsArray collect: [ :each |
  340. each isString
  341. ifTrue: [ each ]
  342. ifFalse: [ each key, '=', each value ]]
  343. !
  344. importsFromJson: anArray
  345. "Parses array of string, eg. #('asdf' 'qwer=tyuo')
  346. into array of Strings and Associations,
  347. eg. {'asdf'. 'qwer'->'tyuo'}"
  348. ^ anArray collect: [ :each |
  349. | split |
  350. split := each tokenize: '='.
  351. split size = 1
  352. ifTrue: [ split first ]
  353. ifFalse: [ split first -> split second ]]
  354. ! !
  355. !Package methodsFor: 'dependencies'!
  356. loadDependencies
  357. "Returns list of packages that need to be loaded
  358. before loading this package."
  359. | classes packages |
  360. classes := self loadDependencyClasses.
  361. ^ (classes collect: [ :each | each package ]) asSet
  362. remove: self ifAbsent: [];
  363. yourself
  364. !
  365. loadDependencyClasses
  366. "Returns classes needed at the time of loading a package.
  367. These are all that are used to subclass
  368. and to define an extension method
  369. as well as all traits used"
  370. | starCategoryName |
  371. starCategoryName := '*', self name.
  372. ^ (self classes collect: [ :each | each superclass ]) asSet
  373. addAll: (Smalltalk classes select: [ :each |
  374. each protocols, (each theMetaClass ifNil: [ #() ] ifNotNil: [ :meta | meta protocols])
  375. includes: starCategoryName ]);
  376. addAll: (Array streamContents: [ :as | self traitCompositions valuesDo: [ :each | as write: (each collect: [ :eachTT | eachTT trait ])]]);
  377. remove: nil ifAbsent: [];
  378. yourself
  379. !
  380. traitCompositions
  381. | traitCompositions |
  382. traitCompositions := Dictionary new.
  383. self classes do: [ :each |
  384. traitCompositions at: each put: each traitComposition.
  385. each theMetaClass ifNotNil: [ :meta | traitCompositions at: meta put: meta traitComposition ] ].
  386. ^ traitCompositions reject: [ :each | each isEmpty ]
  387. ! !
  388. !Package methodsFor: 'evaluating'!
  389. eval: aString
  390. ^ evalBlock
  391. ifNotNil: [ evalBlock value: aString ]
  392. ifNil: [ Compiler eval: aString ]
  393. ! !
  394. !Package methodsFor: 'initialization'!
  395. initialize
  396. super initialize.
  397. organization := PackageOrganizer new.
  398. evalBlock := nil.
  399. dirty := nil.
  400. imports := nil.
  401. transport := nil
  402. ! !
  403. !Package methodsFor: 'printing'!
  404. printOn: aStream
  405. super printOn: aStream.
  406. aStream
  407. nextPutAll: ' (';
  408. nextPutAll: self name;
  409. nextPutAll: ')'
  410. ! !
  411. !Package methodsFor: 'private'!
  412. basicTransport
  413. "Answer the transport literal JavaScript object as setup in the JavaScript file, if any"
  414. ^ basicTransport
  415. !
  416. sortedImportsAsArray
  417. "Answer imports sorted first by type (associations first),
  418. then by value"
  419. ^ self imports asArray
  420. sorted: [ :a :b |
  421. a isString not & b isString or: [
  422. a isString = b isString and: [
  423. a value <= b value ]]]
  424. ! !
  425. !Package methodsFor: 'testing'!
  426. isDirty
  427. ^ dirty ifNil: [ false ]
  428. !
  429. isPackage
  430. ^ true
  431. ! !
  432. !Package methodsFor: 'validation'!
  433. validateImports: aCollection
  434. aCollection do: [ :import |
  435. import isString ifFalse: [
  436. (import respondsTo: #key) ifFalse: [
  437. self error: 'Imports must be Strings or Associations' ].
  438. import key isString & import value isString ifFalse: [
  439. self error: 'Key and value must be Strings' ].
  440. (import key match: '^[a-zA-Z][a-zA-Z0-9]*$') ifFalse: [
  441. self error: 'Keys must be identifiers' ]]]
  442. ! !
  443. Package class instanceVariableNames: 'defaultCommitPathJs defaultCommitPathSt'!
  444. !Package class methodsFor: 'accessing'!
  445. named: aPackageName
  446. ^ Smalltalk
  447. packageAt: aPackageName
  448. ifAbsent: [
  449. Smalltalk createPackage: aPackageName ]
  450. !
  451. named: aPackageName ifAbsent: aBlock
  452. ^ Smalltalk packageAt: aPackageName ifAbsent: aBlock
  453. !
  454. named: aPackageName imports: anArray transport: aTransport
  455. | pkg |
  456. pkg := self named: aPackageName.
  457. pkg imports: anArray.
  458. pkg transport: aTransport.
  459. ^ pkg
  460. !
  461. named: aPackageName transport: aTransport
  462. | pkg |
  463. pkg := self named: aPackageName.
  464. pkg transport: aTransport.
  465. ^ pkg
  466. ! !
  467. !Package class methodsFor: 'instance creation'!
  468. named: aString javaScriptDescriptor: anObject
  469. | pkg |
  470. pkg := Smalltalk createPackage: aString.
  471. pkg javaScriptDescriptor: anObject.
  472. ^ pkg
  473. !
  474. new: aString
  475. ^ Package new
  476. name: aString;
  477. yourself
  478. ! !
  479. !Package class methodsFor: 'sorting'!
  480. sortedClasses: classes
  481. "Answer classes, sorted by superclass/subclasses and by class name for common subclasses (Issue #143)"
  482. | children others nodes expandedClasses |
  483. children := #().
  484. others := #().
  485. classes do: [ :each |
  486. (classes includes: each superclass)
  487. ifFalse: [ children add: each ]
  488. ifTrue: [ others add: each ]].
  489. nodes := children collect: [ :each |
  490. ClassSorterNode on: each classes: others level: 0 ].
  491. nodes := nodes sorted: [ :a :b | a theClass name <= b theClass name ].
  492. expandedClasses := Array new.
  493. nodes do: [ :aNode |
  494. aNode traverseClassesWith: expandedClasses ].
  495. ^ expandedClasses
  496. ! !
  497. Object subclass: #PackageStateObserver
  498. instanceVariableNames: ''
  499. package: 'Kernel-Infrastructure'!
  500. !PackageStateObserver commentStamp!
  501. My current instance listens for any changes in the system that might affect the state of a package (being dirty).!
  502. !PackageStateObserver methodsFor: 'accessing'!
  503. announcer
  504. ^ SystemAnnouncer current
  505. ! !
  506. !PackageStateObserver methodsFor: 'actions'!
  507. observeSystem
  508. self announcer
  509. on: PackageAdded
  510. send: #onPackageAdded:
  511. to: self;
  512. on: ClassAnnouncement
  513. send: #onClassModification:
  514. to: self;
  515. on: MethodAnnouncement
  516. send: #onMethodModification:
  517. to: self;
  518. on: ProtocolAnnouncement
  519. send: #onProtocolModification:
  520. to: self
  521. ! !
  522. !PackageStateObserver methodsFor: 'reactions'!
  523. onClassModification: anAnnouncement
  524. anAnnouncement theClass ifNotNil: [ :theClass | theClass package beDirty ]
  525. !
  526. onMethodModification: anAnnouncement
  527. anAnnouncement method package ifNotNil: [ :package | package beDirty ]
  528. !
  529. onPackageAdded: anAnnouncement
  530. anAnnouncement package beDirty
  531. !
  532. onProtocolModification: anAnnouncement
  533. anAnnouncement package ifNotNil: [ :package | package beDirty ]
  534. ! !
  535. PackageStateObserver class instanceVariableNames: 'current'!
  536. !PackageStateObserver class methodsFor: 'accessing'!
  537. current
  538. ^ current ifNil: [ current := self new ]
  539. ! !
  540. !PackageStateObserver class methodsFor: 'initialization'!
  541. initialize
  542. self current observeSystem
  543. ! !
  544. Error subclass: #ParseError
  545. instanceVariableNames: ''
  546. package: 'Kernel-Infrastructure'!
  547. !ParseError commentStamp!
  548. Instance of ParseError are signaled on any parsing error.
  549. See `Smalltalk >> #parse:`!
  550. Object subclass: #Setting
  551. instanceVariableNames: 'key value defaultValue'
  552. package: 'Kernel-Infrastructure'!
  553. !Setting commentStamp!
  554. I represent a setting **stored** at `Smalltalk settings`.
  555. In the current implementation, `Smalltalk settings` is an object persisted in the localStorage.
  556. ## API
  557. A `Setting` value can be read using `value` and set using `value:`.
  558. Settings are accessed with `'key' asSetting` or `'key' asSettingIfAbsent: aDefaultValue`.
  559. To read the value of a setting you can also use the convenience:
  560. `theValueSet := 'any.characteristic' settingValue`
  561. or with a default using:
  562. `theEnsuredValueSet := 'any.characteristic' settingValueIfAbsent: true`!
  563. !Setting methodsFor: 'accessing'!
  564. defaultValue
  565. ^ defaultValue
  566. !
  567. defaultValue: aStringifiableObject
  568. defaultValue := aStringifiableObject
  569. !
  570. key
  571. ^ key
  572. !
  573. key: aString
  574. key := aString
  575. !
  576. value
  577. ^ Smalltalk settings at: self key ifAbsent: [ self defaultValue ]
  578. !
  579. value: aStringifiableObject
  580. ^ Smalltalk settings at: self key put: aStringifiableObject
  581. ! !
  582. !Setting class methodsFor: 'instance creation'!
  583. at: aString ifAbsent: aDefaultValue
  584. ^ super new
  585. key: aString;
  586. defaultValue: aDefaultValue;
  587. yourself
  588. !
  589. new
  590. self shouldNotImplement
  591. ! !
  592. Object subclass: #SmalltalkImage
  593. instanceVariableNames: 'globalJsVariables packageDictionary'
  594. package: 'Kernel-Infrastructure'!
  595. !SmalltalkImage commentStamp!
  596. I represent the Smalltalk system, wrapping
  597. operations of variable `$core` declared in `support/boot.js`.
  598. ## API
  599. I have only one instance, accessed with global variable `Smalltalk`.
  600. ## Classes
  601. Classes can be accessed using the following methods:
  602. - `#classes` answers the full list of Smalltalk classes in the system
  603. - `#globals #at:` answers a specific global (usually, a class) or `nil`
  604. ## Packages
  605. Packages can be accessed using the following methods:
  606. - `#packages` answers the full list of packages
  607. - `#packageAt:` answers a specific package or `nil`
  608. ## Parsing
  609. The `#parse:` method is used to parse Amber source code.
  610. It requires the `Compiler` package and the `support/parser.js` parser file in order to work.!
  611. !SmalltalkImage methodsFor: 'accessing'!
  612. cancelOptOut: anObject
  613. "A Smalltalk object has a 'a$cls' property.
  614. If this property is shadowed for anObject by optOut:,
  615. the object is treated as plain JS object.
  616. This removes the shadow and anObject is Smalltalk object
  617. again if it was before."
  618. <inlineJS: 'delete anObject.klass; delete anObject.a$cls;'>
  619. !
  620. core
  621. <inlineJS: 'return $core'>
  622. !
  623. globals
  624. <inlineJS: 'return $globals'>
  625. !
  626. includesKey: aKey
  627. <inlineJS: 'return $core.hasOwnProperty(aKey)'>
  628. !
  629. optOut: anObject
  630. "A Smalltalk object has a 'a$cls' property.
  631. This shadows the property for anObject.
  632. The object is treated as plain JS object following this."
  633. <inlineJS: 'anObject.klass = null; anObject.a$cls = null'>
  634. !
  635. parse: aString
  636. | result |
  637. [ result := self basicParse: aString ]
  638. tryCatch: [ :ex | (self parseError: ex parsing: aString) signal ].
  639. ^ result
  640. source: aString;
  641. yourself
  642. !
  643. pseudoVariableNames
  644. ^ #('self' 'super' 'nil' 'true' 'false' 'thisContext')
  645. !
  646. readJSObject: anObject
  647. <inlineJS: 'return $core.readJSObject(anObject)'>
  648. !
  649. reservedWords
  650. ^ #(
  651. "http://www.ecma-international.org/ecma-262/6.0/#sec-keywords"
  652. break case catch class const continue debugger
  653. default delete do else export extends finally
  654. for function if import in instanceof new
  655. return super switch this throw try typeof
  656. var void while with yield
  657. "in strict mode"
  658. let static
  659. "Amber protected words: these should not be compiled as-is when in code"
  660. arguments
  661. "http://www.ecma-international.org/ecma-262/6.0/#sec-future-reserved-words"
  662. await enum
  663. "in strict mode"
  664. implements interface package private protected public
  665. )
  666. !
  667. settings
  668. ^ SmalltalkSettings
  669. !
  670. version
  671. "Answer the version string of Amber"
  672. ^ '0.21.0-pre'
  673. ! !
  674. !SmalltalkImage methodsFor: 'accessing amd'!
  675. amdRequire
  676. ^ self core at: 'amdRequire'
  677. !
  678. defaultAmdNamespace
  679. ^ 'transport.defaultAmdNamespace' settingValue
  680. !
  681. defaultAmdNamespace: aString
  682. 'transport.defaultAmdNamespace' settingValue: aString
  683. ! !
  684. !SmalltalkImage methodsFor: 'classes'!
  685. classes
  686. ^ self core traitsOrClasses copy
  687. !
  688. removeClass: aClass
  689. aClass isMetaclass ifTrue: [ self error: aClass asString, ' is a Metaclass and cannot be removed!!' ].
  690. aClass allSubclassesDo: [ :subclass | self error: aClass name, ' has a subclass: ', subclass name ].
  691. aClass traitUsers ifNotEmpty: [ self error: aClass name, ' has trait users.' ].
  692. self deleteClass: aClass.
  693. aClass setTraitComposition: #().
  694. aClass theMetaClass ifNotNil: [ :meta | meta setTraitComposition: #() ].
  695. SystemAnnouncer current
  696. announce: (ClassRemoved new
  697. theClass: aClass;
  698. yourself)
  699. ! !
  700. !SmalltalkImage methodsFor: 'error handling'!
  701. asSmalltalkException: anObject
  702. "A JavaScript exception may be thrown.
  703. We then need to convert it back to a Smalltalk object"
  704. ^ ((self isSmalltalkObject: anObject) and: [ anObject isKindOf: Error ])
  705. ifTrue: [ anObject ]
  706. ifFalse: [ JavaScriptException on: anObject ]
  707. !
  708. parseError: anException parsing: aString
  709. | pos |
  710. pos := (anException basicAt: 'location') start.
  711. ^ ParseError new messageText: 'Parse error on line ', pos line ,' column ' , pos column ,' : Unexpected character ', (anException basicAt: 'found')
  712. ! !
  713. !SmalltalkImage methodsFor: 'globals'!
  714. addGlobalJsVariable: aString
  715. self globalJsVariables add: aString
  716. !
  717. deleteGlobalJsVariable: aString
  718. self globalJsVariables remove: aString ifAbsent:[]
  719. !
  720. globalJsVariables
  721. ^ globalJsVariables ifNil: [
  722. globalJsVariables := #(window document process global) ]
  723. ! !
  724. !SmalltalkImage methodsFor: 'packages'!
  725. createPackage: packageName
  726. | package announcement |
  727. package := self basicCreatePackage: packageName.
  728. announcement := PackageAdded new
  729. package: package;
  730. yourself.
  731. SystemAnnouncer current announce: announcement.
  732. ^ package
  733. !
  734. packageAt: packageName
  735. self deprecatedAPI: 'Use #packageAt:ifAbsent: directly.'.
  736. ^ self packageAt: packageName ifAbsent: []
  737. !
  738. packageAt: packageName ifAbsent: aBlock
  739. ^ self packageDictionary at: packageName ifAbsent: aBlock
  740. !
  741. packageAt: packageName ifPresent: aBlock
  742. ^ self packageDictionary at: packageName ifPresent: aBlock
  743. !
  744. packageDictionary
  745. ^ packageDictionary ifNil: [ packageDictionary := Dictionary new ]
  746. !
  747. packages
  748. "Return all Package instances in the system."
  749. ^ self packageDictionary values copy
  750. !
  751. removePackage: packageName
  752. "Removes a package and all its classes."
  753. | pkg |
  754. pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
  755. pkg classes do: [ :each |
  756. self removeClass: each ].
  757. self packageDictionary removeKey: packageName
  758. !
  759. renamePackage: packageName to: newName
  760. "Rename a package."
  761. | pkg |
  762. pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
  763. self packageAt: newName ifPresent: [ self error: 'Already exists a package called: ', newName ].
  764. pkg name: newName; beDirty.
  765. self packageDictionary
  766. at: newName put: pkg;
  767. removeKey: packageName
  768. ! !
  769. !SmalltalkImage methodsFor: 'private'!
  770. adoptPackageDictionary
  771. self core packageDescriptors keysAndValuesDo: [ :key :value | Package named: key javaScriptDescriptor: value ]
  772. !
  773. basicCreatePackage: packageName
  774. "Create and bind a new bare package with given name and return it."
  775. ^ self packageDictionary at: packageName ifAbsentPut: [ Package new: packageName ]
  776. !
  777. basicParse: aString
  778. ^ SmalltalkParser parse: aString
  779. !
  780. deleteClass: aClass
  781. "Deletes a class by deleting its binding only. Use #removeClass instead"
  782. <inlineJS: '$core.removeClass(aClass)'>
  783. ! !
  784. !SmalltalkImage methodsFor: 'testing'!
  785. existsJsGlobal: aString
  786. ^ Platform globals
  787. at: aString
  788. ifPresent: [ true ]
  789. ifAbsent: [ false ]
  790. !
  791. isSmalltalkObject: anObject
  792. "Consider anObject a Smalltalk object if it has a 'a$cls' property.
  793. Note that this may be unaccurate"
  794. <inlineJS: 'return anObject.a$cls !!= null'>
  795. ! !
  796. SmalltalkImage class instanceVariableNames: 'current'!
  797. !SmalltalkImage class methodsFor: 'initialization'!
  798. initialize
  799. | st |
  800. st := self current.
  801. st globals at: 'Smalltalk' put: st
  802. ! !
  803. !SmalltalkImage class methodsFor: 'instance creation'!
  804. current
  805. ^ current ifNil: [ current := super new ] ifNotNil: [ self deprecatedAPI. current ]
  806. !
  807. new
  808. self shouldNotImplement
  809. ! !
  810. JSObjectProxy setTraitComposition: {TThenable} asTraitComposition!
  811. ! !
  812. !ProtoStream methodsFor: '*Kernel-Infrastructure'!
  813. nextPutJSObject: aJSObject
  814. self nextPut: aJSObject
  815. ! !
  816. !String methodsFor: '*Kernel-Infrastructure'!
  817. asJavaScriptPropertyName
  818. <inlineJS: 'return $core.st2prop(self)'>
  819. !
  820. asSetting
  821. "Answer aSetting dedicated to locally store a value using this string as key.
  822. Nil will be the default value."
  823. ^ Setting at: self ifAbsent: nil
  824. !
  825. asSettingIfAbsent: aDefaultValue
  826. "Answer aSetting dedicated to locally store a value using this string as key.
  827. Make this setting to have aDefaultValue."
  828. ^ Setting at: self ifAbsent: aDefaultValue
  829. !
  830. settingValue
  831. ^ self asSetting value
  832. !
  833. settingValue: aValue
  834. "Sets the value of the setting that will be locally stored using this string as key.
  835. Note that aValue can be any object that can be stringifyed"
  836. ^ self asSetting value: aValue
  837. !
  838. settingValueIfAbsent: aDefaultValue
  839. "Answer the value of the locally stored setting using this string as key.
  840. Use aDefaultValue in case no setting is found"
  841. ^ (self asSettingIfAbsent: aDefaultValue) value
  842. ! !