The Trunk: ToolBuilder-Morphic-fbs.91.mcz

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

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

Name: ToolBuilder-Morphic-fbs.91
Author: fbs
Time: 9 January 2014, 2:56:27.235 pm
UUID: abaa076b-af43-af42-8c98-7a71482c6a30
Ancestors: ToolBuilder-Morphic-fbs.90

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

=============== Diff against ToolBuilder-Morphic-fbs.90 ===============

Item was added:
+ SystemOrganization addCategory: #'ToolBuilder-Morphic'!

Item was added:
+ Object subclass: #ListChooser
+ instanceVariableNames: 'window fullList selectedItems searchText searchMorph title listMorph index realIndex buttonBar builder addAllowed result'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0!
+ I am a simple dialog to allow the user to pick from a list of strings or symbols.
+ I support keyboard and mouse navigation, and interactive filtering of the displayed items.
+
+ You can specify whether you want the index, or the value of the selected item. If you're interested in the value, you can also allow users to Add a new value not in the list.
+
+ cmd-s or <enter> or double-click answers the currently selected item's value/index;
+ cmd-l or <escape> or closing the window answers nil/zero.
+
+ Now using ToolBuilder, so needs Morphic-MAD.381.
+
+ Released under the MIT Licence.!

Item was added:
+ ----- Method: ListChooser class>>chooseFrom: (in category 'ChooserTool compatibility') -----
+ chooseFrom: aList
+ ^ self
+ chooseFrom: aList
+ title: self defaultTitle!

Item was added:
+ ----- Method: ListChooser class>>chooseFrom:title: (in category 'ChooserTool compatibility') -----
+ chooseFrom: aList title: aString
+ ^ self
+ chooseIndexFrom: aList
+ title: aString
+ addAllowed: false!

Item was added:
+ ----- Method: ListChooser class>>chooseIndexFrom: (in category 'instance creation') -----
+ chooseIndexFrom: aList
+ ^ self
+ chooseIndexFrom: aList
+ title: self defaultTitle!

Item was added:
+ ----- Method: ListChooser class>>chooseIndexFrom:title: (in category 'instance creation') -----
+ chooseIndexFrom: aList title: aString
+ ^ self
+ chooseIndexFrom: aList
+ title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
+ addAllowed: false!

Item was added:
+ ----- Method: ListChooser class>>chooseIndexFrom:title:addAllowed: (in category 'instance creation') -----
+ chooseIndexFrom: aList title: aString addAllowed: aBoolean
+ ^ self new
+ chooseIndexFrom: aList
+ title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
+ addAllowed: aBoolean!

Item was added:
+ ----- Method: ListChooser class>>chooseItemFrom: (in category 'instance creation') -----
+ chooseItemFrom: aList
+ ^ self
+ chooseItemFrom: aList
+ title: self defaultTitle!

Item was added:
+ ----- Method: ListChooser class>>chooseItemFrom:title: (in category 'instance creation') -----
+ chooseItemFrom: aList title: aString
+ ^ self
+ chooseItemFrom: aList
+ title: aString
+ addAllowed: false!

Item was added:
+ ----- Method: ListChooser class>>chooseItemFrom:title:addAllowed: (in category 'instance creation') -----
+ chooseItemFrom: aList title: aString addAllowed: aBoolean
+ ^ self new
+ chooseItemFrom: aList
+ title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
+ addAllowed: aBoolean!

Item was added:
+ ----- Method: ListChooser class>>defaultTitle (in category 'instance creation') -----
+ defaultTitle
+ ^ 'Please choose:'!

Item was added:
+ ----- Method: ListChooser class>>testDictionary (in category 'examples') -----
+ testDictionary
+ ^ self
+ chooseItemFrom: (Dictionary newFrom: {#a->1. 2->#b.})
+ title: 'Pick from Dictionary' "gives values, not keys"!

Item was added:
+ ----- Method: ListChooser class>>testIndex (in category 'examples') -----
+ testIndex
+ ^ self
+ chooseIndexFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection
+ title: 'Pick a class'!

Item was added:
+ ----- Method: ListChooser class>>testItem (in category 'examples') -----
+ testItem
+ ^ self
+ chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection
+ title: 'Pick a class'!

Item was added:
+ ----- Method: ListChooser class>>testItemAdd (in category 'examples') -----
+ testItemAdd
+ ^ self
+ chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection
+ title: 'Pick or Add:'
+ addAllowed: true!

Item was added:
+ ----- Method: ListChooser class>>testLongTitle (in category 'examples') -----
+ testLongTitle
+ ^ self
+ chooseItemFrom: #(this is a list of values that aren/t the point here)
+ title: 'Pick from some values from this list'!

Item was added:
+ ----- Method: ListChooser class>>testSet (in category 'examples') -----
+ testSet
+ ^ self
+ chooseItemFrom: #(a list of values as a Set) asSet
+ title: 'Pick from Set'!

Item was added:
+ ----- Method: ListChooser>>accept (in category 'event handling') -----
+ accept
+ "if the user submits with no valid entry, make them start over"
+ self canAccept ifFalse: [
+ searchMorph selectAll.
+ ^ self ].
+
+ "find the selected item in the original list, and return it"
+ result := selectedItems at: index.
+
+ builder ifNotNil: [ :bldr |
+ builder := nil.
+ bldr close: window ]!

Item was added:
+ ----- Method: ListChooser>>acceptColor (in category 'drawing') -----
+ acceptColor
+ ^ self canAccept
+ ifTrue: [ ColorTheme current okColor ]
+ ifFalse: [ Color lightGray "ColorTheme current disabledColor <- you don't have this!!" ]!

Item was added:
+ ----- Method: ListChooser>>acceptText: (in category 'event handling') -----
+ acceptText: someText
+ "the text morph wants to tell us about its contents but I don't care, I'm only interested in the list"
+ self accept!

Item was added:
+ ----- Method: ListChooser>>add (in category 'event handling') -----
+ add
+ "if the user submits with no valid entry, make them start over"
+ self canAdd ifFalse: [
+ searchMorph selectAll.
+ ^ self ].
+
+ "find the string to return"
+ result := searchMorph getText.
+
+ builder ifNotNil: [ :bldr |
+ builder := nil.
+ bldr close: window ]!

Item was added:
+ ----- Method: ListChooser>>buildButtonBarWith: (in category 'building') -----
+ buildButtonBarWith: builder
+ | panel button |
+ panel := builder pluggablePanelSpec new
+ model: self;
+ layout: #proportional;
+ children: OrderedCollection new.
+ button := builder pluggableButtonSpec new.
+ button
+ model: self;
+ label: 'Accept (s)';
+ action: #accept;
+ enabled: #canAccept;
+ state: #canAccept;
+ color: #acceptColor;
+ frame: (0.0 @ 0.0 corner: 0.34@1).
+ panel children add: button.
+
+ button := builder pluggableButtonSpec new.
+ button
+ model: self;
+ label: 'Add (a)';
+ action: #add;
+ enabled: #canAdd;
+ frame: (0.36 @ 0.0 corner: 0.63@1).
+ panel children add: button.
+
+ button := builder pluggableButtonSpec new.
+ button
+ model: self;
+ label: 'Cancel (l)';
+ action: #cancel;
+ color: #cancelColor;
+ frame: (0.65 @ 0.0 corner: 1@1).
+ panel children add: button.
+
+ ^ panel!

Item was added:
+ ----- Method: ListChooser>>buildListMorphWith: (in category 'building') -----
+ buildListMorphWith: builder
+ | listSpec |
+ listSpec := builder pluggableListSpec new.
+ listSpec
+ model: self;
+ list: #list;
+ getIndex: #selectedIndex;
+ setIndex: #selectedIndex:;
+ doubleClick: #accept;
+ "handleBasicKeys: false;"
+ keystrokePreview: #keyStrokeFromList:;
+ "doubleClickSelector: #accept;"
+ autoDeselect: false.
+ ^ listSpec!

Item was added:
+ ----- Method: ListChooser>>buildSearchMorphWith: (in category 'building') -----
+ buildSearchMorphWith: builder
+ | fieldSpec |
+ fieldSpec := builder pluggableInputFieldSpec new.
+ fieldSpec
+ model: self;
+ getText: #searchText;
+ setText: #acceptText:;
+ menu: nil.
+ "hideScrollBarsIndefinitely;"
+ "acceptOnCR: true;"
+ "setBalloonText: 'Type a string to filter down the listed items'."
+ "onKeyStrokeSend: #keyStroke: to: self."
+ ^ fieldSpec!

Item was added:
+ ----- Method: ListChooser>>buildWindowWith: (in category 'building') -----
+ buildWindowWith: builder
+ | windowSpec |
+ windowSpec := builder pluggableWindowSpec new.
+ windowSpec model: self.
+ windowSpec label: #title.
+ windowSpec children: OrderedCollection new.
+ ^windowSpec!

Item was added:
+ ----- Method: ListChooser>>buildWindowWith:specs: (in category 'building') -----
+ buildWindowWith: builder specs: specs
+ | windowSpec |
+ windowSpec := self buildWindowWith: builder.
+ specs do: [ :assoc |
+ | rect action widgetSpec |
+ rect := assoc key.
+ action := assoc value.
+ widgetSpec := action value.
+ widgetSpec ifNotNil:[
+ widgetSpec frame: rect.
+ windowSpec children add: widgetSpec ] ].
+ ^ windowSpec!

Item was added:
+ ----- Method: ListChooser>>buildWith: (in category 'building') -----
+ buildWith: aBuilder
+ | windowSpec |
+ builder := aBuilder.
+ windowSpec := self buildWindowWith: builder specs: {
+ (0@0 corner: 1@0.05) -> [self buildSearchMorphWith: builder].
+ (0@0.05 corner: 1@0.9) -> [self buildListMorphWith: builder].
+ (0@0.9 corner: 1@1) -> [self buildButtonBarWith: builder].
+ }.
+ windowSpec closeAction: #closed.
+ windowSpec extent: self initialExtent.
+ window := builder build: windowSpec.
+
+
+ searchMorph := window submorphs detect:
+ [ :each | each isKindOf: PluggableTextMorph ].
+ searchMorph
+ hideScrollBarsIndefinitely;
+ acceptOnCR: true;
+ setBalloonText: 'Type a string to filter down the listed items';
+ onKeyStrokeSend: #keyStroke: to: self;
+ hasUnacceptedEdits: true "force acceptOnCR to work even with no text entered".
+ listMorph := window submorphs detect:
+ [ :each | each isKindOf: PluggableListMorph ].
+ ^ window!

Item was added:
+ ----- Method: ListChooser>>canAccept (in category 'testing') -----
+ canAccept
+ ^ self selectedIndex > 0!

Item was added:
+ ----- Method: ListChooser>>canAdd (in category 'testing') -----
+ canAdd
+ ^ addAllowed and: [ self canAccept not ]!

Item was added:
+ ----- Method: ListChooser>>cancel (in category 'event handling') -----
+ cancel
+ "Cancel the dialog and move on"
+ index := 0.
+ builder ifNotNil: [ builder close: window ]!

Item was added:
+ ----- Method: ListChooser>>cancelColor (in category 'drawing') -----
+ cancelColor
+ ^ ColorTheme current cancelColor!

Item was added:
+ ----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') -----
+ chooseIndexFrom: labelList title: aString
+ | choice |
+ choice := self chooseItemFrom: labelList title: aString addAllowed: false.
+ ^ fullList indexOf: choice ifAbsent: 0!

Item was added:
+ ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') -----
+ chooseIndexFrom: labelList title: aString addAllowed: aBoolean
+ | choice |
+ choice := self chooseItemFrom: labelList title: aString addAllowed: false.
+ addAllowed := aBoolean.
+ ^ fullList indexOf: choice ifAbsent: 0!

Item was added:
+ ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') -----
+ chooseItemFrom: labelList title: aString addAllowed: aBoolean
+ fullList := labelList asOrderedCollection. "coerce everything into an OC"
+ builder := ToolBuilder default.
+ self list: fullList.
+ self title: aString.
+ addAllowed := aBoolean.
+ window := ToolBuilder default open: self.
+ window center: Sensor cursorPoint.
+ window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false.
+ builder runModal: window.
+ ^ result!

Item was added:
+ ----- Method: ListChooser>>closed (in category 'event handling') -----
+ closed
+ "Cancel the dialog and move on"
+ builder ifNotNil: [ index := 0 ]!

Item was added:
+ ----- Method: ListChooser>>handlesKeyboard: (in category 'event handling') -----
+ handlesKeyboard: evt
+ ^ true!

Item was added:
+ ----- Method: ListChooser>>initialExtent (in category 'building') -----
+ initialExtent
+ | listFont titleFont buttonFont listWidth titleWidth buttonWidth |
+ listFont := Preferences standardListFont.
+ titleFont := Preferences windowTitleFont.
+ buttonFont := Preferences standardButtonFont.
+ listWidth := 20 * (listFont widthOf: $m).
+ titleWidth := titleFont widthOfString: self title, '__________'. "add some space for titlebar icons"
+ buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add (a)___Cancel_(l)_'.
+ ^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont height))!

