MenuView.st
author claus
Fri, 12 Aug 1994 01:48:09 +0200
changeset 45 e900c30938c8
parent 38 4b9b70b2cc87
child 59 450ce95a72a4
permissions -rw-r--r--
*** empty log message ***

"
 COPYRIGHT (c) 1989 by 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.
"

SelectionInListView subclass:#MenuView
       instanceVariableNames:'selectors args receiver enableFlags
                              disabledFgColor onOffFlags subMenus
                              subMenuShown superMenu checkColor
                              lineLevel lineInset'
       classVariableNames:''
       poolDictionaries:''
       category:'Views-Menus'
!

MenuView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.9 1994-08-11 23:47:51 claus Exp $
'!

!MenuView class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by 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.
"
!

version
"
$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.9 1994-08-11 23:47:51 claus Exp $
"
!

documentation
"
    a menu view used for both pull-down-menus and pop-up-menus
    the action to be performed can be defined either as:

    1) action:aBlockWithOneArg
       which defines a block to be called with the line number (1..n)
       of the selected line.

    2) selectors:selectorArray [args: argarray] receiver:anObject
       which defines the messages to be sent to receiver for each
       line.

    It is also possible to define both actionBlock and selectorArray.

    menu entries starting with '\c' are check-entries.
    menu entries conisting of '-' alone, are separating lines.

    Examples:
        Notice: normally, menuviews are wrapped into either a popup-
        menu or pulldown-menu. But they can also be used stand-alone
        as in:

        |m|
        m := MenuView
                labels:#('foo'
                         'bar'
                         'baz')
                selectors:#(
                            #foo
                            #bar
                            #baz)
                receiver:nil.
        m open
"
! !

!MenuView class methodsFor:'initialization'!

initialize
    "setup some defaults - these are usually redefined during startup."

    super initialize.
    DefaultFont := Font family:'helvetica' face:'bold' style:'roman' size:12
! !

!MenuView class methodsFor:'instance creation'!

labels:labels selectors:selArray args:argArray receiver:anObject in:aView
    "create and return a new MenuView in aView
     - receiverObject gets message from selectorArray with argument
       from argArray"

    ^ (self in:aView) labels:labels 
                   selectors:selArray
                        args:argArray
                    receiver:anObject
!

labels:labels selectors:selArray receiver:anObject in:aView
    "create and return a new MenuView in aView
     - receiverObject gets message from selectorArray without argument"

    ^ (self in:aView) labels:labels
                   selectors:selArray
                        args:nil
                    receiver:anObject
!

labels:labels selector:aSelector args:argArray receiver:anObject in:aTopMenu
    "create and return a new MenuView
     - receiverObject gets message aSelector with argument from
       argArray for all entries"

    ^ (self in:aTopMenu) labels:labels
                      selectors:aSelector
                           args:argArray
                       receiver:anObject
!

labels:labels selector:aSelector args:argArray receiver:anObject for:aTopMenu
    "create and return a new MenuView
     - receiverObject gets message aSelector with argument from
       argArray for all entries"

    ^ (self in:(aTopMenu superView)) labels:labels
                                  selectors:aSelector
                                       args:argArray
                                   receiver:anObject
!

labels:labels selectors:selArray args:argArray receiver:anObject for:aTopMenu
    ^ (self in:(aTopMenu superView)) labels:labels
                                  selectors:selArray
                                       args:argArray
                                   receiver:anObject
!

labels:labels selectors:selArray receiver:anObject for:aTopMenu
    ^ (self in:(aTopMenu superView)) labels:labels
                                  selectors:selArray
                                       args:nil
                                   receiver:anObject
!

labels:labels selectors:selArray receiver:anObject
    "create and return a new MenuView. The parent view
     should be set later."

    ^ (self new) labels:labels
                   selectors:selArray
                        args:nil
                    receiver:anObject
!

labels:labels selectors:selArray
    "create and return a new MenuView. The parent veiw
     and receiver should be set later."

    ^ (self new) labels:labels
                   selectors:selArray
                        args:nil
                    receiver:nil 
