[Pkg] The Trunk: Morphic-cmm.485.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Dec 6 21:38:51 UTC 2010


Chris Muller uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-cmm.485.mcz

==================== Summary ====================

Name: Morphic-cmm.485
Author: cmm
Time: 6 December 2010, 3:37:12.45 pm
UUID: b112abf5-1ce6-4854-9b01-817977a7ff09
Ancestors: Morphic-cmm.484

- Allow each MorphicProject to maintain its own docking-bar.
- Minor clean-ups of access to the "project-parameter" api..

=============== Diff against Morphic-cmm.484 ===============

Item was changed:
  ----- Method: MorphicProject>>cleanseDisabledGlobalFlapIDsList (in category 'flaps support') -----
  cleanseDisabledGlobalFlapIDsList
  	"Make certain that the items on the disabled-global-flap list are actually global flaps, and if not, get rid of them"
  
  	| disabledFlapIDs currentGlobalIDs oldList |
  	disabledFlapIDs := self parameterAt: #disabledGlobalFlapIDs ifAbsent: [Set new].
  	currentGlobalIDs := Flaps globalFlapTabsIfAny collect: [:f | f flapID].
  	oldList := Project current projectParameterAt: #disabledGlobalFlaps ifAbsent: [nil].
  	oldList ifNotNil:
  		[disabledFlapIDs := oldList select: [:aFlap | aFlap flapID]].
  	disabledFlapIDs := disabledFlapIDs select: [:anID | currentGlobalIDs includes: anID].
  	self projectParameterAt: #disabledGlobalFlapIDs put: disabledFlapIDs.
  
+ 	self removeParameter: #disabledGlobalFlaps.
- 	projectParameters ifNotNil:
- 		[projectParameters removeKey: #disabledGlobalFlaps ifAbsent: []].
  !

Item was changed:
  ----- Method: MorphicProject>>createOrUpdateMainDockingBar (in category 'docking bars support') -----
  createOrUpdateMainDockingBar
  	"Private - create a new main docking bar or update the current one"
  	| w mainDockingBars |
  	w := self world.
  	mainDockingBars := w mainDockingBars.
  	mainDockingBars isEmpty
  		ifTrue: ["no docking bar, just create a new one"
+ 			self dockingBar createDockingBar openInWorld: w.
- 			TheWorldMainDockingBar instance createDockingBar openInWorld: w.
  			^ self].
  	"update if needed"
  	mainDockingBars
+ 		do: [:each | self dockingBar updateIfNeeded: each]!
- 		do: [:each | TheWorldMainDockingBar instance updateIfNeeded: each]!

Item was added:
+ ----- Method: MorphicProject>>dockingBar (in category 'docking bars support') -----
+ dockingBar
+ 	^ self
+ 		projectParameterAt: #dockingBar
+ 		ifAbsent: [ TheWorldMainDockingBar instance ]!

Item was added:
+ ----- Method: MorphicProject>>dockingBar: (in category 'docking bars support') -----
+ dockingBar: aTheWorldMainDockingBar 
+ 	self
+ 		projectParameterAt: #dockingBar
+ 		put: aTheWorldMainDockingBar.
+ 	self isCurrentProject ifTrue: [ TheWorldMainDockingBar instance: aTheWorldMainDockingBar ]!

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].
  
  	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.
- 	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"
  
  	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].
- 			revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
  			^ false].
  		ans = 3 ifTrue: [self halt: 'Segment not written']].
  
  	is writeForExportWithSources: aFileName inDirectory: aDirectory.
+ 	revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg].
- 	revertSeg ifNotNil: [projectParameters at: #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].
  
  	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.
- 	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 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
  !



More information about the Packages mailing list