'From Squeak3.2alpha of 1 November 2001 [latest update: #4586] on 12 December 2001 at 10:37:47 am'! "Change Set: betterModuleScoping1-hg Date: 28 November 2001 Author: Henrik Gedenryd - Refactors scoping methods from Class to Module. - Makes class recompilation aware of module name scoping. - Updates cmd-N to work in a module-aware manner. This will put up multiple windows for a name defined in more than one module. - Adds ability to set the default/home module of projects. - Makes the compiler use this home module for name lookups instead of UndefinedObject, when no receiver is given (e.g. workspace doIts). - Makes ChangeLists/Records 'homemodule-aware' too. "! !ChangeRecord methodsFor: 'access' stamp: 'hg 11/29/2001 13:59'! methodClass | methodClass | type == #method ifFalse: [^ nil]. Module default definesName: class asSymbol ifTrue: [:assoc | methodClass _ assoc value]. ^methodClass ifNotNil: [ meta ifTrue: [methodClass class] ifFalse: [methodClass]]! ! !ClassBuilder methodsFor: 'class definition' stamp: 'hg 11/29/2001 18:50'! reshapeClass: aClass to: templateClass super: newSuper "Reshape the given class to the new super class. If templateClass is not nil then it defines the shape of the new class" | fmt newClass newMeta newSuperMeta oldMeta instVars oldClass | templateClass == nil ifTrue:[oldClass _ aClass] ifFalse:[oldClass _ templateClass]. aClass becomeUncompact. "Compute the new format of the class" instVars _ instVarMap at: aClass name ifAbsent:[oldClass instVarNames]. fmt _ self computeFormat: oldClass typeOfClass instSize: instVars size forSuper: newSuper ccIndex: 0."Known to be 0 since we uncompacted aClass first" fmt == nil ifTrue:[^nil]. aClass isMeta ifFalse:["Create a new meta class" oldMeta _ aClass class. newMeta _ oldMeta clone. newSuperMeta _ newSuper ifNil:[Class] ifNotNil:[newSuper class]. newMeta superclass: newSuperMeta methodDictionary: MethodDictionary new format: (self computeFormat: oldMeta typeOfClass instSize: oldMeta instVarNames size forSuper: newSuperMeta ccIndex: 0); setInstVarNames: oldMeta instVarNames; organization: oldMeta organization. "Recompile the meta class" oldMeta hasMethods ifTrue:[newMeta compileAllFrom: oldMeta]. "Fix up meta class structure" oldMeta superclass addObsoleteSubclass: oldMeta. (oldMeta superclass subclasses includes: oldMeta) ifTrue:[ oldMeta superclass removeSubclass: oldMeta. newMeta superclass addSubclass: newMeta]. "And record the change so we can fix global refs later" self recordClass: oldMeta replacedBy: newMeta. ]. newClass _ newMeta == nil ifTrue:[oldClass clone] ifFalse:[newMeta adoptInstance: oldClass from: oldMeta]. newClass superclass: newSuper methodDictionary: MethodDictionary new format: fmt; setInstVarNames: instVars; organization: aClass organization. "Recompile the new class" aClass hasMethods ifTrue:[newClass compileAllFrom: aClass]. "Export the new class into the environment" aClass isMeta ifFalse:[ "Derefence super sends in the old class" self fixSuperSendsFrom: aClass. "Export the class" [(newClass name asLowercase beginsWith: 'anobsolete') ifFalse: [ newClass module redefineName: newClass name as: newClass export: true ]] on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true]. "And use the ST association in the new class" self fixSuperSendsTo: newClass]. "Fix up the class hierarchy" (aClass superclass subclasses includes: aClass) ifTrue:[ aClass superclass removeSubclass: aClass. newClass superclass addSubclass: newClass. ]. "And record the change" self recordClass: aClass replacedBy: newClass. ^newClass ! ! !ClassBuilder methodsFor: 'private' stamp: 'hg 11/29/2001 18:14'! fixSuperSendsTo: newClass "The newClass has been exported into the environment. Fix all references to super so that the association is the original ST association." | newSuper nLits lastLiteral | newSuper _ newClass module associationFor: newClass name ifAbsent:[nil]. newSuper == nil ifTrue:[^self]. newSuper value == newClass ifTrue:[^self]. newClass methodsDo:[:meth| nLits _ meth numLiterals. nLits > 0 ifTrue:[lastLiteral _ meth literalAt: nLits] ifFalse:[lastLiteral _ nil]. (lastLiteral isVariableBinding and:[meth sendsToSuper]) ifTrue:[ meth literalAt: nLits put: newSuper. ]. ].! ! !ClassDescription methodsFor: 'instance variables' stamp: 'hg 11/29/2001 18:24'! browseClassVarRefs "1/17/96 sw: moved here from Browser so that it could be used from a variety of places." | lines labelStream vars allVars index owningClasses | lines _ OrderedCollection new. allVars _ OrderedCollection new. owningClasses _ OrderedCollection new. labelStream _ WriteStream on: (String new: 200). self withAllSuperclasses reverseDo: [:class | vars _ class classVarNames asSortedCollection. vars do: [:var | labelStream nextPutAll: var; cr. allVars add: var. owningClasses add: class]. vars isEmpty ifFalse: [lines add: allVars size]]. labelStream contents isEmpty ifTrue: [^1 beep]. "handle nil superclass better" labelStream skip: -1 "cut last CR". index _ (PopUpMenu labels: labelStream contents lines: lines) startUp. index = 0 ifTrue: [^ self]. Module root browseAllReferencesTo: ((owningClasses at: index) classPool associationAt: (allVars at: index))! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 11/29/2001 14:39'! definesName: varName ifTrue: assocBlock ^ (Preferences strongModules ifTrue: [self strongDefinesName: varName ifTrue: assocBlock] ifFalse: [self weakDefinesName: varName ifTrue: assocBlock]) or: [Preferences lenientScopeForGlobals and: [self lenientDefinesName: varName ifTrue: assocBlock]]! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 11/29/2001 14:40'! lenientDefinesName: varName ifTrue: assocBlock "extra check to allows unrestricted use of global names." "Look it up in Smalltalk to allow references to all global names (except modules)." self class smalltalk associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]. "another lookup just to catch what were formerly Pool variables" ^self class root definesName: varName ifTrue: [:a | assocBlock value: a]! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 11/29/2001 12:46'! strongDefinesName: varName ifTrue: assocBlock "use the lookup rules for strong modularity" self associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]. ^false! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 11/29/2001 12:44'! weakDefinesName: varName ifTrue: assocBlock "Like the strong definesName but this one always uses the lookup rules for weak modularity. I.e. see all names exported from all external and submodules. " | assoc | "Next ask home module to look up name. Treat all neighbors as imported. " assoc _ self localAssocFor: varName ifAbsent: [ "look in all external and submodules." self neighborModules do: [:mod | mod exportedAssocFor: varName ifPresent: [:a :m | assocBlock value: a. ^ true]]. nil]. assoc ifNotNil: [assocBlock value: assoc. ^true]. "Finally look it up globally. This is a compatibility patch for now. Look it up this way instead of in Smalltalk to test multiple name definitions. --Commented out or analysis of global references will always find names. " "Module root associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]." ^false! ! !Module methodsFor: 'changing defined names' stamp: 'hg 11/29/2001 14:07'! validateName: aString forValue: anObject "Validate the name for a new binding" | oldAssoc | aString first isUppercase ifFalse:[ self error: 'The name must be capitalized'. ^false]. oldAssoc _ self localAssocFor: aString ifAbsent:[nil]. oldAssoc ifNil: [ "check if name already used in a different module" (Module root moduleDefining: aString) ifNotNilDo: [:defModule | self notify: ('The name ', aString asText allBold, ' is already defined in module ', defModule pathAsMessages, '.\Proceed will create a second definition with this name in module ', self pathAsMessages, '.') withCRs]] ifNotNil: [ "don't protest if e.g. the new value is a new class and the old value was a class too" (oldAssoc value isKindOf: anObject class) ifFalse: [ self notify: 'The name ', aString asText allBold, ' is already used in module ', self pathAsMessages, '!!\Proceed will store over it.' withCRs]]. ^true! ! !Module methodsFor: 'code analysis' stamp: 'hg 11/29/2001 12:51'! scopedLookup: aSymbol inClass: cl cachedIn: cache "for efficiency, cache scope lookups here" | assoc | assoc _ cache at: aSymbol ifAbsentCache: [:cachedAssoc | cl scopeHas: aSymbol ifTrue: [:ass | assoc _ ass]. assoc ifNotNil: [cachedAssoc value: assoc value]]. ^assoc notNil! ! !Module methodsFor: 'compatibility' stamp: 'hg 12/5/2001 09:46'! removeClassFromSystem: aClass logged: aBool "Delete the class, aClass, from the system, but log the removal neither to the current change set nor to the changes log" aBool ifTrue:[ aClass wantsChangeSetLogging ifTrue: [self changes noteRemovalOf: aClass]. aClass acceptsLoggingOfCompilation ifTrue: [Smalltalk logChange: self pathAsMessages, ' removeClassNamed: #', aClass name]. ]. "self organization removeElement: aClass name." Smalltalk removeFromStartUpList: aClass. Smalltalk removeFromShutDownList: aClass. (self localAssocFor: aClass name ifAbsent: [nil]) ifNotNil: [self removeName: aClass name]. Smalltalk flushClassNameCache ! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 11/29/2001 12:59'! default "answer the module to use if none is specified, e.g. when looking up the names in a workspace doIt" ^Project current module! ! !ParagraphEditor methodsFor: 'menu messages' stamp: 'hg 11/28/2001 16:23'! referencesToIt "Open a references browser on the selected symbol" | aSymbol | self selectionInterval isEmpty ifTrue: [self selectWord]. ((aSymbol _ self selectedSymbol) == nil or: [(Smalltalk includesKey: aSymbol) not]) ifTrue: [^ view flash]. self terminateAndInitializeAround: [ Module root browseAllReferencesTo: self selectedSymbol]! ! !Project methodsFor: 'accessing' stamp: 'hg 12/9/2001 14:21'! module "this is the 'home' module of this project, which should be used as default for name lookups, e.g. in doIts in workspaces and so on" ^ module ifNil: [ Preferences strongModules ifTrue: [Module root] ifFalse: [Module smalltalk]]! ! !Project methodsFor: 'accessing' stamp: 'hg 11/29/2001 12:30'! module: aModule module _ aModule! ! !StringHolder methodsFor: 'message list menu' stamp: 'hg 11/28/2001 16:24'! browseClassRefs | cls | (cls _ self selectedClass) ifNotNil: [ Module root browseAllReferencesTo: cls theNonMetaClass name] ! ! !Browser methodsFor: 'class functions' stamp: 'hg 12/10/2001 11:35'! renameClass | oldName newName | classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. oldName _ self selectedClass name. newName _ self request: 'Please type new class name' initialAnswer: oldName. newName = '' ifTrue: [^ self]. " Cancel returns '' " newName _ newName asSymbol. newName = oldName ifTrue: [^ self]. Module root browseAllReferencesTo: oldName. [self selectedClass rename: newName] on: AttemptToWriteReadOnlyGlobal do: [:ex | ex resume: true].. self changed: #classList. self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) indexOf: newName).! ! !SystemDictionary methodsFor: 'browsing' stamp: 'hg 12/10/2001 12:03'! browseMessageList: messageList name: labelString autoSelect: autoSelectString | title aSize | "Create and schedule a MessageSet browser on the message list." messageList size = 0 ifTrue: [^ (PopUpMenu labels: ' OK ') startUpWithCaption: 'There are no ' , labelString]. title _ (aSize _ messageList size) > 1 ifFalse: [labelString] ifTrue: [ labelString, ' [', aSize printString, ']']. MessageSet openMessageList: messageList name: title autoSelect: autoSelectString! ! !VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 11/29/2001 13:46'! definesName: varName ifTrue: assocBlock "find things in all modules" ^self strongDefinesName: varName ifTrue: assocBlock! ! !VirtualRootModule methodsFor: 'name queries' stamp: 'hg 12/10/2001 12:04'! browseAllReferencesTo: varName "Answer a dictionary of module->value pairs. Searc all modules in the system." | assoc | (self modulesDefining: varName) keysDo: [:module | assoc _ module definedNames associationAt: varName. Smalltalk browseMessageList: (Smalltalk allCallsOn: assoc) asSortedCollection name: 'methods that use ', varName, String cr, ' as defined in ', module pathAsMessages autoSelect: varName]! ! !VirtualRootModule methodsFor: 'name queries' stamp: 'hg 11/29/2001 18:22'! modulesDefining: varName "Answer a dictionary of module->value pairs. Search all modules in the system." | defs | defs _ Dictionary new. self allDefinitionsFor: varName onlyExported: false detect: [:value :module | defs at: module put: value]. defs size > 1 ifTrue: [defs removeKey: Module smalltalk]. ^defs ! ! VirtualRootModule removeSelector: #lenientScopeHas:ifTrue:! Metaclass removeSelector: #lenientScopeHas:ifTrue:! Metaclass removeSelector: #strongScopeHas:ifTrue:! Metaclass removeSelector: #weakScopeHas:ifTrue:!