[Pkg] The Trunk: ToolBuilder-Morphic-fbs.90.mcz

commits at source.squeak.org commits at source.squeak.org
Fri May 31 15:00:25 UTC 2013


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

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

Name: ToolBuilder-Morphic-fbs.90
Author: fbs
Time: 31 May 2013, 4:00:00.398 pm
UUID: b06416ef-714b-41ee-b6a1-90ddf0c305be
Ancestors: ToolBuilder-Morphic-ul.89

Move ToolBuilder-Morphic to Morphic-ToolBuilder.

=============== Diff against ToolBuilder-Morphic-ul.89 ===============

Item was removed:
- SystemOrganization addCategory: #'ToolBuilder-Morphic'!

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

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

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

Item was removed:
- ----- Method: ListChooser class>>chooseIndexFrom:title: (in category 'instance creation') -----
- chooseIndexFrom: aList title: aString
- 	^ self
- 		chooseIndexFrom: aList 
- 		title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
- 		addAllowed: false!

Item was removed:
- ----- Method: ListChooser class>>chooseIndexFrom:title:addAllowed: (in category 'instance creation') -----
- chooseIndexFrom: aList title: aString addAllowed: aBoolean
- 	^ self new
- 		chooseIndexFrom: aList 
- 		title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
- 		addAllowed: aBoolean!

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

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

Item was removed:
- ----- Method: ListChooser class>>chooseItemFrom:title:addAllowed: (in category 'instance creation') -----
- chooseItemFrom: aList title: aString addAllowed: aBoolean
- 	^ self new
- 		chooseItemFrom: aList 
- 		title: (aString isEmptyOrNil ifTrue: [ self defaultTitle ] ifFalse: [ aString ])
- 		addAllowed: aBoolean!

Item was removed:
- ----- Method: ListChooser class>>defaultTitle (in category 'instance creation') -----
- defaultTitle
- 	^ 'Please choose:'!

Item was removed:
- ----- Method: ListChooser class>>testDictionary (in category 'examples') -----
- testDictionary
- 	^ self 
- 		chooseItemFrom: (Dictionary newFrom: {#a->1. 2->#b.})
- 		title: 'Pick from Dictionary' "gives values, not keys"!

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

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

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

Item was removed:
- ----- Method: ListChooser class>>testLongTitle (in category 'examples') -----
- testLongTitle
- 	^ self 
- 		chooseItemFrom: #(this is a list of values that aren/t the point here)
- 		title: 'Pick from some values from this list'!

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

Item was removed:
- ----- Method: ListChooser>>accept (in category 'event handling') -----
- accept
- 	"if the user submits with no valid entry, make them start over"
- 	self canAccept ifFalse: [ 	
- 		searchMorph selectAll.
- 		^ self ].
- 	
- 	"find the selected item in the original list, and return it"
- 	result := selectedItems at: index.
- 
- 	builder ifNotNil: [ :bldr |
- 		builder := nil.
- 		bldr close: window ]!

Item was removed:
- ----- Method: ListChooser>>acceptColor (in category 'drawing') -----
- acceptColor
- 	^ self canAccept 
- 		ifTrue: [ ColorTheme current okColor ]
- 		ifFalse: [ Color lightGray "ColorTheme current disabledColor <- you don't have this!!" ]!

Item was removed:
- ----- Method: ListChooser>>acceptText: (in category 'event handling') -----
- acceptText: someText
- 	"the text morph wants to tell us about its contents but I don't care, I'm only interested in the list"
- 	self accept!

Item was removed:
- ----- Method: ListChooser>>add (in category 'event handling') -----
- add
- 	"if the user submits with no valid entry, make them start over"
- 	self canAdd ifFalse: [ 	
- 		searchMorph selectAll.
- 		^ self ].
- 	
- 	"find the string to return"
- 	result := searchMorph getText.
- 
- 	builder ifNotNil: [ :bldr |
- 		builder := nil.
- 		bldr close: window ]!

Item was removed:
- ----- Method: ListChooser>>buildButtonBarWith: (in category 'building') -----
- buildButtonBarWith: builder
- 	| panel button |
- 	panel := builder pluggablePanelSpec new
- 		model: self;
- 		layout: #proportional;
- 		children: OrderedCollection new.
- 	button := builder pluggableButtonSpec new.
- 	button
- 		model: self; 
- 		label: 'Accept (s)';
- 		action: #accept;
- 		enabled: #canAccept;
- 		state: #canAccept;
- 		color: #acceptColor;
- 		frame: (0.0 @ 0.0 corner: 0.34 at 1).
- 	panel children add: button.
- 
- 	button := builder pluggableButtonSpec new.
- 	button
- 		model: self; 
- 		label: 'Add (a)';
- 		action: #add;
- 		enabled: #canAdd;
- 		frame: (0.36 @ 0.0 corner: 0.63 at 1).
- 	panel children add: button.
- 
- 	button := builder pluggableButtonSpec new.
- 	button
- 		model: self; 
- 		label: 'Cancel (l)';
- 		action: #cancel;
- 		color: #cancelColor;
- 		frame: (0.65 @ 0.0 corner: 1 at 1).
- 	panel children add: button.
- 	
- 	^ panel!

Item was removed:
- ----- Method: ListChooser>>buildListMorphWith: (in category 'building') -----
- buildListMorphWith: builder
- 	| listSpec |
- 	listSpec := builder pluggableListSpec new.
- 	listSpec 
- 		model: self;
- 		list: #list; 
- 		getIndex: #selectedIndex; 
- 		setIndex: #selectedIndex:; 
- 		doubleClick: #accept;
- 		"handleBasicKeys: false;"
- 		keystrokePreview: #keyStrokeFromList:;
- 		"doubleClickSelector: #accept;"
- 		autoDeselect: false.
- 	^ listSpec!

Item was removed:
- ----- Method: ListChooser>>buildSearchMorphWith: (in category 'building') -----
- buildSearchMorphWith: builder
- 	| fieldSpec |
- 	fieldSpec := builder pluggableInputFieldSpec new.
- 	fieldSpec 
- 		model: self;
- 		getText: #searchText;
- 		setText: #acceptText:;
- 		menu: nil.
- 		"hideScrollBarsIndefinitely;"
- 		"acceptOnCR: true;"
- 		"setBalloonText: 'Type a string to filter down the listed items'."
- 		"onKeyStrokeSend: #keyStroke: to: self."
- 	^ fieldSpec!

Item was removed:
- ----- Method: ListChooser>>buildWindowWith: (in category 'building') -----
- buildWindowWith: builder
- 	| windowSpec |
- 	windowSpec := builder pluggableWindowSpec new.
- 	windowSpec model: self.
- 	windowSpec label: #title.
- 	windowSpec children: OrderedCollection new.
- 	^windowSpec!

Item was removed:
- ----- Method: ListChooser>>buildWindowWith:specs: (in category 'building') -----
- buildWindowWith: builder specs: specs
- 	| windowSpec |
- 	windowSpec := self buildWindowWith: builder.
- 	specs do: [ :assoc |
- 		| rect action widgetSpec |
- 		rect := assoc key.
- 		action := assoc value.
- 		widgetSpec := action value.
- 		widgetSpec ifNotNil:[
- 			widgetSpec frame: rect.
- 			windowSpec children add: widgetSpec ] ].
- 	^ windowSpec!

Item was removed:
- ----- Method: ListChooser>>buildWith: (in category 'building') -----
- buildWith: aBuilder
- 	| windowSpec |
- 	builder := aBuilder.
- 	windowSpec := self buildWindowWith: builder specs: {
- 		(0 at 0 corner: 1 at 0.05) -> [self buildSearchMorphWith: builder].
- 		(0 at 0.05 corner: 1 at 0.9) -> [self buildListMorphWith: builder].
- 		(0 at 0.9 corner: 1 at 1) -> [self buildButtonBarWith: builder].
- 	}.
- 	windowSpec closeAction: #closed.
- 	windowSpec extent: self initialExtent.
- 	window := builder build: windowSpec.
- 	
- 	
- 	searchMorph := window submorphs detect: 
- 		[ :each | each isKindOf: PluggableTextMorph ].
- 	searchMorph
- 		hideScrollBarsIndefinitely;
- 		acceptOnCR: true;
- 		setBalloonText: 'Type a string to filter down the listed items';
- 		onKeyStrokeSend: #keyStroke: to: self;
- 		hasUnacceptedEdits: true "force acceptOnCR to work even with no text entered".
- 	listMorph := window submorphs detect: 
- 		[ :each | each isKindOf: PluggableListMorph ].
- 	^ window!

Item was removed:
- ----- Method: ListChooser>>canAccept (in category 'testing') -----
- canAccept
- 	^ self selectedIndex > 0!

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

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

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

Item was removed:
- ----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') -----
- chooseIndexFrom: labelList title: aString
- 	| choice |
- 	choice := self chooseItemFrom: labelList title: aString addAllowed: false.
- 	^ fullList indexOf: choice ifAbsent: 0!

Item was removed:
- ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') -----
- chooseIndexFrom: labelList title: aString addAllowed: aBoolean
- 	| choice |
- 	choice := self chooseItemFrom: labelList title: aString addAllowed: false.
- 	addAllowed := aBoolean.
- 	^ fullList indexOf: choice ifAbsent: 0!

Item was removed:
- ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') -----
- chooseItemFrom: labelList title: aString addAllowed: aBoolean
- 	fullList := labelList asOrderedCollection. "coerce everything into an OC"
- 	builder := ToolBuilder default.
- 	self list: fullList.
- 	self title: aString.
- 	addAllowed := aBoolean.
- 	window := ToolBuilder default open: self.
- 	window center: Sensor cursorPoint.
- 	window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false.
- 	builder runModal: window.
- 	^ result!

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

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

Item was removed:
- ----- Method: ListChooser>>initialExtent (in category 'building') -----
- initialExtent
- 	| listFont titleFont buttonFont listWidth titleWidth buttonWidth |
- 	listFont := Preferences standardListFont.
- 	titleFont := Preferences windowTitleFont.
- 	buttonFont := Preferences standardButtonFont.
- 	listWidth := 20 * (listFont widthOf: $m).
- 	titleWidth := titleFont widthOfString: self title, '__________'. "add some space for titlebar icons"
- 	buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add (a)___Cancel_(l)_'.
- 	^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont height))!