!

labels:labels
    "create and return a new MenuView. The parent view,
     selectors and receiver should be set later."

    ^ (self new) labels:labels
                   selectors:nil
                        args:nil
                    receiver:nil 
! !

!MenuView methodsFor:'initialization'!

initialize
    super initialize.

    disabledFgColor := Color darkGrey.
    ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
        borderWidth := 1.
        self level:1
    ]
!

reinitialize
    "this is called right after snapIn;
     a kind of kludge - reset cursor"

    super reinitialize.
    selection := nil. "self selection:nil."
    self cursor:Cursor hand
!

initStyle
    super initStyle.

    checkColor := fgColor.
    (style == #normal) ifTrue:[
        lineLevel := 0
    ] ifFalse:[
        lineLevel := -1.
        "the inset on each side"
        style == #motif ifTrue:[
            lineInset := 0
        ] ifFalse:[
            lineInset := (device horizontalPixelPerMillimeter * 0.8) rounded.
        ]
    ].
    (style == #iris) ifTrue:[
        device hasGreyscales ifTrue:[
            hilightFgColor := fgColor.
            hilightBgColor := White "bgColor".
            hilightLevel := 1 "2".
            lineSpacing := 3
        ].
        device hasColors ifTrue:[
            checkColor := Color red.
        ].
    ].
    (style == #motif) ifTrue:[
        hilightFgColor := fgColor.
        hilightBgColor := bgColor.
        hilightLevel := 2.
        lineSpacing := (2 * hilightLevel)
    ].
    style == #openwin ifTrue:[
        "add some space for rounded-hilight area"
        self leftMargin:10.
        lineLevel := 1.
    ].
    (style == #st80) ifTrue:[
        viewBackground := White.
        fgColor := Black.
        bgColor := White.
        level := 0.
        lineLevel := 0.
        lineInset := 0
    ].
!

initEvents
    super initEvents.
    self enableLeaveEvents.
    self enableButtonMotionEvents
!

create
    super create.
    subMenuShown := nil.
    self recomputeSize
!

recreate
    super recreate.
    style == #openwin ifTrue:[
        self leftMargin:10.
    ].
    self recomputeSize
! !

!MenuView methodsFor:'accessing'!

superMenu:aMenu
    "set the menu I am contained in 
     - need this to hide main menus when a submenu performed its action"

    superMenu := aMenu
!

superMenu
    "ret the menu I am contained in 
     - need this to hide main menus when a submenu performed its action"

    ^ superMenu
!

subMenuShown
    "return the currently visible submenu - or nil if there is none"

    ^ subMenuShown
!

labels
    "return the menu-labels"

    ^ list
!

labels:text
    "set the labels to the argument, text"

    (text isString) ifTrue:[
        self list:(text asText)
    ] ifFalse:[
        self list:text
    ].
    enableFlags := Array new:(list size) withAll:true.
    self recomputeSize
!

labelAt:indexOrName put:aString
    "change the label at index to be aString"

    |i|

    i := self indexOf:indexOrName.
    i == 0 ifTrue:[^ self].
    list at:i put:aString.

    "create onOff flags, if this label has a check-mark"
    (aString startsWith:'\c') ifTrue:[
        onOffFlags isNil ifTrue:[
            onOffFlags := Array new:(list size) withAll:false
        ] ifFalse:[
            [onOffFlags size < list size] whileTrue:[
                onOffFlags := onOffFlags copyWith:false
            ]
        ].
        onOffFlags at:i put:false
    ].
    self recomputeSize
!

font:aFont
    "adjust size for new font"

    super font:(aFont on:device).
    self recomputeSize
!

addLabel:aLabel selector:aSelector
    "add another label/selector pair"

    list isNil ifTrue:[
        list := Array with:aLabel
    ] ifFalse:[
        list := list copyWith:aLabel
    ].
    selectors := selectors copyWith:aSelector.
    enableFlags := enableFlags copyWith:true.
    self recomputeSize
!

