hg/stx-libwidg: comparison PullDownMenu.st

equal deleted inserted replaced

-:462396b08e30
+:06a050529335
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
 SimpleView subclass:#PullDownMenu
-instanceVariableNames:'menus titles selectors activeMenuNumber
+instanceVariableNames:'receiver menus titles selectors activeMenuNumber
 			      showSeparatingLines topMargin
 			      fgColor bgColor activeFgColor activeBgColor
 			      onLevel offLevel edgeStyle
 			      keepMenu toggleKeep'
 classVariableNames:'DefaultFont
 			   DefaultBackgroundColor
 			   DefaultHilightForegroundColor
 			   DefaultHilightBackgroundColor
 			   DefaultLevel DefaultHilightLevel
 			   DefaultShadowColor DefaultLightColor
-			   DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep'
+			   DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep
+			   DefaultSeparatingLines'
 poolDictionaries:''
 category:'Views-Menus'
 !
 PullDownMenu comment:'
 COPYRIGHT (c) 1989 by Claus Gittinger
 	     All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.17 1995-05-03 00:37:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.18 1995-05-17 12:25:49 claus Exp $
 '!
 !PullDownMenu class methodsFor:'documentation'!
 copyright
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.17 1995-05-03 00:37:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.18 1995-05-17 12:25:49 claus Exp $
 "
 !
 documentation
 "
 PullDown menu provides the top (always visible) part of these menus.
 It controls display of its menus, which become visible when one of the
 PullDownMenus entries is pressed.
+A PullDownMenu itself consists of a single row of labels, which activate
+a pulled menu when clicked. Entries may be empty (i.e. have no menu)
+and empty entries may (optionally) also perform some action when clicked.
+An entries selector is used as the key to define and access submenus
+and (for empty entries:) the selector sent to the receiver of the menu.
 Instance variables:
-menus                   <aCollection>   the sub menus
+menus                   <Collection>    the sub menus
-titles                  <aCollection>   the strings in the menu
+titles                  <Collection>    the strings in the menu
+selectors               <Collection>    the selectors to send to the menu-
+					      receiver (for empty pull-menus)
+					      if nil (the default), title entries
+					      do not send anything.
 activeMenuNumber        <Number>        the index of the currently active menu
 showSeparatingLines     <Boolean>       show separating lines between my menu-strings
 topMargin               <Number>        number of pixels at top
-fgColor                 <Color>         color to draw passive menu-titles
-bgColor                 <Color>         color to draw passive menu-titles
+fgColor                 <Color>         fg color to draw passive menu-titles
-activeFgColor           <Color>         color to draw activated menu-titles
+bgColor                 <Color>         bg color to draw passive menu-titles
-activeBgColor           <Color>         color to draw activated menu-titles
-onLevel                 <Integer>       level of entry-buttons when pressed
+activeFgColor           <Color>         fg color to draw activated menu-titles
-offLevel                <Integer>       level of entry-buttons when released
+activeBgColor           <Color>         bg color to draw activated menu-titles
+onLevel                 <Integer>       3D level of entry-buttons when pressed
+offLevel                <Integer>       3D level of entry-buttons when released
+edgeStyle               <Symbol>        how to draw edges
 keepmenu                <Boolean>       if on, pulled menu stays on click,
 					      till clicked again (motif & windows behavior)