Item was removed:
- ----- Method: ListChooser>>keyStroke: (in category 'event handling') -----
- keyStroke: event
- 	| newText key |
- 	"handle updates to the search box interactively"
- 	key := event keyString.
- 	(key = '<up>') ifTrue: [ 
- 		self move: -1. 
- 		^ self ].
- 	(key = '<down>') ifTrue: [ 
- 		self move: 1.
- 		^ self ].
- 
- 	(key = '<Cmd-s>') ifTrue: [ self accept. ^ self ].
- 	(key = '<cr>') ifTrue: [ self accept. ^ self ].
- 
- 	(key = '<escape>') ifTrue: [ self cancel. ^ self ].
- 	(key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ].
- 	
- 	(key = '<Cmd-a>') ifTrue: [ self add. ^ self ].
- 
- 	"pull out what's been typed, and update the list as required"
- 	newText := searchMorph textMorph asText asString.
- 	(newText = searchText) ifFalse: [ 
- 		searchText := newText.
- 		self updateFilter ].
- !

Item was removed:
- ----- Method: ListChooser>>keyStrokeFromList: (in category 'event handling') -----
- keyStrokeFromList: event
- 	"we don't want the list to be picking up events, excepting scroll events"
- 
- 	"Don't sent ctrl-up/ctrl-down events to the searchMorph: they're scrolling events."
- 	(#(30 31) contains: [:each | each = event keyValue]) not
- 		ifTrue:
- 			["window world primaryHand keyboardFocus: searchMorph."
- 			searchMorph keyStroke: event.
- 			"let the list know we've dealt with it"
- 			^true].
- 	^false.
- 		!

Item was removed:
- ----- Method: ListChooser>>list (in category 'accessing') -----
- list
- 	^ selectedItems!

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

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

Item was removed:
- ----- Method: ListChooser>>move: (in category 'event handling') -----
- move: offset
- 	| newindex |
- 	"The up arrow key moves the cursor, and it seems impossible to restore.
- 	So, for consistency, on either arrow, select everything, so a new letter-press starts over. yuk."
- 	searchMorph selectAll.
- 		
- 	newindex := self selectedIndex + offset.
- 	newindex > selectedItems size ifTrue: [ ^ nil ].
- 	newindex < 1 ifTrue: [ ^ nil ].
- 	self selectedIndex: newindex.
- !

Item was removed:
- ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') -----
- moveWindowNear: aPoint
- 	| trialRect delta |
- 	trialRect := Rectangle center: aPoint extent: window fullBounds extent.
- 	delta := trialRect amountToTranslateWithin: World bounds.
- 	window position: trialRect origin + delta.!

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

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

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

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

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

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

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

Item was removed:
- ----- Method: ListChooser>>updateFilter (in category 'event handling') -----
- updateFilter
- 
- 	selectedItems := 
- 		searchText isEmptyOrNil 
- 			ifTrue: [ fullList ]
- 			ifFalse: [ | pattern patternMatches prefixMatches |
- 				pattern := (searchText includes: $*)
- 					ifTrue: [ searchText ]
- 					ifFalse: [ '*', searchText, '*' ].
- 				patternMatches := fullList select: [:s | pattern match: s ].
- 				prefixMatches := OrderedCollection new: patternMatches size.
- 				patternMatches removeAllSuchThat: [ :each |
- 					(each findString: searchText startingAt: 1 caseSensitive: false) = 1
- 						and: [
- 							prefixMatches add: each.
- 							true ] ].
- 				prefixMatches addAllLast: patternMatches; yourself].
- 	self changed: #list.
- 	self selectedIndex: 1.
- 	self changed: #selectedIndex.!

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

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

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

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

Item was removed:
- ----- Method: MorphicToolBuilder>>asFrame: (in category 'private') -----
- asFrame: aRectangle
- 	| frame |
- 	aRectangle ifNil:[^nil].
- 	frame := LayoutFrame new.
- 	frame 
- 		leftFraction: aRectangle left; 
- 		rightFraction: aRectangle right; 
- 		topFraction: aRectangle top; 
- 		bottomFraction: aRectangle bottom.
- 	^frame!

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

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

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableAlternateMultiSelectionList: (in category 'pluggable widgets') -----
- buildPluggableAlternateMultiSelectionList: aSpec
- 	| listMorph listClass |
- 	aSpec getSelected ifNotNil: [ ^ self error: 'There is no PluggableAlternateListMorphOfManyByItem' ].
- 	listClass := self alternateMultiSelectListClass.
- 	listMorph := listClass 
- 		on: aSpec model
- 		list: aSpec list
- 		primarySelection: aSpec getIndex
- 		changePrimarySelection: aSpec setIndex
- 		listSelection: aSpec getSelectionList
- 		changeListSelection: aSpec setSelectionList
- 		menu: aSpec menu.
- 	listMorph
- 		setProperty: #highlightSelector toValue: #highlightMessageList:with: ;
- 		setProperty: #itemConversionMethod toValue: #asStringOrText ;
- 		setProperty: #balloonTextSelectorForSubMorphs toValue: #balloonTextForClassAndMethodString ;
- 		enableDragNDrop: 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 removed:
- ----- Method: MorphicToolBuilder>>buildPluggableButton: (in category 'pluggable widgets') -----
- buildPluggableButton: aSpec
- 	| widget label state action enabled |
- 	label := aSpec label.
- 	state := aSpec state.
- 	action := aSpec action.
- 	widget := self buttonClass on: aSpec model
- 				getState: (state isSymbol ifTrue:[state])
- 				action: nil
- 				label: (label isSymbol ifTrue:[label]).
- 	widget style: aSpec style.
- 	aSpec changeLabelWhen
- 		ifNotNilDo: [ :event | widget whenChanged: event update: aSpec label].
- 	self register: widget id: aSpec name.
- 	enabled := aSpec enabled.
- 	enabled isSymbol
- 		ifTrue:[widget getEnabledSelector: enabled]
- 		ifFalse:[widget enabled:enabled].
- 	widget action: action.
- 	widget getColorSelector: aSpec color.
- 	widget offColor: Color white..
- 	self buildHelpFor: widget spec: aSpec. 
- 	(label isSymbol or:[label == nil]) ifFalse:[widget label: label].
- 	self setFrame: aSpec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- 	^widget!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableCheckBox: (in category 'pluggable widgets') -----
- buildPluggableCheckBox: spec
- 
- 	| widget label state action |
- 	label := spec label.
- 	state := spec state.
- 	action := spec action.
- 	widget := self checkBoxClass on: spec model
- 				getState: (state isSymbol ifTrue:[state])
- 				action: (action isSymbol ifTrue:[action])
- 				label: (label isSymbol ifTrue:[label]).
- 	self register: widget id: spec name.
- 
- 	widget installButton.
- "	widget getColorSelector: spec color.
- 	widget offColor: Color white..
- 	self buildHelpFor: widget spec: spec. 
- 	(label isSymbol or:[label == nil]) ifFalse:[widget label: label].
- "	self setFrame: spec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- 	^widget!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableCodePane: (in category 'pluggable widgets') -----
- buildPluggableCodePane: aSpec
- 	"Install the default styler for code panes.
- 	Implementation note: We should just be doing something like, e.g.,
- 		^(self buildPluggableText: aSpec) useDefaultStyler
- 	Unfortunately, this will retrieve and layout the initial text twice which
- 	can make for a noticable performance difference when looking at some
- 	larger piece of code. So instead we copy the implementation from 
- 	buildPlugggableText: here and insert #useDefaultStyler at the right point"
- 	| widget |
- 	widget := self codePaneClass new.
- 	widget useDefaultStyler.
- 	widget on: aSpec model
- 				text: aSpec getText 
- 				accept: aSpec setText
- 				readSelection: aSpec selection 
- 				menu: aSpec menu.
- 	widget font: Preferences standardCodeFont.
- 	self register: widget id: aSpec name.
- 	widget getColorSelector: aSpec color.
- 	self setFrame: aSpec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- 	widget borderColor: Color lightGray.
- 	widget color: Color white.
- 	^widget!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableDropDownList: (in category 'pluggable widgets') -----
- buildPluggableDropDownList: spec
- 
- 	| widget model listSelector selectionSelector selectionSetter |
- 	model := spec model.
- 	listSelector := spec listSelector.
- 	selectionSelector := spec selectionSelector.
- 	selectionSetter := spec selectionSetter.
- 	widget := self dropDownListClass new
- 		model: model;
- 		listSelector: listSelector;
- 		selectionSelector: selectionSelector;
- 		selectionSetter: selectionSetter;
- 		yourself.
- 	self register: widget id: spec name.
- 
- 	widget installDropDownList.
- 	self setFrame: spec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- 	^widget!

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

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableList: (in category 'pluggable widgets') -----
- buildPluggableList: aSpec
- 	| widget listClass getIndex setIndex |
- 	aSpec getSelected ifNil:[
- 		listClass := self listClass.
- 		getIndex := aSpec getIndex.
- 		setIndex := aSpec setIndex.
- 	] ifNotNil:[
- 		listClass := self listByItemClass.
- 		getIndex := aSpec getSelected.
- 		setIndex := aSpec setSelected.
- 	].
- 	widget := listClass on: aSpec model
- 				list: aSpec list
- 				selected: getIndex
- 				changeSelected: setIndex
- 				menu: aSpec menu
- 				keystroke: aSpec keyPress.
- 	self register: widget id: aSpec name.
- 	widget getListElementSelector: aSpec listItem.
- 	widget getListSizeSelector: aSpec listSize.
- 	widget getIconSelector: aSpec icon.
- 	widget doubleClickSelector: aSpec doubleClick.
- 	widget dragItemSelector: aSpec dragItem.
- 	widget dropItemSelector: aSpec dropItem.
- 	widget wantsDropSelector: aSpec dropAccept.
- 	widget autoDeselect: aSpec autoDeselect.
- 	widget keystrokePreviewSelector: aSpec keystrokePreview.
- 	aSpec color isNil 
- 		ifTrue: [widget 
- 					borderWidth: 1; 
- 					borderColor: Color lightGray; 
- 					color: Color white]
- 		ifFalse: [widget color: aSpec color].
- 	self buildHelpFor: widget spec: aSpec. 
- 	self setFrame: aSpec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- 	panes ifNotNil:[
- 		aSpec list ifNotNil:[panes add: aSpec list].
- 	].
- 	^widget!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableMenu: (in category 'building') -----
- buildPluggableMenu: menuSpec 
- 	| prior menu |
- 	prior := parentMenu.
- 	parentMenu := menu := self menuClass new.
- 	menuSpec label ifNotNil:[parentMenu addTitle: menuSpec label].
- 	menuSpec items do:[:each| each buildWith: self].
- 	parentMenu := prior.
- 	^menu!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableMenuItem: (in category 'building') -----
- buildPluggableMenuItem: itemSpec
- 	| item action label menu |
- 	item := self menuItemClass new.
- 	label := itemSpec 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 removed:
- ----- Method: MorphicToolBuilder>>buildPluggableMultiSelectionList: (in category 'pluggable widgets') -----
- buildPluggableMultiSelectionList: aSpec
- 	| widget listClass |
- 	aSpec getSelected ifNotNil:[^self error:'There is no PluggableListMorphOfManyByItem'].
- 	listClass := self multiSelectListClass.
- 	widget := listClass on: aSpec model
- 		list: aSpec list
- 		primarySelection: aSpec getIndex
- 		changePrimarySelection: aSpec setIndex
- 		listSelection: aSpec getSelectionList
- 		changeListSelection: aSpec setSelectionList
- 		menu: aSpec menu.
- 	self register: widget id: aSpec name.
- 	widget keystrokeActionSelector: aSpec keyPress.
- 	widget getListElementSelector: aSpec listItem.
- 	widget getListSizeSelector: aSpec listSize.
- 	self buildHelpFor: widget spec: aSpec. 
- 	self setFrame: aSpec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- 	panes ifNotNil:[
- 		aSpec list ifNotNil:[panes add: aSpec list].
- 	].
- 	^widget!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggablePanel: (in category 'pluggable widgets') -----
- buildPluggablePanel: aSpec
- 	| widget children frame |
- 	widget := self panelClass new.
- 	self register: widget id: aSpec name.
- 	widget model: aSpec model.
- 	widget color: Color transparent.
- 	widget clipSubmorphs: true.
- 	children := aSpec children.
- 	children isSymbol ifTrue:[
- 		widget getChildrenSelector: children.
- 		widget update: children.
- 		children := #().
- 	].
- 	self buildAll: children in: widget.
- 	self buildHelpFor: widget spec: aSpec. 
- 	self setFrame: aSpec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- 	self setLayout: aSpec layout in: widget.
- 	widget layoutInset: 0.
- 	widget borderWidth: 0.
- 	widget submorphsDo:[:sm|
- 		(frame := sm layoutFrame) ifNotNil:[
- 			(frame rightFraction = 0 or:[frame rightFraction = 1]) 
- 				ifFalse:[frame rightOffset:1].
- 			(frame bottomFraction = 0 or:[frame bottomFraction = 1]) 
- 				ifFalse:[frame bottomOffset: 1]]].
- 	widget color: Color transparent.
- 	^widget!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableText: (in category 'pluggable widgets') -----
- buildPluggableText: aSpec
- 	| widget |
- 	widget := self textPaneClass on: aSpec model
- 				text: aSpec getText 
- 				accept: aSpec setText
- 				readSelection: aSpec selection 
- 				menu: aSpec menu.
- 	widget askBeforeDiscardingEdits: aSpec askBeforeDiscardingEdits.
- 	widget font: Preferences standardCodeFont.
- 	self register: widget id: aSpec name.
- 	widget getColorSelector: aSpec color.
- 	self buildHelpFor: widget spec: aSpec. 
- 	self setFrame: aSpec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- 	widget borderColor: Color lightGray.
- 	widget color: Color white.
- 	^widget!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableTree: (in category 'pluggable widgets') -----
- buildPluggableTree: aSpec
- 	| widget |
- 	widget := self treeClass new.
- 	self register: widget id: aSpec name.
- 	widget model: aSpec model.
- 	widget getSelectedPathSelector: aSpec getSelectedPath.
- 	widget setSelectedSelector: aSpec setSelected.
- 	widget getChildrenSelector: aSpec getChildren.
- 	widget hasChildrenSelector: aSpec hasChildren.
- 	widget getLabelSelector: aSpec label.
- 	widget getIconSelector: aSpec icon.
- 	widget getHelpSelector: aSpec help.
- 	widget getMenuSelector: aSpec menu.
- 	widget keystrokeActionSelector: aSpec keyPress.
- 	widget getRootsSelector: aSpec roots.
- 	widget autoDeselect: aSpec autoDeselect.
- 	widget dropItemSelector: aSpec dropItem.
- 	widget wantsDropSelector: aSpec dropAccept.
- 	widget dragItemSelector: aSpec dragItem.
- 	self setFrame: aSpec frame in: widget.
- 	parent ifNotNil:[self add: widget to: parent].
- "	panes ifNotNil:[
- 		aSpec roots ifNotNil:[panes add: aSpec roots].
- 	].	"
- 	^widget!

