'From Squeak3.1alpha of 28 February 2001 [latest update: #4173] on 28 June 2001 at 4:33:48 pm'! "Change Set: autoAccesor-tk Date: 22 June 2001 Author: Ted Kaehler Projects with stacks save the text on the cards in a (.t) file. This is in case the stack is unreadable later. AutoAccessors is able to define a message in a superclass for an inst var there."! !Object methodsFor: 'error handling' stamp: 'tk 6/18/2001 15:04'! tryToDefineVariableAccess: aMessage "See if the message just wants to get at an instance variable of this class. Ask the user if its OK. If so, define the message to read or write that instance or class variable and retry." | ask newMessage sel canDo classOrSuper | aMessage arguments size > 1 ifTrue: [^ false]. sel _ aMessage selector asString. "works for 0 args" aMessage arguments size = 1 ifTrue: [ sel last = $: ifFalse: [^ false]. sel _ sel copyWithout: $:]. canDo _ false. classOrSuper _ self class. [((classOrSuper instVarNames includes: sel) ifTrue: [canDo _ true. nil] ifFalse: [classOrSuper _ classOrSuper superclass]) == nil] whileFalse. canDo ifFalse: [classOrSuper _ self class. [((classOrSuper classVarNames includes: sel) ifTrue: [canDo _ true. nil] ifFalse: [classOrSuper _ classOrSuper superclass]) == nil] whileFalse]. canDo ifFalse: [^ false]. ask _ self confirm: 'A ', thisContext sender sender receiver class printString, ' wants to ', (aMessage arguments size = 1 ifTrue: ['write into'] ifFalse: ['read from']), ' ', sel ,' in class ', classOrSuper printString, '. Define a this access message?'. ask ifTrue: [ aMessage arguments size = 1 ifTrue: [newMessage _ aMessage selector, ' anObject ', sel, ' _ anObject'] ifFalse: [newMessage _ aMessage selector, ' ^', aMessage selector]. classOrSuper compile: newMessage classified: 'accessing' notifying: nil]. ^ ask! ! !BookMorph methodsFor: 'other' stamp: 'tk 6/22/2001 11:55'! releaseCachedState "Release the cached state of all my pages." super releaseCachedState. self removeProperty: #allText. "the cache for text search" pages do: [:page | page fullReleaseCachedState]. ! ! !ImageSegment methodsFor: 'read/write segment' stamp: 'tk 6/22/2001 15:40'! findStacks "Return an array of all the StackMorphs in this project." | guys stacks | guys _ StackMorph withAllSubclasses asIdentitySet. stacks _ OrderedCollection new. arrayOfRoots do: [:obj | (guys includes: obj class) ifTrue: [stacks add: obj]]. ^ stacks! ! !Project methodsFor: 'file in/out' stamp: 'tk 6/28/2001 16:12'! exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it .extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder collector fd mgr stacks | "An experimental version to fileout a changeSet first so that a project can contain its own classes" world isMorph ifFalse: [ self projectParameters at: #isMVC put: true. ^ false]. "Only Morphic projects for now" world ifNil: [^ false]. world presenter ifNil: [^ false]. Utilities emptyScrapsBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState; releaseViewers. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [ self error: 'Still holding onto Global flaps']. world releaseSqueakPages. ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]). holder _ Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg _ self projectParameters at: #revertToMe ifAbsent: [nil]. self projectParameters removeKey: #revertToMe ifAbsent: []. roots _ OrderedCollection new. roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. roots add: world activeHand. "; addAll: classList; addAll: (classList collect: [:cls | cls class])" roots _ roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" fd _ aDirectory directoryNamed: self resourceDirectoryName. fd assureExistance. "Clean up resource references before writing out" mgr _ self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra: '(collecting resources...)'. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correctly if referenced from blocks or user code." world becomeActiveDuring:[ is _ ImageSegment new copySmartRootsExport: roots asArray. "old way was (is _ ImageSegment new copyFromRootsForExport: roots asArray)" ]. self resourceManager: mgr. collector _ ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [ collector replaceAll. ^ false]. str _ ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [ str _ str, '\Project''s own world is not in the segment.' withCRs]. str isEmpty ifFalse: [ ans _ (PopUpMenu labels: 'Do not write file Write file anyway Debug') startUpWithCaption: str. ans = 1 ifTrue: [ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [ collector replaceAll. self halt: 'Segment not written']]. stacks _ is findStacks. is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self writeStackText: stacks in: fd registerIn: collector. "local proj.005.myStack.t" self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "also deletes the resource directory" "Now update everything that we know about" mgr updateResourcesFrom: collector. revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. holder. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. is arrayOfRoots do: [:obj | obj class == ScriptEditorMorph ifTrue: [obj unhibernate]]. ^ true ! ! !Project methodsFor: 'file in/out' stamp: 'tk 6/28/2001 16:16'! writeStackText: stacks in: resourceDirectory registerIn: aCollector "The user's text is very valuable. Write an extra file with just the text. It can be read in case the Project can't be opened." "Find allText for each stack, storeOn a local file in the resources folder, with a name like myProj.005.myStack.t. Make the names be unique." "get project name and version" | localName sn trial char ind fs resourceURL textLoc | resourceURL _ self resourceUrl. stacks do: [:stackObj | "Construct a good file name" localName _ self versionedFileName allButLast: 2. "projectName.005." stacks size = 1 ifFalse: ["must distinguish between stacks in the project" (sn _ stackObj knownName) ifNil: [ sn _ stackObj hash printString]. "easy name, or use hash" localName _ localName , sn, FileDirectory dot]. "projectName.005.myStack." localName _ localName , 't'. "See if in use because truncates same as another, fix last char, try again" [trial _ resourceDirectory checkName: localName fixErrors: true. trial endsWith: '.t'] whileFalse: [ localName _ (localName allButLast: 3) , FileDirectory dot, 't']. [resourceDirectory fileExists: trial] whileTrue: [ char _ trial at: (ind _ trial size - 3). trial at: ind put: (char asciiValue + 1) asCharacter]. "twiddle it a little" "write allText in file" fs _ resourceDirectory newFileNamed: trial. fs timeStamp; cr; nextPutAll: '''This is the text for a stack in this project. Use only in an emergency, if the project file is ever unreadable.''.'; cr; cr. stackObj getAllText storeOn: fs. fs close. textLoc _ (ResourceLocator new) localFileName: trial; urlString: resourceURL, '/', trial. aCollector locatorMap at: trial "any distinct object" put: textLoc. ].! ! !ResourceCollector methodsFor: 'accessing' stamp: 'tk 6/28/2001 15:58'! locatorMap "allow outsiders to store in it. For files that are not resources that do want to live in the resource directory locally and on the server. (.t files for example)" ^locatorMap! !