Packages September 2016

packages@lists.squeakfoundation.org

1 participants
72 discussions

The Trunk: Environments-nice.64.mcz
by commits＠source.squeak.org 29 Sep '16

29 Sep '16

Nicolas Cellier uploaded a new version of Environments to project The Trunk: http://source.squeak.org/trunk/Environments-nice.64.mcz ==================== Summary ==================== Name: Environments-nice.64 Author: nice Time: 29 September 2016, 10:41:52.190388 am UUID: 607ee3c4-cc23-ff46-9f28-edddf2118760 Ancestors: Environments-nice.63 Fix the postscript: it's Smalltalk globals that should be exported... Note: Environment stack policies without testing if they already exist, so there's a big danger to exportmore than once! There might be undesired side effects (notifying more than once?) =============== Diff against Environments-nice.63 =============== Item was changed: (PackageInfo named: 'Environments') postscript: '"It''s impossible to import a binding if not exported. There''s nothing secret in Smalltalk (nor private)." + Smalltalk globals exportSelf. - Smalltalk exportSelf. '!

1 0

The Trunk: Environments-nice.63.mcz
by commits＠source.squeak.org 29 Sep '16

29 Sep '16

Nicolas Cellier uploaded a new version of Environments to project The Trunk: http://source.squeak.org/trunk/Environments-nice.63.mcz ==================== Summary ==================== Name: Environments-nice.63 Author: nice Time: 29 September 2016, 10:29:59.273388 am UUID: 1c6b29fd-c218-034b-8059-2a4e231109d4 Ancestors: Environments-mt.62 Update the class comment of Environment to match current instance variable list. Update the postscript to export Smalltalk bindings. =============== Diff against Environments-mt.62 =============== Item was changed: Object subclass: #Environment instanceVariableNames: 'info declarations bindings undeclared policies observers' classVariableNames: 'Default Instances' poolDictionaries: '' category: 'Environments-Core'! + !Environment commentStamp: 'nice 9/29/2016 10:27' prior: 0! - !Environment commentStamp: 'cmm 12/20/2013 14:10' prior: 0! I am a context for compiling methods. I maintain the namespace of classes and global variables that are visible to the methods compiled within me. I have the following instance variables: info <EnvironmentInfo> Metadata about me and the code I contain. - imports <Import> - Rules for importing globals from other environments. - - exports <Export> - Rules for exposing globals to other environments. - declarations <IdentityDictionary> + Bindings for class and other globals that have been declared inside me. - Bindings for globals that have been declared inside me. + bindings <IdentityDictionary> + Bindings for all the class and global variables visible from the compiler. + It generally includes the declarations (see importSelf), plus other imports from other environments, including aliases. - references <IdentityDictionary> - Bindings for globals that are used by methods compiled inside me. + policies <Collection of: NamePolicy> + The list of rules for importing and exporting bindings to other environments. - public <IdentityDictionary> - Bindings for classes that have been declared inside me, and which satisfy the export rules contain in 'exports'. + observers <Collection of: Environment> + These are the environments importing some bindings from self, and which should be notified whenever we add/remove/change some binding. + ! - undeclared <Dictionary> - Bindings for globals that are used by methods compiled inside me, but which aren't present in 'references' and couldn't be found via the rules in 'imports'.! Item was changed: + (PackageInfo named: 'Environments') postscript: '"It''s impossible to import a binding if not exported. + There''s nothing secret in Smalltalk (nor private)." + Smalltalk exportSelf. - (PackageInfo named: 'Environments') postscript: '"Recompile all methods to fix errant bindings" - Compiler recompileAll. '!

1 0

The Trunk: Kernel-nice.1042.mcz
by commits＠source.squeak.org 29 Sep '16