addLabel:aLabel selector:aSelector arg:anArg
    "add another label/selector/argument trio"

    list isNil ifTrue:[
        list := Array with:aLabel
    ] ifFalse:[
        list := list copyWith:aLabel
    ].
    selectors := selectors copyWith:aSelector.
    args := args copyWith:anArg.
    enableFlags := enableFlags copyWith:true.
    self recomputeSize
!

addLabel:aLabel selector:aSelector after:aLabelOrSelectorOrNumber 
    "insert another label/selector pair at some place.
     Being very friendly here, allowing label-string, selector or numeric
     index for the argument aLabelOrSelectorOrNumber"

    |idx|

    list isNil ifTrue:[
        ^ self addLabel:aLabel selector:aSelector
    ].
    "
     be user friendly - allow both label or selector
     to be passed
    "
    aLabelOrSelectorOrNumber isInteger ifTrue:[
        idx := aLabelOrSelectorOrNumber
    ] ifFalse:[
        idx := list indexOf:aLabelOrSelectorOrNumber ifAbsent:[selectors indexOf:aLabelOrSelectorOrNumber].
    ].
    (idx between:1 and:list size) ifFalse:[
        "add to end"
        ^ self addLabel:aLabel selector:aSelector
    ].

    list := list asOrderedCollection add:aLabel beforeIndex:(idx + 1).
    selectors := selectors asOrderedCollection add:aSelector beforeIndex:(idx + 1).
    enableFlags := enableFlags asOrderedCollection add:true beforeIndex:(idx + 1).
    subMenus notNil ifTrue:[
        subMenus := subMenus asOrderedCollection add:nil beforeIndex:(idx + 1).
    ].
    args notNil ifTrue:[
        args := args asOrderedCollection add:nil beforeIndex:(idx + 1).
    ].
    self recomputeSize

    "
     |v|
     CodeView new realize.
     v := CodeView new realize.
     v middleButtonMenu menuView addLabel:'new entry' selector:#foo after:'paste'.
    "
!

remove:indexOrName
    "remove the label at index"

    |i|

    i := self indexOf:indexOrName.
    i == 0 ifTrue:[^ self].
    list := list asOrderedCollection removeIndex:i.
    selectors := selectors asOrderedCollection removeIndex:i.
    enableFlags := enableFlags asOrderedCollection removeIndex:i.
    subMenus notNil ifTrue:[
        subMenus := subMenus asOrderedCollection removeIndex:i.
    ].
    self recomputeSize
!

indexOf:indexOrName
    "return the index of the label named:aName or , if its a symbol
     the index in the selector list"

    (indexOrName isMemberOf:Symbol) ifTrue:[
        ^ selectors indexOf:indexOrName
    ].
    (indexOrName isString) ifTrue:[
        ^ list indexOf:indexOrName
    ].
    ^ indexOrName
!

disable:indexOrName
    "disable an entry"

    |index|

    index := self indexOf:indexOrName.
    index ~~ 0 ifTrue:[
        (enableFlags at:index) ifTrue:[
            enableFlags at:index put:false.
            shown ifTrue:[
                self redrawLine:index
            ]
        ]
    ] ifFalse:[
        "try submenus for convenience"
        (indexOrName isNumber not and:[subMenus notNil]) ifTrue:[
            subMenus do:[:m |
                m notNil ifTrue:[
                    m disable:indexOrName
                ]
            ]
        ]
    ]
!

enable:indexOrName
    "enable an entry"

    |index|

    index := self indexOf:indexOrName.
    index ~~ 0 ifTrue:[
        (enableFlags at:index) ifFalse:[
            enableFlags at:index put:true.
            shown ifTrue:[
                self redrawLine:index
            ]
        ]
    ] ifFalse:[
        "try submenus for convenience"
        (indexOrName isNumber not and:[subMenus notNil]) ifTrue:[
            subMenus do:[:m |
                m notNil ifTrue:[
                    m enable:indexOrName
                ]
            ]
        ]
    ]
!

receiver
    "return the receiver of the message"

    ^ receiver
