diff -r d2888811c664 -r 01f3cbb8e20e PullDownMenu.st --- a/PullDownMenu.st Thu Nov 23 11:44:18 1995 +0100 +++ b/PullDownMenu.st Thu Nov 23 15:37:40 1995 +0100 @@ -11,23 +11,17 @@ " SimpleView subclass:#PullDownMenu - instanceVariableNames:'receiver menus titles selectors activeMenuNumber - showSeparatingLines topMargin - fgColor bgColor activeFgColor activeBgColor - onLevel offLevel edgeStyle - keepMenu toggleKeep raiseTopWhenActivated' - classVariableNames:'DefaultFont - DefaultViewBackground - DefaultForegroundColor - DefaultBackgroundColor - DefaultHilightForegroundColor - DefaultHilightBackgroundColor - DefaultLevel DefaultHilightLevel - DefaultShadowColor DefaultLightColor - DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep - DefaultSeparatingLines' - poolDictionaries:'' - category:'Views-Menus' + instanceVariableNames:'receiver menus titles selectors activeMenuNumber + showSeparatingLines topMargin fgColor bgColor activeFgColor + activeBgColor onLevel offLevel edgeStyle keepMenu toggleKeep + raiseTopWhenActivated' + classVariableNames:'DefaultFont DefaultViewBackground DefaultForegroundColor + DefaultBackgroundColor DefaultHilightForegroundColor + DefaultHilightBackgroundColor DefaultLevel DefaultHilightLevel + DefaultShadowColor DefaultLightColor DefaultEdgeStyle + DefaultKeepMenu DefaultToggleKeep DefaultSeparatingLines' + poolDictionaries:'' + category:'Views-Menus' ! !PullDownMenu class methodsFor:'documentation'! @@ -46,10 +40,6 @@ " ! -version - ^ '$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.26 1995-11-11 16:22:17 cg Exp $' -! - documentation " PullDown menu provides the top (always visible) part of these menus. @@ -330,6 +320,18 @@ receiver:textView. top open " +! + +version + ^ '$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.27 1995-11-23 14:35:27 cg Exp $' +! ! + +!PullDownMenu class methodsFor:'instance creation'! + +labels:titleArray + "create and return a new PullDownMenu" + + ^ self new labels:titleArray ! ! !PullDownMenu class methodsFor:'defaults'! @@ -384,23 +386,596 @@ " ! ! -!PullDownMenu class methodsFor:'instance creation'! +!PullDownMenu methodsFor:'accessing'! + +at:aString putLabels:labels selector:selector args:args receiver:anObject + "create and set the menu under the title, aString" + + |menuView| + + menuView := MenuView labels:labels + selector:selector + args:args + receiver:anObject + for:self. + self at:aString putMenu:menuView +! + +at:aString putLabels:labels selectors:selectors args:args receiver:anObject + "create and set the menu under the title, aString" + + |menuView| + + menuView := MenuView labels:labels + selectors:selectors + args:args + receiver:anObject + for:self. + self at:aString putMenu:menuView +! + +at:aString putLabels:labels selectors:selectors receiver:anObject + "create and set the menu under the title, aString" + + |menuView| + + menuView := MenuView labels:labels + selectors:selectors + receiver:anObject + for:self. + self at:aString putMenu:menuView +! + +at:aString putMenu:aMenu + "set the menu under the title, aString" + + |index| + + index := self indexOf:aString. + (index == 0) ifTrue:[ + self error:'no such menu entry'. + ^ nil + ]. + +"/ not needed: +"/ aMenu origin:((left + (self titleLenUpTo:index)) +"/ @ +"/ (height + aMenu borderWidth)). + aMenu hiddenOnRealize:true. + menus at:index put:aMenu. + aMenu masterView:self. +! + +labels + "return the menu-titles (group-headers)" + + ^ titles +! labels:titleArray - "create and return a new PullDownMenu" + "define the menu-titles (group-headers)" + + |numberOfLabels| + + numberOfLabels := titleArray size. + menus := Array new:numberOfLabels. + titles := Array new:numberOfLabels. + + titleArray keysAndValuesDo:[:index :entry | + |e| + + entry isImage ifTrue:[ + e := entry on:device + ] ifFalse:[ + e := entry printString + ]. + titles at:index put:e + ]. + shown ifTrue:[ + self clear. + self redraw + ] +! + +labels:titleArray selectors:selectorArray + "define the menu-titles (group-headers) and selectors. + Selectors are mostly used as access keys to get to submenus later." + + self labels:titleArray. + self selectors:selectorArray + + "Created: 20.10.1995 / 20:15:54 / cg" +! + +menuAt:stringOrNumber + "return the menu with the title; return nil if not found" + + |index| + + index := self indexOf:stringOrNumber. + (index == 0) ifTrue:[^ nil]. + ^ menus at:index +! + +numberOfTitles:n + "setup blank title-space to be filled in later" + + menus := Array new:n. + titles := Array new:n +! + +receiver:anObject + "set the menu-receiver. Thats the one who gets the + messages (both from myself and from my submenus). + This only sets the receiver for menus which are already + created - menus added later should get their receiver in + the creation send." + + receiver := anObject. + menus notNil ifTrue:[ + menus do:[:aMenu | + aMenu notNil ifTrue:[ + aMenu receiver:anObject + ] + ] + ] +! + +selectors:selectorArray + "define the menu-selectors. These are used as accesskey only + in menuAt: accesses. This makes PullDownMenu accesss + somewhat more compatible to PopUpMenus." + + selectors := selectorArray. +! ! + +!PullDownMenu methodsFor:'accessing-look'! + +backgroundColor:aColor + "set the background drawing color. + You should not use this method; instead leave the value as + defined in the styleSheet." + + bgColor := aColor on:device +! + +font:aFont + "set the menus font. + adjusts menu-origins when font changes. + You should not use this method; instead leave the value as + defined in the styleSheet." + + aFont ~~ font ifTrue:[ + super font:(aFont on:device). + self height:(font height + (font descent * 2)). + shown ifTrue:[ + self setMenuOrigins + ] + ] +! + +foregroundColor:aColor + "set the foreground drawing color. + You should not use this method; instead leave the value as + defined in the styleSheet." + + fgColor := aColor on:device +! + +showSeparatingLines:aBoolean + "turn on/off drawing of separating lines. + You should not use this method; instead leave the value as + defined in the styleSheet." + + showSeparatingLines := aBoolean. + shown ifTrue:[ + self setMenuOrigins. + self redraw + ] +! ! + +!PullDownMenu methodsFor:'drawing '! + +drawActiveTitleSelected:selected + |x| + activeMenuNumber notNil ifTrue:[ + x := self titleLenUpTo:activeMenuNumber. + self drawTitle:(titles at:activeMenuNumber) x:x selected:selected + ] +! + +drawTitle:stringOrImage x:x0 selected:selected + |y w x wSpace fg bg map| + + selected ifTrue:[ + fg := activeFgColor. + bg := activeBgColor + ] ifFalse:[ + fg := fgColor. + bg := bgColor + ]. + + wSpace := font widthOf:' '. + x := x0. + stringOrImage isString ifTrue:[ + y := ((height - (font height)) // 2) + (font ascent) "+ topMargin". + w := font widthOf:stringOrImage. + ] ifFalse:[ + y := ((height - stringOrImage height) // 2) max:0. + w := stringOrImage width + ]. + w := w + (wSpace * 2). + + self paint:bg. + self fillRectangleX:x y:0 width:w height:height. + + self is3D ifTrue:[ + self drawEdgesForX:x y:0 + width:w + height:height + level:(selected ifTrue:[onLevel] ifFalse:[offLevel]) + ]. + self paint:fg. + x := x + wSpace. + stringOrImage isString ifTrue:[ + self displayString:stringOrImage x:x y:y + ] ifFalse:[ + stringOrImage isImageOrForm ifTrue:[ + stringOrImage depth == 1 ifTrue:[ + (map := stringOrImage colorMap) notNil ifTrue:[ + self paint:(map at:2) on:(map at:1). + self displayOpaqueForm:stringOrImage x:x y:y. + ^ self + ] + ]. + self displayForm:stringOrImage x:x y:y + ] ifFalse:[ + stringOrImage displayOn:self x:x y:y + ] + ] + + "Modified: 20.10.1995 / 22:03:27 / cg" +! + +highlightActiveTitle + self drawActiveTitleSelected:true +! + +redraw + |x "{ Class: SmallInteger }" + y "{ Class: SmallInteger }" + index "{ Class: SmallInteger }" + wSpace clr| + + shown ifFalse: [ ^ self ]. + titles isNil ifTrue:[^ self]. + + wSpace := (font widthOf:' '). + x := 0. + y := height "- 1". + index := 1. + titles do:[:title | + self drawTitle:title x:x selected:(index == activeMenuNumber). + + title isString ifTrue:[ + x := x + (font widthOf:title). + ] ifFalse:[ + x := x + title width + ]. + x := x + wSpace + wSpace. + showSeparatingLines ifTrue:[ + self is3D ifTrue:[ + self paint:shadowColor. + self displayLineFromX:x y:0 toX:x y:y. + x := x + 1. + clr := lightColor. + ] ifFalse:[ + clr := fgColor. + ]. + self paint:clr. + self displayLineFromX:x y:0 toX:x y:y. + x := x + 1 + ]. + index := index + 1 + ] +! + +unHighlightActiveTitle + self drawActiveTitleSelected:false +! ! + +!PullDownMenu methodsFor:'event handling'! + +buttonMotion:state x:x y:y + |titleIndex activeMenu activeLeft activeTop| + + state == 0 ifTrue:[^ self]. + + activeMenuNumber notNil ifTrue:[ + activeMenu := menus at:activeMenuNumber. + ]. - ^ self new labels:titleArray + (y < height) ifTrue:[ + "moving around in title line" + activeMenu notNil ifTrue:[ + activeMenu selection:nil + ]. + titleIndex := self titleIndexForX:x. + titleIndex notNil ifTrue:[ + (titleIndex ~~ activeMenuNumber) ifTrue:[ + self pullMenu:titleIndex + ] + ] ifFalse:[ + self hideActiveMenu + ] + ] ifFalse:[ + "moving around below" + activeMenu isNil ifTrue:[^self]. + activeLeft := activeMenu left. + (x between:activeLeft and:(activeMenu right)) ifTrue:[ + activeTop := activeMenu top. + (y between:activeTop and:(activeMenu bottom)) ifTrue:[ + "moving around in menu" + activeMenu buttonMotion:state + x:(x - activeLeft) + y:(y - activeTop). + ^ self + ] + ]. + "moved outside menu" + activeMenu selection:nil + ] +! + +buttonPress:button x:x y:y + |titleIndex activeMenu activeLeft activeTop m| + + device ungrabPointer. + + (y between:0 and:height) ifTrue:[ + titleIndex := self titleIndexForX:x. + ]. + + " + now, titleIndex is non-nil if pressed within myself + " + (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[ + m := self pullMenu:titleIndex. + (keepMenu and:[m notNil]) ifTrue:[ + device grabPointerInView:self. + self cursor:Cursor upRightArrow + ] + ] ifFalse:[ + (keepMenu and:[toggleKeep not]) ifTrue:[ + titleIndex == activeMenuNumber ifTrue:[ + "same pressed again ... stay" + device grabPointerInView:self. + ^ self + ]. + "moving around below" + activeMenuNumber isNil ifTrue:[^self]. + activeMenu := menus at:activeMenuNumber. + activeLeft := activeMenu left. + (x between:activeLeft and:(activeMenu right)) ifTrue:[ + activeTop := activeMenu top. + (y between:activeTop and:(activeMenu bottom)) ifTrue:[ + "moving around in menu" + activeMenu buttonPress:button + x:(x - activeLeft) + y:(y - activeTop). + ^ self + ] + ]. + ]. + self hideActiveMenu + ] +! + +buttonRelease:button x:x y:y + |activeMenu activeLeft activeTop hideMenu sel| + + activeMenuNumber isNil ifTrue:[^self]. + activeMenu := menus at:activeMenuNumber. + + hideMenu := false. + (y >= height) ifTrue:[ + "release below title-line" + activeLeft := activeMenu left. + " + released in a submenu ? + " + (x between:activeLeft and:(activeMenu right)) ifTrue:[ + activeTop := activeMenu top. + (y between:activeTop and:(activeMenu bottom)) ifTrue:[ + "release in menu" + self hideActiveMenu. + activeMenu buttonRelease:button + x:(x - activeLeft) + y:(y - activeTop). + ^ self + ] + ]. + hideMenu := true. + ] ifFalse:[ + y < 0 ifTrue:[ + hideMenu := true + ] ifFalse:[ + activeMenu isNil ifTrue:[ + selectors notNil ifTrue:[ + sel := selectors at:activeMenuNumber. + sel notNil ifTrue:[ + receiver perform:sel + ]. + ]. + hideMenu := true. + ] ifFalse:[ + keepMenu ifFalse:[ + hideMenu := true + ] + ] + ] + ]. + hideMenu ifTrue:[ + self hideActiveMenu. + ] +! + +keyPress:key x:x y:y + + + |index m sel| + + " + handle CursorLeft/Right for non-mouse operation + (for example, if it has the explicit focus) + These will pull the previous/next menu + " + ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[ + activeMenuNumber isNil ifTrue:[ + index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size]. + ] ifFalse:[ + (key == #CursorRight) ifTrue:[ + index := activeMenuNumber+1 + ] ifFalse:[ + index := activeMenuNumber-1 + ]. + index == 0 ifTrue:[index := menus size] + ifFalse:[ + index > menus size ifTrue:[index := 1] + ] + ]. + self pullMenu:index. + ^ self + ]. + + activeMenuNumber isNil ifTrue:[^self]. + + " + Return, space or the (virtual) MenuSelect key trigger + a menu entry (for non-submenu entries). + Otherwise, if we have a submenu open, + pass the key on to it ... + " + m := menus at:activeMenuNumber. + m isNil ifTrue:[ + (key == #Return + or:[key == #MenuSelect + or:[key == Character space]]) ifTrue:[ + sel := selectors at:activeMenuNumber. + sel notNil ifTrue:[ + receiver perform:sel + ] + ]. + ] ifFalse:[ + m keyPress:key x:0 y:0. + ]. +! + +showNoFocus + "when stepping focus, hide any active menu" + + self hideActiveMenu. + super showNoFocus +! ! + +!PullDownMenu methodsFor:'hiding/showing menus'! + +hideActiveMenu + "hide currently active menu - release grab if there is any grab (keepMenu)" + + ^ self hideActiveMenuRelease:true +! + +hideActiveMenuRelease:aBoolean + "hide currently active menu - release grab if aBoolean is true + and a grab was set (keepMenu)" + + |m| + + activeMenuNumber notNil ifTrue:[ + (m := menus at:activeMenuNumber) notNil ifTrue:[ + m hiddenOnRealize:true. + m unrealize. + ]. + self unHighlightActiveTitle. + activeMenuNumber := nil + ]. + aBoolean ifTrue:[ + device ungrabPointer. + self cursor:Cursor normal + ]. +! + +pullMenu:aNumber + "activate a menu, return it or nil" + + |subMenu r posY| + + activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false]. + activeMenuNumber := aNumber. + subMenu := menus at:aNumber. + + raiseTopWhenActivated ifTrue:[ + self topView raise. + ]. + + (activeMenuNumber notNil + and:[ + subMenu notNil + or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[ + self highlightActiveTitle. + ]. + + subMenu notNil ifTrue:[ + subMenu origin:((left + (self titleLenUpTo:aNumber)) + @ + (posY := height + subMenu borderWidth)). + subMenu hiddenOnRealize:false. + subMenu deselect. + subMenu create. + subMenu saveUnder:true. + subMenu superMenu:self. + + subMenu right > (r := self right) ifTrue:[ + subMenu origin:((r - subMenu width) @ posY). + ]. + subMenu raise show. + ]. + ^ subMenu +! + +regainControl + keepMenu ifTrue:[ + device grabPointerInView:self. + self cursor:Cursor upRightArrow + ] ! ! !PullDownMenu methodsFor:'initialize / release'! -initialize - super initialize. +create + super create. + self setMenuOrigins +! + +destroy + "have to destroy the menus manually here, + since they are no real subviews of myself" - font := font on:device. - self origin:(0.0 @ 0.0) - extent:(1.0 @ self preferredExtent y) -"/ extent:(1.0 @ (font height + (font descent * 2) + topMargin)). + menus notNil ifTrue:[ + menus do:[:m | + m notNil ifTrue:[m destroy] + ]. + menus := nil + ]. + activeMenuNumber := nil. + super destroy. +! + +initCursor + "set up a hand cursor" + + cursor := Cursor hand ! initStyle @@ -480,10 +1055,13 @@ raiseTopWhenActivated := styleSheet at:'pullDownMenuRaiseTop' default:true. ! -initCursor - "set up a hand cursor" +initialize + super initialize. - cursor := Cursor hand + font := font on:device. + self origin:(0.0 @ 0.0) + extent:(1.0 @ self preferredExtent y) +"/ extent:(1.0 @ (font height + (font descent * 2) + topMargin)). ! recreate @@ -501,25 +1079,6 @@ self setMenuOrigins ! -create - super create. - self setMenuOrigins -! - -destroy - "have to destroy the menus manually here, - since they are no real subviews of myself" - - menus notNil ifTrue:[ - menus do:[:m | - m notNil ifTrue:[m destroy] - ]. - menus := nil - ]. - activeMenuNumber := nil. - super destroy. -! - superView:aView "when my superView changes, all of my menus must change as well" @@ -533,240 +1092,8 @@ ] ! ! -!PullDownMenu methodsFor:'accessing-look'! - -showSeparatingLines:aBoolean - "turn on/off drawing of separating lines. - You should not use this method; instead leave the value as - defined in the styleSheet." - - showSeparatingLines := aBoolean. - shown ifTrue:[ - self setMenuOrigins. - self redraw - ] -! - -font:aFont - "set the menus font. - adjusts menu-origins when font changes. - You should not use this method; instead leave the value as - defined in the styleSheet." - - aFont ~~ font ifTrue:[ - super font:(aFont on:device). - self height:(font height + (font descent * 2)). - shown ifTrue:[ - self setMenuOrigins - ] - ] -! - -foregroundColor:aColor - "set the foreground drawing color. - You should not use this method; instead leave the value as - defined in the styleSheet." - - fgColor := aColor on:device -! - -backgroundColor:aColor - "set the background drawing color. - You should not use this method; instead leave the value as - defined in the styleSheet." - - bgColor := aColor on:device -! ! - - -!PullDownMenu methodsFor:'accessing'! - -receiver:anObject - "set the menu-receiver. Thats the one who gets the - messages (both from myself and from my submenus). - This only sets the receiver for menus which are already - created - menus added later should get their receiver in - the creation send." - - receiver := anObject. - menus notNil ifTrue:[ - menus do:[:aMenu | - aMenu notNil ifTrue:[ - aMenu receiver:anObject - ] - ] - ] -! - -numberOfTitles:n - "setup blank title-space to be filled in later" - - menus := Array new:n. - titles := Array new:n -! - -labels:titleArray - "define the menu-titles (group-headers)" - - |numberOfLabels| - - numberOfLabels := titleArray size. - menus := Array new:numberOfLabels. - titles := Array new:numberOfLabels. - - titleArray keysAndValuesDo:[:index :entry | - |e| - - entry isImage ifTrue:[ - e := entry on:device - ] ifFalse:[ - e := entry printString - ]. - titles at:index put:e - ]. - shown ifTrue:[ - self clear. - self redraw - ] -! - -labels - "return the menu-titles (group-headers)" - - ^ titles -! - -selectors:selectorArray - "define the menu-selectors. These are used as accesskey only - in menuAt: accesses. This makes PullDownMenu accesss - somewhat more compatible to PopUpMenus." - - selectors := selectorArray. -! - -labels:titleArray selectors:selectorArray - "define the menu-titles (group-headers) and selectors. - Selectors are mostly used as access keys to get to submenus later." - - self labels:titleArray. - self selectors:selectorArray - - "Created: 20.10.1995 / 20:15:54 / cg" -! - -menuAt:stringOrNumber - "return the menu with the title; return nil if not found" - - |index| - - index := self indexOf:stringOrNumber. - (index == 0) ifTrue:[^ nil]. - ^ menus at:index -! - -at:aString putMenu:aMenu - "set the menu under the title, aString" - - |index| - - index := self indexOf:aString. - (index == 0) ifTrue:[ - self error:'no such menu entry'. - ^ nil - ]. - -"/ not needed: -"/ aMenu origin:((left + (self titleLenUpTo:index)) -"/ @ -"/ (height + aMenu borderWidth)). - aMenu hiddenOnRealize:true. - menus at:index put:aMenu. - aMenu masterView:self. -! - -at:aString putLabels:labels selectors:selectors args:args receiver:anObject - "create and set the menu under the title, aString" - - |menuView| - - menuView := MenuView labels:labels - selectors:selectors - args:args - receiver:anObject - for:self. - self at:aString putMenu:menuView -! - -at:aString putLabels:labels selector:selector args:args receiver:anObject - "create and set the menu under the title, aString" - - |menuView| - - menuView := MenuView labels:labels - selector:selector - args:args - receiver:anObject - for:self. - self at:aString putMenu:menuView -! - -at:aString putLabels:labels selectors:selectors receiver:anObject - "create and set the menu under the title, aString" - - |menuView| - - menuView := MenuView labels:labels - selectors:selectors - receiver:anObject - for:self. - self at:aString putMenu:menuView -! ! - -!PullDownMenu methodsFor:'queries'! - -preferredExtent - |w| - - w := self titleLenUpTo:(titles size + 1). - ^ w @ (font height + (font descent * 2) "+ topMargin" + (margin*2)). -! ! - !PullDownMenu methodsFor:'private'! -titleLenUpTo:index - "answer len (in pixels) of all title-strings up-to - (but excluding) title-index. Used to compute x-position when drawing - individual entries." - - |len "{ Class: SmallInteger }" - wSpace wSep| - - (index <= 1) ifTrue:[^ 0]. - wSpace := (font widthOf:' '). - showSeparatingLines ifTrue:[ - self is3D ifTrue:[ - wSep := 2 - ] ifFalse:[ - wSep := 1 - ] - ] ifFalse:[ - wSep := 0 - ]. - - len := 0. - titles from:1 to:(index - 1) do:[:entry | - |thisLength| - - entry isString ifTrue:[ - thisLength := (font widthOf:entry). - ] ifFalse:[ - thisLength := entry width - ]. - len := len + thisLength + wSpace + wSep + wSpace. - ]. - ^ len -! - indexOf:stringOrNumber "return the index of the menu with title; return 0 if not found. stringOrNumber may be a number, a selector from the selectorArray @@ -784,6 +1111,20 @@ ^ titles indexOf:stringOrNumber ! +setMenuOrigins + "adjust origins of menus when font changes" + + (font device == device) ifTrue:[ + menus keysAndValuesDo:[:index :aMenu | + aMenu notNil ifTrue:[ + aMenu origin:((left + (self titleLenUpTo:index)) + @ + (height + aMenu borderWidth)) + ]. + ] + ] +! + someMenuItemLabeled:aLabel "find a menu item. Currently, in ST/X, instances of MenuItem are only created as dummy" @@ -808,20 +1149,6 @@ ^ nil ! -setMenuOrigins - "adjust origins of menus when font changes" - - (font device == device) ifTrue:[ - menus keysAndValuesDo:[:index :aMenu | - aMenu notNil ifTrue:[ - aMenu origin:((left + (self titleLenUpTo:index)) - @ - (height + aMenu borderWidth)) - ]. - ] - ] -! - titleIndexForX:x "given a click x-position, return index in title or nil" @@ -854,189 +1181,49 @@ xstart := xend ]. ^ nil -! ! - -!PullDownMenu methodsFor:'hiding/showing menus'! - -hideActiveMenuRelease:aBoolean - "hide currently active menu - release grab if aBoolean is true - and a grab was set (keepMenu)" - - |m| - - activeMenuNumber notNil ifTrue:[ - (m := menus at:activeMenuNumber) notNil ifTrue:[ - m hiddenOnRealize:true. - m unrealize. - ]. - self unHighlightActiveTitle. - activeMenuNumber := nil - ]. - aBoolean ifTrue:[ - device ungrabPointer. - self cursor:Cursor normal - ]. -! - -hideActiveMenu - "hide currently active menu - release grab if there is any grab (keepMenu)" - - ^ self hideActiveMenuRelease:true ! -pullMenu:aNumber - "activate a menu, return it or nil" +titleLenUpTo:index + "answer len (in pixels) of all title-strings up-to + (but excluding) title-index. Used to compute x-position when drawing + individual entries." - |subMenu r posY| + |len "{ Class: SmallInteger }" + wSpace wSep| - activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false]. - activeMenuNumber := aNumber. - subMenu := menus at:aNumber. - - raiseTopWhenActivated ifTrue:[ - self topView raise. + (index <= 1) ifTrue:[^ 0]. + wSpace := (font widthOf:' '). + showSeparatingLines ifTrue:[ + self is3D ifTrue:[ + wSep := 2 + ] ifFalse:[ + wSep := 1 + ] + ] ifFalse:[ + wSep := 0 ]. - (activeMenuNumber notNil - and:[ - subMenu notNil - or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[ - self highlightActiveTitle. - ]. + len := 0. + titles from:1 to:(index - 1) do:[:entry | + |thisLength| - subMenu notNil ifTrue:[ - subMenu origin:((left + (self titleLenUpTo:aNumber)) - @ - (posY := height + subMenu borderWidth)). - subMenu hiddenOnRealize:false. - subMenu deselect. - subMenu create. - subMenu saveUnder:true. - subMenu superMenu:self. - - subMenu right > (r := self right) ifTrue:[ - subMenu origin:((r - subMenu width) @ posY). + entry isString ifTrue:[ + thisLength := (font widthOf:entry). + ] ifFalse:[ + thisLength := entry width ]. - subMenu raise show. + len := len + thisLength + wSpace + wSep + wSpace. ]. - ^ subMenu -! - -regainControl - keepMenu ifTrue:[ - device grabPointerInView:self. - self cursor:Cursor upRightArrow - ] + ^ len ! ! -!PullDownMenu methodsFor:'drawing '! - -redraw - |x "{ Class: SmallInteger }" - y "{ Class: SmallInteger }" - index "{ Class: SmallInteger }" - wSpace clr| - - shown ifFalse: [ ^ self ]. - titles isNil ifTrue:[^ self]. - - wSpace := (font widthOf:' '). - x := 0. - y := height "- 1". - index := 1. - titles do:[:title | - self drawTitle:title x:x selected:(index == activeMenuNumber). - - title isString ifTrue:[ - x := x + (font widthOf:title). - ] ifFalse:[ - x := x + title width - ]. - x := x + wSpace + wSpace. - showSeparatingLines ifTrue:[ - self is3D ifTrue:[ - self paint:shadowColor. - self displayLineFromX:x y:0 toX:x y:y. - x := x + 1. - clr := lightColor. - ] ifFalse:[ - clr := fgColor. - ]. - self paint:clr. - self displayLineFromX:x y:0 toX:x y:y. - x := x + 1 - ]. - index := index + 1 - ] -! - -drawTitle:stringOrImage x:x0 selected:selected - |y w x wSpace fg bg map| - - selected ifTrue:[ - fg := activeFgColor. - bg := activeBgColor - ] ifFalse:[ - fg := fgColor. - bg := bgColor - ]. +!PullDownMenu methodsFor:'queries'! - wSpace := font widthOf:' '. - x := x0. - stringOrImage isString ifTrue:[ - y := ((height - (font height)) // 2) + (font ascent) "+ topMargin". - w := font widthOf:stringOrImage. - ] ifFalse:[ - y := ((height - stringOrImage height) // 2) max:0. - w := stringOrImage width - ]. - w := w + (wSpace * 2). - - self paint:bg. - self fillRectangleX:x y:0 width:w height:height. +preferredExtent + |w| - self is3D ifTrue:[ - self drawEdgesForX:x y:0 - width:w - height:height - level:(selected ifTrue:[onLevel] ifFalse:[offLevel]) - ]. - self paint:fg. - x := x + wSpace. - stringOrImage isString ifTrue:[ - self displayString:stringOrImage x:x y:y - ] ifFalse:[ - stringOrImage isImageOrForm ifTrue:[ - stringOrImage depth == 1 ifTrue:[ - (map := stringOrImage colorMap) notNil ifTrue:[ - self paint:(map at:2) on:(map at:1). - self displayOpaqueForm:stringOrImage x:x y:y. - ^ self - ] - ]. - self displayForm:stringOrImage x:x y:y - ] ifFalse:[ - stringOrImage displayOn:self x:x y:y - ] - ] - - "Modified: 20.10.1995 / 22:03:27 / cg" -! - -drawActiveTitleSelected:selected - |x| - activeMenuNumber notNil ifTrue:[ - x := self titleLenUpTo:activeMenuNumber. - self drawTitle:(titles at:activeMenuNumber) x:x selected:selected - ] -! - -highlightActiveTitle - self drawActiveTitleSelected:true -! - -unHighlightActiveTitle - self drawActiveTitleSelected:false + w := self titleLenUpTo:(titles size + 1). + ^ w @ (font height + (font descent * 2) "+ topMargin" + (margin*2)). ! ! !PullDownMenu methodsFor:'submenu notifications'! @@ -1062,196 +1249,3 @@ self showPassive ! ! -!PullDownMenu methodsFor:'event handling'! - -showNoFocus - "when stepping focus, hide any active menu" - - self hideActiveMenu. - super showNoFocus -! - -keyPress:key x:x y:y - - - |index m sel| - - " - handle CursorLeft/Right for non-mouse operation - (for example, if it has the explicit focus) - These will pull the previous/next menu - " - ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[ - activeMenuNumber isNil ifTrue:[ - index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size]. - ] ifFalse:[ - (key == #CursorRight) ifTrue:[ - index := activeMenuNumber+1 - ] ifFalse:[ - index := activeMenuNumber-1 - ]. - index == 0 ifTrue:[index := menus size] - ifFalse:[ - index > menus size ifTrue:[index := 1] - ] - ]. - self pullMenu:index. - ^ self - ]. - - activeMenuNumber isNil ifTrue:[^self]. - - " - Return, space or the (virtual) MenuSelect key trigger - a menu entry (for non-submenu entries). - Otherwise, if we have a submenu open, - pass the key on to it ... - " - m := menus at:activeMenuNumber. - m isNil ifTrue:[ - (key == #Return - or:[key == #MenuSelect - or:[key == Character space]]) ifTrue:[ - sel := selectors at:activeMenuNumber. - sel notNil ifTrue:[ - receiver perform:sel - ] - ]. - ] ifFalse:[ - m keyPress:key x:0 y:0. - ]. -! - -buttonPress:button x:x y:y - |titleIndex activeMenu activeLeft activeTop m| - - device ungrabPointer. - - (y between:0 and:height) ifTrue:[ - titleIndex := self titleIndexForX:x. - ]. - - " - now, titleIndex is non-nil if pressed within myself - " - (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[ - m := self pullMenu:titleIndex. - (keepMenu and:[m notNil]) ifTrue:[ - device grabPointerInView:self. - self cursor:Cursor upRightArrow - ] - ] ifFalse:[ - (keepMenu and:[toggleKeep not]) ifTrue:[ - titleIndex == activeMenuNumber ifTrue:[ - "same pressed again ... stay" - device grabPointerInView:self. - ^ self - ]. - "moving around below" - activeMenuNumber isNil ifTrue:[^self]. - activeMenu := menus at:activeMenuNumber. - activeLeft := activeMenu left. - (x between:activeLeft and:(activeMenu right)) ifTrue:[ - activeTop := activeMenu top. - (y between:activeTop and:(activeMenu bottom)) ifTrue:[ - "moving around in menu" - activeMenu buttonPress:button - x:(x - activeLeft) - y:(y - activeTop). - ^ self - ] - ]. - ]. - self hideActiveMenu - ] -! - -buttonMotion:state x:x y:y - |titleIndex activeMenu activeLeft activeTop| - - state == 0 ifTrue:[^ self]. - - activeMenuNumber notNil ifTrue:[ - activeMenu := menus at:activeMenuNumber. - ]. - - (y < height) ifTrue:[ - "moving around in title line" - activeMenu notNil ifTrue:[ - activeMenu selection:nil - ]. - titleIndex := self titleIndexForX:x. - titleIndex notNil ifTrue:[ - (titleIndex ~~ activeMenuNumber) ifTrue:[ - self pullMenu:titleIndex - ] - ] ifFalse:[ - self hideActiveMenu - ] - ] ifFalse:[ - "moving around below" - activeMenu isNil ifTrue:[^self]. - activeLeft := activeMenu left. - (x between:activeLeft and:(activeMenu right)) ifTrue:[ - activeTop := activeMenu top. - (y between:activeTop and:(activeMenu bottom)) ifTrue:[ - "moving around in menu" - activeMenu buttonMotion:state - x:(x - activeLeft) - y:(y - activeTop). - ^ self - ] - ]. - "moved outside menu" - activeMenu selection:nil - ] -! - -buttonRelease:button x:x y:y - |activeMenu activeLeft activeTop hideMenu sel| - - activeMenuNumber isNil ifTrue:[^self]. - activeMenu := menus at:activeMenuNumber. - - hideMenu := false. - (y >= height) ifTrue:[ - "release below title-line" - activeLeft := activeMenu left. - " - released in a submenu ? - " - (x between:activeLeft and:(activeMenu right)) ifTrue:[ - activeTop := activeMenu top. - (y between:activeTop and:(activeMenu bottom)) ifTrue:[ - "release in menu" - self hideActiveMenu. - activeMenu buttonRelease:button - x:(x - activeLeft) - y:(y - activeTop). - ^ self - ] - ]. - hideMenu := true. - ] ifFalse:[ - y < 0 ifTrue:[ - hideMenu := true - ] ifFalse:[ - activeMenu isNil ifTrue:[ - selectors notNil ifTrue:[ - sel := selectors at:activeMenuNumber. - sel notNil ifTrue:[ - receiver perform:sel - ]. - ]. - hideMenu := true. - ] ifFalse:[ - keepMenu ifFalse:[ - hideMenu := true - ] - ] - ] - ]. - hideMenu ifTrue:[ - self hideActiveMenu. - ] -! !