The Trunk: Morphic-fbs.715.mcz

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

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

Name: Morphic-fbs.715
Author: fbs
Time: 9 January 2014, 2:57:00.648 pm
UUID: 679eb0a9-0316-6846-9f95-69f6713114c3
Ancestors: Morphic-tpr.714

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

=============== Diff against Morphic-tpr.714 ===============

Item was changed:
  SystemOrganization addCategory: #'Morphic-Balloon'!
  SystemOrganization addCategory: #'Morphic-Basic'!
  SystemOrganization addCategory: #'Morphic-Basic-NewCurve'!
  SystemOrganization addCategory: #'Morphic-Borders'!
  SystemOrganization addCategory: #'Morphic-Collections-Arrayed'!
  SystemOrganization addCategory: #'Morphic-Demo'!
  SystemOrganization addCategory: #'Morphic-Events'!
  SystemOrganization addCategory: #'Morphic-Explorer'!
  SystemOrganization addCategory: #'Morphic-Kernel'!
  SystemOrganization addCategory: #'Morphic-Layouts'!
  SystemOrganization addCategory: #'Morphic-Menus'!
  SystemOrganization addCategory: #'Morphic-Menus-DockingBar'!
  SystemOrganization addCategory: #'Morphic-Models'!
  SystemOrganization addCategory: #'Morphic-Pluggable Widgets'!
  SystemOrganization addCategory: #'Morphic-Sound'!
  SystemOrganization addCategory: #'Morphic-Sound-Synthesis'!
  SystemOrganization addCategory: #'Morphic-Support'!
  SystemOrganization addCategory: #'Morphic-Text Support'!
- SystemOrganization addCategory: #'Morphic-ToolBuilder'!
  SystemOrganization addCategory: #'Morphic-TrueType'!
  SystemOrganization addCategory: #'Morphic-Widgets'!
  SystemOrganization addCategory: #'Morphic-Windows'!
  SystemOrganization addCategory: #'Morphic-Worlds'!

Item was removed:
- Object subclass: #ListChooser
- instanceVariableNames: 'window fullList selectedItems searchText searchMorph title listMorph index realIndex buttonBar builder addAllowed result'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !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 removed:
- ----- Method: ListChooser class>>chooseFrom: (in category 'ChooserTool compatibility') -----
- chooseFrom: aList
- ^ self
- chooseFrom: aList
- title: self defaultTitle!

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

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ListChooser class>>chooseItemFrom: (in category 'instance creation') -----
- chooseItemFrom: aList
- ^ self
- chooseItemFrom: aList
- title: self defaultTitle!

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

Item was removed:
- ----- 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 removed:
- ----- Method: ListChooser class>>defaultTitle (in category 'instance creation') -----
- defaultTitle
- ^ 'Please choose:'!

Item was removed:
- ----- 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 removed:
- ----- Method: ListChooser class>>testIndex (in category 'examples') -----
- testIndex
- ^ self
- chooseIndexFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection
- title: 'Pick a class'!

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: ListChooser class>>testSet (in category 'examples') -----
- testSet
- ^ self
- chooseItemFrom: #(a list of values as a Set) asSet
- title: 'Pick from Set'!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ListChooser>>canAccept (in category 'testing') -----
- canAccept
- ^ self selectedIndex > 0!

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

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

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ListChooser>>closed (in category 'event handling') -----
- closed
- "Cancel the dialog and move on"
- builder ifNotNil: [ index := 0 ]!

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ListChooser>>list (in category 'accessing') -----
- list
- ^ selectedItems!

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

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ListChooser>>realIndex (in category 'accessing') -----
- realIndex
- ^ realIndex ifNil: [ 0 ]!

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- ToolBuilder subclass: #MorphicToolBuilder
- instanceVariableNames: 'widgets panes parentMenu'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !MorphicToolBuilder commentStamp: 'ar 2/11/2005 15:02' prior: 0!
- The Morphic tool builder.!

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

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: MorphicToolBuilder>>buildHelpFor:spec: (in category 'pluggable widgets') -----
- buildHelpFor: widget spec: aSpec
- aSpec help
- ifNotNil: [widget setBalloonText: aSpec help]!

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MorphicToolBuilder>>buildPluggableInputField: (in category 'pluggable widgets') -----
- buildPluggableInputField: aSpec
- | widget |
- widget := self buildPluggableText: aSpec.
- widget acceptOnCR: true.
- widget hideScrollBarsIndefinitely.
- ^widget!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MorphicToolBuilder>>buttonClass (in category 'widget classes') -----
- buttonClass
- ^ PluggableButtonMorphPlus!

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

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

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

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MorphicToolBuilder>>panelClass (in category 'widget classes') -----
- panelClass
- ^ PluggablePanelMorph!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MorphicToolBuilder>>textPaneClass (in category 'widget classes') -----
- textPaneClass
- ^ PluggableTextMorphPlus!

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

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

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

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

