Kernel-Infrastructure.st 23 KB

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