The Trunk: ST80-fbs.170.mcz

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

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

Name: ST80-fbs.170
Author: fbs
Time: 9 January 2014, 2:58:06.407 pm
UUID: 3e5c636c-dd95-414c-85f4-621cc0fd98cb
Ancestors: ST80-ul.169

Move the ToolBuilder classes back to ToolBuilder-MVC: this way you can have Morphic with or without MVC.

=============== Diff against ST80-ul.169 ===============

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-REPL'!
  SystemOrganization addCategory: #'ST80-Support'!
  SystemOrganization addCategory: #'ST80-Support-Tests'!
  SystemOrganization addCategory: #'ST80-Symbols'!
- SystemOrganization addCategory: #'ST80-ToolBuilder'!
  SystemOrganization addCategory: #'ST80-Views'!

Item was removed:
- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MVCToolBuilder>>buildPluggableWindow: (in category 'pluggable widgets') -----
- buildPluggableWindow: aSpec
- | widget children label |
- topSize := 0@0 corner: 640@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@0 extent: aSpec extent].
- widget window: topSize.
- panes := OrderedCollection new.
- self buildAll: children in: widget.
- widget setUpdatablePanesFrom: panes.
- ^widget!

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MVCToolBuilder>>openDebugger:label:closing: (in category 'opening') -----
- openDebugger: anObject label: aString closing: topView
- "Build an open the object, labeling it appropriately.  Answer the widget opened."
- | window |
- topView controller controlTerminate.
- topView deEmphasize; erase.
-
- "a few hacks to get the scroll selection artifacts out when we got here by clicking in the list"
- " topView subViewWantingControl ifNotNil: [
- topView subViewWantingControl controller controlTerminate
- ]."
- topView controller status: #closed.
- window := self build: anObject.
- window label: aString.
- window controller openNoTerminate.
- topView controller closeAndUnscheduleNoErase.
- Processor terminateActive.
- ^window!

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MVCToolBuilder>>widgetAt:ifAbsent: (in category 'private') -----
- widgetAt: id ifAbsent: aBlock
- widgets ifNil:[^aBlock value].
- ^widgets at: id ifAbsent: aBlock!

Item was removed:
- 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 removed:
- ----- 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 removed:
- ----- Method: MVCUIManager>>chooseDirectory:from: (in category 'ui requests') -----
- chooseDirectory: label from: dir
- "Let the user choose a directory"
- ^self notYetImplemented!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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@10) corner: aPoint + (75@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@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@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@2) extent: w@16).
- lastW := w]]]
- ensure: [savedArea displayOn: Display at: outerFrame topLeft].
- ^result!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MVCUIManager>>initialize (in category 'initialize-release') -----
- initialize
- toolBuilder := MVCToolBuilder new!

Item was removed:
- ----- 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 removed:
- ----- Method: MVCUIManager>>newDisplayDepthNoRestore: (in category 'display') -----
- newDisplayDepthNoRestore: pixelSize
- "Change depths.  Check if there is enough space!!  , di"
- | area need |
- pixelSize = Display depth ifTrue: [^ self  "no change"].
- pixelSize abs < Display depth ifFalse:
- ["Make sure there is enough space"
- area := Display boundingBox area. "pixels"
- ScheduledControllers scheduledWindowControllers do:
- [:aController | "This should be refined..."
- aController view cacheBitsAsTwoTone ifFalse:
- [area := area + aController view windowBox area]].
- need := (area * (pixelSize abs - Display depth) // 8)  "new bytes needed"
- + Smalltalk lowSpaceThreshold.
- (Smalltalk garbageCollectMost <= need
- and: [Smalltalk garbageCollect <= need])
- ifTrue: [self error: 'Insufficient free space']].
- Display setExtent: Display extent depth: pixelSize.
- ScheduledControllers updateGray.
- DisplayScreen startUp!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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!

Item was removed:
- ----- Method: MVCUIManager>>restoreDisplay (in category 'display') -----
- restoreDisplay
- "Restore the bits on Display"
- Project current ifNotNil:[:p| p invalidate; restore].!

Item was removed:
- ----- Method: MVCUIManager>>restoreDisplayAfter: (in category 'display') -----
- restoreDisplayAfter: aBlock
- "Evaluate the block, wait for a mouse click, and then restore the screen."
-
- aBlock value.
- Sensor waitButton.
- self restoreDisplay!