Kernel-Infrastructure.st 27 KB

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