Item was added:
+ ----- Method: ListChooser>>keyStroke: (in category 'event handling') -----
+ keyStroke: event
+ | newText key |
+ "handle updates to the search box interactively"
+ key := event keyString.
+ (key = '<up>') ifTrue: [
+ self move: -1.
+ ^ self ].
+ (key = '<down>') ifTrue: [
+ self move: 1.
+ ^ self ].
+
+ (key = '<Cmd-s>') ifTrue: [ self accept. ^ self ].
+ (key = '<cr>') ifTrue: [ self accept. ^ self ].
+
+ (key = '<escape>') ifTrue: [ self cancel. ^ self ].
+ (key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ].
+
+ (key = '<Cmd-a>') ifTrue: [ self add. ^ self ].
+
+ "pull out what's been typed, and update the list as required"
+ newText := searchMorph textMorph asText asString.
+ (newText = searchText) ifFalse: [
+ searchText := newText.
+ self updateFilter ].
+ !

Item was added:
+ ----- Method: ListChooser>>keyStrokeFromList: (in category 'event handling') -----
+ keyStrokeFromList: event
+ "we don't want the list to be picking up events, excepting scroll events"
+
+ "Don't sent ctrl-up/ctrl-down events to the searchMorph: they're scrolling events."
+ (#(30 31) contains: [:each | each = event keyValue]) not
+ ifTrue:
+ ["window world primaryHand keyboardFocus: searchMorph."
+ searchMorph keyStroke: event.
+ "let the list know we've dealt with it"
+ ^true].
+ ^false.
+ !

Item was added:
+ ----- Method: ListChooser>>list (in category 'accessing') -----
+ list
+ ^ selectedItems!

Item was added:
+ ----- Method: ListChooser>>list: (in category 'accessing') -----
+ list: items
+ fullList := items.
+ selectedItems := items.
+ self changed: #itemList.!

Item was added:
+ ----- Method: ListChooser>>list:title: (in category 'accessing') -----
+ list: aList title: aString
+ self list: aList.
+ self title: aString!

Item was added:
+ ----- Method: ListChooser>>move: (in category 'event handling') -----
+ move: offset
+ | newindex |
+ "The up arrow key moves the cursor, and it seems impossible to restore.
+ So, for consistency, on either arrow, select everything, so a new letter-press starts over. yuk."
+ searchMorph selectAll.
+
+ newindex := self selectedIndex + offset.
+ newindex > selectedItems size ifTrue: [ ^ nil ].
+ newindex < 1 ifTrue: [ ^ nil ].
+ self selectedIndex: newindex.
+ !

Item was added:
+ ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') -----
+ moveWindowNear: aPoint
+ | trialRect delta |
+ trialRect := Rectangle center: aPoint extent: window fullBounds extent.
+ delta := trialRect amountToTranslateWithin: World bounds.
+ window position: trialRect origin + delta.!

Item was added:
+ ----- Method: ListChooser>>realIndex (in category 'accessing') -----
+ realIndex
+ ^ realIndex ifNil: [ 0 ]!

Item was added:
+ ----- Method: ListChooser>>searchText (in category 'accessing') -----
+ searchText
+ ^ searchText ifNil: [ searchText := '' ]!

Item was added:
+ ----- Method: ListChooser>>searchText: (in category 'accessing') -----
+ searchText: aString
+ searchText := aString!

Item was added:
+ ----- Method: ListChooser>>selectedIndex (in category 'accessing') -----
+ selectedIndex
+ ^ index ifNil: [ index := 1 ]!

Item was added:
+ ----- Method: ListChooser>>selectedIndex: (in category 'accessing') -----
+ selectedIndex: anInt
+ index := (anInt min: selectedItems size).
+ self changed: #selectedIndex.
+ self changed: #canAccept.!

Item was added:
+ ----- Method: ListChooser>>title (in category 'accessing') -----
+ title
+ ^ title ifNil: [ title := 'Please choose' ]!

Item was added:
+ ----- Method: ListChooser>>title: (in category 'accessing') -----
+ title: aString
+ title := aString.!

Item was added:
+ ----- Method: ListChooser>>updateFilter (in category 'event handling') -----
+ updateFilter
+
+ selectedItems :=
+ searchText isEmptyOrNil
+ ifTrue: [ fullList ]
+ ifFalse: [ | pattern patternMatches prefixMatches |
+ pattern := (searchText includes: $*)
+ ifTrue: [ searchText ]
+ ifFalse: [ '*', searchText, '*' ].
+ patternMatches := fullList select: [:s | pattern match: s ].
+ prefixMatches := OrderedCollection new: patternMatches size.
+ patternMatches removeAllSuchThat: [ :each |
+ (each findString: searchText startingAt: 1 caseSensitive: false) = 1
+ and: [
+ prefixMatches add: each.
+ true ] ].
+ prefixMatches addAllLast: patternMatches; yourself].
+ self changed: #list.
+ self selectedIndex: 1.
+ self changed: #selectedIndex.!

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

Item was added:
+ ----- Method: MorphicToolBuilder class>>isActiveBuilder (in category 'accessing') -----
+ isActiveBuilder
+ "Answer whether I am the currently active builder"
+ ^Smalltalk isMorphic!

Item was added:
+ ----- Method: MorphicToolBuilder>>add:to: (in category 'private') -----
+ add: aMorph to: aParent
+ aParent addMorphBack: aMorph.
+ aParent isSystemWindow ifTrue:[
+ aParent addPaneMorph: aMorph.
+ ].!

Item was added:
+ ----- Method: MorphicToolBuilder>>alternateMultiSelectListClass (in category 'widget classes') -----
+ alternateMultiSelectListClass
+ ^ AlternatePluggableListMorphOfMany !

Item was added:
+ ----- Method: MorphicToolBuilder>>asFrame: (in category 'private') -----
+ asFrame: aRectangle
+ | frame |
+ aRectangle ifNil:[^nil].
+ frame := LayoutFrame new.
+ frame
+ leftFraction: aRectangle left;
+ rightFraction: aRectangle right;
+ topFraction: aRectangle top;
+ bottomFraction: aRectangle bottom.
+ ^frame!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildHelpFor:spec: (in category 'pluggable widgets') -----
+ buildHelpFor: widget spec: aSpec
+ aSpec help
+ ifNotNil: [widget setBalloonText: aSpec help]!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableActionButton: (in category 'pluggable widgets') -----
+ buildPluggableActionButton: aSpec
+ | button |
+ button := self buildPluggableButton: aSpec.
+ button color: Color white.
+ ^button!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableAlternateMultiSelectionList: (in category 'pluggable widgets') -----
+ buildPluggableAlternateMultiSelectionList: aSpec
+ | listMorph listClass |
+ aSpec getSelected ifNotNil: [ ^ self error: 'There is no PluggableAlternateListMorphOfManyByItem' ].
+ listClass := self alternateMultiSelectListClass.
+ listMorph := listClass
+ on: aSpec model
+ list: aSpec list
+ primarySelection: aSpec getIndex
+ changePrimarySelection: aSpec setIndex
+ listSelection: aSpec getSelectionList
+ changeListSelection: aSpec setSelectionList
+ menu: aSpec menu.
+ listMorph
+ setProperty: #highlightSelector toValue: #highlightMessageList:with: ;
+ setProperty: #itemConversionMethod toValue: #asStringOrText ;
+ setProperty: #balloonTextSelectorForSubMorphs toValue: #balloonTextForClassAndMethodString ;
+ enableDragNDrop: SystemBrowser browseWithDragNDrop ;
+ menuTitleSelector: #messageListSelectorTitle.
+ self
+ register: listMorph
+ id: aSpec name.
+ listMorph
+ keystrokeActionSelector: aSpec keyPress ;
+ getListElementSelector: aSpec listItem ;
+ getListSizeSelector: aSpec listSize.
+ self
+ buildHelpFor: listMorph
+ spec: aSpec.
+ self
+ setFrame: aSpec frame
+ in: listMorph.
+ parent ifNotNil: [ self add: listMorph to: parent ].
+ panes ifNotNil: [ aSpec list ifNotNil:[panes add: aSpec list ] ].
+ ^ listMorph!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableButton: (in category 'pluggable widgets') -----
+ buildPluggableButton: aSpec
+ | widget label state action enabled |
+ label := aSpec label.
+ state := aSpec state.
+ action := aSpec action.
+ widget := self buttonClass on: aSpec model
+ getState: (state isSymbol ifTrue:[state])
+ action: nil
+ label: (label isSymbol ifTrue:[label]).
+ widget style: aSpec style.
+ aSpec changeLabelWhen
+ ifNotNilDo: [ :event | widget whenChanged: event update: aSpec label].
+ self register: widget id: aSpec name.
+ enabled := aSpec enabled.
+ enabled isSymbol
+ ifTrue:[widget getEnabledSelector: enabled]
+ ifFalse:[widget enabled:enabled].
+ widget action: action.
+ widget getColorSelector: aSpec color.
+ widget offColor: Color white..
+ self buildHelpFor: widget spec: aSpec.
+ (label isSymbol or:[label == nil]) ifFalse:[widget label: label].
+ self setFrame: aSpec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableCheckBox: (in category 'pluggable widgets') -----
+ buildPluggableCheckBox: spec
+
+ | widget label state action |
+ label := spec label.
+ state := spec state.
+ action := spec action.
+ widget := self checkBoxClass on: spec model
+ getState: (state isSymbol ifTrue:[state])
+ action: (action isSymbol ifTrue:[action])
+ label: (label isSymbol ifTrue:[label]).
+ self register: widget id: spec name.
+
+ widget installButton.
+ " widget getColorSelector: spec color.
+ widget offColor: Color white..
+ self buildHelpFor: widget spec: spec.
+ (label isSymbol or:[label == nil]) ifFalse:[widget label: label].
+ " self setFrame: spec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableCodePane: (in category 'pluggable widgets') -----
+ buildPluggableCodePane: aSpec
+ "Install the default styler for code panes.
+ Implementation note: We should just be doing something like, e.g.,
+ ^(self buildPluggableText: aSpec) useDefaultStyler
+ Unfortunately, this will retrieve and layout the initial text twice which
+ can make for a noticable performance difference when looking at some
+ larger piece of code. So instead we copy the implementation from
+ buildPlugggableText: here and insert #useDefaultStyler at the right point"
+ | widget |
+ widget := self codePaneClass new.
+ widget useDefaultStyler.
+ widget on: aSpec model
+ text: aSpec getText
+ accept: aSpec setText
+ readSelection: aSpec selection
+ menu: aSpec menu.
+ widget font: Preferences standardCodeFont.
+ self register: widget id: aSpec name.
+ widget getColorSelector: aSpec color.
+ self setFrame: aSpec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ widget borderColor: Color lightGray.
+ widget color: Color white.
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableDropDownList: (in category 'pluggable widgets') -----
+ buildPluggableDropDownList: spec
+
+ | widget model listSelector selectionSelector selectionSetter |
+ model := spec model.
+ listSelector := spec listSelector.
+ selectionSelector := spec selectionSelector.
+ selectionSetter := spec selectionSetter.
+ widget := self dropDownListClass new
+ model: model;
+ listSelector: listSelector;
+ selectionSelector: selectionSelector;
+ selectionSetter: selectionSetter;
+ yourself.
+ self register: widget id: spec name.
+
+ widget installDropDownList.
+ self setFrame: spec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableInputField: (in category 'pluggable widgets') -----
+ buildPluggableInputField: aSpec
+ | widget |
+ widget := self buildPluggableText: aSpec.
+ widget acceptOnCR: true.
+ widget hideScrollBarsIndefinitely.
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableList: (in category 'pluggable widgets') -----
+ buildPluggableList: aSpec
+ | widget listClass getIndex setIndex |
+ aSpec getSelected ifNil:[
+ listClass := self listClass.
+ getIndex := aSpec getIndex.
+ setIndex := aSpec setIndex.
+ ] ifNotNil:[
+ listClass := self listByItemClass.
+ 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.
+ widget getListElementSelector: aSpec listItem.
+ widget getListSizeSelector: aSpec listSize.
+ widget getIconSelector: aSpec icon.
+ widget doubleClickSelector: aSpec doubleClick.
+ widget dragItemSelector: aSpec dragItem.
+ widget dropItemSelector: aSpec dropItem.
+ widget wantsDropSelector: aSpec dropAccept.
+ widget autoDeselect: aSpec autoDeselect.
+ widget keystrokePreviewSelector: aSpec keystrokePreview.
+ aSpec color isNil
+ ifTrue: [widget
+ borderWidth: 1;
+ borderColor: Color lightGray;
+ color: Color white]
+ ifFalse: [widget color: aSpec color].
+ self buildHelpFor: widget spec: aSpec.
+ self setFrame: aSpec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ panes ifNotNil:[
+ aSpec list ifNotNil:[panes add: aSpec list].
+ ].
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableMenu: (in category 'building') -----
+ buildPluggableMenu: menuSpec
+ | prior menu |
+ prior := parentMenu.
+ parentMenu := menu := self menuClass new.
+ menuSpec label ifNotNil:[parentMenu addTitle: menuSpec label].
+ menuSpec items do:[:each| each buildWith: self].
+ parentMenu := prior.
+ ^menu!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableMenuItem: (in category 'building') -----
+ buildPluggableMenuItem: itemSpec
+ | item action label menu |
+ item := self menuItemClass new.
+ label := (itemSpec isCheckable
+ ifTrue: [ itemSpec checked ifTrue: ['<on>'] ifFalse: ['<off>']]
+ ifFalse: ['']), itemSpec label.
+ item contents: label.
+ item isEnabled: itemSpec enabled.
+ (action := itemSpec action) ifNotNil:[
+ item
+ target: action receiver;
+ selector: action selector;
+ arguments: action arguments.
+ ].
+ (menu := itemSpec subMenu) ifNotNil:[
+ item subMenu: (menu buildWith: self).
+ ].
+ parentMenu ifNotNil:[parentMenu addMorphBack: item].
+ itemSpec separator ifTrue:[parentMenu addLine].
+ ^item!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableMultiSelectionList: (in category 'pluggable widgets') -----
+ buildPluggableMultiSelectionList: aSpec
+ | widget listClass |
+ aSpec getSelected ifNotNil:[^self error:'There is no PluggableListMorphOfManyByItem'].
+ listClass := self multiSelectListClass.
+ widget := listClass on: aSpec model
+ list: aSpec list
+ primarySelection: aSpec getIndex
+ changePrimarySelection: aSpec setIndex
+ listSelection: aSpec getSelectionList
+ changeListSelection: aSpec setSelectionList
+ menu: aSpec menu.
+ self register: widget id: aSpec name.
+ widget keystrokeActionSelector: aSpec keyPress.
+ widget getListElementSelector: aSpec listItem.
+ widget getListSizeSelector: aSpec listSize.
+ self buildHelpFor: widget spec: aSpec.
+ self setFrame: aSpec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ panes ifNotNil:[
+ aSpec list ifNotNil:[panes add: aSpec list].
+ ].
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggablePanel: (in category 'pluggable widgets') -----
+ buildPluggablePanel: aSpec
+ | widget children frame |
+ widget := self panelClass new.
+ self register: widget id: aSpec name.
+ widget model: aSpec model.
+ widget color: Color transparent.
+ widget clipSubmorphs: true.
+ children := aSpec children.
+ children isSymbol ifTrue:[
+ widget getChildrenSelector: children.
+ widget update: children.
+ children := #().
+ ].
+ self buildAll: children in: widget.
+ self buildHelpFor: widget spec: aSpec.
+ self setFrame: aSpec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ self setLayout: aSpec layout in: widget.
+ widget layoutInset: 0.
+ widget borderWidth: 0.
+ widget submorphsDo:[:sm|
+ (frame := sm layoutFrame) ifNotNil:[
+ (frame rightFraction = 0 or:[frame rightFraction = 1])
+ ifFalse:[frame rightOffset:1].
+ (frame bottomFraction = 0 or:[frame bottomFraction = 1])
+ ifFalse:[frame bottomOffset: 1]]].
+ widget color: Color transparent.
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableText: (in category 'pluggable widgets') -----
+ buildPluggableText: aSpec
+ | widget |
+ widget := self textPaneClass on: aSpec model
+ text: aSpec getText
+ accept: aSpec setText
+ readSelection: aSpec selection
+ menu: aSpec menu.
+ widget askBeforeDiscardingEdits: aSpec askBeforeDiscardingEdits.
+ widget font: Preferences standardCodeFont.
+ self register: widget id: aSpec name.
+ widget getColorSelector: aSpec color.
+ self buildHelpFor: widget spec: aSpec.
+ self setFrame: aSpec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ widget borderColor: Color lightGray.
+ widget color: Color white.
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableTree: (in category 'pluggable widgets') -----
+ buildPluggableTree: aSpec
+ | widget |
+ widget := self treeClass new.
+ self register: widget id: aSpec name.
+ widget model: aSpec model.
+ widget getSelectedPathSelector: aSpec getSelectedPath.
+ widget setSelectedSelector: aSpec setSelected.
+ widget getChildrenSelector: aSpec getChildren.
+ widget hasChildrenSelector: aSpec hasChildren.
+ widget getLabelSelector: aSpec label.
+ widget getIconSelector: aSpec icon.
+ widget getHelpSelector: aSpec help.
+ widget getMenuSelector: aSpec menu.
+ widget keystrokeActionSelector: aSpec keyPress.
+ widget getRootsSelector: aSpec roots.
+ widget autoDeselect: aSpec autoDeselect.
+ widget dropItemSelector: aSpec dropItem.
+ widget wantsDropSelector: aSpec dropAccept.
+ widget dragItemSelector: aSpec dragItem.
+ self setFrame: aSpec frame in: widget.
+ parent ifNotNil:[self add: widget to: parent].
+ " panes ifNotNil:[
+ aSpec roots ifNotNil:[panes add: aSpec roots].
+ ]. "
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableWindow: (in category 'pluggable widgets') -----
+ buildPluggableWindow: aSpec
+ | widget children |
+ aSpec layout == #proportional ifFalse:[
+ "This needs to be implemented - probably by adding a single pane and then the rest"
+ ^self error: 'Not implemented'.
+ ].
+ widget := (self windowClassFor: aSpec) new.
+ self register: widget id: aSpec name.
+ widget model: aSpec model.
+ aSpec label ifNotNil:
+ [:label|
+ label isSymbol
+ ifTrue:[widget getLabelSelector: label]
+ ifFalse:[widget setLabel: label]].
+ aSpec multiWindowStyle notNil ifTrue:
+ [widget savedMultiWindowState: (SavedMultiWindowState on: aSpec model)].
+ children := aSpec children.
+ children isSymbol ifTrue:[
+ widget getChildrenSelector: children.
+ widget update: children.
+ children := #().
+ ].
+ widget closeWindowSelector: aSpec closeAction.
+ panes := OrderedCollection new.
+ self buildAll: children in: widget.
+ self buildHelpFor: widget spec: aSpec.
+ widget bounds: (RealEstateAgent
+ initialFrameFor: widget
+ initialExtent: (aSpec extent ifNil:[widget initialExtent])
+ world: self currentWorld).
+ widget setUpdatablePanesFrom: panes.
+ ^widget!

