diff -r 7d495c01a8a6 -r 6ce84c1270a6 MenuEditor.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MenuEditor.st Thu Jul 03 10:34:03 1997 +0200 @@ -0,0 +1,1727 @@ +" + 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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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" + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + , '\' + , ' \\' + , ' ^\' + , ' ', 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$' +! !