+toggleKeep              <Boolean>       if on and keepMenu is on,
+					      clicking again on label closes menu
+except menus, titles and selectors, instvars are usually defined from
+defaults in the styleSheet; you should not care for them.
 StyleSheet values:
 pullDownMenuViewBackground              view background Color for the menu bar
 					      default: menuViewBackground
 					      default: menuHilightLevel
 pullDownMenuEdgeStyle                   edge style (nil or #soft)
 pullDownMenuKeepMenu                    if true, pulled menu stays open until button
-					      is pressed again (motif behavior)
+					      is pressed again outside of the item-area (motif behavior)
 					      if false, menu closes on release (default)
 pullDownMenuToggleKeep                  if true, pulled menu closes when an entry is pressed
-					      again. Otherwise, only press outside outside of
+					      again. Otherwise, only press outside of the items area
-					      the entry hides it.
+					      hides it. default is false
-					      default is false
 pullDownMenuLevel                       level (3D only)
 pullDownMenuFont                        font to use for the menu bar
 					      default: menuFont
+pullDownMenuShowSeparatingLines         if true, lines are drawn between items.
+					      default: false
 "
 !
 examples
 "
-|top menu|
+	|top menu|
-top := StandardSystemView new.
+	top := StandardSystemView new.
-menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
+	top extent:300@300.
-menu labels:#('foo' 'bar').
-menu selectors:#(foo bar).
+	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
-menu at:#foo
+	menu labels:#('foo' 'bar').
-	 putLabels:#('foo1' 'foo2' 'foo3')
+	menu selectors:#(foo bar).
-	 selectors:#(foo1 foo2 foo3)
+	menu at:#foo
-	 receiver:nil.
+	     putLabels:#('foo1' 'foo2' 'foo3')
-menu at:#bar
+	     selectors:#(foo1 foo2 foo3)
-	 putLabels:#('bar1' 'bar2' 'bar3')
+	     receiver:nil.
-	 selectors:#(bar1 bar2 bar3)
+	menu at:#bar
-	 receiver:nil.
+	     putLabels:#('bar1' 'bar2' 'bar3')
-top open
+	     selectors:#(bar1 bar2 bar3)
+	     receiver:nil.
+	top open
-'empty entries are possible ...'
-|top menu|
+empty entries are possible as selectable items (with non-nil seletor) ...
-top := StandardSystemView new.
+	|top menu|
-menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
-menu labels:#('foo' 'bar').
+	top := StandardSystemView new.
-menu selectors:#(foo bar).
+	top extent:300@300.
-menu at:#foo
-	 putLabels:#('foo1' 'foo2' 'foo3')
+	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
-	 selectors:#(foo1 foo2 foo3)
+	menu labels:#('foo' 'bar' 'baz').
-	 receiver:nil.
+	menu selectors:#(foo bar baz).
-top open
+	menu at:#foo
+	     putLabels:#('foo1' 'foo2' 'foo3')
+	     selectors:#(foo1 foo2 foo3)
+	     receiver:nil.
-'... for example as separators'
+	menu at:#baz
+	     putLabels:#('baz1' 'baz2' 'baz3')
-|top menu|
+	     selectors:#(baz1 baz2 baz3)
+	     receiver:nil.
-top := StandardSystemView new.
+	top open
-menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
-menu labels:#('foo' '    ' 'bar' ' baz' '    ' 'moreFoo' 'moreBar' 'moreBaz').
-menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
-menu showSeparatingLines:true.
+... or as separators (with nil selector)
-menu at:#foo
-	 putLabels:#('foo1' 'foo2' 'foo3')
+	|top menu|
-	 selectors:#(foo1 foo2 foo3)
-	 receiver:nil.
+	top := StandardSystemView new.
-menu at:#bar
+	top extent:500@200.
-	 putLabels:#('bar1' 'bar2' 'bar3')
-	 selectors:#(bar1 bar2 bar3)
+	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
-	 receiver:nil.
+	menu labels:#('foo' '    ' 'bar' ' baz' '    ' 'moreFoo' 'moreBar' 'moreBaz').
-menu at:#baz
+	menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
-	 putLabels:#('baz1' 'baz2' 'baz3')
+	menu at:#foo
-	 selectors:#(baz1 baz2 baz3)
+	     putLabels:#('foo1' 'foo2' 'foo3')
-	 receiver:nil.
+	     selectors:#(foo1 foo2 foo3)
-top open
+	     receiver:nil.
+	menu at:#bar
+	     putLabels:#('bar1' 'bar2' 'bar3')
+	     selectors:#(bar1 bar2 bar3)
+	     receiver:nil.
-'use menus default height'
+	menu at:#baz
+	     putLabels:#('baz1' 'baz2' 'baz3')
-|top menu|
+	     selectors:#(baz1 baz2 baz3)
+	     receiver:nil.
-top := StandardSystemView new.
+	top open
-menu := PullDownMenu in:top.
-menu origin:0.0@0.0 corner:1.0@(menu height).
-menu labels:#('foo' 'bar').
-menu selectors:#(foo bar).
-menu at:#foo
+use the menus default height
-	 putLabels:#('foo1' 'foo2' 'foo3')
-	 selectors:#(foo1 foo2 foo3)
+	|top menu|
-	 receiver:nil.
-top open
+	top := StandardSystemView new.
+	top extent:300@300.
+	menu := PullDownMenu in:top.
+	menu origin:0.0@0.0 corner:1.0@(menu height).
-'although you can change the font, colors etc (as shown below)
+	menu labels:#('foo' 'bar').
-you should NOT do it - since if you do so, the styleSheet settings
+	menu selectors:#(foo bar).
-are ineffective (which users wont like probably)
+	menu at:#foo
-BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
+	     putLabels:#('foo1' 'foo2' 'foo3')
-	  pullDownMenuBackgroundColor and pullDownMenuFont'
+	     selectors:#(foo1 foo2 foo3)
+	     receiver:nil.
-|top menu|
+	top open
-top := StandardSystemView new.
-menu := PullDownMenu in:top.
-menu font:(Font family:'courier' size:20).
-menu foregroundColor:Color red.
+although you can change the font, colors etc (as shown below)
-menu backgroundColor:Color yellow.
+you should NOT do it - since if you do so, the styleSheet settings
-menu viewBackground:Color yellow.
+are ineffective (which users wont like probably)
-menu showSeparatingLines:true.
+BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
+	 pullDownMenuBackgroundColor and pullDownMenuFont
-menu origin:0.0@0.0 corner:1.0@(menu height).
-menu labels:#('foo' 'bar').
+	|top menu|
-menu selectors:#(foo bar).
-menu at:#foo
+	top := StandardSystemView new.
-	 putLabels:#('foo1' 'foo2' 'foo3')
+	menu := PullDownMenu in:top.
-	 selectors:#(foo1 foo2 foo3)
+	menu font:(Font family:'courier' size:20).
-	 receiver:nil.
+	menu foregroundColor:Color red.
-(menu menuAt:#foo) font:(Font family:'courier' size:36).
+	menu backgroundColor:Color yellow.
-top open
+	menu viewBackground:Color yellow.
+	menu showSeparatingLines:true.
+	menu origin:0.0@0.0 corner:1.0@(menu height).
-'you can use icons, too ...'
+	menu labels:#('foo' 'bar').
+	menu selectors:#(foo bar).
-|labels top menu|
+	menu at:#foo
+	     putLabels:#('foo1' 'foo2' 'foo3')
-top := StandardSystemView new.
+	     selectors:#(foo1 foo2 foo3)
-menu := PullDownMenu in:top.
+	     receiver:nil.
-menu origin:0.0@0.0 corner:1.0@(menu height).
+	(menu menuAt:#foo) font:(Font family:'courier' size:36).
-labels := Array with:(Image fromFile:'SmalltalkX.xbm')
+	top open
-		    with:'foo'
-		    with:'bar'.
-menu labels:labels.
-menu selectors:#(about foo bar).
+you can use icons, too ...
-menu at:#about
-	 putLabels:#('about PullDownMenus')
+	|labels top menu|
-	 selectors:#(aboutMenus)
-	 receiver:nil.
+	top := StandardSystemView new.
-menu at:#foo
+	top extent:300@300.
-	 putLabels:#('foo1' 'foo2' 'foo3')
-	 selectors:#(foo1 foo2 foo3)
+	menu := PullDownMenu in:top.
-	 receiver:nil.
+	menu origin:0.0@0.0 corner:1.0@(menu height).
-top open
+	labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
+			with:'foo'
+			with:'bar'.
+	menu labels:labels.
+	menu selectors:#(about foo bar).
+	menu at:#about
+	     putLabels:#('about PullDownMenus')
+	     selectors:#(aboutMenus)
+	     receiver:nil.
+	menu at:#foo
+	     putLabels:#('foo1' 'foo2' 'foo3')
+	     selectors:#(foo1 foo2 foo3)
+	     receiver:nil.
+	top open
+a concrete example (combining things described above)
+(using a Plug, since we have no application class here):
+	|labels top menu textView appModel|
+	appModel := Plug new.
+	appModel respondTo:#quit with:[top destroy].
+	appModel respondTo:#showAbout with:[self information:'some info here ...'].
+	appModel respondTo:#help with:[self information:'some help here ...'].
+	top := StandardSystemView new.
+	top extent:300@300.
+	menu := PullDownMenu in:top.
+	menu receiver:appModel.
+	menu origin:0.0@0.0 corner:1.0@(menu height).
+	textView := ScrollableView forView:(EditTextView new).
+	textView origin:0.0@menu height corner:1.0@1.0.
+	top addSubView:textView.
+	labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
+			with:'file'
+			with:'edit'
+			with:'help'.
+	menu labels:labels.
+	menu selectors:#(about file edit help).
+	menu at:#about
+	     putLabels:#('about PullDownMenus')
+	     selectors:#(showAbout)
+	     receiver:appModel.
+	menu at:#file
+	     putLabels:#('quit')
+	     selectors:#(quit)
+	     receiver:appModel.
+	menu at:#edit
+	     putLabels:#('copy' 'cut' 'paste')
+	     selectors:#(copySelection cut paste)
+	     receiver:textView.
+	top open
 "
 ! !
 !PullDownMenu class methodsFor:'defaults'!
 DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
 DefaultFont := StyleSheet fontAt:'pullDownMenuFont'.
 DefaultFont isNil ifTrue:[
 	DefaultFont := StyleSheet fontAt:'menuFont'.
 ].
+DefaultSeparatingLines := StyleSheet at:'pullDownMenuSeparatingLines' default:false.
 "
 PullDownMenu updateStyleCache
 "
 ! !
 !
 initStyle
 super initStyle.
-showSeparatingLines := false.
+showSeparatingLines := DefaultSeparatingLines. "/ false.
 DefaultViewBackground notNil ifTrue:[
 	viewBackground := DefaultViewBackground on:device
 ].
 DefaultFont notNil ifTrue:[
 activeBgColor := activeBgColor on:device.
 activeFgColor := activeFgColor on:device.
 !
 recreate
-"if saved with an active menu, hide it"
+"if the image was saved with an active menu, hide it"
+|m|
 activeMenuNumber notNil ifTrue:[
-	(menus at:activeMenuNumber) unrealize.
+	(m := menus at:activeMenuNumber) notNil ifTrue:[
+	    m unrealize.
+	].
 	activeMenuNumber := nil.
 ].
 super recreate.
 self setMenuOrigins
 !
 super create.
 self setMenuOrigins
 !
 destroy
-"
+"have to destroy the menus manually here,
-have to destroy the menus manually here,
+since they are no real subviews of myself"
-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.
 ! !
-!PullDownMenu methodsFor:'accessing'!
+!PullDownMenu methodsFor:'accessing-look'!
 showSeparatingLines:aBoolean
-"turn on/off drawing of separating lines"
+"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 receiver:anObject
+	]
 ]
 !
 numberOfTitles:n
 "setup blank title-space to be filled in later"
 "define the menu-selectors. These are used as accesskey only
 in menuAt: accesses. This makes PullDownMenu accesss
 somewhat more compatible to PopUpMenus."
 selectors := selectorArray.
-!
-font:aFont
-"adjust menu-origins when font changes"
-super font:(aFont on:device).
-self height:(font height + (font descent * 2)).
-shown ifTrue:[
-	self setMenuOrigins
-]
-!
-foregroundColor:aColor
-fgColor := aColor on:device
-!
-backgroundColor:aColor
-bgColor := aColor on:device
 !
 menuAt:string
 "return the menu with the title; return nil if not found"
 hideActiveMenuRelease:aBoolean
 "hide currently active menu - release grab if aBoolean is true
 and a grab was set (keepMenu)"
+|m|
 activeMenuNumber notNil ifTrue:[
-	(menus at:activeMenuNumber) unrealize.
+	(m := menus at:activeMenuNumber) notNil ifTrue:[
+	    m unrealize.
+	].
 	self unHighlightActiveTitle.
 	activeMenuNumber := nil
 ].
 aBoolean ifTrue:[
 	device ungrabPointer.
 "activate a menu, return it or nil"
 |subMenu|
 activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
+activeMenuNumber := aNumber.
 subMenu := menus at:aNumber.
+(activeMenuNumber notNil
+and:[
+	 subMenu notNil
+	 or:[(selectors at:activeMenuNumber) notNil]]) ifTrue:[
+	    self highlightActiveTitle.
+	 ].
 subMenu notNil ifTrue:[
-	activeMenuNumber := aNumber.
-	self highlightActiveTitle.
 	subMenu deselect.
 	subMenu create.
 	subMenu saveUnder:true.
 	subMenu superMenu:self.
 	subMenu raise show
 ! !
 !PullDownMenu methodsFor:'drawing '!
 redraw
-|string
+|x     "{ Class: SmallInteger }"
-x     "{ Class: SmallInteger }"
 y     "{ Class: SmallInteger }"
 index "{ Class: SmallInteger }"
 wSpace|
 shown ifFalse: [ ^ self ].
 ! !
 !PullDownMenu methodsFor:'submenu notifications'!
 showActive
-"sent by a submenu to tell me that it started to perform
+"sent by a menu to tell me that it starts to perform
-its menu action"
+its menu action."
 !
 showPassive
-"sent by a submenu to tell me that it finished its menu-action."
+"sent by a menu to tell me that it finished its menu-action.
+Here, we hide the currently active menu."
 self hideActiveMenu
 !
 submenuTriggered
 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|
+|index m sel|
 "
 handle CursorLeft/Right for non-mouse operation
 (once it has the explicit focus)
 "
 	    index == 0 ifTrue:[index := menus size]
 	    ifFalse:[
 		index > menus size ifTrue:[index := 1]
 	    ]
 	].
-	m := self pullMenu:index.
+	self pullMenu:index.
 	^ self
 ].
 activeMenuNumber isNil ifTrue:[^self].
 "
-pass it on to the active menu
+pass it on to the active menu or perform the items action
 "
 m := menus at:activeMenuNumber.
-m keyPress:key x:0 y:0.
+m isNil ifTrue:[
-^ self
+	key == #Return 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|
 	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.
 	activeMenu selection:nil
 ]
 !
 buttonRelease:button x:x y:y
-|activeMenu activeLeft activeTop hideMenu|
+|activeMenu activeLeft activeTop hideMenu sel|
+activeMenuNumber isNil ifTrue:[^self].
+activeMenu := menus at:activeMenuNumber.
 hideMenu := false.
 (y >= height) ifTrue:[
 	"release below title-line"
-	activeMenuNumber isNil ifTrue:[^self].
-	activeMenu := menus at:activeMenuNumber.
 	activeLeft := activeMenu left.
 	"
 	 released in a submenu ?
 	"
 	(x between:activeLeft and:(activeMenu right)) ifTrue:[
 	hideMenu := true.
 ] ifFalse:[
 	y < 0 ifTrue:[
 	    hideMenu := true
 	] ifFalse:[
-	    keepMenu ifFalse:[
+	    activeMenu isNil ifTrue:[
-		hideMenu := true
+		sel := selectors at:activeMenuNumber.
+		sel notNil ifTrue:[
+		    receiver perform:sel
+		].
+		hideMenu := true.
+	    ] ifFalse:[
+		keepMenu ifFalse:[
+		    hideMenu := true
+		]
 	    ]
 	]
 ].
 hideMenu ifTrue:[
 self hideActiveMenu.

changeset 128	06a050529335
parent 119	59758ff5b841
child 130	338e856bddc9