[squeak-dev] The Trunk: ST80-fbs.145.mcz

commits at source.squeak.org commits at source.squeak.org
Fri May 31 14:59:11 UTC 2013


Frank Shearar uploaded a new version of ST80 to project The Trunk:
http://source.squeak.org/trunk/ST80-fbs.145.mcz

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

Name: ST80-fbs.145
Author: fbs
Time: 31 May 2013, 3:58:33.3 pm
UUID: 391f44a6-e960-42f2-83b4-7c9700212c0e
Ancestors: ST80-fbs.144

Move ToolBuilder-MVC to ST80-ToolBuilder.

=============== Diff against ST80-fbs.144 ===============

Item was changed:
  SystemOrganization addCategory: #'ST80-Controllers'!
  SystemOrganization addCategory: #'ST80-Editors'!
  SystemOrganization addCategory: #'ST80-Framework'!
  SystemOrganization addCategory: #'ST80-Menus'!
  SystemOrganization addCategory: #'ST80-Menus-Tests'!
  SystemOrganization addCategory: #'ST80-Paths'!
  SystemOrganization addCategory: #'ST80-Pluggable Views'!
  SystemOrganization addCategory: #'ST80-Support'!
  SystemOrganization addCategory: #'ST80-Support-Tests'!
  SystemOrganization addCategory: #'ST80-Symbols'!
  SystemOrganization addCategory: #'ST80-Views'!
+ SystemOrganization addCategory: #'ST80-ToolBuilder'!

Item was added:
+ ToolBuilder subclass: #MVCToolBuilder
+ 	instanceVariableNames: 'panes topSize widgets'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'ST80-ToolBuilder'!
+ 
+ !MVCToolBuilder commentStamp: 'ar 2/11/2005 15:02' prior: 0!
+ The MVC tool builder.!

Item was added:
+ ----- Method: MVCToolBuilder class>>isActiveBuilder (in category 'accessing') -----
+ isActiveBuilder
+ 	"Answer whether I am the currently active builder"
+ 	"This is really a way of answering whether 'Smalltalk isMVC'"
+ 	ScheduledControllers ifNil:[^false].
+ 	^(ScheduledControllers activeControllerProcess ifNil:[^false]) isTerminated not!

Item was added:
+ ----- Method: MVCToolBuilder>>asWindow: (in category 'private') -----
+ asWindow: aRectangle
+ 
+ 	| outer |
+ 	outer := parent window ifNil: [topSize].
+ 	^(aRectangle origin * outer extent) truncated
+ 		corner: (aRectangle corner * outer extent) truncated!

Item was added:
+ ----- Method: MVCToolBuilder>>buildPluggableButton: (in category 'pluggable widgets') -----
+ buildPluggableButton: aSpec
+ 	| widget label state |
+ 	label := aSpec label.
+ 	state := aSpec state.
+ 	widget := PluggableButtonView on: aSpec model
+ 				getState: (state isSymbol ifTrue:[state])
+ 				action: aSpec action
+ 				label: (label isSymbol ifTrue:[label]).
+ 	self register: widget id: aSpec name.
+ 	label ifNotNil: [label isSymbol
+ 		ifTrue: [widget label: (aSpec model perform: label)]
+ 		ifFalse: [widget label: label]].
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil: [parent addSubView: widget].
+ 	^widget!

Item was added:
+ ----- Method: MVCToolBuilder>>buildPluggableList: (in category 'pluggable widgets') -----
+ buildPluggableList: aSpec
+ 	| widget listClass getIndex setIndex |
+ 	aSpec getSelected ifNil:[
+ 		listClass := PluggableListView.
+ 		getIndex := aSpec getIndex.
+ 		setIndex := aSpec setIndex.
+ 	] ifNotNil:[
+ 		listClass := PluggableListViewByItem.
+ 		getIndex := aSpec getSelected.
+ 		setIndex := aSpec setSelected.
+ 	].
+ 	widget := listClass on: aSpec model
+ 				list: aSpec list
+ 				selected: getIndex
+ 				changeSelected: setIndex
+ 				menu: aSpec menu
+ 				keystroke: aSpec keyPress.
+ 	self register: widget id: aSpec name.
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[parent addSubView: widget].
+ 	panes ifNotNil:[
+ 		aSpec list ifNotNil:[panes add: aSpec list].
+ 	].
+ 	^widget!