Item was added:
+ ----- Method: MorphicToolBuilder>>buttonClass (in category 'widget classes') -----
+ buttonClass
+ ^ PluggableButtonMorphPlus!

Item was added:
+ ----- Method: MorphicToolBuilder>>checkBoxClass (in category 'widget classes') -----
+ checkBoxClass
+ ^ PluggableCheckBoxMorph!

Item was added:
+ ----- Method: MorphicToolBuilder>>close: (in category 'opening') -----
+ close: aWidget
+ "Close a previously opened widget"
+ aWidget delete!

Item was added:
+ ----- Method: MorphicToolBuilder>>codePaneClass (in category 'widget classes') -----
+ codePaneClass
+ ^ PluggableTextMorphPlus!

Item was added:
+ ----- Method: MorphicToolBuilder>>dropDownListClass (in category 'widget classes') -----
+ dropDownListClass
+ ^ PluggableDropDownListMorph!

Item was added:
+ ----- Method: MorphicToolBuilder>>listByItemClass (in category 'widget classes') -----
+ listByItemClass
+ ^ PluggableListMorphByItemPlus!

Item was added:
+ ----- Method: MorphicToolBuilder>>listClass (in category 'widget classes') -----
+ listClass
+ ^ PluggableListMorphPlus!

Item was added:
+ ----- Method: MorphicToolBuilder>>menuClass (in category 'widget classes') -----
+ menuClass
+ ^ MenuMorph!

