1
0

Kernel-Classes.st 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467
  1. Smalltalk current createPackage: 'Kernel-Classes' properties: #{}!
  2. Object subclass: #Behavior
  3. instanceVariableNames: ''
  4. package: 'Kernel-Classes'!
  5. !Behavior commentStamp!
  6. Behavior is the superclass of all class objects.
  7. It defines the protocol for creating instances of a class with `#basicNew` and `#new` (see `boot.js` for class constructors details).
  8. 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. Behavior also provides methods for compiling methods, examining the method dictionary, and iterating over the class hierarchy.!
  11. !Behavior methodsFor: 'accessing'!
  12. allInstanceVariableNames
  13. | result |
  14. result := self instanceVariableNames copy.
  15. self superclass ifNotNil: [
  16. result addAll: self superclass allInstanceVariableNames].
  17. ^result
  18. !
  19. allSubclasses
  20. | result |
  21. result := self subclasses.
  22. self subclasses do: [:each |
  23. result addAll: each allSubclasses].
  24. ^result
  25. !
  26. comment
  27. ^(self basicAt: 'comment') ifNil: ['']
  28. !
  29. comment: aString
  30. self basicAt: 'comment' put: aString
  31. !
  32. commentStamp
  33. ^ClassCommentReader new
  34. class: self;
  35. yourself
  36. !
  37. commentStamp: aStamp prior: prior
  38. ^self commentStamp
  39. !
  40. instanceVariableNames
  41. <return self.iVarNames>
  42. !
  43. methodAt: aString
  44. <return smalltalk.methods(self)[aString]>
  45. !
  46. methodDictionary
  47. <var dict = smalltalk.HashedCollection._new();
  48. var methods = self.fn.prototype.methods;
  49. for(var i in methods) {
  50. if(methods[i].selector) {
  51. dict._at_put_(methods[i].selector, methods[i]);
  52. }
  53. };
  54. return dict>
  55. !
  56. methodsFor: aString
  57. ^ClassCategoryReader new
  58. class: self category: aString;
  59. yourself
  60. !
  61. methodsFor: aString stamp: aStamp
  62. "Added for compatibility, right now ignores stamp."
  63. ^self methodsFor: aString
  64. !
  65. name
  66. <return self.className || nil>
  67. !
  68. protocols
  69. | protocols |
  70. protocols := Array new.
  71. self methodDictionary do: [:each |
  72. (protocols includes: each category) ifFalse: [
  73. protocols add: each category]].
  74. ^protocols sort
  75. !
  76. protocolsDo: aBlock
  77. "Execute aBlock for each method category with
  78. its collection of methods in the sort order of category name."
  79. | methodsByCategory |
  80. methodsByCategory := HashedCollection new.
  81. self methodDictionary values do: [:m |
  82. (methodsByCategory at: m category ifAbsentPut: [Array new])
  83. add: m].
  84. self protocols do: [:category |
  85. aBlock value: category value: (methodsByCategory at: category)]
  86. !
  87. prototype
  88. <return self.fn.prototype>
  89. !
  90. subclasses
  91. <return smalltalk.subclasses(self)>
  92. !
  93. superclass
  94. <return self.superclass || nil>
  95. !
  96. withAllSubclasses
  97. ^(Array with: self) addAll: self allSubclasses; yourself
  98. ! !
  99. !Behavior methodsFor: 'compiling'!
  100. addCompiledMethod: aMethod
  101. <smalltalk.addMethod(aMethod.selector._asSelector(), aMethod, self)>
  102. !
  103. compile: aString
  104. self compile: aString category: ''
  105. !
  106. compile: aString category: anotherString
  107. | method |
  108. method := Compiler new load: aString forClass: self.
  109. method category: anotherString.
  110. self addCompiledMethod: method
  111. !
  112. removeCompiledMethod: aMethod
  113. <delete self.fn.prototype[aMethod.selector._asSelector()];
  114. delete self.fn.prototype.methods[aMethod.selector];
  115. smalltalk.init(self);>
  116. ! !
  117. !Behavior methodsFor: 'instance creation'!
  118. basicNew
  119. <return new self.fn()>
  120. !
  121. new
  122. ^self basicNew initialize
  123. ! !
  124. !Behavior methodsFor: 'testing'!
  125. canUnderstand: aSelector
  126. ^(self methodDictionary keys includes: aSelector asString) or: [
  127. self superclass notNil and: [self superclass canUnderstand: aSelector]]
  128. !
  129. inheritsFrom: aClass
  130. ^aClass allSubclasses includes: self
  131. ! !
  132. Behavior subclass: #Class
  133. instanceVariableNames: ''
  134. package: 'Kernel-Classes'!
  135. !Class commentStamp!
  136. Class is __the__ class object.
  137. Instances are the classes of the system.
  138. Class creation is done throught a `ClassBuilder`!
  139. !Class methodsFor: 'accessing'!
  140. category
  141. ^self package ifNil: ['Unclassified'] ifNotNil: [self package name]
  142. !
  143. package
  144. <return self.pkg>
  145. !
  146. package: aPackage
  147. <self.pkg = aPackage>
  148. !
  149. rename: aString
  150. <
  151. smalltalk[aString] = self;
  152. delete smalltalk[self.className];
  153. self.className = aString;
  154. >
  155. ! !
  156. !Class methodsFor: 'class creation'!
  157. subclass: aString instanceVariableNames: anotherString
  158. "Kept for compatibility."
  159. ^self subclass: aString instanceVariableNames: anotherString package: nil
  160. !
  161. subclass: aString instanceVariableNames: aString2 category: aString3
  162. "Kept for compatibility."
  163. self deprecatedAPI.
  164. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  165. !
  166. subclass: aString instanceVariableNames: aString2 classVariableNames: classVars poolDictionaries: pools category: aString3
  167. "Just ignore class variables and pools. Added for compatibility."
  168. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  169. !
  170. subclass: aString instanceVariableNames: aString2 package: aString3
  171. ^ClassBuilder new
  172. superclass: self subclass: aString asString instanceVariableNames: aString2 package: aString3
  173. ! !
  174. !Class methodsFor: 'printing'!
  175. printString
  176. ^self name
  177. ! !
  178. !Class methodsFor: 'testing'!
  179. isClass
  180. ^true
  181. ! !
  182. Behavior subclass: #Metaclass
  183. instanceVariableNames: ''
  184. package: 'Kernel-Classes'!
  185. !Metaclass commentStamp!
  186. Metaclass is the root of the class hierarchy.
  187. Metaclass instances are metaclasses, one for each real class.
  188. Metaclass instances have a single instance, which they hold onto, which is the class that they are the metaclass of.!
  189. !Metaclass methodsFor: 'accessing'!
  190. instanceClass
  191. <return self.instanceClass>
  192. !
  193. instanceVariableNames: aCollection
  194. ClassBuilder new
  195. class: self instanceVariableNames: aCollection
  196. ! !
  197. !Metaclass methodsFor: 'printing'!
  198. printString
  199. ^self instanceClass name, ' class'
  200. ! !
  201. !Metaclass methodsFor: 'testing'!
  202. isMetaclass
  203. ^true
  204. ! !
  205. Object subclass: #ClassBuilder
  206. instanceVariableNames: ''
  207. package: 'Kernel-Classes'!
  208. !ClassBuilder commentStamp!
  209. ClassBuilder is responsible for compiling new classes or modifying existing classes in the system.
  210. Rather than using ClassBuilder directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
  211. !ClassBuilder methodsFor: 'class creation'!
  212. class: aClass instanceVariableNames: aString
  213. aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
  214. aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).
  215. self setupClass: aClass
  216. !
  217. superclass: aClass subclass: aString
  218. ^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
  219. !
  220. superclass: aClass subclass: aString instanceVariableNames: aString2 package: aString3
  221. | newClass |
  222. newClass := self addSubclassOf: aClass
  223. named: aString instanceVariableNames: (self instanceVariableNamesFor: aString2)
  224. package: (aString3 ifNil: ['unclassified']).
  225. self setupClass: newClass.
  226. ^newClass
  227. ! !
  228. !ClassBuilder methodsFor: 'private'!
  229. addSubclassOf: aClass named: aString instanceVariableNames: aCollection
  230. <smalltalk.addClass(aString, aClass, aCollection);
  231. return smalltalk[aString]>
  232. !
  233. addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  234. <smalltalk.addClass(aString, aClass, aCollection, packageName);
  235. return smalltalk[aString]>
  236. !
  237. copyClass: aClass named: aString
  238. | newClass |
  239. newClass := self
  240. addSubclassOf: aClass superclass
  241. named: aString
  242. instanceVariableNames: aClass instanceVariableNames
  243. package: aClass package name.
  244. self setupClass: newClass.
  245. aClass methodDictionary values do: [:each |
  246. newClass addCompiledMethod: (Compiler new load: each source forClass: newClass).
  247. (newClass methodDictionary at: each selector) category: each category].
  248. aClass class methodDictionary values do: [:each |
  249. newClass class addCompiledMethod: (Compiler new load: each source forClass: newClass class).
  250. (newClass class methodDictionary at: each selector) category: each category].
  251. self setupClass: newClass.
  252. ^newClass
  253. !
  254. instanceVariableNamesFor: aString
  255. ^(aString tokenize: ' ') reject: [:each | each isEmpty]
  256. !
  257. setupClass: aClass
  258. <smalltalk.init(aClass);>
  259. ! !
  260. Object subclass: #ClassCategoryReader
  261. instanceVariableNames: 'class category chunkParser'
  262. package: 'Kernel-Classes'!
  263. !ClassCategoryReader commentStamp!
  264. ClassCategoryReader represents a mechanism for retrieving class descriptions stored on a file.!
  265. !ClassCategoryReader methodsFor: 'accessing'!
  266. class: aClass category: aString
  267. class := aClass.
  268. category := aString
  269. ! !
  270. !ClassCategoryReader methodsFor: 'fileIn'!
  271. scanFrom: aChunkParser
  272. | chunk |
  273. [chunk := aChunkParser nextChunk.
  274. chunk isEmpty] whileFalse: [
  275. self compileMethod: chunk]
  276. ! !
  277. !ClassCategoryReader methodsFor: 'initialization'!
  278. initialize
  279. super initialize.
  280. chunkParser := ChunkParser new.
  281. ! !
  282. !ClassCategoryReader methodsFor: 'private'!
  283. compileMethod: aString
  284. | method compiler |
  285. method := (compiler := Compiler new) load: aString forClass: class.
  286. method category: category.
  287. class addCompiledMethod: method.
  288. compiler setupClass: class.
  289. ! !
  290. Object subclass: #ClassCommentReader
  291. instanceVariableNames: 'class chunkParser'
  292. package: 'Kernel-Classes'!
  293. !ClassCommentReader commentStamp!
  294. ClassCommentReader represents a mechanism for retrieving class descriptions stored on a file.
  295. See `ClassCategoryReader` too.!
  296. !ClassCommentReader methodsFor: 'accessing'!
  297. class: aClass
  298. class := aClass
  299. ! !
  300. !ClassCommentReader methodsFor: 'fileIn'!
  301. scanFrom: aChunkParser
  302. | chunk |
  303. chunk := aChunkParser nextChunk.
  304. chunk isEmpty ifFalse: [
  305. self setComment: chunk].
  306. ! !
  307. !ClassCommentReader methodsFor: 'initialization'!
  308. initialize
  309. super initialize.
  310. chunkParser := ChunkParser new.
  311. ! !
  312. !ClassCommentReader methodsFor: 'private'!
  313. setComment: aString
  314. class comment: aString
  315. ! !
  316. Object subclass: #ClassSorterNode
  317. instanceVariableNames: 'theClass level nodes'
  318. package: 'Kernel-Classes'!
  319. !ClassSorterNode methodsFor: 'accessing'!
  320. getNodesFrom: aCollection
  321. | children others |
  322. children := #().
  323. others := #().
  324. aCollection do: [:each |
  325. (each superclass = self theClass)
  326. ifTrue: [children add: each]
  327. ifFalse: [others add: each]].
  328. nodes:= children collect: [:each |
  329. ClassSorterNode on: each classes: others level: self level + 1]
  330. !
  331. level
  332. ^level
  333. !
  334. level: anInteger
  335. level := anInteger
  336. !
  337. nodes
  338. ^nodes
  339. !
  340. theClass
  341. ^theClass
  342. !
  343. theClass: aClass
  344. theClass := aClass
  345. ! !
  346. !ClassSorterNode methodsFor: 'visiting'!
  347. traverseClassesWith: aCollection
  348. "sort classes alphabetically Issue #143"
  349. aCollection add: self theClass.
  350. (self nodes sorted: [:a :b | a theClass name <= b theClass name ]) do: [:aNode |
  351. aNode traverseClassesWith: aCollection ].
  352. ! !
  353. !ClassSorterNode class methodsFor: 'instance creation'!
  354. on: aClass classes: aCollection level: anInteger
  355. ^self new
  356. theClass: aClass;
  357. level: anInteger;
  358. getNodesFrom: aCollection;
  359. yourself
  360. ! !