--- 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
+ <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect)>
+
+ |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
- <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect)>
-
- |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.
- ]
-! !