1
0

Kernel-Classes.st 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473
  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: 'converting'!
  174. asJavascript
  175. ^ 'smalltalk.', self name
  176. ! !
  177. !Class methodsFor: 'printing'!
  178. printString
  179. ^self name
  180. ! !
  181. !Class methodsFor: 'testing'!
  182. isClass
  183. ^true
  184. ! !
  185. Behavior subclass: #Metaclass
  186. instanceVariableNames: ''
  187. package: 'Kernel-Classes'!
  188. !Metaclass commentStamp!
  189. Metaclass is the root of the class hierarchy.
  190. Metaclass instances are metaclasses, one for each real class.
  191. Metaclass instances have a single instance, which they hold onto, which is the class that they are the metaclass of.!
  192. !Metaclass methodsFor: 'accessing'!
  193. instanceClass
  194. <return self.instanceClass>
  195. !
  196. instanceVariableNames: aCollection
  197. ClassBuilder new
  198. class: self instanceVariableNames: aCollection
  199. ! !
  200. !Metaclass methodsFor: 'converting'!
  201. asJavascript
  202. ^ 'smalltalk.', self instanceClass name, '.klass'
  203. ! !
  204. !Metaclass methodsFor: 'printing'!
  205. printString
  206. ^self instanceClass name, ' class'
  207. ! !
  208. !Metaclass methodsFor: 'testing'!
  209. isMetaclass
  210. ^true
  211. ! !
  212. Object subclass: #ClassBuilder
  213. instanceVariableNames: ''
  214. package: 'Kernel-Classes'!
  215. !ClassBuilder commentStamp!
  216. ClassBuilder is responsible for compiling new classes or modifying existing classes in the system.
  217. Rather than using ClassBuilder directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
  218. !ClassBuilder methodsFor: 'class creation'!
  219. class: aClass instanceVariableNames: aString
  220. aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
  221. aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).
  222. self setupClass: aClass
  223. !
  224. superclass: aClass subclass: aString
  225. ^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
  226. !
  227. superclass: aClass subclass: aString instanceVariableNames: aString2 package: aString3
  228. | newClass |
  229. newClass := self addSubclassOf: aClass
  230. named: aString instanceVariableNames: (self instanceVariableNamesFor: aString2)
  231. package: (aString3 ifNil: ['unclassified']).
  232. self setupClass: newClass.
  233. ^newClass
  234. ! !
  235. !ClassBuilder methodsFor: 'private'!
  236. addSubclassOf: aClass named: aString instanceVariableNames: aCollection
  237. <smalltalk.addClass(aString, aClass, aCollection);
  238. return smalltalk[aString]>
  239. !
  240. addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  241. <smalltalk.addClass(aString, aClass, aCollection, packageName);
  242. return smalltalk[aString]>
  243. !
  244. copyClass: aClass named: aString
  245. | newClass |
  246. newClass := self
  247. addSubclassOf: aClass superclass
  248. named: aString
  249. instanceVariableNames: aClass instanceVariableNames
  250. package: aClass package name.
  251. self setupClass: newClass.
  252. aClass methodDictionary values do: [:each |
  253. Compiler new install: each source forClass: newClass category: each category].
  254. aClass class methodDictionary values do: [:each |
  255. Compiler new install: each source forClass: newClass class category: each category].
  256. self setupClass: newClass.
  257. ^newClass
  258. !
  259. instanceVariableNamesFor: aString
  260. ^(aString tokenize: ' ') reject: [:each | each isEmpty]
  261. !
  262. setupClass: aClass
  263. <smalltalk.init(aClass);>
  264. ! !
  265. Object subclass: #ClassCategoryReader
  266. instanceVariableNames: 'class category chunkParser'
  267. package: 'Kernel-Classes'!
  268. !ClassCategoryReader commentStamp!
  269. ClassCategoryReader represents a mechanism for retrieving class descriptions stored on a file.!
  270. !ClassCategoryReader methodsFor: 'accessing'!
  271. class: aClass category: aString
  272. class := aClass.
  273. category := aString
  274. ! !
  275. !ClassCategoryReader methodsFor: 'fileIn'!
  276. scanFrom: aChunkParser
  277. | chunk |
  278. [chunk := aChunkParser nextChunk.
  279. chunk isEmpty] whileFalse: [
  280. self compileMethod: chunk].
  281. Compiler new setupClass: class
  282. ! !
  283. !ClassCategoryReader methodsFor: 'initialization'!
  284. initialize
  285. super initialize.
  286. chunkParser := ChunkParser new.
  287. ! !
  288. !ClassCategoryReader methodsFor: 'private'!
  289. compileMethod: aString
  290. Compiler new install: aString forClass: class category: category
  291. ! !
  292. Object subclass: #ClassCommentReader
  293. instanceVariableNames: 'class chunkParser'
  294. package: 'Kernel-Classes'!
  295. !ClassCommentReader commentStamp!
  296. ClassCommentReader represents a mechanism for retrieving class descriptions stored on a file.
  297. See `ClassCategoryReader` too.!
  298. !ClassCommentReader methodsFor: 'accessing'!
  299. class: aClass
  300. class := aClass
  301. ! !
  302. !ClassCommentReader methodsFor: 'fileIn'!
  303. scanFrom: aChunkParser
  304. | chunk |
  305. chunk := aChunkParser nextChunk.
  306. chunk isEmpty ifFalse: [
  307. self setComment: chunk].
  308. ! !
  309. !ClassCommentReader methodsFor: 'initialization'!
  310. initialize
  311. super initialize.
  312. chunkParser := ChunkParser new.
  313. ! !
  314. !ClassCommentReader methodsFor: 'private'!
  315. setComment: aString
  316. class comment: aString
  317. ! !
  318. Object subclass: #ClassSorterNode
  319. instanceVariableNames: 'theClass level nodes'
  320. package: 'Kernel-Classes'!
  321. !ClassSorterNode methodsFor: 'accessing'!
  322. getNodesFrom: aCollection
  323. | children others |
  324. children := #().
  325. others := #().
  326. aCollection do: [:each |
  327. (each superclass = self theClass)
  328. ifTrue: [children add: each]
  329. ifFalse: [others add: each]].
  330. nodes:= children collect: [:each |
  331. ClassSorterNode on: each classes: others level: self level + 1]
  332. !
  333. level
  334. ^level
  335. !
  336. level: anInteger
  337. level := anInteger
  338. !
  339. nodes
  340. ^nodes
  341. !
  342. theClass
  343. ^theClass
  344. !
  345. theClass: aClass
  346. theClass := aClass
  347. ! !
  348. !ClassSorterNode methodsFor: 'visiting'!
  349. traverseClassesWith: aCollection
  350. "sort classes alphabetically Issue #143"
  351. aCollection add: self theClass.
  352. (self nodes sorted: [:a :b | a theClass name <= b theClass name ]) do: [:aNode |
  353. aNode traverseClassesWith: aCollection ].
  354. ! !
  355. !ClassSorterNode class methodsFor: 'instance creation'!
  356. on: aClass classes: aCollection level: anInteger
  357. ^self new
  358. theClass: aClass;
  359. level: anInteger;
  360. getNodesFrom: aCollection;
  361. yourself
  362. ! !