hg/stx-libwidg: comparison PullDownMenu.st

equal deleted inserted replaced

-:596439fe4efd
+:e58c7c979f33
 SimpleView subclass:#PullDownMenu
 instanceVariableNames:'receiver menus titles selectors activeMenuNumber
 			      showSeparatingLines topMargin
 			      fgColor bgColor activeFgColor activeBgColor
 			      onLevel offLevel edgeStyle
-			      keepMenu toggleKeep'
+			      keepMenu toggleKeep raiseTopWhenActivated'
 classVariableNames:'DefaultFont
 			   DefaultViewBackground
 			   DefaultForegroundColor
 			   DefaultBackgroundColor
 			   DefaultHilightForegroundColor
 PullDownMenu comment:'
 COPYRIGHT (c) 1989 by Claus Gittinger
 	     All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.20 1995-06-27 02:23:48 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.21 1995-07-23 03:02:18 claus Exp $
 '!
 !PullDownMenu class methodsFor:'documentation'!
 copyright
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.20 1995-06-27 02:23:48 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.21 1995-07-23 03:02:18 claus Exp $
 "
 !
 documentation
 "
 pullDownMenuFont                        font to use for the menu bar
 					      default: menuFont
 pullDownMenuShowSeparatingLines         if true, lines are drawn between items.
 					      default: false
+pullDownMenuRaiseTop                    if true, topview is raised whenever an entry
+					      is activated.
+					      default: true
 "
 !
 examples
 "
 !PullDownMenu class methodsFor:'defaults'!
 updateStyleCache
 "extract values from the styleSheet and cache them in class variables"
-DefaultViewBackground := StyleSheet colorAt:'pullDownMenuViewBackground'.
+|styleSheet|
+styleSheet := StyleSheet.
+DefaultViewBackground := styleSheet colorAt:'pullDownMenuViewBackground'.
 DefaultViewBackground isNil ifTrue:[
-	DefaultViewBackground := StyleSheet colorAt:'menuViewBackground'.
+	DefaultViewBackground := styleSheet colorAt:'menuViewBackground'.
 ].
-DefaultForegroundColor := StyleSheet colorAt:'pullDownMenuForegroundColor'.
+DefaultForegroundColor := styleSheet colorAt:'pullDownMenuForegroundColor'.
 DefaultForegroundColor isNil ifTrue:[
-	DefaultForegroundColor := StyleSheet colorAt:'menuForegroundColor'.
+	DefaultForegroundColor := styleSheet colorAt:'menuForegroundColor'.
 ].
-DefaultBackgroundColor := StyleSheet colorAt:'pullDownMenuBackgroundColor'.
+DefaultBackgroundColor := styleSheet colorAt:'pullDownMenuBackgroundColor'.
 DefaultBackgroundColor isNil ifTrue:[
 	DefaultViewBackground notNil ifTrue:[
 	    DefaultBackgroundColor := DefaultViewBackground
 	] ifFalse:[
-	    DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
+	    DefaultBackgroundColor := styleSheet colorAt:'menuBackgroundColor'.
 	]
 ].
-DefaultHilightForegroundColor := StyleSheet colorAt:'pullDownMenuHilightForegroundColor'.
+DefaultHilightForegroundColor := styleSheet colorAt:'pullDownMenuHilightForegroundColor'.
 DefaultHilightForegroundColor isNil ifTrue:[
-	DefaultHilightForegroundColor := StyleSheet colorAt:'menuHilightForegroundColor'.
+	DefaultHilightForegroundColor := styleSheet colorAt:'menuHilightForegroundColor'.
 ].
-DefaultHilightBackgroundColor := StyleSheet colorAt:'pullDownMenuHilightBackgroundColor'.
+DefaultHilightBackgroundColor := styleSheet colorAt:'pullDownMenuHilightBackgroundColor'.
 DefaultHilightBackgroundColor isNil ifTrue:[
-	DefaultHilightBackgroundColor := StyleSheet colorAt:'menuHilightBackgroundColor'.
+	DefaultHilightBackgroundColor := styleSheet colorAt:'menuHilightBackgroundColor'.
 ].
-DefaultHilightLevel := StyleSheet at:'pullDownMenuHilightLevel'.
+DefaultHilightLevel := styleSheet at:'pullDownMenuHilightLevel'.
 DefaultHilightLevel isNil ifTrue:[
-	DefaultHilightLevel := StyleSheet at:'menuHilightLevel' default:0.
+	DefaultHilightLevel := styleSheet at:'menuHilightLevel' default:0.
 ].
-DefaultEdgeStyle := StyleSheet at:'pullDownMenuEdgeStyle'.
+DefaultEdgeStyle := styleSheet at:'pullDownMenuEdgeStyle'.
-DefaultKeepMenu := StyleSheet at:'pullDownMenuKeepMenu' default:false.
+DefaultKeepMenu := styleSheet at:'pullDownMenuKeepMenu' default:false.
-DefaultToggleKeep := StyleSheet at:'pullDownMenuToggleKeep' default:false.
+DefaultToggleKeep := styleSheet at:'pullDownMenuToggleKeep' default:false.
-DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
+DefaultLevel := styleSheet at:'pullDownMenuLevel' default:1.
-DefaultFont := StyleSheet fontAt:'pullDownMenuFont'.
+DefaultFont := styleSheet fontAt:'pullDownMenuFont'.
 DefaultFont isNil ifTrue:[
-	DefaultFont := StyleSheet fontAt:'menuFont'.
+	DefaultFont := styleSheet fontAt:'menuFont'.
 ].
