2
0

Kernel-Classes.st 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868
  1. Smalltalk current createPackage: 'Kernel-Classes'!
  2. Object subclass: #Behavior
  3. instanceVariableNames: ''
  4. package: 'Kernel-Classes'!
  5. !Behavior commentStamp!
  6. I am the superclass of all class objects.
  7. I define the protocol for creating instances of a class with `#basicNew` and `#new` (see `boot.js` for class constructors details).
  8. My instances know about the subclass/superclass relationships between classes, contain the description that instances are created from,
  9. and hold the method dictionary that's associated with each class.
  10. I also provides methods for compiling methods, examining the method dictionary, and iterating over the class hierarchy.!
  11. !Behavior methodsFor: 'accessing'!
  12. >> aString
  13. ^ self methodAt: aString
  14. !
  15. allInstanceVariableNames
  16. | result |
  17. result := self instanceVariableNames copy.
  18. self superclass ifNotNil: [
  19. result addAll: self superclass allInstanceVariableNames ].
  20. ^ result
  21. !
  22. allSelectors
  23. ^ self allSuperclasses
  24. inject: self selectors
  25. into: [ :acc :each | acc addAll: each selectors; yourself ]
  26. !
  27. allSubclasses
  28. "Answer an collection of the receiver's and the receiver's descendent's subclasses. "
  29. | subclasses index |
  30. subclasses := self subclasses.
  31. index := 1.
  32. [ index > subclasses size ]
  33. whileFalse: [ subclasses addAll: (subclasses at: index) subclasses.
  34. index := index + 1 ].
  35. ^ subclasses
  36. !
  37. allSuperclasses
  38. self superclass ifNil: [ ^ #() ].
  39. ^ (OrderedCollection with: self superclass)
  40. addAll: self superclass allSuperclasses;
  41. yourself
  42. !
  43. comment
  44. ^ (self basicAt: 'comment') ifNil: [ '' ]
  45. !
  46. comment: aString
  47. self basicAt: 'comment' put: aString.
  48. SystemAnnouncer current
  49. announce: (ClassCommentChanged new
  50. theClass: self;
  51. yourself)
  52. !
  53. commentStamp
  54. ^ ClassCommentReader new
  55. class: self;
  56. yourself
  57. !
  58. commentStamp: aStamp prior: prior
  59. ^ self commentStamp
  60. !
  61. definition
  62. ^ ''
  63. !
  64. instanceVariableNames
  65. <return self.iVarNames>
  66. !
  67. javascriptConstructor
  68. "Answer the JS constructor used to instantiate. See boot.js"
  69. <return self.fn>
  70. !
  71. javascriptConstructor: aJavaScriptFunction
  72. "Set the JS constructor used to instantiate.
  73. See the JS counter-part in boot.js `smalltalk.setClassConstructor'"
  74. <smalltalk.setClassConstructor(self, aJavaScriptFunction);>
  75. !
  76. lookupSelector: selector
  77. "Look up the given selector in my methodDictionary.
  78. Return the corresponding method if found.
  79. Otherwise chase the superclass chain and try again.
  80. Return nil if no method is found."
  81. | lookupClass |
  82. lookupClass := self.
  83. [ lookupClass = nil ] whileFalse: [
  84. (lookupClass includesSelector: selector)
  85. ifTrue: [ ^ lookupClass methodAt: selector ].
  86. lookupClass := lookupClass superclass ].
  87. ^ nil
  88. !
  89. methodAt: aString
  90. ^ self methodDictionary at: aString
  91. !
  92. methodDictionary
  93. <var dict = smalltalk.HashedCollection._new();
  94. var methods = self.methods;
  95. Object.keys(methods).forEach(function(i) {
  96. if(methods[i].selector) {
  97. dict._at_put_(methods[i].selector, methods[i]);
  98. }
  99. });
  100. return dict>
  101. !
  102. methods
  103. ^ self methodDictionary values
  104. !
  105. methodsFor: aString
  106. ^ ClassCategoryReader new
  107. class: self category: aString;
  108. yourself
  109. !
  110. methodsFor: aString stamp: aStamp
  111. "Added for compatibility, right now ignores stamp."
  112. ^ self methodsFor: aString
  113. !
  114. methodsInProtocol: aString
  115. ^ self methodDictionary values select: [ :each | each protocol = aString ]
  116. !
  117. name
  118. <return self.className || nil>
  119. !
  120. organization
  121. ^ self basicAt: 'organization'
  122. !
  123. ownMethods
  124. "Answer the methods of the receiver that are not package extensions"
  125. ^ (self ownProtocols
  126. inject: OrderedCollection new
  127. into: [ :acc :each | acc, (self methodsInProtocol: each) ])
  128. sorted: [ :a :b | a selector <= b selector ]
  129. !
  130. ownProtocols
  131. "Answer the protocols of the receiver that are not package extensions"
  132. ^ self protocols reject: [ :each |
  133. each match: '^\*' ]
  134. !
  135. protocols
  136. ^ self organization elements sorted
  137. !
  138. prototype
  139. <return self.fn.prototype>
  140. !
  141. selectors
  142. ^ self methodDictionary keys
  143. !
  144. subclasses
  145. self subclassResponsibility
  146. !
  147. superclass
  148. <return self.superclass || nil>
  149. !
  150. theMetaClass
  151. ^ self class
  152. !
  153. theNonMetaClass
  154. ^ self
  155. !
  156. withAllSubclasses
  157. ^ (Array with: self) addAll: self allSubclasses; yourself
  158. ! !
  159. !Behavior methodsFor: 'compiling'!
  160. addCompiledMethod: aMethod
  161. | oldMethod announcement |
  162. oldMethod := self methodDictionary
  163. at: aMethod selector
  164. ifAbsent: [ nil ].
  165. (self protocols includes: aMethod protocol)
  166. ifFalse: [ self organization addElement: aMethod protocol ].
  167. self basicAddCompiledMethod: aMethod.
  168. oldMethod ifNotNil: [
  169. (self methods
  170. select: [ :each | each protocol = oldMethod protocol ])
  171. ifEmpty: [ self organization removeElement: oldMethod protocol ] ].
  172. announcement := oldMethod
  173. ifNil: [
  174. MethodAdded new
  175. method: aMethod;
  176. yourself ]
  177. ifNotNil: [
  178. MethodModified new
  179. oldMethod: oldMethod;
  180. method: aMethod;
  181. yourself ].
  182. SystemAnnouncer current
  183. announce: announcement
  184. !
  185. compile: aString
  186. ^ self compile: aString category: ''
  187. !
  188. compile: aString category: anotherString
  189. ^ Compiler new
  190. install: aString
  191. forClass: self
  192. category: anotherString
  193. !
  194. recompile
  195. ^ Compiler new recompile: self
  196. !
  197. removeCompiledMethod: aMethod
  198. self basicRemoveCompiledMethod: aMethod.
  199. self methods
  200. detect: [ :each | each protocol = aMethod protocol ]
  201. ifNone: [ self organization removeElement: aMethod protocol ].
  202. SystemAnnouncer current
  203. announce: (MethodRemoved new
  204. method: aMethod;
  205. yourself)
  206. ! !
  207. !Behavior methodsFor: 'enumerating'!
  208. allSubclassesDo: aBlock
  209. "Evaluate the argument, aBlock, for each of the receiver's subclasses."
  210. self allSubclasses do: [ :each |
  211. aBlock value: each ]
  212. !
  213. protocolsDo: aBlock
  214. "Execute aBlock for each method category with
  215. its collection of methods in the sort order of category name."
  216. | methodsByCategory |
  217. methodsByCategory := HashedCollection new.
  218. self methodDictionary values do: [ :m |
  219. (methodsByCategory at: m category ifAbsentPut: [ Array new ])
  220. add: m ].
  221. self protocols do: [ :category |
  222. aBlock value: category value: (methodsByCategory at: category) ]
  223. ! !
  224. !Behavior methodsFor: 'instance creation'!
  225. basicNew
  226. <return new self.fn()>
  227. !
  228. new
  229. ^ self basicNew initialize
  230. ! !
  231. !Behavior methodsFor: 'private'!
  232. basicAddCompiledMethod: aMethod
  233. <smalltalk.addMethod(aMethod, self)>
  234. !
  235. basicRemoveCompiledMethod: aMethod
  236. <smalltalk.removeMethod(aMethod,self)>
  237. ! !
  238. !Behavior methodsFor: 'testing'!
  239. canUnderstand: aSelector
  240. ^ (self methodDictionary keys includes: aSelector asString) or: [
  241. self superclass notNil and: [ self superclass canUnderstand: aSelector ]]
  242. !
  243. includesBehavior: aClass
  244. ^ self == aClass or: [
  245. self inheritsFrom: aClass ]
  246. !
  247. includesSelector: aString
  248. ^ self methodDictionary includesKey: aString
  249. !
  250. inheritsFrom: aClass
  251. self superclass ifNil: [ ^ false ].
  252. ^ aClass == self superclass or: [
  253. self superclass inheritsFrom: aClass ]
  254. !
  255. isBehavior
  256. ^ true
  257. ! !
  258. Behavior subclass: #Class
  259. instanceVariableNames: ''
  260. package: 'Kernel-Classes'!
  261. !Class commentStamp!
  262. I am __the__ class object.
  263. My instances are the classes of the system.
  264. Class creation is done throught a `ClassBuilder` instance.!
  265. !Class methodsFor: 'accessing'!
  266. category
  267. ^ self package ifNil: [ 'Unclassified' ] ifNotNil: [ self package name ]
  268. !
  269. definition
  270. ^ String streamContents: [ :stream |
  271. stream
  272. nextPutAll: self superclass asString;
  273. nextPutAll: ' subclass: #';
  274. nextPutAll: self name;
  275. nextPutAll: String lf, String tab;
  276. nextPutAll: 'instanceVariableNames: '''.
  277. self instanceVariableNames
  278. do: [ :each | stream nextPutAll: each ]
  279. separatedBy: [ stream nextPutAll: ' ' ].
  280. stream
  281. nextPutAll: '''', String lf, String tab;
  282. nextPutAll: 'package: ''';
  283. nextPutAll: self category;
  284. nextPutAll: '''' ]
  285. !
  286. package
  287. ^ self basicAt: 'pkg'
  288. !
  289. package: aPackage
  290. | oldPackage |
  291. self package = aPackage ifTrue: [ ^ self ].
  292. oldPackage := self package.
  293. self basicAt: 'pkg' put: aPackage.
  294. oldPackage organization removeElement: self.
  295. aPackage organization addElement: self.
  296. SystemAnnouncer current announce: (ClassMoved new
  297. theClass: self;
  298. oldPackage: oldPackage;
  299. yourself)
  300. !
  301. rename: aString
  302. ClassBuilder new renameClass: self to: aString
  303. !
  304. subclasses
  305. <return self.subclasses._copy()>
  306. ! !
  307. !Class methodsFor: 'class creation'!
  308. subclass: aString instanceVariableNames: anotherString
  309. "Kept for compatibility."
  310. ^ self subclass: aString instanceVariableNames: anotherString package: nil
  311. !
  312. subclass: aString instanceVariableNames: aString2 category: aString3
  313. "Kept for compatibility."
  314. self deprecatedAPI.
  315. ^ self subclass: aString instanceVariableNames: aString2 package: aString3
  316. !
  317. subclass: aString instanceVariableNames: aString2 classVariableNames: classVars poolDictionaries: pools category: aString3
  318. "Just ignore class variables and pools. Added for compatibility."
  319. ^ self subclass: aString instanceVariableNames: aString2 package: aString3
  320. !
  321. subclass: aString instanceVariableNames: aString2 package: aString3
  322. ^ ClassBuilder new
  323. superclass: self subclass: aString asString instanceVariableNames: aString2 package: aString3
  324. ! !
  325. !Class methodsFor: 'converting'!
  326. asJavascript
  327. ^ 'smalltalk.', self name
  328. ! !
  329. !Class methodsFor: 'printing'!
  330. printOn: aStream
  331. aStream nextPutAll: self name
  332. ! !
  333. !Class methodsFor: 'testing'!
  334. isClass
  335. ^ true
  336. ! !
  337. Behavior subclass: #Metaclass
  338. instanceVariableNames: ''
  339. package: 'Kernel-Classes'!
  340. !Metaclass commentStamp!
  341. I am the root of the class hierarchy.
  342. My instances are metaclasses, one for each real class, and have a single instance, which they hold onto: the class that they are the metaclass of.!
  343. !Metaclass methodsFor: 'accessing'!
  344. definition
  345. ^ String streamContents: [ :stream |
  346. stream
  347. nextPutAll: self asString;
  348. nextPutAll: ' instanceVariableNames: '''.
  349. self instanceVariableNames
  350. do: [ :each | stream nextPutAll: each ]
  351. separatedBy: [ stream nextPutAll: ' ' ].
  352. stream nextPutAll: '''' ]
  353. !
  354. instanceClass
  355. <return self.instanceClass>
  356. !
  357. instanceVariableNames: aCollection
  358. ClassBuilder new
  359. class: self instanceVariableNames: aCollection
  360. !
  361. subclasses
  362. ^ (self instanceClass subclasses
  363. select: [ :each | each isMetaclass not ])
  364. collect: [ :each | each theMetaClass ]
  365. !
  366. theMetaClass
  367. ^ self
  368. !
  369. theNonMetaClass
  370. ^ self instanceClass
  371. ! !
  372. !Metaclass methodsFor: 'converting'!
  373. asJavascript
  374. ^ 'smalltalk.', self instanceClass name, '.klass'
  375. ! !
  376. !Metaclass methodsFor: 'printing'!
  377. printOn: aStream
  378. aStream
  379. nextPutAll: self instanceClass name;
  380. nextPutAll: ' class'
  381. ! !
  382. !Metaclass methodsFor: 'testing'!
  383. isMetaclass
  384. ^ true
  385. ! !
  386. Object subclass: #ClassBuilder
  387. instanceVariableNames: ''
  388. package: 'Kernel-Classes'!
  389. !ClassBuilder commentStamp!
  390. I am responsible for compiling new classes or modifying existing classes in the system.
  391. Rather than using me directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
  392. !ClassBuilder methodsFor: 'accessing'!
  393. instanceVariableNamesFor: aString
  394. ^ (aString tokenize: ' ') reject: [ :each | each isEmpty ]
  395. ! !
  396. !ClassBuilder methodsFor: 'class definition'!
  397. addSubclassOf: aClass named: className instanceVariableNames: aCollection package: packageName
  398. | theClass thePackage |
  399. theClass := Smalltalk current at: className.
  400. thePackage := self createPackageNamed: packageName.
  401. theClass ifNotNil: [
  402. theClass package: thePackage.
  403. theClass superclass == aClass ifFalse: [
  404. ^ self
  405. migrateClassNamed: className
  406. superclass: aClass
  407. instanceVariableNames: aCollection
  408. package: packageName ] ].
  409. ^ self
  410. basicAddSubclassOf: aClass
  411. named: className
  412. instanceVariableNames: aCollection
  413. package: packageName
  414. !
  415. class: aClass instanceVariableNames: ivarNames
  416. self basicClass: aClass instanceVariableNames: ivarNames.
  417. self setupClass: aClass.
  418. SystemAnnouncer current
  419. announce: (ClassDefinitionChanged new
  420. theClass: aClass;
  421. yourself)
  422. !
  423. superclass: aClass subclass: className
  424. ^ self superclass: aClass subclass: className instanceVariableNames: '' package: nil
  425. !
  426. superclass: aClass subclass: className instanceVariableNames: ivarNames package: packageName
  427. | newClass |
  428. newClass := self addSubclassOf: aClass
  429. named: className instanceVariableNames: (self instanceVariableNamesFor: ivarNames)
  430. package: (packageName ifNil: [ 'unclassified' ]).
  431. self setupClass: newClass.
  432. SystemAnnouncer current
  433. announce: (ClassAdded new
  434. theClass: newClass;
  435. yourself).
  436. ^ newClass
  437. ! !
  438. !ClassBuilder methodsFor: 'class migration'!
  439. migrateClass: aClass superclass: anotherClass
  440. ^ self
  441. migrateClassNamed: aClass name
  442. superclass: anotherClass
  443. instanceVariableNames: aClass instanceVariableNames
  444. package: aClass package name
  445. !
  446. migrateClassNamed: className superclass: aClass instanceVariableNames: aCollection package: packageName
  447. | oldClass newClass tmp |
  448. tmp := 'new*', className.
  449. oldClass := Smalltalk current at: className.
  450. newClass := self
  451. addSubclassOf: aClass
  452. named: tmp
  453. instanceVariableNames: aCollection
  454. package: packageName.
  455. self basicSwapClassNames: oldClass with: newClass.
  456. [ self copyClass: oldClass to: newClass ]
  457. on: Error
  458. do: [ :exception |
  459. self
  460. basicSwapClassNames: oldClass with: newClass;
  461. basicRemoveClass: newClass.
  462. exception signal ].
  463. self
  464. rawRenameClass: oldClass to: tmp;
  465. rawRenameClass: newClass to: className.
  466. oldClass subclasses
  467. do: [ :each | self migrateClass: each superclass: newClass ]
  468. displayingProgress: 'Recompiling ', newClass name, '...'.
  469. self basicRemoveClass: oldClass.
  470. SystemAnnouncer current announce: (ClassMigrated new
  471. theClass: newClass;
  472. oldClass: oldClass;
  473. yourself).
  474. ^ newClass
  475. !
  476. renameClass: aClass to: className
  477. self basicRenameClass: aClass to: className.
  478. "Recompile the class to fix potential issues with super sends"
  479. aClass recompile.
  480. SystemAnnouncer current
  481. announce: (ClassRenamed new
  482. theClass: aClass;
  483. yourself)
  484. ! !
  485. !ClassBuilder methodsFor: 'copying'!
  486. copyClass: aClass named: className
  487. | newClass |
  488. newClass := self
  489. addSubclassOf: aClass superclass
  490. named: className
  491. instanceVariableNames: aClass instanceVariableNames
  492. package: aClass package name.
  493. self copyClass: aClass to: newClass.
  494. SystemAnnouncer current
  495. announce: (ClassAdded new
  496. theClass: newClass;
  497. yourself).
  498. ^ newClass
  499. !
  500. copyClass: aClass to: anotherClass
  501. anotherClass comment: aClass comment.
  502. aClass methodDictionary values do: [ :each |
  503. Compiler new install: each source forClass: anotherClass category: each category ].
  504. self basicClass: anotherClass class instanceVariables: aClass class instanceVariableNames.
  505. aClass class methodDictionary values do: [ :each |
  506. Compiler new install: each source forClass: anotherClass class category: each category ].
  507. self setupClass: anotherClass
  508. ! !
  509. !ClassBuilder methodsFor: 'method definition'!
  510. installMethod: aCompiledMethod forClass: aBehavior category: aString
  511. aCompiledMethod category: aString.
  512. aBehavior addCompiledMethod: aCompiledMethod.
  513. self setupClass: aBehavior.
  514. ^ aCompiledMethod
  515. ! !
  516. !ClassBuilder methodsFor: 'private'!
  517. basicAddSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  518. <
  519. smalltalk.addClass(aString, aClass, aCollection, packageName);
  520. return smalltalk[aString]
  521. >
  522. !
  523. basicClass: aClass instanceVariableNames: aString
  524. self basicClass: aClass instanceVariables: (self instanceVariableNamesFor: aString)
  525. !
  526. basicClass: aClass instanceVariables: aCollection
  527. aClass isMetaclass ifFalse: [ self error: aClass name, ' is not a metaclass' ].
  528. aClass basicAt: 'iVarNames' put: aCollection
  529. !
  530. basicRemoveClass: aClass
  531. <smalltalk.removeClass(aClass)>
  532. !
  533. basicRenameClass: aClass to: aString
  534. <
  535. smalltalk[aString] = aClass;
  536. delete smalltalk[aClass.className];
  537. aClass.className = aString;
  538. >
  539. !
  540. basicSwapClassNames: aClass with: anotherClass
  541. <
  542. var tmp = aClass.className;
  543. aClass.className = anotherClass.className;
  544. anotherClass.className = tmp;
  545. >
  546. !
  547. createPackageNamed: aString
  548. ^ Package named: aString ifAbsent: [
  549. Smalltalk current createPackage: aString ]
  550. !
  551. rawRenameClass: aClass to: aString
  552. <
  553. smalltalk[aString] = aClass;
  554. >
  555. ! !
  556. !ClassBuilder methodsFor: 'public'!
  557. setupClass: aClass
  558. <smalltalk.init(aClass);>
  559. ! !
  560. Object subclass: #ClassCategoryReader
  561. instanceVariableNames: 'class category'
  562. package: 'Kernel-Classes'!
  563. !ClassCategoryReader commentStamp!
  564. I provide a mechanism for retrieving class descriptions stored on a file in the Smalltalk chunk format.!
  565. !ClassCategoryReader methodsFor: 'accessing'!
  566. class: aClass category: aString
  567. class := aClass.
  568. category := aString
  569. ! !
  570. !ClassCategoryReader methodsFor: 'fileIn'!
  571. scanFrom: aChunkParser
  572. | chunk |
  573. [ chunk := aChunkParser nextChunk.
  574. chunk isEmpty ] whileFalse: [
  575. self compileMethod: chunk ].
  576. ClassBuilder new setupClass: class
  577. ! !
  578. !ClassCategoryReader methodsFor: 'initialization'!
  579. initialize
  580. super initialize.
  581. ! !
  582. !ClassCategoryReader methodsFor: 'private'!
  583. compileMethod: aString
  584. Compiler new install: aString forClass: class category: category
  585. ! !
  586. Object subclass: #ClassCommentReader
  587. instanceVariableNames: 'class'
  588. package: 'Kernel-Classes'!
  589. !ClassCommentReader commentStamp!
  590. I provide a mechanism for retrieving class comments stored on a file.
  591. See also `ClassCategoryReader`.!
  592. !ClassCommentReader methodsFor: 'accessing'!
  593. class: aClass
  594. class := aClass
  595. ! !
  596. !ClassCommentReader methodsFor: 'fileIn'!
  597. scanFrom: aChunkParser
  598. | chunk |
  599. chunk := aChunkParser nextChunk.
  600. chunk isEmpty ifFalse: [
  601. self setComment: chunk ].
  602. ! !
  603. !ClassCommentReader methodsFor: 'initialization'!
  604. initialize
  605. super initialize.
  606. ! !
  607. !ClassCommentReader methodsFor: 'private'!
  608. setComment: aString
  609. class comment: aString
  610. ! !
  611. Object subclass: #ClassSorterNode
  612. instanceVariableNames: 'theClass level nodes'
  613. package: 'Kernel-Classes'!
  614. !ClassSorterNode commentStamp!
  615. I provide an algorithm for sorting classes alphabetically.
  616. See [Issue #143](https://github.com/amber-smalltalk/amber/issues/143) on GitHub.!
  617. !ClassSorterNode methodsFor: 'accessing'!
  618. getNodesFrom: aCollection
  619. | children others |
  620. children := #().
  621. others := #().
  622. aCollection do: [ :each |
  623. (each superclass = self theClass)
  624. ifTrue: [ children add: each ]
  625. ifFalse: [ others add: each ]].
  626. nodes:= children collect: [ :each |
  627. ClassSorterNode on: each classes: others level: self level + 1 ]
  628. !
  629. level
  630. ^ level
  631. !
  632. level: anInteger
  633. level := anInteger
  634. !
  635. nodes
  636. ^ nodes
  637. !
  638. theClass
  639. ^ theClass
  640. !
  641. theClass: aClass
  642. theClass := aClass
  643. ! !
  644. !ClassSorterNode methodsFor: 'visiting'!
  645. traverseClassesWith: aCollection
  646. "sort classes alphabetically Issue #143"
  647. aCollection add: self theClass.
  648. (self nodes sorted: [ :a :b | a theClass name <= b theClass name ]) do: [ :aNode |
  649. aNode traverseClassesWith: aCollection ].
  650. ! !
  651. !ClassSorterNode class methodsFor: 'instance creation'!
  652. on: aClass classes: aCollection level: anInteger
  653. ^ self new
  654. theClass: aClass;
  655. level: anInteger;
  656. getNodesFrom: aCollection;
  657. yourself
  658. ! !