2
0

Kernel-Infrastructure.st 24 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033
  1. Smalltalk createPackage: 'Kernel-Infrastructure'!
  2. Object subclass: #InspectorHandler
  3. instanceVariableNames: ''
  4. package: 'Kernel-Infrastructure'!
  5. !InspectorHandler commentStamp!
  6. I am responsible for inspecting object.
  7. My class-side `inspector` inst var holds the current inspector I'm delegating object inspection to.
  8. The default inspector object is the transcript.!
  9. InspectorHandler class instanceVariableNames: 'inspector'!
  10. !InspectorHandler class methodsFor: 'accessing'!
  11. inspector
  12. ^ inspector ifNil: [ inspector := Transcript ]
  13. ! !
  14. !InspectorHandler class methodsFor: 'registration'!
  15. inspect: anObject
  16. ^ self inspector inspect: anObject
  17. !
  18. register: anInspector
  19. inspector := anInspector
  20. ! !
  21. Object subclass: #InterfacingObject
  22. instanceVariableNames: ''
  23. package: 'Kernel-Infrastructure'!
  24. !InterfacingObject commentStamp!
  25. I am superclass of all object that interface with user or environment. `Widget` and a few other classes are subclasses of me. I delegate all of the above APIs to `PlatformInterface`.
  26. ## API
  27. self alert: 'Hey, there is a problem'.
  28. self confirm: 'Affirmative?'.
  29. self prompt: 'Your name:'.
  30. self ajax: #{
  31. 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script'
  32. }.!
  33. !InterfacingObject methodsFor: 'actions'!
  34. ajax: anObject
  35. ^ PlatformInterface ajax: anObject
  36. !
  37. alert: aString
  38. ^ PlatformInterface alert: aString
  39. !
  40. confirm: aString
  41. ^ PlatformInterface confirm: aString
  42. !
  43. prompt: aString
  44. ^ PlatformInterface prompt: aString
  45. ! !
  46. InterfacingObject subclass: #Environment
  47. instanceVariableNames: ''
  48. package: 'Kernel-Infrastructure'!
  49. !Environment commentStamp!
  50. I provide an unified entry point to manipulate Amber packages, classes and methods.
  51. Typical use cases include IDEs, remote access and restricting browsing.!
  52. !Environment methodsFor: 'accessing'!
  53. allSelectors
  54. ^ Smalltalk vm allSelectors
  55. !
  56. availableClassNames
  57. ^ Smalltalk classes
  58. collect: [ :each | each name ]
  59. !
  60. availablePackageNames
  61. ^ Smalltalk packages
  62. collect: [ :each | each name ]
  63. !
  64. availableProtocolsFor: aClass
  65. | protocols |
  66. protocols := aClass protocols.
  67. aClass superclass ifNotNil: [ protocols addAll: (self availableProtocolsFor: aClass superclass) ].
  68. ^ protocols asSet asArray
  69. !
  70. classBuilder
  71. ^ ClassBuilder new
  72. !
  73. classNamed: aString
  74. ^ (Smalltalk globals at: aString asSymbol)
  75. ifNil: [ self error: 'Invalid class name' ]
  76. !
  77. classes
  78. ^ Smalltalk classes
  79. !
  80. doItReceiver
  81. ^ DoIt new
  82. !
  83. packages
  84. ^ Smalltalk packages
  85. !
  86. systemAnnouncer
  87. ^ (Smalltalk globals at: #SystemAnnouncer) current
  88. ! !
  89. !Environment methodsFor: 'actions'!
  90. commitPackage: aPackage
  91. aPackage commit
  92. !
  93. copyClass: aClass to: aClassName
  94. (Smalltalk globals at: aClassName)
  95. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  96. ClassBuilder new copyClass: aClass named: aClassName
  97. !
  98. eval: aString on: aReceiver
  99. | compiler |
  100. compiler := Compiler new.
  101. [ compiler parseExpression: aString ] on: Error do: [ :ex |
  102. ^ self alert: ex messageText ].
  103. ^ compiler evaluateExpression: aString on: aReceiver
  104. !
  105. inspect: anObject
  106. InspectorHandler inspector inspect: anObject
  107. !
  108. moveClass: aClass toPackage: aPackageName
  109. | package |
  110. package := Package named: aPackageName.
  111. package ifNil: [ self error: 'Invalid package name' ].
  112. package == aClass package ifTrue: [ ^ self ].
  113. aClass package: package
  114. !
  115. moveMethod: aMethod toClass: aClassName
  116. | destinationClass |
  117. destinationClass := self classNamed: aClassName.
  118. destinationClass == aMethod methodClass ifTrue: [ ^ self ].
  119. destinationClass
  120. compile: aMethod source
  121. protocol: aMethod protocol.
  122. aMethod methodClass
  123. removeCompiledMethod: aMethod
  124. !
  125. moveMethod: aMethod toProtocol: aProtocol
  126. aMethod protocol: aProtocol
  127. !
  128. registerErrorHandler: anErrorHandler
  129. ErrorHandler setCurrent: anErrorHandler
  130. !
  131. registerInspector: anInspector
  132. InspectorHandler register: anInspector
  133. !
  134. registerProgressHandler: aProgressHandler
  135. ProgressHandler setCurrent: aProgressHandler
  136. !
  137. removeClass: aClass
  138. Smalltalk removeClass: aClass
  139. !
  140. removeMethod: aMethod
  141. aMethod methodClass removeCompiledMethod: aMethod
  142. !
  143. removeProtocol: aString from: aClass
  144. (aClass methodsInProtocol: aString)
  145. do: [ :each | aClass removeCompiledMethod: each ]
  146. !
  147. renameClass: aClass to: aClassName
  148. (Smalltalk globals at: aClassName)
  149. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  150. ClassBuilder new renameClass: aClass to: aClassName
  151. !
  152. renameProtocol: aString to: anotherString in: aClass
  153. (aClass methodsInProtocol: aString)
  154. do: [ :each | each protocol: anotherString ]
  155. !
  156. setClassCommentOf: aClass to: aString
  157. aClass comment: aString
  158. ! !
  159. !Environment methodsFor: 'compiling'!
  160. addInstVarNamed: aString to: aClass
  161. self classBuilder
  162. addSubclassOf: aClass superclass
  163. named: aClass name
  164. instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself)
  165. package: aClass package name
  166. !
  167. compileClassComment: aString for: aClass
  168. aClass comment: aString
  169. !
  170. compileClassDefinition: aString
  171. [ self eval: aString on: DoIt new ]
  172. on: Error
  173. do: [ :error | self alert: error messageText ]
  174. !
  175. compileMethod: sourceCode for: class protocol: protocol
  176. ^ class
  177. compile: sourceCode
  178. protocol: protocol
  179. ! !
  180. !Environment methodsFor: 'error handling'!
  181. evaluate: aBlock on: anErrorClass do: exceptionBlock
  182. "Evaluate a block and catch exceptions happening on the environment stack"
  183. self try: aBlock catch: [ :exception |
  184. (exception isKindOf: (self classNamed: anErrorClass name))
  185. ifTrue: [ exceptionBlock value: exception ]
  186. ifFalse: [ exception signal ] ]
  187. ! !
  188. ProtoObject subclass: #JSObjectProxy
  189. instanceVariableNames: 'jsObject'
  190. package: 'Kernel-Infrastructure'!
  191. !JSObjectProxy commentStamp!
  192. I handle sending messages to JavaScript objects, making JavaScript object accessing from Amber fully transparent.
  193. My instances make intensive use of `#doesNotUnderstand:`.
  194. My instances are automatically created by Amber whenever a message is sent to a JavaScript object.
  195. ## Usage examples
  196. JSObjectProxy objects are instanciated by Amber when a Smalltalk message is sent to a JavaScript object.
  197. window alert: 'hello world'.
  198. window inspect.
  199. (window jQuery: 'body') append: 'hello world'
  200. 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.
  201. ## Message conversion rules
  202. - `someUser name` becomes `someUser.name`
  203. - `someUser name: 'John'` becomes `someUser name = "John"`
  204. - `console log: 'hello world'` becomes `console.log('hello world')`
  205. - `(window jQuery: 'foo') css: 'background' color: 'red'` becomes `window.jQuery('foo').css('background', 'red')`
  206. __Note:__ For keyword-based messages, only the first keyword is kept: `window foo: 1 bar: 2` is equivalent to `window foo: 1 baz: 2`.!
  207. !JSObjectProxy methodsFor: 'accessing'!
  208. at: aString
  209. <return self['@jsObject'][aString]>
  210. !
  211. at: aString ifAbsent: aBlock
  212. "return the aString property or evaluate aBlock if the property is not defined on the object"
  213. <
  214. var obj = self['@jsObject'];
  215. return aString in obj ? obj[aString] : aBlock._value();
  216. >
  217. !
  218. at: aString ifPresent: aBlock
  219. "return the evaluation of aBlock with the value if the property is defined or return nil"
  220. <
  221. var obj = self['@jsObject'];
  222. return aString in obj ? aBlock._value_(obj[aString]) : nil;
  223. >
  224. !
  225. at: aString ifPresent: aBlock ifAbsent: anotherBlock
  226. "return the evaluation of aBlock with the value if the property is defined
  227. or return value of anotherBlock"
  228. <
  229. var obj = self['@jsObject'];
  230. return aString in obj ? aBlock._value_(obj[aString]) : anotherBlock._value();
  231. >
  232. !
  233. at: aString put: anObject
  234. <return self['@jsObject'][aString] = anObject>
  235. !
  236. jsObject
  237. ^ jsObject
  238. !
  239. jsObject: aJSObject
  240. jsObject := aJSObject
  241. !
  242. lookupProperty: aString
  243. "Looks up a property in JS object.
  244. Answer the property if it is present, or nil if it is not present."
  245. <return aString in self._jsObject() ? aString : nil>
  246. ! !
  247. !JSObjectProxy methodsFor: 'enumerating'!
  248. asJSON
  249. "Answers the receiver in a stringyfy-friendly fashion"
  250. ^ jsObject
  251. !
  252. keysAndValuesDo: aBlock
  253. <
  254. var o = self['@jsObject'];
  255. for(var i in o) {
  256. aBlock._value_value_(i, o[i]);
  257. }
  258. >
  259. ! !
  260. !JSObjectProxy methodsFor: 'printing'!
  261. printOn: aStream
  262. aStream nextPutAll: self printString
  263. !
  264. printString
  265. <
  266. var js = self['@jsObject'];
  267. return js.toString
  268. ? js.toString()
  269. : Object.prototype.toString.call(js)
  270. >
  271. ! !
  272. !JSObjectProxy methodsFor: 'proxy'!
  273. addObjectVariablesTo: aDictionary
  274. <
  275. for(var i in self['@jsObject']) {
  276. aDictionary._at_put_(i, self['@jsObject'][i]);
  277. }
  278. >
  279. !
  280. doesNotUnderstand: aMessage
  281. ^ (self lookupProperty: aMessage selector asJavaScriptSelector)
  282. ifNil: [ super doesNotUnderstand: aMessage ]
  283. ifNotNil: [ :jsSelector |
  284. self
  285. forwardMessage: jsSelector
  286. withArguments: aMessage arguments ]
  287. !
  288. forwardMessage: aString withArguments: anArray
  289. <
  290. return smalltalk.send(self._jsObject(), aString, anArray);
  291. >
  292. !
  293. inspectOn: anInspector
  294. | variables |
  295. variables := Dictionary new.
  296. variables at: '#self' put: self jsObject.
  297. anInspector setLabel: self printString.
  298. self addObjectVariablesTo: variables.
  299. anInspector setVariables: variables
  300. ! !
  301. !JSObjectProxy class methodsFor: 'instance creation'!
  302. on: aJSObject
  303. ^ self new
  304. jsObject: aJSObject;
  305. yourself
  306. ! !
  307. Object subclass: #Organizer
  308. instanceVariableNames: ''
  309. package: 'Kernel-Infrastructure'!
  310. !Organizer commentStamp!
  311. I represent categorization information.
  312. ## API
  313. Use `#addElement:` and `#removeElement:` to manipulate instances.!
  314. !Organizer methodsFor: 'accessing'!
  315. addElement: anObject
  316. <self.elements.addElement(anObject)>
  317. !
  318. elements
  319. ^ (self basicAt: 'elements') copy
  320. !
  321. removeElement: anObject
  322. <self.elements.removeElement(anObject)>
  323. ! !
  324. Organizer subclass: #ClassOrganizer
  325. instanceVariableNames: ''
  326. package: 'Kernel-Infrastructure'!
  327. !ClassOrganizer commentStamp!
  328. I am an organizer specific to classes. I hold method categorization information for classes.!
  329. !ClassOrganizer methodsFor: 'accessing'!
  330. addElement: aString
  331. super addElement: aString.
  332. SystemAnnouncer current announce: (ProtocolAdded new
  333. protocol: aString;
  334. theClass: self theClass;
  335. yourself)
  336. !
  337. removeElement: aString
  338. super removeElement: aString.
  339. SystemAnnouncer current announce: (ProtocolRemoved new
  340. protocol: aString;
  341. theClass: self theClass;
  342. yourself)
  343. !
  344. theClass
  345. < return self.theClass >
  346. ! !
  347. Organizer subclass: #PackageOrganizer
  348. instanceVariableNames: ''
  349. package: 'Kernel-Infrastructure'!
  350. !PackageOrganizer commentStamp!
  351. I am an organizer specific to packages. I hold classes categorization information.!
  352. Object subclass: #Package
  353. instanceVariableNames: 'transport'
  354. package: 'Kernel-Infrastructure'!
  355. !Package commentStamp!
  356. 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.
  357. 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.
  358. ## API
  359. Packages are manipulated through "Smalltalk current", like for example finding one based on a name or with `Package class >> #name` directly:
  360. Smalltalk current packageAt: 'Kernel'
  361. Package named: 'Kernel'
  362. 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.
  363. You can fetch a package from the server:
  364. Package load: 'Additional-Examples'!
  365. !Package methodsFor: 'accessing'!
  366. basicTransport
  367. "Answer the transport literal JavaScript object as setup in the JavaScript file, if any"
  368. <return self.transport>
  369. !
  370. definition
  371. ^ String streamContents: [ :stream |
  372. stream
  373. nextPutAll: self class name;
  374. nextPutAll: String lf, String tab;
  375. nextPutAll: ' named: ';
  376. nextPutAll: '''', self name, '''';
  377. nextPutAll: String lf, String tab;
  378. nextPutAll: ' transport: (';
  379. nextPutAll: self transport definition, ')' ]
  380. !
  381. name
  382. <return self.pkgName>
  383. !
  384. name: aString
  385. <self.pkgName = aString>
  386. !
  387. organization
  388. ^ self basicAt: 'organization'
  389. !
  390. transport
  391. ^ transport ifNil: [
  392. transport := (PackageTransport fromJson: self basicTransport)
  393. package: self;
  394. yourself ]
  395. !
  396. transport: aPackageTransport
  397. transport := aPackageTransport.
  398. aPackageTransport package: self
  399. ! !
  400. !Package methodsFor: 'classes'!
  401. classes
  402. ^ self organization elements asSet asArray
  403. !
  404. setupClasses
  405. self classes
  406. do: [ :each | ClassBuilder new setupClass: each ];
  407. do: [ :each | each initialize ]
  408. !
  409. sortedClasses
  410. "Answer all classes in the receiver, sorted by superclass/subclasses and by class name for common subclasses (Issue #143)."
  411. ^ self class sortedClasses: self classes
  412. ! !
  413. !Package methodsFor: 'dependencies'!
  414. loadDependencies
  415. "Returns list of packages that need to be loaded
  416. before loading this package."
  417. | classes packages |
  418. classes := self loadDependencyClasses.
  419. ^ (classes collect: [ :each | each package ]) asSet
  420. remove: self ifAbsent: [];
  421. yourself
  422. !
  423. loadDependencyClasses
  424. "Returns classes needed at the time of loading a package.
  425. These are all that are used to subclass
  426. and to define an extension method"
  427. | starCategoryName |
  428. starCategoryName := '*', self name.
  429. ^ (self classes collect: [ :each | each superclass ]) asSet
  430. remove: nil ifAbsent: [];
  431. addAll: (Smalltalk classes select: [ :each | each protocols, each class protocols includes: starCategoryName ]);
  432. yourself
  433. ! !
  434. !Package methodsFor: 'printing'!
  435. printOn: aStream
  436. super printOn: aStream.
  437. aStream
  438. nextPutAll: ' (';
  439. nextPutAll: self name;
  440. nextPutAll: ')'
  441. ! !
  442. !Package methodsFor: 'testing'!
  443. isPackage
  444. ^ true
  445. ! !
  446. Package class instanceVariableNames: 'defaultCommitPathJs defaultCommitPathSt'!
  447. !Package class methodsFor: 'accessing'!
  448. named: aPackageName
  449. ^ Smalltalk
  450. packageAt: aPackageName
  451. ifAbsent: [
  452. Smalltalk createPackage: aPackageName ]
  453. !
  454. named: aPackageName ifAbsent: aBlock
  455. ^ Smalltalk packageAt: aPackageName ifAbsent: aBlock
  456. !
  457. named: aPackageName transport: aTransport
  458. | package |
  459. package := self named: aPackageName.
  460. package transport: aTransport.
  461. ^ package
  462. ! !
  463. !Package class methodsFor: 'sorting'!
  464. sortedClasses: classes
  465. "Answer classes, sorted by superclass/subclasses and by class name for common subclasses (Issue #143)"
  466. | children others nodes expandedClasses |
  467. children := #().
  468. others := #().
  469. classes do: [ :each |
  470. (classes includes: each superclass)
  471. ifFalse: [ children add: each ]
  472. ifTrue: [ others add: each ]].
  473. nodes := children collect: [ :each |
  474. ClassSorterNode on: each classes: others level: 0 ].
  475. nodes := nodes sorted: [ :a :b | a theClass name <= b theClass name ].
  476. expandedClasses := Array new.
  477. nodes do: [ :aNode |
  478. aNode traverseClassesWith: expandedClasses ].
  479. ^ expandedClasses
  480. ! !
  481. Object subclass: #PlatformInterface
  482. instanceVariableNames: ''
  483. package: 'Kernel-Infrastructure'!
  484. !PlatformInterface commentStamp!
  485. I am single entry point to UI and environment interface.
  486. My `initialize` tries several options (for now, browser environment only) to set myself up.
  487. ## API
  488. PlatformInterface alert: 'Hey, there is a problem'.
  489. PlatformInterface confirm: 'Affirmative?'.
  490. PlatformInterface prompt: 'Your name:'.
  491. PlatformInterface ajax: #{
  492. 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script'
  493. }.!
  494. PlatformInterface class instanceVariableNames: 'worker'!
  495. !PlatformInterface class methodsFor: 'accessing'!
  496. globals
  497. <return (new Function('return this'))();>
  498. !
  499. setWorker: anObject
  500. worker := anObject
  501. ! !
  502. !PlatformInterface class methodsFor: 'actions'!
  503. ajax: anObject
  504. ^ worker
  505. ifNotNil: [ worker ajax: anObject ]
  506. ifNil: [ self error: 'ajax: not available' ]
  507. !
  508. alert: aString
  509. ^ worker
  510. ifNotNil: [ worker alert: aString ]
  511. ifNil: [ self error: 'alert: not available' ]
  512. !
  513. confirm: aString
  514. ^ worker
  515. ifNotNil: [ worker confirm: aString ]
  516. ifNil: [ self error: 'confirm: not available' ]
  517. !
  518. existsGlobal: aString
  519. ^ PlatformInterface globals
  520. at: aString
  521. ifPresent: [ true ]
  522. ifAbsent: [ false ]
  523. !
  524. prompt: aString
  525. ^ worker
  526. ifNotNil: [ worker prompt: aString ]
  527. ifNil: [ self error: 'prompt: not available' ]
  528. ! !
  529. !PlatformInterface class methodsFor: 'initialization'!
  530. initialize
  531. | candidate |
  532. super initialize.
  533. BrowserInterface ifNotNil: [
  534. candidate := BrowserInterface new.
  535. candidate isAvailable ifTrue: [ self setWorker: candidate. ^ self ]
  536. ]
  537. ! !
  538. Object subclass: #ProgressHandler
  539. instanceVariableNames: ''
  540. package: 'Kernel-Infrastructure'!
  541. !ProgressHandler commentStamp!
  542. I am used to manage progress in collection iterations, see `SequenceableCollection >> #do:displayingProgress:`.
  543. Subclasses of can register themselves as the current handler with
  544. `ProgressHandler class >> register`.
  545. The default behavior is to simply iterate over the collection.!
  546. !ProgressHandler methodsFor: 'progress handling'!
  547. do: aBlock on: aCollection displaying: aString
  548. aCollection do: aBlock
  549. ! !
  550. ProgressHandler class instanceVariableNames: 'current'!
  551. !ProgressHandler class methodsFor: 'accessing'!
  552. current
  553. ^ current ifNil: [ current := self new ]
  554. !
  555. setCurrent: anHandler
  556. current := anHandler
  557. ! !
  558. !ProgressHandler class methodsFor: 'initialization'!
  559. initialize
  560. self register
  561. !
  562. register
  563. ProgressHandler setCurrent: self new
  564. ! !
  565. Object subclass: #SmalltalkImage
  566. instanceVariableNames: ''
  567. package: 'Kernel-Infrastructure'!
  568. !SmalltalkImage commentStamp!
  569. I represent the Smalltalk system, wrapping
  570. operations of variable `smalltalk` declared in `js/boot.js`.
  571. ## API
  572. I have only one instance, accessed with global variable `Smalltalk`.
  573. The `smalltalk` object holds all class and packages defined in the system.
  574. ## Classes
  575. Classes can be accessed using the following methods:
  576. - `#classes` answers the full list of Smalltalk classes in the system
  577. - `#at:` answers a specific class or `nil`
  578. ## Packages
  579. Packages can be accessed using the following methods:
  580. - `#packages` answers the full list of packages
  581. - `#packageAt:` answers a specific package or `nil`
  582. ## Parsing
  583. The `#parse:` method is used to parse Amber source code.
  584. It requires the `Compiler` package and the `js/parser.js` parser file in order to work.!
  585. !SmalltalkImage methodsFor: 'accessing'!
  586. at: aString
  587. <return smalltalk[aString]>
  588. !
  589. at: aKey ifAbsent: aBlock
  590. ^ (self includesKey: aKey)
  591. ifTrue: [ self at: aKey ]
  592. ifFalse: [ aBlock value ]
  593. !
  594. at: aString put: anObject
  595. <return smalltalk[aString]=anObject>
  596. !
  597. current
  598. "Backward compatibility for Smalltalk current ..."
  599. self deprecatedAPI.
  600. ^ self
  601. !
  602. globals
  603. "Future compatibility to be able to use Smalltalk globals at: ..."
  604. ^ self
  605. !
  606. includesKey: aKey
  607. <return smalltalk.hasOwnProperty(aKey)>
  608. !
  609. parse: aString
  610. | result |
  611. self
  612. try: [ result := self basicParse: aString ]
  613. catch: [ :ex | (self parseError: ex parsing: aString) signal ].
  614. ^ result
  615. source: aString;
  616. yourself
  617. !
  618. pseudoVariableNames
  619. ^ #('self' 'super' 'nil' 'true' 'false' 'thisContext')
  620. !
  621. readJSObject: anObject
  622. <return smalltalk.readJSObject(anObject)>
  623. !
  624. reservedWords
  625. "JavaScript reserved words"
  626. <return smalltalk.reservedWords>
  627. !
  628. version
  629. "Answer the version string of Amber"
  630. ^ '0.13.0-pre'
  631. !
  632. vm
  633. "Future compatibility to be able to use Smalltalk vm ..."
  634. <return smalltalk>
  635. ! !
  636. !SmalltalkImage methodsFor: 'accessing amd'!
  637. amdRequire
  638. ^ self at: 'amdRequire'
  639. !
  640. defaultAmdNamespace
  641. ^ self at: 'defaultAmdNamespace'
  642. !
  643. defaultAmdNamespace: aString
  644. self at: 'defaultAmdNamespace' put: aString
  645. ! !
  646. !SmalltalkImage methodsFor: 'classes'!
  647. classes
  648. <return smalltalk.classes()>
  649. !
  650. removeClass: aClass
  651. aClass isMetaclass ifTrue: [ self error: aClass asString, ' is a Metaclass and cannot be removed!!' ].
  652. self deleteClass: aClass.
  653. SystemAnnouncer current
  654. announce: (ClassRemoved new
  655. theClass: aClass;
  656. yourself)
  657. ! !
  658. !SmalltalkImage methodsFor: 'error handling'!
  659. asSmalltalkException: anObject
  660. "A JavaScript exception may be thrown.
  661. We then need to convert it back to a Smalltalk object"
  662. ^ ((self isSmalltalkObject: anObject) and: [ anObject isKindOf: Error ])
  663. ifTrue: [ anObject ]
  664. ifFalse: [ JavaScriptException on: anObject ]
  665. !
  666. parseError: anException parsing: aString
  667. ^ ParseError new messageText: 'Parse error on line ', (anException basicAt: 'line') ,' column ' , (anException basicAt: 'column') ,' : Unexpected character ', (anException basicAt: 'found')
  668. ! !
  669. !SmalltalkImage methodsFor: 'globals'!
  670. addGlobalJsVariable: aString
  671. self globalJsVariables add: aString
  672. !
  673. deleteGlobalJsVariable: aString
  674. self globalJsVariables remove: aString ifAbsent:[]
  675. !
  676. globalJsVariables
  677. "Array of global JavaScript variables"
  678. <return smalltalk.globalJsVariables>
  679. ! !
  680. !SmalltalkImage methodsFor: 'packages'!
  681. createPackage: packageName
  682. | package announcement |
  683. package := self basicCreatePackage: packageName.
  684. announcement := PackageAdded new
  685. package: package;
  686. yourself.
  687. SystemAnnouncer current announce: announcement.
  688. ^ package
  689. !
  690. packageAt: packageName
  691. <return smalltalk.packages[packageName]>
  692. !
  693. packageAt: packageName ifAbsent: aBlock
  694. ^ (self packageAt: packageName) ifNil: aBlock
  695. !
  696. packages
  697. "Return all Package instances in the system."
  698. <
  699. return Object.keys(smalltalk.packages).map(function(k) {
  700. return smalltalk.packages[k];
  701. })
  702. >
  703. !
  704. removePackage: packageName
  705. "Removes a package and all its classes."
  706. | pkg |
  707. pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
  708. pkg classes do: [ :each |
  709. self removeClass: each ].
  710. self deletePackage: packageName
  711. !
  712. renamePackage: packageName to: newName
  713. "Rename a package."
  714. | pkg |
  715. pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
  716. (self packageAt: newName) ifNotNil: [ self error: 'Already exists a package called: ', newName ].
  717. (self at: 'packages') at: newName put: pkg.
  718. pkg name: newName.
  719. self deletePackage: packageName.
  720. ! !
  721. !SmalltalkImage methodsFor: 'private'!
  722. basicCreatePackage: packageName
  723. "Create and bind a new bare package with given name and return it."
  724. <return smalltalk.addPackage(packageName)>
  725. !
  726. basicParse: aString
  727. <return smalltalk.parser.parse(aString)>
  728. !
  729. createPackage: packageName properties: aDict
  730. "Needed to import .st files: they begin with this call."
  731. self deprecatedAPI.
  732. aDict isEmpty ifFalse: [ self error: 'createPackage:properties: called with nonempty properties' ].
  733. ^ self createPackage: packageName
  734. !
  735. deleteClass: aClass
  736. "Deletes a class by deleting its binding only. Use #removeClass instead"
  737. <smalltalk.removeClass(aClass)>
  738. !
  739. deletePackage: packageName
  740. "Deletes a package by deleting its binding, but does not check if it contains classes etc.
  741. To remove a package, use #removePackage instead."
  742. <delete smalltalk.packages[packageName]>
  743. ! !
  744. !SmalltalkImage methodsFor: 'testing'!
  745. isSmalltalkObject: anObject
  746. "Consider anObject a Smalltalk object if it has a 'klass' property.
  747. Note that this may be unaccurate"
  748. <return typeof anObject.klass !!== 'undefined'>
  749. ! !
  750. SmalltalkImage class instanceVariableNames: 'current'!
  751. !SmalltalkImage class methodsFor: 'initialization'!
  752. initialize
  753. smalltalk at: 'Smalltalk' put: self current
  754. ! !
  755. !SmalltalkImage class methodsFor: 'instance creation'!
  756. current
  757. ^ current ifNil: [ current := super new ] ifNotNil: [ self deprecatedAPI. current ]
  758. !
  759. new
  760. self shouldNotImplement
  761. ! !
  762. !SequenceableCollection methodsFor: '*Kernel-Infrastructure'!
  763. do: aBlock displayingProgress: aString
  764. ProgressHandler current
  765. do: aBlock on: self displaying: aString
  766. ! !
  767. !String methodsFor: '*Kernel-Infrastructure'!
  768. asJavaScriptSelector
  769. "Return first keyword of the selector, without trailing colon."
  770. ^ self replace: '^([a-zA-Z0-9]*).*$' with: '$1'
  771. ! !