'From Squeak3.1alpha of 28 February 2001 [latest update: #4134] on 8 June 2001 at 11:49:37 am'! "Change Set: ConvMethods-tk Date: 8 June 2001 Author: Ted Kaehler When an author files out a changeSet, and he has added inst vars, deleted inst vars, or renamed a class, prompt him to fill in conversion method. The preference #conversionMethodsAtFileOut controls this. This code tries to be polite. Bring up to date with Bob Arning's changes to conversion methods in January. AUTHORS, please run with #conversionMethodsAtFileOut set to true!!"! !ChangeSet methodsFor: 'change logging' stamp: 'tk 6/8/2001 09:27'! renameClass: class as: newName "Include indication that a class has been renamed." | recorder | isolationSet ifNotNil: ["If there is an isolation layer above me, inform it as well." isolationSet renameClass: class as: newName]. (recorder _ self changeRecorderFor: class) noteChangeType: #rename; noteNewName: newName asSymbol. "store under new name (metaclass too)" changeRecords at: newName put: recorder. changeRecords removeKey: class name. self noteClassStructure: class. recorder _ changeRecords at: class class name ifAbsent: [^ nil]. changeRecords at: (newName, ' class') put: recorder. changeRecords removeKey: class class name. recorder noteNewName: newName , ' class'! ! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'tk 6/6/2001 18:40'! askAddedInstVars: classList | pairList pairClasses index pls newStruct oldStruct | "Ask the author whether these newly added inst vars need to be non-nil" pairList _ OrderedCollection new. pairClasses _ OrderedCollection new. "Class version numbers: If it must change, something big happened. Do need a conversion method then. Ignore them here." classList do: [:cls | newStruct _ (cls allInstVarNames). oldStruct _ (structures at: cls name ifAbsent: [#(0), newStruct]) allButFirst. newStruct do: [:instVarName | (oldStruct includes: instVarName) ifFalse: [ pairList add: cls name, ' ', instVarName. pairClasses add: cls]]]. pairList isEmpty ifTrue: [^ #()]. [index _ PopUpMenu withCaption: 'These instance variables were added. When an old project comes in, newly added instance variables will have the value nil. Click on items to remove them from the list. Click on any for which nil is an OK value.' chooseFrom: pairList, #('all of these need a non-nil value' 'all of these are OK with a nil value'). index <= (pls _ pairList size) ifTrue: [pairList removeAt: index. pairClasses removeAt: index]. index = (pls + 2) ifTrue: ["all are OK" ^ #()]. pairList isEmpty | (index = (pls + 1)) "all need conversion, exit"] whileFalse. ^ pairClasses asSet asArray "non redundant"! ! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'tk 6/6/2001 18:41'! askRemovedInstVars: classList | pairList pairClasses index pls newStruct oldStruct | "Ask the author whether these newly removed inst vars need to have their info saved" pairList _ OrderedCollection new. pairClasses _ OrderedCollection new. "Class version numbers: If it must change, something big happened. Do need a conversion method then. Ignore them here." classList do: [:cls | newStruct _ (cls allInstVarNames). oldStruct _ (structures at: cls name ifAbsent: [#(0), newStruct]) allButFirst. oldStruct do: [:instVarName | (newStruct includes: instVarName) ifFalse: [ pairList add: cls name, ' ', instVarName. pairClasses add: cls]]]. pairList isEmpty ifTrue: [^ #()]. [index _ PopUpMenu withCaption: 'These instance variables were removed. When an old project comes in, instance variables that have been removed will lose their contents. Click on items to remove them from the list. Click on any whose value is unimportant and need not be saved.' chooseFrom: pairList, #('all of these need a conversion method' 'all of these have old values that can be erased'). index <= (pls _ pairList size) ifTrue: [pairList removeAt: index. pairClasses removeAt: index]. index = (pls + 2) ifTrue: ["all are OK" ^ #()]. pairList isEmpty | (index = (pls + 1)) "all need conversion, exit"] whileFalse. ^ pairClasses asSet asArray "non redundant"! ! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'tk 6/8/2001 11:12'! askRenames: renamed addTo: msgSet using: smart | list rec ans oldStruct newStruct | "Go through the renamed classes. Ask the user if it could be in a project. Add a method in SmartRefStream, and a conversion method in the new class." list _ OrderedCollection new. renamed do: [:cls | rec _ changeRecords at: cls name. rec priorName ifNotNil: [ ans _ PopUpMenu withCaption: 'You renamed class ', rec priorName, ' to be ', rec thisName, '.\Could an instance of ', rec priorName, ' be in a project on someone''s disk?' chooseFrom: #('Yes, write code to convert those instances' 'No, no instances are in projects'). ans = 1 ifTrue: [ oldStruct _ structures at: rec priorName ifAbsent: [nil]. newStruct _ (Array with: cls classVersion), (cls allInstVarNames). oldStruct ifNotNil: [ smart writeConversionMethodIn: cls fromInstVars: oldStruct to: newStruct renamedFrom: rec priorName. smart writeClassRename: cls name was: rec priorName. list add: cls name, ' convertToCurrentVersion:refStream:']] ifFalse: [structures removeKey: rec priorName ifAbsent: []]]]. list isEmpty ifTrue: [^ msgSet]. msgSet messageList ifNil: [msgSet initializeMessageList: list] ifNotNil: [list do: [:item | msgSet addItem: item]]. ^ msgSet! ! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'tk 6/8/2001 11:48'! 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 _ Smalltalk changes) == self ifFalse: [ Smalltalk 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: [Smalltalk 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.! ! !ClassChangeRecord methodsFor: 'rename' stamp: 'tk 6/8/2001 09:11'! thisName ^ thisName! ! !SmartRefStream methodsFor: 'class changed shape' stamp: 'tk 6/8/2001 10:53'! conversionMethodsFor: classList | oldStruct newStruct list | "Each of these needs a conversion method. Hard part is the comment in it. Return a MessageSet." list _ OrderedCollection new. classList do: [:cls | oldStruct _ structures at: cls name ifAbsent: [#()]. newStruct _ (Array with: cls classVersion), (cls allInstVarNames). self writeConversionMethodIn: cls fromInstVars: oldStruct to: newStruct renamedFrom: nil. list add: cls name, ' convertToCurrentVersion:refStream:'. ]. ^ MessageSet new initializeMessageList: list.! ! !SmartRefStream methodsFor: 'class changed shape' stamp: 'tk 6/8/2001 09:57'! writeClassRename: newName was: oldName "Write a method that tells which modern class to map instances to." | oldVer sel code | oldVer _ self versionSymbol: (structures at: oldName). sel _ oldName asString. sel at: 1 put: (sel at: 1) asLowercase. sel _ sel, oldVer. "i.e. #rectangleoc4" code _ WriteStream on: (String new: 500). code nextPutAll: sel; cr. code cr; tab; nextPutAll: '^ ', newName. "Return new class" self class compile: code contents classified: 'conversion'. ! ! !SmartRefStream methodsFor: 'class changed shape' stamp: 'tk 6/7/2001 13:02'! writeConversionMethod: sel class: newClass was: oldName fromInstVars: oldList to: newList "The method convertToCurrentVersion:refStream: was not found in newClass. Write a default conversion method for the author to modify." | code newOthers oldOthers copied | code _ WriteStream on: (String new: 500). code nextPutAll: 'convertToCurrentVersion: varDict refStream: smartRefStrm'; cr; tab. newOthers _ newList asOrderedCollection "copy". oldOthers _ oldList asOrderedCollection "copy". copied _ OrderedCollection new. newList do: [:instVar | (oldList includes: instVar) ifTrue: [ instVar isInteger ifFalse: [copied add: instVar]. newOthers remove: instVar. oldOthers remove: instVar]]. code nextPutAll: '"These variables are automatically stored into the new instance '. code nextPutAll: copied asArray printString; nextPut: $. . code cr; tab; nextPutAll: 'This method is for additional changes.'; nextPutAll: ' Use statements like (foo _ varDict at: ''foo'')."'; cr; cr; tab. (newOthers size = 0) & (oldOthers size = 0) ifTrue: [^ self]. "Instance variables are the same. Only the order changed. No conversion needed." (newOthers size > 0) ifTrue: [code nextPutAll: '"New variables: ', newOthers asArray printString, ' If a non-nil value is needed, please assign it."\' withCRs]. (oldOthers size > 0) ifTrue: [code nextPutAll: ' "These are going away ', oldOthers asArray printString, '. Possibly store their info in some other variable?"']. code cr; tab. code nextPutAll: '^ super convertToCurrentVersion: varDict refStream: smartRefStrm'. newClass compile: code contents classified: 'object fileIn'. "If you write a conversion method beware that the class may need a version number change. This only happens when two conversion methods in the same class have the same selector name. (A) The inst var lists of the new and old versions intials as some older set of new and old inst var lists. or (B) Twice in a row, the class needs a conversion method, but the inst vars stay the same the whole time. (For an internal format change.) If either is the case, fileouts already written with the old (wrong) version number, say 2. Your method must be able to read files that say version 2 but are really 3, until you expunge the erroneous version 2 files from the universe." ! ! !SmartRefStream methodsFor: 'class changed shape' stamp: 'tk 6/8/2001 10:52'! writeConversionMethodIn: newClass fromInstVars: oldList to: newList renamedFrom: oldName "The method convertToCurrentVersion:refStream: was not found in newClass. Write a default conversion method for the author to modify." | code newOthers oldOthers copied | code _ WriteStream on: (String new: 500). code nextPutAll: 'convertToCurrentVersion: varDict refStream: smartRefStrm'; cr. newOthers _ newList asOrderedCollection "copy". oldOthers _ oldList asOrderedCollection "copy". copied _ OrderedCollection new. newList do: [:instVar | (oldList includes: instVar) ifTrue: [ instVar isInteger ifFalse: [copied add: instVar]. newOthers remove: instVar. oldOthers remove: instVar]]. code tab; nextPutAll: '"These variables are automatically stored into the new instance: '. code nextPutAll: copied asArray printString; nextPut: $.; cr. code tab; nextPutAll: 'This method is for additional changes.'; nextPutAll: ' Use statements like (foo _ varDict at: ''foo'')."'; cr; cr. (newOthers size = 0) & (oldOthers size = 0) & (oldName == nil) ifTrue: [^ self]. "Instance variables are the same. Only the order changed. No conversion needed." (newOthers size > 0) ifTrue: [ code tab; nextPutAll: '"New variables: ', newOthers asArray printString, '. If a non-nil value is needed, please assign it."'; cr]. (oldOthers size > 0) ifTrue: [ code tab; nextPutAll: '"These are going away ', oldOthers asArray printString, '. Possibly store their info in some other variable?"'; cr]. oldName ifNotNil: [ code tab; nextPutAll: '"Test for instances of class ', oldName, '.'; cr. code tab; nextPutAll: 'Instance vars with the same name have been moved here."'; cr. ]. code cr; tab. code nextPutAll: '^ super convertToCurrentVersion: varDict refStream: smartRefStrm'. newClass compile: code contents classified: 'object fileIn'. "If you write a conversion method beware that the class may need a version number change. This only happens when two conversion methods in the same class have the same selector name. (A) The inst var lists of the new and old versions intials as some older set of new and old inst var lists. or (B) Twice in a row, the class needs a conversion method, but the inst vars stay the same the whole time. (For an internal format change.) If either is the case, fileouts already written with the old (wrong) version number, say 2. Your method must be able to read files that say version 2 but are really 3, until you expunge the erroneous version 2 files from the universe." ! ! SmartRefStream removeSelector: #writeConversionMethodIn:fromInstVars:to:!