Item was removed:
- ----- Method: MorphicToolBuilder>>buildPluggableWindow: (in category 'pluggable widgets') -----
- buildPluggableWindow: aSpec
- 	| widget children |
- 	aSpec layout == #proportional ifFalse:[
- 		"This needs to be implemented - probably by adding a single pane and then the rest"
- 		^self error: 'Not implemented'.
- 	].
- 	widget := (self windowClassFor: aSpec) new.
- 	self register: widget id: aSpec name.
- 	widget model: aSpec model.
- 	aSpec label ifNotNil:
- 		[:label|
- 		label isSymbol 
- 			ifTrue:[widget getLabelSelector: label]
- 			ifFalse:[widget setLabel: label]].
- 	aSpec multiWindowStyle notNil ifTrue:
- 		[widget savedMultiWindowState: (SavedMultiWindowState on: aSpec model)].
- 	children := aSpec children.
- 	children isSymbol ifTrue:[
- 		widget getChildrenSelector: children.
- 		widget update: children.
- 		children := #().
- 	].
- 	widget closeWindowSelector: aSpec closeAction.
- 	panes := OrderedCollection new.
- 	self buildAll: children in: widget.
- 	self buildHelpFor: widget spec: aSpec. 
- 	widget bounds: (RealEstateAgent 
- 		initialFrameFor: widget 
- 		initialExtent: (aSpec extent ifNil:[widget initialExtent])
- 		world: self currentWorld).
- 	widget setUpdatablePanesFrom: panes.
- 	^widget!

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

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

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

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

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

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

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

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

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

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

