[squeak-dev] The Trunk: System-tonyg.1224.mcz

christoph.thiede at student.hpi.uni-potsdam.de christoph.thiede at student.hpi.uni-potsdam.de
Wed Sep 14 09:17:35 UTC 2022


Hi Future You,

FYIO, I have filed https://github.com/Metacello/metacello/issues/555 (Gofer-Core.squeak-ct.136.mcz) which would fix Gofer's extension method by marking it as a proper override and integrating Tony's changes. It just needs to be merged by Dale or anyone else with write access. :-)

==================== Summary ====================

Name: Gofer-Core.squeak-ct.136
Author: ct
Time: 14 September 2022, 11:04:24.862009 am
UUID: 125a7550-6d87-ff45-9717-3ae4694acda0
Ancestors: Gofer-Core.squeak-dkh.135

Updates extension method SystemOrganizer>>#environment to complement System-tonyg.1224 for Squeak. If the environment variable is not available, the code will still compile with a nil literal for environment, falling back to the prior logic. Marks the method as proper override.

=============== Diff against Gofer-Core.squeak-dkh.135 ===============

SystemOrganizer>>environment {*Gofer-Core-accessing-override} · ct 9/14/2022 11:01 (changed and recategorized)
environment
- 
- 	^Smalltalk
+ 	^ environment ifNil: [Smalltalk]

Best,
Christoph

---
Sent from Squeak Inbox Talk

On 2021-06-30T14:02:29+02:00, marcel.taeumel at hpi.de wrote:

> Note to Future Me: The Metacello bootstrap code patches its own version of SystemOrganizer >> #environment into the image.
> 
> See:
> Installer class >> #ensureRecentMetacello
> Installer class >> #gemsource
> http://seaside.gemtalksystems.com/ss/metacello.html
> Gofer-Code.squeak-dkh.135
> 
> 
> Best,
> Present Me
> Am 29.03.2021 10:23:41 schrieb commits at source.squeak.org <commits at source.squeak.org>:
> Tony Garnock-Jones uploaded a new version of System to project The Trunk:
> http://source.squeak.org/trunk/System-tonyg.1224.mcz
> 
> ==================== Summary ====================
> 
> Name: System-tonyg.1224
> Author: tonyg
> Time: 29 March 2021, 10:15:02.279821 am
> UUID: 9d897d72-46fc-4205-a27b-89c7a50ac104
> Ancestors: System-mt.1223
> 
> Teach SystemOrganizer about multiple environments.
> 
> =============== Diff against System-mt.1223 ===============
> 
> Item was changed:
> Categorizer subclass: #SystemOrganizer
> + instanceVariableNames: 'environment'
> - instanceVariableNames: ''
> classVariableNames: ''
> poolDictionaries: ''
> category: 'System-Support'!
> 
> !SystemOrganizer commentStamp: '' prior: 0!
> My instances provide an organization for the classes in the system, just as a ClassOrganizer organizes the messages within a class. The only difference is the methods for fileIn/Out.!
> 
> Item was changed:
> ----- Method: SystemOrganizer>>classesIn: (in category 'query') -----
> classesIn: categoryName
> 
> | classes |
> classes := OrderedCollection new.
> self categories withIndexCollect: [:cat :idx |
> (categoryName match: cat)
> ifTrue: [classes addAll: (self listAtCategoryNumber: idx)]
> ifFalse: [nil]].
> + ^ classes collect: [:clsName | self environment classNamed: clsName]!
> - ^ classes collect: [:clsName | Smalltalk classNamed: clsName]!
> 
> Item was changed:
> ----- Method: SystemOrganizer>>classify:under: (in category 'accessing') -----
> classify: element under: newCategory
> | oldCategory class |
> self flag: #environments. "do we want notifications for classes in other environments?"
> oldCategory := self categoryOfElement: element.
> super classify: element under: newCategory.
> + class := self environment at: element ifAbsent: [^ self].
> - class := Smalltalk at: element ifAbsent: [^ self].
> self == SystemOrganization ifTrue: [
> SystemChangeNotifier uniqueInstance
> class: class
> recategorizedFrom: oldCategory
> to: newCategory]!
> 
> Item was changed:
> ----- Method: SystemOrganizer>>commentInventory: (in category 'query') -----
> commentInventory: categoryName
> 
> "SystemOrganization commentInventory: 'Morphic*'"
> 
> | classes commentedClasses |
> classes := OrderedCollection new.
> self categories withIndexCollect: [:cat :idx |
> (categoryName match: cat)
> ifTrue: [classes addAll: (self listAtCategoryNumber: idx)]
> ifFalse: [nil]].
> + commentedClasses := classes select: [:catCls | (self environment at: catCls) hasComment].
> - commentedClasses := classes select: [:catCls | (Smalltalk at: catCls) hasComment].
> ^ 'There are ' , classes size asString , ' classes in ' , categoryName ,
> ' of which ' , commentedClasses size asString , ' have comments and ',
> (classes size - commentedClasses size) asString , ' do not yet have comments.'
> !
> 
> Item was added:
> + ----- Method: SystemOrganizer>>environment (in category 'accessing') -----
> + environment
> + ^ environment ifNil: [Smalltalk globals]!
> 
> Item was added:
> + ----- Method: SystemOrganizer>>environment: (in category 'accessing') -----
> + environment: anEnvironment
> + environment := anEnvironment!
> 
> Item was changed:
> ----- Method: SystemOrganizer>>fileOutCategory:on:initializing: (in category 'fileIn/Out') -----
> fileOutCategory: category on: aFileStream initializing: aBool
> "Store on the file associated with aFileStream, all the traits and classes associated
> with the category and any requested shared pools in the right order."
> 
> | first poolSet tempClass classes traits |
> traits := self orderedTraitsIn: category.
> classes := self superclassOrder: category.
> poolSet := Set new.
> classes do: [:class | class sharedPools do: [:eachPool | poolSet add: eachPool]].
> poolSet size > 0 ifTrue: [
> tempClass := Class new.
> tempClass shouldFileOutPools ifTrue: [
> poolSet := poolSet select: [:aPool |
> + tempClass shouldFileOutPool: (self environment keyAtIdentityValue: aPool)].
> - tempClass shouldFileOutPool: (Smalltalk globals keyAtIdentityValue: aPool)].
> poolSet do: [:aPool | tempClass fileOutPool: aPool onFileStream: aFileStream]]].
> first := true.
> traits, classes do: [:each |
> first
> ifTrue: [first := false]
> ifFalse: [aFileStream cr; nextPut: Character newPage; cr].
> each
> fileOutOn: aFileStream
> moveSource: false
> toFile: 0
> initializing: false].
> aBool ifTrue: [classes do: [:cls | cls fileOutInitializerOn: aFileStream]].!
> 
> Item was changed:
> ----- Method: SystemOrganizer>>orderedTraitsIn: (in category 'fileIn/Out') -----
> orderedTraitsIn: category
> "Answer an OrderedCollection containing references to the traits in the
> category whose name is the argument, category (a string). The traits
> are ordered so they can be filed in."
> 
> | behaviors traits |
> behaviors := (self listAtCategoryNamed: category asSymbol)
> + collect: [:title | self environment at: title].
> - collect: [:title | Smalltalk at: title].
> traits := behaviors reject: [:each | each isBehavior].
> ^traits asArray sort: [:t1 :t2 |
> (t2 traitComposition allTraits includes: t1)
> or: [(t1 traitComposition allTraits includes: t2) not]]!
> 
> Item was changed:
> ----- Method: SystemOrganizer>>removeMissingClasses (in category 'remove') -----
> removeMissingClasses
> "Remove any class names that are no longer in the Smalltalk dictionary. Used for cleaning up after garbage collecting user-generated classes."
> "SystemOrganization removeMissingClasses"
> 
> elementArray copy do: [:el |
> + (self environment includesKey: el) ifFalse: [self removeElement: el]].
> - (Smalltalk includesKey: el) ifFalse: [self removeElement: el]].
> !
> 
> Item was changed:
> ----- Method: SystemOrganizer>>superclassOrder: (in category 'fileIn/Out') -----
> superclassOrder: category
> "Answer an OrderedCollection containing references to the classes in the
> category whose name is the argument, category (a string). The classes
> are ordered with superclasses first so they can be filed in."
> 
> | behaviors classes |
> behaviors := (self listAtCategoryNamed: category asSymbol)
> + collect: [:title | self environment at: title].
> - collect: [:title | Smalltalk at: title].
> classes := behaviors select: [:each | each isBehavior].
> ^ChangeSet superclassOrder: classes!
> 
> 
> -------------- next part --------------
> An HTML attachment was scrubbed...
> URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20210630/79f1a3c1/attachment.html>
> 
> 
["Gofer-Core.squeak-ct.136.mcz"]
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220914/0edb730a/attachment.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Gofer-Core.squeak-ct.136.mcz
Type: application/octet-stream
Size: 22712 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220914/0edb730a/attachment.obj>


More information about the Squeak-dev mailing list