1
0

Kernel-Classes.st 18 KB

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