Item was removed:
- ----- Method: MorphicToolBuilder>>open: (in category 'opening') -----
- open: anObject
- 	"Build and open the object. Answer the widget opened."
- 	| morph |
- 	anObject isMorph 
- 		ifTrue:[morph := anObject]
- 		ifFalse:[morph := self build: anObject].
- 	(morph isKindOf: MenuMorph)
- 		ifTrue:[morph popUpInWorld: World].
- 	(morph isKindOf: SystemWindow)
- 		ifTrue:[morph openInWorldExtent: morph extent]
- 		ifFalse:[morph openInWorld].
- 	^morph!

Item was removed:
- ----- Method: MorphicToolBuilder>>open:label: (in category 'opening') -----
- open: anObject label: aString
- 	"Build an open the object, labeling it appropriately.  Answer the widget opened."
- 	| window |
- 	window := self open: anObject.
- 	window setLabel: aString.
- 	^window!

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

Item was removed:
- ----- Method: MorphicToolBuilder>>register:id: (in category 'private') -----
- register: widget id: id
- 	id ifNil:[^self].
- 	widgets ifNil:[widgets := Dictionary new].
- 	widgets at: id put: widget.
- 	widget setNameTo: id.!

Item was removed:
- ----- Method: MorphicToolBuilder>>runModal: (in category 'opening') -----
- runModal: aWidget
- 	"Run the (previously opened) widget modally, e.g., 
- 	do not return control to the sender before the user has responded."
- 	[aWidget world notNil] whileTrue: [
- 		aWidget outermostWorldMorph doOneCycle.
- 	].
- !

Item was removed:
- ----- Method: MorphicToolBuilder>>setFrame:in: (in category 'private') -----
- setFrame: aRectangle in: widget
- 	| frame |
- 	aRectangle ifNil:[^nil].
- 	frame := aRectangle isRectangle
- 		ifTrue: [self asFrame: aRectangle]
- 		ifFalse: [aRectangle]. "assume LayoutFrame"
- 	widget layoutFrame: frame.
- 	widget hResizing: #spaceFill; vResizing: #spaceFill.
- 	(parent isSystemWindow) ifTrue:[
- 		widget borderWidth: 2; borderColor: #inset.
- 	].!

Item was removed:
- ----- Method: MorphicToolBuilder>>setLayout:in: (in category 'private') -----
- setLayout: layout in: widget
- 	layout == #proportional ifTrue:[
- 		widget layoutPolicy: ProportionalLayout new.
- 		^self].
- 	layout == #horizontal ifTrue:[
- 		widget layoutPolicy: TableLayout new.
- 		widget listDirection: #leftToRight.
- 		widget submorphsDo:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
- 		widget cellInset: 1 at 1.
- 		widget layoutInset: 1 at 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 at 1.
- 		widget layoutInset: 1 at 1.
- 		widget color: Color transparent.
- 		"and then some..."
- 		^self].
- 	^self error: 'Unknown layout: ', layout.!

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

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

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

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

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

Item was removed:
- ToolBuilderTests subclass: #MorphicToolBuilderTests
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'ToolBuilder-Morphic'!
- 
- !MorphicToolBuilderTests commentStamp: 'ar 2/11/2005 15:02' prior: 0!
- Tests for the Morphic tool builder.!

Item was removed:
- ----- Method: MorphicToolBuilderTests>>acceptWidgetText (in category 'support') -----
- acceptWidgetText
- 	widget hasUnacceptedEdits: true.
- 	widget accept.!

Item was removed:
- ----- Method: MorphicToolBuilderTests>>buttonWidgetEnabled (in category 'support') -----
- buttonWidgetEnabled
- 	"Answer whether the current widget (a button) is currently enabled"
- 	^widget enabled!

Item was removed:
- ----- Method: MorphicToolBuilderTests>>changeListWidget (in category 'support') -----
- changeListWidget
- 	widget changeModelSelection: widget getCurrentSelectionIndex + 1.!

Item was removed:
- ----- Method: MorphicToolBuilderTests>>expectedButtonSideEffects (in category 'support') -----
- expectedButtonSideEffects
- 	^#(getColor getState getEnabled)!