Item was added:
+ ----- Method: MVCToolBuilder>>buildPluggablePanel: (in category 'pluggable widgets') -----
+ buildPluggablePanel: aSpec
+ 	| widget children |
+ 	widget := View new model: aSpec model.
+ 	self register: widget id: aSpec name.
+ 	children := aSpec children.
+ 	children isSymbol ifTrue:[
+ 		"@@@@ FIXME: PluggablePanes need to remember their getChildrenSelector"
+ 		"widget getChildrenSelector: children.
+ 		widget update: children."
+ 		children := #().
+ 	].
+ 	self setFrame: aSpec frame in: widget.
+ 	self buildAll: children in: widget.
+ 	parent ifNotNil:[parent addSubView: widget].
+ 	self setLayout: aSpec layout in: widget.
+ 	^widget!

Item was added:
+ ----- Method: MVCToolBuilder>>buildPluggableText: (in category 'pluggable widgets') -----
+ buildPluggableText: aSpec
+ 	| widget |
+ 	widget := PluggableTextView on: aSpec model
+ 				text: aSpec getText 
+ 				accept: aSpec setText
+ 				readSelection: aSpec selection 
+ 				menu: aSpec menu.
+ 	self register: widget id: aSpec name.
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[parent addSubView: widget].
+ 	panes ifNotNil:[
+ 		aSpec getText ifNotNil:[panes add: aSpec getText].
+ 	].
+ 	^widget!

Item was added:
+ ----- Method: MVCToolBuilder>>buildPluggableWindow: (in category 'pluggable widgets') -----
+ buildPluggableWindow: aSpec
+ 	| widget children label |
+ 	topSize := 0 at 0 corner: 640 at 480.
+ 	aSpec layout == #proportional ifFalse:[
+ 		"This needs to be implemented - probably by adding a single pane and then the rest"
+ 		^self error: 'Not implemented'.
+ 	].
+ 	widget := StandardSystemView new.
+ 	self register: widget id: aSpec name.
+ 	widget model: aSpec model.
+ 	label := aSpec label.
+ 	label isSymbol ifTrue: [label := aSpec model perform: label].
+ 	label isNil ifFalse: [widget setLabel: label].
+ 	children := aSpec children.
+ 	children isSymbol ifTrue:[
+ 		"This isn't implemented by StandardSystemView, so we fake it"
+ 		children := widget model perform: children.
+ 	].
+ 	aSpec extent ifNotNil:[topSize :=  0 at 0 extent: aSpec extent].
+ 	widget window: topSize.
+ 	panes := OrderedCollection new.
+ 	self buildAll: children in: widget.
+ 	widget setUpdatablePanesFrom: panes.
+ 	^widget!

Item was added:
+ ----- Method: MVCToolBuilder>>close: (in category 'opening') -----
+ close: aWidget
+ 	"Close a previously opened widget"
+ 	aWidget controller closeAndUnschedule.!

Item was added:
+ ----- Method: MVCToolBuilder>>open: (in category 'opening') -----
+ open: anObject
+ 	"Build and open the object. Answer the widget opened."
+ 	| window |
+ 	window := self build: anObject.
+ 	window controller open.
+ 	^window!

Item was added:
+ ----- Method: MVCToolBuilder>>open:label: (in category 'opening') -----
+ open: anObject label: aString
+ 	"Build an open the object, labeling it appropriately.  Answer the widget opened."
+ 	| window |
+ 	window := self build: anObject.
+ 	window label: aString.
+ 	window controller open.
+ 	^window!

