[squeak-dev] The Trunk: Morphic-ul.264.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Dec 12 14:24:04 UTC 2009


Levente Uzonyi uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-ul.264.mcz

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

Name: Morphic-ul.264
Author: ul
Time: 12 December 2009, 2:44:12 am
UUID: 17da31dc-e5ba-b745-91c8-1dee2900a960
Ancestors: Morphic-ar.263

- replace sends of #ifNotNilDo: to #ifNotNil:, #ifNil:ifNotNilDo: to #ifNil:ifNotNil:, #ifNotNilDo:ifNil: to #ifNotNil:ifNil:

=============== Diff against Morphic-ar.263 ===============

Item was changed:
  ----- Method: SystemWindow>>bringBehind: (in category 'polymorph') -----
  bringBehind: aMorph
  	"Make the receiver be directly behind the given morph.
  	Take into account any modal owner and propagate."
  
  	|outerMorph|
  	outerMorph := self topRendererOrSelf.
  	outerMorph owner ifNil: [^ self "avoid spurious activate when drop in trash"].
  	outerMorph owner addMorph: outerMorph after: aMorph topRendererOrSelf.
+ 	self modalOwner ifNotNil: [:mo | mo bringBehind: self]!
- 	self modalOwner ifNotNilDo: [:mo | mo bringBehind: self]!

Item was changed:
  ----- Method: MenuMorph>>doButtonAction (in category 'menu') -----
  doButtonAction
  	"Do the receiver's inherent button action.  Makes sense for the kind of MenuMorph that is a wrapper for a single menu-item -- pass it on the the item"
  
+ 	(self findA: MenuItemMorph) ifNotNil: [:aMenuItem | aMenuItem doButtonAction]!
- 	(self findA: MenuItemMorph) ifNotNilDo: [:aMenuItem | aMenuItem doButtonAction]!

Item was changed:
  ----- Method: ScriptEditorMorph>>typeForParameter (in category 'testing') -----
  typeForParameter
  	"Answer a symbol representing the type of my parameter"
  
  	scriptName numArgs > 0 ifTrue:
+ 		[(playerScripted class scripts at: scriptName ifAbsent: [nil]) ifNotNil:
- 		[(playerScripted class scripts at: scriptName ifAbsent: [nil]) ifNotNilDo:
  			[:aScript | ^ aScript argumentVariables first variableType]].
  
  	^ #Error!

Item was changed:
  ----- Method: HaloMorph>>doGrow:with: (in category 'private') -----
  doGrow: evt with: growHandle
  	"Called while the mouse is down in the grow handle"
  
  	| newExtent extentToUse scale |
  	evt hand obtainHalo: self.
  	newExtent := (target pointFromWorld: (target griddedPoint: evt cursorPoint - positionOffset))
  								- target topLeft.
  	evt shiftPressed ifTrue: [
  		scale := (newExtent x / (originalExtent x max: 1)) min:
  					(newExtent y / (originalExtent y max: 1)).
  		newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger
  	].
  	(newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self].
  	target renderedMorph setExtentFromHalo: (extentToUse := newExtent).
  	growHandle position: evt cursorPoint - (growHandle extent // 2).
  	self layoutChanged.
+ 	(self valueOfProperty: #commandInProgress) ifNotNil:  
- 	(self valueOfProperty: #commandInProgress) ifNotNilDo:  
  		[:cmd | "Update the final extent"
  			cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse]
  !

Item was changed:
  ----- Method: MorphicProject>>finalExitActions (in category 'enter') -----
  finalExitActions
  
  	(world findA: ProjectNavigationMorph)
+ 		ifNotNil: [:navigator | navigator retractIfAppropriate]!
- 		ifNotNilDo: [:navigator | navigator retractIfAppropriate]!

Item was changed:
  ----- Method: HaloMorph>>doRot:with: (in category 'private') -----
  doRot: evt with: rotHandle
  	"Update the rotation of my target if it is rotatable.  Keep the relevant command object up to date."
  
  	| degrees |
  	evt hand obtainHalo: self.
  	degrees := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees.
  	degrees := degrees - angleOffset degrees.
  	degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false.
  	degrees = 0.0
  		ifTrue: [self setColor: Color lightBlue toHandle: rotHandle]
  		ifFalse: [self setColor: Color blue toHandle: rotHandle].
  	rotHandle submorphsDo:
  		[:m | m color: rotHandle color makeForegroundColor].
  	self removeAllHandlesBut: rotHandle.
  	self showingDirectionHandles ifFalse:
  		[self showDirectionHandles: true addHandles: false].
  	self addDirectionHandles.
  
  	target rotationDegrees: degrees.
  
  	rotHandle position: evt cursorPoint - (rotHandle extent // 2).
+ 	(self valueOfProperty: #commandInProgress) ifNotNil:
- 	(self valueOfProperty: #commandInProgress) ifNotNilDo:
  		[:cmd | "Update the final rotation"
  		cmd redoTarget: target renderedMorph selector: #heading: argument: degrees].
  	self layoutChanged!

Item was changed:
  ----- Method: Morph>>allMorphsWithPlayersDo: (in category 'submorphs-add/remove') -----
  allMorphsWithPlayersDo: aTwoArgumentBlock 
  	"Evaluate the given block for all morphs in this composite morph that have non-nil players.
  	Also evaluate the block for the receiver if it has a player."
  
  	submorphs do: [:m | m allMorphsWithPlayersDo: aTwoArgumentBlock ].
+ 	self playerRepresented ifNotNil: [ :p | aTwoArgumentBlock value: self value: p ].
- 	self playerRepresented ifNotNilDo: [ :p | aTwoArgumentBlock value: self value: p ].
  !

Item was changed:
  ----- Method: MenuMorph class>>chooseFrom:values:lines:title: (in category 'utilities') -----
  chooseFrom: aList values: valueList lines: linesArray title: queryString
  	"Choose an item from the given list. Answer the index of the selected item."
  	"MenuMorph
  		chooseFrom: #('Hello' 'World' 'Here' 'We' 'Go')
  		values: #('Hello' 'World' 'Here' 'We' 'Go')
  		lines: #(2 4)
  		title: 'What''s up?'"
  	| menu aBlock result |
+ 	(ProvideAnswerNotification signal: queryString) ifNotNil:[:answer | 
- 	(ProvideAnswerNotification signal: queryString) ifNotNilDo:[:answer | 
  		1 to: aList size do:[:i| (aList at: i) = answer ifTrue:[^answer]].
  		^nil].
  	aBlock := [:v| result := v].
  	menu := self new.
  	menu addTitle: queryString.
  	1 to: aList size do:[:i| 
  		menu add: (aList at: i) asString target: aBlock selector: #value: argument: (valueList at: i).
  		(linesArray includes: i) ifTrue:[menu addLine]
  	].
  	MenuIcons decorateMenu: menu.
  	result := nil.
  	menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.
  	^result!

Item was changed:
  ----- Method: TextMorph>>changeMargins: (in category 'menu') -----
  changeMargins: evt
  	| handle origin aHand oldMargin newMargin |
  	aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
  	origin := aHand position.
  	oldMargin := margins.
+ 	(handle := HandleMorph new)
- 	handle := HandleMorph new
  		forEachPointDo:
  			[:newPoint | handle removeAllMorphs.
  			handle addMorph:
  				(LineMorph from: origin to: newPoint color: Color black width: 1).
  			newMargin := (newPoint - origin max: 0 at 0) // 5.
  			self margins: newMargin]
  		lastPointDo:
  			[:newPoint | handle deleteBalloon.
+ 			self halo ifNotNil: [ :halo | halo addHandles].
- 			self halo ifNotNilDo: [:halo | halo addHandles].
  			self rememberCommand:
  				(Command new cmdWording: ('margin change for ' translated,self nameForUndoWording);
  					undoTarget: self selector: #margins: argument: oldMargin;
  					redoTarget: self selector: #margins: argument: newMargin;
  					yourself)].
  	aHand attachMorph: handle.
  	handle setProperty: #helpAtCenter toValue: true.
  	handle showBalloon:
  'Move cursor down and to the right
  to increase margin inset.
  Click when done.' hand: evt hand.
  	handle startStepping!

Item was changed:
  ----- Method: MenuMorph class>>chooseFrom:lines:title: (in category 'utilities') -----
  chooseFrom: aList lines: linesArray title: queryString
  	"Choose an item from the given list. Answer the index of the selected item."
  	"MenuMorph
  		chooseFrom: #('Hello' 'World' 'Here' 'We' 'Go')
  		lines: #(2 4)
  		title: 'What''s up?'"
  	| menu aBlock result |
+ 	(ProvideAnswerNotification signal: queryString) ifNotNil:[:answer | 
- 	(ProvideAnswerNotification signal: queryString) ifNotNilDo:[:answer | 
  		1 to: aList size do:[:i| (aList at: i) = answer ifTrue:[^i]].
  		^0].
  	aBlock := [:v| result := v].
  	menu := self new.
  	menu addTitle: queryString.
  	1 to: aList size do:[:i| 
  		menu add: (aList at: i) asString target: aBlock selector: #value: argument: i.
  		(linesArray includes: i) ifTrue:[menu addLine]
  	].
  	MenuIcons decorateMenu: menu.
  	result := 0.
  	menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.
  	^result!

Item was changed:
  ----- Method: PasteUpMorph>>tellAllContents: (in category 'scripting') -----
  tellAllContents: aMessageSelector
  	"Send the given message selector to all the objects within the receiver"
  
  	self submorphs do:
  		[:m |
+ 			m player ifNotNil:
- 			m player ifNotNilDo:
  				[:p | p performScriptIfCan: aMessageSelector]]!

Item was changed:
  ----- Method: PasteUpMorph>>reintroduceIntoWorld: (in category 'undo') -----
  reintroduceIntoWorld: aMorph
  	"The given morph is being raised from the dead.  Bring it back to life."
  
+ 	(aMorph valueOfProperty: #lastPosition) ifNotNil:
- 	(aMorph valueOfProperty: #lastPosition) ifNotNilDo:
  		[:pos | aMorph position: pos].
  	aMorph openInWorld; goHome
  
  	!

Item was changed:
  ----- Method: StringMorphAttributeScanner>>setActualFont: (in category 'scanning') -----
  setActualFont: aFont
  	"Set the value of actualFont, from a TextFontReference"
  
  	actualFont := aFont.
+ 	aFont textStyle ifNotNil: [ :ts | fontNumber := ts fontIndexOf: aFont ]!
- 	aFont textStyle ifNotNilDo: [ :ts | fontNumber := ts fontIndexOf: aFont ]!

Item was changed:
  ----- Method: ScriptEditorMorph>>updateStatusMorph: (in category 'buttons') -----
  updateStatusMorph: statusMorph
  	"My status button may need to reflect an externally-induced change in status"
  
+ 	(playerScripted existingScriptInstantiationForSelector: scriptName) ifNotNil:
- 	(playerScripted existingScriptInstantiationForSelector: scriptName) ifNotNilDo:
  		[:scriptInstantiation |
  			scriptInstantiation updateStatusMorph: statusMorph]!

Item was changed:
  ----- Method: PasteUpMorph>>fixUponLoad:seg: (in category 'objects from disk') -----
  fixUponLoad: aProject seg: anImageSegment
  	"We are in an old project that is being loaded from disk.
  Fix up conventions that have changed."
  
  	self isWorldMorph ifTrue: [
+ 			(self valueOfProperty: #soundAdditions) ifNotNil:
- 			(self valueOfProperty: #soundAdditions) ifNotNilDo:
  				[:additions | SampledSound
  assimilateSoundsFrom: additions]].
  
  	^ super fixUponLoad: aProject seg: anImageSegment!

Item was changed:
  ----- Method: MenuMorph class>>inform: (in category 'utilities') -----
  inform: queryString
  	"MenuMorph inform: 'I like Squeak'"
  	| menu |
  	(ProvideAnswerNotification signal: queryString) 
+ 		ifNotNil:[:answer | ^ self].
- 		ifNotNilDo:[:answer | ^ self].
  	menu := self new.
  	menu addTitle: queryString icon: MenuIcons confirmIcon.
  	menu add: 'OK' target: self selector: #yourself.
  	MenuIcons decorateMenu: menu.
  	menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.!

Item was changed:
  ----- Method: SystemWindow>>activate (in category 'top window') -----
  activate
  	"Activate the owner too."
  
  	|mo mc|
  	mo := self modalOwner.
  	mc := self modalChild.
  	mc isNil
  		ifFalse: [mc owner notNil ifTrue: [
  				mc activate.
  				^mc modalChild isNil ifTrue: [mc flash]]].
  	(self paneMorphs size > 1 and: [self splitters isEmpty])
  		ifTrue: [self addPaneSplitters].
  	self activateWindow.
  	self rememberedKeyboardFocus
  		ifNil: [(self respondsTo: #navigateFocusForward)
  				ifTrue: [self navigateFocusForward]]
+ 		ifNotNil: [:m | m world
- 		ifNotNilDo: [:m | m world
  						ifNil: [self rememberKeyboardFocus: nil] "deleted"
+ 						ifNotNil: [:w | 
- 						ifNotNilDo: [:w | 
  							m wantsKeyboardFocus
  								ifTrue: [m takeKeyboardFocus]
  								ifFalse: [(self respondsTo: #navigateFocusForward)
  											ifTrue: [self navigateFocusForward]]]].
  	(mo notNil and: [mo isKindOf: SystemWindow])
  		ifTrue: [mo bringBehind: self]!

Item was changed:
  ----- Method: Morph>>defaultFloatPrecisionFor: (in category 'scripting') -----
  defaultFloatPrecisionFor: aGetSelector
  	"Answer a number indicating the default float precision to be used in a numeric readout for which the receiver provides the data.   Individual morphs can override this.  Showing fractional values for readouts of getCursor was in response to an explicit request from ack"
  
+ 	(self renderedMorph decimalPlacesForGetter: aGetSelector) ifNotNil: [:places | ^ (Utilities floatPrecisionForDecimalPlaces: places)].
- 	(self renderedMorph decimalPlacesForGetter: aGetSelector) ifNotNilDo: [:places | ^ (Utilities floatPrecisionForDecimalPlaces: places)].
  
  	(#(getCursor getNumericValue getNumberAtCursor getCursorWrapped getScaleFactor getUnitVector getAlpha) includes: aGetSelector)
  		ifTrue:
  			[^ 0.01].
  	^ 1!

Item was changed:
  ----- Method: HaloMorph>>endInteraction (in category 'private') -----
  endInteraction
  	"Clean up after a user interaction with the a halo control"
  
  	| m |
  	self isMagicHalo: false.	"no longer"
  	self magicAlpha: 1.0.
  	(target isInWorld not or: [owner isNil]) ifTrue: [^self].
  	[target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: 
  			[m := target firstSubmorph.
  			target removeFlexShell.
  			target := m].
  	self isInWorld 
  		ifTrue: 
  			["make sure handles show in front, even if flex shell added"
  
  			self comeToFront.
  			self addHandles].
+ 	(self valueOfProperty: #commandInProgress) ifNotNil: 
- 	(self valueOfProperty: #commandInProgress) ifNotNilDo: 
  			[:cmd | 
  			self rememberCommand: cmd.
  			self removeProperty: #commandInProgress]!

Item was changed:
  ----- Method: PolygonMorph>>customizeArrows: (in category 'menu') -----
  customizeArrows: evt
  	| handle origin aHand |
  	aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
  	origin := aHand position.
+ 	(handle := HandleMorph new)
- 	handle := HandleMorph new
  		forEachPointDo:
  			[:newPoint | handle removeAllMorphs.
  			handle addMorph:
  				(LineMorph from: origin to: newPoint color: Color black width: 1).
  			self arrowSpec: (newPoint - origin) / 5.0]
  		lastPointDo:
  			[:newPoint | handle deleteBalloon.
+ 			self halo ifNotNil: [:halo | halo addHandles].].
- 			self halo ifNotNilDo: [:halo | halo addHandles].].
  	aHand attachMorph: handle.
  	handle setProperty: #helpAtCenter toValue: true.
  	handle showBalloon:
  'Move cursor left and right
  to change arrow length and style.
  Move it up and down to change width.
  Click when done.' hand: evt hand.
  	handle startStepping!

Item was changed:
  ----- Method: Morph>>allSubmorphNamesDo: (in category 'submorphs-accessing') -----
  allSubmorphNamesDo: nameBlock
  	"Return a list of all known names of submorphs and nested submorphs of the receiver, based on the scope of the receiver.  Items in parts bins are excluded"
  
  	self isPartsBin ifTrue: [^ self]. "Don't report names from parts bins"
  	self submorphsDo: 
+ 		[:m | m knownName ifNotNil: [:n | nameBlock value: n].
- 		[:m | m knownName ifNotNilDo: [:n | nameBlock value: n].
  		m allSubmorphNamesDo: nameBlock].
  !

Item was changed:
  ----- Method: TextMorph>>onBlinkCursor (in category 'blinking') -----
  onBlinkCursor
  	"Blink the cursor"
  	| para |
  	para := self paragraph ifNil:[^nil].
  	Time millisecondClockValue < self blinkStart ifTrue:[
  		"don't blink yet"
  		^para showCaret: para focused.
  	].
  	para showCaret: para showCaret not.
+ 	para caretRect ifNotNil: [ :r | self invalidRect: r].!
- 	para caretRect ifNotNilDo:[:r| self invalidRect: r].!

Item was changed:
  ----- Method: PluggableTextMorph>>toggleAnnotationPaneSize (in category 'menu commands') -----
  toggleAnnotationPaneSize
  
  	| handle origin aHand siblings newHeight lf prevBottom m ht |
  
  	self flag: #bob.		"CRUDE HACK to enable changing the size of the annotations pane"
  
  	owner ifNil: [^self].
  	siblings := owner submorphs.
  	siblings size > 3 ifTrue: [^self].
  	siblings size < 2 ifTrue: [^self].
  
  	aHand := self primaryHand.
  	origin := aHand position.
+ 	(handle := HandleMorph new)
- 	handle := HandleMorph new
  		forEachPointDo: [:newPoint |
  			handle removeAllMorphs.
  			newHeight := (newPoint - origin) y asInteger min: owner height - 50 max: 16.
  			lf := siblings last layoutFrame.
  			lf bottomOffset: newHeight.
  			prevBottom := newHeight.
  			siblings size - 1 to: 1 by: -1 do: [ :index |
  				m := siblings at: index.
  				lf := m layoutFrame.
  				ht := lf bottomOffset - lf topOffset.
  				lf topOffset: prevBottom.
  				lf bottomOffset = 0 ifFalse: [
  					lf bottomOffset: (prevBottom + ht).
  				].
  				prevBottom := prevBottom + ht.
  			].
  			owner layoutChanged.
  
  		]
  		lastPointDo:
  			[:newPoint | handle deleteBalloon.
+ 			self halo ifNotNil: [:halo | halo addHandles].
- 			self halo ifNotNilDo: [:halo | halo addHandles].
  		].
  	aHand attachMorph: handle.
  	handle setProperty: #helpAtCenter toValue: true.
  	handle showBalloon:
  'Move cursor farther from
  this point to increase pane.
  Click when done.' hand: aHand.
  	handle startStepping
  
  !

Item was changed:
  ----- Method: PasteUpMorph>>sendTextContentsBackToDonor (in category 'menu & halo') -----
  sendTextContentsBackToDonor
  	"Send my string contents back to the Text Morph from whence I came"
  
+ 	(self valueOfProperty: #donorTextMorph) ifNotNil:
- 	(self valueOfProperty: #donorTextMorph) ifNotNilDo:
  		[:aDonor | aDonor setCharacters: self assuredPlayer getStringContents]!

Item was changed:
  ----- Method: Morph>>stepAt: (in category 'stepping and presenter') -----
  stepAt: millisecondClockValue
  	"Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message.
  	The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch.
  	Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value"
+ 	self player ifNotNil:[:p| p stepAt: millisecondClockValue].
- 	self player ifNotNilDo:[:p| p stepAt: millisecondClockValue].
  	self step
  !

Item was changed:
  ----- Method: PasteUpMorph>>galleryOfPlayers (in category 'world menu') -----
  galleryOfPlayers
  	"Put up a tool showing all the players in the project"
  	
+ 	(ActiveWorld findA: AllPlayersTool) ifNotNil: [:aTool | ^ aTool comeToFront].
- 	(ActiveWorld findA: AllPlayersTool) ifNotNilDo: [:aTool | ^ aTool comeToFront].
  	AllPlayersTool newStandAlone openInHand
  
  "ActiveWorld galleryOfPlayers"!

Item was changed:
  ----- Method: BorderedMorph>>changeBorderWidth: (in category 'menu') -----
  changeBorderWidth: evt
  	| handle origin aHand newWidth oldWidth |
  	aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
  	origin := aHand position.
  	oldWidth := borderWidth.
+ 	(handle := HandleMorph new)
- 	handle := HandleMorph new
  		forEachPointDo:
  			[:newPoint | handle removeAllMorphs.
  			handle addMorph:
  				(LineMorph from: origin to: newPoint color: Color black width: 1).
  			newWidth := (newPoint - origin) r asInteger // 5.
  			self borderWidth: newWidth]
  		lastPointDo:
  			[:newPoint | handle deleteBalloon.
+ 			self halo ifNotNil: [:halo | halo addHandles].
- 			self halo ifNotNilDo: [:halo | halo addHandles].
  			self rememberCommand:
  				(Command new cmdWording: 'border change' translated;
  					undoTarget: self selector: #borderWidth: argument: oldWidth;
  					redoTarget: self selector: #borderWidth: argument: newWidth)].
  	aHand attachMorph: handle.
  	handle setProperty: #helpAtCenter toValue: true.
  	handle showBalloon:
  'Move cursor farther from
  this point to increase border width.
  Click when done.' translated hand: evt hand.
  	handle startStepping!

Item was changed:
  ----- Method: PluggableTextMorph>>accept (in category 'menu commands') -----
  accept 
  	"Inform the model of text to be accepted, and return true if OK."
  
  	| ok saveSelection saveScrollerOffset |
  "sps 8/13/2001 22:41: save selection and scroll info"
  	saveSelection := self selectionInterval copy.
  	saveScrollerOffset := scroller offset copy.
  
  	(self canDiscardEdits and: [(self hasProperty: #alwaysAccept) not])
  		ifTrue: [^ self flash].
  
  	self hasEditingConflicts ifTrue:
  		[(self confirm: 
  'Caution!! This method may have been
  changed elsewhere since you started
  editing it here.  Accept anyway?' translated) ifFalse: [^ self flash]].
  	ok := self acceptTextInModel.
  	ok==true ifTrue:
  		[self setText: self getText.
  		self hasUnacceptedEdits: false.
+ 		(model dependents detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #annotation]] ifNone: [nil]) ifNotNil:
- 		(model dependents detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #annotation]] ifNone: [nil]) ifNotNilDo:
  			[:aPane | model changed: #annotation]].
  
  	"sps 8/13/2001 22:41: restore selection and scroll info"
  	["During the step for the browser, updateCodePaneIfNeeded is called, and 
  		invariably resets the contents of the codeholding PluggableTextMorph
  		at that time, resetting the cursor position and scroller in the process.
  		The following line forces that update without waiting for the step, 		then restores the cursor and scrollbar"
  
  	ok ifTrue: "(don't bother if there was an error during compile)"
  		[(model respondsTo: #updateCodePaneIfNeeded) 
  			ifTrue: [model updateCodePaneIfNeeded].
  		WorldState addDeferredUIMessage:
  			[self currentHand newKeyboardFocus: textMorph.
  			scroller offset: saveScrollerOffset.
  			self setScrollDeltas.
  			self selectFrom: saveSelection first to: saveSelection last]]]
  
  			on: Error do: []
  !

Item was changed:
  ----- Method: MenuMorph class>>confirm:trueChoice:falseChoice: (in category 'utilities') -----
  confirm: queryString trueChoice: trueChoice falseChoice: falseChoice 
  	"Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice,  false if it's the false-choice. This is a modal question -- the user must respond one way or the other."
  	"MenuMorph 
  		confirm: 'Are you hungry?'  
  		trueChoice: 'yes, I''m famished'  
  		falseChoice: 'no, I just ate'"
  	| menu aBlock result |
  	(ProvideAnswerNotification signal: queryString) 
+ 		ifNotNil:[:answer | ^ trueChoice = answer].
- 		ifNotNilDo:[:answer | ^ trueChoice = answer].
  	aBlock := [:v| result := v].
  	menu := self new.
  	menu addTitle: queryString icon: MenuIcons confirmIcon.
  	menu add: trueChoice target: aBlock selector: #value: argument: true.
  	menu add: falseChoice target: aBlock selector: #value: argument: false.
  	MenuIcons decorateMenu: menu.
  	[menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.
  	result == nil] whileTrue.
  	^result!

Item was changed:
  ----- Method: HaloMorph>>doScale:with: (in category 'private') -----
  doScale: evt with: scaleHandle
  	"Update the scale of my target if it is scalable."
  	| newHandlePos colorToUse |
  	evt hand obtainHalo: self.
  	newHandlePos := evt cursorPoint - (scaleHandle extent // 2).
  	target scaleToMatch: newHandlePos.
  	colorToUse := target scale = 1.0
  						ifTrue: [Color yellow]
  						ifFalse: [Color orange].
  	self setColor: colorToUse toHandle: scaleHandle.
  	scaleHandle
  		submorphsDo: [:m | m color: colorToUse makeForegroundColor].
  	scaleHandle position: newHandlePos.
  	self layoutChanged.
  
+ 	(self valueOfProperty: #commandInProgress) ifNotNil:[:cmd |
- 	(self valueOfProperty: #commandInProgress) ifNotNilDo:[:cmd |
  		"Update the final extent"
  		cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent
  	].
  !

Item was changed:
  ----- Method: PolygonMorph>>privateMoveBy: (in category 'private') -----
  privateMoveBy: delta
  	super privateMoveBy: delta.
  	vertices := vertices collect: [:p | p + delta].
  	self arrowForms do: [:f | f offset: f offset + delta].
  	curveState := nil.  "Force recomputation"
+ 	(self valueOfProperty: #referencePosition) ifNotNil:
- 	(self valueOfProperty: #referencePosition) ifNotNilDo:
  		[:oldPos | self setProperty: #referencePosition toValue: oldPos + delta]!

Item was changed:
  ----- Method: Morph>>addModelYellowButtonItemsTo:event: (in category 'menu') -----
  addModelYellowButtonItemsTo: aCustomMenu event: evt 
  	"Give my models a chance to add their context-menu items to  
  	aCustomMenu."
  	self model
+ 		ifNotNil: [:mod |
- 		ifNotNilDo: [:mod |
  			mod
  				addModelYellowButtonMenuItemsTo: aCustomMenu
  				forMorph: self
  				hand: evt hand]!

Item was changed:
  ----- Method: SystemWindow>>replaceBoxes (in category 'initialization') -----
  replaceBoxes
  	"Rebuild the various boxes."
  	self setLabelWidgetAllowance.
+ 	closeBox ifNotNil: [ :m | m delete. self addCloseBox. ].
+ 	expandBox ifNotNil: [ :m | m delete. self addExpandBox. ].
+ 	menuBox ifNotNil: [ :m | m delete. self addMenuControl. ].
+ 	collapseBox ifNotNil: [ :m | m delete. labelArea addMorph: (collapseBox := self createCollapseBox) ].
- 	closeBox ifNotNilDo: [ :m | m delete. self addCloseBox. ].
- 	expandBox ifNotNilDo: [ :m | m delete. self addExpandBox. ].
- 	menuBox ifNotNilDo: [ :m | m delete. self addMenuControl. ].
- 	collapseBox ifNotNilDo: [ :m | m delete. labelArea addMorph: (collapseBox := self createCollapseBox) ].
  	self setFramesForLabelArea.
  	self setWindowColor: self paneColor !

Item was changed:
  ----- Method: PluggableTextMorph>>cancel (in category 'menu commands') -----
  cancel
  	self setText: self getText.
  	self setSelection: self getSelection.
  	getTextSelector == #annotation ifFalse:
+ 		[(model dependents detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #annotation]] ifNone: [nil]) ifNotNil:
- 		[(model dependents detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #annotation]] ifNone: [nil]) ifNotNilDo:
  			[:aPane | model changed: #annotation]]!

Item was changed:
  ----- Method: Morph>>delete (in category 'submorphs-add/remove') -----
  delete
  	"Remove the receiver as a submorph of its owner and make its 
  	new owner be nil."
  
  	| aWorld |
  	self removeHalo.
  	aWorld := self world ifNil: [World].
  	"Terminate genie recognition focus"
  	"I encountered a case where the hand was nil, so I put in a little 
  	protection - raa "
  	" This happens when we are in an MVC project and open
  	  a morphic window. - BG "
  	aWorld ifNotNil:
  	  [self disableSubmorphFocusForHand: self activeHand.
  	  self activeHand releaseKeyboardFocus: self;
  		  releaseMouseFocus: self.].
  	owner ifNotNil:[ self privateDelete.
+ 		self player ifNotNil: [ :player |
- 		self player ifNotNilDo: [ :player |
  			"Player must be notified"
  			player noteDeletionOf: self fromWorld: aWorld]].!

Item was changed:
  ----- Method: FillInTheBlankMorph>>getUserResponse (in category 'invoking') -----
  getUserResponse
  	"Wait for the user to accept or cancel, and answer the result string. Answers the empty string if the user cancels."
  	"Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."
  
  	| w |
  	w := self world.
  	w ifNil: [^ response].
  	
  	(ProvideAnswerNotification signal:
+ 		(self submorphOfClass: TextMorph) userString) ifNotNil:
- 		(self submorphOfClass: TextMorph) userString) ifNotNilDo:
  		[:answer |
  		self delete.
  		w doOneCycle.
  		^ response := (answer == #default) ifTrue: [response] ifFalse: [answer]].
  
  	done := false.
  	w activeHand newKeyboardFocus: textPane.
  	[done] whileFalse: [w doOneCycle].
  	self delete.
  	w doOneCycle.
  	^ response
  !

Item was changed:
  ----- Method: PasteUpMorph>>modalWindow: (in category 'accessing') -----
  modalWindow: aMorph 
  	(self valueOfProperty: #modalWindow)
+ 		ifNotNil: [:morph | morph doCancel].
- 		ifNotNilDo: [:morph | morph doCancel].
  	self setProperty: #modalWindow toValue: aMorph.
  	aMorph
  		ifNotNil: [self
  				when: #aboutToLeaveWorld
  				send: #removeModalWindow
  				to: self]!

Item was changed:
  ----- Method: TextMorph>>resetBlinkCursor (in category 'blinking') -----
  resetBlinkCursor
  	"Reset the blinking cursor"
  	| para |
  	self blinkStart: Time millisecondClockValue + 500.
  	para := self paragraph ifNil:[^self].
  	para showCaret = para focused ifFalse:[
+ 		para caretRect ifNotNil: [ :r | self invalidRect: r].
- 		para caretRect ifNotNilDo:[:r| self invalidRect: r].
  		para showCaret: para focused.
  	].
  !

Item was changed:
  ----- Method: FileList>>readOnlyStream (in category 'file list') -----
  readOnlyStream
  	"Answer a read-only stream on the selected file. For the various stream-reading services."
  
+ 	^self directory ifNotNil: [ :dir | dir readOnlyFileNamed: self fileName ]!
- 	^self directory ifNotNilDo: [ :dir | dir readOnlyFileNamed: self fileName ]!

Item was changed:
  ----- Method: ScriptEditorMorph>>buttonRowForEditor (in category 'buttons') -----
  buttonRowForEditor
  	"Answer a row of buttons that comprise the header at the top of the Scriptor"
  
  	| aRow aString buttonFont aStatusMorph aButton aColumn aTile |
  	buttonFont := Preferences standardButtonFont.
  	aRow := AlignmentMorph newRow color: Color transparent; layoutInset: 0.
  	aRow hResizing: #shrinkWrap.
  	aRow vResizing: #shrinkWrap.
  	self hasParameter ifFalse:
  		[aRow addMorphFront:
  			(SimpleButtonMorph new
  				label: '!!' font: Preferences standardEToysFont;
  				target: self;
  				color: Color yellow;
  				borderWidth: 0;
  				actWhen: #whilePressed;
  				actionSelector: #tryMe;
  				balloonTextSelector: #tryMe).
  		aRow addTransparentSpacerOfSize: 6 at 10].
  	self addDismissButtonTo: aRow.
  	aRow addTransparentSpacerOfSize: 6 at 1.
  	aColumn := AlignmentMorph newColumn beTransparent.
  	aColumn addTransparentSpacerOfSize: 0 at 4.
  	aButton := UpdatingThreePhaseButtonMorph checkBox.
  	aButton
  		target: self;
  		actionSelector: #toggleWhetherShowingTiles;
  		getSelector: #showingMethodPane.
  	aButton setBalloonText: 'toggle between showing tiles and showing textual code' translated.
  	aColumn addMorphBack: aButton.
  	aRow addMorphBack: aColumn.
  
  	aRow addTransparentSpacerOfSize: 6 at 10.
  
  	aString := playerScripted externalName.
  	aRow addMorphBack:
  		(aButton := SimpleButtonMorph new useSquareCorners label: aString font: buttonFont; target: self; setNameTo: 'title').
  	aButton actWhen: #buttonDown; actionSelector: #offerScriptorMenu.
  	aButton
  		on: #mouseEnter send: #menuButtonMouseEnter: to: aButton;
  		on: #mouseLeave send: #menuButtonMouseLeave: to: aButton.
  
  	aButton borderColor: (Color fromRgbTriplet: #(0.065 0.258 1.0)).
  	aButton color: ScriptingSystem uniformTileInteriorColor.
  	aButton balloonTextSelector: #offerScriptorMenu.
  	aRow addTransparentSpacerOfSize: 4 at 1.
  	aButton := (Preferences universalTiles ifTrue: [SyntaxUpdatingStringMorph] 
  					ifFalse: [UpdatingStringMorph]) new.
  	aButton useStringFormat;
  		target:  self;
  		getSelector: #scriptTitle;
  		setNameTo: 'script name';
  		font: ScriptingSystem fontForNameEditingInScriptor;
  		putSelector: #setScriptNameTo:;
  		setProperty: #okToTextEdit toValue: true;
  		step;
  		yourself.
  	aRow addMorphBack: aButton.
  	aButton setBalloonText: 'Click here to edit the name of the script.' translated.
  	aRow addTransparentSpacerOfSize: 6 at 0.
  	self hasParameter
  		ifTrue:
  			[aTile := TypeListTile new choices: Vocabulary typeChoices dataType: nil.
  			aTile addArrows.
  			aTile setLiteral: #Number.
  	"(aButton := SimpleButtonMorph new useSquareCorners label: 'parameter' translated font: buttonFont; target: self; setNameTo: 'parameter').
  			aButton actWhen: #buttonDown; actionSelector: #handUserParameterTile.
  
  "
  			aRow addMorphBack: aTile.
  			aTile borderColor: Color red.
  			aTile color: ScriptingSystem uniformTileInteriorColor.
  			aTile setBalloonText: 'Drag from here to get a parameter tile' translated]
  		ifFalse:
  			[aRow addMorphBack: (aStatusMorph := self scriptInstantiation statusControlMorph)].
  
  	aRow addTransparentSpacerOfSize: 6 at 1.
  
  	aRow addMorphBack:
  		(IconicButton new borderWidth: 0;
  			labelGraphic: (ScriptingSystem formAtKey: 'AddTest'); color: Color transparent; 
  			actWhen: #buttonDown;
  			target: self;
  			actionSelector: #addYesNoToHand;
  			shedSelvedge;
  			balloonTextSelector: #addYesNoToHand).
  	aRow addTransparentSpacerOfSize: 12 at 10.
  	self addDestroyButtonTo: aRow.
  	(playerScripted existingScriptInstantiationForSelector: scriptName)
+ 		ifNotNil:
- 		ifNotNilDo:
  			[:inst | inst updateStatusMorph: aStatusMorph].
  	^ aRow!




More information about the Squeak-dev mailing list