!

selectors
    "return the selector array"

    ^ selectors
!

selectors:anArray
    "set the selector array"

    selectors := anArray
!

selectorAt:indexOrName
    "return an individual selector"

    |i|

    i := self indexOf:indexOrName.
    i ~~ 0 ifTrue:[^ selectors at:i].
    ^ nil
!

selectorAt:indexOrName put:aSelector
    "set an individual selector"

    |i|

    i := self indexOf:indexOrName.
    i ~~ 0 ifTrue:[selectors at:i put:aSelector]
!

args
    "return the argument array"

    ^ args
!

args:anArray
    "set the argument array"

    args := anArray
!

argsAt:indexOrName put:something
    "set an individual selector"

    |i|

    i := self indexOf:indexOrName.
    i ~~ 0 ifTrue:[args at:i put:something]
!

receiver:anObject
    "set the receiver of the message"

    receiver := anObject
!

labels:text selectors:selArray args:argArray receiver:anObject
    "set all relevant stuff"

    self labels:text.
    selectors := selArray.
    args := argArray.
    receiver := anObject
!

checkToggleAt:indexOrName
    "return a check-toggles boolean state"

    |index|

    index := self indexOf:indexOrName.
    index == 0 ifTrue:[^ false].
    onOffFlags isNil ifTrue:[^ false].
    ^ onOffFlags at:index
!

checkToggleAt:indexOrName put:aBoolean
    "set/clear a check-toggle"

    |index|

    onOffFlags isNil ifTrue:[
        onOffFlags := Array new:(list size) withAll:false
    ].
    index := self indexOf:indexOrName.
    index == 0 ifTrue:[^ self].
    onOffFlags at:index put:aBoolean.
    shown ifTrue:[
        self redrawLine:index
    ]
!

subMenuAt:indexOrName
    "return a submenu, or nil"

    |i|

    subMenus isNil ifTrue:[^ nil].
    i := self indexOf:indexOrName.
    i == 0 ifTrue:[^ nil].
    ^ subMenus at:i
!

subMenuAt:indexOrName put:aPopUpMenu
    "define a submenu"

    |i|

    i := self indexOf:indexOrName.
    i == 0 ifTrue:[^ nil].
    subMenus isNil ifTrue:[
        subMenus := Array new:(list size).
        self recomputeSize
    ].
    subMenus at:i put:aPopUpMenu
! !

!MenuView methodsFor:'private'!

hideSubmenu
    subMenuShown notNil ifTrue:[
        subMenuShown hide.
        subMenuShown := nil
    ].
!

recomputeSize
    |margin2 w h|

    margin2 := margin * 2.
    w := self widthOfContents + leftMargin + leftMargin + margin2.
    h := (self numberOfLines) * fontHeight + (2 * topMargin) + margin2.
    "if there is a submenu, add some space for the right arrow"
    subMenus notNil ifTrue:[
        w := w + 16
    ].
    self extent:(w @ h).
    (font device == device) ifTrue:[
        self computeNumberOfLinesShown
    ]
!