Item was added:
+ ----- Method: MVCToolBuilder>>openDebugger: (in category 'opening') -----
+ openDebugger: anObject
+ 	"Build and open the object. Answer the widget opened."
+ 	| window |
+ 	window := self build: anObject.
+ 	window controller openNoTerminate.
+ 	^window!

Item was added:
+ ----- Method: MVCToolBuilder>>openDebugger:label: (in category 'opening') -----
+ openDebugger: anObject label: aString
+ 	"Build an open the object, labeling it appropriately.  Answer the widget opened."
+ 	| window |
+ 	window := self build: anObject.
+ 	window label: aString.
+ 	window controller openNoTerminate.
+ 	^window!

Item was added:
+ ----- Method: MVCToolBuilder>>pluggableTreeSpec (in category 'defaults') -----
+ pluggableTreeSpec
+ 	"We have no tree widget in MVC right now"
+ 	^nil!

Item was added:
+ ----- Method: MVCToolBuilder>>positionSubviewsWithin: (in category 'private') -----
+ positionSubviewsWithin: widget
+ 	"Translate subviews to position the viewport of each subView relative to
+ 	the widget window origin. If subviews are repositioned, as in a row of button
+ 	views arranged within a view, then the transformations will later be rescaled
+ 	to fit the subviews within the widget window."
+ 
+ 	widget subViews ifNotNilDo: [:subViews |
+ 		subViews isEmpty ifFalse: [ | translation |
+ 			translation := widget window origin - subViews first window origin.
+ 			subViews do: [:v | 
+ 				v setTransformation: (v transformation translateBy: translation)]]].
+ !

Item was added:
+ ----- Method: MVCToolBuilder>>register:id: (in category 'private') -----
+ register: widget id: id
+ 	id ifNil:[^self].
+ 	widgets ifNil:[widgets := Dictionary new].
+ 	widgets at: id put: widget.!

Item was added:
+ ----- Method: MVCToolBuilder>>runModal: (in category 'opening') -----
+ runModal: aWidget
+ 	"Run the (previously opened) widget modally, e.g., 
+ 	do not return control to the sender before the user has responded."
+ 
+ 	self error: 'Please implement me'.!

Item was added:
+ ----- Method: MVCToolBuilder>>setFrame:in: (in category 'private') -----
+ setFrame: fractionsRectangleOrLayoutFrame in: widget
+ 	| win |
+ 	fractionsRectangleOrLayoutFrame ifNil: [^nil].
+ 	win := fractionsRectangleOrLayoutFrame isRectangle
+ 		ifTrue: [self asWindow: fractionsRectangleOrLayoutFrame]
+ 		ifFalse: [fractionsRectangleOrLayoutFrame layout: nil in: topSize]. "assume LayoutFrame"
+ 	widget window: win.!

Item was added:
+ ----- Method: MVCToolBuilder>>setLayout:in: (in category 'private') -----
+ setLayout: layout in: widget
+ 	"Arrange subview horizontally or vertically according to layout directive.
+ 	If the subview dimensions were specified with layout frames rather than explicit
+ 	rectangle sizes, then their window horizontal or vertical dimensions will be resized
+ 	as needed to fit within the widget extent."
+ 
+ 	self positionSubviewsWithin: widget.
+ 	layout == #proportional ifTrue:[^self].
+ 	layout == #horizontal ifTrue:[
+ 		| prev subViewWidth widgetWidth xScale |
+ 		subViewWidth := (widget subViews collect: [:e | e window extent x]) sum.
+ 		widgetWidth := widget window extent x.
+ 		xScale := widgetWidth / subViewWidth. "to adjust corner of prev prior to align:"
+ 		prev := nil.
+ 		widget subViews do:[:next| | newWindowWidth newCorner |
+ 			prev ifNotNil:[ "resize prev window prior to aligning next"
+ 				xScale < 1 ifTrue: [ "proportional placement spec requires resizing"
+ 					newWindowWidth := (prev window extent x * xScale) truncated.
+ 					newCorner := (prev window origin x + newWindowWidth)@(prev window corner y).
+ 					prev setWindow: (prev window origin corner: newCorner)].
+ 				next align: next viewport topLeft with: prev viewport topRight.
+ 			].
+ 			prev := next.
+ 		].
+ 		^self].
+ 	layout == #vertical ifTrue:[
+ 		| prev subViewHeight widgetHeight yScale |
+ 		subViewHeight := (widget subViews collect: [:e | e window extent y]) sum.
+ 		widgetHeight := widget window extent y.
+ 		yScale := widgetHeight / subViewHeight. "to adjust corner of prev prior to align:"
+ 		prev := nil.
+ 		widget subViews do:[:next| | newWindowHeight newCorner |
+ 			prev ifNotNil:[ "resize prev window prior to aligning next"
+ 				yScale < 1 ifTrue: [ "proportional placement spec requires resizing"
+ 					newWindowHeight := (prev window extent y * yScale) truncated.
+ 					newCorner := (prev window corner x)@(prev window origin y + newWindowHeight).
+ 					prev setWindow: (prev window origin corner: newCorner)].
+ 				next align: next viewport topLeft with: prev viewport bottomLeft.
+ 			].
+ 			prev := next.
+ 		].
+ 		^self].
+ 	^self error: 'Unknown layout: ', layout.!

