--- a/MenuView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/MenuView.st Sun Aug 07 15:23:42 1994 +0200
@@ -13,41 +13,61 @@
SelectionInListView subclass:#MenuView
instanceVariableNames:'selectors args receiver enableFlags
disabledFgColor onOffFlags subMenus
- subMenuShown superMenu checkColor'
+ subMenuShown superMenu checkColor
+ lineLevel lineInset'
classVariableNames:''
poolDictionaries:''
category:'Views-Menus'
!
MenuView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.7 1994-01-08 17:27:32 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.8 1994-08-07 13:22:51 claus Exp $
'!
!MenuView class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.8 1994-08-07 13:22:51 claus Exp $
+"
+!
+
documentation
"
-a menu view used for both pull-down-menus and pop-up-menus
-the action to be performed can be defined either as:
+ a menu view used for both pull-down-menus and pop-up-menus
+ the action to be performed can be defined either as:
-1) action:aBlockWithOneArg
- which defines a block to be called with the line number (1..n)
- of the selected line.
+ 1) action:aBlockWithOneArg
+ which defines a block to be called with the line number (1..n)
+ of the selected line.
-2) selectors:selectorArray [args: argarray] receiver:anObject
- which defines the messages to be sent to receiver for each
- line.
+ 2) selectors:selectorArray [args: argarray] receiver:anObject
+ which defines the messages to be sent to receiver for each
+ line.
-It is also possible to define both actionBlock and selectorArray.
+ It is also possible to define both actionBlock and selectorArray.
-menu entries starting with '\c' are check-entries.
-menu entries conisting of '-' alone, are separating lines.
+ menu entries starting with '\c' are check-entries.
+ menu entries conisting of '-' alone, are separating lines.
-written summer 89 by claus
+ written summer 89 by claus
"
! !
@@ -117,6 +137,36 @@
selectors:selArray
args:nil
receiver:anObject
+!
+
+labels:labels selectors:selArray receiver:anObject
+ "create and return a new MenuView. The parent view
+ should be set later."
+
+ ^ (self new) labels:labels
+ selectors:selArray
+ args:nil
+ receiver:anObject
+!
+
+labels:labels selectors:selArray
+ "create and return a new MenuView. The parent veiw
+ and receiver should be set later."
+
+ ^ (self new) labels:labels
+ selectors:selArray
+ args:nil
+ receiver:nil
+!
+
+labels:labels
+ "create and return a new MenuView. The parent view,
+ selectors and receiver should be set later."
+
+ ^ (self new) labels:labels
+ selectors:nil
+ args:nil
+ receiver:nil
! !
!MenuView methodsFor:'initialization'!
@@ -125,7 +175,7 @@
super initialize.
disabledFgColor := Color darkGrey.
- self is3D ifTrue:[
+ ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
borderWidth := 1.
self level:1
]
@@ -144,16 +194,47 @@
super initStyle.
checkColor := fgColor.
+ (style == #normal) ifTrue:[
+ lineLevel := 0
+ ] ifFalse:[
+ lineLevel := -1.
+ "the inset on each side"
+ style == #motif ifTrue:[
+ lineInset := 0
+ ] ifFalse:[
+ lineInset := (device horizontalPixelPerMillimeter * 0.8) rounded.
+ ]
+ ].
(style == #iris) ifTrue:[
device hasGreyscales ifTrue:[
hilightFgColor := fgColor.
- hilightBgColor := bgColor.
- hilightLevel := 2.
+ hilightBgColor := White "bgColor".
+ hilightLevel := 1 "2".
+ lineSpacing := 3
].
device hasColors ifTrue:[
checkColor := Color red.
].
- ]
+ ].
+ (style == #motif) ifTrue:[
+ hilightFgColor := fgColor.
+ hilightBgColor := bgColor.
+ hilightLevel := 2.
+ lineSpacing := (2 * hilightLevel)
+ ].
+ style == #openwin ifTrue:[
+ "add some space for rounded-hilight area"
+ self leftMargin:10.
+ lineLevel := 1.
+ ].
+ (style == #st80) ifTrue:[
+ viewBackground := White.
+ fgColor := Black.
+ bgColor := White.
+ level := 0.
+ lineLevel := 0.
+ lineInset := 0
+ ].
!
initEvents
@@ -170,6 +251,9 @@
recreate
super recreate.
+ style == #openwin ifTrue:[
+ self leftMargin:10.
+ ].
self recomputeSize
! !
@@ -204,7 +288,7 @@
labels:text
"set the labels to the argument, text"
- (text isKindOf:String) ifTrue:[
+ (text isString) ifTrue:[
self list:(text asText)
] ifFalse:[
self list:text
@@ -270,16 +354,75 @@
self recomputeSize
!
+addLabel:aLabel selector:aSelector after:aLabelOrSelectorOrNumber
+ "insert another label/selector pair at some place.
+ Being very friendly here, allowing label-string, selector or numeric
+ index for the argument aLabelOrSelectorOrNumber"
+
+ |idx|
+
+ list isNil ifTrue:[
+ ^ self addLabel:aLabel selector:aSelector
+ ].
+ "
+ be user friendly - allow both label or selector
+ to be passed
+ "
+ aLabelOrSelectorOrNumber isInteger ifTrue:[
+ idx := aLabelOrSelectorOrNumber
+ ] ifFalse:[
+ idx := list indexOf:aLabelOrSelectorOrNumber ifAbsent:[selectors indexOf:aLabelOrSelectorOrNumber].
+ ].
+ (idx between:1 and:list size) ifFalse:[
+ "add to end"
+ ^ self addLabel:aLabel selector:aSelector
+ ].
+
+ list := list asOrderedCollection add:aLabel beforeIndex:(idx + 1).
+ selectors := selectors asOrderedCollection add:aSelector beforeIndex:(idx + 1).
+ enableFlags := enableFlags asOrderedCollection add:true beforeIndex:(idx + 1).
+ subMenus notNil ifTrue:[
+ subMenus := subMenus asOrderedCollection add:nil beforeIndex:(idx + 1).
+ ].
+ args notNil ifTrue:[
+ args := args asOrderedCollection add:nil beforeIndex:(idx + 1).
+ ].
+ self recomputeSize
+
+ "
+ |v|
+ CodeView new realize.
+ v := CodeView new realize.
+ v middleButtonMenu menuView addLabel:'new entry' selector:#foo after:'paste'.
+ "
+!
+
+remove:indexOrName
+ "remove the label at index"
+
+ |i|
+
+ i := self indexOf:indexOrName.
+ i == 0 ifTrue:[^ self].
+ list := list asOrderedCollection removeIndex:i.
+ selectors := selectors asOrderedCollection removeIndex:i.
+ enableFlags := enableFlags asOrderedCollection removeIndex:i.
+ subMenus notNil ifTrue:[
+ subMenus := subMenus asOrderedCollection removeIndex:i.
+ ].
+ self recomputeSize
+!
+
indexOf:indexOrName
"return the index of the label named:aName or , if its a symbol
the index in the selector list"
- (indexOrName isMemberOf:String) ifTrue:[
- ^ list indexOf:indexOrName
- ].
(indexOrName isMemberOf:Symbol) ifTrue:[
^ selectors indexOf:indexOrName
].
+ (indexOrName isString) ifTrue:[
+ ^ list indexOf:indexOrName
+ ].
^ indexOrName
!
@@ -486,13 +629,25 @@
setSelectionForX:x y:y
|newSelection org mx my|
+ (x < 0
+ or:[x >= width
+ or:[y < 0
+ or:[y >= height]]]) ifTrue:[
+ "
+ moved outside submenu, but not within self
+ "
+ subMenuShown notNil ifTrue:[
+ ^ self
+ ].
+ ].
+
newSelection := self positionToSelectionX:x y:y.
newSelection ~= selection ifTrue:[
self selection:newSelection.
subMenuShown notNil ifTrue:[
- subMenuShown hide.
- subMenuShown := nil
+ self hideSubmenu.
].
+"/ windowGroup notNil ifTrue:[windowGroup sensor flushUserEvents].
newSelection notNil ifTrue:[
(enableFlags at:newSelection) ifFalse:[
newSelection := nil
@@ -514,12 +669,23 @@
from:(self id)
to:(DisplayRootView new id).
- ActiveGrab == self ifTrue:[
- device ungrabPointer.
- ActiveGrab := nil
- ].
+"/ ActiveGrab == self ifTrue:[
+"/ device ungrabPointer.
+"/ ActiveGrab := nil
+"/ ].
+windowGroup notNil ifTrue:[windowGroup processExposeEvents].
subMenuShown superMenu:self.
- subMenuShown showAt:org.
+"/ subMenuShown showAt:org.
+"
+ realize the submenu in MY windowgroup
+"
+subMenuShown windowGroup:windowGroup.
+subMenuShown windowGroup addTopView:subMenuShown.
+subMenuShown fixSize.
+subMenuShown origin:org.
+subMenuShown makeFullyVisible.
+subMenuShown realize.
+device synchronizeOutput.
^ self
]
] ifFalse:[
@@ -596,6 +762,88 @@
]
!
+drawVisibleLineSelected:visLineNr
+ "redraw a single line as selected."
+
+ |listLine fg bg
+ y "{ Class: SmallInteger }"
+ y2 "{ Class: SmallInteger }"
+ r2 radius topLeftColor botRightColor |
+
+ style ~~ #openwin ifTrue:[
+ ^ super drawVisibleLineSelected:visLineNr.
+ ].
+ "
+ openwin draws selections in a menu as (edged) rounded rectangles
+ "
+
+ bg := hilightBgColor.
+ fg := hilightFgColor.
+ listLine := self visibleLineToListLine:visLineNr.
+ listLine notNil ifTrue:[
+
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ y := self yOfLine:visLineNr.
+ y2 := y + fontHeight - 1.
+ r2 := font height.
+ radius := r2 // 2.
+
+ "
+ refill with normal bg, where arcs will be drawn below
+ "
+ self paint:bgColor.
+ self fillRectangleX:margin y:y width:radius height:fontHeight.
+ self fillRectangleX:width-radius-margin y:y width:radius height:fontHeight.
+
+ "
+ fill the arcs
+ "
+ self paint:hilightBgColor.
+ self fillArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:180.
+ self fillArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:180.
+
+ "
+ a highlight-border around
+ "
+ hilightFrameColor notNil ifTrue:[
+ self paint:hilightFrameColor.
+ self displayLineFromX:radius+2 y:y toX:width-radius-3 y:y.
+ self displayLineFromX:radius+2 y:y2 toX:width-radius-3 y:y2.
+
+ self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:180.
+ self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:180.
+ ^ self
+ ].
+
+ "
+ an edge around
+ "
+ (hilightLevel ~~ 0) ifTrue:[
+ (hilightLevel < 0) ifTrue:[
+ topLeftColor := shadowColor.
+ botRightColor := lightColor.
+ ] ifFalse:[
+ topLeftColor := lightColor.
+ botRightColor := shadowColor.
+ ].
+
+ self paint:topLeftColor.
+ self displayLineFromX:radius+2 y:y toX:width-radius-3 y:y.
+
+ self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:125.
+ self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270+125 angle:55.
+
+ self paint:botRightColor.
+
+ self displayLineFromX:radius+2 y:y2 toX:width-radius-3 y:y2.
+ self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90+125 angle:55.
+ self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:125.
+ ^ self
+ ]
+ ].
+ ^ super drawVisibleLine:visLineNr with:fg and:bg
+!
+
redrawVisibleLine:visLine col:col
self redrawVisibleLine:visLine
!
@@ -609,7 +857,7 @@
!
redrawVisibleLine:visLineNr
- |line lineNr y isSpecial isSeparatingLine mm right|
+ |line lineNr y isSpecial isSeparatingLine right clr1 clr2|
line := self visibleAt:visLineNr.
@@ -640,25 +888,31 @@
"handle separating lines"
y := self yOfLine:visLineNr.
- self is3D ifFalse:[
- self paint:bgColor.
- self fillRectangleX:0 y:y
- width:width height:fontHeight
- ].
+
+ self paint:bgColor.
+ self fillRectangleX:0 y:y width:width height:fontHeight.
+
isSeparatingLine ifTrue:[
y := y + (fontHeight // 2).
- self is3D ifFalse:[
+ lineLevel == 0 ifTrue:[
self paint:fgColor.
self displayLineFromX:0 y:y toX:width y:y
- ] ifTrue:[
+ ] ifFalse:[
"the inset on each side"
- mm := (device horizontalPixelPerMillimeter * 0.8) rounded.
- right := width - 1 - mm.
- self paint:shadowColor.
- self displayLineFromX:mm y:y toX:right y:y.
- self paint:lightColor.
+
+ lineLevel < 0 ifTrue:[
+ clr1 := shadowColor.
+ clr2 := lightColor.
+ ] ifFalse:[
+ clr1 := lightColor.
+ clr2 := shadowColor.
+ ].
+ self paint:clr1.
+ right := width - 1 - lineInset.
+ self displayLineFromX:lineInset y:y toX:right y:y.
+ self paint:clr2.
y := y + 1.
- self displayLineFromX:mm y:y toX:right y:y
+ self displayLineFromX:lineInset y:y toX:right y:y
]
]
!
@@ -730,7 +984,7 @@
].
!
-regainControl
+XXregainControl
"take over pointer control from a submenu"
^ self
@@ -762,13 +1016,13 @@
subMenuShown notNil ifTrue:[
^ self
].
- self setSelectionForX:-1 y:-1. "force deselect"
+"/ self setSelectionForX:-1 y:-1. "force deselect"
subMenuShown isNil ifTrue:[
self selection:nil
].
- superMenu notNil ifTrue:[
- superMenu regainControl.
- ]
+"/ superMenu notNil ifTrue:[
+"/ superMenu regainControl.
+"/ ]
!
buttonRelease:button x:x y:y
@@ -786,40 +1040,48 @@
superMenu notNil ifTrue:[
superMenu showActive
].
+ "
+ either action-block or selectors-array-style
+ "
actionBlock notNil ifTrue:[
- actionBlock value:(self selection)
- ].
- selectors notNil ifTrue: [
- ActiveGrab == self ifTrue:[
- device ungrabPointer.
- ActiveGrab := nil.
- ].
- (selectors isKindOf:Symbol) ifFalse:[
- selection <= (selectors size) ifTrue:[
- theSelector := selectors at:selection
- ]
- ] ifTrue:[
- theSelector := selectors
- ].
- theSelector notNil ifTrue:[
- isCheck := false.
- onOffFlags notNil ifTrue:[
- onOffFlags size >= selection ifTrue:[
- isCheck := (onOffFlags at:selection) notNil
+ Object abortSignal catch:[
+ actionBlock value:(self selection)
+ ]
+ ] ifFalse:[
+ selectors notNil ifTrue: [
+ ActiveGrab == self ifTrue:[
+ device ungrabPointer.
+ ActiveGrab := nil.
+ ].
+ (selectors isKindOf:Symbol) ifFalse:[
+ selection <= (selectors size) ifTrue:[
+ theSelector := selectors at:selection
]
+ ] ifTrue:[
+ theSelector := selectors
].
- isCheck ifTrue:[
- onOffFlags at:selection
- put:(onOffFlags at:selection) not.
- self redrawLine:selection.
- receiver perform:theSelector
- with:(onOffFlags at:selection)
- ] ifFalse:[
- args isNil ifTrue:[
- receiver perform:theSelector
- ] ifFalse:[
- receiver perform:theSelector
- with:(args at:selection)
+ theSelector notNil ifTrue:[
+ isCheck := false.
+ onOffFlags notNil ifTrue:[
+ onOffFlags size >= selection ifTrue:[
+ isCheck := (onOffFlags at:selection) notNil
+ ]
+ ].
+ Object abortSignal catch:[
+ isCheck ifTrue:[
+ onOffFlags at:selection
+ put:(onOffFlags at:selection) not.
+ self redrawLine:selection.
+ receiver perform:theSelector
+ with:(onOffFlags at:selection)
+ ] ifFalse:[
+ args isNil ifTrue:[
+ receiver perform:theSelector
+ ] ifFalse:[
+ receiver perform:theSelector
+ with:(args at:selection)
+ ]
+ ]
]
]
]