[Pkg] The Trunk: ToolBuilder-Morphic-mt.173.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Jul 31 09:11:48 UTC 2016
Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.173.mcz
==================== Summary ====================
Name: ToolBuilder-Morphic-mt.173
Author: mt
Time: 31 July 2016, 11:11:41.15449 am
UUID: 859eb0f9-c596-2f48-9ae3-a3f8056450c5
Ancestors: ToolBuilder-Morphic-mt.172
*** Widget Refactorings and UI Themes (Part 5 of 11) ***
Some fixes and refactorings for dialogs including added support for UI theming.
=============== Diff against ToolBuilder-Morphic-mt.172 ===============
Item was changed:
Model subclass: #ListChooser
+ instanceVariableNames: 'selectedIndex items searchText addAllowed result title listMorph dialogMorph'
- 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>>themeProperties (in category 'preferences') -----
+ themeProperties
+
+ ^ super themeProperties, {
+ { #okColor. 'Colors'. 'Color for the OK button.' }.
+ { #cancelColor. 'Colors'. 'Color for the Cancel button.' }.
+ { #addColor. 'Colors'. 'Color for a normal button.' }.
+ { #disabledColor. 'Colors'. 'Color for a disabled button.' }.
+ }!
Item was changed:
+ ----- Method: ListChooser>>accept (in category 'actions') -----
- ----- 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 ].
+ | choice |
+ self canAccept ifFalse: [
+ self canAdd ifTrue: [^ self add].
+ ^ self changed: #textSelection].
+
+ choice := self selectedItem.
+
+ self canAdd ifTrue: [
+ "Ask the user whether to add the new item or choose the list selection."
+ (UserDialogBoxMorph confirm: 'You can either choose an existing item or add a new one.\What do you want?' translated withCRs title: 'Choose or Add' translated trueChoice: choice asString falseChoice: self searchText asString at: ActiveHand position)
+ ifTrue: [self result: choice] ifFalse: [self result: self searchText asString]
+ ] ifFalse: [self result: choice].
+
+
+ self changed: #close.!
- "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 changed:
+ ----- Method: ListChooser>>acceptColor (in category 'colors') -----
- ----- Method: ListChooser>>acceptColor (in category 'drawing') -----
acceptColor
+
+ self canAdd ifTrue: [^ self addColor].
+
^ self canAccept
+ ifTrue: [ self userInterfaceTheme okColor ifNil: [(Color r: 0.49 g: 0.749 b: 0.49)] ]
+ ifFalse: [ self userInterfaceTheme disabledColor ifNil: [Color lightGray] ]!
- ifTrue: [ ColorTheme current okColor ]
- ifFalse: [ Color lightGray "ColorTheme current disabledColor <- you don't have this!!" ]!
Item was added:
+ ----- Method: ListChooser>>acceptLabel (in category 'colors') -----
+ acceptLabel
+
+ ^ self canAdd
+ ifFalse: ['Choose' translated]
+ ifTrue: [self canAccept
+ ifTrue: ['Choose or Add' translated]
+ ifFalse: ['Add' translated]]!
Item was changed:
+ ----- Method: ListChooser>>acceptText: (in category 'actions') -----
- ----- 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 changed:
+ ----- Method: ListChooser>>add (in category 'actions') -----
- ----- Method: ListChooser>>add (in category 'event handling') -----
add
"if the user submits with no valid entry, make them start over"
+ self canAdd ifFalse: [^ self changed: #textSelection].
+ self result: self searchText asString.
+ self changed: #close.!
- 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>>addAllowed (in category 'accessing') -----
+ addAllowed
+
+ ^ addAllowed!
Item was added:
+ ----- Method: ListChooser>>addAllowed: (in category 'accessing') -----
+ addAllowed: anObject
+
+ addAllowed := anObject!
Item was added:
+ ----- Method: ListChooser>>addColor (in category 'colors') -----
+ addColor
+
+ ^ self canAdd
+ ifTrue: [ self userInterfaceTheme addColor ifNil: [Color blue muchLighter] ]
+ ifFalse: [ self userInterfaceTheme disabledColor ifNil: [Color lightGray] ]!
Item was added:
+ ----- Method: ListChooser>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+
+ super applyUserInterfaceTheme.
+
+ self
+ changed: #okColor;
+ changed: #cancelColor;
+ changed: #addColor.!
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 at 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 at 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 at 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 changed:
----- Method: ListChooser>>buildWith: (in category 'building') -----
+ buildWith: builder
+
+ | dialogSpec searchBarHeight listSpec fieldSpec |
- buildWith: aBuilder
- | windowSpec searchBarHeight buttonBarHeight |
- builder := aBuilder.
searchBarHeight := Preferences standardDefaultTextFont height * 2.
- buttonBarHeight := Preferences standardButtonFont height * 4.
+ dialogSpec := builder pluggableDialogSpec new
+ model: self;
+ title: #title;
+ closeAction: #closed;
+ extent: self initialExtent;
+ children: OrderedCollection new;
+ buttons: OrderedCollection new;
+ yourself.
- windowSpec := self buildWindowWith: builder specs: {
- (LayoutFrame fractions: (0 at 0 corner: 1 at 0) offsets: (0 at 0 corner: 0 at searchBarHeight)) -> [self buildSearchMorphWith: builder].
- (LayoutFrame fractions: (0 at 0 corner: 1 at 1) offsets: (0 at searchBarHeight corner: 0 at buttonBarHeight negated)) -> [self buildListMorphWith: builder].
- (LayoutFrame fractions: (0 at 1 corner: 1 at 1) offsets: (0 at buttonBarHeight negated corner: 0 at 0)) -> [self buildButtonBarWith: builder].
- }.
- windowSpec closeAction: #closed.
- windowSpec extent: self initialExtent.
- window := builder build: windowSpec.
+ listSpec := builder pluggableListSpec new.
+ listSpec
+ model: self;
+ list: #items;
+ getIndex: #selectedIndex;
+ setIndex: #selectedIndex:;
+ doubleClick: #accept;
+ "keystrokePreview: #keyStrokeFromList:;"
+ autoDeselect: false;
+ name: #list;
+ frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 1) offsets: (0 at searchBarHeight corner: 0 at 0)).
+ dialogSpec children add: listSpec.
+ fieldSpec := builder pluggableInputFieldSpec new.
+ fieldSpec
+ model: self;
+ getText: #searchText;
+ editText: #searchText:;
+ setText: #acceptText:;
+ selection: #textSelection;
+ menu: nil;
+ indicateUnacceptedChanges: false;
+ askBeforeDiscardingEdits: false;
+ help: 'Type a string to filter down the listed items';
+ frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 0) offsets: (0 at 0 corner: 0 at searchBarHeight)).
+ dialogSpec children add: fieldSpec.
+
+ "Buttons"
+ dialogSpec buttons add: (
+ builder pluggableButtonSpec new
+ model: self;
+ label: #acceptLabel;
+ action: #accept;
+ enabled: #canAcceptOrAdd;
+ color: #acceptColor).
+
+ dialogSpec buttons add: (
+ builder pluggableButtonSpec new
+ model: self;
+ label: 'Cancel';
+ action: #cancel;
+ color: #cancelColor).
+
+ dialogMorph := builder build: dialogSpec.
+ dialogMorph addKeyboardCaptureFilter: self.
+ listMorph := builder widgetAt: #list.
+ listMorph allowEmptyFilterResult: true.
+
+ ^ dialogMorph!
- 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>>canAcceptOrAdd (in category 'testing') -----
+ canAcceptOrAdd
+ ^ self canAccept or: [self canAdd]!
Item was changed:
----- Method: ListChooser>>canAdd (in category 'testing') -----
canAdd
+ ^ self addAllowed
+ and: [self searchText asString withBlanksTrimmed notEmpty]
+ and: [self selectedItem asString ~= self searchText asString]!
- ^ addAllowed and: [ self canAccept not ]!
Item was changed:
+ ----- Method: ListChooser>>cancel (in category 'actions') -----
- ----- Method: ListChooser>>cancel (in category 'event handling') -----
cancel
+
+ self result: nil.
+ self changed: #close.!
- "Cancel the dialog and move on"
- index := 0.
- builder ifNotNil: [ builder close: window ]!
Item was changed:
+ ----- Method: ListChooser>>cancelColor (in category 'colors') -----
- ----- Method: ListChooser>>cancelColor (in category 'drawing') -----
cancelColor
+
+ ^ self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588]!
- ^ ColorTheme current cancelColor!
Item was changed:
----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') -----
chooseIndexFrom: labelList title: aString
| choice |
choice := self chooseItemFrom: labelList title: aString addAllowed: false.
+ ^ self items indexOf: choice ifAbsent: 0!
- ^ fullList indexOf: choice ifAbsent: 0!
Item was changed:
----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') -----
chooseIndexFrom: labelList title: aString addAllowed: aBoolean
| choice |
choice := self chooseItemFrom: labelList title: aString addAllowed: false.
+ self addAllowed: aBoolean.
+ ^ self items indexOf: choice ifAbsent: 0!
- addAllowed := aBoolean.
- ^ fullList indexOf: choice ifAbsent: 0!
Item was changed:
----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') -----
chooseItemFrom: labelList title: aString addAllowed: aBoolean
+
+ self items: labelList asOrderedCollection.
- fullList := labelList asOrderedCollection. "coerce everything into an OC"
- builder := ToolBuilder default.
- self list: fullList.
self title: aString.
+ self addAllowed: aBoolean.
+
+ ToolBuilder open: self.
+ ^ self result!
- addAllowed := aBoolean.
- window := ToolBuilder default open: self.
- window center: Sensor cursorPoint.
- window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false.
-
- self changed: #inputRequested with: #searchText.
- window lookFocused. "Sigh..."
-
- builder runModal: window.
- ^ result!
Item was changed:
+ ----- Method: ListChooser>>closed (in category 'actions') -----
- ----- Method: ListChooser>>closed (in category 'event handling') -----
closed
+
+ self selectedIndex: 0.!
- "Cancel the dialog and move on"
- builder ifNotNil: [ index := 0 ]!
Item was added:
+ ----- Method: ListChooser>>filterEvent:for: (in category 'event handling') -----
+ filterEvent: aKeyboardEvent for: aMorph
+
+ | char |
+ aKeyboardEvent isKeystroke ifFalse: [^ aKeyboardEvent].
+ aKeyboardEvent anyModifierKeyPressed ifTrue: [^ aKeyboardEvent].
+
+ char := aKeyboardEvent keyCharacter.
+
+ char = Character backspace
+ ifTrue: [self searchText: (self searchText asString ifNotEmpty: [:s | s allButLast]). ^ aKeyboardEvent ignore].
+ char = Character delete
+ ifTrue: [self searchText: (self searchText asString ifNotEmpty: [:s | s allButFirst]). ^ aKeyboardEvent ignore].
+ (char = Character cr or: [char = Character enter])
+ ifTrue: [self accept. aKeyboardEvent ignore].
+ char = Character escape
+ ifTrue: [self cancel. aKeyboardEvent ignore].
+ (char asInteger between: 32 and: 126)
+ ifTrue: [self searchText: self searchText asString, char asString. aKeyboardEvent ignore].
+
+ ^ aKeyboardEvent!
Item was removed:
- ----- Method: ListChooser>>handlesKeyboard: (in category 'event handling') -----
- handlesKeyboard: evt
- ^ true!
Item was changed:
----- Method: ListChooser>>initialExtent (in category 'building') -----
initialExtent
+
+ | listFont |
- | listFont titleFont buttonFont listWidth titleWidth buttonWidth |
listFont := Preferences standardListFont.
+ ^ (20 * (listFont widthOf: $m))@(15 * listFont height)!
- 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>>items (in category 'accessing') -----
+ items
+
+ ^ items!
Item was added:
+ ----- Method: ListChooser>>items: (in category 'accessing') -----
+ items: anObject
+
+ items := anObject!
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 added:
+ ----- Method: ListChooser>>result (in category 'accessing') -----
+ result
+
+ ^ result!
Item was added:
+ ----- Method: ListChooser>>result: (in category 'accessing') -----
+ result: anObject
+
+ result := anObject!
Item was changed:
----- Method: ListChooser>>searchText: (in category 'accessing') -----
searchText: aString
+ searchText := aString.
+ listMorph filterList: aString asString.
+
+ self changed: #searchText.
+ self changed: #canAcceptOrAdd.
+ self changed: #acceptLabel.
+ self changed: #buttons.!
- searchText := aString!
Item was changed:
----- Method: ListChooser>>selectedIndex (in category 'accessing') -----
selectedIndex
+ ^ selectedIndex ifNil: [ 1 ]!
- ^ index ifNil: [ index := 1 ]!
Item was changed:
----- Method: ListChooser>>selectedIndex: (in category 'accessing') -----
selectedIndex: anInt
+ selectedIndex := anInt.
+ self changed: #selectedIndex.!
- index := (anInt min: selectedItems size).
- self changed: #selectedIndex.
- self changed: #canAccept.!
Item was added:
+ ----- Method: ListChooser>>selectedItem (in category 'accessing') -----
+ selectedItem
+
+ ^ self items at: self selectedIndex ifAbsent: []!
Item was added:
+ ----- Method: ListChooser>>textSelection (in category 'accessing') -----
+ textSelection
+ ^ self searchText size +1 to: self searchText size !
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 added:
+ ----- Method: ListMultipleChooser class>>themeProperties (in category 'preferences') -----
+ themeProperties
+
+ ^ super themeProperties, {
+ { #okColor. 'Colors'. 'Color for the OK button.' }.
+ { #cancelColor. 'Colors'. 'Color for the Cancel button.' }.
+ }!
Item was added:
+ ----- Method: ListMultipleChooser>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+
+ super applyUserInterfaceTheme.
+
+ self
+ changed: #okColor;
+ changed: #cancelColor.!
Item was changed:
----- Method: ListMultipleChooser>>buildWith: (in category 'toolbuilder') -----
buildWith: builder
+ | dialogSpec choicesSpec |
+ dialogSpec := builder pluggableDialogSpec new
- | windowSpec choicesSpec acceptSpec cancelSpec buttonHeight |
- windowSpec := builder pluggableWindowSpec new
model: self;
+ extent: self initialExtent;
+ title: #title;
+ children: OrderedCollection new;
+ buttons: OrderedCollection new.
+
- extent: 250 at 400;
- label: #title;
- children: OrderedCollection new.
-
- buttonHeight := Preferences standardButtonFont height * 4.
-
choicesSpec := builder pluggableMultiSelectionListSpec new
model: self;
list: #labels;
setIndex: #selectedIndex:;
getIndex: #selectedIndex;
setSelectionList: #selectionAt:put:;
getSelectionList: #selectionAt:;
+ frame: (0 at 0 corner: 1 at 1).
+ dialogSpec children add: choicesSpec.
- frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 1) offsets: (0 at 0 corner: 0@ buttonHeight negated)).
- windowSpec children add: choicesSpec.
+ "Buttons"
+ dialogSpec buttons add: (
+ builder pluggableButtonSpec new
+ model: self;
+ label: 'accept';
+ color: (self userInterfaceTheme okColor ifNil: [Color r: 0.49 g: 0.749 b: 0.49]);
+ action: #accept).
+
+ dialogSpec buttons add: (
+ builder pluggableButtonSpec new
+ model: self;
+ label: 'cancel';
+ color: (self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588]);
+ action: #cancel).
+
+ ^ builder build: dialogSpec!
- acceptSpec := builder pluggableButtonSpec new
- model: self;
- label: 'accept';
- color: ColorTheme current okColor;
- action: #accept;
- frame: (LayoutFrame fractions: (0 at 1 corner: 0.5 at 1) offsets: (0@ buttonHeight negated corner: 0 at 0)).
- windowSpec children add: acceptSpec.
-
- cancelSpec := builder pluggableButtonSpec new
- model: self;
- label: 'cancel';
- color: ColorTheme current cancelColor;
- action: #cancel;
- frame: (LayoutFrame fractions: (0.5 at 1 corner: 1 at 1) offsets: (0@ buttonHeight negated corner: 0 at 0)).
- windowSpec children add: cancelSpec.
-
- ^ builder build: windowSpec!
Item was changed:
----- Method: ListMultipleChooser>>choose (in category 'actions') -----
choose
- | builder window |
- builder := ToolBuilder default.
- window := builder open: self..
- window center: Sensor cursorPoint. "Avoid morphic dependency here..."
+ " self changed: #inputRequested with: #selectedIndex.
+ "
+ ToolBuilder open: self.
- self changed: #inputRequested with: #selectedIndex.
- window lookFocused. "Sigh..."
-
- builder runModal: window.
-
^ self selectedValues!
Item was added:
+ ----- Method: ListMultipleChooser>>initialExtent (in category 'toolbuilder') -----
+ initialExtent
+
+ | listFont |
+ listFont := Preferences standardListFont.
+ ^ (20 * (listFont widthOf: $m))@(15 * listFont height)!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableDialog: (in category 'widgets optional') -----
+ buildPluggableDialog: aSpec
+
+ | widget |
+
+ widget := self dialogClass new.
+ self register: widget id: aSpec name.
+
+ widget model: aSpec model.
+
+ "Set child dependent layout properties. The pane morph holds the special contents."
+ widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]).
+ self setLayoutHintsFor: widget paneMorph spec: aSpec.
+ widget paneMorph layoutInset: (aSpec padding ifNil: [ProportionalSplitterMorph gripThickness]).
+ widget paneMorph cellInset: (aSpec spacing ifNil: [ProportionalSplitterMorph gripThickness]).
+ widget paneMorph wantsPaneSplitters ifTrue: [widget paneMorph addCornerGrips"addEdgeGrips"].
+
+ "Now create the children."
+ panes := OrderedCollection new.
+ aSpec children isSymbol
+ ifTrue: [
+ widget getChildrenSelector: aSpec children.
+ widget update: aSpec children]
+ ifFalse: [
+ self buildAll: aSpec children in: widget paneMorph].
+
+ "Now create the buttons."
+ aSpec buttons isSymbol
+ ifTrue: [
+ widget getButtonsSelector: aSpec buttons.
+ widget update: aSpec buttons]
+ ifFalse: [
+ self buildAll: aSpec buttons in: widget buttonRowMorph.
+ widget updateButtonProperties].
+
+ aSpec title ifNotNil: [:label |
+ label isSymbol
+ ifTrue:[widget getTitleSelector: label; update: label]
+ ifFalse:[widget title: label]].
+ aSpec message ifNotNil: [:label |
+ label isSymbol
+ ifTrue:[widget getMessageSelector: label; update: label]
+ ifFalse:[widget message: label]].
+
+ widget closeDialogSelector: aSpec closeAction.
+ self buildHelpFor: widget spec: aSpec.
+
+ "Everything is shrink-wrapped around the pane morph."
+ widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent]).
+
+ ^ widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>dialogClass (in category 'widget classes') -----
+ dialogClass
+ ^ PluggableDialogWindow!
Item was changed:
----- 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: DialogWindow)
+ ifTrue: [^ morph moveToHand; getUserResponse].
(morph isKindOf: SystemWindow)
ifFalse:[morph openInWorld]
ifTrue:[
morph := morph openInWorldExtent: morph extent.
(self class openToolsAttachedToMouseCursor
and: [self currentEvent isMouse and: [self currentEvent isMouseUp]])
ifTrue: [
morph setProperty: #initialDrop toValue: true.
morph hasDropShadow: false.
self currentHand attachMorph: morph]].
^morph!
Item was changed:
----- Method: MorphicToolBuilder>>windowClassFor: (in category 'widget classes') -----
windowClassFor: aSpec
- aSpec isDialog ifTrue: [^ PluggableDialogWindow].
^aSpec multiWindowStyle
caseOf:
{ [nil] -> [PluggableSystemWindow].
[#labelButton] -> [PluggableSystemWindowWithLabelButton] }
otherwise: [PluggableSystemWindowWithLabelButton]!
Item was changed:
----- 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 <= 7 ifTrue: [
+ | dialog |
+ dialog := DialogWindow new
+ title: 'Please Choose';
+ message: aString;
+ yourself.
+ aList doWithIndex: [:ea :index |
+ dialog createButton: ea value: index].
+ dialog selectedButtonIndex: 1.
+ ^ dialog getUserResponseAtHand ifNil: [0]].
+
+ ^ ListChooser chooseFrom: aList title: aString!
- ^ 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 changed:
----- 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 |
+ index := self chooseFrom: labelList lines: linesArray title: aString.
+ ^ index = 0
+ ifTrue: [ nil ]
+ ifFalse: [ valueList at: 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>>chooseFromOrAddTo:lines:title: (in category 'ui requests') -----
+ chooseFromOrAddTo: aList lines: linesArray title: aString
+
+ ^ ListChooser
+ chooseItemFrom: aList
+ title: aString
+ addAllowed: true!
Item was changed:
+ DialogWindow subclass: #PluggableDialogWindow
+ instanceVariableNames: 'model getTitleSelector getMessageSelector getChildrenSelector getButtonsSelector closeDialogSelector'
- PluggableSystemWindow subclass: #PluggableDialogWindow
- instanceVariableNames: 'statusValue'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Morphic'!
Item was added:
+ ----- Method: PluggableDialogWindow>>closeDialogSelector (in category 'accessing') -----
+ closeDialogSelector
+
+ ^ closeDialogSelector!
Item was added:
+ ----- Method: PluggableDialogWindow>>closeDialogSelector: (in category 'accessing') -----
+ closeDialogSelector: anObject
+
+ closeDialogSelector := anObject!
Item was added:
+ ----- Method: PluggableDialogWindow>>delete (in category 'submorphs-add/remove') -----
+ delete
+
+ self model okToClose ifFalse: [^ self].
+
+ self closeDialogSelector ifNotNil: [:sel | self model perform: sel].
+
+ self model
+ windowIsClosing;
+ release.
+ self model: nil.
+
+ super delete.!
Item was added:
+ ----- Method: PluggableDialogWindow>>getButtonsSelector (in category 'accessing') -----
+ getButtonsSelector
+
+ ^ getButtonsSelector!
Item was added:
+ ----- Method: PluggableDialogWindow>>getButtonsSelector: (in category 'accessing') -----
+ getButtonsSelector: anObject
+
+ getButtonsSelector := anObject!
Item was added:
+ ----- Method: PluggableDialogWindow>>getChildrenSelector (in category 'accessing') -----
+ getChildrenSelector
+
+ ^ getChildrenSelector!
Item was added:
+ ----- Method: PluggableDialogWindow>>getChildrenSelector: (in category 'accessing') -----
+ getChildrenSelector: anObject
+
+ getChildrenSelector := anObject!
Item was added:
+ ----- Method: PluggableDialogWindow>>getMessageSelector (in category 'accessing') -----
+ getMessageSelector
+
+ ^ getMessageSelector!
Item was added:
+ ----- Method: PluggableDialogWindow>>getMessageSelector: (in category 'accessing') -----
+ getMessageSelector: anObject
+
+ getMessageSelector := anObject!
Item was added:
+ ----- Method: PluggableDialogWindow>>getTitleSelector (in category 'accessing') -----
+ getTitleSelector
+
+ ^ getTitleSelector!
Item was added:
+ ----- Method: PluggableDialogWindow>>getTitleSelector: (in category 'accessing') -----
+ getTitleSelector: anObject
+
+ getTitleSelector := anObject!
Item was added:
+ ----- Method: PluggableDialogWindow>>model (in category 'accessing') -----
+ model
+ ^ model!
Item was added:
+ ----- Method: PluggableDialogWindow>>model: (in category 'accessing') -----
+ model: anObject
+
+ model ifNotNil: [model removeDependent: self].
+ anObject ifNotNil: [anObject addDependent: self].
+ model := anObject.!
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 added:
+ ----- Method: PluggableDialogWindow>>update: (in category 'updating') -----
+ update: what
+
+ what ifNil:[^self].
+
+ what == self getTitleSelector ifTrue:[self title: (model perform: self getTitleSelector)].
+ what == self getMessageSelector ifTrue:[self message: (model perform: self getMessageSelector)].
+
+ what == self getChildrenSelector ifTrue:[
+ self paneMorph removeAllMorphs.
+ (self model perform: self getChildrenSelector)
+ do: [:m| m hResizing: #spaceFill; vResizing: #spaceFill];
+ in: [:children | self paneMorph addAllMorphs: children]].
+
+ what == self getButtonsSelector ifTrue:[
+ self buttonRow
+ removeAllMorphs;
+ addAllMorphs: (self model perform: self getButtonsSelector).
+ self updateButtonProperties].
+
+ what == #close ifTrue: [^ self delete].
+
+ super update: what.!
Item was added:
+ ----- Method: PluggableDialogWindow>>updateButtonProperties (in category 'updating') -----
+ updateButtonProperties
+
+ self buttons do: [:ea |
+ ea setProperty: #normalColor toValue: ea offColor.
+ ea setProperty: #normalLabel toValue: ea label.
+ ea hResizing: #rigid; vResizing: #rigid].
+
+ self updateButtonExtent.!
More information about the Packages
mailing list