'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5623] on 28 January 2004 at 11:12:37 am'! "Change Set: SystemChangeHooks Date: 2 August 2003 Author: Roel Wuyts System hooks that call the SystemChangeNotifier. Has to be filed in last, since the notifications are already used during file-in. This is the version for Squeak 3.7 and up. Users of Squeak 3.6 or older have to load older versions available from Roel Wuyts (roel.wuyts@ulb.ac.be)."! !Browser methodsFor: 'message category functions' stamp: 'NS 1/27/2004 12:53'! alphabetizeMessageCategories classListIndex = 0 ifTrue: [^ false]. self okToChange ifFalse: [^ false]. self classOrMetaClassOrganizer sortCategories. self clearUserEditFlag. self editClass. self classListIndex: classListIndex. SystemChangeNotifier uniqueInstance classReorganized: self selectedClassOrMetaClass. ^ true! ! !Browser methodsFor: 'message category functions' stamp: 'NS 1/27/2004 13:00'! changeMessageCategories: aString "The characters in aString represent an edited version of the the message categories for the selected class. Update this information in the system and inform any dependents that the categories have been changed. This message is invoked because the user had issued the categories command and edited the message categories. Then the user issued the accept command." self classOrMetaClassOrganizer changeFromString: aString. self clearUserEditFlag. self editClass. self classListIndex: classListIndex. SystemChangeNotifier uniqueInstance classReorganized: self selectedClassOrMetaClass. ^ true! ! !Browser methodsFor: 'message category functions' stamp: 'NS 1/27/2004 13:01'! renameCategory "Prompt for a new category name and add it before the current selection, or at the end if no current selection" | oldIndex oldName newName | classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. (oldIndex _ messageCategoryListIndex) = 0 ifTrue: [^ self]. oldName _ self selectedMessageCategoryName. newName _ self request: 'Please type new category name' initialAnswer: oldName. newName isEmpty ifTrue: [^ self] ifFalse: [newName _ newName asSymbol]. newName = oldName ifTrue: [^ self]. self classOrMetaClassOrganizer renameCategory: oldName toBe: newName. self classListIndex: classListIndex. self messageCategoryListIndex: oldIndex. self changed: #messageCategoryList. SystemChangeNotifier uniqueInstance classReorganized: self selectedClassOrMetaClass. ! ! !ChangeSet methodsFor: 'change logging' stamp: 'NS 1/19/2004 18:30'! changeClass: class from: oldClass "Remember that a class definition has been changed. Record the original structure, so that a conversion method can be built." class wantsChangeSetLogging ifFalse: [^ self]. isolationSet ifNotNil: ["If there is an isolation layer above me, inform it as well." isolationSet changeClass: class from: oldClass]. class isMeta ifFalse: [self atClass: class add: #change] "normal" ifTrue: [((self classChangeAt: class theNonMetaClass name) includes: #add) ifTrue: [self atClass: class add: #add] "When a class is defined, the metaclass is not recorded, even though it was added. A further change is really just part of the original add." ifFalse: [self atClass: class add: #change]]. self addCoherency: class name. (self changeRecorderFor: class) notePriorDefinition: oldClass. self noteClassStructure: oldClass! ! !ChangeSet methodsFor: 'change logging' stamp: 'NS 1/27/2004 15:55'! event: anEvent "Hook for SystemChangeNotifier" (anEvent isRemoved and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self noteRemovalOf: anEvent item]. (anEvent isAdded and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self addClass: anEvent item]. (anEvent isModified and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [anEvent anyChanges ifTrue: [self changeClass: anEvent item from: anEvent oldItem]]. (anEvent isCommented and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self commentClass: anEvent item]. (anEvent isAdded and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [self noteNewMethod: anEvent item forClass: anEvent itemClass selector: anEvent itemSelector priorMethod: nil]. (anEvent isModified and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [self noteNewMethod: anEvent item forClass: anEvent itemClass selector: anEvent itemSelector priorMethod: anEvent oldItem]. (anEvent isRemoved and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [self removeSelector: anEvent itemSelector class: anEvent itemClass priorMethod: anEvent item lastMethodInfo: {anEvent item sourcePointer. anEvent itemProtocol}]. (anEvent isRenamed and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self renameClass: anEvent item as: anEvent newName]. (anEvent isReorganized and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self reorganizeClass: anEvent item].! ! !ChangeSet methodsFor: 'class changes' stamp: 'NS 1/26/2004 09:46'! commentClass: class "Include indication that a class comment has been changed." class wantsChangeSetLogging ifFalse: [^ self]. self atClass: class add: #comment! ! !ChangeSet methodsFor: 'class changes' stamp: 'NS 1/19/2004 17:49'! noteRemovalOf: class "The class is about to be removed from the system. Adjust the receiver to reflect that fact." class wantsChangeSetLogging ifFalse: [^ self]. (self changeRecorderFor: class) noteChangeType: #remove fromClass: class. changeRecords removeKey: class class name ifAbsent: [].! ! !ClassBuilder methodsFor: 'class definition' stamp: 'NS 1/21/2004 09:20'! class: oldClass instanceVariableNames: instVarString unsafe: unsafe "This is the basic initialization message to change the definition of an existing Metaclass" | instVars newClass needNew copyOfOldClass | environ _ oldClass environment. instVars _ Scanner new scanFieldNames: instVarString. unsafe ifFalse:[ "Run validation checks so we know that we have a good chance for recompilation" (self validateInstvars: instVars from: oldClass forSuper: oldClass superclass) ifFalse:[^nil]. (self validateSubclassFormat: oldClass typeOfClass from: oldClass forSuper: oldClass superclass extra: instVars size) ifFalse:[^nil]]. "See if we need a new subclass or not" needNew _ self needsSubclassOf: oldClass superclass type: oldClass typeOfClass instanceVariables: instVars from: oldClass. needNew ifNil:[^nil]. "some error" needNew ifFalse:[^oldClass]. "no new class needed" "Create the new class" copyOfOldClass _ oldClass copy. newClass _ self newSubclassOf: oldClass superclass type: oldClass typeOfClass instanceVariables: instVars from: oldClass. newClass _ self recompile: false from: oldClass to: newClass mutate: false. self doneCompiling: newClass. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass. ^newClass! ! !ClassBuilder methodsFor: 'class definition' stamp: 'NS 1/20/2004 19:46'! 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 newClass organization instVars classVars force needNew oldCategory copyOfOldClass newCategory | 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:" copyOfOldClass _ oldClass copy. 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. ] ifFalse:[ "Reuse the old class" newClass _ oldClass. ]. "Install the class variables and pool dictionaries... " force _ (newClass declare: classVarString) | (newClass sharing: poolString). "... classify ..." newCategory _ category asSymbol. organization _ environ ifNotNil:[environ organization]. oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol]. organization classify: newClass name under: newCategory. newClass environment: environ. "... 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]. Smalltalk flushClassNameCache. ]. self doneCompiling: newClass. "... notify interested clients ..." oldClass isNil ifTrue: [ SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory. ^ newClass]. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass. newCategory ~= oldCategory ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category]. ^newClass! ! !ClassBuilder methodsFor: 'class definition' stamp: 'NS 1/21/2004 09:53'! recompile: force from: oldClass to: newClass mutate: forceMutation "Do the necessary recompilation after changine oldClass to newClass. If required (e.g., when oldClass ~~ newClass) mutate oldClass to newClass and all its subclasses. If forceMutation is true force a mutation even if oldClass and newClass are the same." oldClass == nil ifTrue:[^ newClass]. (newClass == oldClass and:[force not and:[forceMutation not]]) ifTrue:[ ^newClass]. currentClassIndex _ 0. maxClassIndex _ oldClass withAllSubclasses size. (oldClass == newClass and:[forceMutation not]) ifTrue:[ "Recompile from newClass without mutating" self informUserDuring:[ newClass isSystemDefined ifFalse:[progress _ nil]. newClass withAllSubclassesDo:[:cl| self showProgressFor: cl. cl compileAll]]. ^newClass]. "Recompile and mutate oldClass to newClass" self informUserDuring:[ newClass isSystemDefined ifFalse:[progress _ nil]. self mutate: oldClass to: newClass. ]. ^oldClass "now mutated to newClass"! ! !ClassBuilder methodsFor: 'class definition' stamp: 'NS 1/21/2004 09:21'! silentlyMoveInstVarNamed: instVarName from: srcClass to: dstClass after: prevInstVarName "Move the instvar from srcClass to dstClass. Do not perform any checks." | srcVars dstVars dstIndex newClass copyOfSrcClass copyOfDstClass | copyOfSrcClass _ srcClass copy. copyOfDstClass _ dstClass copy. srcVars _ srcClass instVarNames copyWithout: instVarName. srcClass == dstClass ifTrue:[dstVars _ srcVars] ifFalse:[dstVars _ dstClass instVarNames]. dstIndex _ dstVars indexOf: prevInstVarName. dstVars _ (dstVars copyFrom: 1 to: dstIndex), (Array with: instVarName), (dstVars copyFrom: dstIndex+1 to: dstVars size). instVarMap at: srcClass name put: srcVars. instVarMap at: dstClass name put: dstVars. (srcClass inheritsFrom: dstClass) ifTrue:[ newClass _ self reshapeClass: dstClass toSuper: dstClass superclass. self recompile: false from: dstClass to: newClass mutate: true. ] ifFalse:[ (dstClass inheritsFrom: srcClass) ifTrue:[ newClass _ self reshapeClass: srcClass toSuper: srcClass superclass. self recompile: false from: srcClass to: newClass mutate: true. ] ifFalse:[ "Disjunct hierarchies" srcClass == dstClass ifFalse:[ newClass _ self reshapeClass: dstClass toSuper: dstClass superclass. self recompile: false from: dstClass to: newClass mutate: true. ]. newClass _ self reshapeClass: srcClass toSuper: srcClass superclass. self recompile: false from: srcClass to: newClass mutate: true. ]. ]. self doneCompiling: srcClass. self doneCompiling: dstClass. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfSrcClass to: srcClass. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfDstClass to: dstClass.! ! !ClassBuilder methodsFor: 'private' stamp: 'NS 1/27/2004 14:21'! recordClass: oldClass replacedBy: newClass "Keep the changes up to date when we're moving instVars around" (instVarMap includesKey: oldClass name) ifTrue:[ SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldClass to: newClass. ].! ! !ClassDescription methodsFor: 'accessing' stamp: 'NS 1/27/2004 14:54'! comment: aStringOrText "Set the receiver's comment to be the argument, aStringOrText." self theNonMetaClass classComment: aStringOrText.! ! !ClassDescription methodsFor: 'accessing' stamp: 'NS 1/27/2004 14:54'! comment: aStringOrText stamp: aStamp "Set the receiver's comment to be the argument, aStringOrText." self theNonMetaClass classComment: aStringOrText stamp: aStamp.! ! !ClassDescription methodsFor: 'instance variables' stamp: 'NS 1/27/2004 11:49'! renameSilentlyInstVar: old to: new | i oldName newName | oldName _ old asString. newName _ new asString. (i _ instanceVariables indexOf: oldName) = 0 ifTrue: [self error: oldName , ' is not defined in ', self name]. self allSuperclasses , self withAllSubclasses asOrderedCollection do: [:cls | (cls instVarNames includes: newName) ifTrue: [self error: newName , ' is already used in ', cls name]]. instanceVariables replaceFrom: i to: i with: (Array with: newName). self replaceSilently: oldName to: newName. "replace in text body of all methods"! ! !ClassDescription methodsFor: 'method dictionary' stamp: 'NS 1/28/2004 11:11'! removeSelector: selector | priorMethod priorProtocol | "Remove the message whose selector is given from the method dictionary of the receiver, if it is there. Answer nil otherwise." (self methodDict includesKey: selector) ifFalse: [^ nil]. priorMethod _ self compiledMethodAt: selector. priorProtocol := self whichCategoryIncludesSelector: selector. super removeSelector: selector. self organization removeElement: selector. SystemChangeNotifier uniqueInstance methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self! ! !ClassDescription methodsFor: 'organization' stamp: 'rw 8/2/2003 11:05'! category: cat "Categorize the receiver under the system category, cat, removing it from any previous categorization." | oldCat | oldCat := self category. (cat isKindOf: String) ifTrue: [SystemOrganization classify: self name under: cat asSymbol] ifFalse: [self errorCategoryName]. SystemChangeNotifier uniqueInstance class: self recategorizedFrom: oldCat to: cat asSymbol! ! !ClassDescription methodsFor: 'compiling' stamp: 'NS 1/26/2004 13:33'! compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource | selector priorMethodOrNil method methodNode newText | SystemChangeNotifier uniqueInstance doSilently: [method _ self compile: text asString notifying: requestor trailer: #(0 0 0 0) ifFail: [^nil] elseSetSelectorAndNode: [:sel :node | selector _ sel. priorMethodOrNil _ self compiledMethodAt: selector ifAbsent: [nil]. methodNode _ node]]. logSource ifTrue: [newText _ ((requestor == nil or: [requestor isKindOf: SyntaxError]) not and: [Preferences confirmFirstUseOfStyle]) ifTrue: [text askIfAddStyle: priorMethodOrNil req: requestor] ifFalse: [text]. method putSource: newText fromParseNode: methodNode class: self category: category withStamp: changeStamp inFile: 2 priorMethod: priorMethodOrNil]. SystemChangeNotifier uniqueInstance doSilently: [self organization classify: selector under: category]. self theNonMetaClass noteCompilationOf: selector meta: self isMeta. priorMethodOrNil isNil ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: method selector: selector inProtocol: category class: self requestor: requestor] ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: method selector: selector inClass: self requestor: requestor]. ^ selector! ! !ClassDescription methodsFor: 'compiling' stamp: 'NS 1/26/2004 17:28'! compile: code notifying: requestor trailer: bytes ifFail: failBlock elseSetSelectorAndNode: selAndNodeBlock "Intercept this message in order to remember system changes. 5/15/96 sw: modified so that if the class does not wish its methods logged in the changes file, then they also won't be accumulated in the current change set. 7/12/96 sw: use wantsChangeSetLogging to determine whether to put in change set" | methodNode selector newMethod priorMethodOrNil | methodNode _ self compilerClass new compile: code in: self notifying: requestor ifFail: failBlock. selector _ methodNode selector. selAndNodeBlock value: selector value: methodNode. methodNode encoder requestor: requestor. "Why was this not preserved?" newMethod _ methodNode generate: bytes. priorMethodOrNil _ self compiledMethodAt: selector ifAbsent: [nil]. self addSelector: selector withMethod: newMethod. priorMethodOrNil isNil ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: newMethod selector: selector inClass: self requestor: requestor] ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: newMethod selector: selector inClass: self requestor: requestor]. ^ newMethod! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'NS 1/27/2004 14:54'! classComment: aString stamp: aStamp "Store the comment, aString or Text or RemoteString, associated with the class we are organizing. Empty string gets stored only if had a non-empty one before." | ptr header file oldCommentRemoteStr | (aString isKindOf: RemoteString) ifTrue: [SystemChangeNotifier uniqueInstance classCommented: self. ^ self organization classComment: aString stamp: aStamp]. oldCommentRemoteStr _ self organization commentRemoteStr. (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ organization classComment: nil]. "never had a class comment, no need to write empty string out" ptr _ oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. SourceFiles ifNotNil: [(file _ SourceFiles at: 2) ifNotNil: [file setToEnd; cr; nextPut: $!!. "directly" "Should be saying (file command: 'H3') for HTML, but ignoring it here" header _ String streamContents: [:strm | strm nextPutAll: self name; nextPutAll: ' commentStamp: '. aStamp storeOn: strm. strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. file nextChunkPut: header]]. SystemChangeNotifier uniqueInstance classCommented: self. organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp ! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'NS 1/27/2004 14:55'! reorganize "During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization. See the transfer of control where ReadWriteStream fileIn calls scanFrom:" SystemChangeNotifier uniqueInstance classReorganized: self. ^self organization! ]style[(10 156 22 20 59 20)f1b,f1,f1LReadWriteStream fileIn;,f1,f2,f1! ! !Class methodsFor: 'initialize-release' stamp: 'NS 1/16/2004 15:16'! removeFromSystem: logged "Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver." "keep the class name and category for triggering the system change message. If we wait to long, then we get obsolete information which is not what we want." "tell class to deactivate and unload itself-- two separate events in the module system" self deactivate; unload. self superclass ifNotNil: ["If we have no superclass there's nothing to be remembered" self superclass addObsoleteSubclass: self]. self environment forgetClass: self logged: logged. self obsolete.! ! !Class methodsFor: 'class name' stamp: 'NS 1/15/2004 15:41'! rename: aString "The new name of the receiver is the argument, aString." | newName | (newName _ aString asSymbol) ~= self name ifFalse: [^ self]. (self environment includesKey: newName) ifTrue: [^ self error: newName , ' already exists']. (Undeclared includesKey: newName) ifTrue: [self inform: 'There are references to, ' , aString printString , ' from Undeclared. Check them after this change.']. self environment renameClass: self as: newName. name _ newName! ! !Class methodsFor: 'class variables' stamp: 'NS 1/27/2004 14:19'! addClassVarName: aString "Add the argument, aString, as a class variable of the receiver. Signal an error if the first character of aString is not capitalized, or if it is already a variable named in the class." | symbol oldState | oldState _ self copy. aString first isLowercase ifTrue: [^self error: aString, ' class variable name should be capitalized; proceed to include anyway.']. symbol _ aString asSymbol. self withAllSubclasses do: [:subclass | (subclass bindingOf: symbol) ifNotNil:[ ^ self error: aString , ' is already used as a variable name in class ' , subclass name]]. classPool == nil ifTrue: [classPool _ Dictionary new]. (classPool includesKey: symbol) ifFalse: ["Pick up any refs in Undeclared" classPool declare: symbol from: Undeclared. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldState to: self]! ! !ChangeSet class methodsFor: 'current changeset' stamp: 'NS 1/16/2004 14:49'! newChanges: aChangeSet "Set the system ChangeSet to be the argument, aChangeSet. Tell the current project that aChangeSet is now its change set. When called from Project enter:, the setChangeSet: call is redundant but harmless; when called from code that changes the current-change-set from within a project, it's vital" SystemChangeNotifier uniqueInstance noMoreNotificationsFor: current. current isolationSet: nil. current _ aChangeSet. SystemChangeNotifier uniqueInstance notify: aChangeSet ofAllSystemChangesUsing: #event:. Smalltalk currentProjectDo: [:proj | proj setChangeSet: aChangeSet. aChangeSet isolationSet: proj isolationSet]! ! !ClassOrganizer methodsFor: 'method dictionary' stamp: 'rw 8/2/2003 11:13'! classify: element under: heading suppressIfDefault: aBoolean "Store the argument, element, in the category named heading. If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein" | catName catIndex elemIndex realHeading myClass | ((heading = NullCategory) or: [heading == nil]) ifTrue: [realHeading _ Default] ifFalse: [realHeading _ heading asSymbol]. (catName _ self categoryOfElement: element) = realHeading ifTrue: [^ self]. "done if already under that category" catName ~~ nil ifTrue: [(aBoolean and: [realHeading = Default]) ifTrue: [^ self]. "return if non-Default category already assigned in memory" self removeElement: element]. "remove if in another category" (categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading]. catIndex _ categoryArray indexOf: realHeading. elemIndex _ catIndex > 1 ifTrue: [categoryStops at: catIndex - 1] ifFalse: [0]. [(elemIndex _ elemIndex + 1) <= (categoryStops at: catIndex) and: [element >= (elementArray at: elemIndex)]] whileTrue. "elemIndex is now the index for inserting the element. Do the insertion before it." elementArray _ elementArray copyReplaceFrom: elemIndex to: elemIndex-1 with: (Array with: element). "add one to stops for this and later categories" catIndex to: categoryArray size do: [:i | categoryStops at: i put: (categoryStops at: i) + 1]. self ifClassOrganizerDo: [ SystemNavigation new allBehaviorsDo: [:aClass | (aClass organization == self) ifTrue: [myClass := aClass]]. SystemChangeNotifier uniqueInstance selector: element recategorizedFrom: catName to: realHeading inClass: myClass]. (self listAtCategoryNamed: Default) size = 0 ifTrue: [self removeCategory: Default]! ! !Compiler methodsFor: 'public access' stamp: 'NS 1/19/2004 10:00'! evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag "Compiles the sourceStream into a parse tree, then generates code into a method. This method is then installed in the receiver's class so that it can be invoked. In other words, if receiver is not nil, then the text can refer to instance variables of that receiver (the Inspector uses this). If aContext is not nil, the text can refer to temporaries in that context (the Debugger uses this). If aRequestor is not nil, then it will receive a notify:at: message before the attempt to evaluate is aborted. Finally, the compiled method is invoked from here as DoIt or (in the case of evaluation in aContext) DoItIn:. The method is subsequently removed from the class, but this will not get done if the invocation causes an error which is terminated. Such garbage can be removed by executing: Smalltalk allBehaviorsDo: [:cl | cl removeSelector: #DoIt; removeSelector: #DoItIn:]." | methodNode method value selector | class _ (aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class. self from: textOrStream class: class context: aContext notifying: aRequestor. methodNode _ self translate: sourceStream noPattern: true ifFail: [^failBlock value]. method _ methodNode generate: #(0 0 0 0). self interactive ifTrue: [method _ method copyWithTempNames: methodNode tempNames]. selector _ context isNil ifTrue: [#DoIt] ifFalse: [#DoItIn:]. SystemChangeNotifier uniqueInstance doSilently: [class addSelector: selector withMethod: method]. value _ context isNil ifTrue: [receiver DoIt] ifFalse: [receiver DoItIn: context]. InMidstOfFileinNotification signal ifFalse: [SystemChangeNotifier uniqueInstance doSilently: [class removeSelectorSimply: selector]]. logFlag ifTrue: [SystemChangeNotifier uniqueInstance evaluated: sourceStream contents context: aContext]. ^ value.! ! !Compiler methodsFor: 'public access' stamp: 'NS 1/19/2004 09:05'! evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock ^ self evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: false.! ! !Compiler class methodsFor: 'evaluating' stamp: 'NS 1/19/2004 10:07'! evaluate: textOrString "See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, a Syntax Error view is created rather than notifying any requestor. Compilation is carried out with respect to nil, i.e., no object, and the invocation is not logged." ^self evaluate: textOrString for: nil logged: false! ! !Compiler class methodsFor: 'evaluating' stamp: 'NS 1/19/2004 09:50'! evaluate: textOrString for: anObject notifying: aController logged: logFlag "Compile and execute the argument, textOrString with respect to the class of anObject. If a compilation error occurs, notify aController. If both compilation and execution are successful then, if logFlag is true, log (write) the text onto a system changes file so that it can be replayed if necessary." ^ self new evaluate: textOrString in: nil to: anObject notifying: aController ifFail: [^nil] logged: logFlag.! ! !ParagraphEditor methodsFor: 'do-its' stamp: 'NS 1/19/2004 10:08'! evaluateSelection "Treat the current selection as an expression; evaluate it and return the result" | result rcvr ctxt | self lineSelectAndEmptyCheck: [^ '']. (model respondsTo: #doItReceiver) ifTrue: [FakeClassPool adopt: model selectedClass. "Include model pool vars if any" rcvr _ model doItReceiver. ctxt _ model doItContext] ifFalse: [rcvr _ ctxt _ nil]. result _ [ rcvr class evaluatorClass new evaluate: self selection string in: ctxt to: rcvr notifying: self ifFail: [FakeClassPool adopt: nil. ^ #failedDoit] logged: true. ] on: OutOfScopeNotification do: [ :ex | ex resume: true]. FakeClassPool adopt: nil. ^ result! ! !SmalltalkImage methodsFor: 'sources, changes log' stamp: 'NS 1/27/2004 15:55'! event: anEvent "Hook for SystemChangeNotifier" (anEvent isRemoved and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [ anEvent item acceptsLoggingOfCompilation ifTrue: [self logChange: 'Smalltalk removeClassNamed: #' , anEvent item name]. ]. anEvent isDoIt ifTrue: [self logChange: anEvent item]. (anEvent isRemoved and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [ anEvent itemClass acceptsLoggingOfCompilation ifTrue: [self logChange: anEvent itemClass name , ' removeSelector: #' , anEvent itemSelector]].! ! !SmalltalkImage class methodsFor: 'class initialization' stamp: 'NS 1/16/2004 16:12'! startUp SystemChangeNotifier uniqueInstance notify: self current ofAllSystemChangesUsing: #event:.! ! !SystemDictionary methodsFor: 'class names' stamp: 'NS 1/27/2004 12:08'! forgetClass: aClass logged: aBool "Delete the class, aClass, from the system. Note that this doesn't do everything required to dispose of a class - to do that use Class>>removeFromSystem." aBool ifTrue: [SystemChangeNotifier uniqueInstance classRemoved: aClass fromCategory: aClass category]. SystemOrganization removeElement: aClass name. self removeFromStartUpList: aClass. self removeFromShutDownList: aClass. self removeKey: aClass name ifAbsent: []. self flushClassNameCache! ! !SystemDictionary methodsFor: 'class names' stamp: 'NS 1/27/2004 12:20'! renameClass: aClass as: newName "Rename the class, aClass, to have the title newName." | oldref i oldName | oldName := aClass name. SystemOrganization classify: newName under: aClass category. SystemOrganization removeElement: aClass name. oldref _ self associationAt: aClass name. self removeKey: aClass name. oldref key: newName. self add: oldref. "Old association preserves old refs" (Array with: StartUpList with: ShutDownList) do: [:list | i _ list indexOf: aClass name ifAbsent: [0]. i > 0 ifTrue: [list at: i put: newName]]. self flushClassNameCache. SystemChangeNotifier uniqueInstance classRenamed: aClass from: oldName to: newName inCategory: aClass category! ! !Utilities class methodsFor: 'class initialization' stamp: 'NS 1/26/2004 09:52'! startUp SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #event:.! ! !Utilities class methodsFor: 'recent method submissions' stamp: 'NS 1/27/2004 15:55'! event: anEvent "Hook for SystemChangeNotifier" (anEvent isCommented and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self noteMethodSubmission: #Comment forClass: anEvent item]. ((anEvent isAdded or: [anEvent isModified]) and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [anEvent itemRequestor ifNotNil: [self noteMethodSubmission: anEvent itemSelector forClass: anEvent itemClass]].! ! "Postscript: Add SmalltalkImage to the startup list" Smalltalk addToStartUpList: SmalltalkImage. Smalltalk addToStartUpList: Utilities. SmalltalkImage startUp. Utilities startUp.!