setSelectionForX:x y:y
    |newSelection org mx my|

    (x < 0 
    or:[x >= width
    or:[y < 0
    or:[y >= height]]]) ifTrue:[
        "
         moved outside submenu, but not within self
        "
        subMenuShown notNil ifTrue:[
            ^ self
        ].
    ].

    newSelection := self positionToSelectionX:x y:y.
    newSelection ~= selection ifTrue:[
        self selection:newSelection.
        subMenuShown notNil ifTrue:[
            self hideSubmenu.
        ].
"/        windowGroup notNil ifTrue:[windowGroup sensor flushUserEvents].
        newSelection notNil ifTrue:[
            (enableFlags at:newSelection) ifFalse:[
                newSelection := nil
            ] ifTrue:[
                subMenus notNil ifTrue:[
                    subMenuShown := subMenus at:newSelection.
                    subMenuShown notNil ifTrue:[
                        "old: show at pointer"
"
                        org := device translatePoint:(x @ y)
                                                from:(self id)
                                                  to:(DisplayRootView new id).
                        org := org - 10.
"
                        "new: show at right of this menu"
                        mx := width - 5.
                        my := self yOfLine:newSelection.
                        org := device translatePoint:(mx @ my)
                                                from:(self id)
                                                  to:(DisplayRootView new id).

"/                        ActiveGrab == self ifTrue:[
"/                            device ungrabPointer.
"/                            ActiveGrab := nil
"/                        ].
windowGroup notNil ifTrue:[windowGroup processExposeEvents].
                        subMenuShown superMenu:self.
"/                        subMenuShown showAt:org.
"
 realize the submenu in MY windowgroup
"
subMenuShown windowGroup:windowGroup.
subMenuShown windowGroup addTopView:subMenuShown.
subMenuShown fixSize.
subMenuShown origin:org.
subMenuShown makeFullyVisible.
subMenuShown realize. 
device synchronizeOutput.
                        ^ self
                    ]
                ] ifFalse:[
                    subMenuShown := nil
                ]
            ]
        ].
    ]
! !

!MenuView methodsFor:'showing'!

show
    hidden := false.
    super realize
! !

!MenuView methodsFor:'redrawing'!