Item was added:
+ ----- Method: MVCToolBuilder>>widgetAt:ifAbsent: (in category 'private') -----
+ widgetAt: id ifAbsent: aBlock
+ 	widgets ifNil:[^aBlock value].
+ 	^widgets at: id ifAbsent: aBlock!

Item was added:
+ ToolBuilderTests subclass: #MVCToolBuilderTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'ST80-ToolBuilder'!
+ 
+ !MVCToolBuilderTests commentStamp: 'ar 2/11/2005 15:02' prior: 0!
+ Tests for the MVC tool builder.!

Item was added:
+ ----- Method: MVCToolBuilderTests>>acceptWidgetText (in category 'support') -----
+ acceptWidgetText
+ 	widget hasUnacceptedEdits: true.
+ 	widget controller accept.!

Item was added:
+ ----- Method: MVCToolBuilderTests>>changeListWidget (in category 'support') -----
+ changeListWidget
+ 	widget changeModelSelection: widget getCurrentSelectionIndex + 1.!

Item was added:
+ ----- Method: MVCToolBuilderTests>>expectedButtonSideEffects (in category 'support') -----
+ expectedButtonSideEffects
+ 	^#(getState)!

Item was added:
+ ----- Method: MVCToolBuilderTests>>fireButtonWidget (in category 'support') -----
+ fireButtonWidget
+ 	widget performAction.!

Item was added:
+ ----- Method: MVCToolBuilderTests>>setUp (in category 'support') -----
+ setUp
+ 	super setUp.
+ 	builder := MVCToolBuilder new.!