Item was added:
+ ----- Method: MorphicToolBuilder>>menuItemClass (in category 'widget classes') -----
+ menuItemClass
+ ^ MenuItemMorph!

Item was added:
+ ----- Method: MorphicToolBuilder>>multiSelectListClass (in category 'widget classes') -----
+ multiSelectListClass
+ ^ PluggableListMorphOfMany!

Item was added:
+ ----- Method: MorphicToolBuilder>>open: (in category 'opening') -----
+ open: anObject
+ "Build and open the object. Answer the widget opened."
+ | morph |
+ anObject isMorph
+ ifTrue:[morph := anObject]
+ ifFalse:[morph := self build: anObject].
+ (morph isKindOf: MenuMorph)
+ ifTrue:[morph popUpInWorld: World].
+ (morph isKindOf: SystemWindow)
+ ifTrue:[morph openInWorldExtent: morph extent]
+ ifFalse:[morph openInWorld].
+ ^morph!

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

Item was added:
+ ----- Method: MorphicToolBuilder>>panelClass (in category 'widget classes') -----
+ panelClass
+ ^ PluggablePanelMorph!

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

Item was added:
+ ----- Method: MorphicToolBuilder>>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."
+ [aWidget world notNil] whileTrue: [
+ aWidget outermostWorldMorph doOneCycle.
+ ].
+ !

Item was added:
+ ----- Method: MorphicToolBuilder>>setFrame:in: (in category 'private') -----
+ setFrame: aRectangle in: widget
+ | frame |
+ aRectangle ifNil:[^nil].
+ frame := aRectangle isRectangle
+ ifTrue: [self asFrame: aRectangle]
+ ifFalse: [aRectangle]. "assume LayoutFrame"
+ widget layoutFrame: frame.
+ widget hResizing: #spaceFill; vResizing: #spaceFill.
+ (parent isSystemWindow) ifTrue:[
+ widget borderWidth: 2; borderColor: #inset.
+ ].!

Item was added:
+ ----- Method: MorphicToolBuilder>>setLayout:in: (in category 'private') -----
+ setLayout: layout in: widget
+ layout == #proportional ifTrue:[
+ widget layoutPolicy: ProportionalLayout new.
+ ^self].
+ layout == #horizontal ifTrue:[
+ widget layoutPolicy: TableLayout new.
+ widget listDirection: #leftToRight.
+ widget submorphsDo:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
+ widget cellInset: 1@1.
+ widget layoutInset: 1@1.
+ widget color: Color transparent.
+ "and then some..."
+ ^self].
+ layout == #vertical ifTrue:[
+ widget layoutPolicy: TableLayout new.
+ widget listDirection: #topToBottom.
+ widget submorphsDo:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
+ widget cellInset: 1@1.
+ widget layoutInset: 1@1.
+ widget color: Color transparent.
+ "and then some..."
+ ^self].
+ ^self error: 'Unknown layout: ', layout.!

Item was added:
+ ----- Method: MorphicToolBuilder>>textPaneClass (in category 'widget classes') -----
+ textPaneClass
+ ^ PluggableTextMorphPlus!

Item was added:
+ ----- Method: MorphicToolBuilder>>treeClass (in category 'widget classes') -----
+ treeClass
+ ^ PluggableTreeMorph!

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

Item was added:
+ ----- Method: MorphicToolBuilder>>windowClass (in category 'widget classes') -----
+ windowClass
+ ^ PluggableSystemWindow!

Item was added:
+ ----- Method: MorphicToolBuilder>>windowClassFor: (in category 'widget classes') -----
+ windowClassFor: aSpec
+ aSpec isDialog ifTrue: [^ PluggableDialogWindow].
+ ^aSpec multiWindowStyle
+ caseOf:
+ { [nil] -> [PluggableSystemWindow].
+ [#labelButton] -> [PluggableSystemWindowWithLabelButton] }
+ otherwise: [PluggableSystemWindowWithLabelButton]!

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

Item was added:
+ ----- Method: MorphicUIManager class>>isActiveManager (in category 'accessing') -----
+ isActiveManager
+ "Answer whether I should act as the active ui manager"
+ ^Smalltalk isMorphic!

Item was added:
+ ----- Method: MorphicUIManager>>chooseClassOrTrait:from: (in category 'ui requests') -----
+ chooseClassOrTrait: label from: environment
+ "Let the user choose a Class or Trait. Use ListChooser in Morphic."
+
+ | names index |
+ names := environment classAndTraitNames.
+ index := self
+ chooseFrom: names
+ lines: #()
+ title: label.
+ index = 0 ifTrue: [ ^nil ].
+ ^environment
+ at: (names at: index)
+ ifAbsent: [ nil ]!

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

Item was added:
+ ----- Method: MorphicUIManager>>chooseFileMatching:label: (in category 'ui requests') -----
+ chooseFileMatching: patterns label: aString
+ "Let the user choose a file matching the given patterns"
+ | result |
+ result := FileList2 modalFileSelectorForSuffixes: patterns.
+ ^result ifNotNil:[result fullName]!

Item was added:
+ ----- Method: MorphicUIManager>>chooseFont:for:setSelector:getSelector: (in category 'ui requests') -----
+ chooseFont: titleString for: aModel setSelector: setSelector getSelector: getSelector
+ "Open a font-chooser for the given model"
+ ^FontChooserTool default
+ openWithWindowTitle: titleString
+ for: aModel
+ setSelector: setSelector
+ getSelector: getSelector!

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ ^ aList size > 30
+ ifTrue:
+ [ "Don't put more than 30 items in a menu.  Use ListChooser insted"
+ ListChooser
+ chooseFrom: aList
+ title: aString ]
+ ifFalse:
+ [ MenuMorph
+ chooseFrom: aList
+ lines: linesArray
+ title: aString ]!

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ | index |
+ ^ labelList size > 30
+ ifTrue:
+ [ "No point in displaying more than 30 items in a menu.  Use ListChooser insted"
+ index := ListChooser
+ chooseFrom: labelList
+ title: aString.
+ index = 0 ifFalse: [ valueList at: index ] ]
+ ifFalse:
+ [ MenuMorph
+ chooseFrom: labelList
+ values: valueList
+ lines: linesArray
+ title: aString ]!

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ ^UserDialogBoxMorph confirm: queryString!

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ ^UserDialogBoxMorph confirm: aString orCancel: cancelBlock!

Item was added:
+ ----- Method: MorphicUIManager>>confirm:trueChoice:falseChoice: (in category 'ui requests') -----
+ 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."
+ ^ UserDialogBoxMorph confirm: queryString trueChoice: trueChoice falseChoice: falseChoice !

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ | result progress |
+ progress := SystemProgressMorph
+ position: aPoint
+ label: titleString
+ min: minVal
+ max: maxVal.
+ [ [ result := workBlock value: progress ]
+ on: ProgressNotification
+ do:
+ [ : ex | ex extraParam isString ifTrue:
+ [ SystemProgressMorph uniqueInstance
+ labelAt: progress
+ put: ex extraParam ].
+ ex resume ] ] ensure: [ SystemProgressMorph close: progress ].
+ ^ result!

Item was added:
+ ----- Method: MorphicUIManager>>edit:label:accept: (in category 'ui requests') -----
+ edit: aText label: labelString accept: anAction
+ "Open an editor on the given string/text"
+ | window |
+ window := Workspace open.
+ labelString ifNotNil: [ window setLabel: labelString ].
+ "By default, don't style in UIManager edit: requests"
+ window model
+ shouldStyle: false;
+ acceptContents:  aText;
+ acceptAction: anAction.
+ ^window.!

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

Item was added:
+ ----- Method: MorphicUIManager>>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]]"
+ SystemProgressMorph
+ informUserAt: nil during: aBlock.!

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

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ ^FillInTheBlankMorph
+ request: queryString
+ initialAnswer: defaultAnswer
+ centerAt: aPoint
+ inWorld: self currentWorld
+ onCancelReturn: nil
+ acceptOnCR: false!

