Kernel-Infrastructure.st 27 KB

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