Kernel-Classes.st 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583
  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. allSuperclasses
  27. self superclass ifNil: [ ^ #() ].
  28. ^ (OrderedCollection with: self superclass)
  29. addAll: self superclass allSuperclasses;
  30. yourself
  31. !
  32. comment
  33. ^(self basicAt: 'comment') ifNil: ['']
  34. !
  35. comment: aString
  36. self basicAt: 'comment' put: aString.
  37. SystemAnnouncer current
  38. announce: (ClassCommentChanged new
  39. theClass: self;
  40. yourself)
  41. !
  42. commentStamp
  43. ^ClassCommentReader new
  44. class: self;
  45. yourself
  46. !
  47. commentStamp: aStamp prior: prior
  48. ^self commentStamp
  49. !
  50. definition
  51. ^ ''
  52. !
  53. instanceVariableNames
  54. <return self.iVarNames>
  55. !
  56. methodAt: aSymbol
  57. <return smalltalk.methods(self)[aSymbol._asString()]>
  58. !
  59. methodDictionary
  60. <var dict = smalltalk.HashedCollection._new();
  61. var methods = self.fn.prototype.methods;
  62. for(var i in methods) {
  63. if(methods[i].selector) {
  64. dict._at_put_(methods[i].selector, methods[i]);
  65. }
  66. };
  67. return dict>
  68. !
  69. methods
  70. ^ self methodDictionary values
  71. !
  72. methodsFor: aString
  73. ^ClassCategoryReader new
  74. class: self category: aString;
  75. yourself
  76. !
  77. methodsFor: aString stamp: aStamp
  78. "Added for compatibility, right now ignores stamp."
  79. ^self methodsFor: aString
  80. !
  81. methodsInProtocol: aString
  82. ^ self methodDictionary values select: [ :each | each protocol = aString ]
  83. !
  84. name
  85. <return self.className || nil>
  86. !
  87. organization
  88. ^ self basicAt: 'organization'
  89. !
  90. protocols
  91. ^ self organization elements sorted
  92. !
  93. protocolsDo: aBlock
  94. "Execute aBlock for each method category with
  95. its collection of methods in the sort order of category name."
  96. | methodsByCategory |
  97. methodsByCategory := HashedCollection new.
  98. self methodDictionary values do: [:m |
  99. (methodsByCategory at: m category ifAbsentPut: [Array new])
  100. add: m].
  101. self protocols do: [:category |
  102. aBlock value: category value: (methodsByCategory at: category)]
  103. !
  104. prototype
  105. <return self.fn.prototype>
  106. !
  107. selectors
  108. ^ self methodDictionary keys
  109. !
  110. subclasses
  111. <return smalltalk.subclasses(self)>
  112. !
  113. superclass
  114. <return self.superclass || nil>
  115. !
  116. theMetaClass
  117. ^ self class
  118. !
  119. theNonMetaClass
  120. ^ self
  121. !
  122. withAllSubclasses
  123. ^(Array with: self) addAll: self allSubclasses; yourself
  124. ! !
  125. !Behavior methodsFor: 'compiling'!
  126. addCompiledMethod: aMethod
  127. <smalltalk.addMethod(aMethod.selector._asSelector(), aMethod, self)>.
  128. SystemAnnouncer current
  129. announce: (MethodAdded new
  130. theClass: self;
  131. method: aMethod;
  132. yourself)
  133. !
  134. compile: aString
  135. self compile: aString category: ''
  136. !
  137. compile: aString category: anotherString
  138. Compiler new
  139. install: aString
  140. forClass: self
  141. category: anotherString
  142. !
  143. removeCompiledMethod: aMethod
  144. <
  145. smalltalk.removeMethod(aMethod)
  146. smalltalk.init(self);
  147. >.
  148. SystemAnnouncer current
  149. announce: (MethodRemoved new
  150. theClass: self;
  151. method: aMethod;
  152. yourself)
  153. ! !
  154. !Behavior methodsFor: 'instance creation'!
  155. basicNew
  156. <return new self.fn()>
  157. !
  158. new
  159. ^self basicNew initialize
  160. ! !
  161. !Behavior methodsFor: 'testing'!
  162. canUnderstand: aSelector
  163. ^(self methodDictionary keys includes: aSelector asString) or: [
  164. self superclass notNil and: [self superclass canUnderstand: aSelector]]
  165. !
  166. inheritsFrom: aClass
  167. ^aClass allSubclasses includes: self
  168. ! !
  169. Behavior subclass: #Class
  170. instanceVariableNames: ''
  171. package: 'Kernel-Classes'!
  172. !Class commentStamp!
  173. Class is __the__ class object.
  174. Instances are the classes of the system.
  175. Class creation is done throught a `ClassBuilder`!
  176. !Class methodsFor: 'accessing'!
  177. category
  178. ^self package ifNil: ['Unclassified'] ifNotNil: [self package name]
  179. !
  180. definition
  181. ^ String streamContents: [ :stream |
  182. stream
  183. nextPutAll: self superclass asString;
  184. nextPutAll: ' subclass: #';
  185. nextPutAll: self name;
  186. nextPutAll: String lf, String tab;
  187. nextPutAll: 'instanceVariableNames: '''.
  188. self instanceVariableNames
  189. do: [ :each | stream nextPutAll: each ]
  190. separatedBy: [ stream nextPutAll: ' ' ].
  191. stream
  192. nextPutAll: '''', String lf, String tab;
  193. nextPutAll: 'package: ''';
  194. nextPutAll: self category;
  195. nextPutAll: '''' ]
  196. !
  197. package
  198. <return self.pkg>
  199. !
  200. package: aPackage
  201. <self.pkg = aPackage>
  202. !
  203. rename: aString
  204. ClassBuilder new renameClass: self to: aString
  205. ! !
  206. !Class methodsFor: 'class creation'!
  207. subclass: aString instanceVariableNames: anotherString
  208. "Kept for compatibility."
  209. ^self subclass: aString instanceVariableNames: anotherString package: nil
  210. !
  211. subclass: aString instanceVariableNames: aString2 category: aString3
  212. "Kept for compatibility."
  213. self deprecatedAPI.
  214. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  215. !
  216. subclass: aString instanceVariableNames: aString2 classVariableNames: classVars poolDictionaries: pools category: aString3
  217. "Just ignore class variables and pools. Added for compatibility."
  218. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  219. !
  220. subclass: aString instanceVariableNames: aString2 package: aString3
  221. ^ClassBuilder new
  222. superclass: self subclass: aString asString instanceVariableNames: aString2 package: aString3
  223. ! !
  224. !Class methodsFor: 'converting'!
  225. asJavascript
  226. ^ 'smalltalk.', self name
  227. ! !
  228. !Class methodsFor: 'printing'!
  229. printString
  230. ^self name
  231. ! !
  232. !Class methodsFor: 'testing'!
  233. isClass
  234. ^true
  235. ! !
  236. Behavior subclass: #Metaclass
  237. instanceVariableNames: ''
  238. package: 'Kernel-Classes'!
  239. !Metaclass commentStamp!
  240. Metaclass is the root of the class hierarchy.
  241. Metaclass instances are metaclasses, one for each real class.
  242. Metaclass instances have a single instance, which they hold onto, which is the class that they are the metaclass of.!
  243. !Metaclass methodsFor: 'accessing'!
  244. definition
  245. ^ String streamContents: [ :stream |
  246. stream
  247. nextPutAll: self asString;
  248. nextPutAll: ' class ';
  249. nextPutAll: 'instanceVariableNames: '''.
  250. self instanceVariableNames
  251. do: [ :each | stream nextPutAll: each ]
  252. separatedBy: [ stream nextPutAll: ' ' ].
  253. stream nextPutAll: '''' ]
  254. !
  255. instanceClass
  256. <return self.instanceClass>
  257. !
  258. instanceVariableNames: aCollection
  259. ClassBuilder new
  260. class: self instanceVariableNames: aCollection
  261. !
  262. theMetaClass
  263. ^ self
  264. !
  265. theNonMetaClass
  266. ^ self instanceClass
  267. ! !
  268. !Metaclass methodsFor: 'converting'!
  269. asJavascript
  270. ^ 'smalltalk.', self instanceClass name, '.klass'
  271. ! !
  272. !Metaclass methodsFor: 'printing'!
  273. printString
  274. ^self instanceClass name, ' class'
  275. ! !
  276. !Metaclass methodsFor: 'testing'!
  277. isMetaclass
  278. ^true
  279. ! !
  280. Object subclass: #ClassBuilder
  281. instanceVariableNames: ''
  282. package: 'Kernel-Classes'!
  283. !ClassBuilder commentStamp!
  284. ClassBuilder is responsible for compiling new classes or modifying existing classes in the system.
  285. Rather than using ClassBuilder directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
  286. !ClassBuilder methodsFor: 'class creation'!
  287. class: aClass instanceVariableNames: aString
  288. aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
  289. aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).
  290. SystemAnnouncer current
  291. announce: (ClassDefinitionChanged new
  292. theClass: aClass;
  293. yourself).
  294. self setupClass: aClass
  295. !
  296. renameClass: aClass to: aString
  297. <
  298. smalltalk[aString] = aClass;
  299. delete smalltalk[aClass.className];
  300. aClass.className = aString;
  301. >.
  302. SystemAnnouncer current
  303. announce: (ClassRenamed new
  304. theClass: aClass;
  305. yourself)
  306. !
  307. superclass: aClass subclass: aString
  308. ^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
  309. !
  310. superclass: aClass subclass: aString instanceVariableNames: aString2 package: aString3
  311. | newClass |
  312. newClass := self addSubclassOf: aClass
  313. named: aString instanceVariableNames: (self instanceVariableNamesFor: aString2)
  314. package: (aString3 ifNil: ['unclassified']).
  315. self setupClass: newClass.
  316. SystemAnnouncer current
  317. announce: (ClassAdded new
  318. theClass: newClass;
  319. yourself).
  320. ^newClass
  321. ! !
  322. !ClassBuilder methodsFor: 'private'!
  323. addSubclassOf: aClass named: aString instanceVariableNames: aCollection
  324. <smalltalk.addClass(aString, aClass, aCollection);
  325. return smalltalk[aString]>
  326. !
  327. addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  328. <smalltalk.addClass(aString, aClass, aCollection, packageName);
  329. return smalltalk[aString]>
  330. !
  331. copyClass: aClass named: aString
  332. | newClass |
  333. newClass := self
  334. addSubclassOf: aClass superclass
  335. named: aString
  336. instanceVariableNames: aClass instanceVariableNames
  337. package: aClass package name.
  338. self setupClass: newClass.
  339. aClass methodDictionary values do: [:each |
  340. Compiler new install: each source forClass: newClass category: each category].
  341. aClass class methodDictionary values do: [:each |
  342. Compiler new install: each source forClass: newClass class category: each category].
  343. self setupClass: newClass.
  344. ^newClass
  345. !
  346. instanceVariableNamesFor: aString
  347. ^(aString tokenize: ' ') reject: [:each | each isEmpty]
  348. !
  349. setupClass: aClass
  350. <smalltalk.init(aClass);>
  351. ! !
  352. Object subclass: #ClassCategoryReader
  353. instanceVariableNames: 'class category chunkParser'
  354. package: 'Kernel-Classes'!
  355. !ClassCategoryReader commentStamp!
  356. ClassCategoryReader represents a mechanism for retrieving class descriptions stored on a file.!
  357. !ClassCategoryReader methodsFor: 'accessing'!
  358. class: aClass category: aString
  359. class := aClass.
  360. category := aString
  361. ! !
  362. !ClassCategoryReader methodsFor: 'fileIn'!
  363. scanFrom: aChunkParser
  364. | chunk |
  365. [chunk := aChunkParser nextChunk.
  366. chunk isEmpty] whileFalse: [
  367. self compileMethod: chunk].
  368. Compiler new setupClass: class
  369. ! !
  370. !ClassCategoryReader methodsFor: 'initialization'!
  371. initialize
  372. super initialize.
  373. chunkParser := ChunkParser new.
  374. ! !
  375. !ClassCategoryReader methodsFor: 'private'!
  376. compileMethod: aString
  377. Compiler new install: aString forClass: class category: category
  378. ! !
  379. Object subclass: #ClassCommentReader
  380. instanceVariableNames: 'class chunkParser'
  381. package: 'Kernel-Classes'!
  382. !ClassCommentReader commentStamp!
  383. ClassCommentReader represents a mechanism for retrieving class descriptions stored on a file.
  384. See `ClassCategoryReader` too.!
  385. !ClassCommentReader methodsFor: 'accessing'!
  386. class: aClass
  387. class := aClass
  388. ! !
  389. !ClassCommentReader methodsFor: 'fileIn'!
  390. scanFrom: aChunkParser
  391. | chunk |
  392. chunk := aChunkParser nextChunk.
  393. chunk isEmpty ifFalse: [
  394. self setComment: chunk].
  395. ! !
  396. !ClassCommentReader methodsFor: 'initialization'!
  397. initialize
  398. super initialize.
  399. chunkParser := ChunkParser new.
  400. ! !
  401. !ClassCommentReader methodsFor: 'private'!
  402. setComment: aString
  403. class comment: aString
  404. ! !
  405. Object subclass: #ClassSorterNode
  406. instanceVariableNames: 'theClass level nodes'
  407. package: 'Kernel-Classes'!
  408. !ClassSorterNode methodsFor: 'accessing'!
  409. getNodesFrom: aCollection
  410. | children others |
  411. children := #().
  412. others := #().
  413. aCollection do: [:each |
  414. (each superclass = self theClass)
  415. ifTrue: [children add: each]
  416. ifFalse: [others add: each]].
  417. nodes:= children collect: [:each |
  418. ClassSorterNode on: each classes: others level: self level + 1]
  419. !
  420. level
  421. ^level
  422. !
  423. level: anInteger
  424. level := anInteger
  425. !
  426. nodes
  427. ^nodes
  428. !
  429. theClass
  430. ^theClass
  431. !
  432. theClass: aClass
  433. theClass := aClass
  434. ! !
  435. !ClassSorterNode methodsFor: 'visiting'!
  436. traverseClassesWith: aCollection
  437. "sort classes alphabetically Issue #143"
  438. aCollection add: self theClass.
  439. (self nodes sorted: [:a :b | a theClass name <= b theClass name ]) do: [:aNode |
  440. aNode traverseClassesWith: aCollection ].
  441. ! !
  442. !ClassSorterNode class methodsFor: 'instance creation'!
  443. on: aClass classes: aCollection level: anInteger
  444. ^self new
  445. theClass: aClass;
  446. level: anInteger;
  447. getNodesFrom: aCollection;
  448. yourself
  449. ! !