Item was removed:
- ----- Method: MorphicToolBuilderTests>>fireButtonWidget (in category 'support') -----
- fireButtonWidget
- 	widget performAction.!

Item was removed:
- ----- Method: MorphicToolBuilderTests>>fireMenuItemWidget (in category 'support') -----
- fireMenuItemWidget
- 	(widget itemWithWording: 'Menu Item')
- 		ifNotNil: [:item | item doButtonAction]!

Item was removed:
- ----- Method: MorphicToolBuilderTests>>setUp (in category 'support') -----
- setUp
- 	super setUp.
- 	builder := MorphicToolBuilder new.!

Item was removed:
- ----- Method: MorphicToolBuilderTests>>testWindowDynamicLabel (in category 'tests-window') -----
- testWindowDynamicLabel
- 	self makeWindow.
- 	self assert: (widget label = 'TestLabel').!

Item was removed:
- ----- 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 removed:
- ----- Method: MorphicToolBuilderTests>>widgetColor (in category 'support') -----
- widgetColor
- 	"Answer color from widget"
- 	^widget color!

Item was removed:
- UIManager subclass: #MorphicUIManager
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'ToolBuilder-Morphic'!
- 
- !MorphicUIManager commentStamp: 'dtl 5/2/2010 16:07' prior: 0!
- MorphicUIManager is a UIManager that implements user interface requests for a Morphic user interface.!

Item was removed:
- ----- Method: MorphicUIManager class>>isActiveManager (in category 'accessing') -----
- isActiveManager
- 	"Answer whether I should act as the active ui manager"
- 	^Smalltalk isMorphic!

Item was removed:
- ----- Method: MorphicUIManager>>chooseClassOrTrait:from: (in category 'ui requests') -----
- chooseClassOrTrait: label from: environment
- 	"Let the user choose a Class or Trait. Use ListChooser in Morphic."
- 	
- 	| names index |
- 	names := environment classAndTraitNames.
- 	index := self
- 		chooseFrom: names
- 		lines: #()
- 		title: label.
- 	index = 0 ifTrue: [ ^nil ].
- 	^environment
- 		at: (names at: index)
- 		ifAbsent: [ nil ]!

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

Item was removed:
- ----- Method: MorphicUIManager>>chooseFileMatching:label: (in category 'ui requests') -----
- chooseFileMatching: patterns label: aString
- 	"Let the user choose a file matching the given patterns"
- 	| result |
- 	result := FileList2 modalFileSelectorForSuffixes: patterns.
- 	^result ifNotNil:[result fullName]!

Item was removed:
- ----- Method: MorphicUIManager>>chooseFont:for:setSelector:getSelector: (in category 'ui requests') -----
- chooseFont: titleString for: aModel setSelector: setSelector getSelector: getSelector
- 	"Open a font-chooser for the given model"
- 	^FontChooserTool default
- 		openWithWindowTitle: titleString 
- 		for: aModel 
- 		setSelector: setSelector 
- 		getSelector: getSelector!

Item was removed:
- ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui requests') -----
- chooseFrom: aList lines: linesArray title: aString 
- 	"Choose an item from the given list. Answer the index of the selected item."
- 	^ aList size > 30
- 		ifTrue:
- 			[ "Don't put more than 30 items in a menu.  Use ListChooser insted"
- 			ListChooser
- 				chooseFrom: aList
- 				title: aString ]
- 		ifFalse:
- 			[ MenuMorph
- 				chooseFrom: aList
- 				lines: linesArray
- 				title: aString ]!

Item was removed:
- ----- Method: MorphicUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') -----
- chooseFrom: labelList values: valueList lines: linesArray title: aString 
- 	"Choose an item from the given list. Answer the selected item."
- 	| index |
- 	^ labelList size > 30
- 		ifTrue:
- 			[ "No point in displaying more than 30 items in a menu.  Use ListChooser insted"
- 			index := ListChooser
- 				chooseFrom: labelList
- 				title: aString.
- 			index = 0 ifFalse: [ valueList at: index ] ]
- 		ifFalse:
- 			[ MenuMorph
- 				chooseFrom: labelList
- 				values: valueList
- 				lines: linesArray
- 				title: aString ]!

Item was removed:
- ----- Method: MorphicUIManager>>confirm: (in category 'ui requests') -----
- confirm: queryString
- 	"Put up a yes/no menu with caption queryString. Answer true if the 
- 	response is yes, false if no. This is a modal question--the user must 
- 	respond yes or no."
- 	^UserDialogBoxMorph confirm: queryString!

Item was removed:
- ----- Method: MorphicUIManager>>confirm:orCancel: (in category 'ui requests') -----
- confirm: aString orCancel: cancelBlock
- 	"Put up a yes/no/cancel menu with caption aString. Answer true if  
- 	the response is yes, false if no. If cancel is chosen, evaluate  
- 	cancelBlock. This is a modal question--the user must respond yes or no."
- 	^UserDialogBoxMorph confirm: aString orCancel: cancelBlock!

Item was removed:
- ----- Method: MorphicUIManager>>confirm:trueChoice:falseChoice: (in category 'ui requests') -----
- confirm: queryString trueChoice: trueChoice falseChoice: falseChoice 
- 	"Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice, false if it's the false-choice.
- 	This is a modal question -- the user must respond one way or the other."
- 	^ UserDialogBoxMorph confirm: queryString trueChoice: trueChoice falseChoice: falseChoice !

Item was removed:
- ----- Method: MorphicUIManager>>displayProgress:at:from:to:during: (in category 'ui requests') -----
- displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock 
- 	"Display titleString as a caption over a progress bar while workBlock is evaluated."
- 	| result progress |
- 	progress := SystemProgressMorph
- 		position: aPoint
- 		label: titleString
- 		min: minVal
- 		max: maxVal.
- 	[ [ result := workBlock value: progress ]
- 		on: ProgressNotification
- 		do:
- 			[ : ex | ex extraParam isString ifTrue:
- 				[ SystemProgressMorph uniqueInstance
- 					labelAt: progress
- 					put: ex extraParam ].
- 			ex resume ] ] ensure: [ SystemProgressMorph close: progress ].
- 	^ result!

Item was removed:
- ----- Method: MorphicUIManager>>edit:label:accept: (in category 'ui requests') -----
- edit: aText label: labelString accept: anAction
- 	"Open an editor on the given string/text"
- 	| window |
- 	window := Workspace open.
- 	labelString ifNotNil: [ window setLabel: labelString ].
- 	"By default, don't style in UIManager edit: requests"
- 	window model
- 		shouldStyle: false;
- 		acceptContents:  aText;
- 		acceptAction: anAction.
- 	^window.!

Item was removed:
- ----- Method: MorphicUIManager>>inform: (in category 'ui requests') -----
- inform: aString
- 	"Display a message for the user to read and then dismiss"
- 	^UserDialogBoxMorph inform: aString!

Item was removed:
- ----- Method: MorphicUIManager>>informUserDuring: (in category 'ui requests') -----
- informUserDuring: aBlock
- 	"Display a message above (or below if insufficient room) the cursor 
- 	during execution of the given block.
- 		UIManager default informUserDuring:[:bar|
- 			#(one two three) do:[:info|
- 				bar value: info.
- 				(Delay forSeconds: 1) wait]]"
- 	SystemProgressMorph
- 		informUserAt: nil during: aBlock.!

Item was removed:
- ----- Method: MorphicUIManager>>initialize (in category 'initialize-release') -----
- initialize
- 	toolBuilder := MorphicToolBuilder new!

