[squeak-dev] The Trunk: Morphic-fbs.653.mcz

31 May 2013


      Frank Shearar uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-fbs.653.mcz
==================== Summary ====================
Name: Morphic-fbs.653
Author: fbs
Time: 31 May 2013, 4:00:33.132 pm
UUID: f85ab481-1220-47b1-998e-0dea9c443203
Ancestors: Morphic-kb.652
Move ToolBuilder-Morphic to Morphic-ToolBuilder.
=============== Diff against Morphic-kb.652 ===============
Item was changed:
  SystemOrganization addCategory: #'Morphic-Balloon'!
  SystemOrganization addCategory: #'Morphic-Basic'!
  SystemOrganization addCategory: #'Morphic-Basic-NewCurve'!
  SystemOrganization addCategory: #'Morphic-Borders'!
  SystemOrganization addCategory: #'Morphic-Collections-Arrayed'!
  SystemOrganization addCategory: #'Morphic-Demo'!
  SystemOrganization addCategory: #'Morphic-Events'!
  SystemOrganization addCategory: #'Morphic-Explorer'!
  SystemOrganization addCategory: #'Morphic-Kernel'!
  SystemOrganization addCategory: #'Morphic-Layouts'!
  SystemOrganization addCategory: #'Morphic-Menus'!
  SystemOrganization addCategory: #'Morphic-Menus-DockingBar'!
  SystemOrganization addCategory: #'Morphic-Models'!
  SystemOrganization addCategory: #'Morphic-Pluggable Widgets'!
  SystemOrganization addCategory: #'Morphic-Support'!
  SystemOrganization addCategory: #'Morphic-Text Support'!
  SystemOrganization addCategory: #'Morphic-TrueType'!
  SystemOrganization addCategory: #'Morphic-Widgets'!
  SystemOrganization addCategory: #'Morphic-Windows'!
  SystemOrganization addCategory: #'Morphic-Worlds'!