Item was added:
+ ----- Method: MorphicUIManager>>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"
+
+ 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.
+
+ DisplayScreen startUp!

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ ^FillInTheBlankMorph request: queryString initialAnswer: defaultAnswer !

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ ^FillInTheBlankMorph request: queryString initialAnswer: defaultAnswer centerAt: aPoint!

Item was added:
+ ----- Method: MorphicUIManager>>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."
+ ^FillInTheBlankMorph requestPassword: queryString!

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

Item was added:
+ ----- Method: MorphicUIManager>>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!

Item was added:
+ PluggableButtonMorph subclass: #PluggableButtonMorphPlus
+ instanceVariableNames: 'enabled action getColorSelector getEnabledSelector updateMap'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !PluggableButtonMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0!
+ An extended version of PluggableButtonMorph supporting enablement, color and block/message actions.!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>action (in category 'accessing') -----
+ action
+ ^action!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>action: (in category 'accessing') -----
+ action: anAction
+ action := nil.
+ anAction isSymbol ifTrue:[^super action: anAction].
+ action := anAction.!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>enabled (in category 'accessing') -----
+ enabled
+ ^ enabled ifNil: [enabled := true]!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>enabled: (in category 'accessing') -----
+ enabled: aBool
+ enabled := aBool.
+ enabled
+ ifFalse:[self color: Color gray]
+ ifTrue:[self getModelState
+ ifTrue: [self color: onColor]
+ ifFalse: [self color: offColor]]!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>getColorSelector (in category 'accessing') -----
+ getColorSelector
+ ^getColorSelector!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>getColorSelector: (in category 'accessing') -----
+ getColorSelector: aSymbol
+ getColorSelector := aSymbol.
+ self update: getColorSelector.!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>getEnabledSelector (in category 'accessing') -----
+ getEnabledSelector
+ ^getEnabledSelector!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>getEnabledSelector: (in category 'accessing') -----
+ getEnabledSelector: aSymbol
+ getEnabledSelector := aSymbol.
+ self update: aSymbol.!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>initialize (in category 'initialize-release') -----
+ initialize
+ super initialize.
+ enabled := true.
+ onColor := Color veryLightGray.
+ offColor := Color white!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>mouseDown: (in category 'action') -----
+ mouseDown: evt
+ enabled ifFalse:[^self].
+ ^super mouseDown: evt!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>mouseMove: (in category 'action') -----
+ mouseMove: evt
+ enabled ifFalse:[^self].
+ ^super mouseMove: evt!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>mouseUp: (in category 'action') -----
+ mouseUp: evt
+ enabled ifFalse:[^self].
+ ^super mouseUp: evt!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>onColor:offColor: (in category 'accessing') -----
+ onColor: colorWhenOn offColor: colorWhenOff
+ "Set the fill colors to be used when this button is on/off."
+
+ onColor := colorWhenOn.
+ offColor := colorWhenOff.
+ self update: getStateSelector.!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>performAction (in category 'action') -----
+ performAction
+ enabled ifFalse:[^self].
+ action ifNotNil:[^action value].
+ ^super performAction!

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>update: (in category 'updating') -----
+ update: what
+ what ifNil:[^self].
+ what == getLabelSelector ifTrue: [
+ self label: (model perform: getLabelSelector)].
+ what == getEnabledSelector ifTrue:[^self enabled: (model perform: getEnabledSelector)].
+
+ getColorSelector ifNotNil: [ | cc |
+ color = (cc := model perform: getColorSelector) ifFalse:[
+ color := cc.
+ self onColor: color offColor: color.
+ self changed.
+ ].
+ ].
+ self getModelState
+ ifTrue: [self color: onColor]
+ ifFalse: [self color: offColor].
+ getEnabledSelector ifNotNil:[
+ self enabled: (model perform: getEnabledSelector).
+ ].
+ updateMap ifNotNil:
+ [(updateMap at: what ifAbsent: [])
+ ifNotNilDo: [ :newTarget | ^self update: newTarget]].
+ !

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>updateMap (in category 'updating') -----
+ updateMap
+ ^ updateMap ifNil: [updateMap := Dictionary new]
+ !

Item was added:
+ ----- Method: PluggableButtonMorphPlus>>whenChanged:update: (in category 'updating') -----
+ whenChanged: notification update: target
+ "On receipt of a notification, such as #contents notification from a CodeHolder,
+ invoke an update as if target had been the original notification."
+
+ self updateMap at: notification put: target!

Item was added:
+ AlignmentMorph subclass: #PluggableCheckBoxMorph
+ instanceVariableNames: 'model actionSelector valueSelector label'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!

Item was added:
+ ----- Method: PluggableCheckBoxMorph class>>on:getState:action:label: (in category 'as yet unclassified') -----
+ on: anObject getState: getStateSel action: actionSel label: labelSel
+
+ ^ self new
+ on: anObject
+ getState: getStateSel
+ action: actionSel
+ label: labelSel
+ menu: nil
+ !

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>actionSelector (in category 'accessing') -----
+ actionSelector
+ "Answer the value of actionSelector"
+
+ ^ actionSelector!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>actionSelector: (in category 'accessing') -----
+ actionSelector: anObject
+ "Set the value of actionSelector"
+
+ actionSelector := anObject!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>basicPanel (in category 'installing') -----
+ basicPanel
+ ^BorderedMorph new
+ beTransparent;
+ extent: 0@0;
+ borderWidth: 0;
+ layoutInset: 0;
+ cellInset: 0;
+ layoutPolicy: TableLayout new;
+ listCentering: #topLeft;
+ cellPositioning: #center;
+ hResizing: #spaceFill;
+ vResizing: #shrinkWrap;
+ yourself!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>horizontalPanel (in category 'installing') -----
+ horizontalPanel
+ ^self basicPanel
+ cellPositioning: #center;
+ listDirection: #leftToRight;
+ yourself.!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>installButton (in category 'installing') -----
+ installButton
+
+ | aButton aLabel |
+ aButton := UpdatingThreePhaseButtonMorph checkBox
+ target: self model;
+ actionSelector: self actionSelector;
+ getSelector: self valueSelector;
+ yourself.
+ aLabel := (StringMorph contents: self label translated
+ font: (StrikeFont familyName: TextStyle defaultFont familyName
+ size: TextStyle defaultFont pointSize - 1)).
+ self addMorph: (self horizontalPanel
+ addMorphBack: aButton;
+ addMorphBack: aLabel;
+ yourself).!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>label (in category 'accessing') -----
+ label
+ "Answer the value of label"
+
+ ^ label!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>label: (in category 'accessing') -----
+ label: anObject
+ "Set the value of label"
+
+ label := anObject!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>model (in category 'accessing') -----
+ model
+ "Answer the value of model"
+
+ ^ model.
+ !

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>model: (in category 'accessing') -----
+ model: anObject
+ "Set the value of model"
+
+ model := anObject!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>on:getState:action:label:menu: (in category 'initialization') -----
+ on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel
+
+ self model: anObject.
+ self valueSelector: getStateSel.
+ self actionSelector: actionSel.
+ self label: (self model perform: labelSel).
+ !

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>valueSelector (in category 'accessing') -----
+ valueSelector
+ "Answer the value of valueSelector"
+
+ ^ valueSelector!

Item was added:
+ ----- Method: PluggableCheckBoxMorph>>valueSelector: (in category 'accessing') -----
+ valueSelector: anObject
+ "Set the value of valueSelector"
+
+ valueSelector := anObject!

Item was added:
+ PluggableSystemWindow subclass: #PluggableDialogWindow
+ instanceVariableNames: 'statusValue'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!

Item was added:
+ ----- Method: PluggableDialogWindow>>statusValue (in category 'as yet unclassified') -----
+ statusValue
+ ^statusValue!

Item was added:
+ ----- Method: PluggableDialogWindow>>statusValue: (in category 'as yet unclassified') -----
+ statusValue: val
+ statusValue := val!

Item was added:
+ AlignmentMorph subclass: #PluggableDropDownListMorph
+ instanceVariableNames: 'model listSelector selectionSelector selectionSetter'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>basicPanel (in category 'drawing') -----
+ basicPanel
+ ^BorderedMorph new
+ beTransparent;
+ extent: 0@0;
+ borderWidth: 0;
+ layoutInset: 0;
+ cellInset: 0;
+ layoutPolicy: TableLayout new;
+ listCentering: #topLeft;
+ cellPositioning: #center;
+ hResizing: #spaceFill;
+ vResizing: #shrinkWrap;
+ yourself!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>currentSelection (in category 'accessing') -----
+ currentSelection
+
+ ^ self model perform: selectionSelector!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>currentSelection: (in category 'accessing') -----
+ currentSelection: obj
+
+ ^ self model perform: selectionSetter with: obj!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>horizontalPanel (in category 'drawing') -----
+ horizontalPanel
+ ^self basicPanel
+ cellPositioning: #center;
+ listDirection: #leftToRight;
+ yourself.!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>installDropDownList (in category 'drawing') -----
+ installDropDownList
+
+ | aButton aLabel |
+ aButton := PluggableButtonMorph on: self model getState: nil action: nil.
+ aLabel := (StringMorph contents: self model currentRemoteVatId translated
+ font: (StrikeFont familyName: TextStyle defaultFont familyName
+ size: TextStyle defaultFont pointSize - 1)).
+ self addMorph: (self horizontalPanel
+ addMorphBack: aLabel;
+ addMorphBack: aButton;
+ yourself).!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>list (in category 'accessing') -----
+ list
+ "Answer the value of list"
+
+ ^ self model perform: self listSelector.
+ !

