"{ Package: 'stx:goodies/monticello' }"

Object subclass:#MCTool
	instanceVariableNames:'morph label modal modalValue'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-UI'
!


!MCTool methodsFor:'morphic ui'!

answer: anObject
	modalValue _ anObject.
	self close.
!

arrowKey: aCharacter from: aPluggableListMorph 
	"backstop"
!

buildWindow
	| window |
	window _ SystemWindow labelled: self label.
	window model: self.
	self widgetSpecs do:
		[:pair | |send fractions offsets|
		send _ pair first.
		fractions _ pair at: 2 ifAbsent: [#(0 0 1 1)].
		offsets _ pair at: 3 ifAbsent: [#(0 0 0 0)].
		window
			addMorph: (self perform: send first withArguments: send allButFirst )
			fullFrame:
				(LayoutFrame
					fractions: 
					((fractions first)@(fractions second) corner: 
						(fractions third)@(fractions fourth))
					offsets:
						((offsets first)@(offsets second)  corner:
							(offsets third)@(offsets fourth)))].
	^ window
!

buildWith: builder
	|  windowBuilder |

	windowBuilder _ MCToolWindowBuilder builder: builder tool: self.
	self widgetSpecs do:
		[:spec | | send fractions offsets origin corner |
		send _ spec first.
		fractions _ spec at: 2 ifAbsent: [#(0 0 1 1)].
		offsets _ spec at: 3 ifAbsent: [#(0 0 0 0)].
		origin _ (offsets first @ offsets second) 
			/ self defaultExtent asFloatPoint
			+ (fractions first @ fractions second).
		corner _ (offsets third @ offsets fourth) 
			/ self defaultExtent asFloatPoint
			+ (fractions third @ fractions fourth).
		windowBuilder frame: (origin corner: corner).
		windowBuilder perform: send first withArguments: send allButFirst].

	^ windowBuilder build
!

buttonEnabled
	^ true
!

buttonRow
	^ self buttonRow: self buttonSpecs
!

buttonRow: specArray
	| aRow aButton enabled selected |
	aRow _ AlignmentMorph newRow.
	aRow 
		color: (Display depth <= 8 ifTrue: [Color transparent] ifFalse: [Color gray alpha: 0.2]);
		borderWidth: 0.

	aRow hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true.
	aRow clipSubmorphs: true.
	aRow layoutInset: 5@2; cellInset: 3.
	aRow wrapCentering: #center; cellPositioning: #leftCenter.
	specArray do:
		[:triplet |
			enabled _ triplet at: 4 ifAbsent: [#buttonEnabled].
			selected _ triplet at: 5 ifAbsent: [enabled].
			aButton _ PluggableButtonMorph
				on: self
				getState: selected
				action: #performButtonAction:enabled:.
			aButton
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				useRoundedCorners;
				label: triplet first asString;
				arguments: (Array with: triplet second with: enabled); 
				onColor: Color transparent offColor: Color white.
			aRow addMorphBack: aButton.
			aButton setBalloonText: triplet third].
		
	Preferences alternativeWindowLook ifTrue:[
		aRow color: Color transparent.
		aRow submorphsDo:[:m| m borderWidth: 2; borderColor: #raised].
	].

	^ aRow
!

buttonSelected
	^ false
!

buttonSpecs
	^ #()
!

buttonState
	^ true
!

close
	self window delete
!

defaultAnnotationPaneHeight 
	"Answer the receiver's preferred default height for new annotation panes."
	^ Preferences parameterAt: #defaultAnnotationPaneHeight ifAbsentPut: [25]
!

defaultBackgroundColor 
	^ (Color r: 0.627 g: 0.69 b: 0.976)
!

defaultButtonPaneHeight
	"Answer the user's preferred default height for new button panes."

	^ Preferences parameterAt: #defaultButtonPaneHeight ifAbsentPut: [25]
!

defaultExtent
	^ 500@500
!

defaultLabel
	^ self class name
!

fillMenu: aMenu fromSpecs: anArray
	anArray do:
		[:pair |
		aMenu add: pair first target: self selector: pair second].
	^ aMenu
!

findListMorph: aSymbol
	^ morph submorphs detect: [:ea | (ea respondsTo: #getListSelector) and: [ea getListSelector = aSymbol]] ifNone: []
!

findTextMorph: aSymbol
	^ morph submorphs detect: [:ea | (ea respondsTo: #getTextSelector) and: [ea getTextSelector = aSymbol]] ifNone: []
!

getMenu: aMenu
	^aMenu
!

label
	^ label ifNil: [self defaultLabel]
!

label: aString
	label _ aString
!

listMorph: listSymbol
	^ self
		listMorph: (listSymbol, 'List') asSymbol
		selection: (listSymbol, 'Selection') asSymbol
		menu: (listSymbol, 'ListMenu:') asSymbol
!

listMorph: listSymbol keystroke: keystrokeSymbol
	^ (self
		listMorph: (listSymbol, 'List') asSymbol
		selection: (listSymbol, 'Selection') asSymbol
		menu: (listSymbol, 'ListMenu:') asSymbol)
		keystrokeActionSelector: keystrokeSymbol;
		yourself
!

listMorph: listSymbol selection: selectionSymbol
	^ PluggableListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol
!

listMorph: listSymbol selection: selectionSymbol menu: menuSymbol
	^ PluggableListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol
		menu: menuSymbol
!

listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol
	^ (PluggableListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol
		menu: menuSymbol)
		keystrokeActionSelector: keystrokeSymbol;
		yourself
!

multiListMorph: listSymbol selection: selectionSymbol listSelection: listSelectionSymbol menu: menuSymbol
	^ PluggableListMorphOfMany
		on: self
		list: listSymbol
		primarySelection: selectionSymbol
		changePrimarySelection: (selectionSymbol, ':') asSymbol
		listSelection: listSelectionSymbol
		changeListSelection: (listSelectionSymbol, 'put:') asSymbol
		menu: menuSymbol
!

perform: selector orSendTo: otherTarget
	"Selector was just chosen from a menu by a user.  If can respond, then
perform it on myself. If not, send it to otherTarget, presumably the
editPane from which the menu was invoked."

	(self respondsTo: selector)
		ifTrue: [^ self perform: selector]
		ifFalse: [^ otherTarget perform: selector]
!

performButtonAction: anActionSelector enabled: anEnabledSelector
	(self perform: anEnabledSelector) 
		ifTrue: [ self perform: anActionSelector ]
!

show
	modal _ false.
	Smalltalk at: #ToolBuilder ifPresent: [:tb | tb open: self. ^ self].
	^self window openInWorldExtent: self defaultExtent; yourself
!

showLabelled: labelString
	modal _ false.
	self label: labelString.
	^(self window)
		openInWorldExtent: self defaultExtent;
		yourself
!

showModally
	modal _ true.
	self window openInWorldExtent: (400@400).
	[self window world notNil] whileTrue: [
		self window outermostWorldMorph doOneCycle.
	].
	morph _ nil.
	^ modalValue
!

step
!

textMorph: aSymbol
	^ PluggableTextMorph on: self text: aSymbol accept: (aSymbol, ':') asSymbol
!

treeMorph: listSymbol
	^ self
		treeMorph: (listSymbol, 'Tree') asSymbol
		selection: (listSymbol, 'SelectionWrapper') asSymbol
		menu: (listSymbol, 'TreeMenu:') asSymbol
!

treeMorph: listSymbol selection: selectionSymbol menu: menuSymbol
	^ SimpleHierarchicalListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol
		menu: menuSymbol
		keystroke: nil
!

treeOrListMorph: aSymbol
	^ self treeMorph: aSymbol
!

widgetSpecs
	^ #()
!

window
	^ morph ifNil: [morph _ self buildWindow]
! !

!MCTool class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCTool.st,v 1.2 2012-09-11 21:29:48 cg Exp $'
! !