"
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.
"
SelectionInListView subclass:#MenuView
instanceVariableNames:'selectors args receiver enableFlags disabledFgColor onOffFlags
subMenus subMenuShown superMenu checkColor lineLevel lineInset
masterView hilightStyle needResize hideOnRelease sizeFixed'
classVariableNames:'DefaultCheckColor DefaultViewBackground DefaultForegroundColor
DefaultBackgroundColor DefaultDisabledForegroundColor
DefaultHilightForegroundColor DefaultHilightBackgroundColor
DefaultHilightLevel DefaultHilightStyle DefaultHilightFrameColor
DefaultLineLevel DefaultLineInset DefaultShadowColor
DefaultLightColor'
poolDictionaries:''
category:'Views-Menus'
!
!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.
"
!
documentation
"
a menu view used for both pull-down-menus and pop-up-menus (and also,
for nonModal menus, such as the Launchers click-menu).
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.
2) selectors:selectorArray [args: argArray] [receiver:anObject]
which defines the messages to be sent to the model or
receiver. Giving an explicit receiver overrides the model.
It is also possible to define both actionBlock and selectorArray.
The wellknown popups are created by wrapping a MenuView into an instance of
PopUpMenu (read the description of popupmenu).
menu entries starting with '\c' are check-entries.
menu entries starting with '\b' are checkBox-entries.
menu entries starting with '\t' are thumbUp/Down-entries.
menu entries conisting of '-' alone, are separating lines.
menu entries conisting of '=' alone, are double separating lines.
StyleSheet defaults:
menuFont font to use for menus
menuViewBackground view background (should be same as menuBackgroundColor)
menuForegroundColor foreground color
menuBackgroundColor background color
menuShadowColor shadow color for 3D effects
menuLightColor lightColor for 3D effects
menuHilightForegroundColor hilighted items foregroundColor
menuHilightBackgroundColor hilighted items backgroundColor
menuHilightFrameColor frame arounf hilighted items (or nil, if none)
defaults to selectionHilightFrameColor
menuHilightLevel 3D level of selected items
menuHilightStyle #openwin or nil (special kludge)
menuSeparatingLineLevel 3D level of sep. lines
menuSeparatingLineInset left/right inset of sep. lines
menuDisabledForegroundColor foreground color of disabled items
menuCheckColor color to use for check marks
menuFont font to use
other values and some defaults are inherited via SelectionInListViews
styles (i.e. look for selectionForegroundColor ...)
"
!
examples
"
See real examples in PopUpMenu & PullDownMenu
Examples:
Notice: normally, menuviews are wrapped into either a popup-
menu or pulldown-menu. But they can also be used stand-alone
as in:
|m|
m := MenuView
labels:#('foo'
'bar'
'baz')
selectors:#(
#foo
#bar
#baz)
receiver:nil.
m open
"
! !
!MenuView class methodsFor:'instance creation'!
labels:labels
"create and return a new MenuView. The parent view,
selectors and receiver should be set later."
^ self labels:labels selectors:nil args:nil receiver:nil
!
labels:labels selector:aSelector args:argArray receiver:anObject for:aTopMenu
"create and return a new MenuView
- receiverObject gets message aSelector with argument from
argArray for ALL entries"
"OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a
single symbol-arg for selectors ..."
^ self labels:labels selectors:aSelector args:argArray receiver:anObject in:(aTopMenu superView)
!
labels:labels selector:aSelector args:argArray receiver:anObject in:aTopMenu
"create and return a new MenuView
- receiverObject gets message aSelector with argument from
argArray for all entries"
"OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a
single symbol-arg for selectors ..."
^ self labels:labels selectors:aSelector args:argArray receiver:anObject in:aTopMenu
!
labels:labels selectors:selArray
"create and return a new MenuView. The parent veiw
and receiver should be set later."
^ self labels:labels selectors:selArray args:nil receiver:nil
!
labels:labels selectors:selArray args:argArray
"create and return a new MenuView. The parent view
should be set later."
^ self labels:labels selectors:selArray args:argArray
!
labels:labels selectors:selArray args:argArray receiver:anObject
"create and return a new MenuView. The parent view
should be set later."
^ (self new)
labels:labels
selectors:selArray
args:argArray
receiver:anObject
!
labels:labels selectors:selArray args:argArray receiver:anObject for:aTopMenu
"create and return a new MenuView for a topMenu"
^ self labels:labels selectors:selArray args:argArray receiver:anObject in:(aTopMenu superView)
!
labels:labels selectors:selArray args:argArray receiver:anObject in:aView
"create and return a new MenuView in aView
- receiverObject gets message from selectorArray with argument
from argArray"
^ (self in:aView)
labels:labels
selectors:selArray
args:argArray
receiver:anObject
!
labels:labels selectors:selArray receiver:anObject
"create and return a new MenuView. The parent view
should be set later."
^ self labels:labels selectors:selArray args:nil receiver:anObject
!
labels:labels selectors:selArray receiver:anObject for:aTopMenu
^ self labels:labels selectors:selArray args:nil receiver:anObject for:aTopMenu
!
labels:labels selectors:selArray receiver:anObject in:aView
"create and return a new MenuView in aView
- receiverObject gets message from selectorArray without argument"
^ self labels:labels selectors:selArray args:nil receiver:anObject in:aView
! !
!MenuView class methodsFor:'defaults'!
updateStyleCache
DefaultViewBackground := StyleSheet colorAt:'menuViewBackground'.
DefaultForegroundColor := StyleSheet colorAt:'menuForegroundColor'.
DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
DefaultShadowColor := StyleSheet colorAt:'menuShadowColor'.
DefaultLightColor := StyleSheet colorAt:'menuLightColor'.
DefaultHilightForegroundColor := StyleSheet colorAt:'menuHilightForegroundColor'.
DefaultHilightBackgroundColor := StyleSheet colorAt:'menuHilightBackgroundColor'.
DefaultHilightFrameColor := StyleSheet colorAt:'menuHilightFrameColor'
default:(StyleSheet colorAt:'selectionHilightFrameColor').
DefaultHilightLevel := StyleSheet at:'menuHilightLevel'.
DefaultHilightStyle := StyleSheet at:'menuHilightStyle'.
DefaultLineLevel := StyleSheet at:'menuSeparatingLineLevel'.
DefaultLineInset := StyleSheet at:'menuSeparatingLineInset'.
DefaultDisabledForegroundColor := StyleSheet colorAt:'menuDisabledForegroundColor' default:Color darkGrey.
DefaultCheckColor := StyleSheet colorAt:'menuCheckColor'.
DefaultFont := StyleSheet fontAt:'menuFont'.
! !
!MenuView methodsFor:'accessing-behavior'!
disable:indexOrName
"disable an entry"
self setEnable:indexOrName to:false
!
disableAll
"disable all entries"
self disableAll:selectors
"Created: 23.12.1995 / 16:56:05 / cg"
!
disableAll:collectionOfIndicesOrNames
"disable an collection of entries"
collectionOfIndicesOrNames do:[:entry |
self disable:entry
]
!
enable:indexOrName
"enable an entry"
self setEnable:indexOrName to:true
!
enableAll:collectionOfIndicesOrNames
"enable an collection of entries"
collectionOfIndicesOrNames do:[:entry |
self enable:entry
]
!
hideOnRelease:aBoolean
hideOnRelease := aBoolean
!
isEnabled:indexOrName
|index|
index := self indexOf:indexOrName.
index ~~ 0 ifTrue:[
enableFlags isNil ifTrue:[^ true].
^ enableFlags at:index
].
"ask submenus for convenience"
(indexOrName isNumber not and:[subMenus notNil]) ifTrue:[
subMenus do:[:m |
m notNil ifTrue:[
m enable:indexOrName
]
]
]
!
setEnable:indexOrName to:aBoolean
"enable/disable an entry"
|index|
index := self indexOf:indexOrName.
index ~~ 0 ifTrue:[
(enableFlags at:index) ~~ aBoolean ifTrue:[
enableFlags at:index put:aBoolean.
shown ifTrue:[
self redrawLine:index
]
]
] ifFalse:[
"try submenus for convenience"
(indexOrName isNumber not and:[subMenus notNil]) ifTrue:[
subMenus do:[:m |
m notNil ifTrue:[
m setEnable:indexOrName to:aBoolean
]
]
]
]
! !
!MenuView methodsFor:'accessing-items'!
addLabel:aLabel selector:aSelector
"add another label/selector pair"
list isNil ifTrue:[
list := Array with:aLabel
] ifFalse:[
list := list copyWith:aLabel
].
selectors := selectors copyWith:aSelector.
enableFlags := enableFlags copyWith:true.
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
!
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.
To be independent of the entries label, we recommend you use the selector
as index; in systems which translate strings for national variants,
this makes your code easier to maintain."
^ self addLabel:aLabel
selector:aSelector
before:(self indexOf:aLabelOrSelectorOrNumber) + 1
"
|v1 v2 v3 v4|
v1 := CodeView new realize.
v2 := CodeView new realize.
v2 middleButtonMenu:
v editMenu addLabel:'new entry' selector:#foo after:'paste'.
v3 := CodeView new realize.
v3 middleButtonMenu:
v editMenu addLabel:'new entry' selector:#foo after:#others.
v4 := CodeView new realize.
v4 middleButtonMenu:
v editMenu addLabel:'new entry' selector:#foo after:1.
"
!
addLabel:aLabel selector:aSelector arg:anArg
"add another label/selector/argument trio"
list isNil ifTrue:[
list := Array with:aLabel
] ifFalse:[
list := list copyWith:aLabel
].
selectors := selectors copyWith:aSelector.
args := args copyWith:anArg.
enableFlags := enableFlags copyWith:true.
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
!
addLabel:aLabel selector:aSelector before:aLabelOrSelectorOrNumber
"insert another label/selector pair at some place.
Being very friendly here, allowing label-string, selector or numeric
index for the argument aLabelOrSelectorOrNumber.
To be independent of the entries label, we recommend you use the selector
as index; in systems which translate strings for national variants,
this makes your code easier to maintain."
|idx|
list isNil ifTrue:[
^ self addLabel:aLabel selector:aSelector
].
"
be user friendly - allow both label or selector
to be passed
"
idx := self indexOf:aLabelOrSelectorOrNumber.
(idx between:1 and:list size) ifFalse:[
"add to end"
^ self addLabel:aLabel selector:aSelector
].
list := list asOrderedCollection.
list add:aLabel beforeIndex:idx.
selectors := selectors asOrderedCollection.
selectors add:aSelector beforeIndex:idx.
enableFlags := enableFlags asOrderedCollection.
enableFlags add:true beforeIndex:idx.
subMenus notNil ifTrue:[
subMenus := subMenus asOrderedCollection.
subMenus add:nil beforeIndex:idx.
].
args notNil ifTrue:[
args := args asOrderedCollection.
args add:nil beforeIndex:idx.
].
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
"
|v1 v2 v3 v4|
v1 := CodeView new realize.
v2 := CodeView new realize.
v2 middleButtonMenu:
(v2 editMenu) addLabel:'new entry' selector:#foo before:'paste'.
v3 := CodeView new realize.
v3 middleButtonMenu:
(v3 editMenu) addLabel:'new entry' selector:#foo before:#again.
v4 := CodeView new realize.
v4 middleButtonMenu:
(v4 editMenu) addLabel:'new entry' selector:#foo before:1.
"
!
addLabels:moreLabels selectors:moreSelectors
"add more labels and selectors at the end"
list isNil ifTrue:[
list := moreLabels
] ifFalse:[
list := list , moreLabels
].
selectors := selectors , moreSelectors.
enableFlags := enableFlags , (Array new:moreLabels size withAll:true).
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
!
addLabels:moreLabels selectors:moreSelectors after:aLabelOrSelectorOrNumber
"insert more labels/selectors at some place.
Being very friendly here, allowing label-string, selector or numeric
index for the argument aLabelOrSelectorOrNumber.
To be independent of the entries label, we recommend you use the selector
as index; in systems which translate strings for national variants,
this makes your code easier to maintain."
^ self addLabels:moreLabels
selectors:moreSelectors
before:(self indexOf:aLabelOrSelectorOrNumber) + 1
!
addLabels:moreLabels selectors:moreSelectors before:aLabelOrSelectorOrNumber
"insert more labels/selectors at some place.
Being very friendly here, allowing label-string, selector or numeric
index for the argument aLabelOrSelectorOrNumber.
To be independent of the entries label, we recommend you use the selector
as index; in systems which translate strings for national variants,
this makes your code easier to maintain."
|idx
i "{ Class: SmallInteger }"
nMore "{ Class: SmallInteger }"|
list isNil ifTrue:[
^ self addLabels:moreLabels selectors:moreSelectors
].
"
be user friendly - allow both label or selector
to be passed
"
idx := self indexOf:aLabelOrSelectorOrNumber.
(idx between:1 and:list size) ifFalse:[
"add to end"
^ self addLabels:moreLabels selectors:moreSelectors
].
nMore := moreLabels size.
"/ just a check
moreSelectors size ~~ nMore ifTrue:[
^ self error
].
list := list asOrderedCollection.
i := idx.
moreLabels do:[:aLabel |
list add:aLabel beforeIndex:i. i := i + 1.
].
selectors := selectors asOrderedCollection.
i := idx.
moreSelectors do:[:sel |
selectors add:sel beforeIndex:i. i := i + 1.
].
enableFlags := enableFlags asOrderedCollection.
i := idx.
nMore timesRepeat:[
enableFlags add:true beforeIndex:i. i := i + 1.
].
subMenus notNil ifTrue:[
subMenus := subMenus asOrderedCollection.
i := idx.
nMore timesRepeat:[
subMenus add:nil beforeIndex:i. i := i + 1.
].
].
args notNil ifTrue:[
args := args asOrderedCollection.
i := idx.
nMore timesRepeat:[
args add:nil beforeIndex:i. i := i + 1.
]
].
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
"
|v1 v2 v3 v4 m|
v1 := CodeView new realize.
v2 := CodeView new realize.
m := v2 editMenu.
m
addLabels:#('new entry1' 'new entry2')
selectors:#(foo bar)
before:'paste'.
v2 middleButtonMenu:m.
v3 := CodeView new realize.
m := v3 editMenu.
m
addLabels:#('new entry1' 'new entry2')
selectors:#(foo bar)
before:#again.
v3 middleButtonMenu:m.
v4 := CodeView new realize.
m := v4 editMenu.
m
addLabels:#('new entry1' 'new entry2')
selectors:#(foo bar)
before:1.
v4 middleButtonMenu:m.
"
!
addSeparatingLine
"add a separating line"
self addLabel:'-' selector:nil
!
addSeparatingLineAfter:aLabelOrSelectorOrNumber
"add a separating line"
self addLabel:'-' selector:nil after:aLabelOrSelectorOrNumber
!
args
"return the argument array"
^ args
!
args:anArray
"set the argument array"
args := anArray
!
argsAt:indexOrName put:something
"set an individual selector"
|i|
i := self indexOf:indexOrName.
i ~~ 0 ifTrue:[args at:i put:something]
!
checkFlags
"return an array filled with the check-mark flags.
Non check-menu items have a nil entry in this array."
^ onOffFlags
!
checkToggleAt:indexOrName
"return a check-toggles boolean state"
|index|
index := self indexOf:indexOrName.
index == 0 ifTrue:[^ false].
onOffFlags isNil ifTrue:[^ false].
^ onOffFlags at:index
!
checkToggleAt:indexOrName put:aBoolean
"set/clear a check-toggle"
|index|
index := self indexOf:indexOrName.
index == 0 ifTrue:[^ self].
onOffFlags isNil ifTrue:[
onOffFlags := Array new:(list size)
].
onOffFlags at:index put:aBoolean.
shown ifTrue:[
self redrawLine:index
]
!
indexOf:indexOrName
"return the index of the label named:aName or , if its a symbol
the index in the selector list"
indexOrName isSymbol ifTrue:[
^ selectors indexOf:indexOrName
].
indexOrName isString ifTrue:[
^ list indexOf:indexOrName
].
indexOrName isNil ifTrue:[^ 0].
^ indexOrName
!
labelAt:indexOrName put:aString
"change the label at index to be aString"
|i nItems|
i := self indexOf:indexOrName.
i == 0 ifTrue:[^ self].
list at:i put:aString.
"create onOff flags, if this label has a check-mark"
(self isCheckItem:aString) ifTrue:[
nItems := list size.
onOffFlags isNil ifTrue:[
onOffFlags := Array new:nItems
] ifFalse:[
[onOffFlags size < nItems] whileTrue:[
onOffFlags := onOffFlags copyWith:nil
]
].
onOffFlags at:i put:false
].
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
!
labels
"return the menu-labels"
^ list
!
labels:text
"set the labels to the argument, text"
|l|
(text isString) ifTrue:[
l := text asStringCollection
] ifFalse:[
l := text
].
"/ self list:l
self setList:l expandTabs:false.
enableFlags := Array new:(list size) withAll:true.
onOffFlags := Array new:(list size).
text keysAndValuesDo:[:index :line |
(line notNil and:[line includes:$\ ]) ifTrue:[
onOffFlags at:index put:false
].
].
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
!
labels:text selectors:selArray args:argArray receiver:anObject
"set all relevant stuff"
self labels:text.
selectors := selArray.
args := argArray.
receiver := anObject
!
receiver
"return the receiver of the message"
^ receiver
!
receiver:anObject
"set the receiver of the message"
receiver := anObject.
subMenus notNil ifTrue:[
subMenus do:[:aMenu |
aMenu notNil ifTrue:[
aMenu receiver:anObject
]
]
]
!
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.
].
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
!
selectorAt:indexOrName
"return an individual selector"
|i|
i := self indexOf:indexOrName.
i ~~ 0 ifTrue:[^ selectors at:i].
^ nil
!
selectorAt:indexOrName put:aSelector
"set an individual selector"
|i|
i := self indexOf:indexOrName.
i ~~ 0 ifTrue:[selectors at:i put:aSelector]
!
selectors
"return the selector array"
^ selectors
!
selectors:anArray
"set the selector array"
selectors := anArray
!
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
].
subMenus notNil ifTrue:[
subMenus do:[:aMenu |
|item|
aMenu notNil ifTrue:[
(item := aMenu someMenuItemLabeled:aLabel) notNil ifTrue:[
^ item
]
]
].
].
^ nil
! !
!MenuView methodsFor:'accessing-look'!
font:aFont
"adjust size for new font"
super font:(aFont on:device).
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
! !
!MenuView methodsFor:'accessing-misc'!
masterView
"return the popup-masterview I am contained in."
^ masterView
!
masterView:aPopUpView
"set the popup-masterview I am contained in."
masterView := aPopUpView
!
selection:index
|sel line|
sel := index.
sel notNil ifTrue:[
line := self listAt:index.
(self isGraphicItem:line) ifTrue:[
"
not really selectable, but a separating line
"
sel := nil
]
].
super selection:sel
!
sizeFixed:aBoolean
sizeFixed := aBoolean
"Created: 9.2.1996 / 01:12:40 / cg"
!
superMenu
"ret the menu I am contained in
- need this to hide main menus when a submenu performed its action"
^ superMenu
!
superMenu:aMenu
"set the menu I am contained in
- need this to hide main menus when a submenu performed its action"
superMenu := aMenu
! !
!MenuView methodsFor:'accessing-submenus'!
subMenuAt:indexOrName
"return a submenu, or nil"
|i|
subMenus isNil ifTrue:[^ nil].
i := self indexOf:indexOrName.
i == 0 ifTrue:[^ nil].
^ subMenus at:i
!
subMenuAt:indexOrName put:aPopUpMenu
"define a submenu"
|i newSubMenus|
i := self indexOf:indexOrName.
i == 0 ifTrue:[^ nil].
subMenus size < i ifTrue:[
newSubMenus := Array new:(list size max:i).
subMenus notNil ifTrue:[
newSubMenus replaceFrom:1 with:subMenus.
].
subMenus := newSubMenus.
shown ifTrue:[
self resize
] ifFalse:[
needResize := true
]
].
subMenus at:i put:aPopUpMenu
!
subMenuShown
"return the currently visible submenu - or nil if there is none"
^ subMenuShown
! !
!MenuView methodsFor:'disabled scrolling'!
makeSelectionVisible
^ self
! !
!MenuView methodsFor:'event handling'!
buttonMotion:state x:x y:y
state ~~ 0 ifTrue:[
self setSelectionForX:x y:y
]
!
buttonPress:button x:x y:y
self setSelectionForX:x y:y
!
buttonRelease:button x:x y:y
|theSelector isCheck checkOn val|
subMenuShown notNil ifTrue:[
^ self
].
(x >= 0 and:[x < width]) ifTrue:[
(y >= 0 and:[y < height]) ifTrue:[
selection notNil ifTrue:[
(subMenus isNil or:[(subMenus at:selection) isNil]) ifTrue:[
self showActive.
[
superMenu notNil ifTrue:[
superMenu showActive
].
val := selection.
args notNil ifTrue:[
val := args at:selection
].
isCheck := false.
onOffFlags notNil ifTrue:[
onOffFlags size >= selection ifTrue:[
checkOn := (onOffFlags at:selection).
isCheck := checkOn notNil.
isCheck ifTrue:[
checkOn := val := checkOn not.
onOffFlags at:selection put:checkOn.
]
]
].
"
ST-80 style model notification
"
self sendChangeMessageWith:val.
"
either action-block or selectors-array-style
"
actionBlock notNil ifTrue:[
AbortSignal handle:[:ex |
ex return
] do:[
actionBlock value:selection
]
] ifFalse:[
selectors notNil ifTrue: [
device activePointerGrab == self ifTrue:[
device ungrabPointer.
].
selectors isSymbol ifFalse:[
(selection notNil
and:[selection <= selectors size]) ifTrue:[
theSelector := selectors at:selection
]
] ifTrue:[
theSelector := selectors
].
theSelector notNil ifTrue:[
AbortSignal handle:[:ex |
ex return
] do:[
isCheck ifTrue:[
self redrawLine:selection.
receiver perform:theSelector with:checkOn
] ifFalse:[
(args isNil or:[theSelector numArgs == 0]) ifTrue:[
receiver perform:theSelector
] ifFalse:[
receiver perform:theSelector with:val
]
]
]
]
]
].
] valueNowOrOnUnwindDo:[
realized ifTrue:[
self showPassive.
].
superMenu notNil ifTrue:[
superMenu showPassive
]
].
].
]
]
].
(superMenu notNil and:[superMenu shown not]) ifTrue:[
(superView notNil and:[superView shown]) ifTrue:[superView hide].
].
hideOnRelease ifTrue:[
superView hide
].
!
keyPress:aKey x:x y:y
|m|
subMenuShown notNil ifTrue:[
subMenuShown keyPress:aKey x:0 y:0.
^ self
].
"
Return, space or the (virtual) MenuSelect
key trigger a selected entry.
"
(aKey == #Return
or:[aKey == #MenuSelect
or:[aKey == Character space]]) ifTrue:[
selection notNil ifTrue:[
(subMenus notNil and:[(m := subMenus at:selection) notNil]) ifTrue:[
self showSubmenu:selection.
m hideOnLeave:false
] ifFalse:[
subMenuShown := nil.
self buttonRelease:1 x:x y:y.
]
].
^ self
].
aKey == #Escape ifTrue:[
masterView notNil ifTrue:[
masterView hide.
].
^ self
].
super keyPress:aKey x:x y:y
!
pointerLeave:state
subMenuShown notNil ifTrue:[
^ self
].
"/ self setSelectionForX:-1 y:-1. "force deselect"
subMenuShown isNil ifTrue:[
self selection:nil
].
"/ superMenu notNil ifTrue:[
"/ superMenu regainControl.
"/ ]
! !
!MenuView methodsFor:'initialize / release'!
create
super create.
subMenuShown := nil.
self resizeIfChanged
!
destroy
"
have to destroy the submenus manually here,
since they are no real subviews of myself
"
subMenus notNil ifTrue:[
subMenus do:[:m |
m notNil ifTrue:[
m destroy
]
].
subMenus := nil
].
super destroy.
!
initEvents
super initEvents.
self enableLeaveEvents.
windowGroup notNil ifTrue:[
windowGroup sensor compressMotionEvents:true
]
!
initStyle
|style|
super initStyle.
"/ DefaultFont notNil ifTrue:[font := DefaultFont on:device].
DefaultCheckColor notNil ifTrue:[
checkColor := DefaultCheckColor
] ifFalse:[
checkColor := fgColor.
].
disabledFgColor := DefaultDisabledForegroundColor on:device.
DefaultForegroundColor notNil ifTrue:[
fgColor := DefaultForegroundColor on:device
].
DefaultBackgroundColor notNil ifTrue:[
bgColor := DefaultBackgroundColor on:device
].
DefaultShadowColor notNil ifTrue:[
shadowColor := DefaultShadowColor on:device
].
DefaultLightColor notNil ifTrue:[
lightColor := DefaultLightColor on:device
].
DefaultHilightLevel notNil ifTrue:[
hilightLevel := DefaultHilightLevel
] ifFalse:[
hilightLevel := 0.
].
hilightStyle := DefaultHilightStyle.
hilightFrameColor := DefaultHilightFrameColor.
styleSheet is3D ifTrue:[
"some 3D style menu - set hilight defaults to same"
DefaultHilightForegroundColor notNil ifTrue:[
hilightFgColor := DefaultHilightForegroundColor on:device
] ifFalse:[
hilightFgColor := fgColor.
].
DefaultHilightBackgroundColor notNil ifTrue:[
hilightBgColor := DefaultHilightBackgroundColor on:device
] ifFalse:[
hilightBgColor := bgColor.
].
DefaultLineLevel notNil ifTrue:[
lineLevel := DefaultLineLevel
] ifFalse:[
lineLevel := -1.
]
] ifFalse:[
"some 2D style menu - set hilight defaults to inverse"
DefaultHilightForegroundColor notNil ifTrue:[
hilightFgColor := DefaultHilightForegroundColor on:device
] ifFalse:[
hilightFgColor := bgColor.
].
DefaultHilightBackgroundColor notNil ifTrue:[
hilightBgColor := DefaultHilightBackgroundColor on:device
] ifFalse:[
hilightBgColor := fgColor.
].
DefaultLineLevel notNil ifTrue:[
lineLevel := DefaultLineLevel
] ifFalse:[
lineLevel := 0.
]
].
DefaultLineInset notNil ifTrue:[
lineInset := DefaultLineInset
] ifFalse:[
lineInset := (device horizontalPixelPerMillimeter * 0.8) rounded.
].
"
the following has to be changed to
use the styleSheet too
"
style := styleSheet name.
(style == #iris) ifTrue:[
device hasGreyscales ifTrue:[
lineSpacing := 3
].
].
(style == #motif) ifTrue:[
lineSpacing := (2 * hilightLevel)
].
hilightStyle == #openwin ifTrue:[
"add some space for rounded-hilight area"
self leftMargin:10.
] ifFalse:[
(hilightLevel ~~ 0) ifTrue:[
self leftMargin:hilightLevel abs + self margin abs + 1.
lineSpacing := lineSpacing max:(hilightLevel abs * 2).
]
].
(style == #st80) ifTrue:[
level := 0.
].
DefaultViewBackground notNil ifTrue:[
viewBackground := DefaultViewBackground on:device
].
"Modified: 22.11.1995 / 23:18:54 / cg"
!
initialize
|style|
super initialize.
hideOnRelease := false.
autoScroll := false.
sizeFixed := false.
(((style := styleSheet name) ~~ #normal)
and:[style ~~ #mswindows]) ifTrue:[
borderWidth := 1.
(style ~~ #st80) ifTrue:[self level:1]
].
"stupid - have to redo this ..."
hilightStyle == #openwin ifTrue:[
"add some space for rounded-hilight area"
self leftMargin:10.
].
"Modified: 9.2.1996 / 01:36:06 / cg"
!
recreate
"when recreated after a snapin, resize myself, in case
font dimensions have changed on the display"
super recreate.
hilightStyle == #openwin ifTrue:[
self leftMargin:10.
].
self resize
!
reinitialize
"this is called right after snapIn;
a kind of kludge - reset cursor (in case the save was
done with myself being shown and active)"
super reinitialize.
selection := nil. "self selection:nil."
self showPassive
! !
!MenuView methodsFor:'private'!
hideSubmenu
subMenuShown notNil ifTrue:[
subMenuShown hide.
subMenuShown := nil
].
!
isCheckItem:line
line notNil ifTrue:[
(line includesString:'\c') ifTrue:[^ true].
(line includesString:'\b') ifTrue:[^ true].
(line includesString:'\t')ifTrue:[^ true].
].
^ false.
"Modified: 26.2.1996 / 23:16:12 / cg"
!
isGraphicItem:line
(line = '-') ifTrue:[^ true].
(line = '=') ifTrue:[^ true].
(line = '') ifTrue:[^ true].
^ false.
!
recomputeSize
"resize myself to my preferred size
OBSOLETE - use resize"
self resize.
!
resize
"resize myself to my preferred size"
sizeFixed == true ifFalse:[
widthOfWidestLine := nil. "/ i.e. unknown
super resize.
]
"Modified: 9.2.1996 / 02:42:32 / cg"
!
resizeIfChanged
needResize == true ifTrue:[
self resize.
needResize := false
]
!
setSelectionForX:x y:y
"select whatever is under x/y coordinate - if there is
a subMenu, show it"
|newSelection subMenu|
(x < 0
or:[x >= width
or:[y < 0
or:[y >= height]]]) ifTrue:[
"
moved outside submenu, but not within self
"
subMenuShown notNil ifTrue:[
^ self
].
superMenu notNil ifTrue:[
superMenu regainControl
].
].
newSelection := self positionToSelectionX:x y:y.
newSelection ~= selection ifTrue:[
newSelection notNil ifTrue:[
(enableFlags at:newSelection) ifFalse:[
newSelection := nil
]
].
self selection:newSelection.
subMenuShown notNil ifTrue:[
self hideSubmenu.
].
].
subMenu := nil.
selection notNil ifTrue:[
subMenus notNil ifTrue:[
x > (width // 2) ifTrue:[
subMenu := (subMenus at:selection)
]
]
].
subMenu notNil ifTrue:[
self showSubmenu:selection.
] ifFalse:[
subMenuShown notNil ifTrue:[
self hideSubmenu.
].
subMenuShown := nil
]
!
showSubmenu:index
"show subMenu at index"
|org mx my m|
m := subMenus at:index.
m isNil ifTrue:[^ self].
m == subMenuShown ifTrue:[^ self].
mx := width - 5.
my := self yOfVisibleLine:index.
"
need to know the physical screen coordinate,
to map the subview there
"
org := device
translatePoint:(mx @ my)
from:(self id)
to:(device rootWindowId).
"/ mhmh - is this still needed ?
"
before showing, process all of my expose events
"
windowGroup notNil ifTrue:[
windowGroup processExposeEvents
].
m superMenu:self.
"
realize the submenu in MY windowgroup
"
windowGroup notNil ifTrue:[
m windowGroup:windowGroup.
windowGroup addTopView:m.
].
m fixSize.
m origin:org.
m makeFullyVisible.
m noShadow.
m realize.
device flush.
subMenuShown := m
! !
!MenuView methodsFor:'queries'!
preferredExtent
|margin2 w h|
widthOfWidestLine := nil. "/ i.e. unknown
margin2 := margin * 2.
w := self widthOfContents + leftMargin + leftMargin + margin2.
h := (self numberOfLines) * fontHeight - lineSpacing + (2 * topMargin) + margin2.
hilightLevel ~~ 0 ifTrue:[
h := h + (hilightLevel abs)
].
"if there is a submenu, add some space for the right arrow"
subMenus notNil ifTrue:[
w := w + 16
].
^ (w @ h).
! !
!MenuView methodsFor:'redrawing'!
drawCheckLine:line inVisibleLine:visLineNr with:fg and:bg
"draw an on/off-mark (or the space for it).
Supported checkmark types:
\c simple mark; space if off
\b box mark
\t thumbsUp/thumbsDown mark
"
|w h y x l check xR yB form markIndex i2 markType|
l := self visibleLineToListLine:visLineNr.
onOffFlags isNil ifTrue:[
check := false
] ifFalse:[
check := (onOffFlags at:l) == true.
].
i2 := markIndex := 1.
[markIndex ~~ 0 and:[i2 ~~ (markIndex+1)]] whileTrue:[
markIndex := line indexOf:$\.
i2 := line indexOfAny:'cbt' startingAt:markIndex+1.
].
markType := line at:i2.
x := (self xOfCol:markIndex inVisibleLine:visLineNr) - leftOffset.
y := (self yOfVisibleLine:visLineNr) - (lineSpacing//2).
markIndex ~~ 1 ifTrue:[
super drawVisibleLine:visLineNr from:1 to:(markIndex-1) with:fg and:bg.
] ifFalse:[
self paint:bg.
self fillRectangleX:margin y:y width:(textStartLeft - margin) height:fontHeight.
].
(markType == $c) ifTrue:[
w := font widthOf:'V'.
] ifFalse:[
(markType == $b) ifTrue:[
w := font maxWidth. "/ font widthOf:' '.
] ifFalse:[
(markType == $t) ifTrue:[
w := 16.
check ifTrue:[form := Cursor thumbsUp sourceForm]
ifFalse:[form := Cursor thumbsDown sourceForm]
]
]
].
self paint:bg.
self fillRectangleX:x y:y width:w height:fontHeight.
self drawLine:(line copyFrom:markIndex+2) atX:x+w inVisible:visLineNr with:fg and:bg.
self paint:(check ifTrue:[checkColor == bg ifTrue:[fg] ifFalse:[checkColor]] ifFalse:[fg]).
h := font ascent.
y := y + (font height - h // 2).
yB := y + h - 1.
(markType == $c) ifTrue:[
check ifTrue:[
xR := x + (w // 3).
self displayLineFromX:x y:(y + (h // 2)) toX:xR y:yB.
self displayLineFromX:xR y:yB toX:(x + w - 1) y:y
]
] ifFalse:[
(markType == $t) ifTrue:[
self displayForm:form x:x y:y
] ifFalse:[
(markType == $b) ifTrue:[
check ifTrue:[
xR := x + w - 2.
self displayLineFromX:x y:y toX:xR y:yB.
self displayLineFromX:xR y:y toX:x y:yB.
].
self paint:fg.
self displayRectangleX:x y:y width:h height:h.
]
]
]
"Modified: 31.8.1995 / 19:27:02 / claus"
"Created: 26.2.1996 / 23:18:00 / cg"
"Modified: 26.2.1996 / 23:39:34 / cg"
!
drawVisibleLine:visLineNr with:fg and:bg
|lineString isSpecial|
'draw' printNL.
lineString := self visibleAt:visLineNr.
isSpecial := lineString notNil and:[lineString includes:$\].
isSpecial ifFalse:[
"
a normal entry
"
^ super drawVisibleLine:visLineNr with:fg and:bg
].
"
some speciality in this line
"
(self isCheckItem:lineString) ifTrue:[
"
(check-mark)
"
^ self drawCheckLine:lineString inVisibleLine:visLineNr with:fg and:bg
].
"
ignored escape ...
"
^ super drawLine:lineString inVisible:visLineNr with:fg and:bg.
"Modified: 26.2.1996 / 23:30:51 / cg"
!
drawVisibleLineSelected:visLineNr
"redraw a single line as selected."
|listLine fg bg
y "{ Class: SmallInteger }"
y2 "{ Class: SmallInteger }"
r2 radius topLeftColor botRightColor |
hilightStyle ~~ #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 yOfVisibleLine:visLineNr) - (lineSpacing//2).
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
"Modified: 22.11.1995 / 23:28:47 / cg"
!
redrawFromVisibleLine:start to:stop
"redraw a line range - redefined to care for special entries."
"the natural way to do it is:
start to:stop do:[:visLine |
self redrawVisibleLine:visLine
]
but I want to draw the stuff in big chunks for slow machines ..."
|first
index "{ Class: SmallInteger }"
current "{ Class: SmallInteger }"
line special index0|
index0 := self visibleLineToListLine:start.
index0 notNil ifTrue:[
index := index0.
first := start.
current := start.
[current <= stop] whileTrue:[
line := (self visibleAt:current) string.
special := line notNil
and:[(self isGraphicItem:line)
or:[line includes:$\ ]].
(special
or:[(enableFlags at:index) not]) ifTrue:[
"a special case"
(first < current) ifTrue:[
super redrawFromVisibleLine:first to:(current - 1)
].
self redrawVisibleLine:current.
first := current + 1
].
current := current + 1.
index := index + 1
].
(first < current) ifTrue:[
super redrawFromVisibleLine:first to:(current - 1)
].
"draw submenu marks"
subMenus notNil ifTrue:[
index := index0.
start to:stop do:[:l |
index <= subMenus size ifTrue:[
(subMenus at:index) notNil ifTrue:[
self drawRightArrowInVisibleLine:l
].
index := index + 1
]
]
]
]
"Modified: 26.2.1996 / 23:31:18 / cg"
!
redrawVisibleLine:visLineNr
"redefined from normal list-line drawing, to handle special
lines. These are:
lines consisting of '-' only: draw a horizontal separating line
lines consisting of '=' only: draw double separating line
empty line : leave blank
there may be more in the future.
"
|line lineNr y isSpecial isSeparatingLine
isDoubleLine right clr1 clr2|
line := self visibleAt:visLineNr.
isSpecial := isDoubleLine := isSeparatingLine := false.
(line = '-') ifTrue:[
isSeparatingLine := isSpecial := true.
] ifFalse:[
(line = '=') ifTrue:[
isSeparatingLine := isSpecial := isDoubleLine := true.
] ifFalse:[
(line = '') ifTrue:[
isSpecial := true
]
]
].
isSpecial ifFalse:[
lineNr := self visibleLineToListLine:visLineNr.
(enableFlags at:lineNr) ifFalse:[
self drawVisibleLine:visLineNr with:disabledFgColor and:bgColor
] ifTrue:[
super redrawVisibleLine:visLineNr
].
"is there a submenu ?"
(subMenus notNil and:[(subMenus at:lineNr) notNil]) ifTrue:[
self drawRightArrowInVisibleLine:visLineNr
].
^ self
].
"handle separating lines"
y := self yOfVisibleLine:visLineNr.
self paint:bgColor.
self fillRectangleX:0 y:y width:width height:fontHeight.
isSeparatingLine ifTrue:[
y := y + (fontHeight // 2).
isDoubleLine ifTrue:[
y := y - (fontHeight // 8).
].
right := width - 1 - lineInset.
lineLevel == 0 ifTrue:[
self paint:fgColor.
self displayLineFromX:lineInset y:y toX:right y:y.
isDoubleLine ifTrue:[
y := y + (fontHeight // 4).
self displayLineFromX:lineInset y:y toX:right y:y
]
] ifFalse:[
"the inset on each side"
lineLevel < 0 ifTrue:[
clr1 := shadowColor.
clr2 := lightColor.
] ifFalse:[
clr1 := lightColor.
clr2 := shadowColor.
].
self paint:clr1.
self displayLineFromX:lineInset y:y toX:right y:y.
self paint:clr2.
y := y + 1.
self displayLineFromX:lineInset y:y toX:right y:y.
isDoubleLine ifTrue:[
y := y + (fontHeight // 4).
self displayLineFromX:lineInset y:y toX:right y:y.
y := y - 1.
self paint:clr1.
self displayLineFromX:lineInset y:y toX:right y:y.
]
]
]
!
redrawVisibleLine:visLine col:col
"redefined to always draw a full line - for openwin handling"
self redrawVisibleLine:visLine
!
redrawVisibleLine:visLine from:startCol
"redefined to always draw a full line - for openwin handling"
self redrawVisibleLine:visLine
!
redrawVisibleLine:visLine from:startCol to:endCol
"redefined to always draw a full line - for openwin handling"
self redrawVisibleLine:visLine
! !
!MenuView methodsFor:'selections'!
isValidSelection:aNumber
"return true, if aNumber is ok for a selection lineNo"
|line|
(super isValidSelection:aNumber) ifFalse:[^ false].
line := self listAt:aNumber.
^ (self isGraphicItem:line) not
! !
!MenuView methodsFor:'showing'!
realize
needResize == true ifTrue:[
self recomputeSize
].
super realize
!
show
hiddenOnRealize := false.
self realize
! !
!MenuView methodsFor:'submenu notifications'!
regainControl
"take over pointer control from a submenu"
masterView notNil ifTrue:[
masterView regainControl
].
!
showActive
"submenu is about to perform a menu-action - show wait cursor here as well"
self cursor:(Cursor wait)
!
showPassive
"submenu has finished its menu-action - show normal cursor again"
self cursor:(Cursor hand)
!
submenuTriggered
"submenu has performed some action - have to deselect here"
self selection:nil.
"a bad kludge - 5 minutes before writing the alpha tapes ..."
(superView isKindOf:PopUpMenu) ifTrue:[
superView hide
].
superMenu notNil ifTrue:[
superMenu submenuTriggered
].
! !
!MenuView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.47 1996-02-26 22:40:34 cg Exp $'
! !