"{ 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 $'
! !