SystemOrganization addCategory: #'OB-ToolBuilder'! !OBButtonBar class methodsFor: '*ob-toolbuilder-layout' stamp: 'cwp 11/7/2011 00:24'! layoutSpecs: specs gutter: gutter | minSize total x | minSize := 3. total := specs inject: 0 into: [:sum :ea || label | label := ea model perform: ea label. sum + (label size max: minSize)]. x := 0. specs do: [:spec || label frame | label := label := spec model perform: spec label. frame := LayoutFrame new topFraction: 0 offset: gutter; bottomFraction: 1 offset: 0; leftFraction: x / total offset: 0. x := x + (label size max: minSize). frame rightFraction: x / total offset: 0. spec frame: frame]. ! ! !OBIcon methodsFor: '*ob-toolbuilder' stamp: 'cwp 12/8/2011 12:24'! asToolBuilderForm | form in | form := Form extent: width @ height depth: 32. in := bytes readStream. 0 to: width - 1 do: [ :x | 0 to: height - 1 do: [ :y || color alpha | alpha := in next. color := (Color r: in next g: in next b: in next range: 255) alpha: alpha. form colorAt: x @ y put: color ] ]. ^ form! ! Object subclass: #OBToolBuilderDialog instanceVariableNames: 'answer builder widget' classVariableNames: '' poolDictionaries: '' category: 'OB-ToolBuilder'! OBToolBuilderDialog subclass: #OBCompletionDialog instanceVariableNames: 'request text listValues listLabels listIndex field' classVariableNames: '' poolDictionaries: '' category: 'OB-ToolBuilder'! !OBCompletionDialog class methodsFor: 'as yet unclassified' stamp: 'cwp 11/13/2011 23:27'! answer: aRequest ^ (self on: aRequest) open; answer! ! !OBCompletionDialog class methodsFor: 'as yet unclassified' stamp: 'cwp 11/12/2011 22:22'! on: aRequest ^ self basicNew initializeWithRequest: aRequest! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:46'! accept answer := self isConstrained ifTrue: [self listSelection] ifFalse: [self text]. self close! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/16/2011 16:50'! accept: aText text := aText asString. self accept.! ! !OBCompletionDialog methodsFor: 'building' stamp: 'cwp 11/13/2011 10:53'! build | windowSpec | windowSpec := self buildWindow. windowSpec children add: self buildField. windowSpec children add: self buildList. windowSpec children add: self buildButtonBar. ^ windowSpec! ! !OBCompletionDialog methodsFor: 'building' stamp: 'cwp 11/13/2011 22:44'! buildButtonBar | button panel frame | frame := LayoutFrame new topFraction: 1 offset: builder buttonHeight negated - builder gutter; rightFraction: 1 offset: 0; bottomFraction: 1 offset: 0; leftFraction: 0 offset: 0; yourself. panel := builder pluggablePanelSpec new model: self; layout: #proportional; children: OrderedCollection new; frame: frame. button := builder pluggableButtonSpec new. button model: self; label: 'Accept (s)'; action: #accept; enabled: #isEnabled; frame: (0@0 corner: 0.5@1). panel children add: button. button := builder pluggableButtonSpec new. button model: self; label: 'Cancel (l)'; action: #cancel; frame: (0.5@0 corner: 1@1). panel children add: button. ^ panel ! ! !OBCompletionDialog methodsFor: 'building' stamp: 'cwp 11/14/2011 00:00'! buildField | frame | frame := LayoutFrame new topFraction: 0 offset: 0; rightFraction: 1 offset: 0; bottomFraction: 0 offset: builder fieldHeight; leftFraction: 0 offset: 0; yourself. ^ builder pluggableInputFieldSpec new model: self; getText: #text; setText: #accept:; askBeforeDiscardingEdits: false; frame: frame.! ! !OBCompletionDialog methodsFor: 'building' stamp: 'cwp 11/16/2011 16:44'! buildList | frame | frame := LayoutFrame new topFraction: 0 offset: builder fieldHeight + builder gutter; rightFraction: 1 offset: 0; bottomFraction: 1 offset: builder buttonHeight negated; leftFraction: 0 offset: 0. ^ builder pluggableListSpec new model: self; list: #listLabels; listItem: #listLabelAt:; listSize: #listSize; getIndex: #listIndex; setIndex: #listIndex:; doubleClick: #accept; keystrokePreview: #keystrokeInList:; autoDeselect: false; frame: frame! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:46'! cancel answer := nil. self close! ! !OBCompletionDialog methodsFor: 'building' stamp: 'cwp 11/16/2011 16:42'! customizeMorph: window field := window findDeeplyA: PluggableTextMorph. field hideScrollBarsIndefinitely; setProperty: #alwaysAccept toValue: true; onKeyStrokeSend: #keystroke:inField: to: self; setProperty: #crAction toValue: [:evt | self accept]. ! ! !OBCompletionDialog methodsFor: 'accessing' stamp: 'cwp 11/15/2011 17:05'! initialExtent ^ 300@400! ! !OBCompletionDialog methodsFor: 'initialize-release' stamp: 'cwp 11/13/2011 22:49'! initializeWithRequest: aRequest self initialize. request := aRequest. text := aRequest default. listValues := #(). listLabels := #(). listIndex := 0. self listValues: (request valuesFor: text). ! ! !OBCompletionDialog methodsFor: 'testing' stamp: 'cwp 11/13/2011 22:30'! isConstrained ^ request assisted not! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:31'! isEnabled ^ self isConstrained ifTrue: [self listIndex > 0] ifFalse: [self text isEmptyOrNil not]! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 23:56'! keystroke: anEvent inField: aMorph self text: aMorph asText asString. ! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/16/2011 16:48'! keystrokeInList: anEvent "Answer true if we've handled with the event, false if the list should handle it." (#(30 31) includes: anEvent keyValue) ifTrue: [^ false]. field keyStroke: anEvent. ^ true! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 09:41'! list ^ (request valuesFor: query) collect: [:ea | request labelFor: ea]! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:39'! listIndex ^ listIndex! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:41'! listIndex: anInteger listIndex = anInteger ifTrue: [^ self]. listIndex := anInteger. self listSelection ifNotNil: [:selection | self isConstrained ifFalse: [text := request labelFor: self listSelection. self changed: #text]]. self changed: #listIndex. self changed: #isEnabled.! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:49'! listLabelAt: anInteger ^ self listLabels at: anInteger ifAbsent: ['']! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:38'! listLabels ^ listLabels! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:41'! listSelection ^ listValues at: self listIndex ifAbsent: [nil]! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:42'! listSelection: anObject self listIndex: (listValues indexOf: anObject ifAbsent: [0])! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:50'! listSize ^ listLabels size! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:42'! listValues ^ listValues! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 23:53'! listValues: aCollection | previous | previous := self listSelection. listValues := aCollection asArray. listLabels := listValues collect: [:ea | request labelFor: ea]. self changed: #listLabels. (listValues includes: previous) ifTrue: [self listSelection: previous].! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 18:21'! querySelection ^ (query size + 1) to: query size! ! !OBCompletionDialog methodsFor: 'building' stamp: 'cwp 11/13/2011 09:16'! searchHeight ^ 20! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 09:27'! selectedIndex ^ 0! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 22:46'! text ^ text! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/14/2011 00:05'! text: aText text = aText asString ifTrue: [^ self]. text := aText asString. self listValues: (request valuesFor: text). self isConstrained ifTrue: [self listIndex: (self listLabels size = 1 ifTrue: [1] ifFalse: [self listLabels findFirst: [:ea | ea sameAs: text]])]. self changed: #isEnabled.! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'cwp 11/13/2011 09:11'! title ^ request prompt! ! OBToolBuilderDialog subclass: #OBMethodNameEditor instanceVariableNames: 'methodName listIndex' classVariableNames: '' poolDictionaries: '' category: 'OB-ToolBuilder'! !OBMethodNameEditor class methodsFor: 'as yet unclassified' stamp: 'cwp 11/15/2011 17:01'! edit: aMethodName ^ (self on: aMethodName) open; answer! ! !OBMethodNameEditor class methodsFor: 'as yet unclassified' stamp: 'cwp 11/15/2011 16:22'! on: aMethodName ^ self basicNew initializeWithMethodName: aMethodName! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 17:00'! accept answer := methodName. self close! ! !OBMethodNameEditor methodsFor: 'building' stamp: 'cwp 11/15/2011 17:24'! build | windowSpec | windowSpec := self buildWindow. #(buildField buildList buildAccept buildCancel buildUp buildDown) do: [:ea | windowSpec children add: (self perform: ea)]. ^ windowSpec! ! !OBMethodNameEditor methodsFor: 'building' stamp: 'cwp 11/15/2011 17:18'! buildAccept | button frame | frame := LayoutFrame new topFraction: 1 offset: builder buttonHeight negated - builder gutter; rightFraction: 0.5 offset: (self rightMargin / 2); bottomFraction: 1 offset: 0; leftFraction: 0 offset: 0; yourself. button := builder pluggableButtonSpec new. button model: self; label: 'Accept (s)'; enabled: #isValid; action: #accept; frame: frame. ^ button ! ! !OBMethodNameEditor methodsFor: 'building' stamp: 'cwp 11/15/2011 17:04'! buildActionButtons | button panel frame | frame := LayoutFrame new topFraction: 1 offset: builder buttonHeight negated - builder gutter; rightFraction: 1 offset: self rightMargin; bottomFraction: 1 offset: 0; leftFraction: 0 offset: 0; yourself. panel := builder pluggablePanelSpec new model: self; layout: #proportional; children: OrderedCollection new; frame: frame. button := builder pluggableButtonSpec new. button model: self; label: 'Accept (s)'; enabled: #isValid; action: #accept; frame: (0@0 corner: 0.5@1). panel children add: button. button := builder pluggableButtonSpec new. button model: self; label: 'Cancel (l)'; action: #cancel; frame: (0.5@0 corner: 1@1). panel children add: button. ^ panel ! ! !OBMethodNameEditor methodsFor: 'building' stamp: 'cwp 11/15/2011 17:18'! buildCancel | button frame | frame := LayoutFrame new topFraction: 1 offset: builder buttonHeight negated - builder gutter; rightFraction: 1 offset: self rightMargin; bottomFraction: 1 offset: 0; leftFraction: 0.5 offset: (self rightMargin / 2); yourself. button := builder pluggableButtonSpec new. button model: self; label: 'Cancel (l)'; action: #cancel; frame: frame. ^ button ! ! !OBMethodNameEditor methodsFor: 'building' stamp: 'cwp 11/15/2011 17:31'! buildDown | button frame | frame := LayoutFrame new topFraction: 0.4 offset: 0; rightFraction: 1 offset: 0; bottomFraction: 0.4 offset: builder buttonHeight; leftFraction: 1 offset: (self rightMargin - builder gutter); yourself. button := builder pluggableButtonSpec new. button model: self; label: 'v'; action: #moveDown; frame: frame. ^ button ! ! !OBMethodNameEditor methodsFor: 'building' stamp: 'cwp 11/15/2011 16:59'! buildField | frame | frame := LayoutFrame new topFraction: 0 offset: 0; rightFraction: 1 offset: self rightMargin; bottomFraction: 0 offset: builder fieldHeight; leftFraction: 0 offset: 0; yourself. ^ builder pluggableInputFieldSpec new model: self; getText: #selector; setText: #selector:; frame: frame.! ! !OBMethodNameEditor methodsFor: 'building' stamp: 'cwp 11/15/2011 16:59'! buildList | frame | frame := LayoutFrame new topFraction: 0 offset: builder fieldHeight + builder gutter; rightFraction: 1 offset: self rightMargin; bottomFraction: 1 offset: builder buttonHeight negated; leftFraction: 0 offset: 0. ^ builder pluggableListSpec new model: self; list: #list; getIndex: #listIndex; setIndex: #listIndex:; doubleClick: #accept; autoDeselect: false; frame: frame! ! !OBMethodNameEditor methodsFor: 'building' stamp: 'cwp 11/15/2011 17:31'! buildUp | button frame | frame := LayoutFrame new topFraction: 0.4 offset: builder buttonHeight negated; rightFraction: 1 offset: 0; bottomFraction: 0.4 offset: 0; leftFraction: 1 offset: (self rightMargin - builder gutter); yourself. button := builder pluggableButtonSpec new. button model: self; label: '^'; action: #moveUp; frame: frame. ^ button ! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 17:00'! cancel self close! ! !OBMethodNameEditor methodsFor: 'accessing' stamp: 'cwp 11/15/2011 17:04'! defaultBackgroundColor ^ Color yellow lighter! ! !OBMethodNameEditor methodsFor: 'accessing' stamp: 'cwp 11/15/2011 17:06'! initialExtent ^ 250@200! ! !OBMethodNameEditor methodsFor: 'initialize-release' stamp: 'cwp 11/15/2011 16:47'! initializeWithMethodName: aMethodName self initialize. methodName := aMethodName. listIndex := 0.! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 16:53'! isValid ^ methodName isValid! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 16:45'! list ^ methodName arguments! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 16:47'! listIndex ^ listIndex! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 16:56'! listIndex: anInteger listIndex := anInteger. self changed: #listIndex! ! !OBMethodNameEditor methodsFor: 'accessing' stamp: 'cwp 11/15/2011 16:24'! methodName ^ methodName! ! !OBMethodNameEditor methodsFor: 'private' stamp: 'cwp 11/15/2011 17:39'! move: from to: to | list tmp | list := methodName arguments. tmp := list at: to. list at: to put: (list at: from). list at: from put: tmp. listIndex := to. self changed: #list! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 21:44'! moveDown (listIndex > 0 and: [listIndex < methodName arguments size]) ifTrue: [self move: listIndex to: listIndex + 1]! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 17:40'! moveUp listIndex > 1 ifTrue: [self move: listIndex to: listIndex - 1]! ! !OBMethodNameEditor methodsFor: 'accessing' stamp: 'cwp 11/15/2011 16:59'! rightMargin ^ -30! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 16:48'! selector ^ methodName selector! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 21:58'! selector: aText methodName selector: aText asString asSymbol. self changed: #selector! ! !OBMethodNameEditor methodsFor: 'callbacks' stamp: 'cwp 11/15/2011 16:51'! title ^ 'Edit method name'! ! !OBToolBuilderDialog methodsFor: 'accessing' stamp: 'cwp 11/15/2011 17:02'! answer ^ answer! ! !OBToolBuilderDialog methodsFor: 'building' stamp: 'cwp 11/15/2011 17:05'! buildWindow ^ builder pluggableWindowSpec new model: self; isDialog: true; label: #title; extent: self initialExtent; children: OrderedCollection new! ! !OBToolBuilderDialog methodsFor: 'open-close' stamp: 'cwp 11/15/2011 16:29'! close builder close: widget! ! !OBToolBuilderDialog methodsFor: 'building' stamp: 'cwp 11/15/2011 23:34'! customizeMorph: aMorph! ! !OBToolBuilderDialog methodsFor: 'open-close' stamp: 'cwp 11/15/2011 16:29'! open self openWith: ToolBuilder default! ! !OBToolBuilderDialog methodsFor: 'open-close' stamp: 'cwp 11/15/2011 23:38'! openMorph: widget | position | self customizeMorph: widget. position := widget activeHand position. builder open: widget. widget center: position. widget setConstrainedPosition: (position - (widget fullBounds extent // 2)) hangOut: false. ! ! !OBToolBuilderDialog methodsFor: 'open-close' stamp: 'cwp 11/15/2011 23:45'! openWith: aBuilder | spec | builder := aBuilder. spec := self build. widget := builder build: spec. (widget isKindOf: Morph) ifTrue: [self openMorph: widget] ifFalse: [builder open: widget]. self runModal. ! ! !OBToolBuilderDialog methodsFor: 'open-close' stamp: 'cwp 11/15/2011 23:45'! runModal builder runModal: widget! ! !MenuMorph methodsFor: '*ob-toolbuilder' stamp: 'cwp 11/4/2011 22:04'! add: label target: anObject selector: aSelector enabled: aBoolean icon: aSymbol keystroke: aKeystroke self add: label target: anObject selector: aSelector. self lastItem isEnabled: aBoolean. anObject longDescription isNil ifFalse: [ self lastItem setBalloonText: anObject longDescription maxLineLength: 256 ]. OBPlatform current menuWithIcons ifTrue: [ self lastItem icon: (self iconNamed: aSymbol) ]. aKeystroke isNil ifFalse: [ self lastItem keyText: aKeystroke asKeystroke printString ]! ! !MenuMorph methodsFor: '*ob-toolbuilder' stamp: 'cwp 11/8/2011 15:12'! addSubmenu: aString enabled: aBoolean "Append the given submenu with the given label." | item submenu | item := MenuItemMorph new. submenu := MenuMorph new. item contents: aString; isEnabled: aBoolean; subMenu: submenu. self addMorphBack: item. ^ submenu! ! !OBList methodsFor: '*ob-toolbuilder' stamp: 'cwp 12/27/2011 21:13'! dropNode: aNode at: anInteger | target | target := self children at: anInteger ifAbsent: [^ self]. (target wantsDroppedNode: aNode) ifFalse: [^ self]. [target acceptDroppedNode: aNode] on: OBAnnouncerRequest do: [:request | request resume: self announcer].! ! !OBList methodsFor: '*ob-toolbuilder' stamp: 'cwp 12/27/2011 21:05'! wantsDroppedNode: aNode ^ aNode notNil and: [self children anySatisfy: [:ea | ea wantsDroppedNode: aNode]]! ! !MenuItemMorph methodsFor: '*ob-toolbuilder' stamp: 'cwp 11/4/2011 22:08'! keyText: aString contents := contents, ' (', aString, ')'! ! !MorphicToolBuilder methodsFor: '*ob-toolbuilder-constants' stamp: 'cwp 11/5/2011 11:46'! buttonHeight ^ OBPlatform current buttonHeight! ! !MorphicToolBuilder methodsFor: '*ob-toolbuilder-constants' stamp: 'cwp 11/13/2011 09:24'! fieldHeight ^ OBPlatform current fieldHeight! ! !MorphicToolBuilder methodsFor: '*ob-toolbuilder-constants' stamp: 'cwp 11/13/2011 09:37'! gutter ^ 4! ! OBBuilder subclass: #OBToolBuilder instanceVariableNames: 'builder window spec frame' classVariableNames: '' poolDictionaries: '' category: 'OB-ToolBuilder'! !OBToolBuilder class methodsFor: 'as yet unclassified' stamp: 'cwp 11/17/2011 22:44'! builder: aBuilder ^ self basicNew initializeWithBuilder: aBuilder. ! ! !OBToolBuilder class methodsFor: 'as yet unclassified' stamp: 'cwp 11/21/2011 01:21'! default ^ self builder: ToolBuilder default! ! !OBToolBuilder class methodsFor: 'as yet unclassified' stamp: 'cwp 11/17/2011 22:44'! open: aBrowser with: aBuilder | visitor | visitor := self builder: aBuilder. visitor visit: aBrowser. aBuilder open: visitor window. ! ! !OBToolBuilder methodsFor: 'private' stamp: 'cwp 11/21/2011 01:53'! build: anInteger columnsForPanel: aPanel | fraction fractionStep offset offsetStep | fraction := frame leftFraction. offset := frame leftOffset. fractionStep := (frame rightFraction - fraction) / anInteger. offsetStep := (frame rightOffset - offset) / anInteger. (aPanel columns last: anInteger) do: [ :ea || f | f := LayoutFrame new. f topFraction: frame topFraction offset: frame topOffset; bottomFraction: frame bottomFraction offset: frame bottomOffset; leftFraction: fraction offset: offset. fraction := fraction + fractionStep. offset := offset + offsetStep. f rightFraction: fraction offset: offset. self frame: f do: [ ea acceptVisitor: self]]! ! !OBToolBuilder methodsFor: 'dynamic' stamp: 'cwp 11/23/2011 23:43'! buildButtons: buttons | minSize total x | x := 0. minSize := 3. total := buttons inject: 0 into: [ :sum :ea | sum + (ea label size max: minSize) ]. ^ buttons do: [ :button || f | f := LayoutFrame new topFraction: 0 offset: 0; bottomFraction: 1 offset: 0; leftFraction: x / total offset: 0. x := x + (button label size max: minSize). f rightFraction: x / total offset: 0. self frame: f do: [ button acceptVisitor: self ] ]! ! !OBToolBuilder methodsFor: 'private' stamp: 'cwp 11/21/2011 00:45'! buildDynamicColumnPanel: aPanel | panelSpec | panelSpec := builder pluggablePanelSpec new model: aPanel; frame: frame; children: #widgets. spec children add: panelSpec! ! !OBToolBuilder methodsFor: 'private' stamp: 'cwp 11/21/2011 00:29'! buildPanelSpecsFor: aBrowser | fraction offset variable f | variable := aBrowser panels count: [ :ea | ea isVerticallyElastic ]. fraction := 0. offset := 0. aBrowser panels do: [ :ea | f := LayoutFrame new. f leftFraction: 0 offset: 0. f rightFraction: 1 offset: 0. f topFraction: fraction offset: offset. ea isVerticallyElastic ifFalse: [ offset := offset + builder buttonHeight + builder gutter ] ifTrue: [ fraction := fraction + (1 / variable). offset := 0 ]. f bottomFraction: fraction offset: offset. self frame: f do: [ ea acceptVisitor: self ] ]! ! !OBToolBuilder methodsFor: 'dynamic' stamp: 'cwp 11/21/2011 12:02'! buildWidgetsIn: aBlock | root | root := builder pluggablePanelSpec new. root children: OrderedCollection new. self spec: root frame: self rootFrame do: aBlock. ^ root children collect: [ :ea | builder build: ea ]! ! !OBToolBuilder methodsFor: 'accessing' stamp: 'cwp 11/21/2011 11:42'! builder ^ builder! ! !OBToolBuilder methodsFor: 'stack' stamp: 'cwp 11/21/2011 00:22'! frame: aLayoutFrame do: aBlock | oldFrame | oldFrame := aLayoutFrame. frame := aLayoutFrame. aBlock ensure: [frame := oldFrame]. ^ aLayoutFrame! ! !OBToolBuilder methodsFor: 'initialize-release' stamp: 'cwp 11/21/2011 00:05'! initializeWithBuilder: aBuilder self initialize. builder := aBuilder. ! ! !OBToolBuilder methodsFor: 'accessing' stamp: 'cwp 11/21/2011 00:13'! rootFrame ^ LayoutFrame new leftFraction: 0 offset: 0; topFraction: 0 offset: 0; rightFraction: 1 offset: 0; bottomFraction: 1 offset: 0; yourself! ! !OBToolBuilder methodsFor: 'stack' stamp: 'cwp 11/23/2011 23:47'! spec: aSpec do: aBlock | oldSpec | oldSpec := spec. spec := aSpec. aBlock ensure: [spec := oldSpec]. ^ aSpec! ! !OBToolBuilder methodsFor: 'stack' stamp: 'cwp 11/21/2011 00:10'! spec: aSpec frame: aLayoutFrame do: aBlock | oldFrame oldSpec | oldSpec := aSpec. oldFrame := aLayoutFrame. spec := aSpec. frame := aLayoutFrame. aBlock ensure: [spec := oldSpec. frame := oldFrame]. ^ aSpec! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/22/2011 21:07'! visitAnnotationPanel: aPanel | panelSpec | panelSpec := builder pluggableInputFieldSpec new model: aPanel; getText: #text; setText: #accept:notifying:; selection: #selection; menu: #menu:shifted:selection:; frame: frame. spec children add: panelSpec! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/21/2011 15:28'! visitBrowser: aBrowser | windowSpec | windowSpec := self spec: builder pluggableWindowSpec new frame: self rootFrame do: [spec model: aBrowser; label: aBrowser labelString asString; color: aBrowser defaultBackgroundColor; children: OrderedCollection new. self buildPanelSpecsFor: aBrowser]. window := windowSpec buildWith: builder! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/22/2011 21:29'! visitButton: button | buttonSpec | buttonSpec := builder pluggableButtonSpec new. buttonSpec model: button; label: #label; action: #execute; state: #isPressed; enabled: #isEnabled; frame: frame. button color ifNotNil: [ buttonSpec color: #color ]. ^ spec children add: buttonSpec! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/23/2011 23:10'! visitButtonBar: aButtonBar | barSpec | barSpec := builder pluggablePanelSpec new model: aButtonBar; children: #widgets; frame: frame. spec children add: barSpec! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/21/2011 00:54'! visitColumn: aColumn | columnSpec | columnSpec := builder pluggablePanelSpec new model: aColumn; children: #widgets. columnSpec frame: frame. spec children add: columnSpec. ^ aColumn! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/21/2011 01:57'! visitColumnPanel: aPanel aPanel minPanes = aPanel maxPanes ifTrue: [ self build: aPanel maxPanes columnsForPanel: aPanel ] ifFalse: [ self buildDynamicColumnPanel: aPanel ]. ^ aPanel! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 12/16/2011 12:03'! visitDefinitionPanel: aPanel | panelSpec | panelSpec := builder pluggableCodePaneSpec new model: aPanel; getText: #text; setText: #accept:notifying:; selection: #selection; menu: #menu:shifted:selection:; frame: frame. spec children add: panelSpec. ! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/23/2011 23:47'! visitFixedButtonPanel: aPanel | panelSpec | panelSpec := builder pluggablePanelSpec new frame: frame; children: OrderedCollection new; yourself. self spec: panelSpec do: [self buildButtons: aPanel buttons]. spec children add: panelSpec.! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 12/27/2011 21:13'! visitList: list | listSpec | listSpec := builder pluggableListSpec new model: list; list: #list; listItem: #listAt:; listSize: #listSize; menu: #menu:; getIndex: #selection; setIndex: #selection:; icon: #iconAt:; doubleClick: #doubleClick; keystrokePreview: #keystrokePreview:; keyPress: #keystroke:; dragItem: #nodeAt:; dropAccept: #wantsDroppedNode:; dropItem: #dropNode:at:; frame: frame. spec children add: listSpec! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/21/2011 14:55'! visitMercuryPanel: aPanel | panelSpec | panelSpec := builder pluggableInputFieldSpec new model: aPanel; getText: #text; setText: #accept:notifying:; selection: #selection; menu: #menu:shifted:selection:; frame: frame. spec children add: panelSpec! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/21/2011 11:38'! visitSwitch: aSwitch aSwitch isActive ifFalse: [^ self]. "First update the list frame to make room for the switch" frame bottomOffset: builder buttonHeight negated - builder gutter. "Now build the buttons in the resulting empty space." self frame: (self rootFrame topFraction: 1 offset: builder buttonHeight negated) do: [aSwitch bar acceptVisitor: self]! ! !OBToolBuilder methodsFor: 'visiting' stamp: 'cwp 11/21/2011 13:41'! visitTextPanel: aPanel | panelSpec | panelSpec := builder pluggableTextSpec new model: aPanel; getText: #text; setText: #accept:notifying:; selection: #selection; menu: #menu:shifted:selection:; frame: frame. spec children add: panelSpec. ! ! !OBToolBuilder methodsFor: 'dynamic' stamp: 'cwp 11/23/2011 23:43'! widgetsForButtonBar: aButtonBar ^ self buildWidgetsIn: [ self buildButtons: aButtonBar buttons ]! ! !OBToolBuilder methodsFor: 'dynamic' stamp: 'cwp 11/21/2011 12:05'! widgetsForColumn: aColumn ^ self buildWidgetsIn: [aColumn list acceptVisitor: self. aColumn switch acceptVisitor: self]! ! !OBToolBuilder methodsFor: 'dynamic' stamp: 'cwp 11/21/2011 12:06'! widgetsForColumnPanel: aPanel | count | count := (aPanel columns size max: aPanel minPanes) min: aPanel maxPanes. ^ self buildWidgetsIn: [ self build: count columnsForPanel: aPanel ]! ! !OBToolBuilder methodsFor: 'accessing' stamp: 'cwp 11/17/2011 22:45'! window ^ window! ! OBInterface subclass: #OBToolBuilderInterface instanceVariableNames: '' classVariableNames: 'Icons' poolDictionaries: '' category: 'OB-ToolBuilder'! !OBToolBuilderInterface class methodsFor: 'as yet unclassified' stamp: 'cwp 12/7/2011 16:41'! initialize OBInterface default: self new. Icons := IdentityDictionary new! ! !OBToolBuilderInterface methodsFor: 'building' stamp: 'cwp 11/6/2011 00:04'! build: aModel ^ self builder build: aModel! ! !OBToolBuilderInterface methodsFor: 'building' stamp: 'cwp 12/8/2011 23:45'! builder ^ OBToolBuilder default! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'cwp 12/8/2011 23:22'! handleBrowseRequest: request OBToolBuilder open: request browser with: ToolBuilder default. ^ request browser! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'dc 9/18/2007 10:48'! handleChoiceRequest: request ^ UIManager default chooseFrom: request labels values: request values lines: request lines title: (request prompt ifNil: [''])! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'cwp 11/9/2011 11:27'! handleCloseRequest: request (SystemWindow allSubInstances detect: [ :each | each model = request browser ] ifNone: [ ^ nil ]) delete! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'cwp 11/12/2011 22:03'! handleCompletionRequest: aRequest ^ OBCompletionDialog answer: aRequest! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'lr 7/19/2010 13:00'! handleConfirmationRequest: request | choice | choice := UIManager default confirm: request prompt trueChoice: request okChoice falseChoice: request cancelChoice. ^ choice ifNil: [ false ] ifNotNil: [ choice ]! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'lr 7/4/2009 16:43'! handleInformRequest: anOBInformRequest UIManager default inform: anOBInformRequest message! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'cwp 11/12/2011 21:23'! handleMethodNameRequest: aRequest ^ OBMethodNameEditor edit: aRequest methodName copy! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'lr 7/4/2009 16:43'! handleMultiLineTextRequest: request ^ UIManager default multiLineRequest: request prompt centerAt: Sensor cursorPoint initialAnswer: request template answerHeight: 200! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'cwp 11/9/2011 11:29'! handleMultipleChoiceRequest: aRequest | menu | aRequest values isEmpty ifTrue: [ ^ aRequest values ]. menu := MenuMorph new. menu stayUp: true. aRequest prompt isEmptyOrNil ifFalse: [ menu addTitle: aRequest prompt ]. aRequest values do: [ :value | menu addUpdating: #label: target: aRequest selector: #toggle: argumentList: (Array with: value) ]. menu addLine. menu add: 'ok' target: menu selector: #delete. menu invokeModal. ^ aRequest selection asArray! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'DamienCassou 9/20/2009 15:55'! handleTextRequest: request | text | text := UIManager default request:request prompt initialAnswer: request template. ^ (text isNil or: [text isEmpty]) ifTrue: [nil] ifFalse: [text]! ! !OBToolBuilderInterface methodsFor: 'interaction' stamp: 'lr 5/14/2008 15:42'! handleWaitRequest: request ^ Cursor wait showWhile: request block! ! !OBToolBuilderInterface methodsFor: 'icons' stamp: 'cwp 12/8/2011 12:06'! iconNamed: aSymbol | icon form | ^ Icons at: aSymbol ifAbsent: [icon := OBIcon named: aSymbol. icon ifNotNil: [form := icon asToolBuilderForm. Icons at: aSymbol put: form]]! ! !SUnitToolBuilder methodsFor: '*ob-toolbuilder-constants' stamp: 'cwp 11/7/2011 00:35'! gutter ^ 5! ! OBToolBuilderInterface initialize!