Item was added:
+ ----- Method: PluggableDropDownListMorph>>listSelector (in category 'accessing') -----
+ listSelector
+ "Answer the value of listSelector"
+
+ ^ listSelector!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>listSelector: (in category 'accessing') -----
+ listSelector: anObject
+ "Set the value of listSelector"
+
+ listSelector := anObject!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>model (in category 'accessing') -----
+ model
+ ^ model!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>model: (in category 'accessing') -----
+ model: anObject
+ "Set the value of model"
+
+ model := anObject!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>selectionSelector (in category 'accessing') -----
+ selectionSelector
+ "Answer the value of selectionSelector"
+
+ ^ selectionSelector!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>selectionSelector: (in category 'accessing') -----
+ selectionSelector: anObject
+ "Set the value of selectionSelector"
+
+ selectionSelector := anObject!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>selectionSetter (in category 'accessing') -----
+ selectionSetter
+ "Answer the value of selectionSetter"
+
+ ^ selectionSetter!

Item was added:
+ ----- Method: PluggableDropDownListMorph>>selectionSetter: (in category 'accessing') -----
+ selectionSetter: anObject
+ "Set the value of selectionSetter"
+
+ selectionSetter := anObject!

Item was added:
+ PluggableListMorphPlus subclass: #PluggableListMorphByItemPlus
+ instanceVariableNames: 'itemList'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !PluggableListMorphByItemPlus commentStamp: '<historical>' prior: 0!
+ Main comment stating the purpose of this class and relevant relationship to other classes.
+
+ Possible useful expressions for doIt or printIt.
+
+ Structure:
+  instVar1 type -- comment about the purpose of instVar1
+  instVar2 type -- comment about the purpose of instVar2
+
+ Any further useful comments about the general approach of this implementation.!

Item was added:
+ ----- Method: PluggableListMorphByItemPlus>>changeModelSelection: (in category 'model access') -----
+ changeModelSelection: anInteger
+ "Change the model's selected item to be the one at the given index."
+
+ | item |
+ setIndexSelector ifNotNil: [
+ item := (anInteger = 0 ifTrue: [nil] ifFalse: [itemList at: anInteger]).
+ model perform: setIndexSelector with: item].
+ self update: getIndexSelector.
+ !

Item was added:
+ ----- Method: PluggableListMorphByItemPlus>>getCurrentSelectionIndex (in category 'model access') -----
+ getCurrentSelectionIndex
+ "Answer the index of the current selection."
+ | item |
+ getIndexSelector == nil ifTrue: [^ 0].
+ item := model perform: getIndexSelector.
+ ^ itemList findFirst: [ :x | x = item]
+ !

