'From Squeak3.1alpha of 4 February 2001 [latest update: #3845] on 15 March 2001 at 11:04:35 pm'! "Change Set: HTMLProto-ar Date: 15 March 2001 Author: Andreas Raab When publishing a project, include an HTML page with it. This ensures that links from HTML will always use the latest version and simplifies numerous problems when attempting to retrieve projects through a web browser."! !Project methodsFor: 'file in/out' stamp: 'ar 3/15/2001 22:36'! 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 | "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...)'. 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']]. 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 compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "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: 'ar 3/15/2001 22:42'! htmlPagePrototype "Return the HTML page prototype" ^' Squeak Project '! ! !Project methodsFor: 'file in/out' stamp: 'ar 3/15/2001 22:53'! storeHtmlPageIn: aFileDirectory "Prepare the HTML wrapper for the current project" | file page | file _ aFileDirectory forceNewFileNamed: (self name, FileDirectory dot,'html'). page _ self htmlPagePrototype. page _ page copyReplaceAll: '$$PROJECT$$' with: self versionedFileName. page _ page copyReplaceAll: '$$WIDTH$$' with: world bounds width printString. page _ page copyReplaceAll: '$$HEIGHT$$' with: world bounds height printString. page _ page copyReplaceAll: String cr with: String lf. "not sure if necessary..." file nextPutAll: page. file close.! ! !String class methodsFor: 'instance creation' stamp: 'ar 3/15/2001 22:47'! lf "Answer a string containing a single carriage return character." ^ self with: Character lf! !