Item was added:
+ ----- Method: MVCToolBuilderTests>>tearDown (in category 'support') -----
+ tearDown
+ 	ScreenController new restoreDisplay.
+ 	super tearDown!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testAddAction (in category 'tests-not applicable') -----
+ testAddAction
+ 	"MVCToolBuilder does not implement #buildPluggableMenu:"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testAddTargetSelectorArgumentList (in category 'tests-not applicable') -----
+ testAddTargetSelectorArgumentList
+ 	"MVCToolBuilder does not implement #buildPluggableMenu:"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testButtonFiresBlock (in category 'tests-not applicable') -----
+ testButtonFiresBlock
+ 	"MVC buttons only support action Symbols"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testButtonFiresMessage (in category 'tests-not applicable') -----
+ testButtonFiresMessage
+ 	"MVC buttons only support action Symbols, not MessageSends"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testButtonInitiallyDisabled (in category 'tests-not applicable') -----
+ testButtonInitiallyDisabled
+ 	"MVC does not have button enablement"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testButtonInitiallyDisabledSelector (in category 'tests-not applicable') -----
+ testButtonInitiallyDisabledSelector
+ 	"MVC does not have button enablement"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testGetButtonColor (in category 'tests-not applicable') -----
+ testGetButtonColor
+ 	"MVC buttons do not have color"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testGetButtonEnabled (in category 'tests-not applicable') -----
+ testGetButtonEnabled
+ 	"MVC does not have button enablement"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testGetInputFieldColor (in category 'tests-not applicable') -----
+ testGetInputFieldColor
+ 	"MVC input fields do not have color"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testGetPanelChildren (in category 'tests-not applicable') -----
+ testGetPanelChildren
+ 	"MVC panels do not allow changing children"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testGetTextColor (in category 'tests-not applicable') -----
+ testGetTextColor
+ 	"not supported in MVC"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testGetWindowChildren (in category 'tests-not applicable') -----
+ testGetWindowChildren
+ 	"not supported in MVC"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testGetWindowLabel (in category 'tests-not applicable') -----
+ testGetWindowLabel
+ 	"not supported in MVC"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testTreeExpandPath (in category 'tests-not applicable') -----
+ testTreeExpandPath
+ 	"MVCToollBuilder does not implement trees"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testTreeExpandPathFirst (in category 'tests-not applicable') -----
+ testTreeExpandPathFirst
+ 	"MVCToollBuilder does not implement trees"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testTreeGetSelectionPath (in category 'tests-not applicable') -----
+ testTreeGetSelectionPath
+ 	"MVCToollBuilder does not implement trees"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testTreeRoots (in category 'tests-not applicable') -----
+ testTreeRoots
+ 	"MVCToollBuilder does not implement trees"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testTreeWidgetID (in category 'tests-not applicable') -----
+ testTreeWidgetID
+ 	"MVCToollBuilder does not implement trees"!

Item was added:
+ ----- Method: MVCToolBuilderTests>>testWindowCloseAction (in category 'tests-not applicable') -----
+ testWindowCloseAction
+ 	"This can only work if we're actually run in MVC"
+ 	World isNil ifTrue: [super testWindowCloseAction]!

Item was added:
+ UIManager subclass: #MVCUIManager
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'ST80-ToolBuilder'!
+ 
+ !MVCUIManager commentStamp: 'dtl 5/2/2010 16:06' prior: 0!
+ MVCUIManager is a UIManager that implements user interface requests for an MVC user interface.!

Item was added:
+ ----- Method: MVCUIManager class>>isActiveManager (in category 'accessing') -----
+ isActiveManager
+ 	"Answer whether I should act as the active ui manager"
+ 	"This is really a way of answering whether 'Smalltalk isMVC'"
+ 	ScheduledControllers ifNil:[^false].
+ 	^ScheduledControllers activeControllerProcess == Processor activeProcess!

Item was added:
+ ----- Method: MVCUIManager>>chooseDirectory:from: (in category 'ui requests') -----
+ chooseDirectory: label from: dir
+ 	"Let the user choose a directory"
+ 	^self notYetImplemented!

Item was added:
+ ----- Method: MVCUIManager>>chooseFileMatching:label: (in category 'ui requests') -----
+ chooseFileMatching: patterns label: labelString
+ 	"Let the user choose a file matching the given patterns"
+ 	^self notYetImplemented!

Item was added:
+ ----- Method: MVCUIManager>>chooseFont:for:setSelector:getSelector: (in category 'ui requests') -----
+ chooseFont: aPrompt for: aTarget setSelector: setSelector getSelector: getSelector
+ 	"MVC Only!! prompt for a font and if one is provided, send it to aTarget using a message with selector aSelector."
+ 	| aMenu aChoice aStyle namesAndSizes aFont |
+ 	aMenu := CustomMenu new.
+ 	TextStyle actualTextStyles keysSortedSafely do:
+ 		[:styleName |
+ 			aMenu add: styleName action: styleName].
+ 	aChoice := aMenu startUpWithCaption: aPrompt.
+ 	aChoice ifNil: [^ self].
+ 	aMenu := CustomMenu new.
+ 	aStyle := TextStyle named: aChoice.
+ 	(namesAndSizes := aStyle fontNamesWithPointSizes) do:
+ 		[:aString | aMenu add: aString action: aString].
+ 	aChoice := aMenu startUpWithCaption: nil.
+ 	aChoice ifNil: [^ self].
+ 	aFont := aStyle fontAt: (namesAndSizes indexOf: aChoice).
+ 	aTarget perform: setSelector with: aFont!

