# HG changeset patch # User Claus Gittinger # Date 825533161 -3600 # Node ID bf35bf40ab11b87e756c1fa63552d0d8d72b4f66 # Parent 9d44d3ff44a0d6405b5f56b12dd5b2e7077a86a0 changes for accelerator-display diff -r 9d44d3ff44a0 -r bf35bf40ab11 MenuView.st --- 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 $' ! ! diff -r 9d44d3ff44a0 -r bf35bf40ab11 PopUpMenu.st --- 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 $' ! !