2
0

Kernel-Classes.st 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461
  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. Compiler new
  108. install: aString forClass: self category: anotherString;
  109. setupClass: self
  110. !
  111. removeCompiledMethod: aMethod
  112. <delete self.fn.prototype[aMethod.selector._asSelector()];
  113. delete self.fn.prototype.methods[aMethod.selector];
  114. smalltalk.init(self);>
  115. ! !
  116. !Behavior methodsFor: 'instance creation'!
  117. basicNew
  118. <return new self.fn()>
  119. !
  120. new
  121. ^self basicNew initialize
  122. ! !
  123. !Behavior methodsFor: 'testing'!
  124. canUnderstand: aSelector
  125. ^(self methodDictionary keys includes: aSelector asString) or: [
  126. self superclass notNil and: [self superclass canUnderstand: aSelector]]
  127. !
  128. inheritsFrom: aClass
  129. ^aClass allSubclasses includes: self
  130. ! !
  131. Behavior subclass: #Class
  132. instanceVariableNames: ''
  133. package: 'Kernel-Classes'!
  134. !Class commentStamp!
  135. Class is __the__ class object.
  136. Instances are the classes of the system.
  137. Class creation is done throught a `ClassBuilder`!
  138. !Class methodsFor: 'accessing'!
  139. category
  140. ^self package ifNil: ['Unclassified'] ifNotNil: [self package name]
  141. !
  142. package
  143. <return self.pkg>
  144. !
  145. package: aPackage
  146. <self.pkg = aPackage>
  147. !
  148. rename: aString
  149. <
  150. smalltalk[aString] = self;
  151. delete smalltalk[self.className];
  152. self.className = aString;
  153. >
  154. ! !
  155. !Class methodsFor: 'class creation'!
  156. subclass: aString instanceVariableNames: anotherString
  157. "Kept for compatibility."
  158. ^self subclass: aString instanceVariableNames: anotherString package: nil
  159. !
  160. subclass: aString instanceVariableNames: aString2 category: aString3
  161. "Kept for compatibility."
  162. self deprecatedAPI.
  163. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  164. !
  165. subclass: aString instanceVariableNames: aString2 classVariableNames: classVars poolDictionaries: pools category: aString3
  166. "Just ignore class variables and pools. Added for compatibility."
  167. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  168. !
  169. subclass: aString instanceVariableNames: aString2 package: aString3
  170. ^ClassBuilder new
  171. superclass: self subclass: aString asString instanceVariableNames: aString2 package: aString3
  172. ! !
  173. !Class methodsFor: 'printing'!
  174. printString
  175. ^self name
  176. ! !
  177. !Class methodsFor: 'testing'!
  178. isClass
  179. ^true
  180. ! !
  181. Behavior subclass: #Metaclass
  182. instanceVariableNames: ''
  183. package: 'Kernel-Classes'!
  184. !Metaclass commentStamp!
  185. Metaclass is the root of the class hierarchy.
  186. Metaclass instances are metaclasses, one for each real class.
  187. Metaclass instances have a single instance, which they hold onto, which is the class that they are the metaclass of.!
  188. !Metaclass methodsFor: 'accessing'!
  189. instanceClass
  190. <return self.instanceClass>
  191. !
  192. instanceVariableNames: aCollection
  193. ClassBuilder new
  194. class: self instanceVariableNames: aCollection
  195. ! !
  196. !Metaclass methodsFor: 'printing'!
  197. printString
  198. ^self instanceClass name, ' class'
  199. ! !
  200. !Metaclass methodsFor: 'testing'!
  201. isMetaclass
  202. ^true
  203. ! !
  204. Object subclass: #ClassBuilder
  205. instanceVariableNames: ''
  206. package: 'Kernel-Classes'!
  207. !ClassBuilder commentStamp!
  208. ClassBuilder is responsible for compiling new classes or modifying existing classes in the system.
  209. Rather than using ClassBuilder directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
  210. !ClassBuilder methodsFor: 'class creation'!
  211. class: aClass instanceVariableNames: aString
  212. aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
  213. aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).
  214. self setupClass: aClass
  215. !
  216. superclass: aClass subclass: aString
  217. ^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
  218. !
  219. superclass: aClass subclass: aString instanceVariableNames: aString2 package: aString3
  220. | newClass |
  221. newClass := self addSubclassOf: aClass
  222. named: aString instanceVariableNames: (self instanceVariableNamesFor: aString2)
  223. package: (aString3 ifNil: ['unclassified']).
  224. self setupClass: newClass.
  225. ^newClass
  226. ! !
  227. !ClassBuilder methodsFor: 'private'!
  228. addSubclassOf: aClass named: aString instanceVariableNames: aCollection
  229. <smalltalk.addClass(aString, aClass, aCollection);
  230. return smalltalk[aString]>
  231. !
  232. addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  233. <smalltalk.addClass(aString, aClass, aCollection, packageName);
  234. return smalltalk[aString]>
  235. !
  236. copyClass: aClass named: aString
  237. | newClass |
  238. newClass := self
  239. addSubclassOf: aClass superclass
  240. named: aString
  241. instanceVariableNames: aClass instanceVariableNames
  242. package: aClass package name.
  243. self setupClass: newClass.
  244. aClass methodDictionary values do: [:each |
  245. Compiler new install: each source forClass: newClass category: each category].
  246. aClass class methodDictionary values do: [:each |
  247. Compiler new install: each source forClass: newClass class category: each category].
  248. self setupClass: newClass.
  249. ^newClass
  250. !
  251. instanceVariableNamesFor: aString
  252. ^(aString tokenize: ' ') reject: [:each | each isEmpty]
  253. !
  254. setupClass: aClass
  255. <smalltalk.init(aClass);>
  256. ! !
  257. Object subclass: #ClassCategoryReader
  258. instanceVariableNames: 'class category chunkParser'
  259. package: 'Kernel-Classes'!
  260. !ClassCategoryReader commentStamp!
  261. ClassCategoryReader represents a mechanism for retrieving class descriptions stored on a file.!
  262. !ClassCategoryReader methodsFor: 'accessing'!
  263. class: aClass category: aString
  264. class := aClass.
  265. category := aString
  266. ! !
  267. !ClassCategoryReader methodsFor: 'fileIn'!
  268. scanFrom: aChunkParser
  269. | chunk |
  270. [chunk := aChunkParser nextChunk.
  271. chunk isEmpty] whileFalse: [
  272. self compileMethod: chunk].
  273. Compiler new setupClass: class
  274. ! !
  275. !ClassCategoryReader methodsFor: 'initialization'!
  276. initialize
  277. super initialize.
  278. chunkParser := ChunkParser new.
  279. ! !
  280. !ClassCategoryReader methodsFor: 'private'!
  281. compileMethod: aString
  282. Compiler new install: aString forClass: class category: category
  283. ! !
  284. Object subclass: #ClassCommentReader
  285. instanceVariableNames: 'class chunkParser'
  286. package: 'Kernel-Classes'!
  287. !ClassCommentReader commentStamp!
  288. ClassCommentReader represents a mechanism for retrieving class descriptions stored on a file.
  289. See `ClassCategoryReader` too.!
  290. !ClassCommentReader methodsFor: 'accessing'!
  291. class: aClass
  292. class := aClass
  293. ! !
  294. !ClassCommentReader methodsFor: 'fileIn'!
  295. scanFrom: aChunkParser
  296. | chunk |
  297. chunk := aChunkParser nextChunk.
  298. chunk isEmpty ifFalse: [
  299. self setComment: chunk].
  300. ! !
  301. !ClassCommentReader methodsFor: 'initialization'!
  302. initialize
  303. super initialize.
  304. chunkParser := ChunkParser new.
  305. ! !
  306. !ClassCommentReader methodsFor: 'private'!
  307. setComment: aString
  308. class comment: aString
  309. ! !
  310. Object subclass: #ClassSorterNode
  311. instanceVariableNames: 'theClass level nodes'
  312. package: 'Kernel-Classes'!
  313. !ClassSorterNode methodsFor: 'accessing'!
  314. getNodesFrom: aCollection
  315. | children others |
  316. children := #().
  317. others := #().
  318. aCollection do: [:each |
  319. (each superclass = self theClass)
  320. ifTrue: [children add: each]
  321. ifFalse: [others add: each]].
  322. nodes:= children collect: [:each |
  323. ClassSorterNode on: each classes: others level: self level + 1]
  324. !
  325. level
  326. ^level
  327. !
  328. level: anInteger
  329. level := anInteger
  330. !
  331. nodes
  332. ^nodes
  333. !
  334. theClass
  335. ^theClass
  336. !
  337. theClass: aClass
  338. theClass := aClass
  339. ! !
  340. !ClassSorterNode methodsFor: 'visiting'!
  341. traverseClassesWith: aCollection
  342. "sort classes alphabetically Issue #143"
  343. aCollection add: self theClass.
  344. (self nodes sorted: [:a :b | a theClass name <= b theClass name ]) do: [:aNode |
  345. aNode traverseClassesWith: aCollection ].
  346. ! !
  347. !ClassSorterNode class methodsFor: 'instance creation'!
  348. on: aClass classes: aCollection level: anInteger
  349. ^self new
  350. theClass: aClass;
  351. level: anInteger;
  352. getNodesFrom: aCollection;
  353. yourself
  354. ! !