+ SystemOrganization addCategory: #'Morphic-ToolBuilder'!
Item was added:
+ Object subclass: #ListChooser
+ 	instanceVariableNames: 'window fullList selectedItems searchText searchMorph title listMorph index realIndex buttonBar builder addAllowed result'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0!
+ I am a simple dialog to allow the user to pick from a list of strings or symbols.
+ I support keyboard and mouse navigation, and interactive filtering of the displayed items.
+ 
+ You can specify whether you want the index, or the value of the selected item. If you're interested in the value, you can also allow users to Add a new value not in the list.
+ 
+ cmd-s or <enter> or double-click answers the currently selected item's value/index;
+ cmd-l or <escape> or closing the window answers nil/zero.
+ 
+ Now using ToolBuilder, so needs Morphic-MAD.381.
+ 
+ Released under the MIT Licence.!
Item was added:
+ ----- Method: ListChooser class>>chooseFrom: (in category 'ChooserTool compatibility') -----
+ chooseFrom: aList
+ 	^ self 
+ 		chooseFrom: aList 
+ 		title: self defaultTitle!
Item was added:
+ ----- Method: ListChooser class>>chooseFrom:title: (in category 'ChooserTool compatibility') -----
+ chooseFrom: aList title: aString
+ 	^ self
+ 		chooseIndexFrom: aList 
+ 		title: aString
+ 		addAllowed: false!
Item was added:
+ ----- Method: ListChooser class>>chooseIndexFrom: (in category 'instance creation') -----
+ chooseIndexFrom: aList
+ 	^ self 
+ 		chooseIndexFrom: aList 
+ 		title: self defaultTitle!
Item was added:
+ ----- Method: ListChooser class>>chooseIndexFrom:title: (in category 'instance creation') -----
+ chooseIndexFrom: aList title: aString
+ 	^ self
+ 		chooseIndexFrom: aList 
+ 		title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
+ 		addAllowed: false!
Item was added:
+ ----- Method: ListChooser class>>chooseIndexFrom:title:addAllowed: (in category 'instance creation') -----
+ chooseIndexFrom: aList title: aString addAllowed: aBoolean
+ 	^ self new
+ 		chooseIndexFrom: aList 
+ 		title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
+ 		addAllowed: aBoolean!
Item was added:
+ ----- Method: ListChooser class>>chooseItemFrom: (in category 'instance creation') -----
+ chooseItemFrom: aList
+ 	^ self 
+ 		chooseItemFrom: aList 
+ 		title: self defaultTitle!
Item was added:
+ ----- Method: ListChooser class>>chooseItemFrom:title: (in category 'instance creation') -----
+ chooseItemFrom: aList title: aString
+ 	^ self
+ 		chooseItemFrom: aList 
+ 		title: aString
+ 		addAllowed: false!
Item was added:
+ ----- Method: ListChooser class>>chooseItemFrom:title:addAllowed: (in category 'instance creation') -----
+ chooseItemFrom: aList title: aString addAllowed: aBoolean
+ 	^ self new
+ 		chooseItemFrom: aList 
+ 		title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
+ 		addAllowed: aBoolean!
Item was added:
+ ----- Method: ListChooser class>>defaultTitle (in category 'instance creation') -----
+ defaultTitle
+ 	^ 'Please choose:'!
Item was added:
+ ----- Method: ListChooser class>>testDictionary (in category 'examples') -----
+ testDictionary
+ 	^ self 
+ 		chooseItemFrom: (Dictionary newFrom: {#a->1. 2->#b.})
+ 		title: 'Pick from Dictionary' "gives values, not keys"!
Item was added:
+ ----- Method: ListChooser class>>testIndex (in category 'examples') -----
+ testIndex
+ 	^ self 
+ 		chooseIndexFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection
+ 		title: 'Pick a class'!
Item was added:
+ ----- Method: ListChooser class>>testItem (in category 'examples') -----
+ testItem
+ 	^ self 
+ 		chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection
+ 		title: 'Pick a class'!
Item was added:
+ ----- Method: ListChooser class>>testItemAdd (in category 'examples') -----
+ testItemAdd
+ 	^ self 
+ 		chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection
+ 		title: 'Pick or Add:'
+ 		addAllowed: true!
Item was added:
+ ----- Method: ListChooser class>>testLongTitle (in category 'examples') -----
+ testLongTitle
+ 	^ self 
+ 		chooseItemFrom: #(this is a list of values that aren/t the point here)
+ 		title: 'Pick from some values from this list'!
Item was added:
+ ----- Method: ListChooser class>>testSet (in category 'examples') -----
+ testSet
+ 	^ self 
+ 		chooseItemFrom: #(a list of values as a Set) asSet
+ 		title: 'Pick from Set'!
Item was added:
+ ----- Method: ListChooser>>accept (in category 'event handling') -----
+ accept
+ 	"if the user submits with no valid entry, make them start over"
+ 	self canAccept ifFalse: [ 	
+ 		searchMorph selectAll.
+ 		^ self ].
+ 	
+ 	"find the selected item in the original list, and return it"
+ 	result := selectedItems at: index.
+ 
+ 	builder ifNotNil: [ :bldr |
+ 		builder := nil.
+ 		bldr close: window ]!
Item was added:
+ ----- Method: ListChooser>>acceptColor (in category 'drawing') -----
+ acceptColor
+ 	^ self canAccept 
+ 		ifTrue: [ ColorTheme current okColor ]
+ 		ifFalse: [ Color lightGray "ColorTheme current disabledColor <- you don't have this!!" ]!
Item was added:
+ ----- Method: ListChooser>>acceptText: (in category 'event handling') -----
+ acceptText: someText
+ 	"the text morph wants to tell us about its contents but I don't care, I'm only interested in the list"
+ 	self accept!
Item was added:
+ ----- Method: ListChooser>>add (in category 'event handling') -----
+ add
+ 	"if the user submits with no valid entry, make them start over"
+ 	self canAdd ifFalse: [ 	
+ 		searchMorph selectAll.
+ 		^ self ].
+ 	
+ 	"find the string to return"
+ 	result := searchMorph getText.
+ 
+ 	builder ifNotNil: [ :bldr |
+ 		builder := nil.
+ 		bldr close: window ]!
Item was added:
+ ----- Method: ListChooser>>buildButtonBarWith: (in category 'building') -----
+ buildButtonBarWith: builder
+ 	| panel button |
+ 	panel := builder pluggablePanelSpec new
+ 		model: self;
+ 		layout: #proportional;
+ 		children: OrderedCollection new.
+ 	button := builder pluggableButtonSpec new.
+ 	button
+ 		model: self; 
+ 		label: 'Accept (s)';
+ 		action: #accept;
+ 		enabled: #canAccept;
+ 		state: #canAccept;
+ 		color: #acceptColor;
+ 		frame: (0.0 @ 0.0 corner: 0.34@1).
+ 	panel children add: button.
+ 
+ 	button := builder pluggableButtonSpec new.
+ 	button
+ 		model: self; 
+ 		label: 'Add (a)';
+ 		action: #add;
+ 		enabled: #canAdd;
+ 		frame: (0.36 @ 0.0 corner: 0.63@1).
+ 	panel children add: button.
+ 
+ 	button := builder pluggableButtonSpec new.
+ 	button
+ 		model: self; 
+ 		label: 'Cancel (l)';
+ 		action: #cancel;
+ 		color: #cancelColor;
+ 		frame: (0.65 @ 0.0 corner: 1@1).
+ 	panel children add: button.
+ 	
+ 	^ panel!
Item was added:
+ ----- Method: ListChooser>>buildListMorphWith: (in category 'building') -----
+ buildListMorphWith: builder
+ 	| listSpec |
+ 	listSpec := builder pluggableListSpec new.
+ 	listSpec 
+ 		model: self;
+ 		list: #list; 
+ 		getIndex: #selectedIndex; 
+ 		setIndex: #selectedIndex:; 
+ 		doubleClick: #accept;
+ 		"handleBasicKeys: false;"
+ 		keystrokePreview: #keyStrokeFromList:;
+ 		"doubleClickSelector: #accept;"
+ 		autoDeselect: false.
+ 	^ listSpec!
Item was added:
+ ----- Method: ListChooser>>buildSearchMorphWith: (in category 'building') -----
+ buildSearchMorphWith: builder
+ 	| fieldSpec |
+ 	fieldSpec := builder pluggableInputFieldSpec new.
+ 	fieldSpec 
+ 		model: self;
+ 		getText: #searchText;
+ 		setText: #acceptText:;
+ 		menu: nil.
+ 		"hideScrollBarsIndefinitely;"
+ 		"acceptOnCR: true;"
+ 		"setBalloonText: 'Type a string to filter down the listed items'."
+ 		"onKeyStrokeSend: #keyStroke: to: self."
+ 	^ fieldSpec!
Item was added:
+ ----- Method: ListChooser>>buildWindowWith: (in category 'building') -----
+ buildWindowWith: builder
+ 	| windowSpec |
+ 	windowSpec := builder pluggableWindowSpec new.
+ 	windowSpec model: self.
+ 	windowSpec label: #title.
+ 	windowSpec children: OrderedCollection new.
+ 	^windowSpec!
Item was added:
+ ----- Method: ListChooser>>buildWindowWith:specs: (in category 'building') -----
+ buildWindowWith: builder specs: specs
+ 	| windowSpec |
+ 	windowSpec := self buildWindowWith: builder.
+ 	specs do: [ :assoc |
+ 		| rect action widgetSpec |
+ 		rect := assoc key.
+ 		action := assoc value.
+ 		widgetSpec := action value.
+ 		widgetSpec ifNotNil:[
+ 			widgetSpec frame: rect.
+ 			windowSpec children add: widgetSpec ] ].
+ 	^ windowSpec!
Item was added:
+ ----- Method: ListChooser>>buildWith: (in category 'building') -----
+ buildWith: aBuilder
+ 	| windowSpec |
+ 	builder := aBuilder.
+ 	windowSpec := self buildWindowWith: builder specs: {
+ 		(0@0 corner: 1@0.05) -> [self buildSearchMorphWith: builder].
+ 		(0@0.05 corner: 1@0.9) -> [self buildListMorphWith: builder].
+ 		(0@0.9 corner: 1@1) -> [self buildButtonBarWith: builder].
+ 	}.
+ 	windowSpec closeAction: #closed.
+ 	windowSpec extent: self initialExtent.
+ 	window := builder build: windowSpec.
+ 	
+ 	
+ 	searchMorph := window submorphs detect: 
+ 		[ :each | each isKindOf: PluggableTextMorph ].
+ 	searchMorph
+ 		hideScrollBarsIndefinitely;
+ 		acceptOnCR: true;
+ 		setBalloonText: 'Type a string to filter down the listed items';
+ 		onKeyStrokeSend: #keyStroke: to: self;
+ 		hasUnacceptedEdits: true "force acceptOnCR to work even with no text entered".
+ 	listMorph := window submorphs detect: 
+ 		[ :each | each isKindOf: PluggableListMorph ].
+ 	^ window!
Item was added:
+ ----- Method: ListChooser>>canAccept (in category 'testing') -----
+ canAccept
+ 	^ self selectedIndex > 0!
Item was added:
+ ----- Method: ListChooser>>canAdd (in category 'testing') -----
+ canAdd
+ 	^ addAllowed and: [ self canAccept not ]!
Item was added:
+ ----- Method: ListChooser>>cancel (in category 'event handling') -----
+ cancel
+ 	"Cancel the dialog and move on"
+ 	index := 0.
+ 	builder ifNotNil: [ builder close: window ]!
Item was added:
+ ----- Method: ListChooser>>cancelColor (in category 'drawing') -----
+ cancelColor
+ 	^ ColorTheme current cancelColor!
Item was added:
+ ----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') -----
+ chooseIndexFrom: labelList title: aString
+ 	| choice |
+ 	choice := self chooseItemFrom: labelList title: aString addAllowed: false.
+ 	^ fullList indexOf: choice ifAbsent: 0!
Item was added:
+ ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') -----
+ chooseIndexFrom: labelList title: aString addAllowed: aBoolean
+ 	| choice |
+ 	choice := self chooseItemFrom: labelList title: aString addAllowed: false.
+ 	addAllowed := aBoolean.
+ 	^ fullList indexOf: choice ifAbsent: 0!
Item was added:
+ ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') -----
+ chooseItemFrom: labelList title: aString addAllowed: aBoolean
+ 	fullList := labelList asOrderedCollection. "coerce everything into an OC"
+ 	builder := ToolBuilder default.
+ 	self list: fullList.
+ 	self title: aString.
+ 	addAllowed := aBoolean.
+ 	window := ToolBuilder default open: self.
+ 	window center: Sensor cursorPoint.
+ 	window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false.
+ 	builder runModal: window.
+ 	^ result!
Item was added:
+ ----- Method: ListChooser>>closed (in category 'event handling') -----
+ closed
+ 	"Cancel the dialog and move on"
+ 	builder ifNotNil: [ index := 0 ]!
Item was added:
+ ----- Method: ListChooser>>handlesKeyboard: (in category 'event handling') -----
+ handlesKeyboard: evt
+ 	^ true!
Item was added:
+ ----- Method: ListChooser>>initialExtent (in category 'building') -----
+ initialExtent
+ 	| listFont titleFont buttonFont listWidth titleWidth buttonWidth |
+ 	listFont := Preferences standardListFont.
+ 	titleFont := Preferences windowTitleFont.
+ 	buttonFont := Preferences standardButtonFont.
+ 	listWidth := 20 * (listFont widthOf: $m).
+ 	titleWidth := titleFont widthOfString: self title, '__________'. "add some space for titlebar icons"
+ 	buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add (a)___Cancel_(l)_'.
+ 	^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont height))!
Item was added:
+ ----- Method: ListChooser>>keyStroke: (in category 'event handling') -----
+ keyStroke: event
+ 	| newText key |
+ 	"handle updates to the search box interactively"
+ 	key := event keyString.
+ 	(key = '<up>') ifTrue: [ 
+ 		self move: -1. 
+ 		^ self ].
+ 	(key = '<down>') ifTrue: [ 
+ 		self move: 1.
+ 		^ self ].
+ 
+ 	(key = '<Cmd-s>') ifTrue: [ self accept. ^ self ].
+ 	(key = '<cr>') ifTrue: [ self accept. ^ self ].
+ 
+ 	(key = '<escape>') ifTrue: [ self cancel. ^ self ].
+ 	(key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ].
+ 	
+ 	(key = '<Cmd-a>') ifTrue: [ self add. ^ self ].
+ 
+ 	"pull out what's been typed, and update the list as required"
+ 	newText := searchMorph textMorph asText asString.
+ 	(newText = searchText) ifFalse: [ 
+ 		searchText := newText.
+ 		self updateFilter ].
+ !
Item was added:
+ ----- Method: ListChooser>>keyStrokeFromList: (in category 'event handling') -----
+ keyStrokeFromList: event
+ 	"we don't want the list to be picking up events, excepting scroll events"
+ 
+ 	"Don't sent ctrl-up/ctrl-down events to the searchMorph: they're scrolling events."
+ 	(#(30 31) contains: [:each | each = event keyValue]) not
+ 		ifTrue:
+ 			["window world primaryHand keyboardFocus: searchMorph."
+ 			searchMorph keyStroke: event.
+ 			"let the list know we've dealt with it"
+ 			^true].
+ 	^false.
+ 		!
Item was added:
+ ----- Method: ListChooser>>list (in category 'accessing') -----
+ list
+ 	^ selectedItems!
Item was added:
+ ----- Method: ListChooser>>list: (in category 'accessing') -----
+ list: items
+ 	fullList := items.
+ 	selectedItems := items.
+ 	self changed: #itemList.!
Item was added:
+ ----- Method: ListChooser>>list:title: (in category 'accessing') -----
+ list: aList title: aString
+ 	self list: aList.
+ 	self title: aString!
Item was added:
+ ----- Method: ListChooser>>move: (in category 'event handling') -----
+ move: offset
+ 	| newindex |
+ 	"The up arrow key moves the cursor, and it seems impossible to restore.
+ 	So, for consistency, on either arrow, select everything, so a new letter-press starts over. yuk."
+ 	searchMorph selectAll.
+ 		
+ 	newindex := self selectedIndex + offset.
+ 	newindex > selectedItems size ifTrue: [ ^ nil ].
+ 	newindex < 1 ifTrue: [ ^ nil ].
+ 	self selectedIndex: newindex.
+ !
Item was added:
+ ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') -----
+ moveWindowNear: aPoint
+ 	| trialRect delta |
+ 	trialRect := Rectangle center: aPoint extent: window fullBounds extent.
+ 	delta := trialRect amountToTranslateWithin: World bounds.
+ 	window position: trialRect origin + delta.!
Item was added:
+ ----- Method: ListChooser>>realIndex (in category 'accessing') -----
+ realIndex
+ 	^ realIndex ifNil: [ 0 ]!
Item was added:
+ ----- Method: ListChooser>>searchText (in category 'accessing') -----
+ searchText
+ 	^ searchText ifNil: [ searchText := '' ]!
Item was added:
+ ----- Method: ListChooser>>searchText: (in category 'accessing') -----
+ searchText: aString
+ 	searchText := aString!
Item was added:
+ ----- Method: ListChooser>>selectedIndex (in category 'accessing') -----
+ selectedIndex
+ 	^ index ifNil: [ index := 1 ]!
Item was added:
+ ----- Method: ListChooser>>selectedIndex: (in category 'accessing') -----
+ selectedIndex: anInt
+ 	index := (anInt min: selectedItems size).
+ 	self changed: #selectedIndex.
+ 	self changed: #canAccept.!
Item was added:
+ ----- Method: ListChooser>>title (in category 'accessing') -----
+ title
+ 	^ title ifNil: [ title := 'Please choose' ]!
Item was added:
+ ----- Method: ListChooser>>title: (in category 'accessing') -----
+ title: aString
+ 	title := aString.!
Item was added:
+ ----- Method: ListChooser>>updateFilter (in category 'event handling') -----
+ updateFilter
+ 
+ 	selectedItems := 
+ 		searchText isEmptyOrNil 
+ 			ifTrue: [ fullList ]
+ 			ifFalse: [ | pattern patternMatches prefixMatches |
+ 				pattern := (searchText includes: $*)
+ 					ifTrue: [ searchText ]
+ 					ifFalse: [ '*', searchText, '*' ].
+ 				patternMatches := fullList select: [:s | pattern match: s ].
+ 				prefixMatches := OrderedCollection new: patternMatches size.
+ 				patternMatches removeAllSuchThat: [ :each |
+ 					(each findString: searchText startingAt: 1 caseSensitive: false) = 1
+ 						and: [
+ 							prefixMatches add: each.
+ 							true ] ].
+ 				prefixMatches addAllLast: patternMatches; yourself].
+ 	self changed: #list.
+ 	self selectedIndex: 1.
+ 	self changed: #selectedIndex.!
Item was added:
+ ToolBuilder subclass: #MorphicToolBuilder
+ 	instanceVariableNames: 'widgets panes parentMenu'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !MorphicToolBuilder commentStamp: 'ar 2/11/2005 15:02' prior: 0!
+ The Morphic tool builder.!
Item was added:
+ ----- Method: MorphicToolBuilder class>>isActiveBuilder (in category 'accessing') -----
+ isActiveBuilder
+ 	"Answer whether I am the currently active builder"
+ 	^Smalltalk isMorphic!
Item was added:
+ ----- Method: MorphicToolBuilder>>add:to: (in category 'private') -----
+ add: aMorph to: aParent
+ 	aParent addMorphBack: aMorph.
+ 	aParent isSystemWindow ifTrue:[
+ 		aParent addPaneMorph: aMorph.
+ 	].!
Item was added:
+ ----- Method: MorphicToolBuilder>>alternateMultiSelectListClass (in category 'widget classes') -----
+ alternateMultiSelectListClass
+ 	^ AlternatePluggableListMorphOfMany !
Item was added:
+ ----- Method: MorphicToolBuilder>>asFrame: (in category 'private') -----
+ asFrame: aRectangle
+ 	| frame |
+ 	aRectangle ifNil:[^nil].
+ 	frame := LayoutFrame new.
+ 	frame 
+ 		leftFraction: aRectangle left; 
+ 		rightFraction: aRectangle right; 
+ 		topFraction: aRectangle top; 
+ 		bottomFraction: aRectangle bottom.
+ 	^frame!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildHelpFor:spec: (in category 'pluggable widgets') -----
+ buildHelpFor: widget spec: aSpec
+ 	aSpec help
+ 		ifNotNil: [widget setBalloonText: aSpec help]!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableActionButton: (in category 'pluggable widgets') -----
+ buildPluggableActionButton: aSpec
+ 	| button |
+ 	button := self buildPluggableButton: aSpec.
+ 	button color: Color white.
+ 	^button!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableAlternateMultiSelectionList: (in category 'pluggable widgets') -----
+ buildPluggableAlternateMultiSelectionList: aSpec
+ 	| listMorph listClass |
+ 	aSpec getSelected ifNotNil: [ ^ self error: 'There is no PluggableAlternateListMorphOfManyByItem' ].
+ 	listClass := self alternateMultiSelectListClass.
+ 	listMorph := listClass 
+ 		on: aSpec model
+ 		list: aSpec list
+ 		primarySelection: aSpec getIndex
+ 		changePrimarySelection: aSpec setIndex
+ 		listSelection: aSpec getSelectionList
+ 		changeListSelection: aSpec setSelectionList
+ 		menu: aSpec menu.
+ 	listMorph
+ 		setProperty: #highlightSelector toValue: #highlightMessageList:with: ;
+ 		setProperty: #itemConversionMethod toValue: #asStringOrText ;
+ 		setProperty: #balloonTextSelectorForSubMorphs toValue: #balloonTextForClassAndMethodString ;
+ 		enableDragNDrop: Preferences browseWithDragNDrop ;
+ 		menuTitleSelector: #messageListSelectorTitle.
+ 	self 
+ 		register: listMorph
+ 		id: aSpec name.
+ 	listMorph
+ 		keystrokeActionSelector: aSpec keyPress ;
+ 		getListElementSelector: aSpec listItem ;
+ 		getListSizeSelector: aSpec listSize.
+ 	self 
+ 		buildHelpFor: listMorph 
+ 		spec: aSpec. 
+ 	self 
+ 		setFrame: aSpec frame 
+ 		in: listMorph.
+ 	parent ifNotNil: [ self add: listMorph to: parent ].
+ 	panes ifNotNil: [ aSpec list ifNotNil:[panes add: aSpec list ] ].
+ 	^ listMorph!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableButton: (in category 'pluggable widgets') -----
+ buildPluggableButton: aSpec
+ 	| widget label state action enabled |
+ 	label := aSpec label.
+ 	state := aSpec state.
+ 	action := aSpec action.
+ 	widget := self buttonClass on: aSpec model
+ 				getState: (state isSymbol ifTrue:[state])
+ 				action: nil
+ 				label: (label isSymbol ifTrue:[label]).
+ 	widget style: aSpec style.
+ 	aSpec changeLabelWhen
+ 		ifNotNilDo: [ :event | widget whenChanged: event update: aSpec label].
+ 	self register: widget id: aSpec name.
+ 	enabled := aSpec enabled.
+ 	enabled isSymbol
+ 		ifTrue:[widget getEnabledSelector: enabled]
+ 		ifFalse:[widget enabled:enabled].
+ 	widget action: action.
+ 	widget getColorSelector: aSpec color.
+ 	widget offColor: Color white..
+ 	self buildHelpFor: widget spec: aSpec. 
+ 	(label isSymbol or:[label == nil]) ifFalse:[widget label: label].
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableCheckBox: (in category 'pluggable widgets') -----
+ buildPluggableCheckBox: spec
+ 
+ 	| widget label state action |
+ 	label := spec label.
+ 	state := spec state.
+ 	action := spec action.
+ 	widget := self checkBoxClass on: spec model
+ 				getState: (state isSymbol ifTrue:[state])
+ 				action: (action isSymbol ifTrue:[action])
+ 				label: (label isSymbol ifTrue:[label]).
+ 	self register: widget id: spec name.
+ 
+ 	widget installButton.
+ "	widget getColorSelector: spec color.
+ 	widget offColor: Color white..
+ 	self buildHelpFor: widget spec: spec. 
+ 	(label isSymbol or:[label == nil]) ifFalse:[widget label: label].
+ "	self setFrame: spec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableCodePane: (in category 'pluggable widgets') -----
+ buildPluggableCodePane: aSpec
+ 	"Install the default styler for code panes.
+ 	Implementation note: We should just be doing something like, e.g.,
+ 		^(self buildPluggableText: aSpec) useDefaultStyler
+ 	Unfortunately, this will retrieve and layout the initial text twice which
+ 	can make for a noticable performance difference when looking at some
+ 	larger piece of code. So instead we copy the implementation from 
+ 	buildPlugggableText: here and insert #useDefaultStyler at the right point"
+ 	| widget |
+ 	widget := self codePaneClass new.
+ 	widget useDefaultStyler.
+ 	widget on: aSpec model
+ 				text: aSpec getText 
+ 				accept: aSpec setText
+ 				readSelection: aSpec selection 
+ 				menu: aSpec menu.
+ 	widget font: Preferences standardCodeFont.
+ 	self register: widget id: aSpec name.
+ 	widget getColorSelector: aSpec color.
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ 	widget borderColor: Color lightGray.
+ 	widget color: Color white.
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableDropDownList: (in category 'pluggable widgets') -----
+ buildPluggableDropDownList: spec
+ 
+ 	| widget model listSelector selectionSelector selectionSetter |
+ 	model := spec model.
+ 	listSelector := spec listSelector.
+ 	selectionSelector := spec selectionSelector.
+ 	selectionSetter := spec selectionSetter.
+ 	widget := self dropDownListClass new
+ 		model: model;
+ 		listSelector: listSelector;
+ 		selectionSelector: selectionSelector;
+ 		selectionSetter: selectionSetter;
+ 		yourself.
+ 	self register: widget id: spec name.
+ 
+ 	widget installDropDownList.
+ 	self setFrame: spec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableInputField: (in category 'pluggable widgets') -----
+ buildPluggableInputField: aSpec
+ 	| widget |
+ 	widget := self buildPluggableText: aSpec.
+ 	widget acceptOnCR: true.
+ 	widget hideScrollBarsIndefinitely.
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableList: (in category 'pluggable widgets') -----
+ buildPluggableList: aSpec
+ 	| widget listClass getIndex setIndex |
+ 	aSpec getSelected ifNil:[
+ 		listClass := self listClass.
+ 		getIndex := aSpec getIndex.
+ 		setIndex := aSpec setIndex.
+ 	] ifNotNil:[
+ 		listClass := self listByItemClass.
+ 		getIndex := aSpec getSelected.
+ 		setIndex := aSpec setSelected.
+ 	].
+ 	widget := listClass on: aSpec model
+ 				list: aSpec list
+ 				selected: getIndex
+ 				changeSelected: setIndex
+ 				menu: aSpec menu
+ 				keystroke: aSpec keyPress.
+ 	self register: widget id: aSpec name.
+ 	widget getListElementSelector: aSpec listItem.
+ 	widget getListSizeSelector: aSpec listSize.
+ 	widget getIconSelector: aSpec icon.
+ 	widget doubleClickSelector: aSpec doubleClick.
+ 	widget dragItemSelector: aSpec dragItem.
+ 	widget dropItemSelector: aSpec dropItem.
+ 	widget wantsDropSelector: aSpec dropAccept.
+ 	widget autoDeselect: aSpec autoDeselect.
+ 	widget keystrokePreviewSelector: aSpec keystrokePreview.
+ 	aSpec color isNil 
+ 		ifTrue: [widget 
+ 					borderWidth: 1; 
+ 					borderColor: Color lightGray; 
+ 					color: Color white]
+ 		ifFalse: [widget color: aSpec color].
+ 	self buildHelpFor: widget spec: aSpec. 
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ 	panes ifNotNil:[
+ 		aSpec list ifNotNil:[panes add: aSpec list].
+ 	].
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableMenu: (in category 'building') -----
+ buildPluggableMenu: menuSpec 
+ 	| prior menu |
+ 	prior := parentMenu.
+ 	parentMenu := menu := self menuClass new.
+ 	menuSpec label ifNotNil:[parentMenu addTitle: menuSpec label].
+ 	menuSpec items do:[:each| each buildWith: self].
+ 	parentMenu := prior.
+ 	^menu!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableMenuItem: (in category 'building') -----
+ buildPluggableMenuItem: itemSpec
+ 	| item action label menu |
+ 	item := self menuItemClass new.
+ 	label := itemSpec label.
+ 	itemSpec checked ifTrue:[label := '<on>', label] ifFalse:[label := '<off>', label].
+ 	item contents: label.
+ 	item isEnabled: itemSpec enabled.
+ 	(action := itemSpec action) ifNotNil:[
+ 		item 
+ 			target: action receiver;
+ 			selector: action selector;
+ 			arguments: action arguments.
+ 	].
+ 	(menu := itemSpec subMenu) ifNotNil:[
+ 		item subMenu: (menu buildWith: self).
+ 	].
+ 	parentMenu ifNotNil:[parentMenu addMorphBack: item].
+ 	itemSpec separator ifTrue:[parentMenu addLine].
+ 	^item!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableMultiSelectionList: (in category 'pluggable widgets') -----
+ buildPluggableMultiSelectionList: aSpec
+ 	| widget listClass |
+ 	aSpec getSelected ifNotNil:[^self error:'There is no PluggableListMorphOfManyByItem'].
+ 	listClass := self multiSelectListClass.
+ 	widget := listClass on: aSpec model
+ 		list: aSpec list
+ 		primarySelection: aSpec getIndex
+ 		changePrimarySelection: aSpec setIndex
+ 		listSelection: aSpec getSelectionList
+ 		changeListSelection: aSpec setSelectionList
+ 		menu: aSpec menu.
+ 	self register: widget id: aSpec name.
+ 	widget keystrokeActionSelector: aSpec keyPress.
+ 	widget getListElementSelector: aSpec listItem.
+ 	widget getListSizeSelector: aSpec listSize.
+ 	self buildHelpFor: widget spec: aSpec. 
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ 	panes ifNotNil:[
+ 		aSpec list ifNotNil:[panes add: aSpec list].
+ 	].
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggablePanel: (in category 'pluggable widgets') -----
+ buildPluggablePanel: aSpec
+ 	| widget children frame |
+ 	widget := self panelClass new.
+ 	self register: widget id: aSpec name.
+ 	widget model: aSpec model.
+ 	widget color: Color transparent.
+ 	widget clipSubmorphs: true.
+ 	children := aSpec children.
+ 	children isSymbol ifTrue:[
+ 		widget getChildrenSelector: children.
+ 		widget update: children.
+ 		children := #().
+ 	].
+ 	self buildAll: children in: widget.
+ 	self buildHelpFor: widget spec: aSpec. 
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ 	self setLayout: aSpec layout in: widget.
+ 	widget layoutInset: 0.
+ 	widget borderWidth: 0.
+ 	widget submorphsDo:[:sm|
+ 		(frame := sm layoutFrame) ifNotNil:[
+ 			(frame rightFraction = 0 or:[frame rightFraction = 1]) 
+ 				ifFalse:[frame rightOffset:1].
+ 			(frame bottomFraction = 0 or:[frame bottomFraction = 1]) 
+ 				ifFalse:[frame bottomOffset: 1]]].
+ 	widget color: Color transparent.
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableText: (in category 'pluggable widgets') -----
+ buildPluggableText: aSpec
+ 	| widget |
+ 	widget := self textPaneClass on: aSpec model
+ 				text: aSpec getText 
+ 				accept: aSpec setText
+ 				readSelection: aSpec selection 
+ 				menu: aSpec menu.
+ 	widget askBeforeDiscardingEdits: aSpec askBeforeDiscardingEdits.
+ 	widget font: Preferences standardCodeFont.
+ 	self register: widget id: aSpec name.
+ 	widget getColorSelector: aSpec color.
+ 	self buildHelpFor: widget spec: aSpec. 
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ 	widget borderColor: Color lightGray.
+ 	widget color: Color white.
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableTree: (in category 'pluggable widgets') -----
+ buildPluggableTree: aSpec
+ 	| widget |
+ 	widget := self treeClass new.
+ 	self register: widget id: aSpec name.
+ 	widget model: aSpec model.
+ 	widget getSelectedPathSelector: aSpec getSelectedPath.
+ 	widget setSelectedSelector: aSpec setSelected.
+ 	widget getChildrenSelector: aSpec getChildren.
+ 	widget hasChildrenSelector: aSpec hasChildren.
+ 	widget getLabelSelector: aSpec label.
+ 	widget getIconSelector: aSpec icon.
+ 	widget getHelpSelector: aSpec help.
+ 	widget getMenuSelector: aSpec menu.
+ 	widget keystrokeActionSelector: aSpec keyPress.
+ 	widget getRootsSelector: aSpec roots.
+ 	widget autoDeselect: aSpec autoDeselect.
+ 	widget dropItemSelector: aSpec dropItem.
+ 	widget wantsDropSelector: aSpec dropAccept.
+ 	widget dragItemSelector: aSpec dragItem.
+ 	self setFrame: aSpec frame in: widget.
+ 	parent ifNotNil:[self add: widget to: parent].
+ "	panes ifNotNil:[
+ 		aSpec roots ifNotNil:[panes add: aSpec roots].
+ 	].	"
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buildPluggableWindow: (in category 'pluggable widgets') -----
+ buildPluggableWindow: aSpec
+ 	| widget children |
+ 	aSpec layout == #proportional ifFalse:[
+ 		"This needs to be implemented - probably by adding a single pane and then the rest"
+ 		^self error: 'Not implemented'.
+ 	].
+ 	widget := (self windowClassFor: aSpec) new.
+ 	self register: widget id: aSpec name.
+ 	widget model: aSpec model.
+ 	aSpec label ifNotNil:
+ 		[:label|
+ 		label isSymbol 
+ 			ifTrue:[widget getLabelSelector: label]
+ 			ifFalse:[widget setLabel: label]].
+ 	aSpec multiWindowStyle notNil ifTrue:
+ 		[widget savedMultiWindowState: (SavedMultiWindowState on: aSpec model)].
+ 	children := aSpec children.
+ 	children isSymbol ifTrue:[
+ 		widget getChildrenSelector: children.
+ 		widget update: children.
+ 		children := #().
+ 	].
+ 	widget closeWindowSelector: aSpec closeAction.
+ 	panes := OrderedCollection new.
+ 	self buildAll: children in: widget.
+ 	self buildHelpFor: widget spec: aSpec. 
+ 	widget bounds: (RealEstateAgent 
+ 		initialFrameFor: widget 
+ 		initialExtent: (aSpec extent ifNil:[widget initialExtent])
+ 		world: self currentWorld).
+ 	widget setUpdatablePanesFrom: panes.
+ 	^widget!
Item was added:
+ ----- Method: MorphicToolBuilder>>buttonClass (in category 'widget classes') -----
+ buttonClass
+ 	^ PluggableButtonMorphPlus!
Item was added:
+ ----- Method: MorphicToolBuilder>>checkBoxClass (in category 'widget classes') -----
+ checkBoxClass
+ 	^ PluggableCheckBoxMorph!
Item was added:
+ ----- Method: MorphicToolBuilder>>close: (in category 'opening') -----
+ close: aWidget
+ 	"Close a previously opened widget"
+ 	aWidget delete!
Item was added:
+ ----- Method: MorphicToolBuilder>>codePaneClass (in category 'widget classes') -----
+ codePaneClass
+ 	^ PluggableTextMorphPlus!
Item was added:
+ ----- Method: MorphicToolBuilder>>dropDownListClass (in category 'widget classes') -----
+ dropDownListClass
+ 	^ PluggableDropDownListMorph!
Item was added:
+ ----- Method: MorphicToolBuilder>>listByItemClass (in category 'widget classes') -----
+ listByItemClass
+ 	^ PluggableListMorphByItemPlus!
Item was added:
+ ----- Method: MorphicToolBuilder>>listClass (in category 'widget classes') -----
+ listClass
+ 	^ PluggableListMorphPlus!
Item was added:
+ ----- Method: MorphicToolBuilder>>menuClass (in category 'widget classes') -----
+ menuClass
+ 	^ MenuMorph!
Item was added:
+ ----- Method: MorphicToolBuilder>>menuItemClass (in category 'widget classes') -----
+ menuItemClass
+ 	^ MenuItemMorph!
Item was added:
+ ----- Method: MorphicToolBuilder>>multiSelectListClass (in category 'widget classes') -----
+ multiSelectListClass
+ 	^ PluggableListMorphOfMany!
Item was added:
+ ----- Method: MorphicToolBuilder>>open: (in category 'opening') -----
+ open: anObject
+ 	"Build and open the object. Answer the widget opened."
+ 	| morph |
+ 	anObject isMorph 
+ 		ifTrue:[morph := anObject]
+ 		ifFalse:[morph := self build: anObject].
+ 	(morph isKindOf: MenuMorph)
+ 		ifTrue:[morph popUpInWorld: World].
+ 	(morph isKindOf: SystemWindow)
+ 		ifTrue:[morph openInWorldExtent: morph extent]
+ 		ifFalse:[morph openInWorld].
+ 	^morph!
Item was added:
+ ----- Method: MorphicToolBuilder>>open:label: (in category 'opening') -----
+ open: anObject label: aString
+ 	"Build an open the object, labeling it appropriately.  Answer the widget opened."
+ 	| window |
+ 	window := self open: anObject.
+ 	window setLabel: aString.
+ 	^window!
Item was added:
+ ----- Method: MorphicToolBuilder>>panelClass (in category 'widget classes') -----
+ panelClass
+ 	^ PluggablePanelMorph!
Item was added:
+ ----- Method: MorphicToolBuilder>>register:id: (in category 'private') -----
+ register: widget id: id
+ 	id ifNil:[^self].
+ 	widgets ifNil:[widgets := Dictionary new].
+ 	widgets at: id put: widget.
+ 	widget setNameTo: id.!
Item was added:
+ ----- Method: MorphicToolBuilder>>runModal: (in category 'opening') -----
+ runModal: aWidget
+ 	"Run the (previously opened) widget modally, e.g., 
+ 	do not return control to the sender before the user has responded."
+ 	[aWidget world notNil] whileTrue: [
+ 		aWidget outermostWorldMorph doOneCycle.
+ 	].
+ !
Item was added:
+ ----- Method: MorphicToolBuilder>>setFrame:in: (in category 'private') -----
+ setFrame: aRectangle in: widget
+ 	| frame |
+ 	aRectangle ifNil:[^nil].
+ 	frame := aRectangle isRectangle
+ 		ifTrue: [self asFrame: aRectangle]
+ 		ifFalse: [aRectangle]. "assume LayoutFrame"
+ 	widget layoutFrame: frame.
+ 	widget hResizing: #spaceFill; vResizing: #spaceFill.
+ 	(parent isSystemWindow) ifTrue:[
+ 		widget borderWidth: 2; borderColor: #inset.
+ 	].!
Item was added:
+ ----- Method: MorphicToolBuilder>>setLayout:in: (in category 'private') -----
+ setLayout: layout in: widget
+ 	layout == #proportional ifTrue:[
+ 		widget layoutPolicy: ProportionalLayout new.
+ 		^self].
+ 	layout == #horizontal ifTrue:[
+ 		widget layoutPolicy: TableLayout new.
+ 		widget listDirection: #leftToRight.
+ 		widget submorphsDo:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
+ 		widget cellInset: 1@1.
+ 		widget layoutInset: 1@1.
+ 		widget color: Color transparent.
+ 		"and then some..."
+ 		^self].
+ 	layout == #vertical ifTrue:[
+ 		widget layoutPolicy: TableLayout new.
+ 		widget listDirection: #topToBottom.
+ 		widget submorphsDo:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
+ 		widget cellInset: 1@1.
+ 		widget layoutInset: 1@1.
+ 		widget color: Color transparent.
+ 		"and then some..."
+ 		^self].
+ 	^self error: 'Unknown layout: ', layout.!
Item was added:
+ ----- Method: MorphicToolBuilder>>textPaneClass (in category 'widget classes') -----
+ textPaneClass
+ 	^ PluggableTextMorphPlus!
Item was added:
+ ----- Method: MorphicToolBuilder>>treeClass (in category 'widget classes') -----
+ treeClass
+ 	^ PluggableTreeMorph!
Item was added:
+ ----- Method: MorphicToolBuilder>>widgetAt:ifAbsent: (in category 'private') -----
+ widgetAt: id ifAbsent: aBlock
+ 	widgets ifNil:[^aBlock value].
+ 	^widgets at: id ifAbsent: aBlock!
Item was added:
+ ----- Method: MorphicToolBuilder>>windowClass (in category 'widget classes') -----
+ windowClass
+ 	^ PluggableSystemWindow!
Item was added:
+ ----- Method: MorphicToolBuilder>>windowClassFor: (in category 'widget classes') -----
+ windowClassFor: aSpec
+ 	aSpec isDialog ifTrue: [^ PluggableDialogWindow].
+ 	^aSpec multiWindowStyle
+ 		caseOf:
+ 		{	[nil]				->	[PluggableSystemWindow].
+ 			[#labelButton]	->	[PluggableSystemWindowWithLabelButton] }
+ 		otherwise:				[PluggableSystemWindowWithLabelButton]!
Item was added:
+ ToolBuilderTests subclass: #MorphicToolBuilderTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !MorphicToolBuilderTests commentStamp: 'ar 2/11/2005 15:02' prior: 0!
+ Tests for the Morphic tool builder.!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>acceptWidgetText (in category 'support') -----
+ acceptWidgetText
+ 	widget hasUnacceptedEdits: true.
+ 	widget accept.!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>buttonWidgetEnabled (in category 'support') -----
+ buttonWidgetEnabled
+ 	"Answer whether the current widget (a button) is currently enabled"
+ 	^widget enabled!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>changeListWidget (in category 'support') -----
+ changeListWidget
+ 	widget changeModelSelection: widget getCurrentSelectionIndex + 1.!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>expectedButtonSideEffects (in category 'support') -----
+ expectedButtonSideEffects
+ 	^#(getColor getState getEnabled)!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>fireButtonWidget (in category 'support') -----
+ fireButtonWidget
+ 	widget performAction.!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>fireMenuItemWidget (in category 'support') -----
+ fireMenuItemWidget
+ 	(widget itemWithWording: 'Menu Item')
+ 		ifNotNil: [:item | item doButtonAction]!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>setUp (in category 'support') -----
+ setUp
+ 	super setUp.
+ 	builder := MorphicToolBuilder new.!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>testWindowDynamicLabel (in category 'tests-window') -----
+ testWindowDynamicLabel
+ 	self makeWindow.
+ 	self assert: (widget label = 'TestLabel').!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>testWindowStaticLabel (in category 'tests-window') -----
+ testWindowStaticLabel
+ 	| spec |
+ 	spec := builder pluggableWindowSpec new.
+ 	spec model: self.
+ 	spec children: #().
+ 	spec label: 'TestLabel'.
+ 	widget := builder build: spec.
+ 	self assert: (widget label = 'TestLabel').!
Item was added:
+ ----- Method: MorphicToolBuilderTests>>widgetColor (in category 'support') -----
+ widgetColor
+ 	"Answer color from widget"
+ 	^widget color!
Item was added:
+ UIManager subclass: #MorphicUIManager
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !MorphicUIManager commentStamp: 'dtl 5/2/2010 16:07' prior: 0!
+ MorphicUIManager is a UIManager that implements user interface requests for a Morphic user interface.!
Item was added:
+ ----- Method: MorphicUIManager class>>isActiveManager (in category 'accessing') -----
+ isActiveManager
+ 	"Answer whether I should act as the active ui manager"
+ 	^Smalltalk isMorphic!
Item was added:
+ ----- Method: MorphicUIManager>>chooseClassOrTrait:from: (in category 'ui requests') -----
+ chooseClassOrTrait: label from: environment
+ 	"Let the user choose a Class or Trait. Use ListChooser in Morphic."
+ 	
+ 	| names index |
+ 	names := environment classAndTraitNames.
+ 	index := self
+ 		chooseFrom: names
+ 		lines: #()
+ 		title: label.
+ 	index = 0 ifTrue: [ ^nil ].
+ 	^environment
+ 		at: (names at: index)
+ 		ifAbsent: [ nil ]!
Item was added:
+ ----- Method: MorphicUIManager>>chooseDirectory:from: (in category 'ui requests') -----
+ chooseDirectory: label from: dir
+ 	"Let the user choose a directory"
+ 	^FileList2 modalFolderSelector: dir!
Item was added:
+ ----- Method: MorphicUIManager>>chooseFileMatching:label: (in category 'ui requests') -----
+ chooseFileMatching: patterns label: aString
+ 	"Let the user choose a file matching the given patterns"
+ 	| result |
+ 	result := FileList2 modalFileSelectorForSuffixes: patterns.
+ 	^result ifNotNil:[result fullName]!
Item was added:
+ ----- Method: MorphicUIManager>>chooseFont:for:setSelector:getSelector: (in category 'ui requests') -----
+ chooseFont: titleString for: aModel setSelector: setSelector getSelector: getSelector
+ 	"Open a font-chooser for the given model"
+ 	^FontChooserTool default
+ 		openWithWindowTitle: titleString 
+ 		for: aModel 
+ 		setSelector: setSelector 
+ 		getSelector: getSelector!
Item was added:
+ ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui requests') -----
+ chooseFrom: aList lines: linesArray title: aString 
+ 	"Choose an item from the given list. Answer the index of the selected item."
+ 	^ aList size > 30
+ 		ifTrue:
+ 			[ "Don't put more than 30 items in a menu.  Use ListChooser insted"
+ 			ListChooser
+ 				chooseFrom: aList
+ 				title: aString ]
+ 		ifFalse:
+ 			[ MenuMorph
+ 				chooseFrom: aList
+ 				lines: linesArray
+ 				title: aString ]!
Item was added:
+ ----- Method: MorphicUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') -----
+ chooseFrom: labelList values: valueList lines: linesArray title: aString 
+ 	"Choose an item from the given list. Answer the selected item."
+ 	| index |
+ 	^ labelList size > 30
+ 		ifTrue:
+ 			[ "No point in displaying more than 30 items in a menu.  Use ListChooser insted"
+ 			index := ListChooser
+ 				chooseFrom: labelList
+ 				title: aString.
+ 			index = 0 ifFalse: [ valueList at: index ] ]
+ 		ifFalse:
+ 			[ MenuMorph
+ 				chooseFrom: labelList
+ 				values: valueList
+ 				lines: linesArray
+ 				title: aString ]!
Item was added:
+ ----- Method: MorphicUIManager>>confirm: (in category 'ui requests') -----
+ confirm: queryString
+ 	"Put up a yes/no menu with caption queryString. Answer true if the 
+ 	response is yes, false if no. This is a modal question--the user must 
+ 	respond yes or no."
+ 	^UserDialogBoxMorph confirm: queryString!
Item was added:
+ ----- Method: MorphicUIManager>>confirm:orCancel: (in category 'ui requests') -----
+ confirm: aString orCancel: cancelBlock
+ 	"Put up a yes/no/cancel menu with caption aString. Answer true if  
+ 	the response is yes, false if no. If cancel is chosen, evaluate  
+ 	cancelBlock. This is a modal question--the user must respond yes or no."
+ 	^UserDialogBoxMorph confirm: aString orCancel: cancelBlock!
Item was added:
+ ----- Method: MorphicUIManager>>confirm:trueChoice:falseChoice: (in category 'ui requests') -----
+ confirm: queryString trueChoice: trueChoice falseChoice: falseChoice 
+ 	"Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice, false if it's the false-choice.
+ 	This is a modal question -- the user must respond one way or the other."
+ 	^ UserDialogBoxMorph confirm: queryString trueChoice: trueChoice falseChoice: falseChoice !
Item was added:
+ ----- Method: MorphicUIManager>>displayProgress:at:from:to:during: (in category 'ui requests') -----
+ displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock 
+ 	"Display titleString as a caption over a progress bar while workBlock is evaluated."
+ 	| result progress |
+ 	progress := SystemProgressMorph
+ 		position: aPoint
+ 		label: titleString
+ 		min: minVal
+ 		max: maxVal.
+ 	[ [ result := workBlock value: progress ]
+ 		on: ProgressNotification
+ 		do:
+ 			[ : ex | ex extraParam isString ifTrue:
+ 				[ SystemProgressMorph uniqueInstance
+ 					labelAt: progress
+ 					put: ex extraParam ].
+ 			ex resume ] ] ensure: [ SystemProgressMorph close: progress ].
+ 	^ result!
Item was added:
+ ----- Method: MorphicUIManager>>edit:label:accept: (in category 'ui requests') -----
+ edit: aText label: labelString accept: anAction
+ 	"Open an editor on the given string/text"
+ 	| window |
+ 	window := Workspace open.
+ 	labelString ifNotNil: [ window setLabel: labelString ].
+ 	"By default, don't style in UIManager edit: requests"
+ 	window model
+ 		shouldStyle: false;
+ 		acceptContents:  aText;
+ 		acceptAction: anAction.
+ 	^window.!
Item was added:
+ ----- Method: MorphicUIManager>>inform: (in category 'ui requests') -----
+ inform: aString
+ 	"Display a message for the user to read and then dismiss"
+ 	^UserDialogBoxMorph inform: aString!
Item was added:
+ ----- Method: MorphicUIManager>>informUserDuring: (in category 'ui requests') -----
+ informUserDuring: aBlock
+ 	"Display a message above (or below if insufficient room) the cursor 
+ 	during execution of the given block.
+ 		UIManager default informUserDuring:[:bar|
+ 			#(one two three) do:[:info|
+ 				bar value: info.
+ 				(Delay forSeconds: 1) wait]]"
+ 	SystemProgressMorph
+ 		informUserAt: nil during: aBlock.!
Item was added:
+ ----- Method: MorphicUIManager>>initialize (in category 'initialize-release') -----
+ initialize
+ 	toolBuilder := MorphicToolBuilder new!
Item was added:
+ ----- Method: MorphicUIManager>>multiLineRequest:centerAt:initialAnswer:answerHeight: (in category 'ui requests') -----
+ multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight
+ 	"Create a multi-line instance of me whose question is queryString with
+ 	the given initial answer. Invoke it centered at the given point, and
+ 	answer the string the user accepts.  Answer nil if the user cancels.  An
+ 	empty string returned means that the ussr cleared the editing area and
+ 	then hit 'accept'.  Because multiple lines are invited, we ask that the user
+ 	use the ENTER key, or (in morphic anyway) hit the 'accept' button, to 
+ 	submit; that way, the return key can be typed to move to the next line."
+ 	^FillInTheBlankMorph 
+ 		request: queryString 
+ 		initialAnswer: defaultAnswer 
+ 		centerAt: aPoint 
+ 		inWorld: self currentWorld
+ 		onCancelReturn: nil
+ 		acceptOnCR: false!
Item was added:
+ ----- Method: MorphicUIManager>>request:initialAnswer: (in category 'ui requests') -----
+ request: queryString initialAnswer: defaultAnswer 
+ 	"Create an instance of me whose question is queryString with the given 
+ 	initial answer. Invoke it centered at the given point, and answer the 
+ 	string the user accepts. Answer the empty string if the user cancels."
+ 	^FillInTheBlankMorph request: queryString initialAnswer: defaultAnswer !
Item was added:
+ ----- Method: MorphicUIManager>>request:initialAnswer:centerAt: (in category 'ui requests') -----
+ request: queryString initialAnswer: defaultAnswer centerAt: aPoint 
+ 	"Create an instance of me whose question is queryString with the given
+ 	initial answer. Invoke it centered at the given point, and answer the
+ 	string the user accepts. Answer the empty string if the user cancels."
+ 	^FillInTheBlankMorph request: queryString initialAnswer: defaultAnswer centerAt: aPoint!
Item was added:
+ ----- Method: MorphicUIManager>>requestPassword: (in category 'ui requests') -----
+ requestPassword: queryString
+ 	"Create an instance of me whose question is queryString. Invoke it centered
+ 	at the cursor, and answer the string the user accepts. Answer the empty 
+ 	string if the user cancels."
+ 	^FillInTheBlankMorph requestPassword: queryString!
Item was added:
+ PluggableButtonMorph subclass: #PluggableButtonMorphPlus
+ 	instanceVariableNames: 'enabled action getColorSelector getEnabledSelector updateMap'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !PluggableButtonMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0!
+ An extended version of PluggableButtonMorph supporting enablement, color and block/message actions.!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>action (in category 'accessing') -----
+ action
+ 	^action!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>action: (in category 'accessing') -----
+ action: anAction	
+ 	action := nil.
+ 	anAction isSymbol ifTrue:[^super action: anAction].
+ 	action := anAction.!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>enabled (in category 'accessing') -----
+ enabled
+ 	^ enabled ifNil: [enabled := true]!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>enabled: (in category 'accessing') -----
+ enabled: aBool
+ 	enabled := aBool.
+ 	enabled 
+ 		ifFalse:[self color: Color gray]
+ 		ifTrue:[self getModelState
+ 			ifTrue: [self color: onColor]
+ 			ifFalse: [self color: offColor]]!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>getColorSelector (in category 'accessing') -----
+ getColorSelector
+ 	^getColorSelector!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>getColorSelector: (in category 'accessing') -----
+ getColorSelector: aSymbol
+ 	getColorSelector := aSymbol.
+ 	self update: getColorSelector.!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>getEnabledSelector (in category 'accessing') -----
+ getEnabledSelector
+ 	^getEnabledSelector!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>getEnabledSelector: (in category 'accessing') -----
+ getEnabledSelector: aSymbol
+ 	getEnabledSelector := aSymbol.
+ 	self update: aSymbol.!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>initialize (in category 'initialize-release') -----
+ initialize
+ 	super initialize.
+ 	enabled := true.
+ 	onColor := Color veryLightGray.
+ 	offColor := Color white!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>mouseDown: (in category 'action') -----
+ mouseDown: evt
+ 	enabled ifFalse:[^self].
+ 	^super mouseDown: evt!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>mouseMove: (in category 'action') -----
+ mouseMove: evt
+ 	enabled ifFalse:[^self].
+ 	^super mouseMove: evt!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>mouseUp: (in category 'action') -----
+ mouseUp: evt
+ 	enabled ifFalse:[^self].
+ 	^super mouseUp: evt!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>onColor:offColor: (in category 'accessing') -----
+ onColor: colorWhenOn offColor: colorWhenOff
+ 	"Set the fill colors to be used when this button is on/off."
+ 
+ 	onColor := colorWhenOn.
+ 	offColor := colorWhenOff.
+ 	self update: getStateSelector.!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>performAction (in category 'action') -----
+ performAction
+ 	enabled ifFalse:[^self].
+ 	action ifNotNil:[^action value].
+ 	^super performAction!
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>update: (in category 'updating') -----
+ update: what
+ 	what ifNil:[^self].
+ 	what == getLabelSelector ifTrue: [
+ 		self label: (model perform: getLabelSelector)].
+ 	what == getEnabledSelector ifTrue:[^self enabled: (model perform: getEnabledSelector)].
+ 
+ 	getColorSelector ifNotNil: [ | cc |
+ 		color = (cc := model perform: getColorSelector) ifFalse:[
+ 			color := cc.
+ 			self onColor: color offColor: color.
+ 			self changed.
+ 		].
+ 	].
+ 	self getModelState
+ 			ifTrue: [self color: onColor]
+ 			ifFalse: [self color: offColor].
+ 	getEnabledSelector ifNotNil:[
+ 		self enabled: (model perform: getEnabledSelector).
+ 	].
+ 	updateMap ifNotNil:
+ 		[(updateMap at: what ifAbsent: [])
+ 			ifNotNilDo: [ :newTarget | ^self update: newTarget]].
+ !
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>updateMap (in category 'updating') -----
+ updateMap
+ 	^ updateMap ifNil: [updateMap := Dictionary new]
+ !
Item was added:
+ ----- Method: PluggableButtonMorphPlus>>whenChanged:update: (in category 'updating') -----
+ whenChanged: notification update: target
+ 	"On receipt of a notification, such as #contents notification from a CodeHolder,
+ 	invoke an update as if target had been the original notification."
+ 
+ 	self updateMap at: notification put: target!
Item was added:
+ AlignmentMorph subclass: #PluggableCheckBoxMorph
+ 	instanceVariableNames: 'model actionSelector valueSelector label'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
Item was added:
+ ----- Method: PluggableCheckBoxMorph class>>on:getState:action:label: (in category 'as yet unclassified') -----
+ on: anObject getState: getStateSel action: actionSel label: labelSel
+ 
+ 	^ self new
+ 		on: anObject
+ 		getState: getStateSel
+ 		action: actionSel
+ 		label: labelSel
+ 		menu: nil
+ !
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>actionSelector (in category 'accessing') -----
+ actionSelector
+ 	"Answer the value of actionSelector"
+ 
+ 	^ actionSelector!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>actionSelector: (in category 'accessing') -----
+ actionSelector: anObject
+ 	"Set the value of actionSelector"
+ 
+ 	actionSelector := anObject!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>basicPanel (in category 'installing') -----
+ basicPanel
+ 	^BorderedMorph new
+ 		beTransparent;
+ 		extent: 0@0;
+ 		borderWidth: 0;
+ 		layoutInset: 0;
+ 		cellInset: 0;
+ 		layoutPolicy: TableLayout new;
+ 		listCentering: #topLeft;
+ 		cellPositioning: #center;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		yourself!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>horizontalPanel (in category 'installing') -----
+ horizontalPanel
+ 	^self basicPanel
+ 		cellPositioning: #center;
+ 		listDirection: #leftToRight;
+ 		yourself.!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>installButton (in category 'installing') -----
+ installButton
+ 
+ 	| aButton aLabel |
+ 	aButton := UpdatingThreePhaseButtonMorph checkBox
+ 		target: self model;
+ 		actionSelector: self actionSelector;
+ 		getSelector: self valueSelector;
+ 		yourself.
+ 	aLabel := (StringMorph contents: self label translated
+ 				font: (StrikeFont familyName: TextStyle defaultFont familyName
+ 							size: TextStyle defaultFont pointSize - 1)).
+ 	self addMorph: (self horizontalPanel
+ 		addMorphBack: aButton;
+ 		addMorphBack: aLabel;
+ 		yourself).!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>label (in category 'accessing') -----
+ label
+ 	"Answer the value of label"
+ 
+ 	^ label!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>label: (in category 'accessing') -----
+ label: anObject
+ 	"Set the value of label"
+ 
+ 	label := anObject!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>model (in category 'accessing') -----
+ model
+ 	"Answer the value of model"
+ 
+ 	^ model.
+ !
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>model: (in category 'accessing') -----
+ model: anObject
+ 	"Set the value of model"
+ 
+ 	model := anObject!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>on:getState:action:label:menu: (in category 'initialization') -----
+ on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel
+ 
+ 	self model: anObject.
+ 	self valueSelector: getStateSel.
+ 	self actionSelector: actionSel.
+ 	self label: (self model perform: labelSel).
+ !
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>valueSelector (in category 'accessing') -----
+ valueSelector
+ 	"Answer the value of valueSelector"
+ 
+ 	^ valueSelector!
Item was added:
+ ----- Method: PluggableCheckBoxMorph>>valueSelector: (in category 'accessing') -----
+ valueSelector: anObject
+ 	"Set the value of valueSelector"
+ 
+ 	valueSelector := anObject!
Item was added:
+ PluggableSystemWindow subclass: #PluggableDialogWindow
+ 	instanceVariableNames: 'statusValue'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
Item was added:
+ ----- Method: PluggableDialogWindow>>statusValue (in category 'as yet unclassified') -----
+ statusValue
+ 	^statusValue!
Item was added:
+ ----- Method: PluggableDialogWindow>>statusValue: (in category 'as yet unclassified') -----
+ statusValue: val
+ 	statusValue := val!
Item was added:
+ AlignmentMorph subclass: #PluggableDropDownListMorph
+ 	instanceVariableNames: 'model listSelector selectionSelector selectionSetter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>basicPanel (in category 'drawing') -----
+ basicPanel
+ 	^BorderedMorph new
+ 		beTransparent;
+ 		extent: 0@0;
+ 		borderWidth: 0;
+ 		layoutInset: 0;
+ 		cellInset: 0;
+ 		layoutPolicy: TableLayout new;
+ 		listCentering: #topLeft;
+ 		cellPositioning: #center;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		yourself!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>currentSelection (in category 'accessing') -----
+ currentSelection
+ 
+ 	^ self model perform: selectionSelector!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>currentSelection: (in category 'accessing') -----
+ currentSelection: obj
+ 
+ 	^ self model perform: selectionSetter with: obj!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>horizontalPanel (in category 'drawing') -----
+ horizontalPanel
+ 	^self basicPanel
+ 		cellPositioning: #center;
+ 		listDirection: #leftToRight;
+ 		yourself.!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>installDropDownList (in category 'drawing') -----
+ installDropDownList
+ 
+ 	| aButton aLabel |
+ 	aButton := PluggableButtonMorph on: self model getState: nil action: nil.
+ 	aLabel := (StringMorph contents: self model currentRemoteVatId translated
+ 				font: (StrikeFont familyName: TextStyle defaultFont familyName
+ 							size: TextStyle defaultFont pointSize - 1)).
+ 	self addMorph: (self horizontalPanel
+ 		addMorphBack: aLabel;
+ 		addMorphBack: aButton;
+ 		yourself).!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>list (in category 'accessing') -----
+ list
+ 	"Answer the value of list"
+ 
+ 	^ self model perform: self listSelector.
+ 	!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>listSelector (in category 'accessing') -----
+ listSelector
+ 	"Answer the value of listSelector"
+ 
+ 	^ listSelector!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>listSelector: (in category 'accessing') -----
+ listSelector: anObject
+ 	"Set the value of listSelector"
+ 
+ 	listSelector := anObject!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>model (in category 'accessing') -----
+ model
+ 	^ model!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>model: (in category 'accessing') -----
+ model: anObject
+ 	"Set the value of model"
+ 
+ 	model := anObject!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>selectionSelector (in category 'accessing') -----
+ selectionSelector
+ 	"Answer the value of selectionSelector"
+ 
+ 	^ selectionSelector!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>selectionSelector: (in category 'accessing') -----
+ selectionSelector: anObject
+ 	"Set the value of selectionSelector"
+ 
+ 	selectionSelector := anObject!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>selectionSetter (in category 'accessing') -----
+ selectionSetter
+ 	"Answer the value of selectionSetter"
+ 
+ 	^ selectionSetter!
Item was added:
+ ----- Method: PluggableDropDownListMorph>>selectionSetter: (in category 'accessing') -----
+ selectionSetter: anObject
+ 	"Set the value of selectionSetter"
+ 
+ 	selectionSetter := anObject!
Item was added:
+ PluggableListMorphPlus subclass: #PluggableListMorphByItemPlus
+ 	instanceVariableNames: 'itemList'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !PluggableListMorphByItemPlus commentStamp: '<historical>' prior: 0!
+ Main comment stating the purpose of this class and relevant relationship to other classes.
+ 
+ Possible useful expressions for doIt or printIt.
+ 
+ Structure:
+  instVar1		type -- comment about the purpose of instVar1
+  instVar2		type -- comment about the purpose of instVar2
+ 
+ Any further useful comments about the general approach of this implementation.!
Item was added:
+ ----- Method: PluggableListMorphByItemPlus>>changeModelSelection: (in category 'model access') -----
+ changeModelSelection: anInteger
+ 	"Change the model's selected item to be the one at the given index."
+ 
+ 	| item |
+ 	setIndexSelector ifNotNil: [
+ 		item := (anInteger = 0 ifTrue: [nil] ifFalse: [itemList at: anInteger]).
+ 		model perform: setIndexSelector with: item].
+ 	self update: getIndexSelector.
+ !
Item was added:
+ ----- Method: PluggableListMorphByItemPlus>>getCurrentSelectionIndex (in category 'model access') -----
+ getCurrentSelectionIndex
+ 	"Answer the index of the current selection."
+ 	| item |
+ 	getIndexSelector == nil ifTrue: [^ 0].
+ 	item := model perform: getIndexSelector.
+ 	^ itemList findFirst: [ :x | x = item]
+ !
Item was added:
+ ----- Method: PluggableListMorphByItemPlus>>getList (in category 'as yet unclassified') -----
+ getList
+ 	"cache the raw items in itemList"
+ 	itemList := getListSelector ifNil: [ #() ] ifNotNil: [ model perform: getListSelector ].
+ 	^super getList!
Item was added:
+ ----- Method: PluggableListMorphByItemPlus>>list: (in category 'initialization') -----
+ list: arrayOfStrings
+ 	"Set the receivers items to be the given list of strings."
+ 	"Note: the instance variable 'items' holds the original list.
+ 	 The instance variable 'list' is a paragraph constructed from
+ 	 this list."
+ "NOTE: this is no longer true; list is a real list, and itemList is no longer used.  And this method shouldn't be called, incidentally."
+ self isThisEverCalled .
+ 	itemList := arrayOfStrings.
+ 	^ super list: arrayOfStrings!
Item was added:
+ PluggableListMorph subclass: #PluggableListMorphPlus
+ 	instanceVariableNames: 'dragItemSelector dropItemSelector wantsDropSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !PluggableListMorphPlus commentStamp: 'ar 7/15/2005 11:10' prior: 0!
+ Extensions for PluggableListMorph needed by ToolBuilder!
Item was added:
+ ----- Method: PluggableListMorphPlus>>acceptDroppingMorph:event: (in category 'drag and drop') -----
+ acceptDroppingMorph: aMorph event: evt
+ 	| item |
+ 	dropItemSelector isNil | potentialDropRow isNil ifTrue: [^self].
+ 	item := aMorph passenger.
+ 	model perform: dropItemSelector with: item with: potentialDropRow.
+ 	self resetPotentialDropRow.
+ 	evt hand releaseMouseFocus: self.
+ 	Cursor normal show.
+ !
Item was added:
+ ----- Method: PluggableListMorphPlus>>dragItemSelector (in category 'accessing') -----
+ dragItemSelector
+ 	^dragItemSelector!
Item was added:
+ ----- Method: PluggableListMorphPlus>>dragItemSelector: (in category 'accessing') -----
+ dragItemSelector: aSymbol
+ 	dragItemSelector := aSymbol.
+ 	aSymbol ifNotNil:[self dragEnabled: true].!
Item was added:
+ ----- Method: PluggableListMorphPlus>>dropItemSelector (in category 'accessing') -----
+ dropItemSelector
+ 	^dropItemSelector!
Item was added:
+ ----- Method: PluggableListMorphPlus>>dropItemSelector: (in category 'accessing') -----
+ dropItemSelector: aSymbol
+ 	dropItemSelector := aSymbol.
+ 	aSymbol ifNotNil:[self dropEnabled: true].!
Item was added:
+ ----- Method: PluggableListMorphPlus>>startDrag: (in category 'drag and drop') -----
+ startDrag: evt 
+ 	
+ 	dragItemSelector ifNil:[^self].
+ 	evt hand hasSubmorphs ifTrue: [^ self].
+ 	[ | dragIndex draggedItem ddm |
+ 	(self dragEnabled and: [model okToChange]) ifFalse: [^ self].
+ 	dragIndex := self rowAtLocation: evt position.
+ 	dragIndex = 0 ifTrue:[^self].
+ 	draggedItem := model perform: dragItemSelector with: (self modelIndexFor: dragIndex).
+ 	draggedItem ifNil:[^self].
+ 	ddm := TransferMorph withPassenger: draggedItem from: self.
+ 	ddm dragTransferType: #dragTransferPlus.
+ 	evt hand grabMorph: ddm]
+ 		ensure: [Cursor normal show.
+ 			evt hand releaseMouseFocus: self]!
Item was added:
+ ----- Method: PluggableListMorphPlus>>wantsDropSelector (in category 'accessing') -----
+ wantsDropSelector
+ 	^wantsDropSelector!
Item was added:
+ ----- Method: PluggableListMorphPlus>>wantsDropSelector: (in category 'accessing') -----
+ wantsDropSelector: aSymbol
+ 	wantsDropSelector := aSymbol!
Item was added:
+ ----- Method: PluggableListMorphPlus>>wantsDroppedMorph:event: (in category 'drag and drop') -----
+ wantsDroppedMorph: aMorph event: anEvent
+ 	aMorph dragTransferType == #dragTransferPlus ifFalse:[^false].
+ 	dropItemSelector ifNil:[^false].
+ 	wantsDropSelector ifNil:[^true].
+ 	^(model perform: wantsDropSelector with: aMorph passenger) == true!
Item was added:
+ AlignmentMorph subclass: #PluggablePanelMorph
+ 	instanceVariableNames: 'model getChildrenSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !PluggablePanelMorph commentStamp: 'ar 2/11/2005 20:13' prior: 0!
+ A pluggable panel morph which deals with changing children.!
Item was added:
+ ----- Method: PluggablePanelMorph>>getChildrenSelector (in category 'accessing') -----
+ getChildrenSelector
+ 	^getChildrenSelector!
Item was added:
+ ----- Method: PluggablePanelMorph>>getChildrenSelector: (in category 'accessing') -----
+ getChildrenSelector: aSymbol
+ 	getChildrenSelector := aSymbol.!
Item was added:
+ ----- Method: PluggablePanelMorph>>model (in category 'accessing') -----
+ model
+ 	^model!
Item was added:
+ ----- Method: PluggablePanelMorph>>model: (in category 'accessing') -----
+ model: aModel
+ 	model ifNotNil:[model removeDependent: self].
+ 	model := aModel.
+ 	model ifNotNil:[model addDependent: self].!
Item was added:
+ ----- Method: PluggablePanelMorph>>update: (in category 'update') -----
+ update: what
+ 	what == nil ifTrue:[^self].
+ 	what == getChildrenSelector ifTrue:[
+ 		self removeAllMorphs.
+ 		self addAllMorphs: (model perform: getChildrenSelector).
+ 		self submorphsDo:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
+ 	].!
Item was added:
+ SystemWindow subclass: #PluggableSystemWindow
+ 	instanceVariableNames: 'getLabelSelector getChildrenSelector children closeWindowSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !PluggableSystemWindow commentStamp: 'ar 2/11/2005 20:14' prior: 0!
+ A pluggable system window. Fixes the issues with label retrieval and adds support for changing children.!
Item was added:
+ ----- Method: PluggableSystemWindow>>addPaneMorph: (in category 'accessing') -----
+ addPaneMorph: aMorph
+ 	self addMorph: aMorph fullFrame: aMorph layoutFrame!
Item was added:
+ ----- Method: PluggableSystemWindow>>closeWindowSelector (in category 'accessing') -----
+ closeWindowSelector
+ 	^closeWindowSelector!
Item was added:
+ ----- Method: PluggableSystemWindow>>closeWindowSelector: (in category 'accessing') -----
+ closeWindowSelector: aSymbol
+ 	closeWindowSelector := aSymbol!
Item was added:
+ ----- Method: PluggableSystemWindow>>delete (in category 'initialization') -----
+ delete
+ 	closeWindowSelector ifNotNil:[model perform: closeWindowSelector].
+ 	super delete.
+ !
Item was added:
+ ----- Method: PluggableSystemWindow>>getChildrenSelector (in category 'accessing') -----
+ getChildrenSelector
+ 	^getChildrenSelector!
Item was added:
+ ----- Method: PluggableSystemWindow>>getChildrenSelector: (in category 'accessing') -----
+ getChildrenSelector: aSymbol
+ 	getChildrenSelector := aSymbol!
Item was added:
+ ----- Method: PluggableSystemWindow>>getLabelSelector (in category 'accessing') -----
+ getLabelSelector
+ 	^getLabelSelector!
Item was added:
+ ----- Method: PluggableSystemWindow>>getLabelSelector: (in category 'accessing') -----
+ getLabelSelector: aSymbol
+ 	getLabelSelector := aSymbol.
+ 	self update: aSymbol.!
Item was added:
+ ----- Method: PluggableSystemWindow>>label (in category 'accessing') -----
+ label
+ 	^label contents!
Item was added:
+ ----- Method: PluggableSystemWindow>>label: (in category 'accessing') -----
+ label: aString
+ 	self setLabel: aString.!
Item was added:
+ ----- Method: PluggableSystemWindow>>update: (in category 'updating') -----
+ update: what
+ 	what ifNil:[^self].
+ 	what == getLabelSelector ifTrue:[self setLabel: (model perform: getLabelSelector)].
+ 	what == getChildrenSelector ifTrue:[
+ 		children ifNil:[children := #()].
+ 		self removeAllMorphsIn: children.
+ 		children := model perform: getChildrenSelector.
+ 		self addAllMorphs: children.
+ 		children do:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
+ 	].
+ 	^super update: what!
Item was added:
+ PluggableTextMorph subclass: #PluggableTextMorphPlus
+ 	instanceVariableNames: 'getColorSelector acceptAction unstyledAcceptText styler'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !PluggableTextMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0!
+ A pluggable text morph with support for color.!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>accept (in category 'updating') -----
+ accept
+ 	super accept.
+ 	acceptAction ifNotNil:[acceptAction value: textMorph asText].!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>acceptAction (in category 'accessing') -----
+ acceptAction
+ 	^acceptAction!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>acceptAction: (in category 'accessing') -----
+ acceptAction: anAction
+ 	acceptAction := anAction!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>acceptTextInModel (in category 'styling') -----
+ acceptTextInModel 
+ 	
+ 	self okToStyle ifFalse:[^super acceptTextInModel].			
+ 	"#correctFrom:to:with: is sent when the method source is
+ 	manipulated during compilation (removing unused temps,
+ 	changing selectors etc). But 	#correctFrom:to:with: operates 
+ 	on the textMorph's text, and we may be saving an unstyled 
+ 	copy of the text. This means that these corrections will be lost
+ 	unless we also apply the corrections to the unstyled copy that we are saving.
+ 		So remember the unstyled copy in unstyledAcceptText, so
+ 	that when #correctFrom:to:with: is received we can also apply
+ 	the correction to it"
+ 	unstyledAcceptText := styler unstyledTextFrom: textMorph asText.
+ 	[^setTextSelector isNil or:
+ 		[setTextSelector numArgs = 2
+ 			ifTrue: [model perform: setTextSelector with: unstyledAcceptText with: self]
+ 			ifFalse: [model perform: setTextSelector with: unstyledAcceptText]]
+ 	] ensure:[unstyledAcceptText := nil]!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>correctFrom:to:with: (in category 'styling') -----
+ correctFrom: start to: stop with: aString
+ 	"see the comment in #acceptTextInModel "
+ 	unstyledAcceptText ifNotNil:[unstyledAcceptText replaceFrom: start to: stop with: aString ].
+ 	^ super correctFrom: start to: stop with: aString!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>getColorSelector (in category 'accessing') -----
+ getColorSelector
+ 	^getColorSelector!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>getColorSelector: (in category 'accessing') -----
+ getColorSelector: aSymbol
+ 	getColorSelector := aSymbol.
+ 	self update: getColorSelector.!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>getMenu: (in category 'menu') -----
+ getMenu: shiftKeyState
+ 	"Answer the menu for this text view. We override the superclass implementation to
+ 	so we can give the selection interval to the model."
+ 	
+ 	| menu aMenu |
+ 	getMenuSelector == nil ifTrue: [^ nil].
+ 	getMenuSelector numArgs < 3 ifTrue: [^ super getMenu: shiftKeyState].
+ 	menu := MenuMorph new defaultTarget: model.
+ 	getMenuSelector numArgs = 3 ifTrue:
+ 		[aMenu := model 
+ 			perform: getMenuSelector 
+ 			with: menu 
+ 			with: shiftKeyState 
+ 			with: self selectionInterval.
+ 		getMenuTitleSelector ifNotNil: 
+ 			[aMenu addTitle: (model perform: getMenuTitleSelector)].
+ 		^ aMenu].
+ 	^ self error: 'The getMenuSelector must be a 1- or 2 or 3-keyword symbol'!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>hasUnacceptedEdits: (in category 'styling') -----
+ hasUnacceptedEdits: aBoolean
+ 	"re-implemented to re-style the text iff aBoolean is true"
+ 	 
+ 	super hasUnacceptedEdits: aBoolean.
+ 	(aBoolean and: [self okToStyle])
+ 		ifTrue: [ styler styleInBackgroundProcess: textMorph contents]!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>okToStyle (in category 'testing') -----
+ okToStyle
+ 	styler ifNil:[^false].
+ 	(model respondsTo: #aboutToStyle: ) ifFalse:[^true].
+ 	^model aboutToStyle: styler
+ !
Item was added:
+ ----- Method: PluggableTextMorphPlus>>setText: (in category 'styling') -----
+ setText: aText
+ 	
+ 	self okToStyle ifFalse:[^super setText: aText].
+ 	super setText: (styler format: aText asText).
+ 	aText size < 4096
+ 		ifTrue:[styler style: textMorph contents]
+ 		ifFalse:[styler styleInBackgroundProcess:  textMorph contents]!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>styler (in category 'accessing') -----
+ styler
+ 	"The styler responsible for highlighting text in the receiver"
+ 	^styler!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>styler: (in category 'accessing') -----
+ styler: anObject
+ 	"The styler responsible for highlighting text in the receiver"
+ 	styler := anObject!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>stylerStyled: (in category 'styling') -----
+ stylerStyled: styledCopyOfText
+ 	"Sent after the styler completed styling the underlying text"
+ 	textMorph contents runs: styledCopyOfText runs .
+ 	"textMorph paragraph recomposeFrom: 1 to: textMorph contents size delta: 0."     "caused chars to appear in wrong order esp. in demo mode. remove this line when sure it is fixed"
+ 	textMorph updateFromParagraph.
+ 	selectionInterval 
+ 		ifNotNil:[
+ 			textMorph editor
+ 				selectInvisiblyFrom: selectionInterval first to: selectionInterval last;
+ 				storeSelectionInParagraph;
+ 				setEmphasisHere].
+ 	textMorph editor blinkParen.
+ 	self scrollSelectionIntoView!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>stylerStyledInBackground: (in category 'styling') -----
+ stylerStyledInBackground: styledCopyOfText 
+ 	"Sent after the styler completed styling of the text"
+ 
+ 	"It is possible that the text string	has changed since the styling began. Disregard the styles if styledCopyOfText's string differs with the current textMorph contents string"
+ 	textMorph contents string = styledCopyOfText string
+ 		ifTrue: [self stylerStyled: styledCopyOfText]!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>update: (in category 'updating') -----
+ update: what
+ 	what ifNil:[^self].
+ 	what == getColorSelector ifTrue:[self color: (model perform: getColorSelector)].
+ 	^super update: what!
Item was added:
+ ----- Method: PluggableTextMorphPlus>>useDefaultStyler (in category 'initialize') -----
+ useDefaultStyler
+ 	"This should be changed to a proper registry but as long as there is only shout this will do"
+ 	Smalltalk at: #SHTextStylerST80 ifPresent:[:stylerClass|
+ 		self styler: (stylerClass new view: self).
+ 	].!
Item was added:
+ ListItemWrapper subclass: #PluggableTreeItemNode
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !PluggableTreeItemNode commentStamp: 'ar 2/12/2005 04:37' prior: 0!
+ Tree item for PluggableTreeMorph.!
Item was added:
+ ----- Method: PluggableTreeItemNode>>acceptDroppingObject: (in category 'accessing') -----
+ acceptDroppingObject: anotherItem
+ 	^model dropNode: anotherItem on: self!
Item was added:
+ ----- Method: PluggableTreeItemNode>>asString (in category 'accessing') -----
+ asString
+ 	^model printNode: self!
Item was added:
+ ----- Method: PluggableTreeItemNode>>balloonText (in category 'accessing') -----
+ balloonText
+ 	^model balloonTextForNode: self!
Item was added:
+ ----- Method: PluggableTreeItemNode>>canBeDragged (in category 'accessing') -----
+ canBeDragged
+ 	^model isDraggableNode: self!
Item was added:
+ ----- Method: PluggableTreeItemNode>>contents (in category 'accessing') -----
+ contents
+ 	^model contentsOfNode: self!
Item was added:
+ ----- Method: PluggableTreeItemNode>>hasContents (in category 'accessing') -----
+ hasContents
+ 	^model hasNodeContents: self!
Item was added:
+ ----- Method: PluggableTreeItemNode>>icon (in category 'accessing') -----
+ icon
+ 	^model iconOfNode: self!
Item was added:
+ ----- Method: PluggableTreeItemNode>>item (in category 'accessing') -----
+ item
+ 	^item!
Item was added:
+ ----- Method: PluggableTreeItemNode>>wantsDroppedObject: (in category 'accessing') -----
+ wantsDroppedObject: anotherItem
+ 	^model wantsDroppedNode: anotherItem on: self!
Item was added:
+ SimpleHierarchicalListMorph subclass: #PluggableTreeMorph
+ 	instanceVariableNames: 'roots selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-ToolBuilder'!
+ 
+ !PluggableTreeMorph commentStamp: 'ar 2/12/2005 04:38' prior: 0!
+ A pluggable tree morph.!
Item was added:
+ ----- Method: PluggableTreeMorph>>acceptDroppingMorph:event: (in category 'morphic') -----
+ acceptDroppingMorph: aTransferMorph event: evt 
+ 	dropItemSelector ifNil: [ ^ self ].
+ 	model
+ 		perform: dropItemSelector
+ 		withEnoughArguments: {aTransferMorph passenger. 
+ 			(self itemFromPoint: evt position) withoutListWrapper. 
+ 			aTransferMorph shouldCopy}.
+ 	evt hand releaseMouseFocus: self.
+ 	potentialDropMorph ifNotNil: [ potentialDropMorph highlightForDrop: false ].
+ 	Cursor normal show!
Item was added:
+ ----- Method: PluggableTreeMorph>>balloonTextForNode: (in category 'node access') -----
+ balloonTextForNode: node
+ 	getHelpSelector ifNil:[^nil].
+ 	^model perform: getHelpSelector with: node item!
Item was added:
+ ----- Method: PluggableTreeMorph>>contentsOfNode: (in category 'node access') -----
+ contentsOfNode: node
+ 	| children |
+ 	getChildrenSelector ifNil:[^#()].
+ 	children := model perform: getChildrenSelector with: node item.
+ 	^children collect:[:item| PluggableTreeItemNode with: item model: self]!
Item was added:
+ ----- Method: PluggableTreeMorph>>dragItemSelector (in category 'accessing') -----
+ dragItemSelector
+ 	^dragItemSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>dragItemSelector: (in category 'accessing') -----
+ dragItemSelector: aSymbol
+ 	dragItemSelector := aSymbol.
+ 	aSymbol ifNotNil:[self dragEnabled: true].!
Item was added:
+ ----- Method: PluggableTreeMorph>>dropItemSelector (in category 'accessing') -----
+ dropItemSelector
+ 	^dropItemSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>dropItemSelector: (in category 'accessing') -----
+ dropItemSelector: aSymbol
+ 	dropItemSelector := aSymbol.
+ 	aSymbol ifNotNil:[self dropEnabled: true].!
Item was added:
+ ----- Method: PluggableTreeMorph>>dropNode:on: (in category 'node access') -----
+ dropNode: srcNode on: dstNode
+ 	dropItemSelector ifNil:[^nil].
+ 	model perform: dropItemSelector with: srcNode item with: dstNode item!
Item was added:
+ ----- Method: PluggableTreeMorph>>getChildrenSelector (in category 'accessing') -----
+ getChildrenSelector
+ 	^getChildrenSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>getChildrenSelector: (in category 'accessing') -----
+ getChildrenSelector: aSymbol
+ 	getChildrenSelector := aSymbol.!
Item was added:
+ ----- Method: PluggableTreeMorph>>getHelpSelector (in category 'accessing') -----
+ getHelpSelector
+ 	^getHelpSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>getHelpSelector: (in category 'accessing') -----
+ getHelpSelector: aSymbol
+ 	getHelpSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTreeMorph>>getIconSelector (in category 'accessing') -----
+ getIconSelector
+ 	^getIconSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>getIconSelector: (in category 'accessing') -----
+ getIconSelector: aSymbol
+ 	getIconSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTreeMorph>>getLabelSelector (in category 'accessing') -----
+ getLabelSelector
+ 	^getLabelSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>getLabelSelector: (in category 'accessing') -----
+ getLabelSelector: aSymbol
+ 	getLabelSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTreeMorph>>getMenuSelector (in category 'accessing') -----
+ getMenuSelector
+ 	^getMenuSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>getMenuSelector: (in category 'accessing') -----
+ getMenuSelector: aSymbol
+ 	getMenuSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTreeMorph>>getRootsSelector (in category 'accessing') -----
+ getRootsSelector
+ 	^getRootsSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>getRootsSelector: (in category 'accessing') -----
+ getRootsSelector: aSelector
+ 	getRootsSelector := aSelector.
+ 	self update: getRootsSelector.!
Item was added:
+ ----- Method: PluggableTreeMorph>>getSelectedPathSelector (in category 'accessing') -----
+ getSelectedPathSelector
+ 	^getSelectedPathSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>getSelectedPathSelector: (in category 'accessing') -----
+ getSelectedPathSelector: aSymbol
+ 	getSelectedPathSelector := aSymbol.!
Item was added:
+ ----- Method: PluggableTreeMorph>>hasChildrenSelector (in category 'accessing') -----
+ hasChildrenSelector
+ 	^hasChildrenSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>hasChildrenSelector: (in category 'accessing') -----
+ hasChildrenSelector: aSymbol
+ 	hasChildrenSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTreeMorph>>hasNodeContents: (in category 'node access') -----
+ hasNodeContents: node
+ 	hasChildrenSelector ifNil:[^node contents isEmpty not].
+ 	^model perform: hasChildrenSelector with: node item!
Item was added:
+ ----- Method: PluggableTreeMorph>>iconOfNode: (in category 'node access') -----
+ iconOfNode: node
+ 	getIconSelector ifNil:[^nil].
+ 	^model perform: getIconSelector with: node item!
Item was added:
+ ----- Method: PluggableTreeMorph>>isDraggableNode: (in category 'node access') -----
+ isDraggableNode: node
+ 	^true!
Item was added:
+ ----- Method: PluggableTreeMorph>>keystrokeActionSelector (in category 'accessing') -----
+ keystrokeActionSelector
+ 	^keystrokeActionSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>keystrokeActionSelector: (in category 'accessing') -----
+ keystrokeActionSelector: aSymbol
+ 	keystrokeActionSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTreeMorph>>printNode: (in category 'node access') -----
+ printNode: node
+ 	getLabelSelector ifNil:[^node item printString].
+ 	^model perform: getLabelSelector with: node item!
Item was added:
+ ----- Method: PluggableTreeMorph>>roots (in category 'accessing') -----
+ roots
+ 	^roots!
Item was added:
+ ----- Method: PluggableTreeMorph>>roots: (in category 'accessing') -----
+ roots: anArray
+ 	roots := anArray collect:[:item| PluggableTreeItemNode with: item model: self].
+ 	self list: roots.!
Item was added:
+ ----- Method: PluggableTreeMorph>>selectPath:in: (in category 'updating') -----
+ selectPath: path in: listItem
+ 	path isEmpty ifTrue: [^self setSelectedMorph: nil].
+ 	listItem withSiblingsDo: [:each | 
+ 		(each complexContents item = path first) ifTrue: [
+ 			each isExpanded ifFalse: [
+ 				each toggleExpandedState.
+ 				self adjustSubmorphPositions.
+ 			].
+ 			each changed.
+ 			path size = 1 ifTrue: [
+ 				^self setSelectedMorph: each
+ 			].
+ 			each firstChild ifNil: [^self setSelectedMorph: nil].
+ 			^self selectPath: path allButFirst in: each firstChild
+ 		].
+ 	].
+ 	^self setSelectedMorph: nil
+ 
+ !
Item was added:
+ ----- Method: PluggableTreeMorph>>setSelectedMorph: (in category 'selection') -----
+ setSelectedMorph: aMorph
+ 	selectedWrapper := aMorph complexContents.
+ 	self selection: selectedWrapper.
+ 	setSelectedSelector ifNotNil:[
+ 		model 
+ 			perform: setSelectedSelector 
+ 			with: (selectedWrapper ifNotNil:[selectedWrapper item]).
+ 	].!
Item was added:
+ ----- Method: PluggableTreeMorph>>setSelectedSelector (in category 'accessing') -----
+ setSelectedSelector
+ 	^setSelectedSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>setSelectedSelector: (in category 'accessing') -----
+ setSelectedSelector: aSymbol
+ 	setSelectedSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTreeMorph>>startDrag: (in category 'morphic') -----
+ startDrag: evt 
+ 	| ddm itemMorph passenger |
+ 	self dragEnabled
+ 		ifTrue: [itemMorph := scroller submorphs
+ 						detect: [:any | any highlightedForMouseDown]
+ 						ifNone: []].
+ 	(itemMorph isNil
+ 			or: [evt hand hasSubmorphs])
+ 		ifTrue: [^ self].
+ 	itemMorph highlightForMouseDown: false.
+ 	itemMorph ~= self selectedMorph
+ 		ifTrue: [self setSelectedMorph: itemMorph].
+ 	passenger := self model perform: dragItemSelector with: itemMorph withoutListWrapper.
+ 	passenger
+ 		ifNotNil: [ddm := TransferMorph withPassenger: passenger from: self.
+ 			ddm dragTransferType: #dragTransferPlus.
+ 			Preferences dragNDropWithAnimation
+ 				ifTrue: [self model dragAnimationFor: itemMorph transferMorph: ddm].
+ 			evt hand grabMorph: ddm].
+ 	evt hand releaseMouseFocus: self!
Item was added:
+ ----- Method: PluggableTreeMorph>>update: (in category 'updating') -----
+ update: what
+ 	what ifNil:[^self].
+ 	what == getRootsSelector ifTrue:[
+ 		self roots: (model perform: getRootsSelector)
+ 	].
+ 	what == getSelectedPathSelector ifTrue:[
+ 		^self selectPath: (model perform: getSelectedPathSelector)
+ 			in: (scroller submorphs at: 1 ifAbsent: [^self]) 
+ 	].
+ 	^super update: what!
Item was added:
+ ----- Method: PluggableTreeMorph>>wantsDropSelector (in category 'accessing') -----
+ wantsDropSelector
+ 	^wantsDropSelector!
Item was added:
+ ----- Method: PluggableTreeMorph>>wantsDropSelector: (in category 'accessing') -----
+ wantsDropSelector: aSymbol
+ 	wantsDropSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTreeMorph>>wantsDroppedMorph:event: (in category 'morphic') -----
+ wantsDroppedMorph: aMorph event: anEvent
+ 	aMorph dragTransferType == #dragTransferPlus ifFalse:[^false].
+ 	dropItemSelector ifNil:[^false].
+ 	wantsDropSelector ifNil:[^true].
+ 	^ (model perform: wantsDropSelector with: aMorph passenger) == true.!
Item was added:
+ ----- Method: PluggableTreeMorph>>wantsDroppedNode:on: (in category 'node access') -----
+ wantsDroppedNode: srcNode on: dstNode
+ 	dropItemSelector ifNil:[^false].
+ 	wantsDropSelector ifNil:[^true].
+ 	^(model perform: wantsDropSelector with: srcNode with: dstNode) == true!