"
COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
ApplicationModel subclass:#MenuEditor
instanceVariableNames:'specClass tabSelection aspects slices'
classVariableNames:''
poolDictionaries:''
category:'Interface-UIPainter'
!
Object subclass:#Item
instanceVariableNames:'activeHelpKey enabled label value nameKey indication shortcutKey
accessCharaterPos retriever icon iconAndLabel'
classVariableNames:''
poolDictionaries:''
privateIn:MenuEditor
!
SelectionInTreeView subclass:#Painter
instanceVariableNames:''
classVariableNames:'CopyBuffer'
poolDictionaries:''
privateIn:MenuEditor
!
!MenuEditor class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
create and modify or inspect popup and pullDown menus of the
new style( derives from Menu).
[start with:]
MenuEditor open
MenuEditor new openOnClass:MenuEditor andSelector:#menuPullDown
[see also:]
UIPainter
UIHelpTool
UISpecificationTool
SelectionInTreeView
[author:]
Claus Atzkern
"
! !
!MenuEditor class methodsFor:'interface specs'!
classAndMethodSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#classAndMethodSpec
MenuEditor new openInterface:#classAndMethodSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'Painter'
#'bounds:' #(#Rectangle 0 0 391 170)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'classLabel'
#'layout:' #(#AlignmentOrigin 45 0.11 51 0 1 0.5)
#'label:' 'class:'
#'adjust:' #right
#'resizeForLabel:' true
)
#(#LabelSpec
#'name:' 'selectorLabel'
#'layout:' #(#AlignmentOrigin 45 0.11 74 0 1 0.5)
#'label:' 'selector:'
#'adjust:' #right
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'methodNameField'
#'layout:' #(#LayoutFrame 47 0.11 64 0 -5 1.0 86 0)
#'tabable:' true
#'model:' #methodNameChannel
)
#(#LabelSpec
#'name:' 'boxLabel'
#'layout:' #(#Point 5 10)
#'label:' 'class & selector for code:'
#'adjust:' #left
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'classNameField'
#'layout:' #(#LayoutFrame 47 0.11 39 0 -5 1.0 61 0)
#'tabable:' true
#'model:' #classNameChannel
)
#(#HorizontalPanelViewSpec
#'name:' 'commitPanel'
#'layout:' #(#LayoutFrame 0 0.0 -24 1.0 0 1.0 0 1.0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ActionButtonSpec
#'name:' 'button1'
#'label:' 'cancel'
#'tabable:' true
#'model:' #cancel
#'extent:' #(#Point 191 24)
)
#(#ActionButtonSpec
#'name:' 'button2'
#'label:' 'ok'
#'tabable:' true
#'isDefault:' true
#'model:' #accept
#'extent:' #(#Point 191 24)
)
)
)
#'horizontalLayout:' #fitSpace
#'verticalLayout:' #fit
#'horizontalSpace:' 3
#'verticalSpace:' 3
)
)
)
)
!
classDefineSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#classDefineSpec
MenuEditor new openInterface:#classDefineSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'Painter'
#'bounds:' #(#Rectangle 0 0 383 128)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'classLabel'
#'layout:' #(#AlignmentOrigin 45 0.11 51 0 1 0.5)
#'label:' 'class:'
#'adjust:' #right
#'resizeForLabel:' true
)
#(#LabelSpec
#'name:' 'boxLabel'
#'layout:' #(#Point 5 10)
#'label:' 'class for code:'
#'adjust:' #left
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'classNameField'
#'layout:' #(#LayoutFrame 47 0.11 39 0 -5 1.0 61 0)
#'tabable:' true
#'model:' #classNameChannel
)
#(#HorizontalPanelViewSpec
#'name:' 'commitPanel'
#'layout:' #(#LayoutFrame 0 0.0 -24 1.0 0 1.0 0 1.0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ActionButtonSpec
#'name:' 'button1'
#'label:' 'cancel'
#'tabable:' true
#'model:' #cancel
#'extent:' #(#Point 187 24)
)
#(#ActionButtonSpec
#'name:' 'button2'
#'label:' 'ok'
#'tabable:' true
#'isDefault:' true
#'model:' #accept
#'extent:' #(#Point 187 24)
)
)
)
#'horizontalLayout:' #fitSpace
#'verticalLayout:' #fit
#'horizontalSpace:' 3
#'verticalSpace:' 3
)
)
)
)
!
menuPullDown
"this window spec was automatically generated by the ST/X MenuEditor"
"do not manually edit this - the builder may not be able to
handle the specification if its corrupted."
"
MenuEditor new openOnClass:MenuEditor andSelector:#menuPullDown
(Menu new fromLiteralArrayEncoding:(MenuEditor menuPullDown)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#'label:' 'file'
#'value:' #file
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'new'
#'value:' #doNew
)
#(#MenuItem
#'label:' 'from class ...'
#'value:' #doFromClass
)
#(#MenuItem
#'label:' 'pick a menu'
#'value:' #doPickAMenu
)
#(#MenuItem
#'label:' '='
)
#(#MenuItem
#'label:' 'quit'
#'value:' #closeRequest
)
) nil
nil
)
)
#(#MenuItem
#'label:' 'code'
#'value:' #code
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'class'
#'value:' #doDefineClass
)
#(#MenuItem
#'label:' '-'
)
#(#MenuItem
#'label:' 'install window spec.'
#'value:' #doInstallSpec
)
#(#MenuItem
#'label:' 'install help spec.'
#'value:' #doInstallHelp
)
#(#MenuItem
#'label:' '='
)
#(#MenuItem
#'label:' 'browse application'
#'value:' #doBrowseAppClass
)
) nil
nil
)
)
#(#MenuItem
#'label:' 'test'
#'value:' #doTest
)
) nil
nil
)
!
windowSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#windowSpec
MenuEditor new openInterface:#windowSpec
"
"MenuEditor open"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'Menu Builder'
#'bounds:' #(#Rectangle 0 0 580 384)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ArbitraryComponentSpec
#'name:' 'painterView'
#'layout:' #(#LayoutFrame 0 0.0 25 0.0 0 0.5 0 1.0)
#'component:' #painter
#'hasHorizontalScrollBar:' true
#'hasVerticalScrollBar:' true
#'hasBorder:' false
#'miniScrollerHorizontal:' false
#'miniScrollerVertical:' false
)
#(#NoteBookViewSpec
#'name:' 'specificationView'
#'layout:' #(#LayoutFrame 0 0.5 25 0.0 0 1.0 -25 1.0)
#'menu:' #tabList
#'model:' #tabModel
#'tabWidget:' #Window
#'useIndex:' true
#'canvas:' #tabCanvas
)
#(#HorizontalPanelViewSpec
#'name:' 'confirmationPanel'
#'layout:' #(#LayoutFrame 0 0.5 -24 1.0 0 1.0 0 1.0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ActionButtonSpec
#'name:' 'cancelButton'
#'label:' 'cancel'
#'model:' #cancel
#'enableChannel:' #modifiedChannel
#'extent:' #(#Point 140 24)
)
#(#ActionButtonSpec
#'name:' 'acceptButton'
#'label:' 'ok'
#'model:' #accept
#'enableChannel:' #modifiedChannel
#'extent:' #(#Point 141 24)
)
)
)
#'horizontalLayout:' #fitSpace
#'verticalLayout:' #fit
#'horizontalSpace:' 3
#'verticalSpace:' 3
)
#(#MenuPanelSpec
#'name:' 'pullDownMenu'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 24 0)
#'menu:' #menuPullDown
)
)
)
)
! !
!MenuEditor class methodsFor:'slices'!
slicesItem
^#(
(Basics basicsItemSpec)
(Details detailsEditSpec)
(Misc miscEditSpec)
(Help help)
)
!
slicesMenu
^#(
(Basics basicsMenuSpec)
(Details detailsEditSpec)
(Misc miscEditSpec)
(Help help)
)
!
slicesRootMenu
^#(
(Basics basicsRootSpec)
)
!
slicesSeperatorMenu
^#(
(Basics basicsSeperatorMenu)
)
! !
!MenuEditor class methodsFor:'specs'!
basicsItemSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#basicsItemSpec
MenuEditor new openInterface:#basicsItemSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'unnamed canvas'
#'bounds:' #(#Rectangle 0 0 267 319)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'nameKeyLabel'
#'layout:' #(#AlignmentOrigin 87 0 26 0 1 0.5)
#'label:' 'NameKey:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'itemNameKey'
#'layout:' #(#LayoutFrame 91 0 15 0 -5 1.0 37 0)
#'tabable:' true
#'model:' #nameKey
#'type:' #symbolOrNil
)
#(#LabelSpec
#'name:' 'labelLabel'
#'layout:' #(#AlignmentOrigin 87 0 53 0 1 0.5)
#'label:' 'Label'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'itemLabel'
#'layout:' #(#LayoutFrame 91 0 42 0 -5 1.0 64 0)
#'tabable:' true
#'model:' #label
)
#(#LabelSpec
#'name:' 'valueLabel'
#'layout:' #(#AlignmentOrigin 87 0 79 0 1 0.5)
#'label:' 'Value:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'itemValue'
#'layout:' #(#LayoutFrame 91 0 68 0 -5 1.0 90 0)
#'tabable:' true
#'model:' #value
#'type:' #symbolOrNil
)
#(#LabelSpec
#'name:' 'indicationLabel'
#'layout:' #(#AlignmentOrigin 87 0 139 0 1 0.5)
#'label:' 'Indication:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'indicationValue'
#'layout:' #(#LayoutFrame 91 0 128 0 -5 1.0 150 0)
#'tabable:' true
#'model:' #indication
#'type:' #symbolOrNil
)
)
)
)
!
basicsMenuSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#basicsMenuSpec
MenuEditor new openInterface:#basicsMenuSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'unnamed canvas'
#'bounds:' #(#Rectangle 0 0 267 319)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'nameKeyLabel'
#'layout:' #(#AlignmentOrigin 87 0 26 0 1 0.5)
#'label:' 'NameKey:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'itemNameKey'
#'layout:' #(#LayoutFrame 91 0 15 0 -5 1.0 37 0)
#'tabable:' true
#'model:' #nameKey
#'type:' #symbolOrNil
)
#(#LabelSpec
#'name:' 'labelLabel'
#'layout:' #(#AlignmentOrigin 87 0 53 0 1 0.5)
#'label:' 'Label'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'itemLabel'
#'layout:' #(#LayoutFrame 91 0 42 0 -5 1.0 64 0)
#'tabable:' true
#'model:' #label
)
)
)
)
!
basicsRootSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#basicsRootSpec
MenuEditor new openInterface:#basicsRootSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'unnamed canvas'
#'bounds:' #(#Rectangle 0 0 267 319)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'selectorLabel'
#'layout:' #(#AlignmentOrigin 78 0 53 0 1 0.5)
#'label:' 'Selector:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'selector'
#'layout:' #(#LayoutFrame 82 0 42 0 -14 1.0 64 0)
#'tabable:' true
#'model:' #label
)
)
)
)
!
basicsSeperatorMenu
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#basicsSeperatorMenu
MenuEditor new openInterface:#basicsSeperatorMenu
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'unnamed canvas'
#'bounds:' #(#Rectangle 0 0 267 319)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#CheckBoxSpec
#'name:' 'seperator'
#'layout:' #(#AlignmentOrigin 19 0 48 0 0 0)
#'tabable:' true
#'model:' #doubleSeperator
#'label:' 'Double Seperator'
)
)
)
)
!
detailsEditSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#detailsEditSpec
MenuEditor new openInterface:#detailsEditSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'unnamed canvas'
#'bounds:' #(#Rectangle 0 0 259 288)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'enabledLabel'
#'layout:' #(#AlignmentOrigin 87 0 59 0 1 0.5)
#'label:' 'Enabled:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'enabled'
#'layout:' #(#LayoutFrame 91 0 48 0 -5 1.0 70 0)
#'tabable:' true
#'model:' #enabled
#'type:' #symbolOrNil
)
#(#LabelSpec
#'name:' 'shortcutKeyLabel'
#'layout:' #(#AlignmentOrigin 87 0 33 0 1 0.5)
#'label:' 'Accelerator:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'accelerator'
#'layout:' #(#LayoutFrame 91 0 22 0 -5 1.0 44 0)
#'tabable:' true
#'model:' #shortcutKey
#'type:' #symbolOrNil
)
#(#LabelSpec
#'name:' 'accessCharPosLabel'
#'layout:' #(#AlignmentOrigin 181 0 127 0 1 0.5)
#'label:' 'Access Character Position:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'accessCharaterPos'
#'layout:' #(#LayoutFrame 184 0 116 0 -5 1.0 138 0)
#'tabable:' true
#'model:' #accessCharaterPos
#'type:' #numberOrNil
)
)
)
)
!
miscEditSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#miscEditSpec
MenuEditor new openInterface:#miscEditSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'unnamed canvas'
#'bounds:' #(#Rectangle 0 0 245 142)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'retrieverLabel'
#'layout:' #(#AlignmentOrigin 77 0 26 0 1 0.5)
#'label:' 'Retriever:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'retriever'
#'layout:' #(#LayoutFrame 81 0 15 0 -8 1.0 37 0)
#'tabable:' true
#'model:' #retriever
#'type:' #symbolOrNil
)
#(#LabelSpec
#'name:' 'iconLabel'
#'layout:' #(#AlignmentOrigin 77 0 50 0 1 0.5)
#'label:' 'Icon:'
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'icon'
#'layout:' #(#LayoutFrame 81 0 39 0 -8 1.0 61 0)
#'tabable:' true
#'model:' #icon
#'type:' #symbolOrNil
)
#(#CheckBoxSpec
#'name:' 'iconAndLabel'
#'layout:' #(#AlignmentOrigin 15 0 100 0 0 0.5)
#'tabable:' true
#'model:' #iconAndLabel
#'label:' 'Icon & Label'
)
)
)
)
!
seperatorSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:MenuEditor andSelector:#seperatorSpec
MenuEditor new openInterface:#seperatorSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'unnamed canvas'
#'bounds:' #(#Rectangle 0 0 267 319)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#CheckBoxSpec
#'name:' 'seperator'
#'layout:' #(#AlignmentOrigin 19 0 48 0 0 0)
#'tabable:' true
#'model:' #doubleSeperator
#'label:' 'Double Seperator'
)
)
)
)
! !
!MenuEditor methodsFor:'accessing'!
specClass
^ specClass
!
specClass:aClass
aClass isBehavior ifTrue:[specClass := aClass name]
ifFalse:[specClass := aClass].
! !
!MenuEditor methodsFor:'actions'!
accept
"automatically generated by UIPainter ..."
|node cont|
node := self painter selectedNode.
node notNil ifTrue:[
self isHelpToolSelected ifTrue:[
self helpTool accept
].
cont := node contents buildFromAspects:aspects.
self painter selectedNodeChanged
].
self modifiedChannel value:false.
!
cancel
|node|
(node := self painter selectedNode) notNil ifTrue:[
aspects do:[:anAspect| anAspect value:nil ].
node contents toAspects:aspects.
].
self modifiedChannel value:false.
! !
!MenuEditor methodsFor:'aspects'!
aspectFor:aKey
"returns aspect for a key or nil
"
^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ]
!
menuPullDown
|menu|
menu := Menu new.
menu fromLiteralArrayEncoding:(self class menuPullDown).
menu receiver:self.
^ menu
!
modifiedChannel
"automatically generated by UIPainter ..."
|holder|
(holder := builder bindingAt:#modifiedChannel) isNil ifTrue:[
builder aspectAt:#modifiedChannel put:(holder := false asValue).
].
^ holder
!
tabCanvas
"automatically generated by UIPainter ..."
|holder|
(holder := builder bindingAt:#tabCanvas) isNil ifTrue:[
builder aspectAt:#tabCanvas put:(holder := SubCanvas new).
].
^ holder
!
tabList
"automatically generated by UIPainter ..."
|holder|
(holder := builder bindingAt:#tabList) isNil ifTrue:[
builder aspectAt:#tabList put:(holder := ValueHolder new)
].
^ holder
!
tabModel
"automatically generated by UIPainter ..."
|holder|
(holder := builder bindingAt:#tabModel) isNil ifTrue:[
holder := AspectAdaptor new subject:self; forAspect:#tabSelection.
builder aspectAt:#tabModel put:holder.
].
^ holder
! !
!MenuEditor methodsFor:'change & update'!
update:something with:aParameter from:changedObject
"one of my models changed its value
"
self modifiedChannel value:true
! !
!MenuEditor methodsFor:'queries'!
isHelpToolSelected
"returns true if current selection is help tool
"
(slices notNil and:[tabSelection notNil]) ifTrue:[
^ (slices at:tabSelection) last == #help
].
^ false
! !
!MenuEditor methodsFor:'selection'!
menuChanged
|node item slc sel|
(node := self painter selectedNode) notNil ifTrue:[
aspects do:[:anAspect| anAspect value:nil ].
item := node contents.
item toAspects:aspects.
item isSeperator ifFalse:[
node parent isNil ifFalse:[
node hasChildren ifTrue:[slc := #slicesMenu]
ifFalse:[slc := #slicesItem].
] ifTrue:[
slc := #slicesRootMenu
]
] ifTrue:[
slc := #slicesSeperatorMenu
].
slc := self class perform:slc.
].
self modifiedChannel value:false.
slc ~= slices ifTrue:[
(slices := slc) notNil ifTrue:[
tabSelection notNil ifTrue:[sel := tabSelection min:(slices size)]
ifFalse:[sel := 1].
self tabList value:(slices collect:[:s| s first]).
self tabModel setValue:nil.
self tabModel value:sel.
] ifFalse:[
self tabList value:nil.
self tabSelection:nil.
]
].
!
tabSelection
^ tabSelection
!
tabSelection:aSelection
|tool sel|
tabSelection == aSelection ifTrue:[
^ self
].
(tabSelection := aSelection) isNil ifTrue:[
^ self tabCanvas client:nil
].
self isHelpToolSelected ifTrue:[
self tabCanvas client:(tool := self helpTool).
tool model:(self aspectFor:#activeHelpKey)
] ifFalse:[
sel := (slices at:tabSelection) last.
self tabCanvas client:self spec:(self class perform:sel) builder:builder
]
! !
!MenuEditor methodsFor:'startup / release'!
buildFrom:aClass andSelector:aSelector
|oldClass newClass|
oldClass := self specClass.
self specClass:aClass.
newClass := self specClass.
oldClass ~= newClass ifTrue:[
self helpTool helpSpecFrom:newClass
].
self painter buildFrom:newClass andSelector:aSelector.
!
initialize
"initialize channels
"
super initialize.
aspects := IdentityDictionary new.
#(
label
accessCharaterPos
activeHelpKey
enabled
value
nameKey
indication
shortcutKey
doubleSeperator
retriever
iconAndLabel
icon
) do:[:aKey||holder|
holder := ValueHolder new.
holder addDependent:self.
aspects at:aKey put:holder.
].
!
openInterface
super openInterface.
self buildFrom:nil andSelector:nil.
!
openOnClass:aClass andSelector:aSelector
super openInterface.
self buildFrom:aClass andSelector:aSelector.
! !
!MenuEditor methodsFor:'user interactions'!
doBrowseAppClass
"open a browser on the class"
|cls|
(cls := self specClass) isNil ifTrue:[
^ self information:'no class yet'.
].
cls isBehavior ifFalse:[
(cls := Smalltalk at:cls asSymbol) isNil ifTrue:[
^ self information:'no valid class defined'.
]
].
SystemBrowser openInClass:cls
!
doDefineClass
aspects at:#classNameChannel put:(self specClass asValue).
(self openDialogInterface:#classDefineSpec) ifTrue:[
self specClass:((aspects at:#classNameChannel) value)
].
!
doFromClass
aspects at:#classNameChannel put:(self specClass asValue).
aspects at:#methodNameChannel put:(self painter selectorName asValue).
(self openDialogInterface:#classAndMethodSpec) ifTrue:[
self buildFrom:(aspects at:#classNameChannel) value
andSelector:(aspects at:#methodNameChannel) value
].
!
doInstallHelp
"install help text
"
self helpTool installHelpSpecInto:(self specClass)
!
doInstallSpec
|cls selector painter menu spec mthd category code|
(cls := self specClass) isNil ifTrue:[
^ self information:'no class yet'.
].
cls isBehavior ifFalse:[
(cls := Smalltalk at:cls asSymbol) isNil ifTrue:[
^ self information:'no valid class defined'.
]
].
painter := self painter.
selector := painter selectorName.
menu := painter asMenu.
menu isNil ifTrue:[
^ self information:'no menu defined'
].
menu := menu literalArrayEncoding.
spec := WriteStream on:String new.
UISpecification prettyPrintSpecArray:menu on:spec indent:5.
spec := spec contents.
"/ if that method already exists, do not overwrite the category
category := 'interface specs'.
(mthd := cls class compiledMethodAt:selector) notNil ifTrue:[
category := mthd category.
].
code := Character excla asString
, cls name , ' class methodsFor:' , category storeString
, Character excla asString , '\\'
, selector , '\'
, ' "this window spec was automatically generated by the ST/X MenuEditor"\\'
, ' "do not manually edit this - the builder may not be able to\'
, ' handle the specification if its corrupted."\\'
, ' "\'
, ' MenuEditor new openOnClass:' , cls name , ' andSelector:#' , selector , '\'
, ' (Menu new fromLiteralArrayEncoding:(' , cls name , ' ' , selector , ')) startUp\'
, ' "\'.
code := code
, '\'
, ' <resource: #menu>\\'
, ' ^\'
, ' ', spec
, '\'
, Character excla asString
, ' '
, Character excla asString
, '\\'.
code := code withCRs.
(ReadStream on:code) fileIn.
!
doNew
self buildFrom:nil andSelector:(self painter selectorName)
!
doPickAMenu
|menu|
menu := Screen current viewFromUser.
(menu isNil or:[menu == Screen current rootView]) ifTrue:[
^ self
].
(menu isKindOf:MenuPanel) ifTrue:[
^ self painter buildFromMenu:(menu asMenu)
].
!
doTest
"open current editing menu
"
|menu value|
menu := self painter asMenu.
menu notNil ifTrue:[
menu receiver:nil.
value := menu startUp.
Transcript showCR:'result from test: ', value printString
]
! !
!MenuEditor methodsFor:'values'!
helpTool
|tool|
(tool := builder bindingAt:#helpTool) isNil ifTrue:[
tool := UIHelpTool new.
tool masterApplication:self.
builder aspectAt:#helpTool put:tool
].
^ tool
!
painter
"automatically generated by UIPainter ..."
|painter|
(painter := builder bindingAt:#painter) isNil ifTrue:[
painter := Painter new.
painter action:[:dummy| self menuChanged ].
builder aspectAt:#painter put:painter.
].
^ painter
! !
!MenuEditor::Item class methodsFor:'documentation'!
documentation
"
implements the contents assigned to a HierarchyNode. An instance
is associated with one item and keeps all its information
[see also:]
HierarchyNode
MenuEditor
[author:]
Claus Atzkern
"
! !
!MenuEditor::Item methodsFor:'accessing'!
label
"return the value of the instance variable 'label' (automatically generated)"
^ label!
label:something
"set the value of the instance variable 'label' (automatically generated)"
label := something.! !
!MenuEditor::Item methodsFor:'conversion'!
asMenuItem
"converts self to a menu item
"
|item rcv|
item := MenuItem labeled:(label ? '-').
self isSeperator ifFalse:[
item activeHelpKey:activeHelpKey.
item enabled:enabled.
item accessCharacterPosition:accessCharaterPos.
item nameKey:nameKey.
item shortcutKeyCharacter:shortcutKey.
item value:value.
item indication:indication.
icon notNil ifTrue:[
rcv := ResourceRetriever new.
rcv className:retriever.
rcv selector:icon.
iconAndLabel == true ifTrue:[
rcv labelText:label
].
item labelImage:rcv
]
].
^ item.
!
buildFromAspects:aspects
|name|
self isSeperator ifFalse:[
name := label.
label := (aspects at:#label) value.
self isSeperator ifTrue:[
(aspects at:#label) value:(label := name)
].
activeHelpKey := (aspects at:#activeHelpKey) value.
enabled := (aspects at:#enabled) value.
value := (aspects at:#value) value.
nameKey := (aspects at:#nameKey) value.
indication := (aspects at:#indication) value.
shortcutKey := (aspects at:#shortcutKey) value.
accessCharaterPos := (aspects at:#accessCharaterPos) value.
retriever := (aspects at:#retriever) value.
icon := (aspects at:#icon) value.
iconAndLabel := (aspects at:#iconAndLabel) value.
] ifTrue:[
(aspects at:#doubleSeperator) value ifTrue:[label := '=']
ifFalse:[label := nil].
]
!
buildFromMenuItem:anItem
|rtv|
label := anItem label.
activeHelpKey := anItem activeHelpKey.
(enabled := anItem enabled) isSymbol ifFalse:[
enabled := nil
].
(value := anItem value) isSymbol ifFalse:[
value := nil.
].
(indication := anItem indication) isSymbol ifFalse:[
indication := nil
].
nameKey := anItem nameKey.
shortcutKey := anItem shortcutKeyCharacter.
accessCharaterPos := anItem accessCharacterPosition.
( ((rtv := anItem adornment) notNil)
and:[(rtv := rtv labelImage) isKindOf:ResourceRetriever]
) ifTrue:[
retriever := rtv className.
icon := rtv selector.
(iconAndLabel := rtv labelText notNil) ifTrue:[
label := rtv labelText.
]
]
!
toAspects:aspects
self isSeperator ifTrue:[
(aspects at:#doubleSeperator) value:(label notNil).
] ifFalse:[
(aspects at:#label) value:label.
(aspects at:#activeHelpKey) value:activeHelpKey.
(aspects at:#enabled) value:enabled.
(aspects at:#value) value:value.
(aspects at:#nameKey) value:nameKey.
(aspects at:#indication) value:indication.
(aspects at:#shortcutKey) value:shortcutKey.
(aspects at:#accessCharaterPos) value:accessCharaterPos.
(aspects at:#retriever) value:retriever.
(aspects at:#icon) value:icon.
(aspects at:#iconAndLabel) value:iconAndLabel.
]
! !
!MenuEditor::Item methodsFor:'queries'!
isSeperator
|c|
label size > 1 ifTrue:[^ false].
label size == 1 ifTrue:[
(c := label first) == $= ifTrue:[
^ true
].
c == $- ifFalse:[
^ false
].
].
label := nil.
^ true
!
isSimpleSeperator
^ label isNil
! !
!MenuEditor::Painter class methodsFor:'defaults'!
defaultMenuMessage
"This message is the default yo be sent to the menuHolder to get a menu
"
^ #menu
! !
!MenuEditor::Painter class methodsFor:'documentation'!
documentation
"
menu selection list
[see also:]
SelectionInTreeView
SelectionInHierarchy
HierarchyNode
[author:]
Claus Atzkern
"
! !
!MenuEditor::Painter methodsFor:'accessing'!
root
^ listOfNodes first
!
selectorName
^ (listOfNodes first contents label) asSymbol
! !
!MenuEditor::Painter methodsFor:'building'!
buildFrom:aClass andSelector:aSelector
|spec cls menu node|
(aClass notNil and:[aSelector notNil]) ifTrue:[
aClass isBehavior ifFalse:[cls := Smalltalk at:aClass asSymbol]
ifTrue:[cls := aClass].
(cls respondsTo:aSelector) ifTrue:[
spec := cls perform:aSelector
]
].
spec isNil ifFalse:[
menu := Menu new fromLiteralArrayEncoding:spec.
node := self nodeLabel:(aSelector asString) level:1.
self subMenu:menu parent:node.
] ifTrue:[
aSelector notNil ifTrue:[cls := aSelector asString]
ifFalse:[cls := 'menu'].
node := self nodeLabel:cls level:1.
].
node hasChildren ifFalse:[
node addChild:(self nodeLabel:'undefined' level:1)
].
model root:node.
model setHideToChildren:true startingAt:node.
!
buildFromMenu:aMenu
|spec cls node|
node := self nodeLabel:'menu' level:1.
self subMenu:aMenu parent:node.
node hasChildren ifFalse:[
node addChild:(self nodeLabel:'undefined' level:1)
].
model root:node.
model setHideToChildren:true startingAt:node.
!
item:anItem level:aLevel
|level node submenu grp ctr sep|
node := self nodeLabel:(anItem label) level:aLevel.
node contents buildFromMenuItem:anItem.
node name:(node contents label).
node hide:true.
self subMenu:(anItem submenu) parent:node.
^ node.
!
subMenu:aMenu parent:aParent
|lvl grp sep|
aMenu isNil ifFalse:[
lvl := (aParent level) + 1.
grp := aMenu groupSizes.
aMenu itemsDo:[:i| aParent addChild:(self item:i level:lvl)].
grp notNil ifTrue:[
sep := self nodeLabel:nil level:lvl.
lvl := 0.
grp do:[:i|
lvl := lvl + i + 1.
aParent addChildAndSubChildren:sep at:lvl
]
]
]
! !
!MenuEditor::Painter methodsFor:'conversion'!
asMenu
|menu root|
root := self root.
root hasChildren ifTrue:[
menu := Menu new.
root children do:[:aChild| menu addItem:(self asMenuItem:aChild)].
].
^ menu
!
asMenuItem:aNode
|menu item|
item := aNode contents asMenuItem.
aNode hasChildren ifTrue:[
menu := Menu new.
aNode children do:[:aChild| menu addItem:(self asMenuItem:aChild)].
item submenu:menu
].
^ item
! !
!MenuEditor::Painter methodsFor:'drawing basics'!
drawLabelIndex:anIndex atX:x y:yCenter
"draw text label assigned to a node at x y( center)
"
|y w item|
item := (listOfNodes at:anIndex) contents.
item isSeperator ifFalse:[
^ super drawLabelIndex:anIndex atX:x y:yCenter
].
self displayLineFromX:x y:yCenter toX:(x + 80) y:yCenter.
item isSimpleSeperator ifFalse:[
self displayLineFromX:x y:(yCenter + 2) toX:(x + 80) y:(yCenter + 2).
]
! !
!MenuEditor::Painter methodsFor:'initialization'!
initialize
super initialize.
super model:(SelectionInHierarchy new).
! !
!MenuEditor::Painter methodsFor:'menus'!
doCopy
CopyBuffer := listOfNodes at:selection.
!
doCreateItem
self addNode:(self nodeLabel:'undefined' level:1)
!
doCreateMenu
|node|
node := self nodeLabel:'undefined' level:1.
node addChild:(self nodeLabel:'undefined' level:2).
self addNode:node
!
doCreateSep
self addNode:(self nodeLabel:nil level:1)
!
doCut
self doCopy.
model removeIndex:selection.
self selection:nil.
!
doPaste
self addNode:CopyBuffer
!
menu
|menu subm|
selection isNumber ifFalse:[
^ nil
].
menu := PopUpMenu labels:#( 'copy' 'cut' 'paste' '-' 'create' )
selectors:#( #doCopy #doCut #doPaste nil #create )
receiver:self.
selection == 1 ifTrue:[
menu disable:#doCopy.
menu disable:#doCut.
].
subm := PopUpMenu labels:#( 'menu' 'item' 'seperator' )
selectors:#( #doCreateMenu #doCreateItem #doCreateSep )
receiver:self.
menu subMenuAt:#create put:subm.
^ menu.
! !
!MenuEditor::Painter methodsFor:'private'!
addNode:aNode
|node parent|
(aNode notNil and:[(node := self selectedNode) notNil]) ifFalse:[
^ self
].
(node isCollapsable or:[node parent isNil]) ifTrue:[
model addChildAndSubChildren:aNode below:node at:1
] ifFalse:[
model addChildAndSubChildren:aNode below:(node parent) after:node
]
!
nodeLabel:aLabel level:aLevel
|node|
node := HierarchyNode new.
node childCollectionClass:OrderedCollection.
node name:aLabel.
node level:aLevel.
node contents:(MenuEditor::Item new label:aLabel).
^ node
! !
!MenuEditor::Painter methodsFor:'selection'!
selectedNodeChanged
|node name|
(node := self selectedNode) isNil ifTrue:[^ self].
name := node contents label.
list at:selection put:name.
node name:name.
self redrawLine:selection.
! !
!MenuEditor class methodsFor:'documentation'!
version
^ '$Header$'
! !