Item was removed:
- ----- Method: MorphicUIManager>>multiLineRequest:centerAt:initialAnswer:answerHeight: (in category 'ui requests') -----
- multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight
- 	"Create a multi-line instance of me whose question is queryString with
- 	the given initial answer. Invoke it centered at the given point, and
- 	answer the string the user accepts.  Answer nil if the user cancels.  An
- 	empty string returned means that the ussr cleared the editing area and
- 	then hit 'accept'.  Because multiple lines are invited, we ask that the user
- 	use the ENTER key, or (in morphic anyway) hit the 'accept' button, to 
- 	submit; that way, the return key can be typed to move to the next line."
- 	^FillInTheBlankMorph 
- 		request: queryString 
- 		initialAnswer: defaultAnswer 
- 		centerAt: aPoint 
- 		inWorld: self currentWorld
- 		onCancelReturn: nil
- 		acceptOnCR: false!

Item was removed:
- ----- Method: MorphicUIManager>>request:initialAnswer: (in category 'ui requests') -----
- request: queryString initialAnswer: defaultAnswer 
- 	"Create an instance of me whose question is queryString with the given 
- 	initial answer. Invoke it centered at the given point, and answer the 
- 	string the user accepts. Answer the empty string if the user cancels."
- 	^FillInTheBlankMorph request: queryString initialAnswer: defaultAnswer !

Item was removed:
- ----- Method: MorphicUIManager>>request:initialAnswer:centerAt: (in category 'ui requests') -----
- request: queryString initialAnswer: defaultAnswer centerAt: aPoint 
- 	"Create an instance of me whose question is queryString with the given
- 	initial answer. Invoke it centered at the given point, and answer the
- 	string the user accepts. Answer the empty string if the user cancels."
- 	^FillInTheBlankMorph request: queryString initialAnswer: defaultAnswer centerAt: aPoint!

Item was removed:
- ----- Method: MorphicUIManager>>requestPassword: (in category 'ui requests') -----
- requestPassword: queryString
- 	"Create an instance of me whose question is queryString. Invoke it centered
- 	at the cursor, and answer the string the user accepts. Answer the empty 
- 	string if the user cancels."
- 	^FillInTheBlankMorph requestPassword: queryString!

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

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

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

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

Item was removed:
- ----- Method: PluggableButtonMorphPlus>>enabled: (in category 'accessing') -----
- enabled: aBool
- 	enabled := aBool.
- 	enabled 
- 		ifFalse:[self color: Color gray]
- 		ifTrue:[self getModelState
- 			ifTrue: [self color: onColor]
- 			ifFalse: [self color: offColor]]!

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

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

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

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

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

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

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

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

Item was removed:
- ----- Method: PluggableButtonMorphPlus>>onColor:offColor: (in category 'accessing') -----
- onColor: colorWhenOn offColor: colorWhenOff
- 	"Set the fill colors to be used when this button is on/off."
- 
- 	onColor := colorWhenOn.
- 	offColor := colorWhenOff.
- 	self update: getStateSelector.!

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

Item was removed:
- ----- Method: PluggableButtonMorphPlus>>update: (in category 'updating') -----
- update: what
- 	what ifNil:[^self].
- 	what == getLabelSelector ifTrue: [
- 		self label: (model perform: getLabelSelector)].
- 	what == getEnabledSelector ifTrue:[^self enabled: (model perform: getEnabledSelector)].
- 
- 	getColorSelector ifNotNil: [ | cc |
- 		color = (cc := model perform: getColorSelector) ifFalse:[
- 			color := cc.
- 			self onColor: color offColor: color.
- 			self changed.
- 		].
- 	].
- 	self getModelState
- 			ifTrue: [self color: onColor]
- 			ifFalse: [self color: offColor].
- 	getEnabledSelector ifNotNil:[
- 		self enabled: (model perform: getEnabledSelector).
- 	].
- 	updateMap ifNotNil:
- 		[(updateMap at: what ifAbsent: [])
- 			ifNotNilDo: [ :newTarget | ^self update: newTarget]].
- !

Item was removed:
- ----- Method: PluggableButtonMorphPlus>>updateMap (in category 'updating') -----
- updateMap
- 	^ updateMap ifNil: [updateMap := Dictionary new]
- !

Item was removed:
- ----- Method: PluggableButtonMorphPlus>>whenChanged:update: (in category 'updating') -----
- whenChanged: notification update: target
- 	"On receipt of a notification, such as #contents notification from a CodeHolder,
- 	invoke an update as if target had been the original notification."
- 
- 	self updateMap at: notification put: target!

Item was removed:
- AlignmentMorph subclass: #PluggableCheckBoxMorph
- 	instanceVariableNames: 'model actionSelector valueSelector label'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'ToolBuilder-Morphic'!

Item was removed:
- ----- Method: PluggableCheckBoxMorph class>>on:getState:action:label: (in category 'as yet unclassified') -----
- on: anObject getState: getStateSel action: actionSel label: labelSel
- 
- 	^ self new
- 		on: anObject
- 		getState: getStateSel
- 		action: actionSel
- 		label: labelSel
- 		menu: nil
- !

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

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

Item was removed:
- ----- Method: PluggableCheckBoxMorph>>basicPanel (in category 'installing') -----
- basicPanel
- 	^BorderedMorph new
- 		beTransparent;
- 		extent: 0 at 0;
- 		borderWidth: 0;
- 		layoutInset: 0;
- 		cellInset: 0;
- 		layoutPolicy: TableLayout new;
- 		listCentering: #topLeft;
- 		cellPositioning: #center;
- 		hResizing: #spaceFill;
- 		vResizing: #shrinkWrap;
- 		yourself!

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

Item was removed:
- ----- Method: PluggableCheckBoxMorph>>installButton (in category 'installing') -----
- installButton
- 
- 	| aButton aLabel |
- 	aButton := UpdatingThreePhaseButtonMorph checkBox
- 		target: self model;
- 		actionSelector: self actionSelector;
- 		getSelector: self valueSelector;
- 		yourself.
- 	aLabel := (StringMorph contents: self label translated
- 				font: (StrikeFont familyName: TextStyle defaultFont familyName
- 							size: TextStyle defaultFont pointSize - 1)).
- 	self addMorph: (self horizontalPanel
- 		addMorphBack: aButton;
- 		addMorphBack: aLabel;
- 		yourself).!

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

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

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

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

Item was removed:
- ----- Method: PluggableCheckBoxMorph>>on:getState:action:label:menu: (in category 'initialization') -----
- on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel
- 
- 	self model: anObject.
- 	self valueSelector: getStateSel.
- 	self actionSelector: actionSel.
- 	self label: (self model perform: labelSel).
- !

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

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

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

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

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

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

Item was removed:
- ----- Method: PluggableDropDownListMorph>>basicPanel (in category 'drawing') -----
- basicPanel
- 	^BorderedMorph new
- 		beTransparent;
- 		extent: 0 at 0;
- 		borderWidth: 0;
- 		layoutInset: 0;
- 		cellInset: 0;
- 		layoutPolicy: TableLayout new;
- 		listCentering: #topLeft;
- 		cellPositioning: #center;
- 		hResizing: #spaceFill;
- 		vResizing: #shrinkWrap;
- 		yourself!

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

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

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

Item was removed:
- ----- Method: PluggableDropDownListMorph>>installDropDownList (in category 'drawing') -----
- installDropDownList
- 
- 	| aButton aLabel |
- 	aButton := PluggableButtonMorph on: self model getState: nil action: nil.
- 	aLabel := (StringMorph contents: self model currentRemoteVatId translated
- 				font: (StrikeFont familyName: TextStyle defaultFont familyName
- 							size: TextStyle defaultFont pointSize - 1)).
- 	self addMorph: (self horizontalPanel
- 		addMorphBack: aLabel;
- 		addMorphBack: aButton;
- 		yourself).!

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

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

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

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

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

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

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

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

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

