[squeak-dev] The Trunk: System-tpr.1343.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Apr 19 18:57:24 UTC 2022


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

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

Name: System-tpr.1343
Author: tpr
Time: 19 April 2022, 11:57:19.004993 am
UUID: 165bce13-ef7f-4f02-ac31-c9b7a17f4e04
Ancestors: System-mt.1342

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 System-mt.1342 ===============

Item was changed:
  ----- Method: AutoStart class>>processUpdates (in category 'updating') -----
  processUpdates
  	"Process update files from a well-known update server.  This method is called at system startup time,   Only if the preference #updateFromServerAtStartup is true is the actual update processing undertaken automatically"
  	| choice |
  	(MCMcmUpdater updateFromServerAtStartup) ifTrue:
+ 		[choice := Project uiManager
+ 			chooseOptionFrom: #('Yes, Update' 'No, Not now' 'Don''t ask again')
- 		[choice := UIManager default chooseFrom: #('Yes, Update' 'No, Not now' 'Don''t ask again')
  			title: 'Shall I look for new code\updates on the server?' withCRs.
+ 		choice = 1 ifTrue: 
+ 			[MCMcmUpdater updateFromServer].
+ 		choice = 3 ifTrue: 
+ 			[MCMcmUpdater updateFromServerAtStartup: false.
- 		choice = 1 ifTrue: [
- 			MCMcmUpdater updateFromServer].
- 		choice = 3 ifTrue: [
- 			MCMcmUpdater updateFromServerAtStartup: false.
  			self inform: 'Remember to save your image to make this setting permant']]!

Item was changed:
  ----- Method: ChangeSet class>>promptForDefaultChangeSetDirectoryIfNecessary (in category 'defaults') -----
  promptForDefaultChangeSetDirectoryIfNecessary
  	"Check the Preference (if any), and prompt the user to change it if necessary.
  	The default if the Preference is unset is the current directory.
  	Answer the directory."
  
  	"ChangeSet promptForDefaultChangeSetDirectoryIfNecessary"
  	| choice directoryName dir |
  	directoryName := Preferences
  				parameterAt: #defaultChangeSetDirectoryName
  				ifAbsentPut: [''].
  	[dir := FileDirectory default directoryNamed: directoryName.
  	dir exists]
+ 		whileFalse: [choice :=Project uiManager
+ 								chooseOptionFrom: 
+ 									{'Create directory' translated.
+ 									'Use default directory and forget preference' translated.
+ 									'Choose another directory'  translated}
+ 								title: ('The preferred change set directory (''{1}'') does not exist.
- 		whileFalse: [choice := UIManager default chooseFrom: {
- 			'Create directory' translated.
- 			'Use default directory and forget preference' translated.
- 			'Choose another directory'  translated
- 		} title: ('The preferred change set directory (''{1}'') does not exist.
  Create it or use the default directory ({2})?' translated format: { directoryName. FileDirectory default pathName }).
+ 			choice = 1 ifTrue: [dir assureExistence ].
+ 			choice = 3 ifTrue:
+ 				[dir := Project uiManager chooseDirectory.
+ 				directoryName := dir
- 			choice = 1
- 				ifTrue: [dir assureExistence ].
- 			choice = 3
- 				ifTrue: [dir := UIManager default chooseDirectory.
- 					directoryName := dir
  					ifNil: [ '' ]
+ 					ifNotNil: [dir pathName ]]].
- 						ifNotNil: [dir pathName ]]].
  		self defaultChangeSetDirectory: directoryName.
  		^dir!

Item was changed:
  ----- Method: ChangeSet>>askRenames:addTo:using: (in category 'fileIn/Out') -----
  askRenames: renamed addTo: msgSet using: smart
  	| list |
  	"Go through the renamed classes.  Ask the user if it could be in a project.  Add a method in SmartRefStream, and a conversion method in the new class."
  
  	list := OrderedCollection new.
+ 	renamed do:
+ 		[:cls | | rec ans oldStruct newStruct |
- 	renamed do: [:cls | | rec ans oldStruct newStruct |
  		rec := changeRecords at: cls name.
  		rec priorName ifNotNil: [
+ 			ans := Project uiManager
+ 						chooseOptionFrom: 
+ 							#('Yes, write code to convert those instances'
+ 							'No, no instances are in projects')
+ 						title: 'You renamed class ', rec priorName, 
+ 							' to be ', rec thisName,
+ 							'.\Could an instance of ', rec priorName, 
+ 							' be in a project on someone''s disk?'.
+ 			ans = 1 ifTrue: 
+ 				[oldStruct := structures at: rec priorName ifAbsent: [nil].
+ 				newStruct := (Array with: cls classVersion), (cls allInstVarNames).
+ 				oldStruct ifNotNil:
+ 					[smart
+ 						writeConversionMethodIn: cls
+ 						fromInstVars: oldStruct 
+ 						to: newStruct
+ 						renamedFrom: rec priorName.
+ 					smart
+ 						writeClassRename: cls name
+ 						was: rec priorName.
+ 					list add: cls name, ' convertToCurrentVersion:refStream:']]
- 			ans := UIManager default chooseFrom: 
- 					#('Yes, write code to convert those instances'
- 					'No, no instances are in projects')
- 				title: 'You renamed class ', rec priorName, 
- 				' to be ', rec thisName,
- 				'.\Could an instance of ', rec priorName, 
- 				' be in a project on someone''s disk?'.
- 			ans = 1 ifTrue: [
- 					oldStruct := structures at: rec priorName ifAbsent: [nil].
- 					newStruct := (Array with: cls classVersion), (cls allInstVarNames).
- 					oldStruct ifNotNil: [
- 						smart writeConversionMethodIn: cls fromInstVars: oldStruct 
- 								to: newStruct renamedFrom: rec priorName.
- 						smart writeClassRename: cls name was: rec priorName.
- 						list add: cls name, ' convertToCurrentVersion:refStream:']]
  				ifFalse: [structures removeKey: rec priorName ifAbsent: []]]].
+ 	list isEmpty ifTrue:
+ 		[^ msgSet].
+ 	msgSet messageList
+ 		ifNil:  [msgSet initializeMessageList: list]
- 	list isEmpty ifTrue: [^ msgSet].
- 	msgSet messageList ifNil: [msgSet initializeMessageList: list]
  		ifNotNil: [list do: [:item | msgSet addItem: item]].
  	^ msgSet!

Item was changed:
  ----- Method: ChangeSet>>checkForConversionMethods (in category 'fileIn/Out') -----
  checkForConversionMethods
  	"See if any conversion methods are needed"
  	| tell choice smart restore renamed listAdd listDrop msgSet list |
  
  	Preferences conversionMethodsAtFileOut ifFalse: [^ self].	"Check preference"
  	structures ifNil: [^ self].
  
  	list := OrderedCollection new.
  	renamed := OrderedCollection new.
+ 	self changedClasses do:
+ 		[:class | | newStruct sel oldStruct need rec |
- 	self changedClasses do: [:class | | newStruct sel oldStruct need rec |
  		need := (self atClass: class includes: #new) not.
+ 		need ifTrue: "Renamed classes."
+ 			[(self atClass: class includes: #rename) ifTrue:
+ 				[rec := changeRecords at: class name.
+ 				rec priorName ifNotNil:
+ 					[(structures includesKey: rec priorName) ifTrue:
+ 						[renamed add: class.  need := false]]]].
- 		need ifTrue: ["Renamed classes."
- 			(self atClass: class includes: #rename) ifTrue: [
- 				rec := changeRecords at: class name.
- 				rec priorName ifNotNil: [
- 					(structures includesKey: rec priorName) ifTrue: [
- 						renamed add: class.  need := false]]]].
  		need ifTrue: [need := (self atClass: class includes: #change)].
+ 		need ifTrue: [oldStruct := structures
+ 									at: class name 
- 		need ifTrue: [oldStruct := structures at: class name 
  									ifAbsent: [need := false.  #()]].
+ 		need ifTrue:
+ 			[newStruct := (Array with: class classVersion), (class allInstVarNames).
- 		need ifTrue: [
- 			newStruct := (Array with: class classVersion), (class allInstVarNames).
  			need := (oldStruct ~= newStruct)].
+ 		need ifTrue:
+ 			[sel := #convertToCurrentVersion:refStream:.
+ 			(#(add change) includes: (self atSelector: sel class: class)) ifFalse:
+ 				[list add: class]]].
- 		need ifTrue: [sel := #convertToCurrentVersion:refStream:.
- 			(#(add change) includes: (self atSelector: sel class: class)) ifFalse: [
- 				list add: class]].
- 		].
  
  	list isEmpty & renamed isEmpty ifTrue: [^ self].
  	"Ask user if want to do this"
  	tell := 'If there might be instances of ', (list asArray, renamed asArray) printString,
  		'\in a project (.pr file) on someone''s disk, \please ask to write a conversion method.\'
  			withCRs,
  		'After you edit the conversion method, you''ll need to fileOut again.\' withCRs,
  		'The preference conversionMethodsAtFileOut in category "fileout" controls this feature.'.
+ 	choice := Project uiManager chooseOptionFrom:
+ #('Write a conversion method by editing a prototype'
+ 'These classes are not used in any object file. fileOut my changes now'
+ 'I''m too busy.  fileOut my changes now'
+ 'Don''t ever ask again.  fileOut my changes now.')  title: tell. 
- 	choice := UIManager default chooseFrom:
- 'Write a conversion method by editing a prototype
- These classes are not used in any object file.  fileOut my changes now.
- I''m too busy.  fileOut my changes now.
- Don''t ever ask again.  fileOut my changes now.' withCRs title: tell. 
  	choice = 4 ifTrue: [Preferences disable: #conversionMethodsAtFileOut].
+ 	choice = 2 ifTrue:
+ 			["Don't consider this class again in the changeSet"
+ 			list do:
+ 				[:cls |
+ 				structures removeKey: cls name ifAbsent: []].
+ 			renamed do:
+ 				 [:cls | | nn | 
- 	choice = 2 ifTrue: ["Don't consider this class again in the changeSet"
- 			list do: [:cls | structures removeKey: cls name ifAbsent: []].
- 			renamed do: [:cls | | nn | 
  				nn := (changeRecords at: cls name) priorName.
  				structures removeKey: nn ifAbsent: []]].
  	choice ~= 1 ifTrue: [^ self].	"exit if choice 2,3,4"
  
  	listAdd := self askAddedInstVars: list.	"Go through each inst var that was added"
  	listDrop := self askRemovedInstVars: list.	"Go through each inst var that was removed"
  	list := (listAdd, listDrop) asSet asArray.
  
  	smart := SmartRefStream on: (RWBinaryOrTextStream on: '12345').
  	smart structures: structures.
  	smart superclasses: superclasses.
+ 	(restore := self class current) == self ifFalse:
+ 		[self class  newChanges: self].	"if not current one"
- 	(restore := self class current) == self ifFalse: [
- 		self class  newChanges: self].	"if not current one"
  	msgSet := smart conversionMethodsFor: list.
  		"each new method is added to self (a changeSet).  Then filed out with the rest."
  	self askRenames: renamed addTo: msgSet using: smart.	"renamed classes, add 2 methods"
+ 	restore == self ifFalse:
+ 		[self class newChanges: restore].
- 	restore == self ifFalse: [self class newChanges: restore].
  	msgSet isEmpty ifTrue: [^ self].
  	self inform: 'Remember to fileOut again after modifying these methods.'.
  	ToolSet 
  		browseMessageSet: msgSet 
  		name: 'Conversion methods for ', self name 
  		autoSelect: nil!

Item was changed:
  ----- Method: ChangeSet>>chooseSubjectPrefixForEmail (in category 'fileIn/Out') -----
  chooseSubjectPrefixForEmail
  
  	| subjectIndex |
+ 	subjectIndex := (Project uiManager
+ 						chooseOptionFrom:
+ 							#('Bug fix [FIX]'
+ 							'Enhancement [ENH]'
+ 							'Goodie [GOODIE]'
+ 							'Test suite [TEST]'
+ 							'None of the above (will not be archived)')
+ 						title: 'What type of change set\are you submitting to the list?' withCRs).
- 
- 	subjectIndex :=
- 		(UIManager default chooseFrom: #('Bug fix [FIX]' 'Enhancement [ENH]' 'Goodie [GOODIE]' 'Test suite [TEST]' 'None of the above (will not be archived)')
- 			title: 'What type of change set\are you submitting to the list?' withCRs).
- 
  	^ #('[CS] ' '[FIX] ' '[ENH] ' '[GOODIE] ' '[TEST] ' '[CS] ') at: subjectIndex + 1!

Item was changed:
  ----- Method: NativeImageSegment class>>startUp (in category 'fileIn/Out') -----
  startUp
  	| choice |
  	"Minimal thing to assure that a .segs folder is present"
  
+ 	(Preferences valueOfFlag: #projectsSentToDisk) ifTrue:
+ 		[(FileDirectory default includesKey: (FileDirectory localNameFor: self folder)) ifFalse:
+ 			[choice := Project uiManager
+ 						chooseOptionFrom: #('Create folder' 'Quit without saving')
+ 						title: 
- (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [
- 	(FileDirectory default includesKey: (FileDirectory localNameFor: self folder)) 
- 		ifFalse: [
- 			choice := UIManager default 
- 				chooseFrom: #('Create folder' 'Quit without saving')
- 				title: 
  					'The folder with segments for this image is missing.\' withCRs,
  					self folder, '\If you have moved or renamed the image file,\' withCRs,
  					'please Quit and rename the segments folder in the same way'.
  			choice = 1 ifTrue: [FileDirectory default createDirectory: self folder].
  			choice = 2 ifTrue: [Smalltalk snapshot: false andQuit: true]]]
  
  	!

Item was changed:
  ----- Method: NativeImageSegment>>copySmartRootsExport: (in category 'read/write segment') -----
  copySmartRootsExport: rootArray 
  	"Use SmartRefStream to find the object.  Make them all roots.  Create the segment in memory.  Project should be in first five objects in rootArray."
  	| newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world |
  
- 	"self halt."
  	world := Project current world.
+ 	symbolHolder := Symbol allSymbols.	"Hold onto Symbols with strong pointers, so they will be in outPointers"
- 	symbolHolder := Symbol allSymbols.	"Hold onto Symbols with strong pointers, 
- 		so they will be in outPointers"
  
+ 	dummy := ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file"
- 	dummy := ReferenceStream on: (DummyStream on: nil).
- 		"Write to a fake Stream, not a file"
  	"Collect all objects"
  	dummy insideASegment: true.	"So Uniclasses will be traced"
  	dummy rootObject: rootArray.	"inform him about the root"
  	dummy nextPut: rootArray.
+ 	(proj :=dummy project) ifNotNil:
+ 		[self dependentsSave: dummy].
- 	(proj :=dummy project) ifNotNil: [self dependentsSave: dummy].
  	allClasses := SmartRefStream new uniClassInstVarsRefs: dummy.
  		"catalog the extra objects in UniClass inst vars.  Put into dummy"
+ 	allClasses do:
+ 		[:cls | 
- 	allClasses do: [:cls | 
  		dummy references at: cls class put: false.	"put Player5 class in roots"
  		dummy blockers removeKey: cls class ifAbsent: []].
  	"refs := dummy references."
  	arrayOfRoots := self smartFillRoots: dummy.	"guaranteed none repeat"
  	self savePlayerReferences: dummy references.	"for shared References table"
  	replacements := dummy blockers.
+ 	dummy project "recompute it" ifNil:
+ 		[self error: 'lost the project!!'].
+ 	dummy project class == DiskProxy ifTrue:
+ 		[self error: 'saving the wrong project'].
- 	dummy project "recompute it" ifNil: [self error: 'lost the project!!'].
- 	dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project'].
  	dummy := nil.	"Allow dummy to be GC'ed below (bytesLeft)."
+ 	naughtyBlocks := arrayOfRoots select:
+ 		[ :each |
- 	naughtyBlocks := arrayOfRoots select: [ :each |
  		each isContext and: [each hasInstVarRef]].
  
  	"since the caller switched ActiveWorld, put the real one back temporarily"
+ 	naughtyBlocks isEmpty ifFalse:
+ 		[world becomeActiveDuring:
+ 			[world firstHand becomeActiveDuring:
+ 				[ | goodToGo |
+ 				goodToGo := (Project uiManager
+ 								chooseOptionFrom: #('keep going' 'stop and take a look')
+ 								title:
+ 	'Some block(s) which reference instance variables 
+ 	are included in this segment. These may fail when
+ 	the segment is loaded if the class has been reshaped.
+ 	What would you like to do?') = 1.
+ 				goodToGo ifFalse:
+ 					[naughtyBlocks inspect.
+ 					self error: 'Here are the bad blocks']]]].
- 	naughtyBlocks isEmpty ifFalse: [
- 		world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo |
- 			goodToGo := (UIManager default
- 				chooseFrom: #('keep going' 'stop and take a look')
- 				title:
- 'Some block(s) which reference instance variables 
- are included in this segment. These may fail when
- the segment is loaded if the class has been reshaped.
- What would you like to do?') = 1.
- 			goodToGo ifFalse: [
- 				naughtyBlocks inspect.
- 				self error: 'Here are the bad blocks'].
- 		]].
- 	].
  	"Creation of the segment happens here"
  
  	"try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)"
  	sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024.
  	self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true.
  	segSize := segment size.
  	[(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse:
  		[arrayOfRoots := newRoots.
  		self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
  		"with methods pointed at from outside"
  	[(newRoots := self rootsIncludingBlocks) == nil] whileFalse:
  		[arrayOfRoots := newRoots.
  		self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
  		"with methods, blocks from outPointers"
+ 	1 to: outPointers size do:
+ 		[:ii | | outPointer |
- 	1 to: outPointers size do: [:ii | | outPointer |
  		outPointer := outPointers at: ii.
  		(outPointer isBlock
  		 or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil].
  		"substitute new object in outPointers"
  		(replacements includesKey: outPointer) ifTrue:
  			[outPointers at: ii put: (replacements at: outPointer)]].
+ 	proj ifNotNil:
+ 		[self dependentsCancel: proj].
- 	proj ifNotNil: [self dependentsCancel: proj].
  	symbolHolder. "hold onto symbolHolder until the last."!

Item was removed:
- ----- Method: Preferences class>>useFormsInPaintBox (in category 'standard queries') -----
- useFormsInPaintBox
- 	^ self
- 		valueOfFlag: #useFormsInPaintBox
- 		ifAbsent: [false]!

Item was changed:
  ----- Method: Project>>decideAboutCreatingBlank: (in category 'file in/out') -----
  decideAboutCreatingBlank: otherProjectName
  
  	| resp |
+ 	true ifFalse: "if saved, then maybe don't create"
+ 		[resp := (Project uiManager
+ 					chooseOptionFrom: #('Yes, make it up' 'No, skip it') 
+ 					title: ('I cannot locate the project\',
+ 						otherProjectName,
+ 						'\Would you like me to create a new project\with that name?'
+ 					) withCRs).
+ 		resp = 1 ifFalse: [^ nil]].
- 
- 	"20 Oct - just do it"
- 	true "version isNil" ifFalse: [	"if saved, then maybe don't create"
- 		resp := (UIManager default chooseFrom: #('Yes, make it up' 'No, skip it') 
- 			title: ('I cannot locate the project\',
- 				otherProjectName,
- 				'\Would you like me to create a new project\with that name?'
- 			) withCRs).
- 		resp = 1 ifFalse: [^ nil]
- 	].
  	^Project current openBlankProjectNamed: otherProjectName!

Item was changed:
  ----- Method: Project>>enter:revert:saveForRevert: (in category 'enter') -----
  enter: returningFlag revert: revertFlag saveForRevert: saveForRevert
  	"Install my ChangeSet, Transcript, and scheduled views as current globals. If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case.
  	If saveForRevert is true, save the ImageSegment of the project being left.
  	If revertFlag is true, make stubs for the world of the project being left.
  	If revertWithoutAsking is true in the project being left, then always revert."
  
  	| leavingProject forceRevert response seg |
  
+ 	self isIncompletelyLoaded ifTrue:
+ 		[^ self loadFromServer: true].
+ 	self isCurrentProject ifTrue: [^ self].
- 	self isIncompletelyLoaded
- 		ifTrue: [^ self loadFromServer: true].
- 	self isCurrentProject
- 		ifTrue: [^ self].
  	
  	EmergencyRecoveryRequested := false. "normal project entry clears recursion guard"
  	forceRevert := false.
  	CurrentProject rawParameters 
+ 		ifNil: [revertFlag ifTrue:
+ 			[^ self inform: 'nothing to revert to' translated]]
+ 		ifNotNil: [saveForRevert ifFalse:
+ 			[forceRevert := CurrentProject projectParameters at: #revertWithoutAsking ifAbsent: [false]]].
+ 	forceRevert not & revertFlag ifTrue: 
+ 		[response := (Project uiManager
+ 						chooseOptionFrom: 
+ 							{'Revert to saved version' translated.
+ 							'Cancel' translated.}
+ 		 				title: 'Are you sure you want to destroy this Project\ and revert to an older version?\\(From the parent project, click on this project''s thumbnail.)' translated withCRs) = 1.
- 		ifNil: [revertFlag ifTrue: [^ self inform: 'nothing to revert to' translated]]
- 		ifNotNil: [saveForRevert ifFalse: [
- 				forceRevert := CurrentProject projectParameters 
- 								at: #revertWithoutAsking ifAbsent: [false]]].
- 	forceRevert not & revertFlag ifTrue: [
- 		response := (UIManager default chooseFrom: {
- 			'Revert to saved version' translated.
- 			'Cancel' translated.
- 		} title: 'Are you sure you want to destroy this Project\ and revert to an older version?\\(From the parent project, click on this project''s thumbnail.)' translated withCRs) = 1.
  		response ifFalse: [^ self]].
  
  	revertFlag | forceRevert 
+ 		ifTrue:
+ 			[seg := CurrentProject projectParameters at: #revertToMe ifAbsent:
+ 				[^ self inform: 'nothing to revert to' translated]]
+ 		ifFalse: 
+ 			[CurrentProject makeThumbnail.
- 		ifTrue: [seg := CurrentProject projectParameters at: #revertToMe ifAbsent: [
- 					^ self inform: 'nothing to revert to' translated]]
- 		ifFalse: [
- 			CurrentProject makeThumbnail.
  			returningFlag == #specialReturn
  				ifTrue:
  					[ProjectHistory forget: CurrentProject.		"this guy is irrelevant"
  					Project forget: CurrentProject]
+ 				ifFalse: [ProjectHistory remember: CurrentProject]].
- 				ifFalse:
- 					[ProjectHistory remember: CurrentProject]].
  
  	(revertFlag | saveForRevert | forceRevert) ifFalse: [
+ 		(Preferences valueOfFlag: #projectsSentToDisk) ifTrue:
+ 			[self inform: 'Project serialization via image segments\does not work at the moment. Disabling the\preference #projectsSentToDisk now...' withCRs.
+ 			Preferences disable: #projectsSentToDisk]].
- 		(Preferences valueOfFlag: #projectsSentToDisk)
- 			ifTrue: [
- 				self inform: 'Project serialization via image segments\does not work at the moment. Disabling the\preference #projectsSentToDisk now...' withCRs.
- 				Preferences disable: #projectsSentToDisk.
- 				"self storeToMakeRoom"]].
  
  	"Update display depth for leaving and entring project."
  	CurrentProject displayDepth: Display depth.
+ 	displayDepth == nil ifTrue:
+ 		[displayDepth := Display depth].
- 	displayDepth == nil ifTrue: [displayDepth := Display depth].
  	self installNewDisplay: Display extent depth: displayDepth.
  
+ 	returningFlag == #specialReturn
+ 		ifTrue:
+ 			 [CurrentProject removeChangeSetIfPossible.	"keep this stuff from accumulating"
+ 			nextProject := nil]
+ 		ifFalse:
+ 		[returningFlag
- 	returningFlag == #specialReturn ifTrue: [
- 		CurrentProject removeChangeSetIfPossible.	"keep this stuff from accumulating"
- 		nextProject := nil
- 	] ifFalse: [
- 		returningFlag
  			ifTrue: [nextProject := CurrentProject]
+ 			ifFalse: [previousProject := CurrentProject]].
- 			ifFalse: [previousProject := CurrentProject].
- 	].
  
  	CurrentProject world triggerEvent: #aboutToLeaveWorld.
  	CurrentProject abortResourceLoading.
  	CurrentProject finalExitActions: self.
  	CurrentProject saveState.
  	
  	"********** SWITCHING CURRENT PROJECT **********"
  	leavingProject := CurrentProject.
  	CurrentProject := self.
  	ProjectHistory remember: self.
  	"********** SWITCHING CURRENT PROJECT **********"
  
  	self loadState.
  	self finalEnterActions: leavingProject.
  	self addDeferredUIMessage: [self startResourceLoading].
  	self world triggerEvent: #aboutToEnterWorld.
  
  	"Save project for revert."
+ 	saveForRevert ifTrue:
+ 		[Smalltalk garbageCollect.	"let go of pointers"
- 	saveForRevert ifTrue: [
- 		Smalltalk garbageCollect.	"let go of pointers"
  		leavingProject storeSegment.
+ 		leavingProject world isInMemory 
- 		"result :=" leavingProject world isInMemory 
  			ifTrue: ['Can''t seem to write the project.']
+ 			ifFalse:
+ 				[leavingProject projectParameters at: #revertToMe put: leavingProject world xxxSegment shallowCopy]].
+ 	"original is for coming back in and continuing."
+ 	revertFlag | forceRevert ifTrue:
+ 		[seg shallowCopy revert].	"non-cloned one is for reverting again later"
- 			ifFalse: [leavingProject projectParameters at: #revertToMe put: 
- 					leavingProject world xxxSegment shallowCopy].
- 				'Project written.'].
- 			"original is for coming back in and continuing."
- 	revertFlag | forceRevert ifTrue: [
- 		seg shallowCopy revert].	"non-cloned one is for reverting again later"
  	self removeParameter: #exportState.
  	
  	"Now that everything is set up, we can show zoom animation."
  	(self showZoom and: [leavingProject displayDepth = self displayDepth])
  		ifTrue: [self displayZoom: leavingProject parent ~~ self "Entering?"]
  		ifFalse: [self restore].
  	
  	"Update processes at last."
  	self scheduleProcessForEnter.
  	leavingProject terminateProcessForLeave.
  !

Item was changed:
  ----- Method: Project>>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' 'Cancel') 
- 	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' 'Cancel') 
  						title:  'A newer version exists on the server.').
+ 			resp ~= 1 ifTrue: [^ nil]]].
- 			resp ~= 1 ifTrue: [^ nil]
- 		].
- 	].
  
  	"let's avoid renaming the loaded change set since it will be replacing ours"
  	self projectParameters at: #loadingNewerVersion put: true.
  
  	CurrentProject
  		do: [ProjectLoading
  				installRemoteNamed: pair first
  				from: server
  				named: self name
  				in: parentProject]
  		withProgressInfoOn: nil
  		label: 'project loading'
  !

Item was changed:
  ----- Method: Project>>okToChange (in category 'release') -----
  okToChange
  	"Answer whether the window in which the project is housed can be dismissed -- which is destructive. We never clobber a project without confirmation"
  
  	| answer |
+ 	(self isCurrentProject and: [self isTopProject]) ifTrue:
+ 		[self inform: 'You cannot close the top project.'.
- 	(self isCurrentProject and: [self isTopProject]) ifTrue: [
- 		self inform: 'You cannot close the top project.'.
  		^ false].
  	
  	((Preferences valueOfFlag: #checkForUnsavedProjects) ==>
  		[self confirm: ('Do you really want to delete the project\{1}\and all its content?' translated withCRs format:{self name})])
  		ifFalse: [^ false].
  
+ 	self subProjects ifNotEmpty:
+ 		[:sp |
- 	self subProjects ifNotEmpty: [:sp |
  		answer := Project uiManager
+ 					chooseOptionFrom:
+ 						#("1" 'Lift all sub-projects'
+ 						"2" 'Discard all sub-projects (NO UNDO!!)'
+ 						"3 or 0" 'Cancel')"<-- needs simpler dialogue with a proper cancel button"
+ 					lines: #(2)
+ 					title: ('The project {1}\contains {2} sub-project(s).' translated withCRs format:{self name. sp size}).		
- 			chooseFrom: #(
- 				"1" 'Lift all sub-projects'
- 				"2" 'Discard all sub-projects (NO UNDO!!)'
- 				"3 or 0" 'Cancel')
- 			lines: #(2)
- 			title: ('The project {1}\contains {2} sub-project(s).' translated withCRs format:{self name. sp size}).
- 		
  		(answer = 0 or: [answer = 3]) ifTrue: [^ false].
  		answer = 1 ifTrue: [self liftSubProjects. ^ true].
+ 		answer = 2 ifTrue:
+ 			[^ sp allSatisfy:
+ 				[:ea | 
+ 				[ea okToChange] valueSuppressingMessages: {'*delete the project*and all its content*'}]]].	
- 		answer = 2 ifTrue: [^ sp allSatisfy: [:ea | 
- 				[ea okToChange] valueSuppressingMessages: {'*delete the project*and all its content*'}]]].
- 	
  	^ true!

Item was changed:
  ----- Method: Project>>storeOnServerInnards (in category 'file in/out') -----
  storeOnServerInnards
  	"Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
  
  	| resp newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber suppliedPassword oldResourceUrl |
  	self assureIntegerVersion.
  
  	"Find out what version"
+ 	primaryServerDirectory := self primaryServerIfNil:
+ 		[(primaryServerDirectory := self findAFolderToStoreProjectIn) ifNil: [^self].
- 	primaryServerDirectory := self primaryServerIfNil: [
- 		(primaryServerDirectory := self findAFolderToStoreProjectIn) ifNil: [^self].
  		oldResourceUrl := self resourceUrl.
+ 		primaryServerDirectory == #localOnly
+ 			ifTrue:
+ 				[self storeNewPrimaryURL: FileDirectory default url.
+ 				nil]
+ 			ifFalse:
+ 				[self storeNewPrimaryURL: primaryServerDirectory downloadUrl.
+ 				primaryServerDirectory]].
- 		primaryServerDirectory == #localOnly ifTrue: [
- 			self storeNewPrimaryURL: FileDirectory default url.
- 			nil
- 		] ifFalse: [
- 			self storeNewPrimaryURL: primaryServerDirectory downloadUrl.
- 			primaryServerDirectory
- 		].
- 	].
  
  	localDirectory := self squeakletDirectory.
  	serverVersionPair := self class mostRecent: self name onServer: primaryServerDirectory.
  	localVersionPair := self class mostRecent: self name onServer: localDirectory.
  	maxNumber := myVersionNumber := self currentVersionNumber.
  
  	ProgressNotification signal: '2:versionsDetected'.
  
  	warning := ''.
+ 	myVersionNumber < serverVersionPair second ifTrue: 
+ 		[warning := warning,'\There are newer version(s) on the server' translated.
+ 		maxNumber := maxNumber max: serverVersionPair second].
+ 	myVersionNumber < localVersionPair second ifTrue: 
+ 		[warning := warning,'\There are newer version(s) in the local directory' translated.
+ 		maxNumber := maxNumber max: localVersionPair second].
+ 	myVersionNumber = 0 ifTrue: 
+ 		[warning isEmpty ifFalse: 
+ 			[myVersionNumber = 0 ifTrue: [warning := warning,'\THIS PROJECT HAS NEVER BEEN SAVED' translated].
- 	myVersionNumber < serverVersionPair second ifTrue: [
- 		warning := warning,'\There are newer version(s) on the server' translated.
- 		maxNumber := maxNumber max: serverVersionPair second.
- 	].
- 	myVersionNumber < localVersionPair second ifTrue: [
- 		warning := warning,'\There are newer version(s) in the local directory' translated.
- 		maxNumber := maxNumber max: localVersionPair second.
- 	].
- 	"8 Nov 2000 - only check on the first attempt to publish"
- 	myVersionNumber = 0 ifTrue: [
- 		warning isEmpty ifFalse: [
- 			myVersionNumber = 0 ifTrue: [
- 				warning := warning,'\THIS PROJECT HAS NEVER BEEN SAVED' translated.
- 			].
  			warning := 'WARNING' translated, '\Project: ' translated, self name,warning.
+ 			resp := (Project uiManager 
+ 						chooseOptionFrom: (Array with: 'Store anyway' translated 
- 			resp := (UIManager default 
- 					chooseFrom: (Array with: 'Store anyway' translated 
  										with: 'Cancel' translated)
+   						title: (warning, '\Please cancel, rename this project, and see what is there.' translated) withCRs).
+ 				resp ~= 1 ifTrue: [^ nil]]].
-   					title: (warning, '\Please cancel, rename this project, and see what is there.' translated) withCRs).
- 				resp ~= 1 ifTrue: [^ nil]
- 		].
- 	].
  	version := self bumpVersion: maxNumber.
  
+ 	oldResourceUrl ifNotNil:
+ 		[self resourceManager adjustToNewServer: self resourceUrl from: oldResourceUrl].
- 	oldResourceUrl
- 		ifNotNil: [self resourceManager adjustToNewServer: self resourceUrl from: oldResourceUrl].
  
  	"write locally - now zipped automatically"
  	newName := self versionedFileName.
  	lastSavedAtSeconds := Time totalSeconds.
  	self exportSegmentFileName: newName directory: localDirectory.
  	(localDirectory readOnlyFileNamed: newName) setFileTypeToObject; close.
  
  	ProgressNotification signal: '4:localSaveComplete'.	"3 is deep in export logic"
  
+ 	primaryServerDirectory ifNotNil:
+ 		[suppliedPassword := ''.
+ 		Preferences passwordsOnPublish ifTrue: [suppliedPassword := UIManager default requestPassword: 'Project password' translated].
+ 		[primaryServerDirectory
- 	primaryServerDirectory ifNotNil: [
- 		suppliedPassword := ''.
- 		Preferences passwordsOnPublish ifTrue: [
- 			suppliedPassword := UIManager default requestPassword: 'Project password' translated
- 		].
- 		[
- 		primaryServerDirectory
  			writeProject: self
  			inFileNamed: newName asFileName
+ 			fromDirectory: localDirectory]
+ 			on: ProjectPasswordNotification
+ 			do:
+ 				[ :ex |
+ 				ex resume: (suppliedPassword ifNil: [''])]].
- 			fromDirectory: localDirectory.
- 		] on: ProjectPasswordNotification do: [ :ex |
- 			ex resume: (suppliedPassword ifNil: [''])
- 		].
- 	].
  	ProgressNotification signal: '9999 save complete'.
  
  	"Later, store with same name on secondary servers.  Still can be race conditions.  All machines will go through the server list in the same order."
  	"2 to: servers size do: [:aServer | aServer putFile: local named: newName]."
  !

Item was changed:
  ----- Method: Project>>tryToFindAServerWithMe (in category 'file in/out') -----
  tryToFindAServerWithMe
  
  	| resp primaryServerDirectory |
  
+ 	urlList isEmptyOrNil ifTrue:
+ 		[urlList := parentProject urlList copy].
+ 	[self primaryServer isNil] whileTrue:
+ 		[resp := (Project uiManager
+ 					chooseOptionFrom: #('Try to find a server' 'Cancel')
- 	urlList isEmptyOrNil ifTrue: [urlList := parentProject urlList copy].
- 	[self primaryServer isNil] whileTrue: [
- 		resp := (UIManager default 
- 					chooseFrom: #('Try to find a server' 'Cancel')
  					title: 'This project thinks it has never been on a server').
  		resp ~= 1 ifTrue: [^ nil].
  		(primaryServerDirectory := self findAFolderToLoadProjectFrom) ifNil: [^nil].
+ 		self storeNewPrimaryURL: primaryServerDirectory downloadUrl].
- 		self storeNewPrimaryURL: primaryServerDirectory downloadUrl.
- 	].
  	^self primaryServer
  !

Item was changed:
  ----- Method: ReplaceExistingFileException>>defaultAction (in category '*System-Files-error handling') -----
  defaultAction
  	| selection |
+ 	selection := Project uiManager
+ 					chooseOptionFrom: #('delete version in target directory' 'cancel' )
+ 					title: fileName , ' already exists'.
- 	selection := UIManager default
- 		chooseFrom: #('delete version in target directory' 'cancel' )
- 		title: fileName , ' already exists'.
  	^ selection = 1.!

Item was changed:
  ----- Method: SecurityManager>>enterRestrictedMode (in category 'security operations') -----
  enterRestrictedMode
  	"Some insecure contents was encountered. Close all doors and proceed."
  	self isInRestrictedMode ifTrue:[^true].
  	Preferences securityChecksEnabled ifFalse:[^true]. "it's been your choice..."
+ 	Preferences warnAboutInsecureContent ifTrue:
+ 		[(Project uiManager
+ 			chooseOptionFrom: #('Load it anyways' 'Do not load it')
- 	Preferences warnAboutInsecureContent ifTrue:[
- 		( UIManager default chooseFrom: #('Load it anyways' 'Do not load it')
  			title: 
  'You are about to load some insecure content.
  If you continue, access to files as well as
+ some other capabilities will be limited.')  = 1 ifFalse:
+ 				["user doesn't really want it"
+ 				^false.]].
- some other capabilities will be limited.')
- 			 = 1 ifFalse:[
- 				"user doesn't really want it"
- 				^false.
- 			].
- 	].
  	"here goes the actual restriction"
  	self flushSecurityKeys.
  	self disableFileAccess.
  	self disableImageWrite.
  	"self disableSocketAccess."
  	FileDirectory setDefaultDirectory: self untrustedUserDirectory.
  	^true
  !

Item was changed:
  ----- Method: SmartRefStream>>writeClassRenameMethod:was:fromInstVars: (in category 'class changed shape') -----
  writeClassRenameMethod: sel was: oldName fromInstVars: oldList
  	"The class coming is unknown.  Ask the user for the existing class it maps to.  If got one, write a method, and restart the obj fileIn.  If none, write a dummy method and get the user to complete it later.  "
  
  | tell choice  newName answ code |
  
  	self flag: #bobconv.	
  
+ 	tell := 'Reading an instance of ', oldName, '.
+ 	Which modern class should it translate to?'.
+ 	answ := Project uiManager
+ 				chooseOptionFrom:
+ 					#('Let me type the name now'
+ 					'Let me think about it' 
+ 					'Let me find a conversion file on the disk') 
+ 				title: tell. 
+ 	answ = 1 ifTrue:
+ 		[tell := 'Name of the modern class {1} should translate to:' translated format: {oldName}.
+ 		choice := Project uiManager request: tell.		"class name"
+ 		(choice size = 0) 
+ 			ifTrue: [answ := 'conversion method needed']
+ 			ifFalse:
+ 				[newName := choice.
+ 				answ := Smalltalk at: newName asSymbol ifAbsent:
+ 					['conversion method needed'].
+ 				answ isString ifFalse:
+ 					[renamed at: oldName asSymbol put: answ name]]].
+ 	(answ = 3) | (answ = 0) ifTrue:
+ 		[self close.
- 
- tell := 'Reading an instance of ', oldName, '.
- Which modern class should it translate to?'.
- answ := (UIManager default 
- 		chooseFrom: #('Let me type the name now' 'Let me think about it'
- 'Let me find a conversion file on the disk') 
- 		title: tell). 
- 
- answ = 1 ifTrue: [
- 	tell := 'Name of the modern class {1} should translate to:' translated format: {oldName}.
- 	choice := UIManager default request: tell.		"class name"
- 	(choice size = 0) 
- 		ifTrue: [answ := 'conversion method needed']
- 		ifFalse: [newName := choice.
- 			answ := Smalltalk at: newName asSymbol 
- 				ifAbsent: ['conversion method needed'].
- 			answ isString ifFalse: [renamed at: oldName asSymbol put: answ name]]].
- (answ = 3) | (answ = 0) ifTrue: [self close.
  		^ 'conversion method needed'].
+ 	answ = 2 ifTrue: [answ := 'conversion method needed'].
+ 	answ = 'conversion method needed' ifTrue: 
+ 		[self close.  
- answ = 2 ifTrue: [answ := 'conversion method needed'].
- answ = 'conversion method needed' ifTrue: [
- 		self close.  
  		newName := 'PutNewClassHere'].
  
+ 	code := WriteStream on: (String new: 500).
+ 	code nextPutAll: sel; cr.
+ 	code cr; tab; nextPutAll: '^ ', newName.	"Return new class"
- code := WriteStream on: (String new: 500).
- code nextPutAll: sel; cr.
- code cr; tab; nextPutAll: '^ ', newName.	"Return new class"
  
+ 	self class compile: code contents classified: 'conversion'.
- self class compile: code contents classified: 'conversion'.
  
+ 	newName = 'PutNewClassHere' ifTrue:
+ 		[self inform: 'Please complete the following method and 
+ 	then read-in the object file again.'.
+ 		SystemNavigation default browseAllImplementorsOf: sel asSymbol]. 
- newName = 'PutNewClassHere' ifTrue: [
- 	self inform: 'Please complete the following method and 
- then read-in the object file again.'.
- 	SystemNavigation default browseAllImplementorsOf: sel asSymbol]. 
  
+ 		"The class version number only needs to change under one specific circumstance.  That is when the first letters of the instance variables have stayed the same, but their meaning has changed.  A conversion method is needed, but this system does not know it.  
+ 		If this is true for class Foo, define classVersion in Foo class.  
+ 		Beware of previous object fileouts already written after the change in meaning, but before bumping the version number.  They have the old (wrong) version number, say 2.  If this is true, your method must be able to test the data and successfully read files that say version 2 but are really 3."
- 	"The class version number only needs to change under one specific circumstance.  That is when the first letters of the instance variables have stayed the same, but their meaning has changed.  A conversion method is needed, but this system does not know it.  
- 	If this is true for class Foo, define classVersion in Foo class.  
- 	Beware of previous object fileouts already written after the change in meaning, but before bumping the version number.  They have the old (wrong) version number, say 2.  If this is true, your method must be able to test the data and successfully read files that say version 2 but are really 3."
  
+ 		^ answ!
- 	^ answ!

Item was changed:
  ----- Method: StandardFileStream class>>fileDoesNotExistUserHandling:ifDebug: (in category '*System-Files-error handling') -----
  fileDoesNotExistUserHandling: fullFileName ifDebug: debugBlock
  
  	| selection newName |
+ 	selection :=Project uiManager
+ 					chooseOptionFrom: 
+ 						{'create a new file' translated.
+ 						'choose another name' translated.
+ 						'debug' translated.
+ 						'cancel' translated}
+ 					title: (FileDirectory localNameFor: fullFileName) , '
- 	selection := UIManager default chooseFrom: {
- 		'create a new file' translated.
- 		'choose another name' translated.
- 		'debug' translated.
- 		'cancel' translated
- 	} title: (FileDirectory localNameFor: fullFileName) , '
  does not exist.'.
  	selection = 1 ifTrue:
  		[^ self new open: fullFileName forWrite: true].
  	selection = 2 ifTrue:
+ 		[ newName := Project uiManager
+ 							request: 'Enter a new file name'
+ 							initialAnswer:  fullFileName.
+ 		^ self oldFileNamed: (self fullName: newName)].
- 		[ newName := UIManager default request: 'Enter a new file name'
- 						initialAnswer:  fullFileName.
- 		^ self oldFileNamed:
- 			(self fullName: newName)].
  	selection = 3 ifTrue: [^ debugBlock value].
  	self halt!

Item was changed:
  ----- Method: StandardFileStream class>>fileExistsUserHandling:ifDebug: (in category '*System-Files-error handling') -----
  fileExistsUserHandling: fullFileName ifDebug: debugBlock
  	| dir localName choice newName newFullFileName |
  	dir := FileDirectory forFileName: fullFileName.
  	localName := FileDirectory localNameFor: fullFileName.
+ 	choice := (Project uiManager 
+ 					chooseOptionFrom: #('overwrite that file' 'append (risky!!!!)' 'choose another name' 'debug' 'cancel')
+ 					title: localName, ' already exists.').
+ 	choice = 1 ifTrue:
+ 		[dir
+ 			deleteFileNamed: localName
- 	choice := (UIManager default 
- 		chooseFrom: #('overwrite that file' 'append (risky!!!!)' 'choose another name' 'debug' 'cancel')
- 		title: localName, ' already exists.').
- 
- 	choice = 1 ifTrue: [
- 		dir deleteFileNamed: localName
  			ifAbsent: [self error: 'Could not delete the old version of that file'].
  		^ self new open: fullFileName forWrite: true].
+ 	choice = 2 ifTrue:
+ 		[^ (self new open: fullFileName forWrite: true) setToEnd].
+ 	choice = 3 ifTrue:
+ 		[newName := Project uiManager
+ 							request: 'Enter a new file name'
+ 							initialAnswer: fullFileName.
- 
- 	choice = 2 ifTrue: [
- 		^ (self new open: fullFileName forWrite: true) setToEnd].
- 
- 	choice = 3 ifTrue: [
- 		newName := UIManager default request: 'Enter a new file name' initialAnswer: fullFileName.
  		newFullFileName := self fullName: newName.
  		^ self newFileNamed: newFullFileName].
- 
  	choice = 4 ifTrue: [^ debugBlock value].
- 
  	self error: 'Please close this to abort file opening'!

Item was changed:
  ----- Method: StandardFileStream class>>readOnlyFileDoesNotExistUserHandling:ifDebug: (in category '*System-Files-error handling') -----
  readOnlyFileDoesNotExistUserHandling: fullFileName ifDebug: debugBlock
  
  	| dir files choices selection newName fileName |
  	dir := FileDirectory forFileName: fullFileName.
  	files := dir fileNames.
  	fileName := FileDirectory localNameFor: fullFileName.
  	choices := fileName correctAgainst: files.
  	choices add: 'Choose another name'.
  	choices add: 'Debug'.
  	choices add: 'Cancel'.
+ 	selection := Project uiManager
+ 					chooseFrom: choices
+ 					lines: (Array with: 5)"<-- needs simpler dialogue with a proper cancel button"
+ 					title: (FileDirectory localNameFor: fullFileName), '
- 	selection := UIManager default chooseFrom: choices lines: (Array with: 5)
- 		title: (FileDirectory localNameFor: fullFileName), '
  does not exist.'.
+ 	selection = choices size ifTrue:
+ 		["cancel" ^ nil "should we raise another exception here?"].
+ 	selection < (choices size - 1) ifTrue: 
+ 		[newName := (dir pathName , FileDirectory slash , (choices at: selection))].
+ 	selection = (choices size - 2) ifTrue: 
+ 		[newName := Project uiManager
- 	selection = choices size ifTrue:["cancel" ^ nil "should we raise another exception here?"].
- 	selection < (choices size - 1) ifTrue: [
- 		newName := (dir pathName , FileDirectory slash , (choices at: selection))].
- 	selection = (choices size - 2) ifTrue: [
- 		newName := UIManager default 
  							request: 'Enter a new file name' 
  							initialAnswer: fileName].
+ 	selection = (choices size - 1) ifTrue:
+ 		[^ debugBlock value].
+ 	newName = '' ifFalse:
+ 		[^ self readOnlyFileNamed: (self fullName: newName)].
- 	selection = (choices size - 1) ifTrue: [^ debugBlock value].
- 	newName = '' ifFalse: [^ self readOnlyFileNamed: (self fullName: newName)].
  	^ self error: 'Could not open a file'!




More information about the Squeak-dev mailing list