Chris Muller uploaded a new version of ToolBuilder-Morphic to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Morphic-cmm.53.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-cmm.53 Author: cmm Time: 15 March 2010, 6:59:31.15 pm UUID: 8558cdec-3e86-460b-a52a-66237e0d22e6 Ancestors: ToolBuilder-Morphic-MAD.52 Integrated new ListChooser from Michael Davies. =============== Diff against ToolBuilder-Morphic-cmm.51 =============== Item was added: + ----- Method: ListChooser classSide>>chooseIndexFrom:title: (in category 'instance creation') ----- + chooseIndexFrom: aList title: aString + ^ self + chooseIndexFrom: aList + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ]) + addAllowed: false! Item was added: + ----- Method: ListChooser classSide>>testItem (in category 'examples') ----- + testItem + ^ self + chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection + title: 'Pick a class'! Item was added: + ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') ----- + moveWindowNear: aPoint + | trialRect delta | + trialRect := Rectangle center: aPoint extent: window fullBounds extent. + delta := trialRect amountToTranslateWithin: World bounds. + window position: trialRect origin + delta.! Item was added: + ----- Method: ListChooser classSide>>defaultTitle (in category 'instance creation') ----- + defaultTitle + ^ 'Please choose:'! Item was added: + ----- Method: ListChooser classSide>>testSet (in category 'examples') ----- + testSet + ^ self + chooseItemFrom: #(a list of values as a Set) asSet + title: 'Pick from Set'! Item was added: + ----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') ----- + chooseIndexFrom: labelList title: aString + | choice | + choice := self chooseItemFrom: labelList title: aString addAllowed: false. + ^ fullList indexOf: choice ifAbsent: 0! Item was added: + ----- Method: ListChooser>>buildListMorphWith: (in category 'building') ----- + buildListMorphWith: builder + | listSpec | + listSpec := builder pluggableListSpec new. + listSpec + model: self; + list: #list; + getIndex: #selectedIndex; + setIndex: #selectedIndex:; + doubleClick: #accept; + "handleBasicKeys: false;" + keystrokePreview: #keyStrokeFromList:; + "doubleClickSelector: #accept;" + autoDeselect: false. + ^ listSpec! Item was added: + ----- Method: ListChooser classSide>>chooseItemFrom: (in category 'instance creation') ----- + chooseItemFrom: aList + ^ self + chooseItemFrom: aList + title: self defaultTitle! Item was added: + ----- Method: ListChooser classSide>>testLongTitle (in category 'examples') ----- + testLongTitle + ^ self + chooseItemFrom: #(this is a list of values that aren/t the point here) + title: 'Pick from some values from this list'! Item was added: + ----- Method: ListChooser>>buildWindowWith:specs: (in category 'building') ----- + buildWindowWith: builder specs: specs + | windowSpec | + windowSpec := self buildWindowWith: builder. + specs do: [ :assoc | + | rect action widgetSpec | + rect := assoc key. + action := assoc value. + widgetSpec := action value. + widgetSpec ifNotNil:[ + widgetSpec frame: rect. + windowSpec children add: widgetSpec ] ]. + ^ windowSpec! Item was added: + ----- Method: ListChooser>>cancel (in category 'event handling') ----- + cancel + "Cancel the dialog and move on" + index := 0. + builder ifNotNil: [ builder close: window ]! Item was added: + ----- Method: ListChooser>>buildSearchMorphWith: (in category 'building') ----- + buildSearchMorphWith: builder + | fieldSpec | + fieldSpec := builder pluggableInputFieldSpec new. + fieldSpec + model: self; + getText: #searchText; + setText: #acceptText:; + menu: nil. + "hideScrollBarsIndefinitely;" + "acceptOnCR: true;" + "setBalloonText: 'Type a string to filter down the listed items'." + "onKeyStrokeSend: #keyStroke: to: self." + ^ fieldSpec! Item was added: + ----- Method: ListChooser>>buildWindowWith: (in category 'building') ----- + buildWindowWith: builder + | windowSpec | + windowSpec := builder pluggableWindowSpec new. + windowSpec model: self. + windowSpec label: #title. + windowSpec children: OrderedCollection new. + ^windowSpec! Item was added: + ----- Method: ListChooser classSide>>chooseIndexFrom:title:addAllowed: (in category 'instance creation') ----- + chooseIndexFrom: aList title: aString addAllowed: aBoolean + ^ self new + chooseIndexFrom: aList + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ]) + addAllowed: aBoolean! Item was added: + ----- Method: ListChooser>>searchText: (in category 'accessing') ----- + searchText: aString + searchText := aString! Item was added: + ----- Method: ListChooser>>title: (in category 'accessing') ----- + title: aString + title := aString.! Item was added: + ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') ----- + chooseIndexFrom: labelList title: aString addAllowed: aBoolean + | choice | + choice := self chooseItemFrom: labelList title: aString addAllowed: false. + addAllowed := aBoolean. + ^ fullList indexOf: choice ifAbsent: 0! Item was added: + ----- Method: ListChooser>>realIndex (in category 'accessing') ----- + realIndex + ^ realIndex ifNil: [ 0 ]! Item was added: + ----- Method: ListChooser>>list (in category 'accessing') ----- + list + ^ selectedItems! Item was changed: ----- 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 doubleClickSelector: aSpec doubleClick. widget dragItemSelector: aSpec dragItem. widget dropItemSelector: aSpec dropItem. widget wantsDropSelector: aSpec dropAccept. widget autoDeselect: aSpec autoDeselect. + widget keystrokePreviewSelector: aSpec keystrokePreview. self buildHelpFor: widget spec: aSpec. self setFrame: aSpec frame in: widget. parent ifNotNil:[self add: widget to: parent]. panes ifNotNil:[ aSpec list ifNotNil:[panes add: aSpec list]. ]. ^widget! Item was added: + ----- Method: ListChooser>>accept (in category 'event handling') ----- + accept + "if the user submits with no valid entry, make them start over" + self canAccept ifFalse: [ + searchMorph selectAll. + ^ self ]. + + "find the selected item in the original list, and return it" + result := selectedItems at: index. + + builder ifNotNil: [ :bldr | + builder := nil. + bldr close: window ]! Item was added: + ----- Method: ListChooser classSide>>chooseItemFrom:title:addAllowed: (in category 'instance creation') ----- + chooseItemFrom: aList title: aString addAllowed: aBoolean + ^ self new + chooseItemFrom: aList + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ]) + addAllowed: aBoolean! Item was added: + ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') ----- + chooseItemFrom: labelList title: aString addAllowed: aBoolean + fullList := labelList asOrderedCollection. "coerce everything into an OC" + builder := ToolBuilder default. + self list: fullList. + self title: aString. + addAllowed := aBoolean. + window := ToolBuilder default open: self. + window center: Sensor cursorPoint. + window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false. + builder runModal: window. + ^ result! Item was added: + ----- Method: ListChooser>>canAdd (in category 'testing') ----- + canAdd + ^ addAllowed and: [ self canAccept not ]! Item was changed: ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui requests') ----- + chooseFrom: aList lines: linesArray title: aString - 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 ]! - aList size > 30 ifTrue:[ - "No point in displaying more than 30 items as list. Use ChooserTool insted" - ^ChooserTool chooseFrom: aList title: aString. - ] ifFalse:[ - ^MenuMorph chooseFrom: aList lines: linesArray title: aString - ].! Item was added: + ----- Method: ListChooser>>cancelColor (in category 'drawing') ----- + cancelColor + ^ ColorTheme current cancelColor! Item was added: + ----- Method: ListChooser>>title (in category 'accessing') ----- + title + ^ title ifNil: [ title := 'Please choose' ]! Item was added: + ----- Method: ListChooser>>searchText (in category 'accessing') ----- + searchText + ^ searchText ifNil: [ searchText := '' ]! Item was added: + ----- Method: ListChooser>>selectedIndex: (in category 'accessing') ----- + selectedIndex: anInt + index := (anInt min: selectedItems size). + self changed: #selectedIndex. + self changed: #canAccept.! Item was added: + ----- Method: ListChooser>>buildWith: (in category 'building') ----- + buildWith: aBuilder + | windowSpec | + builder := aBuilder. + windowSpec := self buildWindowWith: builder specs: { + (0@0 corner: 1@0.05) -> [self buildSearchMorphWith: builder]. + (0@0.05 corner: 1@0.9) -> [self buildListMorphWith: builder]. + (0@0.9 corner: 1@1) -> [self buildButtonBarWith: builder]. + }. + windowSpec closeAction: #closed. + windowSpec extent: self initialExtent. + window := builder build: windowSpec. + + + searchMorph := window submorphs detect: + [ :each | each isKindOf: PluggableTextMorph ]. + searchMorph + hideScrollBarsIndefinitely; + acceptOnCR: true; + setBalloonText: 'Type a string to filter down the listed items'; + onKeyStrokeSend: #keyStroke: to: self; + hasUnacceptedEdits: true "force acceptOnCR to work even with no text entered". + listMorph := window submorphs detect: + [ :each | each isKindOf: PluggableListMorph ]. + ^ window! Item was added: + Object subclass: #ListChooser + instanceVariableNames: 'window fullList selectedItems searchText searchMorph title listMorph index realIndex buttonBar builder addAllowed result' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolBuilder-Morphic'! + + !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0! + I am a simple dialog to allow the user to pick from a list of strings or symbols. + I support keyboard and mouse navigation, and interactive filtering of the displayed items. + + You can specify whether you want the index, or the value of the selected item. If you're interested in the value, you can also allow users to Add a new value not in the list. + + cmd-s or <enter> or double-click answers the currently selected item's value/index; + cmd-l or <escape> or closing the window answers nil/zero. + + Now using ToolBuilder, so needs Morphic-MAD.381. + + Released under the MIT Licence.! Item was added: + ----- Method: ListChooser classSide>>testItemAdd (in category 'examples') ----- + testItemAdd + ^ self + chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection + title: 'Pick or Add:' + addAllowed: true! Item was added: + ----- Method: ListChooser>>keyStrokeFromList: (in category 'event handling') ----- + keyStrokeFromList: event + "we don't want the list to be picking up events" + window world primaryHand keyboardFocus: searchMorph. + searchMorph keyStroke: event. + "let the list know we've dealt with it" + ^ true! Item was changed: ----- Method: MorphicUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') ----- + chooseFrom: labelList values: valueList lines: linesArray title: aString - 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 ]! - labelList size > 30 ifTrue:[ - "No point in displaying more than 30 items as list. Use ChooserTool insted" - index := ChooserTool chooseFrom: labelList title: aString. - ^ index = 0 ifFalse:[valueList at: index]. - ] ifFalse:[ - ^MenuMorph chooseFrom: labelList values: valueList lines: linesArray title: aString - ].! Item was added: + ----- Method: ListChooser>>keyStroke: (in category 'event handling') ----- + keyStroke: event + | newText key | + "handle updates to the search box interactively" + key := event keyString. + (key = '<up>') ifTrue: [ + self move: -1. + ^ self ]. + (key = '<down>') ifTrue: [ + self move: 1. + ^ self ]. + + (key = '<Cmd-s>') ifTrue: [ self accept. ^ self ]. + (key = '<cr>') ifTrue: [ self accept. ^ self ]. + + (key = '<escape>') ifTrue: [ self cancel. ^ self ]. + (key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ]. + + (key = '<Cmd-a>') ifTrue: [ self add. ^ self ]. + + "pull out what's been typed, and update the list as required" + newText := searchMorph textMorph asText asString. + (newText = searchText) ifFalse: [ + searchText := newText. + self updateFilter ]. + ! Item was added: + ----- Method: ListChooser>>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; + color: #acceptColor; + frame: (0.0 @ 0.0 corner: 0.34@1). + panel children add: button. + + button := builder pluggableButtonSpec new. + button + model: self; + label: 'Add (a)'; + action: #add; + enabled: #canAdd; + frame: (0.36 @ 0.0 corner: 0.63@1). + panel children add: button. + + button := builder pluggableButtonSpec new. + button + model: self; + label: 'Cancel (l)'; + action: #cancel; + color: #cancelColor; + frame: (0.65 @ 0.0 corner: 1@1). + panel children add: button. + + ^ panel! Item was added: + ----- Method: ListChooser classSide>>chooseItemFrom:title: (in category 'instance creation') ----- + chooseItemFrom: aList title: aString + ^ self + chooseItemFrom: aList + title: aString + addAllowed: false! Item was added: + ----- Method: ListChooser>>selectedIndex (in category 'accessing') ----- + selectedIndex + ^ index ifNil: [ index := 1 ]! Item was added: + ----- Method: ListChooser>>acceptText: (in category 'event handling') ----- + acceptText: someText + "the text morph wants to tell us about its contents but I don't care, I'm only interested in the list" + self accept! Item was added: + ----- Method: ListChooser>>updateFilter (in category 'event handling') ----- + updateFilter + selectedItems := + searchText isEmptyOrNil + ifTrue: [ fullList ] + ifFalse: [ fullList select: [ :each | each includesSubstring: searchText caseSensitive: false ] ]. + self changed: #list. + self selectedIndex: 1. + self changed: #selectedIndex.! Item was added: + ----- Method: ListChooser>>canAccept (in category 'testing') ----- + canAccept + ^ self selectedIndex > 0! Item was added: + ----- Method: ListChooser classSide>>testIndex (in category 'examples') ----- + testIndex + ^ self + chooseIndexFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection + title: 'Pick a class'! Item was added: + ----- Method: ListChooser classSide>>chooseFrom: (in category 'ChooserTool compatibility') ----- + chooseFrom: aList + ^ self + chooseFrom: aList + title: self defaultTitle! Item was added: + ----- Method: ListChooser>>handlesKeyboard: (in category 'event handling') ----- + handlesKeyboard: evt + ^ true! Item was added: + ----- Method: ListChooser>>list:title: (in category 'accessing') ----- + list: aList title: aString + self list: aList. + self title: aString! Item was added: + ----- Method: ListChooser>>list: (in category 'accessing') ----- + list: items + fullList := items. + selectedItems := items. + self changed: #itemList.! Item was added: + ----- Method: ListChooser classSide>>testDictionary (in category 'examples') ----- + testDictionary + ^ self + chooseItemFrom: (Dictionary newFrom: {#a->1. 2->#b.}) + title: 'Pick from Dictionary' "gives values, not keys"! Item was added: + ----- Method: ListChooser>>initialExtent (in category 'building') ----- + initialExtent + | listFont titleFont buttonFont listWidth titleWidth buttonWidth | + listFont := Preferences standardListFont. + titleFont := Preferences windowTitleFont. + buttonFont := Preferences standardButtonFont. + listWidth := 20 * (listFont widthOf: $m). + titleWidth := titleFont widthOfString: self title, '__________'. "add some space for titlebar icons" + buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add (a)___Cancel_(l)_'. + ^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont height))! Item was added: + ----- Method: ListChooser classSide>>chooseFrom:title: (in category 'ChooserTool compatibility') ----- + chooseFrom: aList title: aString + ^ self + chooseIndexFrom: aList + title: aString + addAllowed: false! Item was added: + ----- Method: ListChooser>>closed (in category 'event handling') ----- + closed + "Cancel the dialog and move on" + builder ifNotNil: [ index := 0 ]! Item was added: + ----- Method: ListChooser>>move: (in category 'event handling') ----- + move: offset + | newindex | + "The up arrow key moves the cursor, and it seems impossible to restore. + So, for consistency, on either arrow, select everything, so a new letter-press starts over. yuk." + searchMorph selectAll. + + newindex := self selectedIndex + offset. + newindex > selectedItems size ifTrue: [ ^ nil ]. + newindex < 1 ifTrue: [ ^ nil ]. + self selectedIndex: newindex. + ! Item was added: + ----- Method: ListChooser classSide>>chooseIndexFrom: (in category 'instance creation') ----- + chooseIndexFrom: aList + ^ self + chooseIndexFrom: aList + title: self defaultTitle! Item was added: + ----- Method: ListChooser>>add (in category 'event handling') ----- + add + "if the user submits with no valid entry, make them start over" + self canAdd ifFalse: [ + searchMorph selectAll. + ^ self ]. + + "find the string to return" + result := searchMorph getText. + + builder ifNotNil: [ :bldr | + builder := nil. + bldr close: window ]! Item was added: + ----- Method: ListChooser>>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: - Model subclass: #ChooserTool - instanceVariableNames: 'label items index builder window' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !ChooserTool commentStamp: 'ar 12/9/2009 23:46' prior: 0! - A simple chooser tool for Morphic. Useful when menus just get too long.! Item was removed: - ----- Method: ChooserTool>>canAccept (in category 'accessing') ----- - canAccept - ^self itemListIndex > 0! Item was removed: - ----- Method: ChooserTool>>closed (in category 'actions') ----- - closed - "Cancel the dialog and move on" - builder ifNotNil:[index := 0].! Item was removed: - ----- Method: ChooserTool class>>chooseFrom:title: (in category 'tools') ----- - chooseFrom: labelList title: aString - ^self new chooseFrom: labelList title: aString! Item was removed: - ----- Method: ChooserTool>>label (in category 'accessing') ----- - label - ^label! Item was removed: - ----- Method: ChooserTool>>chooseFrom:title: (in category 'initialize') ----- - chooseFrom: labelList title: aString - builder := ToolBuilder default. - self itemList: labelList. - self label: aString. - window := ToolBuilder default open: self. - window center: Sensor cursorPoint. - window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false. - builder runModal: window. - ^self itemListIndex! Item was removed: - ----- Method: ChooserTool>>cancel (in category 'actions') ----- - cancel - "Cancel the dialog and move on" - index := 0. - builder ifNotNil:[builder close: window].! Item was removed: - ----- Method: ChooserTool>>buildWindowWith:specs: (in category 'toolbuilder') ----- - 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: ChooserTool>>itemList (in category 'accessing') ----- - itemList - ^items! Item was removed: - ----- Method: ChooserTool>>buildWindowWith: (in category 'toolbuilder') ----- - buildWindowWith: builder - | windowSpec | - windowSpec := builder pluggableWindowSpec new. - windowSpec model: self. - windowSpec label: #labelString. - windowSpec children: OrderedCollection new. - ^windowSpec! Item was removed: - ----- Method: ChooserTool>>itemListIndex (in category 'accessing') ----- - itemListIndex - ^index ifNil:[0]! Item was removed: - ----- Method: ChooserTool>>accept (in category 'actions') ----- - accept - "Accept current selection and move on" - builder ifNotNil:[:bldr| - builder := nil. - bldr close: window].! Item was removed: - ----- Method: ChooserTool>>buildButtonsWith: (in category 'toolbuilder') ----- - buildButtonsWith: aBuilder - | panel button | - panel := aBuilder pluggablePanelSpec new - model: self; - layout: #proportional; - children: OrderedCollection new. - button := aBuilder pluggableButtonSpec new. - button - model: self; - label: 'Accept'; - action: #accept; - enabled: #canAccept; - frame: (0.0 @ 0.0 corner: 0.48@1). - panel children add: button. - - button := aBuilder pluggableButtonSpec new. - button - model: self; - label: 'Cancel'; - action: #cancel; - frame: (0.52 @ 0.0 corner: 1@1). - panel children add: button. - ^panel! Item was removed: - ----- Method: ChooserTool>>itemList: (in category 'accessing') ----- - itemList: aCollection - items := aCollection. - self changed: #items.! Item was removed: - ----- Method: ChooserTool>>itemListIndex: (in category 'accessing') ----- - itemListIndex: newIndex - index := newIndex. - self changed: #itemListIndex. - self changed: #canAccept.! Item was removed: - ----- Method: ChooserTool>>label: (in category 'accessing') ----- - label: aString - label := aString.! Item was removed: - ----- Method: ChooserTool>>buildWith: (in category 'toolbuilder') ----- - buildWith: aBuilder - | windowSpec | - builder := aBuilder. - windowSpec := self buildWindowWith: builder specs: { - (0@0 corner: 1@0.9) -> [self buildChooserListWith: builder]. - (0@0.9 corner: 1@1) -> [self buildButtonsWith: builder]. - }. - windowSpec closeAction: #closed. - windowSpec extent: 250@350. - ^builder build: windowSpec! Item was removed: - ----- Method: ChooserTool>>labelString (in category 'accessing') ----- - labelString - ^label! Item was removed: - ----- Method: ChooserTool>>buildChooserListWith: (in category 'toolbuilder') ----- - buildChooserListWith: builder - | listSpec | - listSpec := builder pluggableListSpec new. - listSpec - model: self; - list: #itemList; - getIndex: #itemListIndex; - setIndex: #itemListIndex:; - doubleClick: #accept; - autoDeselect: false. - ^listSpec - ! Item was removed: - ----- Method: ChooserTool class>>open (in category 'opening') ----- - open - ^ToolBuilder open: self! |
Something is broken. I get an emergency evaluator after updating to 9713
and trying to open the TestRunner. Levente On Mon, 15 Mar 2010, [hidden email] wrote: > Chris Muller uploaded a new version of ToolBuilder-Morphic to project The Trunk: > http://source.squeak.org/trunk/ToolBuilder-Morphic-cmm.53.mcz > > ==================== Summary ==================== > > Name: ToolBuilder-Morphic-cmm.53 > Author: cmm > Time: 15 March 2010, 6:59:31.15 pm > UUID: 8558cdec-3e86-460b-a52a-66237e0d22e6 > Ancestors: ToolBuilder-Morphic-MAD.52 > > Integrated new ListChooser from Michael Davies. > > =============== Diff against ToolBuilder-Morphic-cmm.51 =============== > > Item was added: > + ----- Method: ListChooser classSide>>chooseIndexFrom:title: (in category 'instance creation') ----- > + chooseIndexFrom: aList title: aString > + ^ self > + chooseIndexFrom: aList > + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ]) > + addAllowed: false! > > Item was added: > + ----- Method: ListChooser classSide>>testItem (in category 'examples') ----- > + testItem > + ^ self > + chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection > + title: 'Pick a class'! > > Item was added: > + ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') ----- > + moveWindowNear: aPoint > + | trialRect delta | > + trialRect := Rectangle center: aPoint extent: window fullBounds extent. > + delta := trialRect amountToTranslateWithin: World bounds. > + window position: trialRect origin + delta.! > > Item was added: > + ----- Method: ListChooser classSide>>defaultTitle (in category 'instance creation') ----- > + defaultTitle > + ^ 'Please choose:'! > > Item was added: > + ----- Method: ListChooser classSide>>testSet (in category 'examples') ----- > + testSet > + ^ self > + chooseItemFrom: #(a list of values as a Set) asSet > + title: 'Pick from Set'! > > Item was added: > + ----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') ----- > + chooseIndexFrom: labelList title: aString > + | choice | > + choice := self chooseItemFrom: labelList title: aString addAllowed: false. > + ^ fullList indexOf: choice ifAbsent: 0! > > Item was added: > + ----- Method: ListChooser>>buildListMorphWith: (in category 'building') ----- > + buildListMorphWith: builder > + | listSpec | > + listSpec := builder pluggableListSpec new. > + listSpec > + model: self; > + list: #list; > + getIndex: #selectedIndex; > + setIndex: #selectedIndex:; > + doubleClick: #accept; > + "handleBasicKeys: false;" > + keystrokePreview: #keyStrokeFromList:; > + "doubleClickSelector: #accept;" > + autoDeselect: false. > + ^ listSpec! > > Item was added: > + ----- Method: ListChooser classSide>>chooseItemFrom: (in category 'instance creation') ----- > + chooseItemFrom: aList > + ^ self > + chooseItemFrom: aList > + title: self defaultTitle! > > Item was added: > + ----- Method: ListChooser classSide>>testLongTitle (in category 'examples') ----- > + testLongTitle > + ^ self > + chooseItemFrom: #(this is a list of values that aren/t the point here) > + title: 'Pick from some values from this list'! > > Item was added: > + ----- Method: ListChooser>>buildWindowWith:specs: (in category 'building') ----- > + buildWindowWith: builder specs: specs > + | windowSpec | > + windowSpec := self buildWindowWith: builder. > + specs do: [ :assoc | > + | rect action widgetSpec | > + rect := assoc key. > + action := assoc value. > + widgetSpec := action value. > + widgetSpec ifNotNil:[ > + widgetSpec frame: rect. > + windowSpec children add: widgetSpec ] ]. > + ^ windowSpec! > > Item was added: > + ----- Method: ListChooser>>cancel (in category 'event handling') ----- > + cancel > + "Cancel the dialog and move on" > + index := 0. > + builder ifNotNil: [ builder close: window ]! > > Item was added: > + ----- Method: ListChooser>>buildSearchMorphWith: (in category 'building') ----- > + buildSearchMorphWith: builder > + | fieldSpec | > + fieldSpec := builder pluggableInputFieldSpec new. > + fieldSpec > + model: self; > + getText: #searchText; > + setText: #acceptText:; > + menu: nil. > + "hideScrollBarsIndefinitely;" > + "acceptOnCR: true;" > + "setBalloonText: 'Type a string to filter down the listed items'." > + "onKeyStrokeSend: #keyStroke: to: self." > + ^ fieldSpec! > > Item was added: > + ----- Method: ListChooser>>buildWindowWith: (in category 'building') ----- > + buildWindowWith: builder > + | windowSpec | > + windowSpec := builder pluggableWindowSpec new. > + windowSpec model: self. > + windowSpec label: #title. > + windowSpec children: OrderedCollection new. > + ^windowSpec! > > Item was added: > + ----- Method: ListChooser classSide>>chooseIndexFrom:title:addAllowed: (in category 'instance creation') ----- > + chooseIndexFrom: aList title: aString addAllowed: aBoolean > + ^ self new > + chooseIndexFrom: aList > + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ]) > + addAllowed: aBoolean! > > Item was added: > + ----- Method: ListChooser>>searchText: (in category 'accessing') ----- > + searchText: aString > + searchText := aString! > > Item was added: > + ----- Method: ListChooser>>title: (in category 'accessing') ----- > + title: aString > + title := aString.! > > Item was added: > + ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') ----- > + chooseIndexFrom: labelList title: aString addAllowed: aBoolean > + | choice | > + choice := self chooseItemFrom: labelList title: aString addAllowed: false. > + addAllowed := aBoolean. > + ^ fullList indexOf: choice ifAbsent: 0! > > Item was added: > + ----- Method: ListChooser>>realIndex (in category 'accessing') ----- > + realIndex > + ^ realIndex ifNil: [ 0 ]! > > Item was added: > + ----- Method: ListChooser>>list (in category 'accessing') ----- > + list > + ^ selectedItems! > > Item was changed: > ----- 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 doubleClickSelector: aSpec doubleClick. > widget dragItemSelector: aSpec dragItem. > widget dropItemSelector: aSpec dropItem. > widget wantsDropSelector: aSpec dropAccept. > widget autoDeselect: aSpec autoDeselect. > + widget keystrokePreviewSelector: aSpec keystrokePreview. > self buildHelpFor: widget spec: aSpec. > self setFrame: aSpec frame in: widget. > parent ifNotNil:[self add: widget to: parent]. > panes ifNotNil:[ > aSpec list ifNotNil:[panes add: aSpec list]. > ]. > ^widget! > > Item was added: > + ----- Method: ListChooser>>accept (in category 'event handling') ----- > + accept > + "if the user submits with no valid entry, make them start over" > + self canAccept ifFalse: [ > + searchMorph selectAll. > + ^ self ]. > + > + "find the selected item in the original list, and return it" > + result := selectedItems at: index. > + > + builder ifNotNil: [ :bldr | > + builder := nil. > + bldr close: window ]! > > Item was added: > + ----- Method: ListChooser classSide>>chooseItemFrom:title:addAllowed: (in category 'instance creation') ----- > + chooseItemFrom: aList title: aString addAllowed: aBoolean > + ^ self new > + chooseItemFrom: aList > + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ]) > + addAllowed: aBoolean! > > Item was added: > + ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') ----- > + chooseItemFrom: labelList title: aString addAllowed: aBoolean > + fullList := labelList asOrderedCollection. "coerce everything into an OC" > + builder := ToolBuilder default. > + self list: fullList. > + self title: aString. > + addAllowed := aBoolean. > + window := ToolBuilder default open: self. > + window center: Sensor cursorPoint. > + window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false. > + builder runModal: window. > + ^ result! > > Item was added: > + ----- Method: ListChooser>>canAdd (in category 'testing') ----- > + canAdd > + ^ addAllowed and: [ self canAccept not ]! > > Item was changed: > ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui requests') ----- > + chooseFrom: aList lines: linesArray title: aString > - 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 ]! > - aList size > 30 ifTrue:[ > - "No point in displaying more than 30 items as list. Use ChooserTool insted" > - ^ChooserTool chooseFrom: aList title: aString. > - ] ifFalse:[ > - ^MenuMorph chooseFrom: aList lines: linesArray title: aString > - ].! > > Item was added: > + ----- Method: ListChooser>>cancelColor (in category 'drawing') ----- > + cancelColor > + ^ ColorTheme current cancelColor! > > Item was added: > + ----- Method: ListChooser>>title (in category 'accessing') ----- > + title > + ^ title ifNil: [ title := 'Please choose' ]! > > Item was added: > + ----- Method: ListChooser>>searchText (in category 'accessing') ----- > + searchText > + ^ searchText ifNil: [ searchText := '' ]! > > Item was added: > + ----- Method: ListChooser>>selectedIndex: (in category 'accessing') ----- > + selectedIndex: anInt > + index := (anInt min: selectedItems size). > + self changed: #selectedIndex. > + self changed: #canAccept.! > > Item was added: > + ----- Method: ListChooser>>buildWith: (in category 'building') ----- > + buildWith: aBuilder > + | windowSpec | > + builder := aBuilder. > + windowSpec := self buildWindowWith: builder specs: { > + (0@0 corner: 1@0.05) -> [self buildSearchMorphWith: builder]. > + (0@0.05 corner: 1@0.9) -> [self buildListMorphWith: builder]. > + (0@0.9 corner: 1@1) -> [self buildButtonBarWith: builder]. > + }. > + windowSpec closeAction: #closed. > + windowSpec extent: self initialExtent. > + window := builder build: windowSpec. > + > + > + searchMorph := window submorphs detect: > + [ :each | each isKindOf: PluggableTextMorph ]. > + searchMorph > + hideScrollBarsIndefinitely; > + acceptOnCR: true; > + setBalloonText: 'Type a string to filter down the listed items'; > + onKeyStrokeSend: #keyStroke: to: self; > + hasUnacceptedEdits: true "force acceptOnCR to work even with no text entered". > + listMorph := window submorphs detect: > + [ :each | each isKindOf: PluggableListMorph ]. > + ^ window! > > Item was added: > + Object subclass: #ListChooser > + instanceVariableNames: 'window fullList selectedItems searchText searchMorph title listMorph index realIndex buttonBar builder addAllowed result' > + classVariableNames: '' > + poolDictionaries: '' > + category: 'ToolBuilder-Morphic'! > + > + !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0! > + I am a simple dialog to allow the user to pick from a list of strings or symbols. > + I support keyboard and mouse navigation, and interactive filtering of the displayed items. > + > + You can specify whether you want the index, or the value of the selected item. If you're interested in the value, you can also allow users to Add a new value not in the list. > + > + cmd-s or <enter> or double-click answers the currently selected item's value/index; > + cmd-l or <escape> or closing the window answers nil/zero. > + > + Now using ToolBuilder, so needs Morphic-MAD.381. > + > + Released under the MIT Licence.! > > Item was added: > + ----- Method: ListChooser classSide>>testItemAdd (in category 'examples') ----- > + testItemAdd > + ^ self > + chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection > + title: 'Pick or Add:' > + addAllowed: true! > > Item was added: > + ----- Method: ListChooser>>keyStrokeFromList: (in category 'event handling') ----- > + keyStrokeFromList: event > + "we don't want the list to be picking up events" > + window world primaryHand keyboardFocus: searchMorph. > + searchMorph keyStroke: event. > + "let the list know we've dealt with it" > + ^ true! > > Item was changed: > ----- Method: MorphicUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') ----- > + chooseFrom: labelList values: valueList lines: linesArray title: aString > - 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 ]! > - labelList size > 30 ifTrue:[ > - "No point in displaying more than 30 items as list. Use ChooserTool insted" > - index := ChooserTool chooseFrom: labelList title: aString. > - ^ index = 0 ifFalse:[valueList at: index]. > - ] ifFalse:[ > - ^MenuMorph chooseFrom: labelList values: valueList lines: linesArray title: aString > - ].! > > Item was added: > + ----- Method: ListChooser>>keyStroke: (in category 'event handling') ----- > + keyStroke: event > + | newText key | > + "handle updates to the search box interactively" > + key := event keyString. > + (key = '<up>') ifTrue: [ > + self move: -1. > + ^ self ]. > + (key = '<down>') ifTrue: [ > + self move: 1. > + ^ self ]. > + > + (key = '<Cmd-s>') ifTrue: [ self accept. ^ self ]. > + (key = '<cr>') ifTrue: [ self accept. ^ self ]. > + > + (key = '<escape>') ifTrue: [ self cancel. ^ self ]. > + (key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ]. > + > + (key = '<Cmd-a>') ifTrue: [ self add. ^ self ]. > + > + "pull out what's been typed, and update the list as required" > + newText := searchMorph textMorph asText asString. > + (newText = searchText) ifFalse: [ > + searchText := newText. > + self updateFilter ]. > + ! > > Item was added: > + ----- Method: ListChooser>>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; > + color: #acceptColor; > + frame: (0.0 @ 0.0 corner: 0.34@1). > + panel children add: button. > + > + button := builder pluggableButtonSpec new. > + button > + model: self; > + label: 'Add (a)'; > + action: #add; > + enabled: #canAdd; > + frame: (0.36 @ 0.0 corner: 0.63@1). > + panel children add: button. > + > + button := builder pluggableButtonSpec new. > + button > + model: self; > + label: 'Cancel (l)'; > + action: #cancel; > + color: #cancelColor; > + frame: (0.65 @ 0.0 corner: 1@1). > + panel children add: button. > + > + ^ panel! > > Item was added: > + ----- Method: ListChooser classSide>>chooseItemFrom:title: (in category 'instance creation') ----- > + chooseItemFrom: aList title: aString > + ^ self > + chooseItemFrom: aList > + title: aString > + addAllowed: false! > > Item was added: > + ----- Method: ListChooser>>selectedIndex (in category 'accessing') ----- > + selectedIndex > + ^ index ifNil: [ index := 1 ]! > > Item was added: > + ----- Method: ListChooser>>acceptText: (in category 'event handling') ----- > + acceptText: someText > + "the text morph wants to tell us about its contents but I don't care, I'm only interested in the list" > + self accept! > > Item was added: > + ----- Method: ListChooser>>updateFilter (in category 'event handling') ----- > + updateFilter > + selectedItems := > + searchText isEmptyOrNil > + ifTrue: [ fullList ] > + ifFalse: [ fullList select: [ :each | each includesSubstring: searchText caseSensitive: false ] ]. > + self changed: #list. > + self selectedIndex: 1. > + self changed: #selectedIndex.! > > Item was added: > + ----- Method: ListChooser>>canAccept (in category 'testing') ----- > + canAccept > + ^ self selectedIndex > 0! > > Item was added: > + ----- Method: ListChooser classSide>>testIndex (in category 'examples') ----- > + testIndex > + ^ self > + chooseIndexFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection > + title: 'Pick a class'! > > Item was added: > + ----- Method: ListChooser classSide>>chooseFrom: (in category 'ChooserTool compatibility') ----- > + chooseFrom: aList > + ^ self > + chooseFrom: aList > + title: self defaultTitle! > > Item was added: > + ----- Method: ListChooser>>handlesKeyboard: (in category 'event handling') ----- > + handlesKeyboard: evt > + ^ true! > > Item was added: > + ----- Method: ListChooser>>list:title: (in category 'accessing') ----- > + list: aList title: aString > + self list: aList. > + self title: aString! > > Item was added: > + ----- Method: ListChooser>>list: (in category 'accessing') ----- > + list: items > + fullList := items. > + selectedItems := items. > + self changed: #itemList.! > > Item was added: > + ----- Method: ListChooser classSide>>testDictionary (in category 'examples') ----- > + testDictionary > + ^ self > + chooseItemFrom: (Dictionary newFrom: {#a->1. 2->#b.}) > + title: 'Pick from Dictionary' "gives values, not keys"! > > Item was added: > + ----- Method: ListChooser>>initialExtent (in category 'building') ----- > + initialExtent > + | listFont titleFont buttonFont listWidth titleWidth buttonWidth | > + listFont := Preferences standardListFont. > + titleFont := Preferences windowTitleFont. > + buttonFont := Preferences standardButtonFont. > + listWidth := 20 * (listFont widthOf: $m). > + titleWidth := titleFont widthOfString: self title, '__________'. "add some space for titlebar icons" > + buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add (a)___Cancel_(l)_'. > + ^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont height))! > > Item was added: > + ----- Method: ListChooser classSide>>chooseFrom:title: (in category 'ChooserTool compatibility') ----- > + chooseFrom: aList title: aString > + ^ self > + chooseIndexFrom: aList > + title: aString > + addAllowed: false! > > Item was added: > + ----- Method: ListChooser>>closed (in category 'event handling') ----- > + closed > + "Cancel the dialog and move on" > + builder ifNotNil: [ index := 0 ]! > > Item was added: > + ----- Method: ListChooser>>move: (in category 'event handling') ----- > + move: offset > + | newindex | > + "The up arrow key moves the cursor, and it seems impossible to restore. > + So, for consistency, on either arrow, select everything, so a new letter-press starts over. yuk." > + searchMorph selectAll. > + > + newindex := self selectedIndex + offset. > + newindex > selectedItems size ifTrue: [ ^ nil ]. > + newindex < 1 ifTrue: [ ^ nil ]. > + self selectedIndex: newindex. > + ! > > Item was added: > + ----- Method: ListChooser classSide>>chooseIndexFrom: (in category 'instance creation') ----- > + chooseIndexFrom: aList > + ^ self > + chooseIndexFrom: aList > + title: self defaultTitle! > > Item was added: > + ----- Method: ListChooser>>add (in category 'event handling') ----- > + add > + "if the user submits with no valid entry, make them start over" > + self canAdd ifFalse: [ > + searchMorph selectAll. > + ^ self ]. > + > + "find the string to return" > + result := searchMorph getText. > + > + builder ifNotNil: [ :bldr | > + builder := nil. > + bldr close: window ]! > > Item was added: > + ----- Method: ListChooser>>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: > - Model subclass: #ChooserTool > - instanceVariableNames: 'label items index builder window' > - classVariableNames: '' > - poolDictionaries: '' > - category: 'ToolBuilder-Morphic'! > - > - !ChooserTool commentStamp: 'ar 12/9/2009 23:46' prior: 0! > - A simple chooser tool for Morphic. Useful when menus just get too long.! > > Item was removed: > - ----- Method: ChooserTool>>canAccept (in category 'accessing') ----- > - canAccept > - ^self itemListIndex > 0! > > Item was removed: > - ----- Method: ChooserTool>>closed (in category 'actions') ----- > - closed > - "Cancel the dialog and move on" > - builder ifNotNil:[index := 0].! > > Item was removed: > - ----- Method: ChooserTool class>>chooseFrom:title: (in category 'tools') ----- > - chooseFrom: labelList title: aString > - ^self new chooseFrom: labelList title: aString! > > Item was removed: > - ----- Method: ChooserTool>>label (in category 'accessing') ----- > - label > - ^label! > > Item was removed: > - ----- Method: ChooserTool>>chooseFrom:title: (in category 'initialize') ----- > - chooseFrom: labelList title: aString > - builder := ToolBuilder default. > - self itemList: labelList. > - self label: aString. > - window := ToolBuilder default open: self. > - window center: Sensor cursorPoint. > - window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false. > - builder runModal: window. > - ^self itemListIndex! > > Item was removed: > - ----- Method: ChooserTool>>cancel (in category 'actions') ----- > - cancel > - "Cancel the dialog and move on" > - index := 0. > - builder ifNotNil:[builder close: window].! > > Item was removed: > - ----- Method: ChooserTool>>buildWindowWith:specs: (in category 'toolbuilder') ----- > - 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: ChooserTool>>itemList (in category 'accessing') ----- > - itemList > - ^items! > > Item was removed: > - ----- Method: ChooserTool>>buildWindowWith: (in category 'toolbuilder') ----- > - buildWindowWith: builder > - | windowSpec | > - windowSpec := builder pluggableWindowSpec new. > - windowSpec model: self. > - windowSpec label: #labelString. > - windowSpec children: OrderedCollection new. > - ^windowSpec! > > Item was removed: > - ----- Method: ChooserTool>>itemListIndex (in category 'accessing') ----- > - itemListIndex > - ^index ifNil:[0]! > > Item was removed: > - ----- Method: ChooserTool>>accept (in category 'actions') ----- > - accept > - "Accept current selection and move on" > - builder ifNotNil:[:bldr| > - builder := nil. > - bldr close: window].! > > Item was removed: > - ----- Method: ChooserTool>>buildButtonsWith: (in category 'toolbuilder') ----- > - buildButtonsWith: aBuilder > - | panel button | > - panel := aBuilder pluggablePanelSpec new > - model: self; > - layout: #proportional; > - children: OrderedCollection new. > - button := aBuilder pluggableButtonSpec new. > - button > - model: self; > - label: 'Accept'; > - action: #accept; > - enabled: #canAccept; > - frame: (0.0 @ 0.0 corner: 0.48@1). > - panel children add: button. > - > - button := aBuilder pluggableButtonSpec new. > - button > - model: self; > - label: 'Cancel'; > - action: #cancel; > - frame: (0.52 @ 0.0 corner: 1@1). > - panel children add: button. > - ^panel! > > Item was removed: > - ----- Method: ChooserTool>>itemList: (in category 'accessing') ----- > - itemList: aCollection > - items := aCollection. > - self changed: #items.! > > Item was removed: > - ----- Method: ChooserTool>>itemListIndex: (in category 'accessing') ----- > - itemListIndex: newIndex > - index := newIndex. > - self changed: #itemListIndex. > - self changed: #canAccept.! > > Item was removed: > - ----- Method: ChooserTool>>label: (in category 'accessing') ----- > - label: aString > - label := aString.! > > Item was removed: > - ----- Method: ChooserTool>>buildWith: (in category 'toolbuilder') ----- > - buildWith: aBuilder > - | windowSpec | > - builder := aBuilder. > - windowSpec := self buildWindowWith: builder specs: { > - (0@0 corner: 1@0.9) -> [self buildChooserListWith: builder]. > - (0@0.9 corner: 1@1) -> [self buildButtonsWith: builder]. > - }. > - windowSpec closeAction: #closed. > - windowSpec extent: 250@350. > - ^builder build: windowSpec! > > Item was removed: > - ----- Method: ChooserTool>>labelString (in category 'accessing') ----- > - labelString > - ^label! > > Item was removed: > - ----- Method: ChooserTool>>buildChooserListWith: (in category 'toolbuilder') ----- > - buildChooserListWith: builder > - | listSpec | > - listSpec := builder pluggableListSpec new. > - listSpec > - model: self; > - list: #itemList; > - getIndex: #itemListIndex; > - setIndex: #itemListIndex:; > - doubleClick: #accept; > - autoDeselect: false. > - ^listSpec > - ! > > Item was removed: > - ----- Method: ChooserTool class>>open (in category 'opening') ----- > - open > - ^ToolBuilder open: self! > > > |
Yeah, I apparently broke the trunk badly.. checking..
On Mon, Mar 15, 2010 at 7:06 PM, Levente Uzonyi <[hidden email]> wrote: > Something is broken. I get an emergency evaluator after updating to 9713 and > trying to open the TestRunner. > > > Levente > > On Mon, 15 Mar 2010, [hidden email] wrote: > >> Chris Muller uploaded a new version of ToolBuilder-Morphic to project The >> Trunk: >> http://source.squeak.org/trunk/ToolBuilder-Morphic-cmm.53.mcz >> >> ==================== Summary ==================== >> >> Name: ToolBuilder-Morphic-cmm.53 >> Author: cmm >> Time: 15 March 2010, 6:59:31.15 pm >> UUID: 8558cdec-3e86-460b-a52a-66237e0d22e6 >> Ancestors: ToolBuilder-Morphic-MAD.52 >> >> Integrated new ListChooser from Michael Davies. >> >> =============== Diff against ToolBuilder-Morphic-cmm.51 =============== >> >> Item was added: >> + ----- Method: ListChooser classSide>>chooseIndexFrom:title: (in category >> 'instance creation') ----- >> + chooseIndexFrom: aList title: aString >> + ^ self >> + chooseIndexFrom: aList >> + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] >> ifFalse: [ aString ]) >> + addAllowed: false! >> >> Item was added: >> + ----- Method: ListChooser classSide>>testItem (in category 'examples') >> ----- >> + testItem >> + ^ self >> + chooseItemFrom: (Smalltalk classNames , Smalltalk >> traitNames) asOrderedCollection >> + title: 'Pick a class'! >> >> Item was added: >> + ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') ----- >> + moveWindowNear: aPoint >> + | trialRect delta | >> + trialRect := Rectangle center: aPoint extent: window fullBounds >> extent. >> + delta := trialRect amountToTranslateWithin: World bounds. >> + window position: trialRect origin + delta.! >> >> Item was added: >> + ----- Method: ListChooser classSide>>defaultTitle (in category 'instance >> creation') ----- >> + defaultTitle >> + ^ 'Please choose:'! >> >> Item was added: >> + ----- Method: ListChooser classSide>>testSet (in category 'examples') >> ----- >> + testSet >> + ^ self >> + chooseItemFrom: #(a list of values as a Set) asSet >> + title: 'Pick from Set'! >> >> Item was added: >> + ----- Method: ListChooser>>chooseIndexFrom:title: (in category >> 'initialize-release') ----- >> + chooseIndexFrom: labelList title: aString >> + | choice | >> + choice := self chooseItemFrom: labelList title: aString >> addAllowed: false. >> + ^ fullList indexOf: choice ifAbsent: 0! >> >> Item was added: >> + ----- Method: ListChooser>>buildListMorphWith: (in category 'building') >> ----- >> + buildListMorphWith: builder >> + | listSpec | >> + listSpec := builder pluggableListSpec new. >> + listSpec >> + model: self; >> + list: #list; >> + getIndex: #selectedIndex; >> + setIndex: #selectedIndex:; >> + doubleClick: #accept; >> + "handleBasicKeys: false;" >> + keystrokePreview: #keyStrokeFromList:; >> + "doubleClickSelector: #accept;" >> + autoDeselect: false. >> + ^ listSpec! >> >> Item was added: >> + ----- Method: ListChooser classSide>>chooseItemFrom: (in category >> 'instance creation') ----- >> + chooseItemFrom: aList >> + ^ self >> + chooseItemFrom: aList >> + title: self defaultTitle! >> >> Item was added: >> + ----- Method: ListChooser classSide>>testLongTitle (in category >> 'examples') ----- >> + testLongTitle >> + ^ self >> + chooseItemFrom: #(this is a list of values that aren/t the >> point here) >> + title: 'Pick from some values from this list'! >> >> Item was added: >> + ----- Method: ListChooser>>buildWindowWith:specs: (in category >> 'building') ----- >> + buildWindowWith: builder specs: specs >> + | windowSpec | >> + windowSpec := self buildWindowWith: builder. >> + specs do: [ :assoc | >> + | rect action widgetSpec | >> + rect := assoc key. >> + action := assoc value. >> + widgetSpec := action value. >> + widgetSpec ifNotNil:[ >> + widgetSpec frame: rect. >> + windowSpec children add: widgetSpec ] ]. >> + ^ windowSpec! >> >> Item was added: >> + ----- Method: ListChooser>>cancel (in category 'event handling') ----- >> + cancel >> + "Cancel the dialog and move on" >> + index := 0. >> + builder ifNotNil: [ builder close: window ]! >> >> Item was added: >> + ----- Method: ListChooser>>buildSearchMorphWith: (in category >> 'building') ----- >> + buildSearchMorphWith: builder >> + | fieldSpec | >> + fieldSpec := builder pluggableInputFieldSpec new. >> + fieldSpec >> + model: self; >> + getText: #searchText; >> + setText: #acceptText:; >> + menu: nil. >> + "hideScrollBarsIndefinitely;" >> + "acceptOnCR: true;" >> + "setBalloonText: 'Type a string to filter down the listed >> items'." >> + "onKeyStrokeSend: #keyStroke: to: self." >> + ^ fieldSpec! >> >> Item was added: >> + ----- Method: ListChooser>>buildWindowWith: (in category 'building') >> ----- >> + buildWindowWith: builder >> + | windowSpec | >> + windowSpec := builder pluggableWindowSpec new. >> + windowSpec model: self. >> + windowSpec label: #title. >> + windowSpec children: OrderedCollection new. >> + ^windowSpec! >> >> Item was added: >> + ----- Method: ListChooser classSide>>chooseIndexFrom:title:addAllowed: >> (in category 'instance creation') ----- >> + chooseIndexFrom: aList title: aString addAllowed: aBoolean >> + ^ self new >> + chooseIndexFrom: aList >> + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] >> ifFalse: [ aString ]) >> + addAllowed: aBoolean! >> >> Item was added: >> + ----- Method: ListChooser>>searchText: (in category 'accessing') ----- >> + searchText: aString >> + searchText := aString! >> >> Item was added: >> + ----- Method: ListChooser>>title: (in category 'accessing') ----- >> + title: aString >> + title := aString.! >> >> Item was added: >> + ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in >> category 'initialize-release') ----- >> + chooseIndexFrom: labelList title: aString addAllowed: aBoolean >> + | choice | >> + choice := self chooseItemFrom: labelList title: aString >> addAllowed: false. >> + addAllowed := aBoolean. >> + ^ fullList indexOf: choice ifAbsent: 0! >> >> Item was added: >> + ----- Method: ListChooser>>realIndex (in category 'accessing') ----- >> + realIndex >> + ^ realIndex ifNil: [ 0 ]! >> >> Item was added: >> + ----- Method: ListChooser>>list (in category 'accessing') ----- >> + list >> + ^ selectedItems! >> >> Item was changed: >> ----- 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 doubleClickSelector: aSpec doubleClick. >> widget dragItemSelector: aSpec dragItem. >> widget dropItemSelector: aSpec dropItem. >> widget wantsDropSelector: aSpec dropAccept. >> widget autoDeselect: aSpec autoDeselect. >> + widget keystrokePreviewSelector: aSpec keystrokePreview. >> self buildHelpFor: widget spec: aSpec. >> self setFrame: aSpec frame in: widget. >> parent ifNotNil:[self add: widget to: parent]. >> panes ifNotNil:[ >> aSpec list ifNotNil:[panes add: aSpec list]. >> ]. >> ^widget! >> >> Item was added: >> + ----- Method: ListChooser>>accept (in category 'event handling') ----- >> + accept >> + "if the user submits with no valid entry, make them start over" >> + self canAccept ifFalse: [ >> + searchMorph selectAll. >> + ^ self ]. >> + >> + "find the selected item in the original list, and return it" >> + result := selectedItems at: index. >> + >> + builder ifNotNil: [ :bldr | >> + builder := nil. >> + bldr close: window ]! >> >> Item was added: >> + ----- Method: ListChooser classSide>>chooseItemFrom:title:addAllowed: >> (in category 'instance creation') ----- >> + chooseItemFrom: aList title: aString addAllowed: aBoolean >> + ^ self new >> + chooseItemFrom: aList >> + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] >> ifFalse: [ aString ]) >> + addAllowed: aBoolean! >> >> Item was added: >> + ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category >> 'initialize-release') ----- >> + chooseItemFrom: labelList title: aString addAllowed: aBoolean >> + fullList := labelList asOrderedCollection. "coerce everything into >> an OC" >> + builder := ToolBuilder default. >> + self list: fullList. >> + self title: aString. >> + addAllowed := aBoolean. >> + window := ToolBuilder default open: self. >> + window center: Sensor cursorPoint. >> + window setConstrainedPosition: (Sensor cursorPoint - (window >> fullBounds extent // 2)) hangOut: false. >> + builder runModal: window. >> + ^ result! >> >> Item was added: >> + ----- Method: ListChooser>>canAdd (in category 'testing') ----- >> + canAdd >> + ^ addAllowed and: [ self canAccept not ]! >> >> Item was changed: >> ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui >> requests') ----- >> + chooseFrom: aList lines: linesArray title: aString >> - 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 ]! >> - aList size > 30 ifTrue:[ >> - "No point in displaying more than 30 items as list. Use >> ChooserTool insted" >> - ^ChooserTool chooseFrom: aList title: aString. >> - ] ifFalse:[ >> - ^MenuMorph chooseFrom: aList lines: linesArray title: >> aString >> - ].! >> >> Item was added: >> + ----- Method: ListChooser>>cancelColor (in category 'drawing') ----- >> + cancelColor >> + ^ ColorTheme current cancelColor! >> >> Item was added: >> + ----- Method: ListChooser>>title (in category 'accessing') ----- >> + title >> + ^ title ifNil: [ title := 'Please choose' ]! >> >> Item was added: >> + ----- Method: ListChooser>>searchText (in category 'accessing') ----- >> + searchText >> + ^ searchText ifNil: [ searchText := '' ]! >> >> Item was added: >> + ----- Method: ListChooser>>selectedIndex: (in category 'accessing') >> ----- >> + selectedIndex: anInt >> + index := (anInt min: selectedItems size). >> + self changed: #selectedIndex. >> + self changed: #canAccept.! >> >> Item was added: >> + ----- Method: ListChooser>>buildWith: (in category 'building') ----- >> + buildWith: aBuilder >> + | windowSpec | >> + builder := aBuilder. >> + windowSpec := self buildWindowWith: builder specs: { >> + (0@0 corner: 1@0.05) -> [self buildSearchMorphWith: >> builder]. >> + (0@0.05 corner: 1@0.9) -> [self buildListMorphWith: >> builder]. >> + (0@0.9 corner: 1@1) -> [self buildButtonBarWith: builder]. >> + }. >> + windowSpec closeAction: #closed. >> + windowSpec extent: self initialExtent. >> + window := builder build: windowSpec. >> + >> + >> + searchMorph := window submorphs detect: >> + [ :each | each isKindOf: PluggableTextMorph ]. >> + searchMorph >> + hideScrollBarsIndefinitely; >> + acceptOnCR: true; >> + setBalloonText: 'Type a string to filter down the listed >> items'; >> + onKeyStrokeSend: #keyStroke: to: self; >> + hasUnacceptedEdits: true "force acceptOnCR to work even >> with no text entered". >> + listMorph := window submorphs detect: >> + [ :each | each isKindOf: PluggableListMorph ]. >> + ^ window! >> >> Item was added: >> + Object subclass: #ListChooser >> + instanceVariableNames: 'window fullList selectedItems searchText >> searchMorph title listMorph index realIndex buttonBar builder addAllowed >> result' >> + classVariableNames: '' >> + poolDictionaries: '' >> + category: 'ToolBuilder-Morphic'! >> + >> + !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0! >> + I am a simple dialog to allow the user to pick from a list of strings or >> symbols. >> + I support keyboard and mouse navigation, and interactive filtering of >> the displayed items. >> + >> + You can specify whether you want the index, or the value of the selected >> item. If you're interested in the value, you can also allow users to Add a >> new value not in the list. >> + >> + cmd-s or <enter> or double-click answers the currently selected item's >> value/index; >> + cmd-l or <escape> or closing the window answers nil/zero. >> + >> + Now using ToolBuilder, so needs Morphic-MAD.381. >> + >> + Released under the MIT Licence.! >> >> Item was added: >> + ----- Method: ListChooser classSide>>testItemAdd (in category >> 'examples') ----- >> + testItemAdd >> + ^ self >> + chooseItemFrom: (Smalltalk classNames , Smalltalk >> traitNames) asOrderedCollection >> + title: 'Pick or Add:' >> + addAllowed: true! >> >> Item was added: >> + ----- Method: ListChooser>>keyStrokeFromList: (in category 'event >> handling') ----- >> + keyStrokeFromList: event >> + "we don't want the list to be picking up events" >> + window world primaryHand keyboardFocus: searchMorph. >> + searchMorph keyStroke: event. >> + "let the list know we've dealt with it" >> + ^ true! >> >> Item was changed: >> ----- Method: MorphicUIManager>>chooseFrom:values:lines:title: (in >> category 'ui requests') ----- >> + chooseFrom: labelList values: valueList lines: linesArray title: aString >> - 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 ]! >> - labelList size > 30 ifTrue:[ >> - "No point in displaying more than 30 items as list. Use >> ChooserTool insted" >> - index := ChooserTool chooseFrom: labelList title: aString. >> - ^ index = 0 ifFalse:[valueList at: index]. >> - ] ifFalse:[ >> - ^MenuMorph chooseFrom: labelList values: valueList lines: >> linesArray title: aString >> - ].! >> >> Item was added: >> + ----- Method: ListChooser>>keyStroke: (in category 'event handling') >> ----- >> + keyStroke: event >> + | newText key | >> + "handle updates to the search box interactively" >> + key := event keyString. >> + (key = '<up>') ifTrue: [ >> + self move: -1. >> + ^ self ]. >> + (key = '<down>') ifTrue: [ >> + self move: 1. >> + ^ self ]. >> + >> + (key = '<Cmd-s>') ifTrue: [ self accept. ^ self ]. >> + (key = '<cr>') ifTrue: [ self accept. ^ self ]. >> + >> + (key = '<escape>') ifTrue: [ self cancel. ^ self ]. >> + (key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ]. >> + >> + (key = '<Cmd-a>') ifTrue: [ self add. ^ self ]. >> + >> + "pull out what's been typed, and update the list as required" >> + newText := searchMorph textMorph asText asString. >> + (newText = searchText) ifFalse: [ >> + searchText := newText. >> + self updateFilter ]. >> + ! >> >> Item was added: >> + ----- Method: ListChooser>>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; >> + color: #acceptColor; >> + frame: (0.0 @ 0.0 corner: 0.34@1). >> + panel children add: button. >> + >> + button := builder pluggableButtonSpec new. >> + button >> + model: self; >> + label: 'Add (a)'; >> + action: #add; >> + enabled: #canAdd; >> + frame: (0.36 @ 0.0 corner: 0.63@1). >> + panel children add: button. >> + >> + button := builder pluggableButtonSpec new. >> + button >> + model: self; >> + label: 'Cancel (l)'; >> + action: #cancel; >> + color: #cancelColor; >> + frame: (0.65 @ 0.0 corner: 1@1). >> + panel children add: button. >> + >> + ^ panel! >> >> Item was added: >> + ----- Method: ListChooser classSide>>chooseItemFrom:title: (in category >> 'instance creation') ----- >> + chooseItemFrom: aList title: aString >> + ^ self >> + chooseItemFrom: aList >> + title: aString >> + addAllowed: false! >> >> Item was added: >> + ----- Method: ListChooser>>selectedIndex (in category 'accessing') ----- >> + selectedIndex >> + ^ index ifNil: [ index := 1 ]! >> >> Item was added: >> + ----- Method: ListChooser>>acceptText: (in category 'event handling') >> ----- >> + acceptText: someText >> + "the text morph wants to tell us about its contents but I don't >> care, I'm only interested in the list" >> + self accept! >> >> Item was added: >> + ----- Method: ListChooser>>updateFilter (in category 'event handling') >> ----- >> + updateFilter >> + selectedItems := >> + searchText isEmptyOrNil >> + ifTrue: [ fullList ] >> + ifFalse: [ fullList select: [ :each | each >> includesSubstring: searchText caseSensitive: false ] ]. >> + self changed: #list. >> + self selectedIndex: 1. >> + self changed: #selectedIndex.! >> >> Item was added: >> + ----- Method: ListChooser>>canAccept (in category 'testing') ----- >> + canAccept >> + ^ self selectedIndex > 0! >> >> Item was added: >> + ----- Method: ListChooser classSide>>testIndex (in category 'examples') >> ----- >> + testIndex >> + ^ self >> + chooseIndexFrom: (Smalltalk classNames , Smalltalk >> traitNames) asOrderedCollection >> + title: 'Pick a class'! >> >> Item was added: >> + ----- Method: ListChooser classSide>>chooseFrom: (in category >> 'ChooserTool compatibility') ----- >> + chooseFrom: aList >> + ^ self >> + chooseFrom: aList >> + title: self defaultTitle! >> >> Item was added: >> + ----- Method: ListChooser>>handlesKeyboard: (in category 'event >> handling') ----- >> + handlesKeyboard: evt >> + ^ true! >> >> Item was added: >> + ----- Method: ListChooser>>list:title: (in category 'accessing') ----- >> + list: aList title: aString >> + self list: aList. >> + self title: aString! >> >> Item was added: >> + ----- Method: ListChooser>>list: (in category 'accessing') ----- >> + list: items >> + fullList := items. >> + selectedItems := items. >> + self changed: #itemList.! >> >> Item was added: >> + ----- Method: ListChooser classSide>>testDictionary (in category >> 'examples') ----- >> + testDictionary >> + ^ self >> + chooseItemFrom: (Dictionary newFrom: {#a->1. 2->#b.}) >> + title: 'Pick from Dictionary' "gives values, not keys"! >> >> Item was added: >> + ----- Method: ListChooser>>initialExtent (in category 'building') ----- >> + initialExtent >> + | listFont titleFont buttonFont listWidth titleWidth buttonWidth | >> + listFont := Preferences standardListFont. >> + titleFont := Preferences windowTitleFont. >> + buttonFont := Preferences standardButtonFont. >> + listWidth := 20 * (listFont widthOf: $m). >> + titleWidth := titleFont widthOfString: self title, '__________'. >> "add some space for titlebar icons" >> + buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add >> (a)___Cancel_(l)_'. >> + ^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont >> height))! >> >> Item was added: >> + ----- Method: ListChooser classSide>>chooseFrom:title: (in category >> 'ChooserTool compatibility') ----- >> + chooseFrom: aList title: aString >> + ^ self >> + chooseIndexFrom: aList >> + title: aString >> + addAllowed: false! >> >> Item was added: >> + ----- Method: ListChooser>>closed (in category 'event handling') ----- >> + closed >> + "Cancel the dialog and move on" >> + builder ifNotNil: [ index := 0 ]! >> >> Item was added: >> + ----- Method: ListChooser>>move: (in category 'event handling') ----- >> + move: offset >> + | newindex | >> + "The up arrow key moves the cursor, and it seems impossible to >> restore. >> + So, for consistency, on either arrow, select everything, so a new >> letter-press starts over. yuk." >> + searchMorph selectAll. >> + >> + newindex := self selectedIndex + offset. >> + newindex > selectedItems size ifTrue: [ ^ nil ]. >> + newindex < 1 ifTrue: [ ^ nil ]. >> + self selectedIndex: newindex. >> + ! >> >> Item was added: >> + ----- Method: ListChooser classSide>>chooseIndexFrom: (in category >> 'instance creation') ----- >> + chooseIndexFrom: aList >> + ^ self >> + chooseIndexFrom: aList >> + title: self defaultTitle! >> >> Item was added: >> + ----- Method: ListChooser>>add (in category 'event handling') ----- >> + add >> + "if the user submits with no valid entry, make them start over" >> + self canAdd ifFalse: [ >> + searchMorph selectAll. >> + ^ self ]. >> + >> + "find the string to return" >> + result := searchMorph getText. >> + >> + builder ifNotNil: [ :bldr | >> + builder := nil. >> + bldr close: window ]! >> >> Item was added: >> + ----- Method: ListChooser>>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: >> - Model subclass: #ChooserTool >> - instanceVariableNames: 'label items index builder window' >> - classVariableNames: '' >> - poolDictionaries: '' >> - category: 'ToolBuilder-Morphic'! >> - >> - !ChooserTool commentStamp: 'ar 12/9/2009 23:46' prior: 0! >> - A simple chooser tool for Morphic. Useful when menus just get too long.! >> >> Item was removed: >> - ----- Method: ChooserTool>>canAccept (in category 'accessing') ----- >> - canAccept >> - ^self itemListIndex > 0! >> >> Item was removed: >> - ----- Method: ChooserTool>>closed (in category 'actions') ----- >> - closed >> - "Cancel the dialog and move on" >> - builder ifNotNil:[index := 0].! >> >> Item was removed: >> - ----- Method: ChooserTool class>>chooseFrom:title: (in category 'tools') >> ----- >> - chooseFrom: labelList title: aString >> - ^self new chooseFrom: labelList title: aString! >> >> Item was removed: >> - ----- Method: ChooserTool>>label (in category 'accessing') ----- >> - label >> - ^label! >> >> Item was removed: >> - ----- Method: ChooserTool>>chooseFrom:title: (in category 'initialize') >> ----- >> - chooseFrom: labelList title: aString >> - builder := ToolBuilder default. >> - self itemList: labelList. >> - self label: aString. >> - window := ToolBuilder default open: self. >> - window center: Sensor cursorPoint. >> - window setConstrainedPosition: (Sensor cursorPoint - (window >> fullBounds extent // 2)) hangOut: false. >> - builder runModal: window. >> - ^self itemListIndex! >> >> Item was removed: >> - ----- Method: ChooserTool>>cancel (in category 'actions') ----- >> - cancel >> - "Cancel the dialog and move on" >> - index := 0. >> - builder ifNotNil:[builder close: window].! >> >> Item was removed: >> - ----- Method: ChooserTool>>buildWindowWith:specs: (in category >> 'toolbuilder') ----- >> - 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: ChooserTool>>itemList (in category 'accessing') ----- >> - itemList >> - ^items! >> >> Item was removed: >> - ----- Method: ChooserTool>>buildWindowWith: (in category 'toolbuilder') >> ----- >> - buildWindowWith: builder >> - | windowSpec | >> - windowSpec := builder pluggableWindowSpec new. >> - windowSpec model: self. >> - windowSpec label: #labelString. >> - windowSpec children: OrderedCollection new. >> - ^windowSpec! >> >> Item was removed: >> - ----- Method: ChooserTool>>itemListIndex (in category 'accessing') ----- >> - itemListIndex >> - ^index ifNil:[0]! >> >> Item was removed: >> - ----- Method: ChooserTool>>accept (in category 'actions') ----- >> - accept >> - "Accept current selection and move on" >> - builder ifNotNil:[:bldr| >> - builder := nil. >> - bldr close: window].! >> >> Item was removed: >> - ----- Method: ChooserTool>>buildButtonsWith: (in category 'toolbuilder') >> ----- >> - buildButtonsWith: aBuilder >> - | panel button | >> - panel := aBuilder pluggablePanelSpec new >> - model: self; >> - layout: #proportional; >> - children: OrderedCollection new. >> - button := aBuilder pluggableButtonSpec new. >> - button >> - model: self; >> - label: 'Accept'; >> - action: #accept; >> - enabled: #canAccept; >> - frame: (0.0 @ 0.0 corner: 0.48@1). >> - panel children add: button. >> - >> - button := aBuilder pluggableButtonSpec new. >> - button >> - model: self; >> - label: 'Cancel'; >> - action: #cancel; >> - frame: (0.52 @ 0.0 corner: 1@1). >> - panel children add: button. >> - ^panel! >> >> Item was removed: >> - ----- Method: ChooserTool>>itemList: (in category 'accessing') ----- >> - itemList: aCollection >> - items := aCollection. >> - self changed: #items.! >> >> Item was removed: >> - ----- Method: ChooserTool>>itemListIndex: (in category 'accessing') >> ----- >> - itemListIndex: newIndex >> - index := newIndex. >> - self changed: #itemListIndex. >> - self changed: #canAccept.! >> >> Item was removed: >> - ----- Method: ChooserTool>>label: (in category 'accessing') ----- >> - label: aString >> - label := aString.! >> >> Item was removed: >> - ----- Method: ChooserTool>>buildWith: (in category 'toolbuilder') ----- >> - buildWith: aBuilder >> - | windowSpec | >> - builder := aBuilder. >> - windowSpec := self buildWindowWith: builder specs: { >> - (0@0 corner: 1@0.9) -> [self buildChooserListWith: >> builder]. >> - (0@0.9 corner: 1@1) -> [self buildButtonsWith: builder]. >> - }. >> - windowSpec closeAction: #closed. >> - windowSpec extent: 250@350. >> - ^builder build: windowSpec! >> >> Item was removed: >> - ----- Method: ChooserTool>>labelString (in category 'accessing') ----- >> - labelString >> - ^label! >> >> Item was removed: >> - ----- Method: ChooserTool>>buildChooserListWith: (in category >> 'toolbuilder') ----- >> - buildChooserListWith: builder >> - | listSpec | >> - listSpec := builder pluggableListSpec new. >> - listSpec >> - model: self; >> - list: #itemList; >> - getIndex: #itemListIndex; >> - setIndex: #itemListIndex:; >> - doubleClick: #accept; >> - autoDeselect: false. >> - ^listSpec >> - ! >> >> Item was removed: >> - ----- Method: ChooserTool class>>open (in category 'opening') ----- >> - open >> - ^ToolBuilder open: self! >> >> >> > > |
On Mon, 15 Mar 2010, Chris Muller wrote:
> Yeah, I apparently broke the trunk badly.. checking.. Seems to be okay now, and we don't even need a new mcm. Levente > > On Mon, Mar 15, 2010 at 7:06 PM, Levente Uzonyi <[hidden email]> wrote: >> Something is broken. I get an emergency evaluator after updating to 9713 and >> trying to open the TestRunner. >> >> >> Levente >> >> On Mon, 15 Mar 2010, [hidden email] wrote: >> >>> Chris Muller uploaded a new version of ToolBuilder-Morphic to project The >>> Trunk: >>> http://source.squeak.org/trunk/ToolBuilder-Morphic-cmm.53.mcz >>> >>> ==================== Summary ==================== >>> >>> Name: ToolBuilder-Morphic-cmm.53 >>> Author: cmm >>> Time: 15 March 2010, 6:59:31.15 pm >>> UUID: 8558cdec-3e86-460b-a52a-66237e0d22e6 >>> Ancestors: ToolBuilder-Morphic-MAD.52 >>> >>> Integrated new ListChooser from Michael Davies. >>> >>> =============== Diff against ToolBuilder-Morphic-cmm.51 =============== >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>chooseIndexFrom:title: (in category >>> 'instance creation') ----- >>> + chooseIndexFrom: aList title: aString >>> + ^ self >>> + chooseIndexFrom: aList >>> + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] >>> ifFalse: [ aString ]) >>> + addAllowed: false! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>testItem (in category 'examples') >>> ----- >>> + testItem >>> + ^ self >>> + chooseItemFrom: (Smalltalk classNames , Smalltalk >>> traitNames) asOrderedCollection >>> + title: 'Pick a class'! >>> >>> Item was added: >>> + ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') ----- >>> + moveWindowNear: aPoint >>> + | trialRect delta | >>> + trialRect := Rectangle center: aPoint extent: window fullBounds >>> extent. >>> + delta := trialRect amountToTranslateWithin: World bounds. >>> + window position: trialRect origin + delta.! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>defaultTitle (in category 'instance >>> creation') ----- >>> + defaultTitle >>> + ^ 'Please choose:'! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>testSet (in category 'examples') >>> ----- >>> + testSet >>> + ^ self >>> + chooseItemFrom: #(a list of values as a Set) asSet >>> + title: 'Pick from Set'! >>> >>> Item was added: >>> + ----- Method: ListChooser>>chooseIndexFrom:title: (in category >>> 'initialize-release') ----- >>> + chooseIndexFrom: labelList title: aString >>> + | choice | >>> + choice := self chooseItemFrom: labelList title: aString >>> addAllowed: false. >>> + ^ fullList indexOf: choice ifAbsent: 0! >>> >>> Item was added: >>> + ----- Method: ListChooser>>buildListMorphWith: (in category 'building') >>> ----- >>> + buildListMorphWith: builder >>> + | listSpec | >>> + listSpec := builder pluggableListSpec new. >>> + listSpec >>> + model: self; >>> + list: #list; >>> + getIndex: #selectedIndex; >>> + setIndex: #selectedIndex:; >>> + doubleClick: #accept; >>> + "handleBasicKeys: false;" >>> + keystrokePreview: #keyStrokeFromList:; >>> + "doubleClickSelector: #accept;" >>> + autoDeselect: false. >>> + ^ listSpec! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>chooseItemFrom: (in category >>> 'instance creation') ----- >>> + chooseItemFrom: aList >>> + ^ self >>> + chooseItemFrom: aList >>> + title: self defaultTitle! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>testLongTitle (in category >>> 'examples') ----- >>> + testLongTitle >>> + ^ self >>> + chooseItemFrom: #(this is a list of values that aren/t the >>> point here) >>> + title: 'Pick from some values from this list'! >>> >>> Item was added: >>> + ----- Method: ListChooser>>buildWindowWith:specs: (in category >>> 'building') ----- >>> + buildWindowWith: builder specs: specs >>> + | windowSpec | >>> + windowSpec := self buildWindowWith: builder. >>> + specs do: [ :assoc | >>> + | rect action widgetSpec | >>> + rect := assoc key. >>> + action := assoc value. >>> + widgetSpec := action value. >>> + widgetSpec ifNotNil:[ >>> + widgetSpec frame: rect. >>> + windowSpec children add: widgetSpec ] ]. >>> + ^ windowSpec! >>> >>> Item was added: >>> + ----- Method: ListChooser>>cancel (in category 'event handling') ----- >>> + cancel >>> + "Cancel the dialog and move on" >>> + index := 0. >>> + builder ifNotNil: [ builder close: window ]! >>> >>> Item was added: >>> + ----- Method: ListChooser>>buildSearchMorphWith: (in category >>> 'building') ----- >>> + buildSearchMorphWith: builder >>> + | fieldSpec | >>> + fieldSpec := builder pluggableInputFieldSpec new. >>> + fieldSpec >>> + model: self; >>> + getText: #searchText; >>> + setText: #acceptText:; >>> + menu: nil. >>> + "hideScrollBarsIndefinitely;" >>> + "acceptOnCR: true;" >>> + "setBalloonText: 'Type a string to filter down the listed >>> items'." >>> + "onKeyStrokeSend: #keyStroke: to: self." >>> + ^ fieldSpec! >>> >>> Item was added: >>> + ----- Method: ListChooser>>buildWindowWith: (in category 'building') >>> ----- >>> + buildWindowWith: builder >>> + | windowSpec | >>> + windowSpec := builder pluggableWindowSpec new. >>> + windowSpec model: self. >>> + windowSpec label: #title. >>> + windowSpec children: OrderedCollection new. >>> + ^windowSpec! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>chooseIndexFrom:title:addAllowed: >>> (in category 'instance creation') ----- >>> + chooseIndexFrom: aList title: aString addAllowed: aBoolean >>> + ^ self new >>> + chooseIndexFrom: aList >>> + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] >>> ifFalse: [ aString ]) >>> + addAllowed: aBoolean! >>> >>> Item was added: >>> + ----- Method: ListChooser>>searchText: (in category 'accessing') ----- >>> + searchText: aString >>> + searchText := aString! >>> >>> Item was added: >>> + ----- Method: ListChooser>>title: (in category 'accessing') ----- >>> + title: aString >>> + title := aString.! >>> >>> Item was added: >>> + ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in >>> category 'initialize-release') ----- >>> + chooseIndexFrom: labelList title: aString addAllowed: aBoolean >>> + | choice | >>> + choice := self chooseItemFrom: labelList title: aString >>> addAllowed: false. >>> + addAllowed := aBoolean. >>> + ^ fullList indexOf: choice ifAbsent: 0! >>> >>> Item was added: >>> + ----- Method: ListChooser>>realIndex (in category 'accessing') ----- >>> + realIndex >>> + ^ realIndex ifNil: [ 0 ]! >>> >>> Item was added: >>> + ----- Method: ListChooser>>list (in category 'accessing') ----- >>> + list >>> + ^ selectedItems! >>> >>> Item was changed: >>> ----- 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 doubleClickSelector: aSpec doubleClick. >>> widget dragItemSelector: aSpec dragItem. >>> widget dropItemSelector: aSpec dropItem. >>> widget wantsDropSelector: aSpec dropAccept. >>> widget autoDeselect: aSpec autoDeselect. >>> + widget keystrokePreviewSelector: aSpec keystrokePreview. >>> self buildHelpFor: widget spec: aSpec. >>> self setFrame: aSpec frame in: widget. >>> parent ifNotNil:[self add: widget to: parent]. >>> panes ifNotNil:[ >>> aSpec list ifNotNil:[panes add: aSpec list]. >>> ]. >>> ^widget! >>> >>> Item was added: >>> + ----- Method: ListChooser>>accept (in category 'event handling') ----- >>> + accept >>> + "if the user submits with no valid entry, make them start over" >>> + self canAccept ifFalse: [ >>> + searchMorph selectAll. >>> + ^ self ]. >>> + >>> + "find the selected item in the original list, and return it" >>> + result := selectedItems at: index. >>> + >>> + builder ifNotNil: [ :bldr | >>> + builder := nil. >>> + bldr close: window ]! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>chooseItemFrom:title:addAllowed: >>> (in category 'instance creation') ----- >>> + chooseItemFrom: aList title: aString addAllowed: aBoolean >>> + ^ self new >>> + chooseItemFrom: aList >>> + title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] >>> ifFalse: [ aString ]) >>> + addAllowed: aBoolean! >>> >>> Item was added: >>> + ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category >>> 'initialize-release') ----- >>> + chooseItemFrom: labelList title: aString addAllowed: aBoolean >>> + fullList := labelList asOrderedCollection. "coerce everything into >>> an OC" >>> + builder := ToolBuilder default. >>> + self list: fullList. >>> + self title: aString. >>> + addAllowed := aBoolean. >>> + window := ToolBuilder default open: self. >>> + window center: Sensor cursorPoint. >>> + window setConstrainedPosition: (Sensor cursorPoint - (window >>> fullBounds extent // 2)) hangOut: false. >>> + builder runModal: window. >>> + ^ result! >>> >>> Item was added: >>> + ----- Method: ListChooser>>canAdd (in category 'testing') ----- >>> + canAdd >>> + ^ addAllowed and: [ self canAccept not ]! >>> >>> Item was changed: >>> ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui >>> requests') ----- >>> + chooseFrom: aList lines: linesArray title: aString >>> - 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 ]! >>> - aList size > 30 ifTrue:[ >>> - "No point in displaying more than 30 items as list. Use >>> ChooserTool insted" >>> - ^ChooserTool chooseFrom: aList title: aString. >>> - ] ifFalse:[ >>> - ^MenuMorph chooseFrom: aList lines: linesArray title: >>> aString >>> - ].! >>> >>> Item was added: >>> + ----- Method: ListChooser>>cancelColor (in category 'drawing') ----- >>> + cancelColor >>> + ^ ColorTheme current cancelColor! >>> >>> Item was added: >>> + ----- Method: ListChooser>>title (in category 'accessing') ----- >>> + title >>> + ^ title ifNil: [ title := 'Please choose' ]! >>> >>> Item was added: >>> + ----- Method: ListChooser>>searchText (in category 'accessing') ----- >>> + searchText >>> + ^ searchText ifNil: [ searchText := '' ]! >>> >>> Item was added: >>> + ----- Method: ListChooser>>selectedIndex: (in category 'accessing') >>> ----- >>> + selectedIndex: anInt >>> + index := (anInt min: selectedItems size). >>> + self changed: #selectedIndex. >>> + self changed: #canAccept.! >>> >>> Item was added: >>> + ----- Method: ListChooser>>buildWith: (in category 'building') ----- >>> + buildWith: aBuilder >>> + | windowSpec | >>> + builder := aBuilder. >>> + windowSpec := self buildWindowWith: builder specs: { >>> + (0@0 corner: 1@0.05) -> [self buildSearchMorphWith: >>> builder]. >>> + (0@0.05 corner: 1@0.9) -> [self buildListMorphWith: >>> builder]. >>> + (0@0.9 corner: 1@1) -> [self buildButtonBarWith: builder]. >>> + }. >>> + windowSpec closeAction: #closed. >>> + windowSpec extent: self initialExtent. >>> + window := builder build: windowSpec. >>> + >>> + >>> + searchMorph := window submorphs detect: >>> + [ :each | each isKindOf: PluggableTextMorph ]. >>> + searchMorph >>> + hideScrollBarsIndefinitely; >>> + acceptOnCR: true; >>> + setBalloonText: 'Type a string to filter down the listed >>> items'; >>> + onKeyStrokeSend: #keyStroke: to: self; >>> + hasUnacceptedEdits: true "force acceptOnCR to work even >>> with no text entered". >>> + listMorph := window submorphs detect: >>> + [ :each | each isKindOf: PluggableListMorph ]. >>> + ^ window! >>> >>> Item was added: >>> + Object subclass: #ListChooser >>> + instanceVariableNames: 'window fullList selectedItems searchText >>> searchMorph title listMorph index realIndex buttonBar builder addAllowed >>> result' >>> + classVariableNames: '' >>> + poolDictionaries: '' >>> + category: 'ToolBuilder-Morphic'! >>> + >>> + !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0! >>> + I am a simple dialog to allow the user to pick from a list of strings or >>> symbols. >>> + I support keyboard and mouse navigation, and interactive filtering of >>> the displayed items. >>> + >>> + You can specify whether you want the index, or the value of the selected >>> item. If you're interested in the value, you can also allow users to Add a >>> new value not in the list. >>> + >>> + cmd-s or <enter> or double-click answers the currently selected item's >>> value/index; >>> + cmd-l or <escape> or closing the window answers nil/zero. >>> + >>> + Now using ToolBuilder, so needs Morphic-MAD.381. >>> + >>> + Released under the MIT Licence.! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>testItemAdd (in category >>> 'examples') ----- >>> + testItemAdd >>> + ^ self >>> + chooseItemFrom: (Smalltalk classNames , Smalltalk >>> traitNames) asOrderedCollection >>> + title: 'Pick or Add:' >>> + addAllowed: true! >>> >>> Item was added: >>> + ----- Method: ListChooser>>keyStrokeFromList: (in category 'event >>> handling') ----- >>> + keyStrokeFromList: event >>> + "we don't want the list to be picking up events" >>> + window world primaryHand keyboardFocus: searchMorph. >>> + searchMorph keyStroke: event. >>> + "let the list know we've dealt with it" >>> + ^ true! >>> >>> Item was changed: >>> ----- Method: MorphicUIManager>>chooseFrom:values:lines:title: (in >>> category 'ui requests') ----- >>> + chooseFrom: labelList values: valueList lines: linesArray title: aString >>> - 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 ]! >>> - labelList size > 30 ifTrue:[ >>> - "No point in displaying more than 30 items as list. Use >>> ChooserTool insted" >>> - index := ChooserTool chooseFrom: labelList title: aString. >>> - ^ index = 0 ifFalse:[valueList at: index]. >>> - ] ifFalse:[ >>> - ^MenuMorph chooseFrom: labelList values: valueList lines: >>> linesArray title: aString >>> - ].! >>> >>> Item was added: >>> + ----- Method: ListChooser>>keyStroke: (in category 'event handling') >>> ----- >>> + keyStroke: event >>> + | newText key | >>> + "handle updates to the search box interactively" >>> + key := event keyString. >>> + (key = '<up>') ifTrue: [ >>> + self move: -1. >>> + ^ self ]. >>> + (key = '<down>') ifTrue: [ >>> + self move: 1. >>> + ^ self ]. >>> + >>> + (key = '<Cmd-s>') ifTrue: [ self accept. ^ self ]. >>> + (key = '<cr>') ifTrue: [ self accept. ^ self ]. >>> + >>> + (key = '<escape>') ifTrue: [ self cancel. ^ self ]. >>> + (key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ]. >>> + >>> + (key = '<Cmd-a>') ifTrue: [ self add. ^ self ]. >>> + >>> + "pull out what's been typed, and update the list as required" >>> + newText := searchMorph textMorph asText asString. >>> + (newText = searchText) ifFalse: [ >>> + searchText := newText. >>> + self updateFilter ]. >>> + ! >>> >>> Item was added: >>> + ----- Method: ListChooser>>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; >>> + color: #acceptColor; >>> + frame: (0.0 @ 0.0 corner: 0.34@1). >>> + panel children add: button. >>> + >>> + button := builder pluggableButtonSpec new. >>> + button >>> + model: self; >>> + label: 'Add (a)'; >>> + action: #add; >>> + enabled: #canAdd; >>> + frame: (0.36 @ 0.0 corner: 0.63@1). >>> + panel children add: button. >>> + >>> + button := builder pluggableButtonSpec new. >>> + button >>> + model: self; >>> + label: 'Cancel (l)'; >>> + action: #cancel; >>> + color: #cancelColor; >>> + frame: (0.65 @ 0.0 corner: 1@1). >>> + panel children add: button. >>> + >>> + ^ panel! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>chooseItemFrom:title: (in category >>> 'instance creation') ----- >>> + chooseItemFrom: aList title: aString >>> + ^ self >>> + chooseItemFrom: aList >>> + title: aString >>> + addAllowed: false! >>> >>> Item was added: >>> + ----- Method: ListChooser>>selectedIndex (in category 'accessing') ----- >>> + selectedIndex >>> + ^ index ifNil: [ index := 1 ]! >>> >>> Item was added: >>> + ----- Method: ListChooser>>acceptText: (in category 'event handling') >>> ----- >>> + acceptText: someText >>> + "the text morph wants to tell us about its contents but I don't >>> care, I'm only interested in the list" >>> + self accept! >>> >>> Item was added: >>> + ----- Method: ListChooser>>updateFilter (in category 'event handling') >>> ----- >>> + updateFilter >>> + selectedItems := >>> + searchText isEmptyOrNil >>> + ifTrue: [ fullList ] >>> + ifFalse: [ fullList select: [ :each | each >>> includesSubstring: searchText caseSensitive: false ] ]. >>> + self changed: #list. >>> + self selectedIndex: 1. >>> + self changed: #selectedIndex.! >>> >>> Item was added: >>> + ----- Method: ListChooser>>canAccept (in category 'testing') ----- >>> + canAccept >>> + ^ self selectedIndex > 0! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>testIndex (in category 'examples') >>> ----- >>> + testIndex >>> + ^ self >>> + chooseIndexFrom: (Smalltalk classNames , Smalltalk >>> traitNames) asOrderedCollection >>> + title: 'Pick a class'! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>chooseFrom: (in category >>> 'ChooserTool compatibility') ----- >>> + chooseFrom: aList >>> + ^ self >>> + chooseFrom: aList >>> + title: self defaultTitle! >>> >>> Item was added: >>> + ----- Method: ListChooser>>handlesKeyboard: (in category 'event >>> handling') ----- >>> + handlesKeyboard: evt >>> + ^ true! >>> >>> Item was added: >>> + ----- Method: ListChooser>>list:title: (in category 'accessing') ----- >>> + list: aList title: aString >>> + self list: aList. >>> + self title: aString! >>> >>> Item was added: >>> + ----- Method: ListChooser>>list: (in category 'accessing') ----- >>> + list: items >>> + fullList := items. >>> + selectedItems := items. >>> + self changed: #itemList.! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>testDictionary (in category >>> 'examples') ----- >>> + testDictionary >>> + ^ self >>> + chooseItemFrom: (Dictionary newFrom: {#a->1. 2->#b.}) >>> + title: 'Pick from Dictionary' "gives values, not keys"! >>> >>> Item was added: >>> + ----- Method: ListChooser>>initialExtent (in category 'building') ----- >>> + initialExtent >>> + | listFont titleFont buttonFont listWidth titleWidth buttonWidth | >>> + listFont := Preferences standardListFont. >>> + titleFont := Preferences windowTitleFont. >>> + buttonFont := Preferences standardButtonFont. >>> + listWidth := 20 * (listFont widthOf: $m). >>> + titleWidth := titleFont widthOfString: self title, '__________'. >>> "add some space for titlebar icons" >>> + buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add >>> (a)___Cancel_(l)_'. >>> + ^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont >>> height))! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>chooseFrom:title: (in category >>> 'ChooserTool compatibility') ----- >>> + chooseFrom: aList title: aString >>> + ^ self >>> + chooseIndexFrom: aList >>> + title: aString >>> + addAllowed: false! >>> >>> Item was added: >>> + ----- Method: ListChooser>>closed (in category 'event handling') ----- >>> + closed >>> + "Cancel the dialog and move on" >>> + builder ifNotNil: [ index := 0 ]! >>> >>> Item was added: >>> + ----- Method: ListChooser>>move: (in category 'event handling') ----- >>> + move: offset >>> + | newindex | >>> + "The up arrow key moves the cursor, and it seems impossible to >>> restore. >>> + So, for consistency, on either arrow, select everything, so a new >>> letter-press starts over. yuk." >>> + searchMorph selectAll. >>> + >>> + newindex := self selectedIndex + offset. >>> + newindex > selectedItems size ifTrue: [ ^ nil ]. >>> + newindex < 1 ifTrue: [ ^ nil ]. >>> + self selectedIndex: newindex. >>> + ! >>> >>> Item was added: >>> + ----- Method: ListChooser classSide>>chooseIndexFrom: (in category >>> 'instance creation') ----- >>> + chooseIndexFrom: aList >>> + ^ self >>> + chooseIndexFrom: aList >>> + title: self defaultTitle! >>> >>> Item was added: >>> + ----- Method: ListChooser>>add (in category 'event handling') ----- >>> + add >>> + "if the user submits with no valid entry, make them start over" >>> + self canAdd ifFalse: [ >>> + searchMorph selectAll. >>> + ^ self ]. >>> + >>> + "find the string to return" >>> + result := searchMorph getText. >>> + >>> + builder ifNotNil: [ :bldr | >>> + builder := nil. >>> + bldr close: window ]! >>> >>> Item was added: >>> + ----- Method: ListChooser>>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: >>> - Model subclass: #ChooserTool >>> - instanceVariableNames: 'label items index builder window' >>> - classVariableNames: '' >>> - poolDictionaries: '' >>> - category: 'ToolBuilder-Morphic'! >>> - >>> - !ChooserTool commentStamp: 'ar 12/9/2009 23:46' prior: 0! >>> - A simple chooser tool for Morphic. Useful when menus just get too long.! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>canAccept (in category 'accessing') ----- >>> - canAccept >>> - ^self itemListIndex > 0! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>closed (in category 'actions') ----- >>> - closed >>> - "Cancel the dialog and move on" >>> - builder ifNotNil:[index := 0].! >>> >>> Item was removed: >>> - ----- Method: ChooserTool class>>chooseFrom:title: (in category 'tools') >>> ----- >>> - chooseFrom: labelList title: aString >>> - ^self new chooseFrom: labelList title: aString! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>label (in category 'accessing') ----- >>> - label >>> - ^label! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>chooseFrom:title: (in category 'initialize') >>> ----- >>> - chooseFrom: labelList title: aString >>> - builder := ToolBuilder default. >>> - self itemList: labelList. >>> - self label: aString. >>> - window := ToolBuilder default open: self. >>> - window center: Sensor cursorPoint. >>> - window setConstrainedPosition: (Sensor cursorPoint - (window >>> fullBounds extent // 2)) hangOut: false. >>> - builder runModal: window. >>> - ^self itemListIndex! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>cancel (in category 'actions') ----- >>> - cancel >>> - "Cancel the dialog and move on" >>> - index := 0. >>> - builder ifNotNil:[builder close: window].! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>buildWindowWith:specs: (in category >>> 'toolbuilder') ----- >>> - 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: ChooserTool>>itemList (in category 'accessing') ----- >>> - itemList >>> - ^items! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>buildWindowWith: (in category 'toolbuilder') >>> ----- >>> - buildWindowWith: builder >>> - | windowSpec | >>> - windowSpec := builder pluggableWindowSpec new. >>> - windowSpec model: self. >>> - windowSpec label: #labelString. >>> - windowSpec children: OrderedCollection new. >>> - ^windowSpec! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>itemListIndex (in category 'accessing') ----- >>> - itemListIndex >>> - ^index ifNil:[0]! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>accept (in category 'actions') ----- >>> - accept >>> - "Accept current selection and move on" >>> - builder ifNotNil:[:bldr| >>> - builder := nil. >>> - bldr close: window].! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>buildButtonsWith: (in category 'toolbuilder') >>> ----- >>> - buildButtonsWith: aBuilder >>> - | panel button | >>> - panel := aBuilder pluggablePanelSpec new >>> - model: self; >>> - layout: #proportional; >>> - children: OrderedCollection new. >>> - button := aBuilder pluggableButtonSpec new. >>> - button >>> - model: self; >>> - label: 'Accept'; >>> - action: #accept; >>> - enabled: #canAccept; >>> - frame: (0.0 @ 0.0 corner: 0.48@1). >>> - panel children add: button. >>> - >>> - button := aBuilder pluggableButtonSpec new. >>> - button >>> - model: self; >>> - label: 'Cancel'; >>> - action: #cancel; >>> - frame: (0.52 @ 0.0 corner: 1@1). >>> - panel children add: button. >>> - ^panel! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>itemList: (in category 'accessing') ----- >>> - itemList: aCollection >>> - items := aCollection. >>> - self changed: #items.! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>itemListIndex: (in category 'accessing') >>> ----- >>> - itemListIndex: newIndex >>> - index := newIndex. >>> - self changed: #itemListIndex. >>> - self changed: #canAccept.! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>label: (in category 'accessing') ----- >>> - label: aString >>> - label := aString.! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>buildWith: (in category 'toolbuilder') ----- >>> - buildWith: aBuilder >>> - | windowSpec | >>> - builder := aBuilder. >>> - windowSpec := self buildWindowWith: builder specs: { >>> - (0@0 corner: 1@0.9) -> [self buildChooserListWith: >>> builder]. >>> - (0@0.9 corner: 1@1) -> [self buildButtonsWith: builder]. >>> - }. >>> - windowSpec closeAction: #closed. >>> - windowSpec extent: 250@350. >>> - ^builder build: windowSpec! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>labelString (in category 'accessing') ----- >>> - labelString >>> - ^label! >>> >>> Item was removed: >>> - ----- Method: ChooserTool>>buildChooserListWith: (in category >>> 'toolbuilder') ----- >>> - buildChooserListWith: builder >>> - | listSpec | >>> - listSpec := builder pluggableListSpec new. >>> - listSpec >>> - model: self; >>> - list: #itemList; >>> - getIndex: #itemListIndex; >>> - setIndex: #itemListIndex:; >>> - doubleClick: #accept; >>> - autoDeselect: false. >>> - ^listSpec >>> - ! >>> >>> Item was removed: >>> - ----- Method: ChooserTool class>>open (in category 'opening') ----- >>> - open >>> - ^ToolBuilder open: self! >>> >>> >>> >> >> > > |
Free forum by Nabble | Edit this page |