[squeak-dev] The Trunk: Morphic-tpr.1968.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Apr 19 18:48:45 UTC 2022


tim Rowledge uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-tpr.1968.mcz

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

Name: Morphic-tpr.1968
Author: tpr
Time: 19 April 2022, 11:48:37.562456 am
UUID: cc640262-3b82-4ae0-a043-458a8ddf28e6
Ancestors: Morphic-mt.1967

Use the new ToolBuilder ability to show a list of options - typically a small number, maybe with a cancel button etc - as opposed to an arbitrary list of values. This separates it out from the chooseFrom:... protocol.
Also update "UIManager default" with "Project uiManager"

=============== Diff against Morphic-mt.1967 ===============

Item was changed:
  ----- Method: HaloMorph>>maybeDismiss:with: (in category 'private') -----
  maybeDismiss: evt with: dismissHandle
  	"Ask hand to dismiss my target if mouse comes up in it."
  
  	evt hand obtainHalo: self.
  	(dismissHandle containsPoint: evt cursorPoint)
+ 		ifFalse:
+ 			[self delete.
- 		ifFalse: [
- 			self delete.
  			target addHalo: evt]
+ 		ifTrue:
+ 			[target resistsRemoval ifTrue:
+ 				[(Project uiManager
+ 					chooseOptionFrom:
+ 					{'Yes' translated.
+ 					'Um, no, let me reconsider' translated.}
+ 					title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]].
- 		ifTrue: [
- 			target resistsRemoval ifTrue:
- 				[(UIManager default chooseFrom: {
- 					'Yes' translated.
- 					'Um, no, let me reconsider' translated.
- 				} title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]].
  			evt hand removeHalo.
  			self delete.
  			target dismissViaHalo.
  			self currentWorld presenter flushPlayerListCache].!

Item was changed:
  ----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') -----
  exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName
  directory: aDirectory withoutInteraction: noInteraction
  	"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 emptyScrapBook.
  	(world respondsTo: #cleanUpReferences) ifTrue:
  		[world cleanUpReferences].
  	world currentHand pasteBuffer: nil.	  "don't write the paste buffer."
  	world currentHand mouseOverHandler initialize.	  "forget about any
  	references here"
+ 	"Display checkCurrentHandForObjectToPaste."
- 		"Display checkCurrentHandForObjectToPaste."
  	Command initialize.
  	world clearCommandHistory.
  	world fullReleaseCachedState; releaseViewers.
  	world cleanseStepList.
+ 	world localFlapTabs size = world flapTabs size ifFalse:
+ 		[noInteraction ifTrue: [^ false].
- 	world localFlapTabs size = world flapTabs size ifFalse: [
- 		noInteraction ifTrue: [^ false].
  		self error: 'Still holding onto Global flaps'].
  	world releaseSqueakPages.
+ 	Smalltalk
+ 		at: #ScriptEditorMorph
+ 		ifPresent:
+ 			[:s |
+ 			s writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false])].
- 	Smalltalk at: #ScriptEditorMorph ifPresent: [:s |
- 		s 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 parameterAt: #revertToMe.
  	self removeParameter: #revertToMe.
  
  	roots := OrderedCollection new.
+ 	roots
+ 		add: self;
+ 		add: world;
+ 		add: transcript;
+ 		add: aChangeSetOrNil;
+ 		add: thumbnail;
+ 		add: world activeHand.
- 	roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand.
  
+ 	roots := roots reject: [ :x | x isNil].	"early saves may not have active hand or thumbnail"
- 		"; 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 copySmartRootsExport: roots asArray.
+ 		"old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"].
- 	world becomeActiveDuring:[
- 		is := ImageSegment 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.
- 	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 := Project uiManager
+ 					chooseOptionFrom: 
+ 						{'Do not write file' translated.
+ 						'Write file anyway' translated.
+ 						'Debug' translated}
+ 					 title: str.
+ 		ans = 1 ifTrue:
+ 			[revertSeg ifNotNil:
+ 				[projectParameters at: #revertToMe put: revertSeg].
- 	(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.
- 		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"
- 		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].
- 	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]].
- 
- 	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>>loadFromServer: (in category 'file in/out') -----
  loadFromServer: newerAutomatically
  	"If a newer version of me is on the server, load it."
  	| pair resp server |
  	self assureIntegerVersion.
  
+ 	self isCurrentProject ifTrue: "exit, then do the command"
+ 		[^ self armsLengthCommand: #loadFromServer withDescription: 'Loading' translated].
- 	self isCurrentProject ifTrue: ["exit, then do the command"
- 		^ self armsLengthCommand: #loadFromServer withDescription: 'Loading' translated
- 	].
  	server := self tryToFindAServerWithMe ifNil: [^ nil].
  	pair := self class mostRecent: self name onServer: server.
+ 	pair first ifNil:
+ 		[^ self inform: ('can''t find file on server for {1}' translated format: {self name})].
+ 	self currentVersionNumber > pair second ifTrue: 
+ 		[^ self inform: ('That server has an older version of the project.' translated)].
+ 	version = (Project parseProjectFileName: pair first) second
+ 				ifTrue: [resp := (Project uiManager
+ 									chooseOptionFrom: 
+ 										{ 'Reload anyway' translated. 'Cancel' translated withCRs} 
+ 									title:  'The only changes are the ones you made here.' translated).
+ 					resp ~= 1 ifTrue: [^ nil]]
+ 				ifFalse: [newerAutomatically ifFalse:
+ 						[resp := Project uiManager
+ 									chooseOptionFrom: {'Load it' translated. 'Cancel' translated}
+ 									title:  'A newer version exists on the server.' translated.
+ 			resp ~= 1 ifTrue: [^ nil]]].
- 	pair first ifNil: [^ self inform: ('can''t find file on server for {1}' translated format: {self name})].
- 	self currentVersionNumber > pair second ifTrue: [
- 		^ self inform: ('That server has an older version of the project.' translated)].
- 	version = (Project parseProjectFileName: pair first) second ifTrue: [
- 		resp := (UIManager default chooseFrom: 
- 				(Array with: 'Reload anyway' translated 
- 						with: 'Cancel' translated withCRs) 
- 				title:  'The only changes are the ones you made here.' translated).
- 		resp ~= 1 ifTrue: [^ nil]
- 	] ifFalse: [
- 		newerAutomatically ifFalse: [
- 			resp := (UIManager default 
- 						chooseFrom: {'Load it' translated. 'Cancel' translated}
- 						title:  'A newer version exists on the server.' translated).
- 			resp ~= 1 ifTrue: [^ nil]
- 		].
- 	].
  
  	"let's avoid renaming the loaded change set since it will be replacing ours"
  	self projectParameters at: #loadingNewerVersion put: true.
  
  	ComplexProgressIndicator new 
  		targetMorph: nil;
  		historyCategory: 'project loading';
+ 		withProgressDo:
+ 			[ProjectLoading
- 		withProgressDo: [
- 			ProjectLoading
  				installRemoteNamed: pair first
  				from: server
  				named: self name
+ 				in: parentProject]!
- 				in: parentProject
- 		]!

Item was changed:
  ----- Method: PasteUpMorph>>checkCurrentHandForObjectToPaste (in category 'world state') -----
  checkCurrentHandForObjectToPaste
  
  	| response |
  	self primaryHand pasteBuffer ifNil: [^self].
+ 	response := Project uiManager
+ 					chooseOptionFrom: #('Delete' 'Keep')
+ 					title: 'Hand is holding a Morph in its paste buffer:\' withCRs,
+ 							self primaryHand pasteBuffer printString.
+ 	response = 1 ifTrue:
+ 		[self primaryHand pasteBuffer: nil].
- 	response := UIManager default chooseFrom: #('Delete' 'Keep')
- 		title: 'Hand is holding a Morph in its paste buffer:\' withCRs,
- 			self primaryHand pasteBuffer printString.
- 	response = 1 ifTrue: [self primaryHand pasteBuffer: nil].
  !

Item was changed:
  ----- Method: ProjectViewMorph>>dismissViaHalo (in category 'initialization') -----
  dismissViaHalo
  	| choice |
  	project ifNil:[^self delete]. "no current project"
+ 	choice := Project uiManager
+ 				chooseOptionFrom: 
+ 					{'yes - delete the window and the project' translated.
+ 					'no - delete the window only' translated}
+ 				title: ('Do you really want to delete {1}
- 	choice := UIManager default chooseFrom: {
- 		'yes - delete the window and the project' translated.
- 		'no - delete the window only' translated
- 	} title: ('Do you really want to delete {1}
  and all its content?' translated format: {project name printString}).
  	choice = 1 ifTrue:[^self expungeProject].
  	choice = 2 ifTrue:[^self delete].!



More information about the Squeak-dev mailing list