1
0

Kernel-Infrastructure.st 31 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402
  1. Smalltalk createPackage: 'Kernel-Infrastructure'!
  2. Object subclass: #ConsoleErrorHandler
  3. instanceVariableNames: ''
  4. package: 'Kernel-Infrastructure'!
  5. !ConsoleErrorHandler commentStamp!
  6. I am manage Smalltalk errors, displaying the stack in the console.!
  7. !ConsoleErrorHandler methodsFor: 'error handling'!
  8. handleError: anError
  9. anError context ifNotNil: [ self logErrorContext: anError context ].
  10. self logError: anError
  11. ! !
  12. !ConsoleErrorHandler methodsFor: 'private'!
  13. log: aString
  14. console log: aString
  15. !
  16. logContext: aContext
  17. aContext home ifNotNil: [
  18. self logContext: aContext home ].
  19. self log: aContext asString
  20. !
  21. logError: anError
  22. self log: anError messageText
  23. !
  24. logErrorContext: aContext
  25. aContext ifNotNil: [
  26. aContext home ifNotNil: [
  27. self logContext: aContext home ]]
  28. ! !
  29. ConsoleErrorHandler class instanceVariableNames: 'current'!
  30. !ConsoleErrorHandler class methodsFor: 'initialization'!
  31. initialize
  32. ErrorHandler registerIfNone: self new
  33. ! !
  34. Object subclass: #InterfacingObject
  35. instanceVariableNames: ''
  36. package: 'Kernel-Infrastructure'!
  37. !InterfacingObject commentStamp!
  38. 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`.
  39. ## API
  40. self alert: 'Hey, there is a problem'.
  41. self confirm: 'Affirmative?'.
  42. self prompt: 'Your name:'.
  43. self ajax: #{
  44. 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script'
  45. }.!
  46. !InterfacingObject methodsFor: 'actions'!
  47. ajax: anObject
  48. ^ PlatformInterface ajax: anObject
  49. !
  50. alert: aString
  51. ^ PlatformInterface alert: aString
  52. !
  53. confirm: aString
  54. ^ PlatformInterface confirm: aString
  55. !
  56. prompt: aString
  57. ^ PlatformInterface prompt: aString
  58. !
  59. prompt: aString default: defaultString
  60. ^ PlatformInterface prompt: aString default: defaultString
  61. ! !
  62. InterfacingObject subclass: #Environment
  63. instanceVariableNames: ''
  64. package: 'Kernel-Infrastructure'!
  65. !Environment commentStamp!
  66. I provide an unified entry point to manipulate Amber packages, classes and methods.
  67. Typical use cases include IDEs, remote access and restricting browsing.!
  68. !Environment methodsFor: 'accessing'!
  69. allSelectors
  70. ^ Smalltalk vm allSelectors
  71. !
  72. availableClassNames
  73. ^ Smalltalk classes
  74. collect: [ :each | each name ]
  75. !
  76. availablePackageNames
  77. ^ Smalltalk packages
  78. collect: [ :each | each name ]
  79. !
  80. availableProtocolsFor: aClass
  81. | protocols |
  82. protocols := aClass protocols.
  83. aClass superclass ifNotNil: [ protocols addAll: (self availableProtocolsFor: aClass superclass) ].
  84. ^ protocols asSet asArray sort
  85. !
  86. classBuilder
  87. ^ ClassBuilder new
  88. !
  89. classNamed: aString
  90. ^ (Smalltalk globals at: aString asSymbol)
  91. ifNil: [ self error: 'Invalid class name' ]
  92. !
  93. classes
  94. ^ Smalltalk classes
  95. !
  96. doItReceiver
  97. ^ DoIt new
  98. !
  99. packages
  100. ^ Smalltalk packages
  101. !
  102. systemAnnouncer
  103. ^ (Smalltalk globals at: #SystemAnnouncer) current
  104. ! !
  105. !Environment methodsFor: 'actions'!
  106. commitPackage: aPackage onSuccess: aBlock onError: anotherBlock
  107. aPackage transport
  108. commitOnSuccess: aBlock
  109. onError: anotherBlock
  110. !
  111. copyClass: aClass to: aClassName
  112. (Smalltalk globals at: aClassName)
  113. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  114. ClassBuilder new copyClass: aClass named: aClassName
  115. !
  116. inspect: anObject
  117. Inspector inspect: anObject
  118. !
  119. moveClass: aClass toPackage: aPackageName
  120. | package |
  121. package := Package named: aPackageName.
  122. package ifNil: [ self error: 'Invalid package name' ].
  123. package == aClass package ifTrue: [ ^ self ].
  124. aClass package: package
  125. !
  126. moveMethod: aMethod toClass: aClassName
  127. | destinationClass |
  128. destinationClass := self classNamed: aClassName.
  129. destinationClass == aMethod methodClass ifTrue: [ ^ self ].
  130. aMethod methodClass isMetaclass ifTrue: [
  131. destinationClass := destinationClass class ].
  132. destinationClass
  133. compile: aMethod source
  134. protocol: aMethod protocol.
  135. aMethod methodClass
  136. removeCompiledMethod: aMethod
  137. !
  138. moveMethod: aMethod toProtocol: aProtocol
  139. aMethod protocol: aProtocol
  140. !
  141. removeClass: aClass
  142. Smalltalk removeClass: aClass
  143. !
  144. removeMethod: aMethod
  145. aMethod methodClass removeCompiledMethod: aMethod
  146. !
  147. removeProtocol: aString from: aClass
  148. (aClass methodsInProtocol: aString)
  149. do: [ :each | aClass removeCompiledMethod: each ]
  150. !
  151. renameClass: aClass to: aClassName
  152. (Smalltalk globals at: aClassName)
  153. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  154. ClassBuilder new renameClass: aClass to: aClassName
  155. !
  156. renameProtocol: aString to: anotherString in: aClass
  157. (aClass methodsInProtocol: aString)
  158. do: [ :each | each protocol: anotherString ]
  159. !
  160. setClassCommentOf: aClass to: aString
  161. aClass comment: aString
  162. ! !
  163. !Environment methodsFor: 'compiling'!
  164. addInstVarNamed: aString to: aClass
  165. self classBuilder
  166. addSubclassOf: aClass superclass
  167. named: aClass name
  168. instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself)
  169. package: aClass package name
  170. !
  171. compileClassComment: aString for: aClass
  172. aClass comment: aString
  173. !
  174. compileClassDefinition: aString
  175. [ self evaluate: aString for: DoIt new ]
  176. on: Error
  177. do: [ :error | self alert: error messageText ]
  178. !
  179. compileMethod: sourceCode for: class protocol: protocol
  180. ^ class
  181. compile: sourceCode
  182. protocol: protocol
  183. ! !
  184. !Environment methodsFor: 'error handling'!
  185. evaluate: aBlock on: anErrorClass do: exceptionBlock
  186. "Evaluate a block and catch exceptions happening on the environment stack"
  187. aBlock tryCatch: [ :exception |
  188. (exception isKindOf: (self classNamed: anErrorClass name))
  189. ifTrue: [ exceptionBlock value: exception ]
  190. ifFalse: [ exception signal ] ]
  191. ! !
  192. !Environment methodsFor: 'evaluating'!
  193. evaluate: aString for: anObject
  194. ^ Evaluator evaluate: aString for: anObject
  195. ! !
  196. !Environment methodsFor: 'services'!
  197. registerErrorHandler: anErrorHandler
  198. ErrorHandler register: anErrorHandler
  199. !
  200. registerFinder: aFinder
  201. Finder register: aFinder
  202. !
  203. registerInspector: anInspector
  204. Inspector register: anInspector
  205. !
  206. registerProgressHandler: aProgressHandler
  207. ProgressHandler register: aProgressHandler
  208. !
  209. registerTranscript: aTranscript
  210. Transcript register: aTranscript
  211. ! !
  212. ProtoObject subclass: #JSObjectProxy
  213. instanceVariableNames: 'jsObject'
  214. package: 'Kernel-Infrastructure'!
  215. !JSObjectProxy commentStamp!
  216. I handle sending messages to JavaScript objects, making JavaScript object accessing from Amber fully transparent.
  217. My instances make intensive use of `#doesNotUnderstand:`.
  218. My instances are automatically created by Amber whenever a message is sent to a JavaScript object.
  219. ## Usage examples
  220. JSObjectProxy objects are instanciated by Amber when a Smalltalk message is sent to a JavaScript object.
  221. window alert: 'hello world'.
  222. window inspect.
  223. (window jQuery: 'body') append: 'hello world'
  224. 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.
  225. ## Message conversion rules
  226. - `someUser name` becomes `someUser.name`
  227. - `someUser name: 'John'` becomes `someUser name = "John"`
  228. - `console log: 'hello world'` becomes `console.log('hello world')`
  229. - `(window jQuery: 'foo') css: 'background' color: 'red'` becomes `window.jQuery('foo').css('background', 'red')`
  230. __Note:__ For keyword-based messages, only the first keyword is kept: `window foo: 1 bar: 2` is equivalent to `window foo: 1 baz: 2`.!
  231. !JSObjectProxy methodsFor: 'accessing'!
  232. at: aString
  233. <return self['@jsObject'][aString]>
  234. !
  235. at: aString ifAbsent: aBlock
  236. "return the aString property or evaluate aBlock if the property is not defined on the object"
  237. <
  238. var obj = self['@jsObject'];
  239. return aString in obj ? obj[aString] : aBlock._value();
  240. >
  241. !
  242. at: aString ifPresent: aBlock
  243. "return the evaluation of aBlock with the value if the property is defined or return nil"
  244. <
  245. var obj = self['@jsObject'];
  246. return aString in obj ? aBlock._value_(obj[aString]) : nil;
  247. >
  248. !
  249. at: aString ifPresent: aBlock ifAbsent: anotherBlock
  250. "return the evaluation of aBlock with the value if the property is defined
  251. or return value of anotherBlock"
  252. <
  253. var obj = self['@jsObject'];
  254. return aString in obj ? aBlock._value_(obj[aString]) : anotherBlock._value();
  255. >
  256. !
  257. at: aString put: anObject
  258. <return self['@jsObject'][aString] = anObject>
  259. !
  260. jsObject
  261. ^ jsObject
  262. !
  263. jsObject: aJSObject
  264. jsObject := aJSObject
  265. !
  266. lookupProperty: aString
  267. "Looks up a property in JS object.
  268. Answer the property if it is present, or nil if it is not present."
  269. <return aString in self._jsObject() ? aString : nil>
  270. ! !
  271. !JSObjectProxy methodsFor: 'comparing'!
  272. = anObject
  273. anObject class == self class ifFalse: [ ^ false ].
  274. ^ self compareJSObjectWith: anObject jsObject
  275. ! !
  276. !JSObjectProxy methodsFor: 'enumerating'!
  277. asJSON
  278. "Answers the receiver in a stringyfy-friendly fashion"
  279. ^ jsObject
  280. !
  281. keysAndValuesDo: aBlock
  282. <
  283. var o = self['@jsObject'];
  284. for(var i in o) {
  285. aBlock._value_value_(i, o[i]);
  286. }
  287. >
  288. ! !
  289. !JSObjectProxy methodsFor: 'printing'!
  290. printOn: aStream
  291. aStream nextPutAll: self printString
  292. !
  293. printString
  294. <
  295. var js = self['@jsObject'];
  296. return js.toString
  297. ? js.toString()
  298. : Object.prototype.toString.call(js)
  299. >
  300. ! !
  301. !JSObjectProxy methodsFor: 'private'!
  302. compareJSObjectWith: aJSObject
  303. <return self["@jsObject"] === aJSObject>
  304. ! !
  305. !JSObjectProxy methodsFor: 'proxy'!
  306. addObjectVariablesTo: aDictionary
  307. <
  308. for(var i in self['@jsObject']) {
  309. aDictionary._at_put_(i, self['@jsObject'][i]);
  310. }
  311. >
  312. !
  313. doesNotUnderstand: aMessage
  314. ^ (self lookupProperty: aMessage selector asJavaScriptSelector)
  315. ifNil: [ super doesNotUnderstand: aMessage ]
  316. ifNotNil: [ :jsSelector |
  317. self
  318. forwardMessage: jsSelector
  319. withArguments: aMessage arguments ]
  320. !
  321. forwardMessage: aString withArguments: anArray
  322. <
  323. return smalltalk.send(self._jsObject(), aString, anArray);
  324. >
  325. !
  326. inspectOn: anInspector
  327. | variables |
  328. variables := Dictionary new.
  329. variables at: '#self' put: self jsObject.
  330. anInspector setLabel: self printString.
  331. self addObjectVariablesTo: variables.
  332. anInspector setVariables: variables
  333. ! !
  334. !JSObjectProxy class methodsFor: 'instance creation'!
  335. on: aJSObject
  336. ^ self new
  337. jsObject: aJSObject;
  338. yourself
  339. ! !
  340. Object subclass: #NullProgressHandler
  341. instanceVariableNames: ''
  342. package: 'Kernel-Infrastructure'!
  343. !NullProgressHandler commentStamp!
  344. I am the default progress handler. I do not display any progress, and simply iterate over the collection.!
  345. !NullProgressHandler methodsFor: 'progress handling'!
  346. do: aBlock on: aCollection displaying: aString
  347. aCollection do: aBlock
  348. ! !
  349. NullProgressHandler class instanceVariableNames: 'current'!
  350. !NullProgressHandler class methodsFor: 'initialization'!
  351. initialize
  352. ProgressHandler registerIfNone: self new
  353. ! !
  354. Object subclass: #Organizer
  355. instanceVariableNames: ''
  356. package: 'Kernel-Infrastructure'!
  357. !Organizer commentStamp!
  358. I represent categorization information.
  359. ## API
  360. Use `#addElement:` and `#removeElement:` to manipulate instances.!
  361. !Organizer methodsFor: 'accessing'!
  362. addElement: anObject
  363. <self.elements.addElement(anObject)>
  364. !
  365. elements
  366. ^ (self basicAt: 'elements') copy
  367. !
  368. removeElement: anObject
  369. <self.elements.removeElement(anObject)>
  370. ! !
  371. Organizer subclass: #ClassOrganizer
  372. instanceVariableNames: ''
  373. package: 'Kernel-Infrastructure'!
  374. !ClassOrganizer commentStamp!
  375. I am an organizer specific to classes. I hold method categorization information for classes.!
  376. !ClassOrganizer methodsFor: 'accessing'!
  377. addElement: aString
  378. super addElement: aString.
  379. SystemAnnouncer current announce: (ProtocolAdded new
  380. protocol: aString;
  381. theClass: self theClass;
  382. yourself)
  383. !
  384. removeElement: aString
  385. super removeElement: aString.
  386. SystemAnnouncer current announce: (ProtocolRemoved new
  387. protocol: aString;
  388. theClass: self theClass;
  389. yourself)
  390. !
  391. theClass
  392. < return self.theClass >
  393. ! !
  394. Organizer subclass: #PackageOrganizer
  395. instanceVariableNames: ''
  396. package: 'Kernel-Infrastructure'!
  397. !PackageOrganizer commentStamp!
  398. I am an organizer specific to packages. I hold classes categorization information.!
  399. Object subclass: #Package
  400. instanceVariableNames: 'transport dirty'
  401. package: 'Kernel-Infrastructure'!
  402. !Package commentStamp!
  403. 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.
  404. 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.
  405. ## API
  406. Packages are manipulated through "Smalltalk current", like for example finding one based on a name or with `Package class >> #name` directly:
  407. Smalltalk current packageAt: 'Kernel'
  408. Package named: 'Kernel'
  409. 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.
  410. You can fetch a package from the server:
  411. Package load: 'Additional-Examples'!
  412. !Package methodsFor: 'accessing'!
  413. beClean
  414. dirty := false.
  415. SystemAnnouncer current announce: (PackageClean new
  416. package: self;
  417. yourself)
  418. !
  419. beDirty
  420. dirty := true.
  421. SystemAnnouncer current announce: (PackageClean new
  422. package: self;
  423. yourself)
  424. !
  425. classTemplate
  426. ^ String streamContents: [ :stream |
  427. stream
  428. nextPutAll: 'Object';
  429. nextPutAll: ' subclass: #NameOfSubclass';
  430. nextPutAll: String lf, String tab;
  431. nextPutAll: 'instanceVariableNames: '''''.
  432. stream
  433. nextPutAll: '''', String lf, String tab;
  434. nextPutAll: 'package: ''';
  435. nextPutAll: self name;
  436. nextPutAll: '''' ]
  437. !
  438. definition
  439. ^ String streamContents: [ :stream |
  440. stream
  441. nextPutAll: self class name;
  442. nextPutAll: String lf, String tab;
  443. nextPutAll: ' named: ';
  444. nextPutAll: '''', self name, '''';
  445. nextPutAll: String lf, String tab;
  446. nextPutAll: ' transport: (';
  447. nextPutAll: self transport definition, ')' ]
  448. !
  449. name
  450. <return self.pkgName>
  451. !
  452. name: aString
  453. self basicName: aString.
  454. self beDirty
  455. !
  456. organization
  457. ^ self basicAt: 'organization'
  458. !
  459. transport
  460. ^ transport ifNil: [
  461. transport := (PackageTransport fromJson: self basicTransport)
  462. package: self;
  463. yourself ]
  464. !
  465. transport: aPackageTransport
  466. transport := aPackageTransport.
  467. aPackageTransport package: self
  468. ! !
  469. !Package methodsFor: 'classes'!
  470. classes
  471. ^ self organization elements
  472. !
  473. setupClasses
  474. self classes
  475. do: [ :each | ClassBuilder new setupClass: each ];
  476. do: [ :each | each initialize ]
  477. !
  478. sortedClasses
  479. "Answer all classes in the receiver, sorted by superclass/subclasses and by class name for common subclasses (Issue #143)."
  480. ^ self class sortedClasses: self classes
  481. ! !
  482. !Package methodsFor: 'dependencies'!
  483. loadDependencies
  484. "Returns list of packages that need to be loaded
  485. before loading this package."
  486. | classes packages |
  487. classes := self loadDependencyClasses.
  488. ^ (classes collect: [ :each | each package ]) asSet
  489. remove: self ifAbsent: [];
  490. yourself
  491. !
  492. loadDependencyClasses
  493. "Returns classes needed at the time of loading a package.
  494. These are all that are used to subclass
  495. and to define an extension method"
  496. | starCategoryName |
  497. starCategoryName := '*', self name.
  498. ^ (self classes collect: [ :each | each superclass ]) asSet
  499. remove: nil ifAbsent: [];
  500. addAll: (Smalltalk classes select: [ :each | each protocols, each class protocols includes: starCategoryName ]);
  501. yourself
  502. ! !
  503. !Package methodsFor: 'printing'!
  504. printOn: aStream
  505. super printOn: aStream.
  506. aStream
  507. nextPutAll: ' (';
  508. nextPutAll: self name;
  509. nextPutAll: ')'
  510. ! !
  511. !Package methodsFor: 'private'!
  512. basicName: aString
  513. <self.pkgName = aString>
  514. !
  515. basicTransport
  516. "Answer the transport literal JavaScript object as setup in the JavaScript file, if any"
  517. <return self.transport>
  518. ! !
  519. !Package methodsFor: 'testing'!
  520. isDirty
  521. ^ dirty ifNil: [ false ]
  522. !
  523. isPackage
  524. ^ true
  525. ! !
  526. Package class instanceVariableNames: 'defaultCommitPathJs defaultCommitPathSt'!
  527. !Package class methodsFor: 'accessing'!
  528. named: aPackageName
  529. ^ Smalltalk
  530. packageAt: aPackageName
  531. ifAbsent: [
  532. Smalltalk createPackage: aPackageName ]
  533. !
  534. named: aPackageName ifAbsent: aBlock
  535. ^ Smalltalk packageAt: aPackageName ifAbsent: aBlock
  536. !
  537. named: aPackageName transport: aTransport
  538. | package |
  539. package := self named: aPackageName.
  540. package transport: aTransport.
  541. ^ package
  542. ! !
  543. !Package class methodsFor: 'sorting'!
  544. sortedClasses: classes
  545. "Answer classes, sorted by superclass/subclasses and by class name for common subclasses (Issue #143)"
  546. | children others nodes expandedClasses |
  547. children := #().
  548. others := #().
  549. classes do: [ :each |
  550. (classes includes: each superclass)
  551. ifFalse: [ children add: each ]
  552. ifTrue: [ others add: each ]].
  553. nodes := children collect: [ :each |
  554. ClassSorterNode on: each classes: others level: 0 ].
  555. nodes := nodes sorted: [ :a :b | a theClass name <= b theClass name ].
  556. expandedClasses := Array new.
  557. nodes do: [ :aNode |
  558. aNode traverseClassesWith: expandedClasses ].
  559. ^ expandedClasses
  560. ! !
  561. Object subclass: #PackageStateObserver
  562. instanceVariableNames: ''
  563. package: 'Kernel-Infrastructure'!
  564. !PackageStateObserver commentStamp!
  565. My current instance listens for any changes in the system that might affect the state of a package (being dirty).!
  566. !PackageStateObserver methodsFor: 'accessing'!
  567. announcer
  568. ^ SystemAnnouncer current
  569. ! !
  570. !PackageStateObserver methodsFor: 'actions'!
  571. observeSystem
  572. self announcer
  573. on: PackageAdded
  574. send: #onPackageAdded:
  575. to: self;
  576. on: ClassAnnouncement
  577. send: #onClassModification:
  578. to: self;
  579. on: MethodAnnouncement
  580. send: #onMethodModification:
  581. to: self;
  582. on: ProtocolAnnouncement
  583. send: #onProtocolModification:
  584. to: self
  585. ! !
  586. !PackageStateObserver methodsFor: 'reactions'!
  587. onClassModification: anAnnouncement
  588. anAnnouncement theClass ifNotNil: [ :theClass |
  589. theClass package beDirty ]
  590. !
  591. onMethodModification: anAnnouncement
  592. anAnnouncement method package ifNotNil: [ :package | package beDirty ]
  593. !
  594. onPackageAdded: anAnnouncement
  595. anAnnouncement package beDirty
  596. !
  597. onProtocolModification: anAnnouncement
  598. anAnnouncement theClass package beDirty
  599. ! !
  600. PackageStateObserver class instanceVariableNames: 'current'!
  601. !PackageStateObserver class methodsFor: 'accessing'!
  602. current
  603. ^ current ifNil: [ current := self new ]
  604. ! !
  605. !PackageStateObserver class methodsFor: 'initialization'!
  606. initialize
  607. self current observeSystem
  608. ! !
  609. Object subclass: #PlatformInterface
  610. instanceVariableNames: ''
  611. package: 'Kernel-Infrastructure'!
  612. !PlatformInterface commentStamp!
  613. I am single entry point to UI and environment interface.
  614. My `initialize` tries several options (for now, browser environment only) to set myself up.
  615. ## API
  616. PlatformInterface alert: 'Hey, there is a problem'.
  617. PlatformInterface confirm: 'Affirmative?'.
  618. PlatformInterface prompt: 'Your name:'.
  619. PlatformInterface ajax: #{
  620. 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script'
  621. }.!
  622. PlatformInterface class instanceVariableNames: 'worker'!
  623. !PlatformInterface class methodsFor: 'accessing'!
  624. globals
  625. <return (new Function('return this'))();>
  626. !
  627. setWorker: anObject
  628. worker := anObject
  629. ! !
  630. !PlatformInterface class methodsFor: 'actions'!
  631. ajax: anObject
  632. ^ worker
  633. ifNotNil: [ worker ajax: anObject ]
  634. ifNil: [ self error: 'ajax: not available' ]
  635. !
  636. alert: aString
  637. ^ worker
  638. ifNotNil: [ worker alert: aString ]
  639. ifNil: [ self error: 'alert: not available' ]
  640. !
  641. confirm: aString
  642. ^ worker
  643. ifNotNil: [ worker confirm: aString ]
  644. ifNil: [ self error: 'confirm: not available' ]
  645. !
  646. existsGlobal: aString
  647. ^ PlatformInterface globals
  648. at: aString
  649. ifPresent: [ true ]
  650. ifAbsent: [ false ]
  651. !
  652. prompt: aString
  653. ^ worker
  654. ifNotNil: [ worker prompt: aString ]
  655. ifNil: [ self error: 'prompt: not available' ]
  656. !
  657. prompt: aString default: defaultString
  658. ^ worker
  659. ifNotNil: [ worker prompt: aString default: defaultString ]
  660. ifNil: [ self error: 'prompt: not available' ]
  661. ! !
  662. !PlatformInterface class methodsFor: 'initialization'!
  663. initialize
  664. | candidate |
  665. super initialize.
  666. BrowserInterface ifNotNil: [
  667. candidate := BrowserInterface new.
  668. candidate isAvailable ifTrue: [ self setWorker: candidate. ^ self ]
  669. ]
  670. ! !
  671. Object subclass: #Service
  672. instanceVariableNames: ''
  673. package: 'Kernel-Infrastructure'!
  674. !Service commentStamp!
  675. I implement the basic behavior for class registration to a service.
  676. See the `Transcript` class for a concrete service.
  677. ## API
  678. Use class-side methods `#register:` and `#registerIfNone:` to register classes to a specific service.!
  679. Service class instanceVariableNames: 'current'!
  680. !Service class methodsFor: 'accessing'!
  681. current
  682. ^ current
  683. ! !
  684. !Service class methodsFor: 'instance creation'!
  685. new
  686. self shouldNotImplement
  687. ! !
  688. !Service class methodsFor: 'registration'!
  689. register: anObject
  690. current := anObject
  691. !
  692. registerIfNone: anObject
  693. self current ifNil: [ self register: anObject ]
  694. ! !
  695. Service subclass: #ErrorHandler
  696. instanceVariableNames: ''
  697. package: 'Kernel-Infrastructure'!
  698. !ErrorHandler commentStamp!
  699. I am the service used to handle Smalltalk errors.
  700. See `boot.js` `handleError()` function.
  701. Registered service instances must implement `#handleError:` to perform an action on the thrown exception.!
  702. !ErrorHandler class methodsFor: 'error handling'!
  703. handleError: anError
  704. self handleUnhandledError: anError
  705. !
  706. handleUnhandledError: anError
  707. anError wasHandled ifTrue: [ ^ self ].
  708. ^ self current handleError: anError
  709. ! !
  710. Service subclass: #Finder
  711. instanceVariableNames: ''
  712. package: 'Kernel-Infrastructure'!
  713. !Finder commentStamp!
  714. I am the service responsible for finding classes/methods.
  715. __There is no default finder.__
  716. ## API
  717. Use `#browse` on an object to find it.!
  718. !Finder class methodsFor: 'finding'!
  719. findClass: aClass
  720. ^ self current findClass: aClass
  721. !
  722. findMethod: aCompiledMethod
  723. ^ self current findMethod: aCompiledMethod
  724. !
  725. findString: aString
  726. ^ self current findString: aString
  727. ! !
  728. Service subclass: #Inspector
  729. instanceVariableNames: ''
  730. package: 'Kernel-Infrastructure'!
  731. !Inspector commentStamp!
  732. I am the service responsible for inspecting objects.
  733. The default inspector object is the transcript.!
  734. !Inspector class methodsFor: 'inspecting'!
  735. inspect: anObject
  736. ^ self current inspect: anObject
  737. ! !
  738. Service subclass: #ProgressHandler
  739. instanceVariableNames: ''
  740. package: 'Kernel-Infrastructure'!
  741. !ProgressHandler commentStamp!
  742. I am used to manage progress in collection iterations, see `SequenceableCollection >> #do:displayingProgress:`.
  743. Registered instances must implement `#do:on:displaying:`.
  744. The default behavior is to simply iterate over the collection, using `NullProgressHandler`.!
  745. !ProgressHandler class methodsFor: 'progress handling'!
  746. do: aBlock on: aCollection displaying: aString
  747. self current do: aBlock on: aCollection displaying: aString
  748. ! !
  749. Service subclass: #Transcript
  750. instanceVariableNames: ''
  751. package: 'Kernel-Infrastructure'!
  752. !Transcript commentStamp!
  753. I am a facade for Transcript actions.
  754. I delegate actions to the currently registered transcript.
  755. ## API
  756. Transcript
  757. show: 'hello world';
  758. cr;
  759. show: anObject.!
  760. !Transcript class methodsFor: 'instance creation'!
  761. open
  762. self current open
  763. ! !
  764. !Transcript class methodsFor: 'printing'!
  765. clear
  766. self current clear
  767. !
  768. cr
  769. self current show: String cr
  770. !
  771. inspect: anObject
  772. self show: anObject
  773. !
  774. show: anObject
  775. self current show: anObject
  776. ! !
  777. Object subclass: #Setting
  778. instanceVariableNames: 'key value defaultValue'
  779. package: 'Kernel-Infrastructure'!
  780. !Setting commentStamp!
  781. I represent a setting accessible via `Smalltalk settings`.
  782. ## API
  783. A `Setting` value can be read using `value` and set using `value:`.
  784. Settings are accessed with `'key' asSetting` or `'key' asSettingIfAbsent: 'defaultValue'`.!
  785. !Setting methodsFor: 'accessing'!
  786. defaultValue
  787. ^ defaultValue
  788. !
  789. defaultValue: anObject
  790. defaultValue := anObject
  791. !
  792. key
  793. ^ key
  794. !
  795. key: anObject
  796. key := anObject
  797. !
  798. value
  799. ^ Smalltalk settings at: self key ifAbsent: [ self defaultValue ]
  800. !
  801. value: aString
  802. ^ Smalltalk settings at: self key put: aString
  803. ! !
  804. !Setting class methodsFor: 'instance creation'!
  805. at: aString ifAbsent: anotherString
  806. ^ super new
  807. key: aString;
  808. defaultValue: anotherString;
  809. yourself
  810. !
  811. new
  812. self shouldNotImplement
  813. ! !
  814. Object subclass: #SmalltalkImage
  815. instanceVariableNames: ''
  816. package: 'Kernel-Infrastructure'!
  817. !SmalltalkImage commentStamp!
  818. I represent the Smalltalk system, wrapping
  819. operations of variable `smalltalk` declared in `support/boot.js`.
  820. ## API
  821. I have only one instance, accessed with global variable `Smalltalk`.
  822. The `smalltalk` object holds all class and packages defined in the system.
  823. ## Classes
  824. Classes can be accessed using the following methods:
  825. - `#classes` answers the full list of Smalltalk classes in the system
  826. - `#at:` answers a specific class or `nil`
  827. ## Packages
  828. Packages can be accessed using the following methods:
  829. - `#packages` answers the full list of packages
  830. - `#packageAt:` answers a specific package or `nil`
  831. ## Parsing
  832. The `#parse:` method is used to parse Amber source code.
  833. It requires the `Compiler` package and the `support/parser.js` parser file in order to work.!
  834. !SmalltalkImage methodsFor: 'accessing'!
  835. at: aString
  836. self deprecatedAPI.
  837. ^ self globals at: aString
  838. !
  839. at: aKey ifAbsent: aBlock
  840. ^ (self includesKey: aKey)
  841. ifTrue: [ self at: aKey ]
  842. ifFalse: [ aBlock value ]
  843. !
  844. at: aString put: anObject
  845. self deprecatedAPI.
  846. ^ self globals at: aString put: anObject
  847. !
  848. current
  849. "Backward compatibility for Smalltalk current ..."
  850. self deprecatedAPI.
  851. ^ self
  852. !
  853. globals
  854. "Future compatibility to be able to use Smalltalk globals at: ..."
  855. <return globals>
  856. !
  857. includesKey: aKey
  858. <return smalltalk.hasOwnProperty(aKey)>
  859. !
  860. parse: aString
  861. | result |
  862. [ result := self basicParse: aString ]
  863. tryCatch: [ :ex | (self parseError: ex parsing: aString) signal ].
  864. ^ result
  865. source: aString;
  866. yourself
  867. !
  868. pseudoVariableNames
  869. ^ #('self' 'super' 'nil' 'true' 'false' 'thisContext')
  870. !
  871. readJSObject: anObject
  872. <return smalltalk.readJSObject(anObject)>
  873. !
  874. reservedWords
  875. "JavaScript reserved words"
  876. <return smalltalk.reservedWords>
  877. !
  878. settings
  879. ^ SmalltalkSettings
  880. !
  881. version
  882. "Answer the version string of Amber"
  883. ^ '0.13.0-pre'
  884. !
  885. vm
  886. "Future compatibility to be able to use Smalltalk vm ..."
  887. <return smalltalk>
  888. ! !
  889. !SmalltalkImage methodsFor: 'accessing amd'!
  890. amdRequire
  891. ^ self vm at: 'amdRequire'
  892. !
  893. defaultAmdNamespace
  894. ^ 'transport.defaultAmdNamespace' settingValue
  895. !
  896. defaultAmdNamespace: aString
  897. 'transport.defaultAmdNamespace' settingValue: aString
  898. ! !
  899. !SmalltalkImage methodsFor: 'classes'!
  900. classes
  901. <return smalltalk.classes()>
  902. !
  903. removeClass: aClass
  904. aClass isMetaclass ifTrue: [ self error: aClass asString, ' is a Metaclass and cannot be removed!!' ].
  905. self deleteClass: aClass.
  906. SystemAnnouncer current
  907. announce: (ClassRemoved new
  908. theClass: aClass;
  909. yourself)
  910. ! !
  911. !SmalltalkImage methodsFor: 'error handling'!
  912. asSmalltalkException: anObject
  913. "A JavaScript exception may be thrown.
  914. We then need to convert it back to a Smalltalk object"
  915. ^ ((self isSmalltalkObject: anObject) and: [ anObject isKindOf: Error ])
  916. ifTrue: [ anObject ]
  917. ifFalse: [ JavaScriptException on: anObject ]
  918. !
  919. parseError: anException parsing: aString
  920. ^ ParseError new messageText: 'Parse error on line ', (anException basicAt: 'line') ,' column ' , (anException basicAt: 'column') ,' : Unexpected character ', (anException basicAt: 'found')
  921. ! !
  922. !SmalltalkImage methodsFor: 'globals'!
  923. addGlobalJsVariable: aString
  924. self globalJsVariables add: aString
  925. !
  926. deleteGlobalJsVariable: aString
  927. self globalJsVariables remove: aString ifAbsent:[]
  928. !
  929. globalJsVariables
  930. "Array of global JavaScript variables"
  931. <return smalltalk.globalJsVariables>
  932. ! !
  933. !SmalltalkImage methodsFor: 'packages'!
  934. createPackage: packageName
  935. | package announcement |
  936. package := self basicCreatePackage: packageName.
  937. announcement := PackageAdded new
  938. package: package;
  939. yourself.
  940. SystemAnnouncer current announce: announcement.
  941. ^ package
  942. !
  943. packageAt: packageName
  944. <return smalltalk.packages[packageName]>
  945. !
  946. packageAt: packageName ifAbsent: aBlock
  947. ^ (self packageAt: packageName) ifNil: aBlock
  948. !
  949. packages
  950. "Return all Package instances in the system."
  951. <
  952. return Object.keys(smalltalk.packages).map(function(k) {
  953. return smalltalk.packages[k];
  954. })
  955. >
  956. !
  957. removePackage: packageName
  958. "Removes a package and all its classes."
  959. | pkg |
  960. pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
  961. pkg classes do: [ :each |
  962. self removeClass: each ].
  963. self deletePackage: packageName
  964. !
  965. renamePackage: packageName to: newName
  966. "Rename a package."
  967. | pkg |
  968. pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
  969. (self packageAt: newName) ifNotNil: [ self error: 'Already exists a package called: ', newName ].
  970. (self at: 'packages') at: newName put: pkg.
  971. pkg name: newName.
  972. self deletePackage: packageName.
  973. ! !
  974. !SmalltalkImage methodsFor: 'private'!
  975. basicCreatePackage: packageName
  976. "Create and bind a new bare package with given name and return it."
  977. <return smalltalk.addPackage(packageName)>
  978. !
  979. basicParse: aString
  980. ^ SmalltalkParser parse: aString
  981. !
  982. createPackage: packageName properties: aDict
  983. "Needed to import .st files: they begin with this call."
  984. self deprecatedAPI.
  985. aDict isEmpty ifFalse: [ self error: 'createPackage:properties: called with nonempty properties' ].
  986. ^ self createPackage: packageName
  987. !
  988. deleteClass: aClass
  989. "Deletes a class by deleting its binding only. Use #removeClass instead"
  990. <smalltalk.removeClass(aClass)>
  991. !
  992. deletePackage: packageName
  993. "Deletes a package by deleting its binding, but does not check if it contains classes etc.
  994. To remove a package, use #removePackage instead."
  995. <delete smalltalk.packages[packageName]>
  996. ! !
  997. !SmalltalkImage methodsFor: 'testing'!
  998. isSmalltalkObject: anObject
  999. "Consider anObject a Smalltalk object if it has a 'klass' property.
  1000. Note that this may be unaccurate"
  1001. <return typeof anObject.klass !!== 'undefined'>
  1002. ! !
  1003. SmalltalkImage class instanceVariableNames: 'current'!
  1004. !SmalltalkImage class methodsFor: 'initialization'!
  1005. initialize
  1006. globals at: 'Smalltalk' put: self current
  1007. ! !
  1008. !SmalltalkImage class methodsFor: 'instance creation'!
  1009. current
  1010. ^ current ifNil: [ current := super new ] ifNotNil: [ self deprecatedAPI. current ]
  1011. !
  1012. new
  1013. self shouldNotImplement
  1014. ! !
  1015. !SequenceableCollection methodsFor: '*Kernel-Infrastructure'!
  1016. do: aBlock displayingProgress: aString
  1017. ProgressHandler
  1018. do: aBlock
  1019. on: self
  1020. displaying: aString
  1021. ! !
  1022. !String methodsFor: '*Kernel-Infrastructure'!
  1023. asJavaScriptSelector
  1024. "Return first keyword of the selector, without trailing colon."
  1025. ^ self replace: '^([a-zA-Z0-9]*).*$' with: '$1'
  1026. !
  1027. asSetting
  1028. ^ Setting at: self ifAbsent: nil
  1029. !
  1030. asSettingIfAbsent: aString
  1031. ^ Setting at: self ifAbsent: aString
  1032. !
  1033. settingValue
  1034. ^ self asSetting value
  1035. !
  1036. settingValue: aString
  1037. ^ self asSetting value: aString
  1038. !
  1039. settingValueIfAbsent: aString
  1040. ^ (self asSettingIfAbsent: aString) value
  1041. ! !