-DefaultSeparatingLines := StyleSheet at:'pullDownMenuSeparatingLines' default:false.
+DefaultSeparatingLines := styleSheet at:'pullDownMenuSeparatingLines' default:false.
 "
 PullDownMenu updateStyleCache
 "
 ! !
 bgColor := bgColor on:device.
 fgColor := fgColor on:device.
 activeBgColor := activeBgColor on:device.
 activeFgColor := activeFgColor on:device.
+raiseTopWhenActivated := styleSheet at:'pullDownMenuRaiseTop' default:true.
+!
+initCursor
+"set up a hand cursor"
+cursor := Cursor hand
 !
 recreate
 "if the image was saved with an active menu, hide it"
 	].
 	menus := nil
 ].
 activeMenuNumber := nil.
 super destroy.
+!
+superView:aView
+"when my superView changes, all of my menus must change as well"
+super superView:aView.
+menus notNil ifTrue:[
+	menus do:[:aMenu |
+	    aMenu notNil ifTrue:[
+		aMenu superView:aView
+	    ]
+	]
+]
 ! !
 !PullDownMenu methodsFor:'accessing-look'!
 showSeparatingLines:aBoolean
 	idx ~~ 0 ifTrue:[^ idx].
 ].
 ^ titles indexOf:stringOrNumber
 !
+someMenuItemLabeled:aLabel
+"find a menu item.
+Currently, in ST/X, instances of MenuItem are only created as dummy"
+|idx|
+idx := self indexOf:aLabel.
+idx ~~ 0 ifTrue:[
+	^ MenuItem new menu:self index:idx
+].
+menus notNil ifTrue:[
+	menus do:[:aMenu |
+	    |item|
+	    aMenu notNil ifTrue:[
+		(item := aMenu someMenuItemLabeled:aLabel) notNil ifTrue:[
+		    ^ item
+		]
+	    ]
+	]
+].
+^ nil
+!
 setMenuOrigins
 "adjust origins of menus when font changes"
 (font device == device) ifTrue:[
 	menus keysAndValuesDo:[:index :aMenu |
 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.
 redraw
 |x     "{ Class: SmallInteger }"
 y     "{ Class: SmallInteger }"
 index "{ Class: SmallInteger }"
-wSpace|
+wSpace clr|
 shown ifFalse: [ ^ self ].
 titles isNil ifTrue:[^ self].
 wSpace := (font widthOf:' ').
 	showSeparatingLines ifTrue:[
 	    self is3D ifTrue:[
 		self paint:shadowColor.
 		self displayLineFromX:x y:0 toX:x y:y.
 		x := x + 1.
-		self paint:lightColor.
+		clr := lightColor.
 	    ] ifFalse:[
-		self paint:fgColor.
+		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|
+|y w x wSpace fg bg|
+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".
 	y := ((height - stringOrImage height) // 2) max:0.
 	w := stringOrImage width
 ].
 w := w + (wSpace * 2).
-selected ifTrue:[
+self paint:bg.
-	self paint:activeBgColor
-] ifFalse:[
-	self paint:bgColor
-].
 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])
 ].
-selected ifTrue:[
+self paint:fg.
-	self paint:activeFgColor
-] ifFalse:[
-	self paint:fgColor
-].
 x := x + wSpace.
 stringOrImage isString ifTrue:[
 	self displayString:stringOrImage x:x y:y
 ] ifFalse:[
 	self displayForm:stringOrImage x:x y:y
 ]
 !
-highlightActiveTitle
+drawActiveTitleSelected:selected
 |x|
 activeMenuNumber notNil ifTrue:[
 	x := self titleLenUpTo:activeMenuNumber.
-	self drawTitle:(titles at:activeMenuNumber) x:x selected:true
+	self drawTitle:(titles at:activeMenuNumber) x:x selected:selected
 ]
 !
+highlightActiveTitle
+self drawActiveTitleSelected:true
+!
 unHighlightActiveTitle
-|x|
+self drawActiveTitleSelected:false
-activeMenuNumber notNil ifTrue:[
-	x := self titleLenUpTo:activeMenuNumber.
-	self drawTitle:(titles at:activeMenuNumber) x:x selected:false
-]
 ! !
 !PullDownMenu methodsFor:'submenu notifications'!
 showActive
 keyPress:key x:x y:y
 |index m sel|
 "
 handle CursorLeft/Right for non-mouse operation
-(once it has the explicit focus)
+(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:[
 ].
 activeMenuNumber isNil ifTrue:[^self].
 "
-pass it on to the active menu or perform the items action
+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 ifTrue:[
+	(key == #Return
+	or:[key == #MenuSelect
+	or:[key == Character space]]) ifTrue:[
 	    sel := selectors at:activeMenuNumber.
 	    sel notNil ifTrue:[
 		receiver perform:sel
 	    ]
 	].

changeset 133	e58c7c979f33
parent 131	208fa92f434d
child 146	7726707ac980