Item was removed:
- PluggableListMorphPlus subclass: #PluggableListMorphByItemPlus
- 	instanceVariableNames: 'itemList'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'ToolBuilder-Morphic'!
- 
- !PluggableListMorphByItemPlus commentStamp: '<historical>' prior: 0!
- Main comment stating the purpose of this class and relevant relationship to other classes.
- 
- Possible useful expressions for doIt or printIt.
- 
- Structure:
-  instVar1		type -- comment about the purpose of instVar1
-  instVar2		type -- comment about the purpose of instVar2
- 
- Any further useful comments about the general approach of this implementation.!

Item was removed:
- ----- Method: PluggableListMorphByItemPlus>>changeModelSelection: (in category 'model access') -----
- changeModelSelection: anInteger
- 	"Change the model's selected item to be the one at the given index."
- 
- 	| item |
- 	setIndexSelector ifNotNil: [
- 		item := (anInteger = 0 ifTrue: [nil] ifFalse: [itemList at: anInteger]).
- 		model perform: setIndexSelector with: item].
- 	self update: getIndexSelector.
- !

Item was removed:
- ----- Method: PluggableListMorphByItemPlus>>getCurrentSelectionIndex (in category 'model access') -----
- getCurrentSelectionIndex
- 	"Answer the index of the current selection."
- 	| item |
- 	getIndexSelector == nil ifTrue: [^ 0].
- 	item := model perform: getIndexSelector.
- 	^ itemList findFirst: [ :x | x = item]
- !