Item was added:
+ ----- Method: MVCUIManager>>chooseFrom:lines:title: (in category 'ui requests') -----
+ chooseFrom: aList lines: linesArray title: aString
+ 	"Choose an item from the given list. Answer the index of the selected item."
+ 	| menu |
+ 	menu := PopUpMenu labelArray: aList lines: linesArray.
+ 	^aString isEmpty ifTrue:[menu startUp] ifFalse:[menu startUpWithCaption: aString]!

Item was added:
+ ----- Method: MVCUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') -----
+ chooseFrom: labelList values: valueList lines: linesArray title: aString
+ 	"Choose an item from the given list. Answer the selected item."
+ 	| menu |
+ 	menu := SelectionMenu labels: labelList lines: linesArray selections: valueList.
+ 	^aString isEmpty ifTrue:[menu startUp] ifFalse:[menu startUpWithCaption: aString]!

Item was added:
+ ----- Method: MVCUIManager>>confirm: (in category 'ui requests') -----
+ confirm: queryString
+ 	"Put up a yes/no menu with caption queryString. Answer true if the 
+ 	response is yes, false if no. This is a modal question--the user must 
+ 	respond yes or no."
+ 	^PopUpMenu confirm: queryString!

Item was added:
+ ----- Method: MVCUIManager>>confirm:orCancel: (in category 'ui requests') -----
+ confirm: aString orCancel: cancelBlock
+ 	"Put up a yes/no/cancel menu with caption aString. Answer true if  
+ 	the response is yes, false if no. If cancel is chosen, evaluate  
+ 	cancelBlock. This is a modal question--the user must respond yes or no."
+ 	^PopUpMenu confirm: aString orCancel: cancelBlock!

Item was added:
+ ----- Method: MVCUIManager>>displayProgress:at:from:to:during: (in category 'ui requests') -----
+ displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock
+ 	"Display titleString as a caption over a progress bar while workBlock is evaluated."
+ 	| delta savedArea captionText textFrame barFrame outerFrame result range lastW |
+ 	barFrame := aPoint - (75 at 10) corner: aPoint + (75 at 10).
+ 	captionText := DisplayText text: titleString asText allBold.
+ 	captionText
+ 		foregroundColor: Color black
+ 		backgroundColor: Color white.
+ 	textFrame := captionText boundingBox insetBy: -4.
+ 	textFrame := textFrame align: textFrame bottomCenter
+ 					with: barFrame topCenter + (0 at 2).
+ 	outerFrame := barFrame merge: textFrame.
+ 	delta := outerFrame amountToTranslateWithin: Display boundingBox.
+ 	barFrame := barFrame translateBy: delta.
+ 	textFrame := textFrame translateBy: delta.
+ 	outerFrame := outerFrame translateBy: delta.
+ 	savedArea := Form fromDisplay: outerFrame.
+ 	Display fillBlack: barFrame; fillWhite: (barFrame insetBy: 2).
+ 	Display fillBlack: textFrame; fillWhite: (textFrame insetBy: 2).
+ 	captionText displayOn: Display at: textFrame topLeft + (4 at 4).
+ 	range := maxVal = minVal ifTrue: [1] ifFalse: [maxVal - minVal].  "Avoid div by 0"
+ 	lastW := 0.
+ 	[result := workBlock value:  "Supply the bar-update block for evaluation in the work block"
+ 		[:barVal |
+ 		| w |
+ 		w := ((barFrame width-4) asFloat * ((barVal-minVal) asFloat / range min: 1.0)) asInteger.
+ 		w ~= lastW ifTrue: [
+ 			Display fillGray: (barFrame topLeft + (2 at 2) extent: w at 16).
+ 			lastW := w]]]
+ 		ensure: [savedArea displayOn: Display at: outerFrame topLeft].
+ 	^result!

