Frank Shearar uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-fbs.699.mcz ==================== Summary ==================== Name: Morphic-fbs.699 Author: fbs Time: 25 November 2013, 9:01:18.155 am UUID: f48605fb-165d-b447-9aea-b88e8f39fdfc Ancestors: Morphic-cmm.698 Deprecate the old scrapsbook API: use ScrapBook instead of Utilities. (These things reference something in MorphicExtras! Bad!) =============== Diff against Morphic-cmm.698 =============== Item was changed: ----- Method: Morph>>slideToTrash: (in category 'dropping/grabbing') ----- slideToTrash: evt "Perhaps slide the receiver across the screen to a trash can and make it disappear into it. In any case, remove the receiver from the screen." | aForm trash startPoint endPoint morphToSlide | + ((self renderedMorph == ScrapBook default scrapBook) or: [self renderedMorph isKindOf: TrashCanMorph]) ifTrue: - ((self renderedMorph == Utilities scrapsBook) or: [self renderedMorph isKindOf: TrashCanMorph]) ifTrue: [self dismissMorph. ^ self]. Preferences slideDismissalsToTrash ifTrue: [morphToSlide := self representativeNoTallerThan: 200 norWiderThan: 200 thumbnailHeight: 100. aForm := morphToSlide imageForm offset: (0@0). trash := ActiveWorld findDeepSubmorphThat: [:aMorph | (aMorph isKindOf: TrashCanMorph) and: [aMorph topRendererOrSelf owner == ActiveWorld]] ifAbsent: [trash := TrashCanMorph new. trash position: ActiveWorld bottomLeft - (0 @ (trash extent y + 26)). trash openInWorld. trash]. endPoint := trash fullBoundsInWorld center. startPoint := self topRendererOrSelf fullBoundsInWorld center - (aForm extent // 2)]. self dismissMorph. ActiveWorld displayWorld. Preferences slideDismissalsToTrash ifTrue: [aForm slideFrom: startPoint to: endPoint nSteps: 12 delay: 15]. + ScrapBook default addToTrash: self! - Utilities addToTrash: self! Item was changed: ----- Method: MorphicProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') ----- exportSegmentWithCatagories: catList classes: classList 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 <project name>.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 | self flag: #toRemove. self halt. "unused" "world == World ifTrue: [^ false]." "self inform: 'Can''t send the current world out'." world ifNil: [^ false]. world presenter ifNil: [^ false]. + ScrapBook default emptyScrapsBook. - 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. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg := self parameterAt: #revertToMe. 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" catList do: [:sysCat | (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb | roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]]. is := ImageSegment new copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)" is state = #tooBig ifTrue: [^ 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 := (UIManager default chooseFrom: #('Do not write file' 'Write file anyway' 'Debug') title: str). ans = 1 ifTrue: [ revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg]. ^ false]. ans = 3 ifTrue: [self halt: 'Segment not written']]. is writeForExportWithSources: aFileName inDirectory: aDirectory. revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg]. holder. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. is arrayOfRoots do: [:obj | obj isScriptEditorMorph ifTrue: [obj unhibernate]]. ^ true ! Item was changed: ----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') ----- 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 <project name>.extSeg. Whatdo 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 | "Files out a changeSet first, so that a project can contain its own classes" world ifNil: [^ false]. world presenter ifNil: [^ false]. + ScrapBook default emptyScrapsBook. - 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. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg := self parameterAt: #revertToMe. self removeParameter: #revertToMe. 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 assureExistence. "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...)' translated. "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.' translated withCRs]. str isEmpty ifFalse: [ ans := UIManager default chooseFrom: { 'Do not write file' translated. 'Write file anyway' translated. 'Debug' translated. } title: str. ans = 1 ifTrue: [ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [ collector replaceAll. self halt: 'Segment not written' translated]]. 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 storeManifestFileIn: 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 isScriptEditorMorph ifTrue: [obj unhibernate]]. ^ true ! Item was changed: ----- Method: MorphicProject>>storeSegment (in category 'file in/out') ----- storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" | is sizeHint | (World == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" world ifNil: [^ false]. world presenter ifNil: [^ false]. + ScrapBook default emptyScrapsBook. - Utilities emptyScrapsBook. World checkCurrentHandForObjectToPaste. world releaseSqueakPages. sizeHint := self projectParameters at: #segmentSize ifAbsent: [0]. is := ImageSegment new copyFromRootsLocalFileFor: (Array with: world presenter with: world) "world, and all Players" sizeHint: sizeHint. is state = #tooBig ifTrue: [^ false]. is segment size < 2000 ifTrue: ["debugging" Transcript show: self name, ' only ', is segment size printString, 'bytes in Segment.'; cr]. self projectParameters at: #segmentSize put: is segment size. is extract; writeToFile: self name. ^ true ! Item was changed: ----- Method: MorphicProject>>storeSegmentNoFile (in category 'file in/out') ----- storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" | is | (World == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" world ifNil: [^ self]. world presenter ifNil: [^ self]. "Do this on project enter" World flapTabs do: [:ft | ft referent adaptToWorld: World]. "Hack to keep the Menu flap from pointing at my project" "Preferences setPreference: #useGlobalFlaps toValue: false." "Utilities globalFlapTabsIfAny do: [:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: false]. Utilities clobberFlapTabList. " "project world deleteAllFlapArtifacts." "self currentWorld deleteAllFlapArtifacts. " + ScrapBook default emptyScrapsBook. - Utilities emptyScrapsBook. World checkCurrentHandForObjectToPaste2. is := ImageSegment new copyFromRootsLocalFileFor: (Array with: world presenter with: world) "world, and all Players" sizeHint: 0. is segment size < 800 ifTrue: ["debugging" Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep]. is extract. "is instVarAt: 2 put: is segment clone." "different memory" ! Item was changed: ----- Method: PasteUpMorph>>openScrapsBook: (in category 'world menu') ----- openScrapsBook: evt "Open up the Scraps book in the center of the screen" + evt hand world addMorphCentered: ScrapBook default scrapBook! - evt hand world addMorphCentered: Utilities scrapsBook! |
Free forum by Nabble | Edit this page |