Item was removed:
- UIManager subclass: #MorphicUIManager
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !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 removed:
- ----- Method: MorphicUIManager class>>isActiveManager (in category 'accessing') -----
- isActiveManager
- "Answer whether I should act as the active ui manager"
- ^Smalltalk isMorphic!

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

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableButtonMorphPlus>>getColorSelector (in category 'accessing') -----
- getColorSelector
- ^getColorSelector!

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

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableButtonMorphPlus>>performAction (in category 'action') -----
- performAction
- enabled ifFalse:[^self].
- action ifNotNil:[^action value].
- ^super performAction!

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableButtonMorphPlus>>updateMap (in category 'updating') -----
- updateMap
- ^ updateMap ifNil: [updateMap := Dictionary new]
- !

Item was removed:
- ----- 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 removed:
- AlignmentMorph subclass: #PluggableCheckBoxMorph
- instanceVariableNames: 'model actionSelector valueSelector label'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableCheckBoxMorph>>actionSelector (in category 'accessing') -----
- actionSelector
- "Answer the value of actionSelector"
-
- ^ actionSelector!

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableCheckBoxMorph>>horizontalPanel (in category 'installing') -----
- horizontalPanel
- ^self basicPanel
- cellPositioning: #center;
- listDirection: #leftToRight;
- yourself.!

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableCheckBoxMorph>>label (in category 'accessing') -----
- label
- "Answer the value of label"
-
- ^ label!

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

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableCheckBoxMorph>>valueSelector (in category 'accessing') -----
- valueSelector
- "Answer the value of valueSelector"
-
- ^ valueSelector!

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableDropDownListMorph>>currentSelection (in category 'accessing') -----
- currentSelection
-
- ^ self model perform: selectionSelector!

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableDropDownListMorph>>list (in category 'accessing') -----
- list
- "Answer the value of list"
-
- ^ self model perform: self listSelector.
- !

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

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

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

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

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

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

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

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

Item was removed:
- PluggableListMorphPlus subclass: #PluggableListMorphByItemPlus
- instanceVariableNames: 'itemList'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- PluggableListMorph subclass: #PluggableListMorphPlus
- instanceVariableNames: 'dragItemSelector dropItemSelector wantsDropSelector'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !PluggableListMorphPlus commentStamp: 'ar 7/15/2005 11:10' prior: 0!
- Extensions for PluggableListMorph needed by ToolBuilder!

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableListMorphPlus>>dragItemSelector (in category 'accessing') -----
- dragItemSelector
- ^dragItemSelector!

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

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableListMorphPlus>>wantsDropSelector (in category 'accessing') -----
- wantsDropSelector
- ^wantsDropSelector!

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

Item was removed:
- ----- 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 removed:
- AlignmentMorph subclass: #PluggablePanelMorph
- instanceVariableNames: 'model getChildrenSelector'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !PluggablePanelMorph commentStamp: 'ar 2/11/2005 20:13' prior: 0!
- A pluggable panel morph which deals with changing children.!

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- SystemWindow subclass: #PluggableSystemWindow
- instanceVariableNames: 'getLabelSelector getChildrenSelector children closeWindowSelector'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !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 removed:
- ----- Method: PluggableSystemWindow>>addPaneMorph: (in category 'accessing') -----
- addPaneMorph: aMorph
- self addMorph: aMorph fullFrame: aMorph layoutFrame!

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

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

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

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- PluggableTextMorph subclass: #PluggableTextMorphPlus
- instanceVariableNames: 'getColorSelector acceptAction unstyledAcceptText styler'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !PluggableTextMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0!
- A pluggable text morph with support for color.!

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

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

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: PluggableTextMorphPlus>>getColorSelector (in category 'accessing') -----
- getColorSelector
- ^getColorSelector!

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: PluggableTextMorphPlus>>okToStyle (in category 'testing') -----
- okToStyle
- styler ifNil:[^false].
- (model respondsTo: #aboutToStyle: ) ifFalse:[^true].
- ^model aboutToStyle: styler
- !

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableTextMorphPlus>>styler (in category 'accessing') -----
- styler
- "The styler responsible for highlighting text in the receiver"
- ^styler!

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: PluggableTextMorphPlus>>update: (in category 'updating') -----
- update: what
- what ifNil:[^self].
- what == getColorSelector ifTrue:[self color: (model perform: getColorSelector)].
- ^super update: what!

Item was removed:
- ----- 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 removed:
- ListItemWrapper subclass: #PluggableTreeItemNode
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-ToolBuilder'!
-
- !PluggableTreeItemNode commentStamp: 'ar 2/12/2005 04:37' prior: 0!
- Tree item for PluggableTreeMorph.!

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

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

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

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

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableTreeMorph>>balloonTextForNode: (in category 'node access') -----
- balloonTextForNode: node
- getHelpSelector ifNil:[^nil].
- ^model perform: getHelpSelector with: node item!

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableTreeMorph>>dragItemSelector (in category 'accessing') -----
- dragItemSelector
- ^dragItemSelector!

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

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: PluggableTreeMorph>>getChildrenSelector (in category 'accessing') -----
- getChildrenSelector
- ^getChildrenSelector!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: PluggableTreeMorph>>setSelectedSelector (in category 'accessing') -----
- setSelectedSelector
- ^setSelectedSelector!

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

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: PluggableTreeMorph>>wantsDropSelector (in category 'accessing') -----
- wantsDropSelector
- ^wantsDropSelector!

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

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