PullDMenu.st
changeset 133 e58c7c979f33
parent 131 208fa92f434d
child 146 7726707ac980
--- a/PullDMenu.st	Mon Jul 03 04:34:22 1995 +0200
+++ b/PullDMenu.st	Sun Jul 23 05:03:13 1995 +0200
@@ -15,7 +15,7 @@
 			      showSeparatingLines topMargin
 			      fgColor bgColor activeFgColor activeBgColor
 			      onLevel offLevel edgeStyle
-			      keepMenu toggleKeep'
+			      keepMenu toggleKeep raiseTopWhenActivated'
        classVariableNames:'DefaultFont
 			   DefaultViewBackground 
 			   DefaultForegroundColor 
@@ -34,7 +34,7 @@
 COPYRIGHT (c) 1989 by Claus Gittinger
 	     All Rights Reserved
 
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.20 1995-06-27 02:23:48 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.21 1995-07-23 03:02:18 claus Exp $
 '!
 
 !PullDownMenu class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.20 1995-06-27 02:23:48 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.21 1995-07-23 03:02:18 claus Exp $
 "
 !
 
@@ -146,6 +146,10 @@
 
       pullDownMenuShowSeparatingLines         if true, lines are drawn between items.
 					      default: false
+
+      pullDownMenuRaiseTop                    if true, topview is raised whenever an entry
+					      is activated.
+					      default: true
 "
 !
 
@@ -342,43 +346,47 @@
 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'.
-    DefaultKeepMenu := StyleSheet at:'pullDownMenuKeepMenu' default:false.
-    DefaultToggleKeep := StyleSheet at:'pullDownMenuToggleKeep' default:false.
-    DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
-    DefaultFont := StyleSheet fontAt:'pullDownMenuFont'.
+    DefaultEdgeStyle := styleSheet at:'pullDownMenuEdgeStyle'.
+    DefaultKeepMenu := styleSheet at:'pullDownMenuKeepMenu' default:false.
+    DefaultToggleKeep := styleSheet at:'pullDownMenuToggleKeep' default:false.
+    DefaultLevel := styleSheet at:'pullDownMenuLevel' default:1.
+    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
@@ -477,6 +485,14 @@
     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
@@ -511,6 +527,19 @@
     ].
     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'!
@@ -748,6 +777,30 @@
     ^ 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"
 
@@ -833,6 +886,10 @@
     activeMenuNumber := aNumber.
     subMenu := menus at:aNumber.
 
+    raiseTopWhenActivated ifTrue:[
+	self topView raise.
+    ].
+
     (activeMenuNumber notNil 
     and:[
 	 subMenu notNil
@@ -871,7 +928,7 @@
     |x     "{ Class: SmallInteger }"
      y     "{ Class: SmallInteger }"
      index "{ Class: SmallInteger }" 
-     wSpace|
+     wSpace clr|
 
     shown ifFalse: [ ^ self ].
     titles isNil ifTrue:[^ self].
@@ -894,10 +951,11 @@
 		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
 	].
@@ -906,7 +964,15 @@
 !
 
 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.
@@ -919,11 +985,7 @@
     ].
     w := w + (wSpace * 2).
 
-    selected ifTrue:[
-	self paint:activeBgColor
-    ] ifFalse:[
-	self paint:bgColor
-    ].
+    self paint:bg.
     self fillRectangleX:x y:0 width:w height:height.
 
     self is3D ifTrue:[
@@ -932,11 +994,7 @@
 		    height:height
 		     level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
     ].
-    selected ifTrue:[
-	self paint:activeFgColor
-    ] ifFalse:[
-	self paint:fgColor
-    ].
+    self paint:fg.
     x := x + wSpace.
     stringOrImage isString ifTrue:[
 	self displayString:stringOrImage x:x y:y
@@ -945,20 +1003,20 @@
     ]
 !
 
-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|
-    activeMenuNumber notNil ifTrue:[
-	x := self titleLenUpTo:activeMenuNumber.
-	self drawTitle:(titles at:activeMenuNumber) x:x selected:false
-    ]
+    self drawActiveTitleSelected:false 
 ! !
 
 !PullDownMenu methodsFor:'submenu notifications'!
@@ -998,7 +1056,8 @@
 
     "
      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:[
@@ -1021,11 +1080,16 @@
     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