Item was added:
+ ----- Method: MVCUIManager>>edit:label:accept: (in category 'ui requests') -----
+ edit: aText label: labelString accept: anAction
+ 	"Open an editor on the given string/text"
+ 
+ 	Workspace new
+ 		acceptContents: aText;
+ 		acceptAction: anAction;
+ 		openLabel: labelString
+ !

Item was added:
+ ----- Method: MVCUIManager>>inform: (in category 'ui requests') -----
+ inform: aString
+ 	"Display a message for the user to read and then dismiss"
+ 	^PopUpMenu inform: aString!

Item was added:
+ ----- Method: MVCUIManager>>informUser:during: (in category 'ui requests') -----
+ informUser: aString during: aBlock
+ 	"Display a message above (or below if insufficient room) the cursor 
+ 	during execution of the given block.
+ 		UIManager default informUser: 'Just a sec!!' during: [(Delay forSeconds: 1) wait].
+ 	"
+ 	(SelectionMenu labels: '')
+ 		displayAt: Sensor cursorPoint
+ 		withCaption: aString
+ 		during: aBlock!

Item was added:
+ ----- Method: MVCUIManager>>informUserDuring: (in category 'ui requests') -----
+ informUserDuring: aBlock
+ 	"Display a message above (or below if insufficient room) the cursor 
+ 	during execution of the given block.
+ 		UIManager default informUserDuring:[:bar|
+ 			#(one two three) do:[:info|
+ 				bar value: info.
+ 				(Delay forSeconds: 1) wait]]"
+ 	aBlock value:[:string| Transcript cr; show: string].!

Item was added:
+ ----- Method: MVCUIManager>>initialize (in category 'initialize-release') -----
+ initialize
+ 	toolBuilder := MVCToolBuilder new!

Item was added:
+ ----- Method: MVCUIManager>>multiLineRequest:centerAt:initialAnswer:answerHeight: (in category 'ui requests') -----
+ multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight
+ 	"Create a multi-line instance of me whose question is queryString with
+ 	the given initial answer. Invoke it centered at the given point, and
+ 	answer the string the user accepts.  Answer nil if the user cancels.  An
+ 	empty string returned means that the ussr cleared the editing area and
+ 	then hit 'accept'.  Because multiple lines are invited, we ask that the user
+ 	use the ENTER key, or (in morphic anyway) hit the 'accept' button, to 
+ 	submit; that way, the return key can be typed to move to the next line."
+ 	^FillInTheBlank multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight!

Item was added:
+ ----- Method: MVCUIManager>>request:initialAnswer: (in category 'ui requests') -----
+ request: queryString initialAnswer: defaultAnswer 
+ 	"Create an instance of me whose question is queryString with the given 
+ 	initial answer. Invoke it centered at the given point, and answer the 
+ 	string the user accepts. Answer the empty string if the user cancels."
+ 	^FillInTheBlank request: queryString initialAnswer: defaultAnswer !

Item was added:
+ ----- Method: MVCUIManager>>request:initialAnswer:centerAt: (in category 'ui requests') -----
+ request: queryString initialAnswer: defaultAnswer centerAt: aPoint 
+ 	"Create an instance of me whose question is queryString with the given
+ 	initial answer. Invoke it centered at the given point, and answer the
+ 	string the user accepts. Answer the empty string if the user cancels."
+ 	^ FillInTheBlank request: queryString initialAnswer: defaultAnswer centerAt: aPoint !

Item was added:
+ ----- Method: MVCUIManager>>requestPassword: (in category 'ui requests') -----
+ requestPassword: queryString
+ 	"Create an instance of me whose question is queryString. Invoke it centered
+ 	at the cursor, and answer the string the user accepts. Answer the empty 
+ 	string if the user cancels."
+ 	^FillInTheBlank requestPassword: queryString!



More information about the Squeak-dev mailing list