Item was removed:
- ----- Method: PluggableListMorphByItemPlus>>getList (in category 'as yet unclassified') -----
- getList
- 	"cache the raw items in itemList"
- 	itemList := getListSelector ifNil: [ #() ] ifNotNil: [ model perform: getListSelector ].
- 	^super getList!

Item was removed:
- ----- Method: PluggableListMorphByItemPlus>>list: (in category 'initialization') -----
- list: arrayOfStrings
- 	"Set the receivers items to be the given list of strings."
- 	"Note: the instance variable 'items' holds the original list.
- 	 The instance variable 'list' is a paragraph constructed from
- 	 this list."
- "NOTE: this is no longer true; list is a real list, and itemList is no longer used.  And this method shouldn't be called, incidentally."
- self isThisEverCalled .
- 	itemList := arrayOfStrings.
- 	^ super list: arrayOfStrings!

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

Item was removed:
- ----- Method: PluggableListMorphPlus>>acceptDroppingMorph:event: (in category 'drag and drop') -----
- acceptDroppingMorph: aMorph event: evt
- 	| item |
- 	dropItemSelector isNil | potentialDropRow isNil ifTrue: [^self].
- 	item := aMorph passenger.
- 	model perform: dropItemSelector with: item with: potentialDropRow.
- 	self resetPotentialDropRow.
- 	evt hand releaseMouseFocus: self.
- 	Cursor normal show.
- !

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

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

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

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

Item was removed:
- ----- Method: PluggableListMorphPlus>>startDrag: (in category 'drag and drop') -----
- startDrag: evt 
- 	
- 	dragItemSelector ifNil:[^self].
- 	evt hand hasSubmorphs ifTrue: [^ self].
- 	[ | dragIndex draggedItem ddm |
- 	(self dragEnabled and: [model okToChange]) ifFalse: [^ self].
- 	dragIndex := self rowAtLocation: evt position.
- 	dragIndex = 0 ifTrue:[^self].
- 	draggedItem := model perform: dragItemSelector with: (self modelIndexFor: dragIndex).
- 	draggedItem ifNil:[^self].
- 	ddm := TransferMorph withPassenger: draggedItem from: self.
- 	ddm dragTransferType: #dragTransferPlus.
- 	evt hand grabMorph: ddm]
- 		ensure: [Cursor normal show.
- 			evt hand releaseMouseFocus: self]!

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

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

Item was removed:
- ----- Method: PluggableListMorphPlus>>wantsDroppedMorph:event: (in category 'drag and drop') -----
- wantsDroppedMorph: aMorph event: anEvent
- 	aMorph dragTransferType == #dragTransferPlus ifFalse:[^false].
- 	dropItemSelector ifNil:[^false].
- 	wantsDropSelector ifNil:[^true].
- 	^(model perform: wantsDropSelector with: aMorph passenger) == true!

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

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

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

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

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

Item was removed:
- ----- Method: PluggablePanelMorph>>update: (in category 'update') -----
- update: 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 removed:
- SystemWindow subclass: #PluggableSystemWindow
- 	instanceVariableNames: 'getLabelSelector getChildrenSelector children closeWindowSelector'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'ToolBuilder-Morphic'!
- 
- !PluggableSystemWindow commentStamp: 'ar 2/11/2005 20:14' prior: 0!
- A pluggable system window. Fixes the issues with label retrieval and adds support for changing children.!

Item was removed:
- ----- Method: PluggableSystemWindow>>addPaneMorph: (in category 'accessing') -----
- addPaneMorph: aMorph
- 	self addMorph: aMorph fullFrame: aMorph layoutFrame!

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

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

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

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

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

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

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

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

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

Item was removed:
- ----- Method: PluggableSystemWindow>>update: (in category 'updating') -----
- update: what
- 	what ifNil:[^self].
- 	what == getLabelSelector ifTrue:[self setLabel: (model perform: getLabelSelector)].
- 	what == getChildrenSelector ifTrue:[
- 		children ifNil:[children := #()].
- 		self removeAllMorphsIn: children.
- 		children := model perform: getChildrenSelector.
- 		self addAllMorphs: children.
- 		children do:[:m| m hResizing: #spaceFill; vResizing: #spaceFill].
- 	].
- 	^super update: what!

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

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

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

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

Item was removed:
- ----- Method: PluggableTextMorphPlus>>acceptTextInModel (in category 'styling') -----
- acceptTextInModel 
- 	
- 	self okToStyle ifFalse:[^super acceptTextInModel].			
- 	"#correctFrom:to:with: is sent when the method source is
- 	manipulated during compilation (removing unused temps,
- 	changing selectors etc). But 	#correctFrom:to:with: operates 
- 	on the textMorph's text, and we may be saving an unstyled 
- 	copy of the text. This means that these corrections will be lost
- 	unless we also apply the corrections to the unstyled copy that we are saving.
- 		So remember the unstyled copy in unstyledAcceptText, so
- 	that when #correctFrom:to:with: is received we can also apply
- 	the correction to it"
- 	unstyledAcceptText := styler unstyledTextFrom: textMorph asText.
- 	[^setTextSelector isNil or:
- 		[setTextSelector numArgs = 2
- 			ifTrue: [model perform: setTextSelector with: unstyledAcceptText with: self]
- 			ifFalse: [model perform: setTextSelector with: unstyledAcceptText]]
- 	] ensure:[unstyledAcceptText := nil]!

Item was removed:
- ----- Method: PluggableTextMorphPlus>>correctFrom:to:with: (in category 'styling') -----
- correctFrom: start to: stop with: aString
- 	"see the comment in #acceptTextInModel "
- 	unstyledAcceptText ifNotNil:[unstyledAcceptText replaceFrom: start to: stop with: aString ].
- 	^ super correctFrom: start to: stop with: aString!

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

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

Item was removed:
- ----- Method: PluggableTextMorphPlus>>getMenu: (in category 'menu') -----
- getMenu: shiftKeyState
- 	"Answer the menu for this text view. We override the superclass implementation to
- 	so we can give the selection interval to the model."
- 	
- 	| menu aMenu |
- 	getMenuSelector == nil ifTrue: [^ nil].
- 	getMenuSelector numArgs < 3 ifTrue: [^ super getMenu: shiftKeyState].
- 	menu := MenuMorph new defaultTarget: model.
- 	getMenuSelector numArgs = 3 ifTrue:
- 		[aMenu := model 
- 			perform: getMenuSelector 
- 			with: menu 
- 			with: shiftKeyState 
- 			with: self selectionInterval.
- 		getMenuTitleSelector ifNotNil: 
- 			[aMenu addTitle: (model perform: getMenuTitleSelector)].
- 		^ aMenu].
- 	^ self error: 'The getMenuSelector must be a 1- or 2 or 3-keyword symbol'!

Item was removed:
- ----- Method: PluggableTextMorphPlus>>hasUnacceptedEdits: (in category 'styling') -----
- hasUnacceptedEdits: aBoolean
- 	"re-implemented to re-style the text iff aBoolean is true"
- 	 
- 	super hasUnacceptedEdits: aBoolean.
- 	(aBoolean and: [self okToStyle])
- 		ifTrue: [ styler styleInBackgroundProcess: textMorph contents]!

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

Item was removed:
- ----- Method: PluggableTextMorphPlus>>setText: (in category 'styling') -----
- setText: aText
- 	
- 	self okToStyle ifFalse:[^super setText: aText].
- 	super setText: (styler format: aText asText).
- 	aText size < 4096
- 		ifTrue:[styler style: textMorph contents]
- 		ifFalse:[styler styleInBackgroundProcess:  textMorph contents]!

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

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

Item was removed:
- ----- Method: PluggableTextMorphPlus>>stylerStyled: (in category 'styling') -----
- stylerStyled: styledCopyOfText
- 	"Sent after the styler completed styling the underlying text"
- 	textMorph contents runs: styledCopyOfText runs .
- 	"textMorph paragraph recomposeFrom: 1 to: textMorph contents size delta: 0."     "caused chars to appear in wrong order esp. in demo mode. remove this line when sure it is fixed"
- 	textMorph updateFromParagraph.
- 	selectionInterval 
- 		ifNotNil:[
- 			textMorph editor
- 				selectInvisiblyFrom: selectionInterval first to: selectionInterval last;
- 				storeSelectionInParagraph;
- 				setEmphasisHere].
- 	textMorph editor blinkParen.
- 	self scrollSelectionIntoView!

Item was removed:
- ----- Method: PluggableTextMorphPlus>>stylerStyledInBackground: (in category 'styling') -----
- stylerStyledInBackground: styledCopyOfText 
- 	"Sent after the styler completed styling of the text"
- 
- 	"It is possible that the text string	has changed since the styling began. Disregard the styles if styledCopyOfText's string differs with the current textMorph contents string"
- 	textMorph contents string = styledCopyOfText string
- 		ifTrue: [self stylerStyled: styledCopyOfText]!

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

Item was removed:
- ----- Method: PluggableTextMorphPlus>>useDefaultStyler (in category 'initialize') -----
- useDefaultStyler
- 	"This should be changed to a proper registry but as long as there is only shout this will do"
- 	Smalltalk at: #SHTextStylerST80 ifPresent:[:stylerClass|
- 		self styler: (stylerClass new view: self).
- 	].!

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

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

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

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

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

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

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

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

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

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

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

Item was removed:
- ----- Method: PluggableTreeMorph>>acceptDroppingMorph:event: (in category 'morphic') -----
- acceptDroppingMorph: aTransferMorph event: evt 
- 	dropItemSelector ifNil: [ ^ self ].
- 	model
- 		perform: dropItemSelector
- 		withEnoughArguments: {aTransferMorph passenger. 
- 			(self itemFromPoint: evt position) withoutListWrapper. 
- 			aTransferMorph shouldCopy}.
- 	evt hand releaseMouseFocus: self.
- 	potentialDropMorph ifNotNil: [ potentialDropMorph highlightForDrop: false ].
- 	Cursor normal show!

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

Item was removed:
- ----- Method: PluggableTreeMorph>>contentsOfNode: (in category 'node access') -----
- contentsOfNode: node
- 	| children |
- 	getChildrenSelector ifNil:[^#()].
- 	children := model perform: getChildrenSelector with: node item.
- 	^children collect:[:item| PluggableTreeItemNode with: item model: self]!

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

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

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

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

Item was removed:
- ----- Method: PluggableTreeMorph>>dropNode:on: (in category 'node access') -----
- dropNode: srcNode on: dstNode
- 	dropItemSelector ifNil:[^nil].
- 	model perform: dropItemSelector with: srcNode item with: dstNode item!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Item was removed:
- ----- Method: PluggableTreeMorph>>selectPath:in: (in category 'updating') -----
- selectPath: path in: listItem
- 	path isEmpty ifTrue: [^self setSelectedMorph: nil].
- 	listItem withSiblingsDo: [:each | 
- 		(each complexContents item = path first) ifTrue: [
- 			each isExpanded ifFalse: [
- 				each toggleExpandedState.
- 				self adjustSubmorphPositions.
- 			].
- 			each changed.
- 			path size = 1 ifTrue: [
- 				^self setSelectedMorph: each
- 			].
- 			each firstChild ifNil: [^self setSelectedMorph: nil].
- 			^self selectPath: path allButFirst in: each firstChild
- 		].
- 	].
- 	^self setSelectedMorph: nil
- 
- !

Item was removed:
- ----- Method: PluggableTreeMorph>>setSelectedMorph: (in category 'selection') -----
- setSelectedMorph: aMorph
- 	selectedWrapper := aMorph complexContents.
- 	self selection: selectedWrapper.
- 	setSelectedSelector ifNotNil:[
- 		model 
- 			perform: setSelectedSelector 
- 			with: (selectedWrapper ifNotNil:[selectedWrapper item]).
- 	].!

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

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

Item was removed:
- ----- Method: PluggableTreeMorph>>startDrag: (in category 'morphic') -----
- startDrag: evt 
- 	| ddm itemMorph passenger |
- 	self dragEnabled
- 		ifTrue: [itemMorph := scroller submorphs
- 						detect: [:any | any highlightedForMouseDown]
- 						ifNone: []].
- 	(itemMorph isNil
- 			or: [evt hand hasSubmorphs])
- 		ifTrue: [^ self].
- 	itemMorph highlightForMouseDown: false.
- 	itemMorph ~= self selectedMorph
- 		ifTrue: [self setSelectedMorph: itemMorph].
- 	passenger := self model perform: dragItemSelector with: itemMorph withoutListWrapper.
- 	passenger
- 		ifNotNil: [ddm := TransferMorph withPassenger: passenger from: self.
- 			ddm dragTransferType: #dragTransferPlus.
- 			Preferences dragNDropWithAnimation
- 				ifTrue: [self model dragAnimationFor: itemMorph transferMorph: ddm].
- 			evt hand grabMorph: ddm].
- 	evt hand releaseMouseFocus: self!

Item was removed:
- ----- Method: PluggableTreeMorph>>update: (in category 'updating') -----
- update: what
- 	what ifNil:[^self].
- 	what == getRootsSelector ifTrue:[
- 		self roots: (model perform: getRootsSelector)
- 	].
- 	what == getSelectedPathSelector ifTrue:[
- 		^self selectPath: (model perform: getSelectedPathSelector)
- 			in: (scroller submorphs at: 1 ifAbsent: [^self]) 
- 	].
- 	^super update: what!

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

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

Item was removed:
- ----- Method: PluggableTreeMorph>>wantsDroppedMorph:event: (in category 'morphic') -----
- wantsDroppedMorph: aMorph event: anEvent
- 	aMorph dragTransferType == #dragTransferPlus ifFalse:[^false].
- 	dropItemSelector ifNil:[^false].
- 	wantsDropSelector ifNil:[^true].
- 	^ (model perform: wantsDropSelector with: aMorph passenger) == true.!

Item was removed:
- ----- Method: PluggableTreeMorph>>wantsDroppedNode:on: (in category 'node access') -----
- wantsDroppedNode: srcNode on: dstNode
- 	dropItemSelector ifNil:[^false].
- 	wantsDropSelector ifNil:[^true].
- 	^(model perform: wantsDropSelector with: srcNode with: dstNode) == true!



More information about the Packages mailing list