[Pkg] The Trunk: Morphic-fbs.699.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Nov 25 09:35:29 UTC 2013
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 at 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!
More information about the Packages
mailing list