drawMarkInVisibleLine:visLineNr with:fg and:bg
    "draw an on-mark"

    |w h y x l check|

    l := self visibleLineToListLine:visLineNr.
    onOffFlags isNil ifTrue:[
        onOffFlags := Array new:(list size) withAll:false.
        check := false
    ] ifFalse:[
        check := onOffFlags at:l.
    ].

    w := font widthOf:'\c'.
    h := font ascent.

    x := (self xOfCol:1 inLine:visLineNr) - leftOffset.
    y := self yOfLine:visLineNr.

    self paint:bg.
    self fillRectangleX:x y:y width:w height:fontHeight.
    self paint:fg.
    check ifTrue:[
        self paint:checkColor.
        self displayLineFromX:x 
                            y:(y + (h // 2))
                          toX:(x + (w // 3))
                            y:(y + h - 1).

        self displayLineFromX:(x + (w // 3)) 
                            y:(y + h - 1)
                          toX:(x + w - 1)
                            y:y
    ]
!

drawVisibleLine:visLineNr with:fg and:bg
    |line isSpecial special|

    line := self visibleAt:visLineNr.

    isSpecial := false.

    ((line at:1) == $\) ifTrue:[
        special := line at:2.
        (special == $c) ifTrue:[
            isSpecial := true
        ]
    ].
    isSpecial ifFalse:[
        super drawVisibleLine:visLineNr with:fg and:bg
    ] ifTrue:[
        super drawVisibleLine:visLineNr "from:3" with:fg and:bg.
        self drawMarkInVisibleLine:visLineNr with:fg and:bg
    ]
!

drawVisibleLineSelected:visLineNr
    "redraw a single line as selected."

    |listLine fg bg
     y "{ Class: SmallInteger }" 
     y2 "{ Class: SmallInteger }" 
     r2 radius topLeftColor botRightColor |

    style ~~ #openwin ifTrue:[
        ^ super drawVisibleLineSelected:visLineNr.
    ].
    "
     openwin draws selections in a menu as (edged) rounded rectangles
    "

    bg := hilightBgColor.
    fg := hilightFgColor.
    listLine := self visibleLineToListLine:visLineNr.
    listLine notNil ifTrue:[

        self drawVisibleLine:visLineNr with:fg and:bg.
        y := self yOfLine:visLineNr.
        y2 := y + fontHeight - 1.
        r2 := font height.
        radius := r2 // 2.

        "
         refill with normal bg, where arcs will be drawn below
        "
        self paint:bgColor.
        self fillRectangleX:margin y:y width:radius height:fontHeight.
        self fillRectangleX:width-radius-margin y:y width:radius height:fontHeight.

        "
         fill the arcs
        "
        self paint:hilightBgColor.
        self fillArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:180. 
        self fillArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:180. 

        "
         a highlight-border around
        "
        hilightFrameColor notNil ifTrue:[
            self paint:hilightFrameColor.
            self displayLineFromX:radius+2 y:y toX:width-radius-3 y:y.
            self displayLineFromX:radius+2 y:y2 toX:width-radius-3 y:y2.

            self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:180. 
            self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:180. 
            ^ self
        ].

        "
         an edge around
        "
        (hilightLevel ~~ 0) ifTrue:[
            (hilightLevel < 0) ifTrue:[
                topLeftColor := shadowColor.
                botRightColor := lightColor.
            ] ifFalse:[
                topLeftColor := lightColor.
                botRightColor := shadowColor.
            ].

            self paint:topLeftColor.
            self displayLineFromX:radius+2 y:y toX:width-radius-3 y:y.

            self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:125. 
            self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270+125 angle:55. 

            self paint:botRightColor.

            self displayLineFromX:radius+2 y:y2 toX:width-radius-3 y:y2.
            self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90+125 angle:55. 
            self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:125. 
            ^ self
        ]
    ].
    ^ super drawVisibleLine:visLineNr with:fg and:bg
!

redrawVisibleLine:visLine col:col
    self redrawVisibleLine:visLine
!

redrawVisibleLine:visLine from:startCol
    self redrawVisibleLine:visLine
!

redrawVisibleLine:visLine from:startCol to:endCol
    self redrawVisibleLine:visLine
!

redrawVisibleLine:visLineNr
    |line lineNr y isSpecial isSeparatingLine right clr1 clr2|

    line := self visibleAt:visLineNr.

    isSpecial := false.
    (line = '-') ifTrue:[
        isSeparatingLine := true.
        isSpecial := true
    ] ifFalse:[
        (line = '') ifTrue:[
            isSeparatingLine := false.
            isSpecial := true
        ]
    ].
    isSpecial ifFalse:[
        lineNr := self visibleLineToListLine:visLineNr.
        (enableFlags at:lineNr) ifFalse:[
            self drawVisibleLine:visLineNr with:disabledFgColor and:bgColor
        ] ifTrue:[
            super redrawVisibleLine:visLineNr
        ].
        "is there a submenu ?"
        (subMenus notNil and:[(subMenus at:lineNr) notNil]) ifTrue:[
            self drawRightArrowInVisibleLine:visLineNr
        ].
        ^ self
    ].

    "handle separating lines"

    y := self yOfLine:visLineNr.

    self paint:bgColor.
    self fillRectangleX:0 y:y width:width height:fontHeight.

    isSeparatingLine ifTrue:[
        y := y + (fontHeight // 2).
        lineLevel == 0 ifTrue:[
            self paint:fgColor.
            self displayLineFromX:0 y:y toX:width y:y
        ] ifFalse:[
            "the inset on each side"

            lineLevel < 0 ifTrue:[
                clr1 := shadowColor.
                clr2 := lightColor.
            ] ifFalse:[
                clr1 := lightColor.
                clr2 := shadowColor.
            ].
            self paint:clr1.
            right := width - 1 - lineInset.
            self displayLineFromX:lineInset y:y toX:right y:y.
            self paint:clr2.
            y := y + 1.
            self displayLineFromX:lineInset y:y toX:right y:y
        ]
    ]
!

redrawFromVisibleLine:start to:stop
    "redraw a line range"

    "the natural way to do it is:

    start to:stop do:[:visLine |
        self redrawVisibleLine:visLine
    ]

    but I want to draw the stuff in big chunks for slow machines ..."

    |first current line special index|

    first := start.
    current := start.
    index := self visibleLineToListLine:start.
    index notNil ifTrue:[
        [current <= stop] whileTrue:[
            line := self visibleAt:current.

            special := (line = '-') or:[(line = '') or:[(line at:1) == $\]].
            (special 
            or:[(enableFlags at:index) not]) ifTrue:[
                "a special case"
                (first < current) ifTrue:[
                    super redrawFromVisibleLine:first to:(current - 1)
                ].
                self redrawVisibleLine:current.
                first := current + 1
            ].
            current := current + 1.
            index := index + 1
        ].
        (first < current) ifTrue:[
            super redrawFromVisibleLine:first to:(current - 1)
        ].

        "draw submenu marks"
        subMenus notNil ifTrue:[
            index := self visibleLineToListLine:start.
            start to:stop do:[:l |
                index <= subMenus size ifTrue:[
                    (subMenus at:index) notNil ifTrue:[
                        self drawRightArrowInVisibleLine:l
                    ].
                    index := index + 1
                ]
            ]
        ]
    ]
! !

!MenuView methodsFor:'submenu actions'!

submenuTriggered
    "submenu has performed some action - have to deselect here"

    self selection:nil.
    "a bad kludge - 5 minutes before writing the alpha tapes ..."
    (superView isKindOf:PopUpMenu) ifTrue:[
        superView hide
    ].
    superMenu notNil ifTrue:[
        superMenu submenuTriggered 
    ].
!

XXregainControl
    "take over pointer control from a submenu"

    ^ self
!

showActive
    "submenu is about to perform an action - show wait cursor here as well"

    self cursor:(Cursor wait)
!

showPassive
    "submenu has performed its action - show normal cursor again"

    self cursor:(Cursor hand)
! !

!MenuView methodsFor:'event handling'!

buttonPress:button x:x y:y
    self setSelectionForX:x y:y
!

buttonMotion:state x:x y:y
    self setSelectionForX:x y:y
!

pointerLeave:state
    subMenuShown notNil ifTrue:[
        ^ self
    ].
"/    self setSelectionForX:-1 y:-1. "force deselect"
    subMenuShown isNil ifTrue:[
        self selection:nil
    ].
"/    superMenu notNil ifTrue:[
"/        superMenu regainControl.
"/    ]
!

buttonRelease:button x:x y:y
    |theSelector isCheck|

    subMenuShown notNil ifTrue:[
        ^ self
    ].

    (x >= 0 and:[x < width]) ifTrue:[
        (y >= 0 and:[y < height]) ifTrue:[
            selection notNil ifTrue:[
                (subMenus isNil or:[(subMenus at:selection) isNil]) ifTrue:[
                    self cursor:Cursor wait.
                    superMenu notNil ifTrue:[
                        superMenu showActive
                    ].
                    "
                     either action-block or selectors-array-style
                    "
                    actionBlock notNil ifTrue:[
                        Object abortSignal catch:[
                            actionBlock value:(self selection)
                        ]
                    ] ifFalse:[
                        selectors notNil ifTrue: [
                            ActiveGrab == self ifTrue:[
                                device ungrabPointer.
                                ActiveGrab := nil.
                            ].
                            (selectors isKindOf:Symbol) ifFalse:[
                                selection <= (selectors size) ifTrue:[
                                    theSelector := selectors at:selection
                                ]
                            ] ifTrue:[
                                theSelector := selectors
                            ].
                            theSelector notNil ifTrue:[
                                isCheck := false.
                                onOffFlags notNil ifTrue:[
                                    onOffFlags size >= selection ifTrue:[
                                        isCheck := (onOffFlags at:selection) notNil
                                    ]
                                ].
                                Object abortSignal catch:[
                                    isCheck ifTrue:[
                                        onOffFlags at:selection
                                                  put:(onOffFlags at:selection) not.
                                        self redrawLine:selection.
                                        receiver perform:theSelector
                                                    with:(onOffFlags at:selection)
                                    ] ifFalse:[
                                        args isNil ifTrue:[
                                            receiver perform:theSelector
                                        ] ifFalse:[
                                            receiver perform:theSelector
                                                        with:(args at:selection)
                                        ]
                                    ]
                                ]
                            ]
                        ]
                    ].
                    realized ifTrue:[
                        self cursor:Cursor hand.
                    ].
                    superMenu notNil ifTrue:[
                        superMenu showPassive
                    ].
                ].
            ]
        ]
    ]
! !