| package | package := Package name: 'CJDReStoreTools'. package paxVersion: 0; basicComment: 'Release 2 (8-16-2001 @ 11:00 PM) Requires ReStore from Solutions Software By: Christopher J. Demers Copyright 2001 (Freeware) The code may be freely used and freely modified, but please don''t redistributed modified versions (without asking me). I have no affiliation with Solutions Software (ReStore developers). Use this code at your own risk. see: http://www.mitchellscientific.com/smalltalk/ for much more information. see CJDRestoreDefGen class comment for directions. example: CJDReStoreDefGen generate: myObject. "Class selection prompted for all fields." CJDReStoreDefGen generateWithMap: myObject. "Class selection prompted only for unique classes." '. package basicPackageVersion: '0.001'. "Add the package scripts" "Add the class names, loose method names, global names, resource names" package classNames add: #CJDReStoreDefGen; add: #CJDReStoreParser; yourself. package methodNames yourself. package globalNames yourself. package resourceNames yourself. "Binary Global Names" package binaryGlobalNames: (Set new yourself). "Resource Names" package allResourceNames: (Set new yourself). "Add the prerequisite names" package setPrerequisites: (IdentitySet new add: 'Dolphin'; yourself). package! "Class Definitions"! Object subclass: #CJDReStoreDefGen instanceVariableNames: 'targetInstance classGeneralityMap' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! Object subclass: #CJDReStoreParser instanceVariableNames: 'fields' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! "Loose Methods"! "End of package definition"! CJDReStoreDefGen comment: 'CJD 8-15-2001 This class generates a Restore class definition method for the targetInstance class based on targetInstance. The targetInstance should be a prototype instance of the class to receive the ReStore definition method. The instance should be a real world object with as much of it filled in as possible. The more the instance is defined the better the ReStore definition method will be. If it is not easy to programmatically create a populated targetInstance one can be retrieved from a UI by sending allInstances to the class. Inspect the results and pick a good instance that is as broadly representative of your class as possible. If a class is not a direct descendant of Object or a low-level class (String, Date, etc...) you will be prompted to select a class to use to represent the class. Optionally these class generalities can be cached and reused for all instances of the class. The default is not to cache the mappings. example: CJDReStoreDefGen generate: myObject. "Class selection prompted for all fields." CJDReStoreDefGen generateWithMap: myObject. "Class selection prompted only for unique classes." '! CJDReStoreDefGen guid: (GUID fromString: '{E59995E2-91A9-11D5-80E8-006008C07585}')! !CJDReStoreDefGen categoriesForClass!Unclassified! ! !CJDReStoreDefGen methodsFor! classDescriptionForObject: anObject fieldName: aFieldName "Private - CJD 8-15-2001 Determin the class description of anObject for ReStore." | choiceClasses objClass classDescription | objClass := anObject class. "Handle obvious choice." objClass superclass == Object ifTrue: [^objClass]. "Handle Objects that are immediatly persistable." anObject isValidForPersistence ifTrue: [^objClass]. "Handle Collections" (anObject isKindOf: Collection) ifTrue: [classDescription := '(' , objClass printString , ' of: '. anObject isEmpty ifTrue: [classDescription := classDescription , 'UndefinedObject)'] ifFalse: [classDescription := classDescription , (self classDescriptionForObject: anObject first fieldName: 'first of ' , aFieldName) printString , ')']. ^classDescription]. "Let the user choose the correct place in the Class Hierarchy." "Use the map if it is defined. (see shouldUseClassGeneralityMap:)" self classGeneralityMap notNil ifTrue: [classDescription := self classGeneralityMap at: objClass ifAbsent: [nil]. classDescription notNil ifTrue: [^classDescription]]. choiceClasses := (objClass allSuperclasses addFirst: objClass; remove: Object; yourself). classDescription := ChoicePrompter on: objClass choices: choiceClasses caption: 'Map field ', aFieldName , ' of ' , objClass printString. self classGeneralityMap notNil ifTrue: [self classGeneralityMap at: objClass put: classDescription]. ^classDescription.! classGeneralityMap "Private - Answer the value of the receiver's ''classGeneralityMap'' instance variable." ^classGeneralityMap! classGeneralityMap: anObject "Private - Set the value of the receiver's ''classGeneralityMap'' instance variable to the argument, anObject." classGeneralityMap := anObject! generate "CJD 8-15-2001 Generate the restore definition method based on targetInstace." | restoreParser newIVars value outStream | outStream := String writeStream. outStream nextPutAll: self getMethodBaseCode; cr; tab; nextPutAll: '"AutoGenerated on ' , (TimeStamp current displayString) , '"'; cr. restoreParser := CJDReStoreParser new. self targetClass addClassDefinitionTo: restoreParser. newIVars := (self targetClass allInstVarNames collect: [:each | each asSymbol]) difference: restoreParser fields. newIVars do: [:varName | outStream nextPutAll: ' aClassDefinition define: ' , varName printString , ' as: '. value := self targetInstanceVariable: varName. outStream nextPutAll: (self classDescriptionForObject: value fieldName: varName) displayString. outStream nextPut: $. ; cr]. self targetClass class compile: outStream contents.! getMethodBaseCode "Private - CJD 8-15-2001 Return the base code for the method (existing or a template)." | str | str := [(self targetClass class sourceCodeAt: #addClassDefinitionTo:) trimBlanks] on: Error do: [:error | error return: 'addClassDefinitionTo: aClassDefinition " (AutoGenerated) Define the class for ReStore." super addClassDefinitionTo: aClassDefinition.']. ^(self hasTrailingStatementSeperator: str) ifTrue: [str] ifFalse: [str , '.']! hasTrailingStatementSeperator: aMethodCodeString "Private - CJD 7-2-2001 Check aString to see if it has a trailing statement seperator. This may be overkill, I had been using a much simpler approach to check this, but I suppose I should do this more robust check for the sake of completeness. Returns true if aMethodCodeString ends with a statement seperator (.) or false if it does not." | inComment inString lastSeperator lastStatement | "Find the last statement seperator." inString := inComment := false. lastSeperator := aMethodCodeString findLast: [:ch | ch = $" ifTrue: [inComment := inComment not]. ch = $' ifTrue: [inString := inString not]. ch = $. & (inString | inComment) not]. "Now see if there is another statement after it." inString := inComment := false. lastStatement := aMethodCodeString findLast: [:ch | ch = $" ifTrue: [inComment := inComment not]. ch = $' ifTrue: [inString := inString not]. ch isAlphaNumeric & (inString | inComment) not]. ^lastSeperator - lastStatement > 0.! shouldUseClassGeneralityMap: aBoolean "CJD 8-15-2001 If we want to use the classGeneralityMap then init it to a dictionary. If it is nil it will not be used. The default is not to use it." classGeneralityMap := aBoolean ifTrue: [Dictionary new].! targetClass "Private - CJD 8-15-2001" ^targetInstance class.! targetInstance "Private - Answer the value of the receiver's ''targetInstance'' instance variable." ^targetInstance! targetInstance: anObject "Set the value of the receiver's ''targetInstance'' instance variable to the argument, anObject." targetInstance := anObject! targetInstanceVariable: aVariableNameSymbol "Private - CJD 8-15-2001 Return the value of the instance variable named aVariableNameSymbol." ^targetInstance instVarAt: (self targetClass allInstVarNames indexOf: aVariableNameSymbol asString).! ! !CJDReStoreDefGen categoriesFor: #classDescriptionForObject:fieldName:!*-unclassified!private! ! !CJDReStoreDefGen categoriesFor: #classGeneralityMap!accessing!private! ! !CJDReStoreDefGen categoriesFor: #classGeneralityMap:!accessing!private! ! !CJDReStoreDefGen categoriesFor: #generate!*-unclassified!public! ! !CJDReStoreDefGen categoriesFor: #getMethodBaseCode!*-unclassified!private! ! !CJDReStoreDefGen categoriesFor: #hasTrailingStatementSeperator:!*-unclassified!private! ! !CJDReStoreDefGen categoriesFor: #shouldUseClassGeneralityMap:!*-unclassified!public! ! !CJDReStoreDefGen categoriesFor: #targetClass!*-unclassified!private! ! !CJDReStoreDefGen categoriesFor: #targetInstance!accessing!private! ! !CJDReStoreDefGen categoriesFor: #targetInstance:!accessing!public! ! !CJDReStoreDefGen categoriesFor: #targetInstanceVariable:!*-unclassified!private! ! !CJDReStoreDefGen class methodsFor! generate: anObject "CJD 8-16-2001 Generate a ReStore description method for anObject." | rdg | rdg := self new. rdg targetInstance: anObject. ^rdg generate. ! generateWithMap: anObject "CJD 8-16-2001 Generate a ReStore description method for anObject. A generality decision can be made once for each class and will be cached in the class generality map." | rdg | rdg := self new. rdg shouldUseClassGeneralityMap: true. rdg targetInstance: anObject. ^rdg generate. ! ! !CJDReStoreDefGen class categoriesFor: #generate:!*-unclassified!public! ! !CJDReStoreDefGen class categoriesFor: #generateWithMap:!*-unclassified!public! ! CJDReStoreParser comment: 'CJD 8-16-2001 This class is used to pass to addClassDefinitionTo: to get the fields that are already defined.'! CJDReStoreParser guid: (GUID fromString: '{E59995E3-91A9-11D5-80E8-006008C07585}')! !CJDReStoreParser categoriesForClass!Unclassified! ! !CJDReStoreParser methodsFor! define: aField as: aDefinition "CJD 8-15-2001 This just keeps track of the fields that are already defined." fields add: aField.! fields "Answer the value of the receiver's ''fields'' instance variable." ^fields! fields: anObject "Private - Set the value of the receiver's ''fields'' instance variable to the argument, anObject." fields := anObject! init fields := Set new.! ! !CJDReStoreParser categoriesFor: #define:as:!*-unclassified!public! ! !CJDReStoreParser categoriesFor: #fields!accessing!public! ! !CJDReStoreParser categoriesFor: #fields:!accessing!private! ! !CJDReStoreParser categoriesFor: #init!*-unclassified!private! ! !CJDReStoreParser class methodsFor! new ^super new init.! ! !CJDReStoreParser class categoriesFor: #new!*-unclassified!public! ! "Binary Globals"! "Resources"!