--- a/MenuView.st Wed Feb 28 15:29:08 1996 +0100
+++ b/MenuView.st Wed Feb 28 19:46:01 1996 +0100
@@ -13,13 +13,14 @@
SelectionInListView subclass:#MenuView
instanceVariableNames:'selectors args receiver enableFlags disabledFgColor onOffFlags
subMenus subMenuShown superMenu checkColor lineLevel lineInset
- masterView hilightStyle needResize hideOnRelease sizeFixed'
+ masterView hilightStyle needResize hideOnRelease sizeFixed
+ shortKeys maxShortKeyStringLen'
classVariableNames:'DefaultCheckColor DefaultViewBackground DefaultForegroundColor
DefaultBackgroundColor DefaultDisabledForegroundColor
DefaultHilightForegroundColor DefaultHilightBackgroundColor
DefaultHilightLevel DefaultHilightStyle DefaultHilightFrameColor
DefaultLineLevel DefaultLineInset DefaultShadowColor
- DefaultLightColor'
+ DefaultLightColor ShowAcceleratorKeys'
poolDictionaries:''
category:'Views-Menus'
!
@@ -155,6 +156,45 @@
^ self labels:labels selectors:selArray args:nil receiver:nil
!
+labels:labels selectors:selArray accelerators:shorties
+ "create and return a new MenuView. The parent veiw
+ and receiver should be set later."
+
+ ^ self labels:labels selectors:selArray accelerators:shorties args:nil receiver:nil
+!
+
+labels:labels selectors:selArray accelerators:shorties args:argArray receiver:anObject
+ "create and return a new MenuView. The parent view
+ should be set later."
+
+ ^ (self new)
+ labels:labels
+ selectors:selArray
+ accelerators:shorties
+ args:argArray
+ receiver:anObject
+!
+
+labels:labels selectors:selArray accelerators:shorties 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
+ accelerators:shorties
+ args:argArray
+ receiver:anObject
+!
+
+labels:labels selectors:selArray accelerators:shorties receiver:anObject
+ "create and return a new MenuView. The parent view
+ should be set later."
+
+ ^ self labels:labels selectors:selArray accelerators:shorties args:nil receiver:anObject
+!
+
labels:labels selectors:selArray args:argArray
"create and return a new MenuView. The parent view
should be set later."
@@ -317,21 +357,29 @@
!MenuView methodsFor:'accessing-items'!
-addLabel:aLabel selector:aSelector
- "add another label/selector pair"
+accelerators:collectionOfShortKeys
+ "set the accelerator keys collection.
+ You should pass translated symbolic keys - the menu will automatically
+ show the untranslated original key sequences."
- list isNil ifTrue:[
- list := Array with:aLabel
+ shortKeys := collectionOfShortKeys.
+ maxShortKeyStringLen := nil.
+ shown ifTrue:[
+ self resize
] ifFalse:[
- list := list copyWith:aLabel
+ needResize := true
].
- selectors := selectors copyWith:aSelector.
- enableFlags := enableFlags copyWith:true.
- shown ifTrue:[
- self resize
- ] ifFalse:[
- needResize := true
- ]
+
+ "Created: 28.2.1996 / 17:15:31 / cg"
+ "Modified: 28.2.1996 / 18:27:30 / cg"
+!
+
+addLabel:aLabel selector:aSelector
+ "add another label/selector pair at the end"
+
+ self addLabel:aLabel selector:aSelector after:nil
+
+ "Modified: 28.2.1996 / 17:54:11 / cg"
!
addLabel:aLabel selector:aSelector after:aLabelOrSelectorOrNumber
@@ -343,44 +391,43 @@
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
+ self
+ addLabels:(Array with:aLabel)
+ selectors:(Array with:aSelector)
+ after:aLabelOrSelectorOrNumber
+
"
|v1 v2 v3 v4|
- v1 := CodeView new realize.
+ v1 := CodeView new open.
- v2 := CodeView new realize.
+ v2 := CodeView new open.
v2 middleButtonMenu:
- v editMenu addLabel:'new entry' selector:#foo after:'paste'.
+ (v2 editMenu addLabel:'new entry' selector:#foo after:#pasteSelection; yourself).
- v3 := CodeView new realize.
+ v3 := CodeView new open.
v3 middleButtonMenu:
- v editMenu addLabel:'new entry' selector:#foo after:#others.
+ (v3 editMenu addLabel:'new entry' selector:#foo after:#others; yourself).
- v4 := CodeView new realize.
+ v4 := CodeView new open.
v4 middleButtonMenu:
- v editMenu addLabel:'new entry' selector:#foo after:1.
+ (v4 editMenu addLabel:'new entry' selector:#foo after:1; yourself).
"
+
+ "Modified: 28.2.1996 / 18:04:35 / cg"
!
addLabel:aLabel selector:aSelector arg:anArg
- "add another label/selector/argument trio"
+ "add another label/selector/argument trio.
+ OBSOLETE"
+
+ |idx|
- 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
- ]
+ idx := list size + 1.
+ self addLabel:aLabel selector:aSelector.
+ args at:idx put:anArg
+
+ "Modified: 28.2.1996 / 18:08:39 / cg"
!
addLabel:aLabel selector:aSelector before:aLabelOrSelectorOrNumber
@@ -392,203 +439,311 @@
as index; in systems which translate strings for national variants,
this makes your code easier to maintain."
+ self
+ addLabels:(Array with:aLabel)
+ selectors:(Array with:aSelector)
+ before:aLabelOrSelectorOrNumber
+
+ "
+ |v1 v2 v3 v4 v5|
+
+ v1 := CodeView new open.
+
+ v2 := CodeView new open.
+ v2 middleButtonMenu:
+ (v2 editMenu addLabel:'new entry' selector:#foo before:'paste'; yourself).
+
+ v3 := CodeView new open.
+ v3 middleButtonMenu:
+ (v3 editMenu addLabel:'new entry' selector:#foo before:#pasteOrReplace; yourself).
+
+ v4 := CodeView new open.
+ v4 middleButtonMenu:
+ (v4 editMenu addLabel:'new entry' selector:#foo before:#again; yourself).
+
+ v5 := CodeView new open.
+ v5 middleButtonMenu:
+ (v5 editMenu addLabel:'new entry' selector:#foo before:1; yourself).
+
+ Notice: v2 above is an example on how NOT to do it - it will not work with nationalized menus
+ "
+
+ "Modified: 28.2.1996 / 18:04:00 / cg"
+!
+
+addLabels:moreLabels selectors:moreSelectors
+ "add more labels and selectors at the END"
+
+ self addLabels:moreLabels selectors:moreSelectors after:nil
+
+ "Modified: 28.2.1996 / 17:46:50 / cg"
+!
+
+addLabels:moreLabels selectors:moreSelectors accelerators:shorties
+ "add more labels and selectors at the END"
+
+ self addLabels:moreLabels selectors:moreSelectors accelerators:shorties after:nil
+
+ "Modified: 28.2.1996 / 17:46:50 / cg"
+ "Created: 28.2.1996 / 17:47:17 / cg"
+!
+
+addLabels:moreLabels selectors:moreSelectors accelerators:shorties after:aLabelOrSelectorOrNumber
+ "insert more labels/selectors at some place.
+ Being very friendly here, allowing label-string, selector or numeric
+ index for the argument aLabelOrSelectorOrNumber.
+ If such an item is not found, insert the new items at the END.
+
+ 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|
+ aLabelOrSelectorOrNumber isNil ifTrue:[
+ idx := list size + 1
+ ] ifFalse:[
+ idx := (self indexOf:aLabelOrSelectorOrNumber) + 1.
+ idx == 1 ifTrue:[
+ idx := list size + 1
+ ]
+ ].
+
+ ^ self
+ addLabels:moreLabels
+ selectors:moreSelectors
+ accelerators:shorties
+ before:idx
+
+ "Created: 28.2.1996 / 17:48:24 / cg"
+ "Modified: 28.2.1996 / 18:07:06 / cg"
+!
+
+addLabels:moreLabels selectors:moreSelectors accelerators:shorties before:aLabelOrSelectorOrNumber
+ "insert more labels/selectors at some place.
+ Being very friendly here, allowing label-string, selector or numeric
+ index for the argument aLabelOrSelectorOrNumber.
+ If such an item is not found, insert the new items at the beginning.
+
+ 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 oldSize
+ i "{ Class: SmallInteger }"
+ nMore "{ Class: SmallInteger }"|
+
list isNil ifTrue:[
- ^ self addLabel:aLabel selector:aSelector
+ ^ 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 addLabel:aLabel selector:aSelector
+ aLabelOrSelectorOrNumber isNil ifTrue:[
+ idx := 1
+ ] ifFalse:[
+ idx := self indexOf:aLabelOrSelectorOrNumber.
+ (idx between:1 and:list size) ifFalse:[
+ "add to beginning"
+ idx := 1
+ ]
].
+ nMore := moreLabels size.
+ "/ just a check
+ moreSelectors size ~~ nMore ifTrue:[
+ ^ self error
+ ].
+
+ oldSize := list size.
+
list := list asOrderedCollection.
- list add:aLabel beforeIndex:idx.
+ i := idx.
+ moreLabels do:[:aLabel |
+ list add:aLabel beforeIndex:i. i := i + 1.
+ ].
+
selectors := selectors asOrderedCollection.
- selectors add:aSelector beforeIndex:idx.
+ i := idx.
+ moreSelectors do:[:sel |
+ selectors add:sel beforeIndex:i. i := i + 1.
+ ].
+
enableFlags := enableFlags asOrderedCollection.
- enableFlags add:true beforeIndex:idx.
+ i := idx.
+ nMore timesRepeat:[
+ enableFlags add:true beforeIndex:i. i := i + 1.
+ ].
+
subMenus notNil ifTrue:[
- subMenus := subMenus asOrderedCollection.
- subMenus add:nil beforeIndex:idx.
+ subMenus := subMenus asOrderedCollection.
+ i := idx.
+ nMore timesRepeat:[
+ subMenus add:nil beforeIndex:i. i := i + 1.
+ ].
].
args notNil ifTrue:[
- args := args asOrderedCollection.
- args add:nil beforeIndex:idx.
+ args := args asOrderedCollection.
+ i := idx.
+ nMore timesRepeat:[
+ args add:nil beforeIndex:i. i := i + 1.
+ ]
+ ].
+ shortKeys isNil ifTrue:[
+ shortKeys := OrderedCollection new:oldSize.
+ shortKeys grow:oldSize
].
+ shortKeys := shortKeys asOrderedCollection.
+ i := idx.
+ shorties isNil ifTrue:[
+ nMore timesRepeat:[
+ shortKeys add:nil beforeIndex:i. i := i + 1.
+ ]
+ ] ifFalse:[
+ maxShortKeyStringLen := nil.
+ shorties do:[:sel |
+ shortKeys add:sel beforeIndex:i. i := i + 1.
+ ]
+ ].
+
shown ifTrue:[
- self resize
+ self resize
] ifFalse:[
- needResize := true
- ]
+ needResize := true
+ ].
"
- |v1 v2 v3 v4|
+ |v1 v2 v3 v4 v5 m|
+
- v1 := CodeView new realize.
+ v1 := CodeView new open.
+ v1 contents:'original menu'.
- v2 := CodeView new realize.
- v2 middleButtonMenu:
- (v2 editMenu) addLabel:'new entry' selector:#foo before:'paste'.
+ v2 := CodeView new open.
+ v2 contents:'before copy'.
+ m := v2 editMenu.
+ m
+ addLabels:#('new entry1' 'new entry2')
+ selectors:#(foo bar)
+ before:#copySelection
+ accelerators:#(Copy Cut Paste).
+ v2 middleButtonMenu:m.
- v3 := CodeView new realize.
- v3 middleButtonMenu:
- (v3 editMenu) addLabel:'new entry' selector:#foo before:#again.
+ v3 := CodeView new open.
+ v3 contents:'before again '.
+ m := v3 editMenu.
+ m
+ addLabels:#('new entry1' 'new entry2')
+ selectors:#(foo bar)
+ before:#again.
+ v3 middleButtonMenu:m.
- v4 := CodeView new realize.
- v4 middleButtonMenu:
- (v4 editMenu) addLabel:'new entry' selector:#foo before:1.
+ v4 := CodeView new open.
+ v4 contents:'at beginning '.
+ m := v4 editMenu.
+ m
+ addLabels:#('new entry1' 'new entry2' '-')
+ selectors:#(foo bar nil)
+ before:1.
+ v4 middleButtonMenu:m.
+
+ v5 := CodeView new open.
+ v5 contents:'at end '.
+ m := v5 editMenu.
+ m
+ addLabels:#('-' 'new entry1' 'new entry2')
+ selectors:#(nil foo bar).
+ v5 middleButtonMenu:m.
"
-!
-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
- ]
+ "Created: 28.2.1996 / 17:49:44 / cg"
+ "Modified: 28.2.1996 / 18:27:48 / cg"
!
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.
+ If such an item is not found, insert the new items at the END.
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
+ ^ self
+ addLabels:moreLabels
+ selectors:moreSelectors
+ accelerators:nil
+ after:aLabelOrSelectorOrNumber
+
+ "Modified: 28.2.1996 / 17:47:52 / cg"
!
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.
+ If such an item is not found, insert the new items at the beginning.
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
- ]
+ self
+ addLabels:moreLabels
+ selectors:moreSelectors
+ accelerators:nil
+ before:aLabelOrSelectorOrNumber
"
|v1 v2 v3 v4 m|
- v1 := CodeView new realize.
+ v1 := CodeView new open.
- v2 := CodeView new realize.
+ v2 := CodeView new open.
m := v2 editMenu.
m
- addLabels:#('new entry1' 'new entry2')
- selectors:#(foo bar)
- before:'paste'.
+ addLabels:#('new entry1' 'new entry2')
+ selectors:#(foo bar)
+ before:'paste'.
v2 middleButtonMenu:m.
- v3 := CodeView new realize.
+ v3 := CodeView new open.
m := v3 editMenu.
m
- addLabels:#('new entry1' 'new entry2')
- selectors:#(foo bar)
- before:#again.
+ addLabels:#('new entry1' 'new entry2')
+ selectors:#(foo bar)
+ before:#again.
v3 middleButtonMenu:m.
- v4 := CodeView new realize.
+ v4 := CodeView new open.
m := v4 editMenu.
m
- addLabels:#('new entry1' 'new entry2')
- selectors:#(foo bar)
- before:1.
+ addLabels:#('new entry1' 'new entry2')
+ selectors:#(foo bar)
+ before:1.
v4 middleButtonMenu:m.
"
+
+ "Modified: 28.2.1996 / 17:49:30 / cg"
!
addSeparatingLine
- "add a separating line"
+ "add a separating line at the END"
self addLabel:'-' selector:nil
+
+ "Modified: 28.2.1996 / 17:50:08 / cg"
!
addSeparatingLineAfter:aLabelOrSelectorOrNumber
- "add a separating line"
+ "add a separating line after an item"
self addLabel:'-' selector:nil after:aLabelOrSelectorOrNumber
+
+ "Modified: 28.2.1996 / 17:50:14 / cg"
!
args
@@ -721,6 +876,18 @@
]
!
+labels:text selectors:selArray accelerators:shorties args:argArray receiver:anObject
+ "set all relevant stuff"
+
+ self labels:text.
+ selectors := selArray.
+ args := argArray.
+ receiver := anObject.
+ shortKeys := shorties.
+
+ "Created: 28.2.1996 / 18:56:38 / cg"
+!
+
labels:text selectors:selArray args:argArray receiver:anObject
"set all relevant stuff"
@@ -760,13 +927,19 @@
selectors := selectors asOrderedCollection removeIndex:i.
enableFlags := enableFlags asOrderedCollection removeIndex:i.
subMenus notNil ifTrue:[
- subMenus := subMenus asOrderedCollection removeIndex:i.
+ subMenus := subMenus asOrderedCollection removeIndex:i.
+ ].
+ shortKeys notNil ifTrue:[
+ shortKeys := shortKeys asOrderedCollection removeIndex:i.
+ maxShortKeyStringLen := nil.
].
shown ifTrue:[
- self resize
+ self resize
] ifFalse:[
- needResize := true
+ needResize := true
]
+
+ "Modified: 28.2.1996 / 18:27:57 / cg"
!
selectorAt:indexOrName
@@ -934,6 +1107,241 @@
^ self
! !
+!MenuView methodsFor:'drawing'!
+
+drawAccelerator:aSymbolicKey inVisibleLine:visLineNr with:fg and:bg
+ "draw the accelerator at the right."
+
+ |s x|
+
+ "/ this is somewhat complicated: we have the symbolic key at hand,
+ "/ but want to show the untranslated (inverse keyBoardMapped) key & modifier
+ "/
+
+ s := self shortKeyStringFor:aSymbolicKey.
+ s isNil ifTrue:[^ self].
+
+"/ this aligns them
+ x := width - textStartLeft - self shortKeyInset.
+
+"/ this aligns them at the right
+"/ x := width - leftMargin - (font widthOf:s).
+
+ hilightStyle == #openwin ifTrue:[
+ x := x - 2 "/ inset of rounded rectangle
+ ].
+
+ self drawLine:s fromX:x inVisible:visLineNr with:fg and:bg
+
+ "Created: 28.2.1996 / 18:48:05 / cg"
+ "Modified: 28.2.1996 / 19:43:25 / cg"
+!
+
+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) fromX: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: 28.2.1996 / 14:14:29 / cg"
+!
+
+drawVisibleLine:visLineNr with:fg and:bg
+ |l lineString isSpecial key|
+
+ l := self visibleLineToListLine:visLineNr.
+ lineString := self visibleAt:visLineNr.
+
+ isSpecial := lineString notNil and:[lineString includes:$\].
+ isSpecial ifFalse:[
+ "
+ a normal entry
+ "
+ super drawVisibleLine:visLineNr with:fg and:bg
+ ] ifTrue:[
+ "
+ some speciality in this line
+ "
+ (self isCheckItem:lineString) ifTrue:[
+ "
+ (check-mark)
+ "
+ self drawCheckLine:lineString inVisibleLine:visLineNr with:fg and:bg
+ ] ifFalse:[
+ super drawLine:lineString inVisible:visLineNr with:fg and:bg.
+ ].
+ ].
+
+ "/
+ "/ is there a shortKey ?
+ "/
+ (shortKeys notNil
+ and:[(key := shortKeys at:l ifAbsent:nil) notNil]) ifTrue:[
+ self drawAccelerator:key inVisibleLine:visLineNr with:fg and:bg
+ ]
+
+ "Modified: 28.2.1996 / 18:47:18 / cg"
+!
+
+drawVisibleLineSelected:visLineNr with:fg and:bg
+ "redraw a single line as selected."
+
+ |listLine
+ y "{ Class: SmallInteger }"
+ y2 "{ Class: SmallInteger }"
+ r2 radius topLeftColor botRightColor |
+
+
+ hilightStyle ~~ #openwin ifTrue:[
+ ^ super drawVisibleLineSelected:visLineNr with:fg and:bg.
+ ].
+
+ "
+ openwin draws selections in a menu as (edged) rounded rectangles
+ "
+ 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
+
+ "Created: 28.2.1996 / 18:41:17 / cg"
+ "Modified: 28.2.1996 / 19:42:57 / cg"
+! !
+
!MenuView methodsFor:'event handling'!
buttonMotion:state x:x y:y
@@ -950,99 +1358,106 @@
|theSelector isCheck checkOn val|
subMenuShown notNil ifTrue:[
- ^ self
+ ^ 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
- ].
+ (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
- ].
+ 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.
- ]
- ]
- ].
+ 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.
+ "
+ 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
- ]
- ].
- ].
- ]
- ]
+ "
+ 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].
+ (superView notNil and:[superView shown]) ifTrue:[superView hide].
].
hideOnRelease ifTrue:[
- superView hide
+ superView hide
].
+ (superView notNil and:[superView isPopUpView]) ifTrue:[
+"/ 'refetch focus' printNL.
+ superView getKeyboardFocus.
+ superView hide
+ ]
+
+ "Modified: 28.2.1996 / 18:31:54 / cg"
!
keyPress:aKey x:x y:y
@@ -1133,76 +1548,76 @@
"/ DefaultFont notNil ifTrue:[font := DefaultFont on:device].
DefaultCheckColor notNil ifTrue:[
- checkColor := DefaultCheckColor
+ checkColor := DefaultCheckColor
] ifFalse:[
- checkColor := fgColor.
+ checkColor := fgColor.
].
disabledFgColor := DefaultDisabledForegroundColor on:device.
DefaultForegroundColor notNil ifTrue:[
- fgColor := DefaultForegroundColor on:device
+ fgColor := DefaultForegroundColor on:device
].
DefaultBackgroundColor notNil ifTrue:[
- bgColor := DefaultBackgroundColor on:device
+ bgColor := DefaultBackgroundColor on:device
].
DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor on:device
+ shadowColor := DefaultShadowColor on:device
].
DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor on:device
+ lightColor := DefaultLightColor on:device
].
DefaultHilightLevel notNil ifTrue:[
- hilightLevel := DefaultHilightLevel
+ hilightLevel := DefaultHilightLevel
] ifFalse:[
- hilightLevel := 0.
+ hilightLevel := 0.
].
hilightStyle := DefaultHilightStyle.
hilightFrameColor := DefaultHilightFrameColor.
styleSheet is3D ifTrue:[
- "some 3D style menu - set hilight defaults to same"
+ "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.
- ]
+ 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.
- ]
+ "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
+ lineInset := DefaultLineInset
] ifFalse:[
- lineInset := (device horizontalPixelPerMillimeter * 0.8) rounded.
+ lineInset := (device horizontalPixelPerMillimeter * 0.8) rounded.
].
"
@@ -1212,30 +1627,31 @@
style := styleSheet name.
(style == #iris) ifTrue:[
- device hasGreyscales ifTrue:[
- lineSpacing := 3
- ].
+ device hasGreyscales ifTrue:[
+ lineSpacing := 3
+ ].
].
(style == #motif) ifTrue:[
- lineSpacing := (2 * hilightLevel)
+ 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).
- ]
- ].
+"/ stupid - these are clobbered somewhere; see initialize and recreate
+"/ hilightStyle == #openwin ifTrue:[
+"/ "add some space for rounded-hilight area"
+"/ self leftMargin:(font height // 2 + 2 "inset of rounded rect") "10".
+"/ ] ifFalse:[
+"/ (hilightLevel ~~ 0) ifTrue:[
+"/ self leftMargin:hilightLevel abs + self margin abs + 1.
+"/ lineSpacing := lineSpacing max:(hilightLevel abs * 2).
+"/ ]
+"/ ].
(style == #st80) ifTrue:[
- level := 0.
+ level := 0.
].
DefaultViewBackground notNil ifTrue:[
- viewBackground := DefaultViewBackground on:device
+ viewBackground := DefaultViewBackground on:device
].
- "Modified: 22.11.1995 / 23:18:54 / cg"
+ "Modified: 28.2.1996 / 19:40:12 / cg"
!
initialize
@@ -1255,10 +1671,15 @@
"stupid - have to redo this ..."
hilightStyle == #openwin ifTrue:[
"add some space for rounded-hilight area"
- self leftMargin:10.
+ self leftMargin:(font height // 2 + 2 "inset of rounded rect") "10".
+ ] ifFalse:[
+ (hilightLevel ~~ 0) ifTrue:[
+ self leftMargin:hilightLevel abs + self margin abs + 1.
+ lineSpacing := lineSpacing max:(hilightLevel abs * 2).
+ ]
].
- "Modified: 9.2.1996 / 01:36:06 / cg"
+ "Modified: 28.2.1996 / 19:39:28 / cg"
!
recreate
@@ -1267,9 +1688,17 @@
super recreate.
hilightStyle == #openwin ifTrue:[
- self leftMargin:10.
+ "add some space for rounded-hilight area"
+ self leftMargin:(font height // 2 + 2 "inset of rounded rect") "10".
+ ] ifFalse:[
+ (hilightLevel ~~ 0) ifTrue:[
+ self leftMargin:hilightLevel abs + self margin abs + 1.
+ lineSpacing := lineSpacing max:(hilightLevel abs * 2).
+ ]
].
self resize
+
+ "Modified: 28.2.1996 / 19:39:37 / cg"
!
reinitialize
@@ -1438,7 +1867,7 @@
!MenuView methodsFor:'queries'!
preferredExtent
- |margin2 w h|
+ |margin2 w h extra|
widthOfWidestLine := nil. "/ i.e. unknown
@@ -1446,223 +1875,140 @@
w := self widthOfContents + leftMargin + leftMargin + margin2.
h := (self numberOfLines) * fontHeight - lineSpacing + (2 * topMargin) + margin2.
hilightLevel ~~ 0 ifTrue:[
- h := h + (hilightLevel abs)
+ h := h + (hilightLevel abs)
].
+
+ extra := 0.
"if there is a submenu, add some space for the right arrow"
subMenus notNil ifTrue:[
- w := w + 16
+ extra := 16
+ ].
+ shortKeys notNil ifTrue:[
+ extra := extra max:(self shortKeyInset) + 10 "/ spacing
+ ].
+ ^ ((w+extra) @ h).
+
+ "Modified: 28.2.1996 / 19:44:43 / cg"
+!
+
+shortKeyInset
+ "compute the width req'd for the shortKey"
+
+ maxShortKeyStringLen isNil ifTrue:[
+
+ shortKeys isNil ifTrue:[
+ maxShortKeyStringLen := 0
+ ] ifFalse:[
+ maxShortKeyStringLen := shortKeys
+ inject:0
+ into:[:maxSoFar :thisKey | |short|
+
+ thisKey isNil ifTrue:[
+ maxSoFar
+ ] ifFalse:[
+ short := self shortKeyStringFor:thisKey.
+ short isNil ifTrue:[
+ maxSoFar
+ ] ifFalse:[
+ maxSoFar max:(font widthOf:short)
+ ]
+ ]
+ ]
+ ].
].
- ^ (w @ h).
+ ^ maxShortKeyStringLen
+
+ "Created: 28.2.1996 / 16:30:09 / cg"
+ "Modified: 28.2.1996 / 18:26:37 / cg"
+!
+
+shortKeyPrefixFor:aModifier
+ |m|
+
+"/ aModifier = 'Alt' ifTrue:[
+"/ ^ '@-'
+"/ ].
+"/ aModifier = 'Cmd' ifTrue:[
+"/ ^ '@-'
+"/ ].
+"/ aModifier = 'Meta' ifTrue:[
+"/ ^ '$-'
+"/ ].
+"/ aModifier = 'Ctrl' ifTrue:[
+"/ ^ '^-'
+"/ ].
+"/ ^ aModifier.
+
+ m := device modifierKeyTopFor:aModifier.
+ m notNil ifTrue:[
+ ^ m , '-'
+ ].
+^ aModifier.
+
+ aModifier = 'Alt' ifTrue:[
+ ^ 'Alt-'
+ ].
+ aModifier = 'Cmd' ifTrue:[
+ (device keyboardMap keyAtValue:'Cmd' ifAbsent:nil) notNil ifTrue:[
+ self halt.
+ ].
+ ^ 'Cmd-'
+ ].
+ aModifier = 'Meta' ifTrue:[
+ ^ 'Meta-'
+ ].
+ aModifier = 'Ctrl' ifTrue:[
+ ^ 'Ctrl-'
+ ].
+ ^ aModifier
+
+ "Created: 28.2.1996 / 16:32:17 / cg"
+ "Modified: 28.2.1996 / 17:08:29 / cg"
+!
+
+shortKeyStringFor:aSymbolicKey
+ |untranslatedKey s x|
+
+ "/ this is somewhat complicated: we have the symbolic key at hand,
+ "/ but want to show the untranslated (inverse keyBoardMapped) key & modifier
+ "/
+
+ untranslatedKey := device keyboardMap keyAtValue:aSymbolicKey ifAbsent:nil.
+ untranslatedKey notNil ifTrue:[
+ (untranslatedKey startsWith:'Cmd') ifTrue:[
+ s := (self shortKeyPrefixFor:'Cmd') , (untranslatedKey copyFrom:4)
+ ].
+ (untranslatedKey startsWith:'Alt') ifTrue:[
+ s := (self shortKeyPrefixFor:'Alt') , (untranslatedKey copyFrom:4)
+ ].
+ (untranslatedKey startsWith:'Meta') ifTrue:[
+ s := (self shortKeyPrefixFor:'Meta') , (untranslatedKey copyFrom:5)
+ ].
+ (untranslatedKey startsWith:'Ctrl') ifTrue:[
+ s := (self shortKeyPrefixFor:'Ctrl') , (untranslatedKey copyFrom:5)
+ ].
+ (untranslatedKey startsWith:'F') ifTrue:[
+ s := untranslatedKey
+ ].
+ ].
+ ^ s
+
+ "Created: 28.2.1996 / 18:20:09 / cg"
! !
!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|
-
- 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:45:56 / 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 ..."
+ "/ 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 ...
+ "/ Q: is it worth it ?
|first
index "{ Class: SmallInteger }"
@@ -1681,8 +2027,9 @@
and:[(self isGraphicItem:line)
or:[line includes:$\ ]].
- (special
- or:[(enableFlags at:index) not]) ifTrue:[
+ (special
+ or:[shortKeys notNil
+ or:[(enableFlags at:index) not]]) ifTrue:[
"a special case"
(first < current) ifTrue:[
super redrawFromVisibleLine:first to:(current - 1)
@@ -1711,51 +2058,56 @@
]
]
- "Modified: 26.2.1996 / 23:31:18 / cg"
+ "Modified: 28.2.1996 / 14:52:05 / 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
+ 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|
+ isDoubleLine right clr1 clr2 key|
line := self visibleAt:visLineNr.
isSpecial := isDoubleLine := isSeparatingLine := false.
(line = '-') ifTrue:[
- isSeparatingLine := isSpecial := true.
+ isSeparatingLine := isSpecial := true.
] ifFalse:[
- (line = '=') ifTrue:[
- isSeparatingLine := isSpecial := isDoubleLine := true.
- ] ifFalse:[
- (line = '') ifTrue:[
- isSpecial := true
- ]
- ]
+ (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
+ 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 ifAbsent:nil) notNil]) ifTrue:[
+ self drawRightArrowInVisibleLine:visLineNr
+ ].
+ ^ self
].
- "handle separating lines"
+ "/
+ "/ handle separating lines
+ "/
y := self yOfVisibleLine:visLineNr.
@@ -1763,45 +2115,47 @@
self fillRectangleX:0 y:y width:width height:fontHeight.
isSeparatingLine ifTrue:[
- y := y + (fontHeight // 2).
- isDoubleLine ifTrue:[
- y := y - (fontHeight // 8).
- ].
+ y := y + (fontHeight // 2).
+ isDoubleLine ifTrue:[
+ y := y - (fontHeight // 8).
+ ].
- right := width - 1 - lineInset.
+ 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:[
+ 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.
- ].
+ 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.
- ]
- ]
+ 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.
+ ]
+ ]
]
+
+ "Modified: 28.2.1996 / 18:47:41 / cg"
!
redrawVisibleLine:visLine col:col
@@ -1838,10 +2192,10 @@
!MenuView methodsFor:'showing'!
realize
- needResize == true ifTrue:[
- self recomputeSize
- ].
+ self resizeIfChanged.
super realize
+
+ "Modified: 28.2.1996 / 18:17:05 / cg"
!
show
@@ -1887,5 +2241,5 @@
!MenuView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.48 1996-02-26 22:46:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.49 1996-02-28 18:45:44 cg Exp $'
! !
--- a/PopUpMenu.st Wed Feb 28 15:29:08 1996 +0100
+++ b/PopUpMenu.st Wed Feb 28 19:46:01 1996 +0100
@@ -296,7 +296,9 @@
"
OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
"
- ^ self labels:labels selectors:aSelector args:args receiver:anObject
+ ^ self labels:labels selectors:aSelector accelerators:nil args:args receiver:anObject
+
+ "Modified: 28.2.1996 / 19:01:12 / cg"
!
labels:labels selector:aSelector args:args receiver:anObject for:aView
@@ -309,32 +311,40 @@
"
OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
"
- ^ self labels:labels selectors:aSelector args:args receiver:anObject for:aView
+ ^ self labels:labels selectors:aSelector accelerators:nil args:args receiver:anObject for:aView
+
+ "Modified: 28.2.1996 / 19:01:29 / cg"
!
labels:labels selectors:selectors
"create and return a menu with label-items and selectors. The receiver
will either be defined later, or not used at all (if opened via startUp)"
- ^ self labels:labels selectors:selectors args:nil receiver:nil for:nil
+ ^ self labels:labels selectors:selectors accelerators:nil args:nil receiver:nil for:nil
+
+ "Modified: 28.2.1996 / 19:01:35 / cg"
!
-labels:labels selectors:selectors args:argArray
+labels:labels selectors:selectors accelerators:shorties
"create and return a menu with label-items and selectors. The receiver
will either be defined later, or not used at all (if opened via startUp)"
- ^ self labels:labels selectors:selectors args:argArray receiver:nil for:nil
+ ^ self labels:labels selectors:selectors accelerators:shorties args:nil receiver:nil for:nil
+
+ "Created: 28.2.1996 / 18:58:52 / cg"
!
-labels:labels selectors:selectors args:args receiver:anObject
+labels:labels selectors:selectors accelerators:shorties args:args receiver:anObject
"create and return a popup menu with labels as entries.
Each item will send a corresponding selector:argument from the selectors-
and args array to anObject. The menu is created on the default Display"
- ^ self labels:labels selectors:selectors args:args receiver:anObject for:nil
+ ^ self labels:labels selectors:selectors accelerators:shorties args:args receiver:anObject for:nil
+
+ "Created: 28.2.1996 / 18:59:03 / cg"
!
-labels:labels selectors:selectors args:args receiver:anObject for:aView
+labels:labels selectors:selectors accelerators:shorties args:args receiver:anObject for:aView
"create and return a popup menu with labels as entries.
Each item will send a corresponding selector:argument from the selectors-
and args array to anObject. The menu is created on the same physical device
@@ -345,12 +355,57 @@
newMenu := self onSameDeviceAs:aView.
newMenu menu:(MenuView
- labels:labels
- selectors:selectors
- args:args
- receiver:anObject
- in:newMenu).
+ labels:labels
+ selectors:selectors
+ accelerators:shorties
+ args:args
+ receiver:anObject
+ in:newMenu).
^ newMenu
+
+ "Created: 28.2.1996 / 18:59:25 / cg"
+!
+
+labels:labels selectors:selectors accelerators:shorties receiver:anObject
+ "create and return a popup menu with labels as entries.
+ Each item will send a message with a selector from the corresponding
+ selectors-array.
+ The menu is created on the default Display."
+
+ ^ self labels:labels selectors:selectors accelerators:shorties args:nil receiver:anObject for:nil
+
+ "Created: 28.2.1996 / 19:00:49 / cg"
+!
+
+labels:labels selectors:selectors args:argArray
+ "create and return a menu with label-items and selectors. The receiver
+ will either be defined later, or not used at all (if opened via startUp)"
+
+ ^ self labels:labels selectors:selectors accelerators:nil args:argArray receiver:nil for:nil
+
+ "Modified: 28.2.1996 / 19:01:45 / cg"
+!
+
+labels:labels selectors:selectors args:args receiver:anObject
+ "create and return a popup menu with labels as entries.
+ Each item will send a corresponding selector:argument from the selectors-
+ and args array to anObject. The menu is created on the default Display"
+
+ ^ self labels:labels selectors:selectors accelerators:nil args:args receiver:anObject for:nil
+
+ "Modified: 28.2.1996 / 19:01:49 / cg"
+!
+
+labels:labels selectors:selectors args:args receiver:anObject for:aView
+ "create and return a popup menu with labels as entries.
+ Each item will send a corresponding selector:argument from the selectors-
+ and args array to anObject. The menu is created on the same physical device
+ as aView (which is only of interest in multi-Display applications;
+ typical applications can use the sibbling message without the for: argument)."
+
+ ^ self labels:labels selectors:selectors accelerators:nil args:args receiver:anObject for:aView
+
+ "Modified: 28.2.1996 / 19:03:58 / cg"
!
labels:labels selectors:selectors receiver:anObject
@@ -359,7 +414,9 @@
selectors-array.
The menu is created on the default Display."
- ^ self labels:labels selectors:selectors args:nil receiver:anObject for:nil
+ ^ self labels:labels selectors:selectors accelerators:nil args:nil receiver:anObject for:nil
+
+ "Modified: 28.2.1996 / 19:02:07 / cg"
!
labels:labels selectors:selectors receiver:anObject for:aView
@@ -369,7 +426,9 @@
as aView (which is only of interest in multi-Display applications;
typical applications can use the sibbling message without the for: argument)."
- ^ self labels:labels selectors:selectors args:nil receiver:anObject for:aView
+ ^ self labels:labels selectors:selectors accelerators:nil args:nil receiver:anObject for:aView
+
+ "Modified: 28.2.1996 / 19:02:10 / cg"
! !
!PopUpMenu class methodsFor:'ST-80 instance creation'!
@@ -1004,5 +1063,5 @@
!PopUpMenu class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.37 1996-02-28 14:29:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.38 1996-02-28 18:46:01 cg Exp $'
! !