'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5278] on 2 July 2003 at 9:10:19 am'! "Change Set: KCP0085b-nk Date: 2 July 2003 Author: Ned Konz This is the remaining cleanup required after KCP0085a is done. It also fixes some wrong or missing methods in the original KCP0085 code and makes sure that SqueakMap will work again after the changes. "! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'nk 7/2/2003 09:01'! checkForConversionMethods "See if any conversion methods are needed" | oldStruct newStruct tell choice list need sel smart restore renamed listAdd listDrop msgSet rec nn | Preferences conversionMethodsAtFileOut ifFalse: [^ self]. "Check preference" structures ifNil: [^ self]. list _ OrderedCollection new. renamed _ OrderedCollection new. self changedClasses do: [:class | need _ (self atClass: class includes: #new) not. need ifTrue: ["Renamed classes." (self atClass: class includes: #rename) ifTrue: [ rec _ changeRecords at: class name. rec priorName ifNotNil: [ (structures includesKey: rec priorName) ifTrue: [ renamed add: class. need _ false]]]]. need ifTrue: [need _ (self atClass: class includes: #change)]. need ifTrue: [oldStruct _ structures at: class name ifAbsent: [need _ false. #()]]. need ifTrue: [ newStruct _ (Array with: class classVersion), (class allInstVarNames). need _ (oldStruct ~= newStruct)]. need ifTrue: [sel _ #convertToCurrentVersion:refStream:. (#(add change) includes: (self atSelector: sel class: class)) ifFalse: [ list add: class]]. ]. list isEmpty & renamed isEmpty ifTrue: [^ self]. "Ask user if want to do this" tell _ 'If there might be instances of ', (list asArray, renamed asArray) printString, '\in a project (.pr file) on someone''s disk, \please ask to write a conversion method.\' withCRs, 'After you edit the conversion method, you''ll need to fileOut again.\' withCRs, 'The preference conversionMethodsAtFileOut in category "fileout" controls this feature.'. choice _ (PopUpMenu labels: 'Write a conversion method by editing a prototype These classes are not used in any object file. fileOut my changes now. I''m too busy. fileOut my changes now. Don''t ever ask again. fileOut my changes now.') startUpWithCaption: tell. choice = 4 ifTrue: [Preferences disable: #conversionMethodsAtFileOut]. choice = 2 ifTrue: ["Don't consider this class again in the changeSet" list do: [:cls | structures removeKey: cls name ifAbsent: []]. renamed do: [:cls | nn _ (changeRecords at: cls name) priorName. structures removeKey: nn ifAbsent: []]]. choice ~= 1 ifTrue: [^ self]. "exit if choice 2,3,4" listAdd _ self askAddedInstVars: list. "Go through each inst var that was added" listDrop _ self askRemovedInstVars: list. "Go through each inst var that was removed" list _ (listAdd, listDrop) asSet asArray. smart _ SmartRefStream on: (RWBinaryOrTextStream on: '12345'). smart structures: structures. smart superclasses: superclasses. (restore _ self class current) == self ifFalse: [ self class newChanges: self]. "if not current one" msgSet _ smart conversionMethodsFor: list. "each new method is added to self (a changeSet). Then filed out with the rest." self askRenames: renamed addTo: msgSet using: smart. "renamed classes, add 2 methods" restore == self ifFalse: [self class newChanges: restore]. msgSet messageList isEmpty ifTrue: [^ self]. self inform: 'Remember to fileOut again after modifying these methods.'. MessageSet open: msgSet name: 'Conversion methods for ', self name.! ! !SARInstaller methodsFor: 'private' stamp: 'nk 7/2/2003 08:59'! withCurrentChangeSetNamed: aString do: aOneArgumentBlock "Evaluate the one-argument block aOneArgumentBlock while the named change set is active. We let the user confirm operating on an existing ChangeSet or specify another ChangeSet name if the name derived from the filename already exists. Duplicated from SMSimpleInstaller. Should be a class-side method. Returns change set." | changeSet newName oldChanges | newName := aString. changeSet := self class changeSetNamed: newName. changeSet ifNotNil: [newName := FillInTheBlank request: 'ChangeSet already present, just confirm to overwrite or enter a new name:' initialAnswer: newName. newName isEmpty ifTrue: [self error: 'Cancelled by user']. changeSet := self class changeSetNamed: newName]. changeSet ifNil: [changeSet := self class basicNewChangeSet: newName]. changeSet ifNil: [self error: 'User did not specify a valid ChangeSet name']. oldChanges := Smalltalk changes. [ChangeSet newChanges: changeSet. aOneArgumentBlock value: changeSet] ensure: [ChangeSet newChanges: oldChanges]. ^changeSet! ! !SMSimpleInstaller methodsFor: 'services' stamp: 'nk 7/2/2003 08:59'! fileIntoChangeSetNamed: aString fromStream: stream "We let the user confirm filing into an existing ChangeSet or specify another ChangeSet name if the name derived from the filename already exists." | changeSet newName oldChanges | newName _ aString. changeSet _ SMInstaller changeSetNamed: newName. changeSet ifNotNil: [ newName _ FillInTheBlank request: 'ChangeSet already present, just confirm to overwrite or enter a new name:' initialAnswer: newName. newName isEmpty ifTrue:[self error: 'Cancelled by user']. changeSet _ SMInstaller changeSetNamed: newName]. changeSet ifNil:[changeSet _ SMInstaller basicNewChangeSet: newName]. changeSet ifNil:[self error: 'User did not specify a valid ChangeSet name']. oldChanges _ Smalltalk changes. [ChangeSet newChanges: changeSet. stream fileInAnnouncing: 'Loading ', newName, ' into change set ''', newName, ''''. stream close] ensure: [ChangeSet newChanges: oldChanges]! ! !SMSqueakMap class methodsFor: 'bootstrap upgrade' stamp: 'nk 7/2/2003 08:59'! bootStrap "Bootstrap upgrade. Only used when SqueakMap itself is too old to communicate with the server. This relies on the existence of a package called SqueakMap that is packaged as a .cs.gz." | server set oldChanges url | server _ self findServer. server ifNotNil: ["Ok, found a SqueakMap server" url _ (('http://', server, '/sm/packagebyname/squeakmap/downloadurl') asUrl retrieveContents content) asUrl. name _ url path last sansPeriodSuffix. set _ SMInstaller changeSetNamed: name. set ifNil: [set _ SMInstaller basicNewChangeSet: name]. oldChanges _ Smalltalk changes. [ChangeSet newChanges: set. (url retrieveContents content unzipped readStream) fileInAnnouncing: 'Loading ', name, '...'] ensure: [ChangeSet newChanges: oldChanges]. ]! ! !SystemDictionary methodsFor: 'sources, change log' stamp: 'sd 5/23/2003 15:16'! 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" self deprecatedExplanation: 'Use ChangeSet current newChanges:'. ChangeSet newChanges: aChangeSet! ! !SystemDictionary methodsFor: 'sources, change log' stamp: 'sd 5/23/2003 15:17'! noChanges "Initialize the system ChangeSet." self deprecatedExplanation: 'Use ChangeSet current noChanges'. ChangeSet noChanges! ! !SystemDictionary methodsFor: 'deprecated' stamp: 'sd 6/9/2003 17:19'! changes "Answer the current system ChangeSet." self deprecatedExplanation: 'This method is deprecated please use ChangeSet current instead'. ^ChangeSet current! ! !Environment class methodsFor: 'system conversion' stamp: 'nk 7/2/2003 08:59'! reorganizeEverything "Undertake a grand reorganization. Environment reorganizeEverything. " | bigCat envt pool s | "First check for clashes between environment names and existing globals..." SystemOrganization categories do: [:cat | bigCat _ (cat asString copyUpTo: '-' first) asSymbol. (Smalltalk kernelCategories includes: bigCat) ifFalse: [(Smalltalk includesKey: bigCat) ifTrue: [^ self error: bigCat , ' cannot be used to name both a package and a class or other global variable. No reorganization will be attempted.']]]. (self confirm: 'Your image is about to be partitioned into environments. Many things may not work after this, so you should be working in a throw-away copy of your working image. Are you really ready to procede? (choose ''no'' to stop here safely)') ifFalse: [^ self inform: 'No changes were made']. ChangeSet newChanges: (ChangeSet basicNewNamed: 'Reorganization'). "Recreate the Smalltalk dictionary as the top-level Environment." Smalltalk _ SmalltalkEnvironment newFrom: Smalltalk. Smalltalk setName: #Smalltalk inOuterEnvt: nil. "Don't hang onto old copy of Smalltalk ." Smalltalk recreateSpecialObjectsArray. Smalltalk allClassesDo: [:c | c environment: nil. "Flush any old values"]. "Run through all categories making up new sub-environments" SystemOrganization categories do: [:cat | bigCat _ (cat asString copyUpTo: '-' first) asSymbol. (Smalltalk kernelCategories includes: bigCat) ifFalse: ["Not a kernel category ..." envt _ Smalltalk at: bigCat ifAbsent: ["... make up a new environment if necessary ..." Smalltalk makeSubEnvironmentNamed: bigCat]. "... and install the member classes in that category" envt transferBindingsNamedIn: (SystemOrganization listAtCategoryNamed: cat) from: Smalltalk]. ]. "Move all shared pools that are only referred to in sub environments" Smalltalk associationsDo: [:assn | ((pool _ assn value) isMemberOf: Dictionary) ifTrue: [s _ IdentitySet new. Smalltalk allClassesAnywhereDo: [:c | c sharedPools do: [:p | p == pool ifTrue: [s add: c environment]]]. (s size = 1 and: [(envt _ s someElement) ~~ Smalltalk]) ifTrue: [envt declare: assn key from: Smalltalk]]]. Smalltalk rewriteIndirectRefs. ChangeSet newChanges: (ChangeSet basicNewNamed: 'PostReorganization'). ChangeSorter initialize. Preferences enable: #browserShowsPackagePane. ! ! ChangeSet class removeSelector: #current:! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." SystemDictionary removeClassVarName: 'SystemChanges'.!