29 Sep '16

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1042.mcz ==================== Summary ==================== Name: Kernel-nice.1042 Author: nice Time: 29 September 2016, 10:15:16.009388 am UUID: 8923b113-72cf-414e-802c-cef7c50f8ad1 Ancestors: Kernel-tfel.1041, Kernel-nice.798 Merge Kernel-nice.798 (variable scope fix, don't resolve name in superclass environment) Reminder: this requires some Smalltalk exportSelf. =============== Diff against Kernel-tfel.1041 =============== Item was changed: ----- Method: Class>>bindingOf:environment: (in category 'compiling') ----- bindingOf: varName environment: anEnvironment "Answer the binding of some variable resolved in the scope of the receiver" | aSymbol binding | aSymbol := varName asSymbol. + "First look in local classVar dictionary." + binding := self classPool bindingOf: aSymbol. + binding ifNotNil:[^binding]. - "First look in classVar dictionary." - (self classThatDefinesClassVariable: aSymbol) ifNotNil: - [:x | ^x classPool bindingOf: aSymbol]. + "Next look in local shared pools." - "Next look in shared pools." self sharedPools do:[:pool | binding := pool bindingOf: aSymbol. binding ifNotNil:[^binding]. ]. + "Next look into superclass pools" + superclass ifNotNil: [^ superclass bindingOf: aSymbol environment: anEnvironment]. + + "No more superclass... Last look in declared environment." + ^anEnvironment bindingOf: aSymbol - "Next look in declared environment." - binding := anEnvironment bindingOf: aSymbol. - binding ifNotNil:[^binding]. - "Finally look higher up the superclass chain and fail at the end." - superclass == nil - ifTrue: [^ nil] - ifFalse: [^ superclass bindingOf: aSymbol]. - !

1 0

The Trunk: Kernel-nice.798.mcz
by commits＠source.squeak.org 29 Sep '16

29 Sep '16

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.798.mcz ==================== Summary ==================== Name: Kernel-nice.798 Author: nice Time: 30 July 2013, 10:34:15.34 pm UUID: e02ae597-3f6d-40b9-9468-bf01416db6de Ancestors: Kernel-nice.797 Better fix for http://bugs.squeak.org/view.php?id=1554 A class variable defined in a superclass should take precedence over a global variable. First look in local class variables. Then look in local sharedPools (a local sharedPool will shadow a super class variable, that sounds fair). Then look in superclass pools. When superclass chain is exhausted, look in the Environment that were provided as parameter. Note that this is mostly squeak 1.x implementation of #scopeHas:ifTrue: (or st-80), except that anEvironment parameter replaces Smalltalk. This way we avoid duplicate lookup of previous workaround. And we never ever look in superclass environment, that's not necessarily ours. This currently breaks some EnvironmentTest because inheriting superclass environment is a cheap and easy way to import all Smalltalk (unless you are not an Object or ProtoObject of course). The longest and proper way would be to properly export some symbols from Smalltalk globals, and import them explicitely in the tested environment. =============== Diff against Kernel-nice.797 =============== Item was changed: ----- Method: Class>>bindingOf:environment: (in category 'compiling') ----- bindingOf: varName environment: anEnvironment "Answer the binding of some variable resolved in the scope of the receiver" | aSymbol binding | aSymbol := varName asSymbol. + "First look in local classVar dictionary." + binding := self classPool bindingOf: aSymbol. + binding ifNotNil:[^binding]. - "First look in classVar dictionary." - (self classThatDefinesClassVariable: aSymbol) ifNotNil: - [:x | ^x classPool bindingOf: aSymbol]. + "Next look in local shared pools." - "Next look in shared pools." self sharedPools do:[:pool | binding := pool bindingOf: aSymbol. binding ifNotNil:[^binding]. ]. + "Next look into superclass pools" + superclass ifNotNil: [^ superclass bindingOf: aSymbol environment: anEnvironment]. + + "No more superclass... Last look in declared environment." + ^anEnvironment bindingOf: aSymbol - "Next look in declared environment." - binding := anEnvironment bindingOf: aSymbol. - binding ifNotNil:[^binding]. - "Finally look higher up the superclass chain and fail at the end." - superclass == nil - ifTrue: [^ nil] - ifFalse: [^ superclass bindingOf: aSymbol]. - !

1 0

The Trunk: EToys-tfel.259.mcz
by commits＠source.squeak.org 29 Sep '16

29 Sep '16

Tim Felgentreff uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-tfel.259.mcz ==================== Summary ==================== Name: EToys-tfel.259 Author: tfel Time: 29 September 2016, 10:11:59.109594 am UUID: 2f475582-bfa8-48fa-a9eb-362252d134ef Ancestors: EToys-tfel.258 Another fix for copying Kedama, KedamaPatches need to reference the copy of their world, too, if that was copied. =============== Diff against EToys-tfel.258 =============== Item was added: + ----- Method: KedamaPatchMorph>>veryDeepFixupWith: (in category 'copying') ----- + veryDeepFixupWith: deepCopier + + super veryDeepFixupWith: deepCopier. + kedamaWorld := deepCopier references at: kedamaWorld ifAbsent: [kedamaWorld].! Item was changed: + ----- Method: KedamaPatchMorph>>veryDeepInner: (in category 'copying') ----- - ----- Method: KedamaPatchMorph>>veryDeepInner: (in category 'as yet unclassified') ----- veryDeepInner: deepCopier "the state of a Kedama patch is held in its forms, so we need to " form := form deepCopy. displayForm := displayForm deepCopy. tmpForm := tmpForm deepCopy. super veryDeepInner: deepCopier.!

1 0

The Trunk: EToys-tfel.258.mcz
by commits＠source.squeak.org 28 Sep '16

28 Sep '16

Tim Felgentreff uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-tfel.258.mcz ==================== Summary ==================== Name: EToys-tfel.258 Author: tfel Time: 28 September 2016, 5:27:37.334594 pm UUID: ef184947-0831-4b86-9f5f-5707547734bc Ancestors: EToys-tfel.257 - Fix for duplicating KedamaMorphs with non-visible patches or turtles - be careful not to loose top level projects when deleting projects through the etoys history morph - setTurtleCount: on a vector player should go to the exampler player =============== Diff against EToys-tfel.257 =============== Item was changed: ----- Method: EToyProjectHistoryMorph>>confirmedDelete:evt:from: (in category 'as yet unclassified') ----- confirmedDelete: aProject evt: evt from: origin self delete. aProject = Project current ifTrue: [ ^ self inform: 'Cannot delete current project' translated]. (self confirm: ('Do you really want to delete {1} and all its content?' translated format: {aProject name})) + ifTrue: [ + aProject isTopProject ifTrue: [Project current beTopProject]. + aProject delete. + Project rebuildAllProjects].! - ifTrue: [aProject delete].! Item was changed: ----- Method: KedamaMorph>>duplicate (in category 'as yet unclassified') ----- duplicate | allMorphBounds allMorphs allOwners copyW s w | allMorphs := {self}, self player allPatchAndTurtleMorphs. allOwners := allMorphs collect: #owner. allMorphBounds := allMorphs allButFirst inject: self bounds into: [:acc :next | next bounds merge: acc]. w := PasteUpMorph new. w bounds: allMorphBounds. w openInWorld. w addAllMorphs: allMorphs. copyW := w duplicate. + allMorphs withIndexDo: [:m :idx | (allOwners at: idx) ifNotNil: [:o | o addMorph: m]]. - allMorphs withIndexDo: [:m :idx | (allOwners at: idx) addMorph: m]. w delete. s := SelectionMorph new. s bounds: copyW bounds. s selectSubmorphsOf: copyW. ^ s! Item was added: + ----- Method: KedamaTurtleVectorPlayer2>>setTurtleCount: (in category 'slot-kedama') ----- + setTurtleCount: aNumber + + ^ exampler setTurtleCount: aNumber!

1 0

The Trunk: EToys-tfel.257.mcz
by commits＠source.squeak.org 28 Sep '16

28 Sep '16

Tim Felgentreff uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-tfel.257.mcz ==================== Summary ==================== Name: EToys-tfel.257 Author: tfel Time: 28 September 2016, 2:02:17.012904 pm UUID: a4bd9831-92ff-fb4f-9f7f-0681429e8add Ancestors: EToys-tfel.256 make Kedama worlds copyable, by forcing it to always copy also its patches and turtles, and fixing up the deep copying so these players are copied correctly and their scripts are also recompiled correctly. =============== Diff against EToys-tfel.256 =============== Item was added: + ----- Method: KedamaExamplerPlayer>>veryDeepInner: (in category 'copying') ----- + veryDeepInner: deepCopier + "Special code that handles user-added instance variables of a uniClass. + Copy all of my instance variables. Some need to be not copied at all, but shared. This is special code for the dictionary. See DeepCopier." + + kedamaWorld := kedamaWorld veryDeepCopyWith: deepCopier. + turtles := turtles veryDeepCopyWith: deepCopier. + sequentialStub := sequentialStub veryDeepCopyWith: deepCopier. + super veryDeepInner: deepCopier. + ! Item was added: + ----- Method: KedamaMorph>>duplicate (in category 'as yet unclassified') ----- + duplicate + + | allMorphBounds allMorphs allOwners copyW s w | + allMorphs := {self}, self player allPatchAndTurtleMorphs. + allOwners := allMorphs collect: #owner. + allMorphBounds := allMorphs allButFirst + inject: self bounds into: [:acc :next | next bounds merge: acc]. + w := PasteUpMorph new. + w bounds: allMorphBounds. + w openInWorld. + w addAllMorphs: allMorphs. + copyW := w duplicate. + allMorphs withIndexDo: [:m :idx | (allOwners at: idx) addMorph: m]. + w delete. + s := SelectionMorph new. + s bounds: copyW bounds. + s selectSubmorphsOf: copyW. + ^ s! Item was changed: ----- Method: KedamaMorph>>isVisible: (in category 'private') ----- isVisible: examplerPlayer | turtleMorph | turtleMorph := examplerPlayer costume. turtleMorph visible ifFalse: [^ false]. + turtleMorph world ifNil: [^ false]. turtleMorph owner isRenderer ifFalse: [^ true]. ^ turtleMorph owner visible. ! Item was changed: ----- Method: KedamaMorph>>offerCostumeViewerMenu: (in category 'menu') ----- offerCostumeViewerMenu: aMenu aMenu add: 'add a new patch variable' translated action: #newPatch. aMenu balloonTextForLastItem: 'Add a new patch variable' translated. aMenu add: 'add a new breed of turtle' translated action: #newTurtle. aMenu balloonTextForLastItem: 'Add a new turtle' translated. aMenu addLine. + aMenu add: 'gather patches and turtles' translated action: #gatherPatchesAndTurtles. + aMenu balloonTextForLastItem: 'Show all turtles next to me' translated. ! Item was added: + ----- Method: KedamaMorph>>patches (in category 'accessing') ----- + patches + + ^ patchesToDisplay! Item was added: + ----- Method: KedamaMorph>>turtles (in category 'accessing') ----- + turtles + + ^ turtlesDict keys! Item was added: + ----- Method: KedamaPatchMorph>>veryDeepInner: (in category 'as yet unclassified') ----- + veryDeepInner: deepCopier + "the state of a Kedama patch is held in its forms, so we need to " + form := form deepCopy. + displayForm := displayForm deepCopy. + tmpForm := tmpForm deepCopy. + super veryDeepInner: deepCopier.! Item was added: + ----- Method: Player>>allPatchAndTurtleMorphs (in category 'slot-kedama') ----- + allPatchAndTurtleMorphs + + self costume ifNil: [^ #()]. + ^ self costume patches, (self costume turtles collect: #costume)! Item was added: + ----- Method: Player>>gatherPatchesAndTurtles (in category 'slot-kedama') ----- + gatherPatchesAndTurtles + + | position | + self costume owner ifNil: [^ self]. + position := self costume topRight + (5@0). + self allPatchAndTurtleMorphs do: [:m | + m ifNotNil: [ + m position: position. + self costume owner addMorph: m. + m visible: true. + position := position + (0@(m height + 5))]].! Item was added: + ----- Method: UniclassScript>>veryDeepFixupWith: (in category 'copying') ----- + veryDeepFixupWith: deepCopier + + super veryDeepFixupWith: deepCopier. + self flag: #todo. "Textually coded scripts may also have to be adapted" + Project current addDeferredUIMessage: [ + "We do this in a deferred way, because the deep copying may non-deterministically + be in a state where not all referenced players already have copies, so then we recompile the + script, but we still reference the wrong players!! - tfel,jl" + self recompileScriptFromTilesUnlessTextuallyCoded].!

1 0

The Trunk: EToys-tfel.256.mcz
by commits＠source.squeak.org 27 Sep '16

27 Sep '16

Tim Felgentreff uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-tfel.256.mcz ==================== Summary ==================== Name: EToys-tfel.256 Author: tfel Time: 27 September 2016, 3:48:35.810629 pm UUID: 67cc3cc0-a391-2e4e-af52-dd6bbc2e1f03 Ancestors: EToys-tfel.255 - various fixes for the mentoring event recorder - utility methods for etoys course =============== Diff against EToys-tfel.255 =============== Item was changed: ----- Method: InteriorSolidSugarSuppliesTab>>mouseMove: (in category 'event handling') ----- mouseMove: evt "Handle a mouse-move within the solid tab." | aPosition newReferentThickness adjustedPosition thick aWorldlet | + true ifTrue: [^ self]. dragged ifFalse: [(thick := self referentThickness) > 0 ifTrue: [lastReferentThickness := thick]]. aWorldlet := self ownerThatIsA: Worldlet. aPosition := evt cursorPoint - aWorldlet position. edgeToAdhereTo == #top ifTrue: [adjustedPosition := aPosition - evt hand targetOffset. newReferentThickness := adjustedPosition y - self navBarHeight] ifFalse: [adjustedPosition := aPosition - evt hand targetOffset. newReferentThickness := aWorldlet height - (adjustedPosition y + self navBarHeight + self height)]. self applyThickness: newReferentThickness. dragged := true. self fitOnScreen! Item was changed: ----- Method: MentoringEventRecorder>>handleListenEvent: (in category 'events-processing') ----- handleListenEvent: anEvent "Process a listen event." anEvent hand == recHand ifFalse: [^ self]. "not for me" (#(recording recordingWithSound) includes: self state) ifFalse: ["If user got an error while recording and deleted recorder, will still be listening" recHand ifNotNil: [recHand removeEventListener: self]. ^ self]. + anEvent timeStamp: Time millisecondClockValue. "Workaround a bug in Windows VM" anEvent = lastEvent ifTrue: [^ self]. (anEvent isKeyboard and: [anEvent keyValue = 27 "esc"]) ifTrue: [^ self handleEscape]. time := anEvent timeStamp. tapeStream ifNotNil: [tapeStream nextPut: (anEvent copy setHand: nil)]. lastEvent := anEvent! Item was changed: ----- Method: MentoringEventRecorder>>pauseIn: (in category 'pause/resume') ----- pauseIn: aWorld "Suspend -- a stop command, typically because an EOF event was found on the event tape being played." (#(recordingWithSound playbackAddingVoiceover) includes: self state) ifTrue: [self terminateVoiceRecording. self state: #atEndOfPlayback. recHand ifNotNil: [recHand removeEventListener: self]. recHand := nil.]. (#(playback) includes: self state) ifTrue: [self state: #suspendedPlay. playHand ifNotNil: [playHand halo ifNotNil: [playHand halo delete]. playHand delete]. aWorld removeHand: playHand. self removeProperty: #suspendedContentArea. playHand := nil. + recordingSpace playingEnded. + aWorld firstHand showHardwareCursor: true] - recordingSpace playingEnded] ! Item was changed: ----- Method: MentoringEventRecorder>>resumePlayIn: (in category 'pause/resume') ----- resumePlayIn: aWorld "Playback" | anEvent aPosition | recordingSpace abandonReplayHandsAndHalos. self flag: #deferred. "I guess it's the above line that messes up the nesting of these guys..." self state: #playback. recordingSpace populateControlsPanel. aWorld doOneCycle. playHand := HandMorphForReplay new recorder: self. [((anEvent := tapeStream next) notNil and: [(anEvent isKindOf: UserInputEvent) not])] whileTrue: []. aPosition := anEvent ifNil: [recordingSpace contentArea center] ifNotNil: [anEvent position]. tapeStream reset. playHand position: aPosition + recordingSpace areaOffset. aWorld addHand: playHand. playHand newKeyboardFocus: aWorld. + playHand userInitials: '' andPicture: nil. - playHand userInitials: 'play' andPicture: nil. lastEvent := nil. lastDelta := 0@0. startPlaybackTime := Time millisecondClockValue. millisecondsIntoPlayback := 0. self findPlayOffset. self synchronize ! Item was changed: ----- Method: PasteUpMorph>>impartPrivatePresenter (in category '*Etoys-playfield') ----- impartPrivatePresenter presenter ifNil: [presenter := EtoysPresenter new associatedMorph: self. + "presenter standardPlayer"]! - presenter standardPlayer]! Item was added: + ----- Method: Project class>>cleanUpEtoysGarbage (in category '*Etoys-Squeakland-utilities') ----- + cleanUpEtoysGarbage + "Project cleanUpEtoysGarbage" + "All these should eventuall go away and be fixed, but for now we have this here." + Smalltalk garbageCollect. + "Clear weak message sends to remove modal windows from worlds that are closing." + (WeakMessageSend allInstances select: [:wm | + (wm receiver isKindOf: PasteUpMorph) and: [wm selector = #removeModalWindow]]) do: [:wm | wm receiver: nil]. + "Clear the weak dictionary on the class side that keeps node state around in the rewriter" + KedamaEvaluatorNodeState initialize. + "Clear the KedamaEvaluator that holds on to the last Kedama world" + ScriptEditorMorph setDefaultEvaluator. + "Clear the hard references to player classes, " + (Smalltalk organization listAtCategoryNamed: 'UserObjects') do: [:name | + Smalltalk forgetClass: (Smalltalk classNamed: name) logged: false]. + Player withAllSubclasses + select: [:c | c isSystemDefined not] + thenDo: [:c | c superclass removeSubclass: c]. + "Clear the paste buffer" + HandMorph initialize. + "Clear the reference to the project tree in SkObject" + SkObject initialize. + Smalltalk garbageCollect.! Item was added: + ----- Method: Project class>>makeANewLocalGallery (in category '*Etoys-Squeakland-utilities') ----- + makeANewLocalGallery + | m pvm | + m := Morph new + changeTableLayout; + listDirection: #leftToRight; + wrapDirection: #topToBottom; + yourself. + (((FileDirectory default fileNamesMatching: '*.pr') + collect: [:name | (Project parseProjectFileName: name) first]) asSet sorted) do: [:name | + pvm := ProjectViewMorph new. + m addMorph: (pvm + project: (DiskProxy global: #Project selector: #named: args: {name}))]. + m openInHand!

1 0

The Trunk: EToys-tfel.255.mcz
by commits＠source.squeak.org 27 Sep '16

27 Sep '16

Tim Felgentreff uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-tfel.255.mcz ==================== Summary ==================== Name: EToys-tfel.255 Author: tfel Time: 27 September 2016, 3:44:53.921268 pm UUID: 76eaa9ec-bd5b-7c48-b15a-fff14d6af1ee Ancestors: EToys-tfel.254 pretend uniclasses have an environment, to make the compilation paths work =============== Diff against EToys-tfel.254 =============== Item was removed: - ----- Method: Player class>>category (in category 'organization') ----- - category - - ^ super category ifNil: [self categoryForUniclasses]! Item was added: + ----- Method: Player class>>environment (in category 'organization') ----- + environment + + ^ self isUniClass + ifTrue: [(Environment withName: 'EtoysUserDefinedTempEnvironment') + at: self name put: self; + yourself] + ifFalse: [super environment]!

1 0

The Trunk: Kernel-tfel.1041.mcz
by commits＠source.squeak.org 27 Sep '16

27 Sep '16

Tim Felgentreff uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-tfel.1041.mcz ==================== Summary ==================== Name: Kernel-tfel.1041 Author: tfel Time: 27 September 2016, 3:41:40.508268 pm UUID: 31da1f70-2af0-e74e-b46c-74f1c7b615b7 Ancestors: Kernel-tfel.1040 uniclasses might not have a category =============== Diff against Kernel-tfel.1040 =============== Item was changed: ----- Method: ClassBuilder>>name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe: (in category 'class definition') ----- name: className inEnvironment: env subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe "Define a new class in the given environment. If unsafe is true do not run any validation checks. This facility is provided to implement important system changes." | oldClass instVars classVars copyOfOldClass newClass | environ := env. instVars := Scanner new scanFieldNames: instVarString. classVars := (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol]. "Validate the proposed name" unsafe ifFalse:[(self validateClassName: className) ifFalse:[^nil]]. oldClass := env at: className ifAbsent:[nil]. oldClass isBehavior ifFalse: [oldClass := nil] "Already checked in #validateClassName:" ifTrue: [ copyOfOldClass := oldClass copy. copyOfOldClass superclass addSubclass: copyOfOldClass]. [ | newCategory needNew force organization oldCategory | unsafe ifFalse:[ "Run validation checks so we know that we have a good chance for recompilation" (self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil]. (self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil]. (self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil]. (self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]]. "See if we need a new subclass" needNew := self needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass. needNew == nil ifTrue:[^nil]. "some error" (needNew and:[unsafe not]) ifTrue:[ "Make sure we don't redefine any dangerous classes" (self tooDangerousClasses includes: oldClass name) ifTrue:[ self error: oldClass name, ' cannot be changed'. ]. "Check if the receiver should not be redefined" (oldClass ~~ nil and:[oldClass shouldNotBeRedefined]) ifTrue:[ self notify: oldClass name asText allBold, ' should not be redefined. \Proceed to store over it.' withCRs]]. needNew ifTrue:[ "Create the new class" newClass := self newSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass. newClass == nil ifTrue:[^nil]. "Some error" newClass setName: className. newClass environment: environ. ] ifFalse:[ "Reuse the old class" newClass := oldClass. ]. "Install the class variables and pool dictionaries... " force := (newClass declare: classVarString) | (newClass sharing: poolString). "... classify ..." + category ifNotNil: [ + newCategory := category asSymbol. + organization := environ ifNotNil:[environ organization]. + oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol]. + organization classify: newClass name under: newCategory suppressIfDefault: true]. + - newCategory := category asSymbol. - organization := environ ifNotNil:[environ organization]. - oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol]. - organization classify: newClass name under: newCategory suppressIfDefault: true. - "... recompile ..." newClass := self recompile: force from: oldClass to: newClass mutate: false. "... export if not yet done ..." (environ at: newClass name ifAbsent:[nil]) == newClass ifFalse:[ [environ at: newClass name put: newClass] on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true]. environ flushClassNameCache. ]. newClass doneCompiling. "... notify interested clients ..." oldClass isNil ifTrue: [ SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory. ^ newClass]. newCategory ~= oldCategory ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category] ifFalse: [SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.]. ] ensure: [copyOfOldClass ifNotNil: [copyOfOldClass superclass removeSubclass: copyOfOldClass]. Behavior flushObsoleteSubclasses. ]. ^newClass!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages September 2016