Item was added:
+ ----- Method: PluggableListMorphByItemPlus>>getList (in category 'as yet unclassified') -----
+ getList
+ "cache the raw items in itemList"
+ itemList := getListSelector ifNil: [ #() ] ifNotNil: [ model perform: getListSelector ].
+ ^super getList!

Item was added:
+ ----- Method: PluggableListMorphByItemPlus>>list: (in category 'initialization') -----
+ list: arrayOfStrings
+ "Set the receivers items to be the given list of strings."
+ "Note: the instance variable 'items' holds the original list.
+ The instance variable 'list' is a paragraph constructed from
+ this list."
+ "NOTE: this is no longer true; list is a real list, and itemList is no longer used.  And this method shouldn't be called, incidentally."
+ self isThisEverCalled .
+ itemList := arrayOfStrings.
+ ^ super list: arrayOfStrings!

Item was added:
+ PluggableListMorph subclass: #PluggableListMorphPlus
+ instanceVariableNames: 'dragItemSelector dropItemSelector wantsDropSelector'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !PluggableListMorphPlus commentStamp: 'ar 7/15/2005 11:10' prior: 0!
+ Extensions for PluggableListMorph needed by ToolBuilder!

Item was added:
+ ----- Method: PluggableListMorphPlus>>acceptDroppingMorph:event: (in category 'drag and drop') -----
+ acceptDroppingMorph: aMorph event: evt
+ | item |
+ dropItemSelector isNil | potentialDropRow isNil ifTrue: [^self].
+ item := aMorph passenger.
+ model perform: dropItemSelector with: item with: potentialDropRow.
+ self resetPotentialDropRow.
+ evt hand releaseMouseFocus: self.
+ Cursor normal show.
+ !

Item was added:
+ ----- Method: PluggableListMorphPlus>>dragItemSelector (in category 'accessing') -----
+ dragItemSelector
+ ^dragItemSelector!

Item was added:
+ ----- Method: PluggableListMorphPlus>>dragItemSelector: (in category 'accessing') -----
+ dragItemSelector: aSymbol
+ dragItemSelector := aSymbol.
+ aSymbol ifNotNil:[self dragEnabled: true].!

Item was added:
+ ----- Method: PluggableListMorphPlus>>dropItemSelector (in category 'accessing') -----
+ dropItemSelector
+ ^dropItemSelector!

Item was added:
+ ----- Method: PluggableListMorphPlus>>dropItemSelector: (in category 'accessing') -----
+ dropItemSelector: aSymbol
+ dropItemSelector := aSymbol.
+ aSymbol ifNotNil:[self dropEnabled: true].!

Item was added:
+ ----- Method: PluggableListMorphPlus>>startDrag: (in category 'drag and drop') -----
+ startDrag: evt
+
+ dragItemSelector ifNil:[^self].
+ evt hand hasSubmorphs ifTrue: [^ self].
+ [ | dragIndex draggedItem ddm |
+ (self dragEnabled and: [model okToChange]) ifFalse: [^ self].
+ dragIndex := self rowAtLocation: evt position.
+ dragIndex = 0 ifTrue:[^self].
+ draggedItem := model perform: dragItemSelector with: (self modelIndexFor: dragIndex).
+ draggedItem ifNil:[^self].
+ ddm := TransferMorph withPassenger: draggedItem from: self.
+ ddm dragTransferType: #dragTransferPlus.
+ evt hand grabMorph: ddm]
+ ensure: [Cursor normal show.
+ evt hand releaseMouseFocus: self]!

Item was added:
+ ----- Method: PluggableListMorphPlus>>wantsDropSelector (in category 'accessing') -----
+ wantsDropSelector
+ ^wantsDropSelector!

Item was added:
+ ----- Method: PluggableListMorphPlus>>wantsDropSelector: (in category 'accessing') -----
+ wantsDropSelector: aSymbol
+ wantsDropSelector := aSymbol!

Item was added:
+ ----- Method: PluggableListMorphPlus>>wantsDroppedMorph:event: (in category 'drag and drop') -----
+ wantsDroppedMorph: aMorph event: anEvent
+ aMorph dragTransferType == #dragTransferPlus ifFalse:[^false].
+ dropItemSelector ifNil:[^false].
+ wantsDropSelector ifNil:[^true].
+ ^(model perform: wantsDropSelector with: aMorph passenger) == true!

Item was added:
+ AlignmentMorph subclass: #PluggablePanelMorph
+ instanceVariableNames: 'model getChildrenSelector'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !PluggablePanelMorph commentStamp: 'ar 2/11/2005 20:13' prior: 0!
+ A pluggable panel morph which deals with changing children.!

Item was added:
+ ----- Method: PluggablePanelMorph>>canBeEncroached (in category 'private') -----
+ canBeEncroached
+ ^ submorphs allSatisfy:
+ [ : each | each canBeEncroached ]!

Item was added:
+ ----- Method: PluggablePanelMorph>>children (in category 'accessing') -----
+ children
+ ^ model perform: getChildrenSelector!

Item was added:
+ ----- Method: PluggablePanelMorph>>getChildrenSelector (in category 'accessing') -----
+ getChildrenSelector
+ ^getChildrenSelector!

Item was added:
+ ----- Method: PluggablePanelMorph>>getChildrenSelector: (in category 'accessing') -----
+ getChildrenSelector: aSymbol
+ getChildrenSelector := aSymbol.!

Item was added:
+ ----- Method: PluggablePanelMorph>>model (in category 'accessing') -----
+ model
+ ^model!

Item was added:
+ ----- Method: PluggablePanelMorph>>model: (in category 'accessing') -----
+ model: aModel
+ model ifNotNil:[model removeDependent: self].
+ model := aModel.
+ model ifNotNil:[model addDependent: self].!

Item was added:
+ ----- Method: PluggablePanelMorph>>update: (in category 'update') -----
+ update: selectorSymbolOrNil
+ selectorSymbolOrNil ifNil: [ ^ self ].
+ selectorSymbolOrNil = getChildrenSelector ifTrue:
+ [ self
+ removeAllMorphs ;
+ addAllMorphs: self children ;
+ submorphsDo:
+ [ : m | m
+ hResizing: #spaceFill ;
+ vResizing: #spaceFill ] ]!

Item was added:
+ SystemWindow subclass: #PluggableSystemWindow
+ instanceVariableNames: 'getLabelSelector getChildrenSelector children closeWindowSelector'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !PluggableSystemWindow commentStamp: 'ar 2/11/2005 20:14' prior: 0!
+ A pluggable system window. Fixes the issues with label retrieval and adds support for changing children.!

Item was added:
+ ----- Method: PluggableSystemWindow>>addPaneMorph: (in category 'accessing') -----
+ addPaneMorph: aMorph
+ self addMorph: aMorph fullFrame: aMorph layoutFrame!

Item was added:
+ ----- Method: PluggableSystemWindow>>closeWindowSelector (in category 'accessing') -----
+ closeWindowSelector
+ ^closeWindowSelector!

Item was added:
+ ----- Method: PluggableSystemWindow>>closeWindowSelector: (in category 'accessing') -----
+ closeWindowSelector: aSymbol
+ closeWindowSelector := aSymbol!

Item was added:
+ ----- Method: PluggableSystemWindow>>delete (in category 'initialization') -----
+ delete
+ closeWindowSelector ifNotNil:[model perform: closeWindowSelector].
+ super delete.
+ !

Item was added:
+ ----- Method: PluggableSystemWindow>>getChildrenSelector (in category 'accessing') -----
+ getChildrenSelector
+ ^getChildrenSelector!

Item was added:
+ ----- Method: PluggableSystemWindow>>getChildrenSelector: (in category 'accessing') -----
+ getChildrenSelector: aSymbol
+ getChildrenSelector := aSymbol!

Item was added:
+ ----- Method: PluggableSystemWindow>>getLabelSelector (in category 'accessing') -----
+ getLabelSelector
+ ^getLabelSelector!

Item was added:
+ ----- Method: PluggableSystemWindow>>getLabelSelector: (in category 'accessing') -----
+ getLabelSelector: aSymbol
+ getLabelSelector := aSymbol.
+ self update: aSymbol.!

Item was added:
+ ----- Method: PluggableSystemWindow>>label (in category 'accessing') -----
+ label
+ ^label contents!

Item was added:
+ ----- Method: PluggableSystemWindow>>label: (in category 'accessing') -----
+ label: aString
+ self setLabel: aString.!

Item was added:
+ ----- Method: PluggableSystemWindow>>update: (in category 'updating') -----
+ update: what
+ what ifNil:[^self].
+ what == getLabelSelector ifTrue:[self setLabel: (model perform: getLabelSelector)].
+ what == getChildrenSelector ifTrue:[
+ children ifNil:[children := #()].
+ self removeAllMorphsIn: children.
+ children := model perform: getChildrenSelector.
+ self addAllMorphs: children.
+ children do:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
+ ].
+ ^super update: what!

Item was added:
+ PluggableTextMorph subclass: #PluggableTextMorphPlus
+ instanceVariableNames: 'getColorSelector acceptAction unstyledAcceptText styler'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !PluggableTextMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0!
+ A pluggable text morph with support for color.!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>accept (in category 'updating') -----
+ accept
+ super accept.
+ acceptAction ifNotNil:[acceptAction value: textMorph asText].!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>acceptAction (in category 'accessing') -----
+ acceptAction
+ ^acceptAction!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>acceptAction: (in category 'accessing') -----
+ acceptAction: anAction
+ acceptAction := anAction!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>acceptTextInModel (in category 'styling') -----
+ acceptTextInModel
+
+ self okToStyle ifFalse:[^super acceptTextInModel].
+ "#correctFrom:to:with: is sent when the method source is
+ manipulated during compilation (removing unused temps,
+ changing selectors etc). But #correctFrom:to:with: operates
+ on the textMorph's text, and we may be saving an unstyled
+ copy of the text. This means that these corrections will be lost
+ unless we also apply the corrections to the unstyled copy that we are saving.
+ So remember the unstyled copy in unstyledAcceptText, so
+ that when #correctFrom:to:with: is received we can also apply
+ the correction to it"
+ unstyledAcceptText := styler unstyledTextFrom: textMorph asText.
+ [^setTextSelector isNil or:
+ [setTextSelector numArgs = 2
+ ifTrue: [model perform: setTextSelector with: unstyledAcceptText with: self]
+ ifFalse: [model perform: setTextSelector with: unstyledAcceptText]]
+ ] ensure:[unstyledAcceptText := nil]!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>correctFrom:to:with: (in category 'styling') -----
+ correctFrom: start to: stop with: aString
+ "see the comment in #acceptTextInModel "
+ unstyledAcceptText ifNotNil:[unstyledAcceptText replaceFrom: start to: stop with: aString ].
+ ^ super correctFrom: start to: stop with: aString!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>getColorSelector (in category 'accessing') -----
+ getColorSelector
+ ^getColorSelector!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>getColorSelector: (in category 'accessing') -----
+ getColorSelector: aSymbol
+ getColorSelector := aSymbol.
+ self update: getColorSelector.!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>getMenu: (in category 'menu') -----
+ getMenu: shiftKeyState
+ "Answer the menu for this text view. We override the superclass implementation to
+ so we can give the selection interval to the model."
+
+ | menu aMenu |
+ getMenuSelector == nil ifTrue: [^ nil].
+ getMenuSelector numArgs < 3 ifTrue: [^ super getMenu: shiftKeyState].
+ menu := MenuMorph new defaultTarget: model.
+ getMenuSelector numArgs = 3 ifTrue:
+ [aMenu := model
+ perform: getMenuSelector
+ with: menu
+ with: shiftKeyState
+ with: self selectionInterval.
+ getMenuTitleSelector ifNotNil:
+ [aMenu addTitle: (model perform: getMenuTitleSelector)].
+ ^ aMenu].
+ ^ self error: 'The getMenuSelector must be a 1- or 2 or 3-keyword symbol'!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>hasUnacceptedEdits: (in category 'styling') -----
+ hasUnacceptedEdits: aBoolean
+ "re-implemented to re-style the text iff aBoolean is true"
+
+ super hasUnacceptedEdits: aBoolean.
+ (aBoolean and: [self okToStyle])
+ ifTrue: [ styler styleInBackgroundProcess: textMorph contents]!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>okToStyle (in category 'testing') -----
+ okToStyle
+ styler ifNil:[^false].
+ (model respondsTo: #aboutToStyle: ) ifFalse:[^true].
+ ^model aboutToStyle: styler
+ !

Item was added:
+ ----- Method: PluggableTextMorphPlus>>setText: (in category 'styling') -----
+ setText: aText
+
+ self okToStyle ifFalse:[^super setText: aText].
+ super setText: (styler format: aText asText).
+ aText size < 4096
+ ifTrue:[styler style: textMorph contents]
+ ifFalse:[styler styleInBackgroundProcess:  textMorph contents]!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>styler (in category 'accessing') -----
+ styler
+ "The styler responsible for highlighting text in the receiver"
+ ^styler!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>styler: (in category 'accessing') -----
+ styler: anObject
+ "The styler responsible for highlighting text in the receiver"
+ styler := anObject!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>stylerStyled: (in category 'styling') -----
+ stylerStyled: styledCopyOfText
+ "Sent after the styler completed styling the underlying text"
+ textMorph contents runs: styledCopyOfText runs .
+ "textMorph paragraph recomposeFrom: 1 to: textMorph contents size delta: 0."     "caused chars to appear in wrong order esp. in demo mode. remove this line when sure it is fixed"
+ textMorph paragraph composeAll.
+ textMorph updateFromParagraph.
+ selectionInterval
+ ifNotNil:[
+ textMorph editor
+ selectInvisiblyFrom: selectionInterval first to: selectionInterval last;
+ storeSelectionInParagraph;
+ setEmphasisHere].
+ textMorph editor blinkParen.
+ self scrollSelectionIntoView!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>stylerStyledInBackground: (in category 'styling') -----
+ stylerStyledInBackground: styledCopyOfText
+ "Sent after the styler completed styling of the text"
+
+ "It is possible that the text string has changed since the styling began. Disregard the styles if styledCopyOfText's string differs with the current textMorph contents string"
+ textMorph contents string = styledCopyOfText string
+ ifTrue: [self stylerStyled: styledCopyOfText]!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>update: (in category 'updating') -----
+ update: what
+ what ifNil:[^self].
+ what == getColorSelector ifTrue:[self color: (model perform: getColorSelector)].
+ ^super update: what!

Item was added:
+ ----- Method: PluggableTextMorphPlus>>useDefaultStyler (in category 'initialize') -----
+ useDefaultStyler
+ "This should be changed to a proper registry but as long as there is only shout this will do"
+ Smalltalk at: #SHTextStylerST80 ifPresent:[:stylerClass|
+ self styler: (stylerClass new view: self).
+ ].!

Item was added:
+ ListItemWrapper subclass: #PluggableTreeItemNode
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !PluggableTreeItemNode commentStamp: 'ar 2/12/2005 04:37' prior: 0!
+ Tree item for PluggableTreeMorph.!

Item was added:
+ ----- Method: PluggableTreeItemNode>>acceptDroppingObject: (in category 'accessing') -----
+ acceptDroppingObject: anotherItem
+ ^model dropNode: anotherItem on: self!

Item was added:
+ ----- Method: PluggableTreeItemNode>>asString (in category 'accessing') -----
+ asString
+ ^model printNode: self!

Item was added:
+ ----- Method: PluggableTreeItemNode>>balloonText (in category 'accessing') -----
+ balloonText
+ ^model balloonTextForNode: self!

Item was added:
+ ----- Method: PluggableTreeItemNode>>canBeDragged (in category 'accessing') -----
+ canBeDragged
+ ^model isDraggableNode: self!

Item was added:
+ ----- Method: PluggableTreeItemNode>>contents (in category 'accessing') -----
+ contents
+ ^model contentsOfNode: self!

Item was added:
+ ----- Method: PluggableTreeItemNode>>hasContents (in category 'accessing') -----
+ hasContents
+ ^model hasNodeContents: self!

Item was added:
+ ----- Method: PluggableTreeItemNode>>icon (in category 'accessing') -----
+ icon
+ ^model iconOfNode: self!

Item was added:
+ ----- Method: PluggableTreeItemNode>>item (in category 'accessing') -----
+ item
+ ^item!

Item was added:
+ ----- Method: PluggableTreeItemNode>>wantsDroppedObject: (in category 'accessing') -----
+ wantsDroppedObject: anotherItem
+ ^model wantsDroppedNode: anotherItem on: self!

Item was added:
+ SimpleHierarchicalListMorph subclass: #PluggableTreeMorph
+ instanceVariableNames: 'roots selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Morphic'!
+
+ !PluggableTreeMorph commentStamp: 'ar 2/12/2005 04:38' prior: 0!
+ A pluggable tree morph.!

Item was added:
+ ----- Method: PluggableTreeMorph>>acceptDroppingMorph:event: (in category 'morphic') -----
+ acceptDroppingMorph: aTransferMorph event: evt
+ dropItemSelector ifNil: [ ^ self ].
+ model
+ perform: dropItemSelector
+ withEnoughArguments: {aTransferMorph passenger.
+ (self itemFromPoint: evt position) withoutListWrapper.
+ aTransferMorph shouldCopy}.
+ evt hand releaseMouseFocus: self.
+ potentialDropMorph ifNotNil: [ potentialDropMorph highlightForDrop: false ].
+ Cursor normal show!

Item was added:
+ ----- Method: PluggableTreeMorph>>balloonTextForNode: (in category 'node access') -----
+ balloonTextForNode: node
+ getHelpSelector ifNil:[^nil].
+ ^model perform: getHelpSelector with: node item!

Item was added:
+ ----- Method: PluggableTreeMorph>>contentsOfNode: (in category 'node access') -----
+ contentsOfNode: node
+ | children |
+ getChildrenSelector ifNil:[^#()].
+ children := model perform: getChildrenSelector with: node item.
+ ^children collect:[:item| PluggableTreeItemNode with: item model: self]!

Item was added:
+ ----- Method: PluggableTreeMorph>>dragItemSelector (in category 'accessing') -----
+ dragItemSelector
+ ^dragItemSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>dragItemSelector: (in category 'accessing') -----
+ dragItemSelector: aSymbol
+ dragItemSelector := aSymbol.
+ aSymbol ifNotNil:[self dragEnabled: true].!

Item was added:
+ ----- Method: PluggableTreeMorph>>dropItemSelector (in category 'accessing') -----
+ dropItemSelector
+ ^dropItemSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>dropItemSelector: (in category 'accessing') -----
+ dropItemSelector: aSymbol
+ dropItemSelector := aSymbol.
+ aSymbol ifNotNil:[self dropEnabled: true].!

Item was added:
+ ----- Method: PluggableTreeMorph>>dropNode:on: (in category 'node access') -----
+ dropNode: srcNode on: dstNode
+ dropItemSelector ifNil:[^nil].
+ model perform: dropItemSelector with: srcNode item with: dstNode item!

Item was added:
+ ----- Method: PluggableTreeMorph>>getChildrenSelector (in category 'accessing') -----
+ getChildrenSelector
+ ^getChildrenSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>getChildrenSelector: (in category 'accessing') -----
+ getChildrenSelector: aSymbol
+ getChildrenSelector := aSymbol.!

Item was added:
+ ----- Method: PluggableTreeMorph>>getHelpSelector (in category 'accessing') -----
+ getHelpSelector
+ ^getHelpSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>getHelpSelector: (in category 'accessing') -----
+ getHelpSelector: aSymbol
+ getHelpSelector := aSymbol!

Item was added:
+ ----- Method: PluggableTreeMorph>>getIconSelector (in category 'accessing') -----
+ getIconSelector
+ ^getIconSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>getIconSelector: (in category 'accessing') -----
+ getIconSelector: aSymbol
+ getIconSelector := aSymbol!

Item was added:
+ ----- Method: PluggableTreeMorph>>getLabelSelector (in category 'accessing') -----
+ getLabelSelector
+ ^getLabelSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>getLabelSelector: (in category 'accessing') -----
+ getLabelSelector: aSymbol
+ getLabelSelector := aSymbol!

Item was added:
+ ----- Method: PluggableTreeMorph>>getMenuSelector (in category 'accessing') -----
+ getMenuSelector
+ ^getMenuSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>getMenuSelector: (in category 'accessing') -----
+ getMenuSelector: aSymbol
+ getMenuSelector := aSymbol!

Item was added:
+ ----- Method: PluggableTreeMorph>>getRootsSelector (in category 'accessing') -----
+ getRootsSelector
+ ^getRootsSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>getRootsSelector: (in category 'accessing') -----
+ getRootsSelector: aSelector
+ getRootsSelector := aSelector.
+ self update: getRootsSelector.!

Item was added:
+ ----- Method: PluggableTreeMorph>>getSelectedPathSelector (in category 'accessing') -----
+ getSelectedPathSelector
+ ^getSelectedPathSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>getSelectedPathSelector: (in category 'accessing') -----
+ getSelectedPathSelector: aSymbol
+ getSelectedPathSelector := aSymbol.!

Item was added:
+ ----- Method: PluggableTreeMorph>>hasChildrenSelector (in category 'accessing') -----
+ hasChildrenSelector
+ ^hasChildrenSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>hasChildrenSelector: (in category 'accessing') -----
+ hasChildrenSelector: aSymbol
+ hasChildrenSelector := aSymbol!

Item was added:
+ ----- Method: PluggableTreeMorph>>hasNodeContents: (in category 'node access') -----
+ hasNodeContents: node
+ hasChildrenSelector ifNil:[^node contents isEmpty not].
+ ^model perform: hasChildrenSelector with: node item!

Item was added:
+ ----- Method: PluggableTreeMorph>>iconOfNode: (in category 'node access') -----
+ iconOfNode: node
+ getIconSelector ifNil:[^nil].
+ ^model perform: getIconSelector with: node item!

Item was added:
+ ----- Method: PluggableTreeMorph>>isDraggableNode: (in category 'node access') -----
+ isDraggableNode: node
+ ^true!

Item was added:
+ ----- Method: PluggableTreeMorph>>keystrokeActionSelector (in category 'accessing') -----
+ keystrokeActionSelector
+ ^keystrokeActionSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>keystrokeActionSelector: (in category 'accessing') -----
+ keystrokeActionSelector: aSymbol
+ keystrokeActionSelector := aSymbol!

Item was added:
+ ----- Method: PluggableTreeMorph>>printNode: (in category 'node access') -----
+ printNode: node
+ getLabelSelector ifNil:[^node item printString].
+ ^model perform: getLabelSelector with: node item!

Item was added:
+ ----- Method: PluggableTreeMorph>>roots (in category 'accessing') -----
+ roots
+ ^roots!

Item was added:
+ ----- Method: PluggableTreeMorph>>roots: (in category 'accessing') -----
+ roots: anArray
+ roots := anArray collect:[:item| PluggableTreeItemNode with: item model: self].
+ self list: roots.!

Item was added:
+ ----- Method: PluggableTreeMorph>>selectPath:in: (in category 'updating') -----
+ selectPath: path in: listItem
+ path isEmpty ifTrue: [^self setSelectedMorph: nil].
+ listItem withSiblingsDo: [:each |
+ (each complexContents item = path first) ifTrue: [
+ each isExpanded ifFalse: [
+ each toggleExpandedState.
+ self adjustSubmorphPositions.
+ ].
+ each changed.
+ path size = 1 ifTrue: [
+ ^self setSelectedMorph: each
+ ].
+ each firstChild ifNil: [^self setSelectedMorph: nil].
+ ^self selectPath: path allButFirst in: each firstChild
+ ].
+ ].
+ ^self setSelectedMorph: nil
+
+ !

Item was added:
+ ----- Method: PluggableTreeMorph>>setSelectedMorph: (in category 'selection') -----
+ setSelectedMorph: aMorph
+ selectedWrapper := aMorph complexContents.
+ self selection: selectedWrapper.
+ setSelectedSelector ifNotNil:[
+ model
+ perform: setSelectedSelector
+ with: (selectedWrapper ifNotNil:[selectedWrapper item]).
+ ].!

Item was added:
+ ----- Method: PluggableTreeMorph>>setSelectedSelector (in category 'accessing') -----
+ setSelectedSelector
+ ^setSelectedSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>setSelectedSelector: (in category 'accessing') -----
+ setSelectedSelector: aSymbol
+ setSelectedSelector := aSymbol!

Item was added:
+ ----- Method: PluggableTreeMorph>>startDrag: (in category 'morphic') -----
+ startDrag: evt
+ | ddm itemMorph passenger |
+ self dragEnabled
+ ifTrue: [itemMorph := scroller submorphs
+ detect: [:any | any highlightedForMouseDown]
+ ifNone: []].
+ (itemMorph isNil
+ or: [evt hand hasSubmorphs])
+ ifTrue: [^ self].
+ itemMorph highlightForMouseDown: false.
+ itemMorph ~= self selectedMorph
+ ifTrue: [self setSelectedMorph: itemMorph].
+ passenger := self model perform: dragItemSelector with: itemMorph withoutListWrapper.
+ passenger
+ ifNotNil: [ddm := TransferMorph withPassenger: passenger from: self.
+ ddm dragTransferType: #dragTransferPlus.
+ Preferences dragNDropWithAnimation
+ ifTrue: [self model dragAnimationFor: itemMorph transferMorph: ddm].
+ evt hand grabMorph: ddm].
+ evt hand releaseMouseFocus: self!

Item was added:
+ ----- Method: PluggableTreeMorph>>update: (in category 'updating') -----
+ update: what
+ what ifNil:[^self].
+ what == getRootsSelector ifTrue:[
+ self roots: (model perform: getRootsSelector)
+ ].
+ what == getSelectedPathSelector ifTrue:[
+ ^self selectPath: (model perform: getSelectedPathSelector)
+ in: (scroller submorphs at: 1 ifAbsent: [^self])
+ ].
+ ^super update: what!

Item was added:
+ ----- Method: PluggableTreeMorph>>wantsDropSelector (in category 'accessing') -----
+ wantsDropSelector
+ ^wantsDropSelector!

Item was added:
+ ----- Method: PluggableTreeMorph>>wantsDropSelector: (in category 'accessing') -----
+ wantsDropSelector: aSymbol
+ wantsDropSelector := aSymbol!

Item was added:
+ ----- Method: PluggableTreeMorph>>wantsDroppedMorph:event: (in category 'morphic') -----
+ wantsDroppedMorph: aMorph event: anEvent
+ aMorph dragTransferType == #dragTransferPlus ifFalse:[^false].
+ dropItemSelector ifNil:[^false].
+ wantsDropSelector ifNil:[^true].
+ ^ (model perform: wantsDropSelector with: aMorph passenger) == true.!

Item was added:
+ ----- Method: PluggableTreeMorph>>wantsDroppedNode:on: (in category 'node access') -----
+ wantsDroppedNode: srcNode on: dstNode
+ dropItemSelector ifNil:[^false].
+ wantsDropSelector ifNil:[^true].
+ ^(model perform: wantsDropSelector with: srcNode with: dstNode) == true!