The Trunk: ToolBuilder-Morphic-cmm.53.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: ToolBuilder-Morphic-cmm.53.mcz

commits-2
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!


Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Morphic-cmm.53.mcz

Levente Uzonyi-2
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!
>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Morphic-cmm.53.mcz

Chris Muller-3
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!
>>
>>
>>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Morphic-cmm.53.mcz

Levente Uzonyi-2
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!
>>>
>>>
>>>
>>
>>
>
>