--- a/ClckMenuV.st Thu Nov 23 11:44:18 1995 +0100
+++ b/ClckMenuV.st Thu Nov 23 15:37:40 1995 +0100
@@ -11,10 +11,10 @@
"
MenuView subclass:#ClickMenuView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Menus'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Menus'
!
!ClickMenuView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/ClckMenuV.st,v 1.6 1995-11-11 16:19:18 cg Exp $'
-!
-
documentation
"
ClickMenuViews are like menuViews, but deselects automatically
@@ -89,6 +85,10 @@
top add:menu1.
top openWithExtent:(menu1 extent).
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Attic/ClckMenuV.st,v 1.7 1995-11-23 14:34:28 cg Exp $'
! !
!ClickMenuView methodsFor:'event handling'!
@@ -97,3 +97,4 @@
super buttonRelease:button x:x y:y.
self selection:nil
! !
+
--- a/ClickMenuView.st Thu Nov 23 11:44:18 1995 +0100
+++ b/ClickMenuView.st Thu Nov 23 15:37:40 1995 +0100
@@ -11,10 +11,10 @@
"
MenuView subclass:#ClickMenuView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Menus'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Menus'
!
!ClickMenuView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/ClickMenuView.st,v 1.6 1995-11-11 16:19:18 cg Exp $'
-!
-
documentation
"
ClickMenuViews are like menuViews, but deselects automatically
@@ -89,6 +85,10 @@
top add:menu1.
top openWithExtent:(menu1 extent).
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/ClickMenuView.st,v 1.7 1995-11-23 14:34:28 cg Exp $'
! !
!ClickMenuView methodsFor:'event handling'!
@@ -97,3 +97,4 @@
super buttonRelease:button x:x y:y.
self selection:nil
! !
+
--- a/HPanelV.st Thu Nov 23 11:44:18 1995 +0100
+++ b/HPanelV.st Thu Nov 23 15:37:40 1995 +0100
@@ -11,10 +11,10 @@
"
PanelView subclass:#HorizontalPanelView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Layout'
!
!HorizontalPanelView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.17 1995-11-11 16:20:33 cg Exp $'
-!
-
documentation
"
a View which arranges its child-views in a horizontal row.
@@ -862,6 +858,10 @@
l2 label:'twotwo'.
l3 label:'threethree'.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.18 1995-11-23 14:35:52 cg Exp $'
! !
!HorizontalPanelView methodsFor:'accessing'!
@@ -889,29 +889,6 @@
^ hLayout
!
-verticalLayout
- "return the vertical layout as a symbol.
- the returned value is one of
- #top place element at the top
- #topSpace place element at the top, offset by verticalSpace
- #center place it horizontally centered
- #bottom place it at the bottom
- #bottomSpace place it at the bottom, offset by verticalSpace
- #fit resize elements vertically to fit this panel
- #fitSpace like #fit, but with spacing
-
- #topMax like #top, but resize all views vertically to max height
- #topSpaceMax like #topSpace, but resize all views vertically to max height
- #bottomMax like #bottom, but resize all views vertically to max height
- #bottomSpaceMax like #bottomSpace, but resize all views vertically to max height
- #centerMax like #center, but resize all views vertically to max height
- the default is #center
- See the class documentation for the meanings.
- "
-
- ^ vLayout
-!
-
horizontalLayout:aSymbol
"change the horizontal layout as symbol.
The argument, aSymbol must be one of:
@@ -938,6 +915,49 @@
]
!
+layout
+ "leftover for historic reasons - do not use any more"
+
+ self obsoleteMethodWarning:'use #horizontalLayout'.
+ ^ self horizontalLayout
+!
+
+layout:something
+ "OBSOLETE compatibility interface. Will vanish.
+ leftover for historic reasons - do not use any more.
+ In the meantime, try to figure out what is meant ... a kludge"
+
+ something isLayout ifTrue:[^ super layout:something].
+
+ self obsoleteMethodWarning:'use #horizontalLayout:'.
+ ^ self horizontalLayout:something
+
+ "Modified: 31.8.1995 / 23:07:33 / claus"
+!
+
+verticalLayout
+ "return the vertical layout as a symbol.
+ the returned value is one of
+ #top place element at the top
+ #topSpace place element at the top, offset by verticalSpace
+ #center place it horizontally centered
+ #bottom place it at the bottom
+ #bottomSpace place it at the bottom, offset by verticalSpace
+ #fit resize elements vertically to fit this panel
+ #fitSpace like #fit, but with spacing
+
+ #topMax like #top, but resize all views vertically to max height
+ #topSpaceMax like #topSpace, but resize all views vertically to max height
+ #bottomMax like #bottom, but resize all views vertically to max height
+ #bottomSpaceMax like #bottomSpace, but resize all views vertically to max height
+ #centerMax like #center, but resize all views vertically to max height
+ the default is #center
+ See the class documentation for the meanings.
+ "
+
+ ^ vLayout
+!
+
verticalLayout:aSymbol
"change the vertical layout as a symbol.
The argument, aSymbol must be one of:
@@ -962,90 +982,6 @@
vLayout := aSymbol.
self layoutChanged
]
-!
-
-layout
- "leftover for historic reasons - do not use any more"
-
- self obsoleteMethodWarning:'use #horizontalLayout'.
- ^ self horizontalLayout
-!
-
-layout:something
- "OBSOLETE compatibility interface. Will vanish.
- leftover for historic reasons - do not use any more.
- In the meantime, try to figure out what is meant ... a kludge"
-
- something isLayout ifTrue:[^ super layout:something].
-
- self obsoleteMethodWarning:'use #horizontalLayout:'.
- ^ self horizontalLayout:something
-
- "Modified: 31.8.1995 / 23:07:33 / claus"
-! !
-
-
-!HorizontalPanelView methodsFor:'queries'!
-
-preferredExtent
- "return a good extent, one that makes subviews fit"
-
- |sumOfWidths maxHeight maxWidth|
-
- subViews isNil ifTrue:[^ horizontalSpace @ verticalSpace].
-
- "compute net height needed"
-
- sumOfWidths := 0.
- maxHeight := 0.
- maxWidth := 0.
-
- subViews do:[:child |
- |childsPreference|
-
- "/ better to use component's preferredExtent ...
-
- childsPreference := child preferredExtent.
- sumOfWidths := sumOfWidths + childsPreference x.
- maxHeight := maxHeight max:childsPreference y.
- maxWidth := maxWidth max:childsPreference x.
-
- "/ ... instead of actual extent
-"/ sumOfWidths := sumOfWidths + child widthIncludingBorder.
-"/ maxHeight := maxHeight max:(child heightIncludingBorder).
-"/ maxWidth := maxWidth max:(child widthIncludingBorder).
- ].
- borderWidth ~~ 0 ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2).
- maxHeight := maxHeight + (verticalSpace * 2).
- ].
- (hLayout == #fit
- or:[hLayout == #fitSpace
- or:[hLayout endsWith:'Max']]) ifTrue:[
- sumOfWidths := maxWidth * subViews size.
- borderWidth ~~ 0 ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2).
- ]
- ] ifFalse:[
- sumOfWidths := sumOfWidths + ((subViews size - 1) * horizontalSpace).
- hLayout == #leftSpace ifTrue:[
- sumOfWidths := sumOfWidths + horizontalSpace
- ] ifFalse:[
- ((hLayout == #center) or:[hLayout == #spread]) ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2)
- ]
- ].
- ].
-
- ((vLayout == #topSpace) or:[vLayout == #bottomSpace]) ifTrue:[
- maxHeight := maxHeight + verticalSpace
- ] ifFalse:[
- ((vLayout == #fitSpace) or:[vLayout == #center]) ifTrue:[
- maxHeight := maxHeight + (verticalSpace * 2)
- ]
- ].
-
- ^ sumOfWidths @ maxHeight
! !
!HorizontalPanelView methodsFor:'layout'!
@@ -1281,3 +1217,67 @@
"Modified: 4.9.1995 / 18:43:10 / claus"
! !
+
+!HorizontalPanelView methodsFor:'queries'!
+
+preferredExtent
+ "return a good extent, one that makes subviews fit"
+
+ |sumOfWidths maxHeight maxWidth|
+
+ subViews isNil ifTrue:[^ horizontalSpace @ verticalSpace].
+
+ "compute net height needed"
+
+ sumOfWidths := 0.
+ maxHeight := 0.
+ maxWidth := 0.
+
+ subViews do:[:child |
+ |childsPreference|
+
+ "/ better to use component's preferredExtent ...
+
+ childsPreference := child preferredExtent.
+ sumOfWidths := sumOfWidths + childsPreference x.
+ maxHeight := maxHeight max:childsPreference y.
+ maxWidth := maxWidth max:childsPreference x.
+
+ "/ ... instead of actual extent
+"/ sumOfWidths := sumOfWidths + child widthIncludingBorder.
+"/ maxHeight := maxHeight max:(child heightIncludingBorder).
+"/ maxWidth := maxWidth max:(child widthIncludingBorder).
+ ].
+ borderWidth ~~ 0 ifTrue:[
+ sumOfWidths := sumOfWidths + (horizontalSpace * 2).
+ maxHeight := maxHeight + (verticalSpace * 2).
+ ].
+ (hLayout == #fit
+ or:[hLayout == #fitSpace
+ or:[hLayout endsWith:'Max']]) ifTrue:[
+ sumOfWidths := maxWidth * subViews size.
+ borderWidth ~~ 0 ifTrue:[
+ sumOfWidths := sumOfWidths + (horizontalSpace * 2).
+ ]
+ ] ifFalse:[
+ sumOfWidths := sumOfWidths + ((subViews size - 1) * horizontalSpace).
+ hLayout == #leftSpace ifTrue:[
+ sumOfWidths := sumOfWidths + horizontalSpace
+ ] ifFalse:[
+ ((hLayout == #center) or:[hLayout == #spread]) ifTrue:[
+ sumOfWidths := sumOfWidths + (horizontalSpace * 2)
+ ]
+ ].
+ ].
+
+ ((vLayout == #topSpace) or:[vLayout == #bottomSpace]) ifTrue:[
+ maxHeight := maxHeight + verticalSpace
+ ] ifFalse:[
+ ((vLayout == #fitSpace) or:[vLayout == #center]) ifTrue:[
+ maxHeight := maxHeight + (verticalSpace * 2)
+ ]
+ ].
+
+ ^ sumOfWidths @ maxHeight
+! !
+
--- a/HorizontalPanelView.st Thu Nov 23 11:44:18 1995 +0100
+++ b/HorizontalPanelView.st Thu Nov 23 15:37:40 1995 +0100
@@ -11,10 +11,10 @@
"
PanelView subclass:#HorizontalPanelView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Layout'
!
!HorizontalPanelView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.17 1995-11-11 16:20:33 cg Exp $'
-!
-
documentation
"
a View which arranges its child-views in a horizontal row.
@@ -862,6 +858,10 @@
l2 label:'twotwo'.
l3 label:'threethree'.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.18 1995-11-23 14:35:52 cg Exp $'
! !
!HorizontalPanelView methodsFor:'accessing'!
@@ -889,29 +889,6 @@
^ hLayout
!
-verticalLayout
- "return the vertical layout as a symbol.
- the returned value is one of
- #top place element at the top
- #topSpace place element at the top, offset by verticalSpace
- #center place it horizontally centered
- #bottom place it at the bottom
- #bottomSpace place it at the bottom, offset by verticalSpace
- #fit resize elements vertically to fit this panel
- #fitSpace like #fit, but with spacing
-
- #topMax like #top, but resize all views vertically to max height
- #topSpaceMax like #topSpace, but resize all views vertically to max height
- #bottomMax like #bottom, but resize all views vertically to max height
- #bottomSpaceMax like #bottomSpace, but resize all views vertically to max height
- #centerMax like #center, but resize all views vertically to max height
- the default is #center
- See the class documentation for the meanings.
- "
-
- ^ vLayout
-!
-
horizontalLayout:aSymbol
"change the horizontal layout as symbol.
The argument, aSymbol must be one of:
@@ -938,6 +915,49 @@
]
!
+layout
+ "leftover for historic reasons - do not use any more"
+
+ self obsoleteMethodWarning:'use #horizontalLayout'.
+ ^ self horizontalLayout
+!
+
+layout:something
+ "OBSOLETE compatibility interface. Will vanish.
+ leftover for historic reasons - do not use any more.
+ In the meantime, try to figure out what is meant ... a kludge"
+
+ something isLayout ifTrue:[^ super layout:something].
+
+ self obsoleteMethodWarning:'use #horizontalLayout:'.
+ ^ self horizontalLayout:something
+
+ "Modified: 31.8.1995 / 23:07:33 / claus"
+!
+
+verticalLayout
+ "return the vertical layout as a symbol.
+ the returned value is one of
+ #top place element at the top
+ #topSpace place element at the top, offset by verticalSpace
+ #center place it horizontally centered
+ #bottom place it at the bottom
+ #bottomSpace place it at the bottom, offset by verticalSpace
+ #fit resize elements vertically to fit this panel
+ #fitSpace like #fit, but with spacing
+
+ #topMax like #top, but resize all views vertically to max height
+ #topSpaceMax like #topSpace, but resize all views vertically to max height
+ #bottomMax like #bottom, but resize all views vertically to max height
+ #bottomSpaceMax like #bottomSpace, but resize all views vertically to max height
+ #centerMax like #center, but resize all views vertically to max height
+ the default is #center
+ See the class documentation for the meanings.
+ "
+
+ ^ vLayout
+!
+
verticalLayout:aSymbol
"change the vertical layout as a symbol.
The argument, aSymbol must be one of:
@@ -962,90 +982,6 @@
vLayout := aSymbol.
self layoutChanged
]
-!
-
-layout
- "leftover for historic reasons - do not use any more"
-
- self obsoleteMethodWarning:'use #horizontalLayout'.
- ^ self horizontalLayout
-!
-
-layout:something
- "OBSOLETE compatibility interface. Will vanish.
- leftover for historic reasons - do not use any more.
- In the meantime, try to figure out what is meant ... a kludge"
-
- something isLayout ifTrue:[^ super layout:something].
-
- self obsoleteMethodWarning:'use #horizontalLayout:'.
- ^ self horizontalLayout:something
-
- "Modified: 31.8.1995 / 23:07:33 / claus"
-! !
-
-
-!HorizontalPanelView methodsFor:'queries'!
-
-preferredExtent
- "return a good extent, one that makes subviews fit"
-
- |sumOfWidths maxHeight maxWidth|
-
- subViews isNil ifTrue:[^ horizontalSpace @ verticalSpace].
-
- "compute net height needed"
-
- sumOfWidths := 0.
- maxHeight := 0.
- maxWidth := 0.
-
- subViews do:[:child |
- |childsPreference|
-
- "/ better to use component's preferredExtent ...
-
- childsPreference := child preferredExtent.
- sumOfWidths := sumOfWidths + childsPreference x.
- maxHeight := maxHeight max:childsPreference y.
- maxWidth := maxWidth max:childsPreference x.
-
- "/ ... instead of actual extent
-"/ sumOfWidths := sumOfWidths + child widthIncludingBorder.
-"/ maxHeight := maxHeight max:(child heightIncludingBorder).
-"/ maxWidth := maxWidth max:(child widthIncludingBorder).
- ].
- borderWidth ~~ 0 ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2).
- maxHeight := maxHeight + (verticalSpace * 2).
- ].
- (hLayout == #fit
- or:[hLayout == #fitSpace
- or:[hLayout endsWith:'Max']]) ifTrue:[
- sumOfWidths := maxWidth * subViews size.
- borderWidth ~~ 0 ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2).
- ]
- ] ifFalse:[
- sumOfWidths := sumOfWidths + ((subViews size - 1) * horizontalSpace).
- hLayout == #leftSpace ifTrue:[
- sumOfWidths := sumOfWidths + horizontalSpace
- ] ifFalse:[
- ((hLayout == #center) or:[hLayout == #spread]) ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2)
- ]
- ].
- ].
-
- ((vLayout == #topSpace) or:[vLayout == #bottomSpace]) ifTrue:[
- maxHeight := maxHeight + verticalSpace
- ] ifFalse:[
- ((vLayout == #fitSpace) or:[vLayout == #center]) ifTrue:[
- maxHeight := maxHeight + (verticalSpace * 2)
- ]
- ].
-
- ^ sumOfWidths @ maxHeight
! !
!HorizontalPanelView methodsFor:'layout'!
@@ -1281,3 +1217,67 @@
"Modified: 4.9.1995 / 18:43:10 / claus"
! !
+
+!HorizontalPanelView methodsFor:'queries'!
+
+preferredExtent
+ "return a good extent, one that makes subviews fit"
+
+ |sumOfWidths maxHeight maxWidth|
+
+ subViews isNil ifTrue:[^ horizontalSpace @ verticalSpace].
+
+ "compute net height needed"
+
+ sumOfWidths := 0.
+ maxHeight := 0.
+ maxWidth := 0.
+
+ subViews do:[:child |
+ |childsPreference|
+
+ "/ better to use component's preferredExtent ...
+
+ childsPreference := child preferredExtent.
+ sumOfWidths := sumOfWidths + childsPreference x.
+ maxHeight := maxHeight max:childsPreference y.
+ maxWidth := maxWidth max:childsPreference x.
+
+ "/ ... instead of actual extent
+"/ sumOfWidths := sumOfWidths + child widthIncludingBorder.
+"/ maxHeight := maxHeight max:(child heightIncludingBorder).
+"/ maxWidth := maxWidth max:(child widthIncludingBorder).
+ ].
+ borderWidth ~~ 0 ifTrue:[
+ sumOfWidths := sumOfWidths + (horizontalSpace * 2).
+ maxHeight := maxHeight + (verticalSpace * 2).
+ ].
+ (hLayout == #fit
+ or:[hLayout == #fitSpace
+ or:[hLayout endsWith:'Max']]) ifTrue:[
+ sumOfWidths := maxWidth * subViews size.
+ borderWidth ~~ 0 ifTrue:[
+ sumOfWidths := sumOfWidths + (horizontalSpace * 2).
+ ]
+ ] ifFalse:[
+ sumOfWidths := sumOfWidths + ((subViews size - 1) * horizontalSpace).
+ hLayout == #leftSpace ifTrue:[
+ sumOfWidths := sumOfWidths + horizontalSpace
+ ] ifFalse:[
+ ((hLayout == #center) or:[hLayout == #spread]) ifTrue:[
+ sumOfWidths := sumOfWidths + (horizontalSpace * 2)
+ ]
+ ].
+ ].
+
+ ((vLayout == #topSpace) or:[vLayout == #bottomSpace]) ifTrue:[
+ maxHeight := maxHeight + verticalSpace
+ ] ifFalse:[
+ ((vLayout == #fitSpace) or:[vLayout == #center]) ifTrue:[
+ maxHeight := maxHeight + (verticalSpace * 2)
+ ]
+ ].
+
+ ^ sumOfWidths @ maxHeight
+! !
+
--- a/Label.st Thu Nov 23 11:44:18 1995 +0100
+++ b/Label.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,12 +10,10 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:13:27 am'!
-
View subclass:#Label
instanceVariableNames:'logo labelWidth labelHeight labelOriginX labelOriginY adjust
- hSpace vSpace bgColor fgColor fixSize labelMsg converter
- labelChannel foregroundChannel backgroundChannel'
+ hSpace vSpace bgColor fgColor fixSize labelMsg converter
+ labelChannel foregroundChannel backgroundChannel'
classVariableNames:'DefaultFont DefaultForegroundColor DefaultBackgroundColor'
poolDictionaries:''
category:'Views-Layout'
@@ -37,10 +35,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Label.st,v 1.34 1995-11-16 15:21:04 cg Exp $'
-!
-
documentation
"
This class implements labels, which are views to display a string or image.
@@ -678,6 +672,10 @@
model value:#('oneone' 'twotwo' 'threethree').
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Label.st,v 1.35 1995-11-23 14:36:21 cg Exp $'
! !
!Label class methodsFor:'instance creation'!
@@ -724,29 +722,15 @@
"
! !
-!Label methodsFor:'event handling'!
+!Label methodsFor:'accessing-channels'!
-sizeChanged:how
- "sent whenever size is changed by someone else - recompute the
- logos position within the View."
-
- |prevPosition|
+backgroundChannel:aValueHolder
+ |prev|
- super sizeChanged:how.
- prevPosition := labelOriginX.
- self computeLabelOrigin
- shown ifTrue:[
- (adjust == #fit
- or:[labelOriginX ~~ prevPosition
- or:[how ~~ #smaller]]) ifTrue:[
- "/ self clear.
- self redraw.
- self redrawEdges
- ]
- ]
-! !
-
-!Label methodsFor:'accessing-channels'!
+ prev := backgroundChannel.
+ backgroundChannel := aValueHolder.
+ self setupChannel:aValueHolder for:#backgroundChannelChanged withOld:prev
+!
foregroundChannel:aValueHolder
|prev|
@@ -756,14 +740,6 @@
self setupChannel:aValueHolder for:#foregroundChannelChanged withOld:prev
!
-backgroundChannel:aValueHolder
- |prev|
-
- prev := backgroundChannel.
- backgroundChannel := aValueHolder.
- self setupChannel:aValueHolder for:#backgroundChannelChanged withOld:prev
-!
-
labelChannel:aValueHolder
|prev|
@@ -772,53 +748,18 @@
self setupChannel:aValueHolder for:#labelChannelChanged withOld:prev
! !
-!Label methodsFor:'accessing-mvc'!
-
-model:aModel
- super model:aModel.
- self getLabelFromModel.
-!
+!Label methodsFor:'accessing-colors'!
-labelMessage
- "return the symbol used to aquire the labelString/image from the model
- when the aspect changes.
- The default is nil, which means: leave the label unchanged."
+backgroundColor
+ "return the background color"
- ^ labelMsg
+ ^ bgColor
!
-labelMessage:aSymbol
- "set the symbol used to aquire the labelString/image from the model.
- The default is nil, which means: leave the label unchanged."
-
- labelMsg ~~ aSymbol ifTrue:[
- labelMsg := aSymbol.
- self getLabelFromModel
- ]
-!
-
-addModelInterfaceTo:aDictionary
- "see comment in View>>modelInterface"
+backgroundColor:aColor
+ "set the background color"
- super addModelInterfaceTo:aDictionary.
- aDictionary at:#labelMessage put:labelMsg
-!
-
-converter:aConverter
- "set the printConverter;
- that one is asked to convert the models value to a printed
- representation (if non-nil). If nil, the model is supposed to
- return a string or bitmap image."
-
- converter := aConverter
-! !
-
-!Label methodsFor:'accessing-colors'!
-
-foregroundColor:aColor
- "set the foreground color"
-
- fgColor := aColor on:device.
+ bgColor := aColor on:device.
shown ifTrue:[self redraw]
!
@@ -828,19 +769,13 @@
^ fgColor
!
-backgroundColor:aColor
- "set the background color"
+foregroundColor:aColor
+ "set the foreground color"
- bgColor := aColor on:device.
+ fgColor := aColor on:device.
shown ifTrue:[self redraw]
!
-backgroundColor
- "return the background color"
-
- ^ bgColor
-!
-
foregroundColor:fg backgroundColor:bg
"set the colors to be used for drawing"
@@ -851,11 +786,17 @@
!Label methodsFor:'accessing-contents'!
-labelString:aString
- "for ST-80 compatibility: same as #label:
- set the label-string; adjust extent if not already realized and not fixedSize"
+form:aForm
+ "set the labels form; adjust extent if not already realized.
+ OBSOLETE: you should now use #label: for both strings and images"
- self label:aString
+ self label:aForm
+!
+
+label
+ "return the labels string or image"
+
+ ^ logo
!
label:aStringOrFormOrImage
@@ -886,11 +827,17 @@
]
!
-form:aForm
- "set the labels form; adjust extent if not already realized.
- OBSOLETE: you should now use #label: for both strings and images"
+labelString:aString
+ "for ST-80 compatibility: same as #label:
+ set the label-string; adjust extent if not already realized and not fixedSize"
- self label:aForm
+ self label:aString
+!
+
+labelWidth
+ "return the logos width in pixels"
+
+ ^ labelWidth
!
logo:something
@@ -899,61 +846,14 @@
you should now use #label: for any."
self label:something
-!
-
-label
- "return the labels string or image"
-
- ^ logo
-!
-
-labelWidth
- "return the logos width in pixels"
-
- ^ labelWidth
! !
!Label methodsFor:'accessing-layout'!
-sizeFixed:aBoolean
- "set/clear the fix-size attribute.
- If true, the receiver will not change its size when the labelString/logo
- changes. If false (the default), it will resize itself to make the logo
- fit."
-
- fixSize := aBoolean
-!
-
-sizeFixed
- "return the fix-size attribute"
-
- ^ fixSize
-!
+adjust
+ "return the adjust symbol"
-layout:something
- "OBSOLETE compatibility interface. Will vanish.
- for protocol compatibility: alias for #adjust:.
- Please use #adjust:, since #layout: conflicts with a method
- in VW (which has a completely different meaning).
- In future versions of ST/X, #layout: will behave the VW way.
- In the meantime, try to figure out what is meant ... a kludge"
-
- something isLayout ifTrue:[^ super layout:something].
-
- self obsoleteMethodWarning:'use #adjust:'.
- self adjust:something
-
- "Modified: 31.8.1995 / 23:08:13 / claus"
-!
-
-layout
- "for protocol compatibility: alias for #adjust.
- Please use #adjust, since #layout conflicts with a method
- in VW (which has a completely different meaning).
- In future versions of ST/X, #layout will behave the VW way."
-
- self obsoleteMethodWarning:'use #adjust'.
- ^ self adjust
+ ^ adjust
!
adjust:how
@@ -976,18 +876,13 @@
]
!
-adjust
- "return the adjust symbol"
-
- ^ adjust
-!
+font:aFont
+ "set the font - if I'm not realized and not fixedSize, adjust my size"
-verticalSpace:aNumber
- "set the number of pixels by which the logo
- is vertically inset from the border"
-
- vSpace := aNumber.
- self newLayout
+ (aFont ~~ font) ifTrue:[
+ super font:(aFont on:device).
+ self newLayout
+ ]
!
horizontalSpace:aNumber
@@ -998,12 +893,141 @@
self newLayout
!
-font:aFont
- "set the font - if I'm not realized and not fixedSize, adjust my size"
+layout
+ "for protocol compatibility: alias for #adjust.
+ Please use #adjust, since #layout conflicts with a method
+ in VW (which has a completely different meaning).
+ In future versions of ST/X, #layout will behave the VW way."
+
+ self obsoleteMethodWarning:'use #adjust'.
+ ^ self adjust
+!
+
+layout:something
+ "OBSOLETE compatibility interface. Will vanish.
+ for protocol compatibility: alias for #adjust:.
+ Please use #adjust:, since #layout: conflicts with a method
+ in VW (which has a completely different meaning).
+ In future versions of ST/X, #layout: will behave the VW way.
+ In the meantime, try to figure out what is meant ... a kludge"
+
+ something isLayout ifTrue:[^ super layout:something].
+
+ self obsoleteMethodWarning:'use #adjust:'.
+ self adjust:something
+
+ "Modified: 31.8.1995 / 23:08:13 / claus"
+!
+
+sizeFixed
+ "return the fix-size attribute"
+
+ ^ fixSize
+!
+
+sizeFixed:aBoolean
+ "set/clear the fix-size attribute.
+ If true, the receiver will not change its size when the labelString/logo
+ changes. If false (the default), it will resize itself to make the logo
+ fit."
+
+ fixSize := aBoolean
+!
+
+verticalSpace:aNumber
+ "set the number of pixels by which the logo
+ is vertically inset from the border"
+
+ vSpace := aNumber.
+ self newLayout
+! !
+
+!Label methodsFor:'accessing-mvc'!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#labelMessage put:labelMsg
+!
+
+converter:aConverter
+ "set the printConverter;
+ that one is asked to convert the models value to a printed
+ representation (if non-nil). If nil, the model is supposed to
+ return a string or bitmap image."
+
+ converter := aConverter
+!
- (aFont ~~ font) ifTrue:[
- super font:(aFont on:device).
- self newLayout
+labelMessage
+ "return the symbol used to aquire the labelString/image from the model
+ when the aspect changes.
+ The default is nil, which means: leave the label unchanged."
+
+ ^ labelMsg
+!
+
+labelMessage:aSymbol
+ "set the symbol used to aquire the labelString/image from the model.
+ The default is nil, which means: leave the label unchanged."
+
+ labelMsg ~~ aSymbol ifTrue:[
+ labelMsg := aSymbol.
+ self getLabelFromModel
+ ]
+!
+
+model:aModel
+ super model:aModel.
+ self getLabelFromModel.
+! !
+
+!Label methodsFor:'change & update'!
+
+backgroundChannelChanged
+ self backgroundColor:(backgroundChannel value)
+!
+
+foregroundChannelChanged
+ self foregroundColor:(foregroundChannel value)
+!
+
+labelChannelChanged
+ self label:(labelChannel value)
+!
+
+update:something with:aParameter from:changedObject
+ "the MVC way of changing the label ..."
+
+ changedObject == model ifTrue:[
+ something == aspectMsg ifTrue:[
+ self getLabelFromModel.
+ ^ self.
+ ]
+ ].
+ ^ super update:something with:aParameter from:changedObject
+! !
+
+!Label methodsFor:'event handling'!
+
+sizeChanged:how
+ "sent whenever size is changed by someone else - recompute the
+ logos position within the View."
+
+ |prevPosition|
+
+ super sizeChanged:how.
+ prevPosition := labelOriginX.
+ self computeLabelOrigin
+ shown ifTrue:[
+ (adjust == #fit
+ or:[labelOriginX ~~ prevPosition
+ or:[how ~~ #smaller]]) ifTrue:[
+ "/ self clear.
+ self redraw.
+ self redrawEdges
+ ]
]
! !
@@ -1049,6 +1073,144 @@
self computeLabelOrigin
! !
+!Label methodsFor:'private'!
+
+computeLabelOrigin
+ "(re)compute the origin of the label whenever label or font changes"
+
+ |x y|
+
+ labelHeight isNil ifTrue:[^ self].
+
+ adjust == #fit ifTrue:[
+ labelOriginX := labelOriginY := margin.
+ ^ self
+ ].
+
+ "if it does not fit, should we make the origin visible,
+ or the center (for text, the center seems better. For images,
+ I dont really know ehich is better ...
+ The commented code below makes the origin visible
+ "
+"/ (labelHeight < height) ifTrue:[
+"/ y := (height - labelHeight) // 2
+"/ ] ifFalse:[
+"/ y := 0
+"/ ].
+
+ "always center vertically"
+ y := (height - labelHeight) // 2.
+
+ labelOriginY := y.
+
+ (((adjust == #center)
+ or:[adjust == #centerRight])
+ or:[adjust == #centerLeft]) ifTrue:[
+ " center text/form in button "
+ x := (width - labelWidth) // 2.
+ (width < labelWidth) ifTrue:[
+ "no fit"
+ (adjust == #centerLeft) ifTrue:[
+ x := margin
+ ] ifFalse:[
+ (adjust == #centerRight) ifTrue:[
+ x := width - labelWidth - margin
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ (adjust == #left) ifTrue:[
+ x := margin
+ ] ifFalse:[
+ x := width - labelWidth - margin
+ ]
+ ].
+ labelOriginX := x
+!
+
+computeLabelSize
+ "compute the extent needed to hold the label; aForm or aString"
+
+ |numberOfLines textHeight textWidth|
+
+ logo isNil ifTrue:[^ self].
+
+ logo isImageOrForm ifTrue:[
+ labelWidth := logo width.
+ labelHeight := logo height.
+ ^ self
+ ].
+
+ "must be a String or collection of strings"
+ logo isString ifTrue:[
+ numberOfLines := 1 + (logo occurrencesOf:(Character cr)).
+ (numberOfLines ~~ 1) ifTrue:[
+ logo := logo asStringCollection
+ ]
+ ] ifFalse:[
+ numberOfLines := logo size.
+ (numberOfLines <= 1) ifTrue:[
+ logo := logo asString
+ ]
+ ].
+
+"/ textHeight := font height * numberOfLines + font descent.
+ textHeight := font height * numberOfLines.
+ textWidth := font widthOf:logo.
+ labelWidth := textWidth + (hSpace * 2) .
+ labelHeight := textHeight + (vSpace * 2)
+!
+
+getLabelFromModel
+ "ask my model for the label to show.
+ Here, we use labelMsg (instead of aspectMsg).
+ This allows multiple labels to react on the same aspect,
+ but show different labels when changed
+ (also, since labelMsg defaults to nil, constant labels
+ which have a nil labelMsg will not try to aquire a labelString)."
+
+ |val|
+
+ (model notNil
+ and:[labelMsg notNil]) ifTrue:[
+ val := model perform:labelMsg.
+ converter notNil ifTrue:[
+ val := converter printStringFor:val
+ ].
+ self label:val.
+ ].
+!
+
+newLayout
+ "recompute position/size after a change
+ - helper for form:/font: etc."
+
+ self computeLabelSize.
+ fixSize ifFalse:[
+ self resize
+ ] ifTrue:[
+ self computeLabelOrigin
+ ].
+ shown ifTrue:[
+ self redraw
+ ]
+! !
+
+!Label methodsFor:'queries'!
+
+preferredExtent
+ "return my preferred extent - this is the minimum size I would like to have"
+
+ |extra|
+
+ logo notNil ifTrue:[
+ extra := margin * 2.
+ ^ (labelWidth + extra + hSpace) @ (labelHeight + extra + vSpace)
+ ].
+
+ ^ super preferredExtent
+! !
+
!Label methodsFor:'redrawing'!
clearInsideWith:bg
@@ -1156,129 +1318,6 @@
]
! !
-!Label methodsFor:'private'!
-
-getLabelFromModel
- "ask my model for the label to show.
- Here, we use labelMsg (instead of aspectMsg).
- This allows multiple labels to react on the same aspect,
- but show different labels when changed
- (also, since labelMsg defaults to nil, constant labels
- which have a nil labelMsg will not try to aquire a labelString)."
-
- |val|
-
- (model notNil
- and:[labelMsg notNil]) ifTrue:[
- val := model perform:labelMsg.
- converter notNil ifTrue:[
- val := converter printStringFor:val
- ].
- self label:val.
- ].
-!
-
-newLayout
- "recompute position/size after a change
- - helper for form:/font: etc."
-
- self computeLabelSize.
- fixSize ifFalse:[
- self resize
- ] ifTrue:[
- self computeLabelOrigin
- ].
- shown ifTrue:[
- self redraw
- ]
-!
-
-computeLabelOrigin
- "(re)compute the origin of the label whenever label or font changes"
-
- |x y|
-
- labelHeight isNil ifTrue:[^ self].
-
- adjust == #fit ifTrue:[
- labelOriginX := labelOriginY := margin.
- ^ self
- ].
-
- "if it does not fit, should we make the origin visible,
- or the center (for text, the center seems better. For images,
- I dont really know ehich is better ...
- The commented code below makes the origin visible
- "
-"/ (labelHeight < height) ifTrue:[
-"/ y := (height - labelHeight) // 2
-"/ ] ifFalse:[
-"/ y := 0
-"/ ].
-
- "always center vertically"
- y := (height - labelHeight) // 2.
-
- labelOriginY := y.
-
- (((adjust == #center)
- or:[adjust == #centerRight])
- or:[adjust == #centerLeft]) ifTrue:[
- " center text/form in button "
- x := (width - labelWidth) // 2.
- (width < labelWidth) ifTrue:[
- "no fit"
- (adjust == #centerLeft) ifTrue:[
- x := margin
- ] ifFalse:[
- (adjust == #centerRight) ifTrue:[
- x := width - labelWidth - margin
- ]
- ]
- ]
- ] ifFalse:[
- (adjust == #left) ifTrue:[
- x := margin
- ] ifFalse:[
- x := width - labelWidth - margin
- ]
- ].
- labelOriginX := x
-!
-
-computeLabelSize
- "compute the extent needed to hold the label; aForm or aString"
-
- |numberOfLines textHeight textWidth|
-
- logo isNil ifTrue:[^ self].
-
- logo isImageOrForm ifTrue:[
- labelWidth := logo width.
- labelHeight := logo height.
- ^ self
- ].
-
- "must be a String or collection of strings"
- logo isString ifTrue:[
- numberOfLines := 1 + (logo occurrencesOf:(Character cr)).
- (numberOfLines ~~ 1) ifTrue:[
- logo := logo asStringCollection
- ]
- ] ifFalse:[
- numberOfLines := logo size.
- (numberOfLines <= 1) ifTrue:[
- logo := logo asString
- ]
- ].
-
-"/ textHeight := font height * numberOfLines + font descent.
- textHeight := font height * numberOfLines.
- textWidth := font widthOf:logo.
- labelWidth := textWidth + (hSpace * 2) .
- labelHeight := textHeight + (vSpace * 2)
-! !
-
!Label methodsFor:'resizing'!
forceResize
@@ -1308,43 +1347,3 @@
]
! !
-!Label methodsFor:'change & update'!
-
-foregroundChannelChanged
- self foregroundColor:(foregroundChannel value)
-!
-
-backgroundChannelChanged
- self backgroundColor:(backgroundChannel value)
-!
-
-labelChannelChanged
- self label:(labelChannel value)
-!
-
-update:something with:aParameter from:changedObject
- "the MVC way of changing the label ..."
-
- changedObject == model ifTrue:[
- something == aspectMsg ifTrue:[
- self getLabelFromModel.
- ^ self.
- ]
- ].
- ^ super update:something with:aParameter from:changedObject
-! !
-
-!Label methodsFor:'queries'!
-
-preferredExtent
- "return my preferred extent - this is the minimum size I would like to have"
-
- |extra|
-
- logo notNil ifTrue:[
- extra := margin * 2.
- ^ (labelWidth + extra + hSpace) @ (labelHeight + extra + vSpace)
- ].
-
- ^ super preferredExtent
-! !
--- a/MenuView.st Thu Nov 23 11:44:18 1995 +0100
+++ b/MenuView.st Thu Nov 23 15:37:40 1995 +0100
@@ -11,21 +11,17 @@
"
SelectionInListView subclass:#MenuView
- instanceVariableNames:'selectors args receiver enableFlags
- disabledFgColor onOffFlags subMenus
- subMenuShown superMenu checkColor
- lineLevel lineInset masterView hilightStyle
- needResize hideOnRelease'
- classVariableNames:'DefaultFont DefaultCheckColor DefaultViewBackground
- DefaultForegroundColor DefaultBackgroundColor
- DefaultDisabledForegroundColor
- DefaultHilightForegroundColor DefaultHilightBackgroundColor
- DefaultHilightLevel DefaultHilightStyle
- DefaultHilightFrameColor
- DefaultLineLevel DefaultLineInset
- DefaultShadowColor DefaultLightColor'
- poolDictionaries:''
- category:'Views-Menus'
+ instanceVariableNames:'selectors args receiver enableFlags disabledFgColor onOffFlags
+ subMenus subMenuShown superMenu checkColor lineLevel lineInset
+ masterView hilightStyle needResize hideOnRelease'
+ classVariableNames:'DefaultFont DefaultCheckColor DefaultViewBackground
+ DefaultForegroundColor DefaultBackgroundColor
+ DefaultDisabledForegroundColor DefaultHilightForegroundColor
+ DefaultHilightBackgroundColor DefaultHilightLevel
+ DefaultHilightStyle DefaultHilightFrameColor DefaultLineLevel
+ DefaultLineInset DefaultShadowColor DefaultLightColor'
+ poolDictionaries:''
+ category:'Views-Menus'
!
!MenuView class methodsFor:'documentation'!
@@ -44,10 +40,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.35 1995-11-22 23:07:45 cg Exp $'
-!
-
documentation
"
a menu view used for both pull-down-menus and pop-up-menus (and also,
@@ -121,6 +113,102 @@
receiver:nil.
m open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.36 1995-11-23 14:34:45 cg Exp $'
+! !
+
+!MenuView class methodsFor:'instance creation'!
+
+labels:labels
+ "create and return a new MenuView. The parent view,
+ selectors and receiver should be set later."
+
+ ^ self labels:labels selectors:nil args:nil receiver:nil
+!
+
+labels:labels selector:aSelector args:argArray receiver:anObject for:aTopMenu
+ "create and return a new MenuView
+ - receiverObject gets message aSelector with argument from
+ argArray for ALL entries"
+
+ "OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a
+ single symbol-arg for selectors ..."
+
+ ^ self labels:labels selectors:aSelector args:argArray receiver:anObject in:(aTopMenu superView)
+!
+
+labels:labels selector:aSelector args:argArray receiver:anObject in:aTopMenu
+ "create and return a new MenuView
+ - receiverObject gets message aSelector with argument from
+ argArray for all entries"
+
+ "OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a
+ single symbol-arg for selectors ..."
+
+ ^ self labels:labels selectors:aSelector args:argArray receiver:anObject in:aTopMenu
+!
+
+labels:labels selectors:selArray
+ "create and return a new MenuView. The parent veiw
+ and receiver should be set later."
+
+ ^ self labels:labels selectors:selArray args:nil receiver:nil
+!
+
+labels:labels selectors:selArray args:argArray
+ "create and return a new MenuView. The parent view
+ should be set later."
+
+ ^ self labels:labels selectors:selArray args:argArray
+!
+
+labels:labels selectors:selArray args:argArray receiver:anObject
+ "create and return a new MenuView. The parent view
+ should be set later."
+
+ ^ (self new)
+ labels:labels
+ selectors:selArray
+ args:argArray
+ receiver:anObject
+!
+
+labels:labels selectors:selArray args:argArray receiver:anObject for:aTopMenu
+ "create and return a new MenuView for a topMenu"
+
+ ^ self labels:labels selectors:selArray args:argArray receiver:anObject in:(aTopMenu superView)
+!
+
+labels:labels selectors:selArray args:argArray receiver:anObject in:aView
+ "create and return a new MenuView in aView
+ - receiverObject gets message from selectorArray with argument
+ from argArray"
+
+ ^ (self in:aView)
+ labels:labels
+ selectors:selArray
+ args:argArray
+ receiver:anObject
+!
+
+labels:labels selectors:selArray receiver:anObject
+ "create and return a new MenuView. The parent view
+ should be set later."
+
+ ^ self labels:labels selectors:selArray args:nil receiver:anObject
+!
+
+labels:labels selectors:selArray receiver:anObject for:aTopMenu
+ ^ self labels:labels selectors:selArray args:nil receiver:anObject for:aTopMenu
+!
+
+labels:labels selectors:selArray receiver:anObject in:aView
+ "create and return a new MenuView in aView
+ - receiverObject gets message from selectorArray without argument"
+
+ ^ self labels:labels selectors:selArray args:nil receiver:anObject in:aView
! !
!MenuView class methodsFor:'defaults'!
@@ -144,322 +232,14 @@
DefaultFont := StyleSheet fontAt:'menuFont'.
! !
-!MenuView class methodsFor:'instance creation'!
-
-labels:labels selectors:selArray args:argArray receiver:anObject in:aView
- "create and return a new MenuView in aView
- - receiverObject gets message from selectorArray with argument
- from argArray"
-
- ^ (self in:aView)
- labels:labels
- selectors:selArray
- args:argArray
- receiver:anObject
-!
-
-labels:labels selectors:selArray receiver:anObject in:aView
- "create and return a new MenuView in aView
- - receiverObject gets message from selectorArray without argument"
-
- ^ self labels:labels selectors:selArray args:nil receiver:anObject in:aView
-!
-
-labels:labels selector:aSelector args:argArray receiver:anObject in:aTopMenu
- "create and return a new MenuView
- - receiverObject gets message aSelector with argument from
- argArray for all entries"
-
- "OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a
- single symbol-arg for selectors ..."
-
- ^ self labels:labels selectors:aSelector args:argArray receiver:anObject in:aTopMenu
-!
-
-labels:labels selectors:selArray args:argArray receiver:anObject for:aTopMenu
- "create and return a new MenuView for a topMenu"
-
- ^ self labels:labels selectors:selArray args:argArray receiver:anObject in:(aTopMenu superView)
-!
-
-labels:labels selector:aSelector args:argArray receiver:anObject for:aTopMenu
- "create and return a new MenuView
- - receiverObject gets message aSelector with argument from
- argArray for ALL entries"
-
- "OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a
- single symbol-arg for selectors ..."
-
- ^ self labels:labels selectors:aSelector args:argArray receiver:anObject in:(aTopMenu superView)
-!
-
-labels:labels selectors:selArray receiver:anObject for:aTopMenu
- ^ self labels:labels selectors:selArray args:nil receiver:anObject for:aTopMenu
-!
-
-labels:labels selectors:selArray args:argArray receiver:anObject
- "create and return a new MenuView. The parent view
- should be set later."
-
- ^ (self new)
- labels:labels
- selectors:selArray
- args:argArray
- receiver:anObject
-!
-
-labels:labels selectors:selArray args:argArray
- "create and return a new MenuView. The parent view
- should be set later."
-
- ^ self labels:labels selectors:selArray args:argArray
-!
-
-labels:labels selectors:selArray receiver:anObject
- "create and return a new MenuView. The parent view
- should be set later."
-
- ^ self labels:labels selectors:selArray args:nil receiver:anObject
-!
-
-labels:labels selectors:selArray
- "create and return a new MenuView. The parent veiw
- and receiver should be set later."
-
- ^ self labels:labels selectors:selArray args:nil receiver:nil
-!
-
-labels:labels
- "create and return a new MenuView. The parent view,
- selectors and receiver should be set later."
-
- ^ self labels:labels selectors:nil args:nil receiver:nil
-! !
-
-!MenuView methodsFor:'initialize / release'!
-
-initialize
- |style|
-
- super initialize.
- hideOnRelease := false.
- autoScroll := false.
-
- (((style := styleSheet name) ~~ #normal)
- and:[style ~~ #mswindows]) ifTrue:[
- borderWidth := 1.
- self level:1
- ].
-
- "stupid - have to redo this ..."
- hilightStyle == #openwin ifTrue:[
- "add some space for rounded-hilight area"
- self leftMargin:10.
- ].
-!
-
-reinitialize
- "this is called right after snapIn;
- a kind of kludge - reset cursor (in case the save was
- done with myself being shown and active)"
-
- super reinitialize.
- selection := nil. "self selection:nil."
- self showPassive
-!
-
-initStyle
- |style|
-
- super initStyle.
-
- DefaultFont notNil ifTrue:[
- font := DefaultFont on:device
- ].
-
- DefaultCheckColor notNil ifTrue:[
- checkColor := DefaultCheckColor
- ] ifFalse:[
- checkColor := fgColor.
- ].
- disabledFgColor := DefaultDisabledForegroundColor on:device.
-
- DefaultForegroundColor notNil ifTrue:[
- fgColor := DefaultForegroundColor on:device
- ].
- DefaultBackgroundColor notNil ifTrue:[
- bgColor := DefaultBackgroundColor on:device
- ].
-
- DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor on:device
- ].
- DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor on:device
- ].
-
- DefaultHilightLevel notNil ifTrue:[
- hilightLevel := DefaultHilightLevel
- ] ifFalse:[
- hilightLevel := 0.
- ].
- hilightStyle := DefaultHilightStyle.
-
- hilightFrameColor := DefaultHilightFrameColor.
-
- styleSheet is3D ifTrue:[
- "some 3D style menu - set hilight defaults to same"
-
- DefaultHilightForegroundColor notNil ifTrue:[
- hilightFgColor := DefaultHilightForegroundColor on:device
- ] ifFalse:[
- hilightFgColor := fgColor.
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- hilightBgColor := DefaultHilightBackgroundColor on:device
- ] ifFalse:[
- hilightBgColor := bgColor.
- ].
- DefaultLineLevel notNil ifTrue:[
- lineLevel := DefaultLineLevel
- ] ifFalse:[
- lineLevel := -1.
- ]
- ] ifFalse:[
- "some 2D style menu - set hilight defaults to inverse"
- DefaultHilightForegroundColor notNil ifTrue:[
- hilightFgColor := DefaultHilightForegroundColor on:device
- ] ifFalse:[
- hilightFgColor := bgColor.
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- hilightBgColor := DefaultHilightBackgroundColor on:device
- ] ifFalse:[
- hilightBgColor := fgColor.
- ].
- DefaultLineLevel notNil ifTrue:[
- lineLevel := DefaultLineLevel
- ] ifFalse:[
- lineLevel := 0.
- ]
- ].
-
- DefaultLineInset notNil ifTrue:[
- lineInset := DefaultLineInset
- ] ifFalse:[
- lineInset := (device horizontalPixelPerMillimeter * 0.8) rounded.
- ].
-
- "
- the following has to be changed to
- use the styleSheet too
- "
- style := styleSheet name.
-
- (style == #iris) ifTrue:[
- device hasGreyscales ifTrue:[
- lineSpacing := 3
- ].
- ].
- (style == #motif) ifTrue:[
- lineSpacing := (2 * hilightLevel)
- ].
- hilightStyle == #openwin ifTrue:[
- "add some space for rounded-hilight area"
- self leftMargin:10.
- ] ifFalse:[
- (hilightLevel ~~ 0) ifTrue:[
- self leftMargin:hilightLevel abs + self margin abs + 1.
- lineSpacing := lineSpacing max:(hilightLevel abs * 2).
- ]
- ].
- (style == #st80) ifTrue:[
- level := 0.
- ].
- DefaultViewBackground notNil ifTrue:[
- viewBackground := DefaultViewBackground on:device
- ].
-
- "Modified: 22.11.1995 / 23:18:54 / cg"
-!
-
-initEvents
- super initEvents.
- self enableLeaveEvents.
- windowGroup notNil ifTrue:[
- windowGroup sensor compressMotionEvents:true
- ]
-!
-
-create
- super create.
- subMenuShown := nil.
- self resizeIfChanged
-!
-
-recreate
- "when recreated after a snapin, resize myself, in case
- font dimensions have changed on the display"
-
- super recreate.
- hilightStyle == #openwin ifTrue:[
- self leftMargin:10.
- ].
- self resize
-!
-
-destroy
- "
- have to destroy the submenus manually here,
- since they are no real subviews of myself
- "
- subMenus notNil ifTrue:[
- subMenus do:[:m |
- m notNil ifTrue:[
- m destroy
- ]
- ].
- subMenus := nil
- ].
- super destroy.
-! !
-
-!MenuView methodsFor:'queries'!
-
-preferredExtent
- |margin2 w h|
-
- widthOfWidestLine := nil. "/ i.e. unknown
-
- margin2 := margin * 2.
- w := self widthOfContents + leftMargin + leftMargin + margin2.
- h := (self numberOfLines) * fontHeight - lineSpacing + (2 * topMargin) + margin2.
- "if there is a submenu, add some space for the right arrow"
- subMenus notNil ifTrue:[
- w := w + 16
- ].
- ^ (w @ h).
-! !
-
-
!MenuView methodsFor:'accessing-behavior'!
-hideOnRelease:aBoolean
- hideOnRelease := aBoolean
-!
-
disable:indexOrName
"disable an entry"
self setEnable:indexOrName to:false
!
-enable:indexOrName
- "enable an entry"
-
- self setEnable:indexOrName to:true
-!
-
disableAll:collectionOfIndicesOrNames
"disable an collection of entries"
@@ -468,6 +248,12 @@
]
!
+enable:indexOrName
+ "enable an entry"
+
+ self setEnable:indexOrName to:true
+!
+
enableAll:collectionOfIndicesOrNames
"enable an collection of entries"
@@ -476,6 +262,10 @@
]
!
+hideOnRelease:aBoolean
+ hideOnRelease := aBoolean
+!
+
isEnabled:indexOrName
|index|
@@ -519,146 +309,8 @@
]
! !
-!MenuView methodsFor:'accessing-look'!
-
-font:aFont
- "adjust size for new font"
-
- super font:(aFont on:device).
- shown ifTrue:[
- self resize
- ] ifFalse:[
- needResize := true
- ]
-! !
-
-!MenuView methodsFor:'accessing-misc'!
-
-selection:index
- |sel line|
-
- sel := index.
- sel notNil ifTrue:[
- line := self listAt:index.
- (self isGraphicItem:line) ifTrue:[
- "
- not really selectable, but a separating line
- "
- sel := nil
- ]
- ].
- super selection:sel
-!
-
-superMenu:aMenu
- "set the menu I am contained in
- - need this to hide main menus when a submenu performed its action"
-
- superMenu := aMenu
-!
-
-superMenu
- "ret the menu I am contained in
- - need this to hide main menus when a submenu performed its action"
-
- ^ superMenu
-!
-
-masterView
- "return the popup-masterview I am contained in."
-
- ^ masterView
-!
-
-masterView:aPopUpView
- "set the popup-masterview I am contained in."
-
- masterView := aPopUpView
-! !
-
!MenuView methodsFor:'accessing-items'!
-labels
- "return the menu-labels"
-
- ^ list
-!
-
-labels:text
- "set the labels to the argument, text"
-
- |l|
-
- (text isString) ifTrue:[
- l := text asStringCollection
- ] ifFalse:[
- l := text
- ].
-"/ self list:l
- self setList:l expandTabs:false.
- enableFlags := Array new:(list size) withAll:true.
- onOffFlags := Array new:(list size).
- text keysAndValuesDo:[:index :line |
- (line notNil and:[line includes:$\ ]) ifTrue:[
- onOffFlags at:index put:false
- ].
- ].
- shown ifTrue:[
- self resize
- ] ifFalse:[
- needResize := true
- ]
-!
-
-labels:text selectors:selArray args:argArray receiver:anObject
- "set all relevant stuff"
-
- self labels:text.
- selectors := selArray.
- args := argArray.
- receiver := anObject
-!
-
-labelAt:indexOrName put:aString
- "change the label at index to be aString"
-
- |i nItems|
-
- i := self indexOf:indexOrName.
- i == 0 ifTrue:[^ self].
- list at:i put:aString.
-
- "create onOff flags, if this label has a check-mark"
- (self isCheckItem:aString) ifTrue:[
- nItems := list size.
- onOffFlags isNil ifTrue:[
- onOffFlags := Array new:nItems
- ] ifFalse:[
- [onOffFlags size < nItems] whileTrue:[
- onOffFlags := onOffFlags copyWith:nil
- ]
- ].
- onOffFlags at:i put:false
- ].
- shown ifTrue:[
- self resize
- ] ifFalse:[
- needResize := true
- ]
-!
-
-addSeparatingLine
- "add a separating line"
-
- self addLabel:'-' selector:nil
-!
-
-addSeparatingLineAfter:aLabelOrSelectorOrNumber
- "add a separating line"
-
- self addLabel:'-' selector:nil after:aLabelOrSelectorOrNumber
-!
-
addLabel:aLabel selector:aSelector
"add another label/selector pair"
@@ -676,24 +328,6 @@
]
!
-addLabel:aLabel selector:aSelector arg:anArg
- "add another label/selector/argument trio"
-
- list isNil ifTrue:[
- list := Array with:aLabel
- ] ifFalse:[
- list := list copyWith:aLabel
- ].
- selectors := selectors copyWith:aSelector.
- args := args copyWith:anArg.
- enableFlags := enableFlags copyWith:true.
- shown ifTrue:[
- self resize
- ] ifFalse:[
- needResize := true
- ]
-!
-
addLabel:aLabel selector:aSelector after:aLabelOrSelectorOrNumber
"insert another label/selector pair at some place.
Being very friendly here, allowing label-string, selector or numeric
@@ -725,6 +359,87 @@
"
!
+addLabel:aLabel selector:aSelector arg:anArg
+ "add another label/selector/argument trio"
+
+ list isNil ifTrue:[
+ list := Array with:aLabel
+ ] ifFalse:[
+ list := list copyWith:aLabel
+ ].
+ selectors := selectors copyWith:aSelector.
+ args := args copyWith:anArg.
+ enableFlags := enableFlags copyWith:true.
+ shown ifTrue:[
+ self resize
+ ] ifFalse:[
+ needResize := true
+ ]
+!
+
+addLabel:aLabel selector:aSelector before:aLabelOrSelectorOrNumber
+ "insert another label/selector pair at some place.
+ Being very friendly here, allowing label-string, selector or numeric
+ index for the argument aLabelOrSelectorOrNumber.
+
+ To be independent of the entries label, we recommend you use the selector
+ as index; in systems which translate strings for national variants,
+ this makes your code easier to maintain."
+
+ |idx|
+
+ list isNil ifTrue:[
+ ^ self addLabel:aLabel selector:aSelector
+ ].
+ "
+ be user friendly - allow both label or selector
+ to be passed
+ "
+ idx := self indexOf:aLabelOrSelectorOrNumber.
+ (idx between:1 and:list size) ifFalse:[
+ "add to end"
+ ^ self addLabel:aLabel selector:aSelector
+ ].
+
+ list := list asOrderedCollection.
+ list add:aLabel beforeIndex:idx.
+ selectors := selectors asOrderedCollection.
+ selectors add:aSelector beforeIndex:idx.
+ enableFlags := enableFlags asOrderedCollection.
+ enableFlags add:true beforeIndex:idx.
+ subMenus notNil ifTrue:[
+ subMenus := subMenus asOrderedCollection.
+ subMenus add:nil beforeIndex:idx.
+ ].
+ args notNil ifTrue:[
+ args := args asOrderedCollection.
+ args add:nil beforeIndex:idx.
+ ].
+ shown ifTrue:[
+ self resize
+ ] ifFalse:[
+ needResize := true
+ ]
+
+ "
+ |v1 v2 v3 v4|
+
+ v1 := CodeView new realize.
+
+ v2 := CodeView new realize.
+ v2 middleButtonMenu:
+ (v2 editMenu) addLabel:'new entry' selector:#foo before:'paste'.
+
+ v3 := CodeView new realize.
+ v3 middleButtonMenu:
+ (v3 editMenu) addLabel:'new entry' selector:#foo before:#again.
+
+ v4 := CodeView new realize.
+ v4 middleButtonMenu:
+ (v4 editMenu) addLabel:'new entry' selector:#foo before:1.
+ "
+!
+
addLabels:moreLabels selectors:moreSelectors
"add more labels and selectors at the end"
@@ -858,169 +573,16 @@
"
!
-addLabel:aLabel selector:aSelector before:aLabelOrSelectorOrNumber
- "insert another label/selector pair at some place.
- Being very friendly here, allowing label-string, selector or numeric
- index for the argument aLabelOrSelectorOrNumber.
-
- To be independent of the entries label, we recommend you use the selector
- as index; in systems which translate strings for national variants,
- this makes your code easier to maintain."
-
- |idx|
-
- list isNil ifTrue:[
- ^ self addLabel:aLabel selector:aSelector
- ].
- "
- be user friendly - allow both label or selector
- to be passed
- "
- idx := self indexOf:aLabelOrSelectorOrNumber.
- (idx between:1 and:list size) ifFalse:[
- "add to end"
- ^ self addLabel:aLabel selector:aSelector
- ].
+addSeparatingLine
+ "add a separating line"
- list := list asOrderedCollection.
- list add:aLabel beforeIndex:idx.
- selectors := selectors asOrderedCollection.
- selectors add:aSelector beforeIndex:idx.
- enableFlags := enableFlags asOrderedCollection.
- enableFlags add:true beforeIndex:idx.
- subMenus notNil ifTrue:[
- subMenus := subMenus asOrderedCollection.
- subMenus add:nil beforeIndex:idx.
- ].
- args notNil ifTrue:[
- args := args asOrderedCollection.
- args add:nil beforeIndex:idx.
- ].
- shown ifTrue:[
- self resize
- ] ifFalse:[
- needResize := true
- ]
-
- "
- |v1 v2 v3 v4|
-
- v1 := CodeView new realize.
-
- v2 := CodeView new realize.
- v2 middleButtonMenu:
- (v2 editMenu) addLabel:'new entry' selector:#foo before:'paste'.
-
- v3 := CodeView new realize.
- v3 middleButtonMenu:
- (v3 editMenu) addLabel:'new entry' selector:#foo before:#again.
-
- v4 := CodeView new realize.
- v4 middleButtonMenu:
- (v4 editMenu) addLabel:'new entry' selector:#foo before:1.
- "
+ self addLabel:'-' selector:nil
!
-remove:indexOrName
- "remove the label at index"
-
- |i|
-
- i := self indexOf:indexOrName.
- i == 0 ifTrue:[^ self].
- list := list asOrderedCollection removeIndex:i.
- selectors := selectors asOrderedCollection removeIndex:i.
- enableFlags := enableFlags asOrderedCollection removeIndex:i.
- subMenus notNil ifTrue:[
- subMenus := subMenus asOrderedCollection removeIndex:i.
- ].
- shown ifTrue:[
- self resize
- ] ifFalse:[
- needResize := true
- ]
-!
-
-indexOf:indexOrName
- "return the index of the label named:aName or , if its a symbol
- the index in the selector list"
-
- indexOrName isSymbol ifTrue:[
- ^ selectors indexOf:indexOrName
- ].
- indexOrName isString ifTrue:[
- ^ list indexOf:indexOrName
- ].
- indexOrName isNil ifTrue:[^ 0].
- ^ indexOrName
-!
-
-someMenuItemLabeled:aLabel
- "find a menu item.
- Currently, in ST/X, instances of MenuItem are only created as dummy"
-
- |idx|
-
- idx := self indexOf:aLabel.
- idx ~~ 0 ifTrue:[
- ^ MenuItem new menu:self index:idx
- ].
- subMenus notNil ifTrue:[
- subMenus do:[:aMenu |
- |item|
+addSeparatingLineAfter:aLabelOrSelectorOrNumber
+ "add a separating line"
- aMenu notNil ifTrue:[
- (item := aMenu someMenuItemLabeled:aLabel) notNil ifTrue:[
- ^ item
- ]
- ]
- ].
- ].
- ^ nil
-!
-
-receiver
- "return the receiver of the message"
-
- ^ receiver
-!
-
-checkFlags
- "return an array filled with the check-mark flags.
- Non check-menu items have a nil entry in this array."
-
- ^ onOffFlags
-!
-
-selectors
- "return the selector array"
-
- ^ selectors
-!
-
-selectors:anArray
- "set the selector array"
-
- selectors := anArray
-!
-
-selectorAt:indexOrName
- "return an individual selector"
-
- |i|
-
- i := self indexOf:indexOrName.
- i ~~ 0 ifTrue:[^ selectors at:i].
- ^ nil
-!
-
-selectorAt:indexOrName put:aSelector
- "set an individual selector"
-
- |i|
-
- i := self indexOf:indexOrName.
- i ~~ 0 ifTrue:[selectors at:i put:aSelector]
+ self addLabel:'-' selector:nil after:aLabelOrSelectorOrNumber
!
args
@@ -1044,17 +606,11 @@
i ~~ 0 ifTrue:[args at:i put:something]
!
-receiver:anObject
- "set the receiver of the message"
+checkFlags
+ "return an array filled with the check-mark flags.
+ Non check-menu items have a nil entry in this array."
- receiver := anObject.
- subMenus notNil ifTrue:[
- subMenus do:[:aMenu |
- aMenu notNil ifTrue:[
- aMenu receiver:anObject
- ]
- ]
- ]
+ ^ onOffFlags
!
checkToggleAt:indexOrName
@@ -1083,16 +639,244 @@
shown ifTrue:[
self redrawLine:index
]
+!
+
+indexOf:indexOrName
+ "return the index of the label named:aName or , if its a symbol
+ the index in the selector list"
+
+ indexOrName isSymbol ifTrue:[
+ ^ selectors indexOf:indexOrName
+ ].
+ indexOrName isString ifTrue:[
+ ^ list indexOf:indexOrName
+ ].
+ indexOrName isNil ifTrue:[^ 0].
+ ^ indexOrName
+!
+
+labelAt:indexOrName put:aString
+ "change the label at index to be aString"
+
+ |i nItems|
+
+ i := self indexOf:indexOrName.
+ i == 0 ifTrue:[^ self].
+ list at:i put:aString.
+
+ "create onOff flags, if this label has a check-mark"
+ (self isCheckItem:aString) ifTrue:[
+ nItems := list size.
+ onOffFlags isNil ifTrue:[
+ onOffFlags := Array new:nItems
+ ] ifFalse:[
+ [onOffFlags size < nItems] whileTrue:[
+ onOffFlags := onOffFlags copyWith:nil
+ ]
+ ].
+ onOffFlags at:i put:false
+ ].
+ shown ifTrue:[
+ self resize
+ ] ifFalse:[
+ needResize := true
+ ]
+!
+
+labels
+ "return the menu-labels"
+
+ ^ list
+!
+
+labels:text
+ "set the labels to the argument, text"
+
+ |l|
+
+ (text isString) ifTrue:[
+ l := text asStringCollection
+ ] ifFalse:[
+ l := text
+ ].
+"/ self list:l
+ self setList:l expandTabs:false.
+ enableFlags := Array new:(list size) withAll:true.
+ onOffFlags := Array new:(list size).
+ text keysAndValuesDo:[:index :line |
+ (line notNil and:[line includes:$\ ]) ifTrue:[
+ onOffFlags at:index put:false
+ ].
+ ].
+ shown ifTrue:[
+ self resize
+ ] ifFalse:[
+ needResize := true
+ ]
+!
+
+labels:text selectors:selArray args:argArray receiver:anObject
+ "set all relevant stuff"
+
+ self labels:text.
+ selectors := selArray.
+ args := argArray.
+ receiver := anObject
+!
+
+receiver
+ "return the receiver of the message"
+
+ ^ receiver
+!
+
+receiver:anObject
+ "set the receiver of the message"
+
+ receiver := anObject.
+ subMenus notNil ifTrue:[
+ subMenus do:[:aMenu |
+ aMenu notNil ifTrue:[
+ aMenu receiver:anObject
+ ]
+ ]
+ ]
+!
+
+remove:indexOrName
+ "remove the label at index"
+
+ |i|
+
+ i := self indexOf:indexOrName.
+ i == 0 ifTrue:[^ self].
+ list := list asOrderedCollection removeIndex:i.
+ selectors := selectors asOrderedCollection removeIndex:i.
+ enableFlags := enableFlags asOrderedCollection removeIndex:i.
+ subMenus notNil ifTrue:[
+ subMenus := subMenus asOrderedCollection removeIndex:i.
+ ].
+ shown ifTrue:[
+ self resize
+ ] ifFalse:[
+ needResize := true
+ ]
+!
+
+selectorAt:indexOrName
+ "return an individual selector"
+
+ |i|
+
+ i := self indexOf:indexOrName.
+ i ~~ 0 ifTrue:[^ selectors at:i].
+ ^ nil
+!
+
+selectorAt:indexOrName put:aSelector
+ "set an individual selector"
+
+ |i|
+
+ i := self indexOf:indexOrName.
+ i ~~ 0 ifTrue:[selectors at:i put:aSelector]
+!
+
+selectors
+ "return the selector array"
+
+ ^ selectors
+!
+
+selectors:anArray
+ "set the selector array"
+
+ selectors := anArray
+!
+
+someMenuItemLabeled:aLabel
+ "find a menu item.
+ Currently, in ST/X, instances of MenuItem are only created as dummy"
+
+ |idx|
+
+ idx := self indexOf:aLabel.
+ idx ~~ 0 ifTrue:[
+ ^ MenuItem new menu:self index:idx
+ ].
+ subMenus notNil ifTrue:[
+ subMenus do:[:aMenu |
+ |item|
+
+ aMenu notNil ifTrue:[
+ (item := aMenu someMenuItemLabeled:aLabel) notNil ifTrue:[
+ ^ item
+ ]
+ ]
+ ].
+ ].
+ ^ nil
+! !
+
+!MenuView methodsFor:'accessing-look'!
+
+font:aFont
+ "adjust size for new font"
+
+ super font:(aFont on:device).
+ shown ifTrue:[
+ self resize
+ ] ifFalse:[
+ needResize := true
+ ]
+! !
+
+!MenuView methodsFor:'accessing-misc'!
+
+masterView
+ "return the popup-masterview I am contained in."
+
+ ^ masterView
+!
+
+masterView:aPopUpView
+ "set the popup-masterview I am contained in."
+
+ masterView := aPopUpView
+!
+
+selection:index
+ |sel line|
+
+ sel := index.
+ sel notNil ifTrue:[
+ line := self listAt:index.
+ (self isGraphicItem:line) ifTrue:[
+ "
+ not really selectable, but a separating line
+ "
+ sel := nil
+ ]
+ ].
+ super selection:sel
+!
+
+superMenu
+ "ret the menu I am contained in
+ - need this to hide main menus when a submenu performed its action"
+
+ ^ superMenu
+!
+
+superMenu:aMenu
+ "set the menu I am contained in
+ - need this to hide main menus when a submenu performed its action"
+
+ superMenu := aMenu
! !
!MenuView methodsFor:'accessing-submenus'!
-subMenuShown
- "return the currently visible submenu - or nil if there is none"
-
- ^ subMenuShown
-!
-
subMenuAt:indexOrName
"return a submenu, or nil"
@@ -1124,6 +908,359 @@
]
].
subMenus at:i put:aPopUpMenu
+!
+
+subMenuShown
+ "return the currently visible submenu - or nil if there is none"
+
+ ^ subMenuShown
+! !
+
+!MenuView methodsFor:'disabled scrolling'!
+
+makeSelectionVisible
+ ^ self
+! !
+
+!MenuView methodsFor:'event handling'!
+
+buttonMotion:state x:x y:y
+ state ~~ 0 ifTrue:[
+ self setSelectionForX:x y:y
+ ]
+!
+
+buttonPress:button x:x y:y
+ self setSelectionForX:x y:y
+!
+
+buttonRelease:button x:x y:y
+ |theSelector isCheck checkOn val|
+
+ subMenuShown notNil ifTrue:[
+ ^ self
+ ].
+
+ (x >= 0 and:[x < width]) ifTrue:[
+ (y >= 0 and:[y < height]) ifTrue:[
+ selection notNil ifTrue:[
+ (subMenus isNil or:[(subMenus at:selection) isNil]) ifTrue:[
+ self showActive.
+ [
+ superMenu notNil ifTrue:[
+ superMenu showActive
+ ].
+
+ val := selection.
+ args notNil ifTrue:[
+ val := args at:selection
+ ].
+
+ isCheck := false.
+ onOffFlags notNil ifTrue:[
+ onOffFlags size >= selection ifTrue:[
+ checkOn := (onOffFlags at:selection).
+ isCheck := checkOn notNil.
+ isCheck ifTrue:[
+ checkOn := val := checkOn not.
+ onOffFlags at:selection put:checkOn.
+ ]
+ ]
+ ].
+
+ "
+ ST-80 style model notification
+ "
+ self sendChangeMessageWith:val.
+
+ "
+ either action-block or selectors-array-style
+ "
+ actionBlock notNil ifTrue:[
+ Object 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:[
+ Object abortSignal handle:[:ex |
+ ex return
+ ] do:[
+ isCheck ifTrue:[
+ self redrawLine:selection.
+ receiver perform:theSelector with:checkOn
+ ] ifFalse:[
+ (args isNil or:[theSelector numArgs == 0]) ifTrue:[
+ receiver perform:theSelector
+ ] ifFalse:[
+ receiver perform:theSelector with:val
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ] valueNowOrOnUnwindDo:[
+ realized ifTrue:[
+ self showPassive.
+ ].
+ superMenu notNil ifTrue:[
+ superMenu showPassive
+ ]
+ ].
+ ].
+ ]
+ ]
+ ].
+ (superMenu notNil and:[superMenu shown not]) ifTrue:[
+ (superView notNil and:[superView shown]) ifTrue:[superView hide].
+ ].
+ hideOnRelease ifTrue:[
+ superView hide
+ ].
+!
+
+keyPress:aKey x:x y:y
+ |m|
+
+ subMenuShown notNil ifTrue:[
+ subMenuShown keyPress:aKey x:0 y:0.
+ ^ self
+ ].
+
+ "
+ Return, space or the (virtual) MenuSelect
+ key trigger a selected entry.
+ "
+ (aKey == #Return
+ or:[aKey == #MenuSelect
+ or:[aKey == Character space]]) ifTrue:[
+ selection notNil ifTrue:[
+ (subMenus notNil and:[(m := subMenus at:selection) notNil]) ifTrue:[
+ self showSubmenu:selection.
+ m hideOnLeave:false
+ ] ifFalse:[
+ subMenuShown := nil.
+ self buttonRelease:1 x:x y:y.
+ ]
+ ].
+ ^ self
+ ].
+ super keyPress:aKey x:x y:y
+!
+
+pointerLeave:state
+ subMenuShown notNil ifTrue:[
+ ^ self
+ ].
+"/ self setSelectionForX:-1 y:-1. "force deselect"
+ subMenuShown isNil ifTrue:[
+ self selection:nil
+ ].
+"/ superMenu notNil ifTrue:[
+"/ superMenu regainControl.
+"/ ]
+! !
+
+!MenuView methodsFor:'initialize / release'!
+
+create
+ super create.
+ subMenuShown := nil.
+ self resizeIfChanged
+!
+
+destroy
+ "
+ have to destroy the submenus manually here,
+ since they are no real subviews of myself
+ "
+ subMenus notNil ifTrue:[
+ subMenus do:[:m |
+ m notNil ifTrue:[
+ m destroy
+ ]
+ ].
+ subMenus := nil
+ ].
+ super destroy.
+!
+
+initEvents
+ super initEvents.
+ self enableLeaveEvents.
+ windowGroup notNil ifTrue:[
+ windowGroup sensor compressMotionEvents:true
+ ]
+!
+
+initStyle
+ |style|
+
+ super initStyle.
+
+ DefaultFont notNil ifTrue:[
+ font := DefaultFont on:device
+ ].
+
+ DefaultCheckColor notNil ifTrue:[
+ checkColor := DefaultCheckColor
+ ] ifFalse:[
+ checkColor := fgColor.
+ ].
+ disabledFgColor := DefaultDisabledForegroundColor on:device.
+
+ DefaultForegroundColor notNil ifTrue:[
+ fgColor := DefaultForegroundColor on:device
+ ].
+ DefaultBackgroundColor notNil ifTrue:[
+ bgColor := DefaultBackgroundColor on:device
+ ].
+
+ DefaultShadowColor notNil ifTrue:[
+ shadowColor := DefaultShadowColor on:device
+ ].
+ DefaultLightColor notNil ifTrue:[
+ lightColor := DefaultLightColor on:device
+ ].
+
+ DefaultHilightLevel notNil ifTrue:[
+ hilightLevel := DefaultHilightLevel
+ ] ifFalse:[
+ hilightLevel := 0.
+ ].
+ hilightStyle := DefaultHilightStyle.
+
+ hilightFrameColor := DefaultHilightFrameColor.
+
+ styleSheet is3D ifTrue:[
+ "some 3D style menu - set hilight defaults to same"
+
+ DefaultHilightForegroundColor notNil ifTrue:[
+ hilightFgColor := DefaultHilightForegroundColor on:device
+ ] ifFalse:[
+ hilightFgColor := fgColor.
+ ].
+ DefaultHilightBackgroundColor notNil ifTrue:[
+ hilightBgColor := DefaultHilightBackgroundColor on:device
+ ] ifFalse:[
+ hilightBgColor := bgColor.
+ ].
+ DefaultLineLevel notNil ifTrue:[
+ lineLevel := DefaultLineLevel
+ ] ifFalse:[
+ lineLevel := -1.
+ ]
+ ] ifFalse:[
+ "some 2D style menu - set hilight defaults to inverse"
+ DefaultHilightForegroundColor notNil ifTrue:[
+ hilightFgColor := DefaultHilightForegroundColor on:device
+ ] ifFalse:[
+ hilightFgColor := bgColor.
+ ].
+ DefaultHilightBackgroundColor notNil ifTrue:[
+ hilightBgColor := DefaultHilightBackgroundColor on:device
+ ] ifFalse:[
+ hilightBgColor := fgColor.
+ ].
+ DefaultLineLevel notNil ifTrue:[
+ lineLevel := DefaultLineLevel
+ ] ifFalse:[
+ lineLevel := 0.
+ ]
+ ].
+
+ DefaultLineInset notNil ifTrue:[
+ lineInset := DefaultLineInset
+ ] ifFalse:[
+ lineInset := (device horizontalPixelPerMillimeter * 0.8) rounded.
+ ].
+
+ "
+ the following has to be changed to
+ use the styleSheet too
+ "
+ style := styleSheet name.
+
+ (style == #iris) ifTrue:[
+ device hasGreyscales ifTrue:[
+ lineSpacing := 3
+ ].
+ ].
+ (style == #motif) ifTrue:[
+ lineSpacing := (2 * hilightLevel)
+ ].
+ hilightStyle == #openwin ifTrue:[
+ "add some space for rounded-hilight area"
+ self leftMargin:10.
+ ] ifFalse:[
+ (hilightLevel ~~ 0) ifTrue:[
+ self leftMargin:hilightLevel abs + self margin abs + 1.
+ lineSpacing := lineSpacing max:(hilightLevel abs * 2).
+ ]
+ ].
+ (style == #st80) ifTrue:[
+ level := 0.
+ ].
+ DefaultViewBackground notNil ifTrue:[
+ viewBackground := DefaultViewBackground on:device
+ ].
+
+ "Modified: 22.11.1995 / 23:18:54 / cg"
+!
+
+initialize
+ |style|
+
+ super initialize.
+ hideOnRelease := false.
+ autoScroll := false.
+
+ (((style := styleSheet name) ~~ #normal)
+ and:[style ~~ #mswindows]) ifTrue:[
+ borderWidth := 1.
+ self level:1
+ ].
+
+ "stupid - have to redo this ..."
+ hilightStyle == #openwin ifTrue:[
+ "add some space for rounded-hilight area"
+ self leftMargin:10.
+ ].
+!
+
+recreate
+ "when recreated after a snapin, resize myself, in case
+ font dimensions have changed on the display"
+
+ super recreate.
+ hilightStyle == #openwin ifTrue:[
+ self leftMargin:10.
+ ].
+ self resize
+!
+
+reinitialize
+ "this is called right after snapIn;
+ a kind of kludge - reset cursor (in case the save was
+ done with myself being shown and active)"
+
+ super reinitialize.
+ selection := nil. "self selection:nil."
+ self showPassive
! !
!MenuView methodsFor:'private'!
@@ -1135,18 +1272,20 @@
].
!
-resizeIfChanged
- needResize == true ifTrue:[
- self resize.
- needResize := false
- ]
+isCheckItem:line
+ line notNil ifTrue:[
+ (line startsWith:'\c') ifTrue:[^ true].
+ (line startsWith:'\b') ifTrue:[^ true].
+ (line startsWith:'\t')ifTrue:[^ true].
+ ].
+ ^ false.
!
-resize
- "resize myself to my preferred size"
-
- widthOfWidestLine := nil. "/ i.e. unknown
- super resize.
+isGraphicItem:line
+ (line = '-') ifTrue:[^ true].
+ (line = '=') ifTrue:[^ true].
+ (line = '') ifTrue:[^ true].
+ ^ false.
!
recomputeSize
@@ -1156,51 +1295,18 @@
self resize.
!
-showSubmenu:index
- "show subMenu at index"
-
- |org mx my m|
-
- m := subMenus at:index.
- m isNil ifTrue:[^ self].
- m == subMenuShown ifTrue:[^ self].
-
- mx := width - 5.
- my := self yOfVisibleLine:index.
- "
- need to know the physical screen coordinate,
- to map the subview there
- "
- org := device
- translatePoint:(mx @ my)
- from:(self id)
- to:(device rootWindowId).
+resize
+ "resize myself to my preferred size"
-"/ mhmh - is this still needed ?
- "
- before showing, process all of my expose events
- "
- windowGroup notNil ifTrue:[
- windowGroup processExposeEvents
- ].
-
- m superMenu:self.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ super resize.
+!
- "
- realize the submenu in MY windowgroup
- "
- windowGroup notNil ifTrue:[
- m windowGroup:windowGroup.
- windowGroup addTopView:m.
- ].
- m fixSize.
- m origin:org.
- m makeFullyVisible.
- m noShadow.
- m realize.
- device flush.
-
- subMenuShown := m
+resizeIfChanged
+ needResize == true ifTrue:[
+ self resize.
+ needResize := false
+ ]
!
setSelectionForX:x y:y
@@ -1257,47 +1363,68 @@
]
!
-isCheckItem:line
- line notNil ifTrue:[
- (line startsWith:'\c') ifTrue:[^ true].
- (line startsWith:'\b') ifTrue:[^ true].
- (line startsWith:'\t')ifTrue:[^ true].
+showSubmenu:index
+ "show subMenu at index"
+
+ |org mx my m|
+
+ m := subMenus at:index.
+ m isNil ifTrue:[^ self].
+ m == subMenuShown ifTrue:[^ self].
+
+ mx := width - 5.
+ my := self yOfVisibleLine:index.
+ "
+ need to know the physical screen coordinate,
+ to map the subview there
+ "
+ org := device
+ translatePoint:(mx @ my)
+ from:(self id)
+ to:(device rootWindowId).
+
+"/ mhmh - is this still needed ?
+ "
+ before showing, process all of my expose events
+ "
+ windowGroup notNil ifTrue:[
+ windowGroup processExposeEvents
].
- ^ false.
-!
+
+ m superMenu:self.
-isGraphicItem:line
- (line = '-') ifTrue:[^ true].
- (line = '=') ifTrue:[^ true].
- (line = '') ifTrue:[^ true].
- ^ false.
+ "
+ realize the submenu in MY windowgroup
+ "
+ windowGroup notNil ifTrue:[
+ m windowGroup:windowGroup.
+ windowGroup addTopView:m.
+ ].
+ m fixSize.
+ m origin:org.
+ m makeFullyVisible.
+ m noShadow.
+ m realize.
+ device flush.
+
+ subMenuShown := m
! !
-!MenuView methodsFor:'showing'!
+!MenuView methodsFor:'queries'!
-realize
- needResize == true ifTrue:[
- self recomputeSize
- ].
- super realize
-!
+preferredExtent
+ |margin2 w h|
+
+ widthOfWidestLine := nil. "/ i.e. unknown
-show
- hiddenOnRealize := false.
- self realize
-! !
-
-!MenuView methodsFor:'selections'!
-
-isValidSelection:aNumber
- "return true, if aNumber is ok for a selection lineNo"
-
- |line|
-
- (super isValidSelection:aNumber) ifFalse:[^ false].
-
- line := self listAt:aNumber.
- ^ (self isGraphicItem:line) not
+ margin2 := margin * 2.
+ w := self widthOfContents + leftMargin + leftMargin + margin2.
+ h := (self numberOfLines) * fontHeight - lineSpacing + (2 * topMargin) + margin2.
+ "if there is a submenu, add some space for the right arrow"
+ subMenus notNil ifTrue:[
+ w := w + 16
+ ].
+ ^ (w @ h).
! !
!MenuView methodsFor:'redrawing'!
@@ -1485,22 +1612,63 @@
"Modified: 22.11.1995 / 23:28:47 / cg"
!
-redrawVisibleLine:visLine col:col
- "redefined to always draw a full line - for openwin handling"
+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 ..."
- self redrawVisibleLine:visLine
-!
+ |first
+ index "{ Class: SmallInteger }"
+ current "{ Class: SmallInteger }"
+ line special index0|
+
+ index0 := self visibleLineToListLine:start.
+ index0 notNil ifTrue:[
+ index := index0.
+ first := start.
+ current := start.
+ [current <= stop] whileTrue:[
+ line := (self visibleAt:current) string.
+
+ special := line notNil
+ and:[(self isGraphicItem:line)
+ or:[(line at:1) == $\ ]].
-redrawVisibleLine:visLine from:startCol
- "redefined to always draw a full line - for openwin handling"
+ (special
+ or:[(enableFlags at:index) not]) ifTrue:[
+ "a special case"
+ (first < current) ifTrue:[
+ super redrawFromVisibleLine:first to:(current - 1)
+ ].
+ self redrawVisibleLine:current.
+ first := current + 1
+ ].
+ current := current + 1.
+ index := index + 1
+ ].
+ (first < current) ifTrue:[
+ super redrawFromVisibleLine:first to:(current - 1)
+ ].
- self redrawVisibleLine:visLine
-!
-
-redrawVisibleLine:visLine from:startCol to:endCol
- "redefined to always draw a full line - for openwin handling"
-
- self redrawVisibleLine:visLine
+ "draw submenu marks"
+ subMenus notNil ifTrue:[
+ index := index0.
+ start to:stop do:[:l |
+ index <= subMenus size ifTrue:[
+ (subMenus at:index) notNil ifTrue:[
+ self drawRightArrowInVisibleLine:l
+ ].
+ index := index + 1
+ ]
+ ]
+ ]
+ ]
!
redrawVisibleLine:visLineNr
@@ -1593,86 +1761,53 @@
]
!
-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 ..."
+redrawVisibleLine:visLine col:col
+ "redefined to always draw a full line - for openwin handling"
- |first
- index "{ Class: SmallInteger }"
- current "{ Class: SmallInteger }"
- line special index0|
-
- index0 := self visibleLineToListLine:start.
- index0 notNil ifTrue:[
- index := index0.
- first := start.
- current := start.
- [current <= stop] whileTrue:[
- line := (self visibleAt:current) string.
-
- special := line notNil
- and:[(self isGraphicItem:line)
- or:[(line at:1) == $\ ]].
+ self redrawVisibleLine:visLine
+!
- (special
- or:[(enableFlags at:index) not]) ifTrue:[
- "a special case"
- (first < current) ifTrue:[
- super redrawFromVisibleLine:first to:(current - 1)
- ].
- self redrawVisibleLine:current.
- first := current + 1
- ].
- current := current + 1.
- index := index + 1
- ].
- (first < current) ifTrue:[
- super redrawFromVisibleLine:first to:(current - 1)
- ].
+redrawVisibleLine:visLine from:startCol
+ "redefined to always draw a full line - for openwin handling"
- "draw submenu marks"
- subMenus notNil ifTrue:[
- index := index0.
- start to:stop do:[:l |
- index <= subMenus size ifTrue:[
- (subMenus at:index) notNil ifTrue:[
- self drawRightArrowInVisibleLine:l
- ].
- index := index + 1
- ]
- ]
- ]
- ]
+ self redrawVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine from:startCol to:endCol
+ "redefined to always draw a full line - for openwin handling"
+
+ self redrawVisibleLine:visLine
! !
-!MenuView methodsFor:'disabled scrolling'!
+!MenuView methodsFor:'selections'!
+
+isValidSelection:aNumber
+ "return true, if aNumber is ok for a selection lineNo"
+
+ |line|
+
+ (super isValidSelection:aNumber) ifFalse:[^ false].
+
+ line := self listAt:aNumber.
+ ^ (self isGraphicItem:line) not
+! !
-makeSelectionVisible
- ^ self
+!MenuView methodsFor:'showing'!
+
+realize
+ needResize == true ifTrue:[
+ self recomputeSize
+ ].
+ super realize
+!
+
+show
+ hiddenOnRealize := false.
+ self realize
! !
!MenuView methodsFor:'submenu notifications'!
-submenuTriggered
- "submenu has performed some action - have to deselect here"
-
- self selection:nil.
- "a bad kludge - 5 minutes before writing the alpha tapes ..."
- (superView isKindOf:PopUpMenu) ifTrue:[
- superView hide
- ].
- superMenu notNil ifTrue:[
- superMenu submenuTriggered
- ].
-!
-
regainControl
"take over pointer control from a submenu"
@@ -1691,157 +1826,18 @@
"submenu has finished its menu-action - show normal cursor again"
self cursor:(Cursor hand)
-! !
-
-!MenuView methodsFor:'event handling'!
-
-buttonPress:button x:x y:y
- self setSelectionForX:x y:y
-!
-
-buttonMotion:state x:x y:y
- state ~~ 0 ifTrue:[
- self setSelectionForX:x y:y
- ]
-!
-
-keyPress:aKey x:x y:y
- |m|
-
- subMenuShown notNil ifTrue:[
- subMenuShown keyPress:aKey x:0 y:0.
- ^ self
- ].
-
- "
- Return, space or the (virtual) MenuSelect
- key trigger a selected entry.
- "
- (aKey == #Return
- or:[aKey == #MenuSelect
- or:[aKey == Character space]]) ifTrue:[
- selection notNil ifTrue:[
- (subMenus notNil and:[(m := subMenus at:selection) notNil]) ifTrue:[
- self showSubmenu:selection.
- m hideOnLeave:false
- ] ifFalse:[
- subMenuShown := nil.
- self buttonRelease:1 x:x y:y.
- ]
- ].
- ^ self
- ].
- super keyPress:aKey x:x y:y
-!
-
-pointerLeave:state
- subMenuShown notNil ifTrue:[
- ^ self
- ].
-"/ self setSelectionForX:-1 y:-1. "force deselect"
- subMenuShown isNil ifTrue:[
- self selection:nil
- ].
-"/ superMenu notNil ifTrue:[
-"/ superMenu regainControl.
-"/ ]
!
-buttonRelease:button x:x y:y
- |theSelector isCheck checkOn val|
-
- subMenuShown notNil ifTrue:[
- ^ self
- ].
-
- (x >= 0 and:[x < width]) ifTrue:[
- (y >= 0 and:[y < height]) ifTrue:[
- selection notNil ifTrue:[
- (subMenus isNil or:[(subMenus at:selection) isNil]) ifTrue:[
- self showActive.
- [
- superMenu notNil ifTrue:[
- superMenu showActive
- ].
-
- val := selection.
- args notNil ifTrue:[
- val := args at:selection
- ].
-
- isCheck := false.
- onOffFlags notNil ifTrue:[
- onOffFlags size >= selection ifTrue:[
- checkOn := (onOffFlags at:selection).
- isCheck := checkOn notNil.
- isCheck ifTrue:[
- checkOn := val := checkOn not.
- onOffFlags at:selection put:checkOn.
- ]
- ]
- ].
-
- "
- ST-80 style model notification
- "
- self sendChangeMessageWith:val.
+submenuTriggered
+ "submenu has performed some action - have to deselect here"
- "
- either action-block or selectors-array-style
- "
- actionBlock notNil ifTrue:[
- Object 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:[
- Object abortSignal handle:[:ex |
- ex return
- ] do:[
- isCheck ifTrue:[
- self redrawLine:selection.
- receiver perform:theSelector with:checkOn
- ] ifFalse:[
- (args isNil or:[theSelector numArgs == 0]) ifTrue:[
- receiver perform:theSelector
- ] ifFalse:[
- receiver perform:theSelector with:val
- ]
- ]
- ]
- ]
- ]
- ].
- ] valueNowOrOnUnwindDo:[
- realized ifTrue:[
- self showPassive.
- ].
- superMenu notNil ifTrue:[
- superMenu showPassive
- ]
- ].
- ].
- ]
- ]
- ].
- (superMenu notNil and:[superMenu shown not]) ifTrue:[
- (superView notNil and:[superView shown]) ifTrue:[superView hide].
- ].
- hideOnRelease ifTrue:[
+ self selection:nil.
+ "a bad kludge - 5 minutes before writing the alpha tapes ..."
+ (superView isKindOf:PopUpMenu) ifTrue:[
superView hide
].
+ superMenu notNil ifTrue:[
+ superMenu submenuTriggered
+ ].
! !
+
--- a/PanelView.st Thu Nov 23 11:44:18 1995 +0100
+++ b/PanelView.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,11 +10,9 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:05:18 pm'!
-
SimpleView subclass:#PanelView
instanceVariableNames:'hLayout vLayout verticalSpace horizontalSpace mustRearrange
- elementsChangeSize'
+ elementsChangeSize'
classVariableNames:''
poolDictionaries:''
category:'Views-Layout'
@@ -36,10 +34,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.12 1995-11-11 16:22:02 cg Exp $'
-!
-
documentation
"
this is a view for holding subviews. (layout-widget ?)
@@ -110,6 +104,89 @@
].
top open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.13 1995-11-23 14:36:38 cg Exp $'
+! !
+
+!PanelView methodsFor:'accessing'!
+
+elementsChangeSize:aBoolean
+ "tell the panel if elements are to change their size by themselfes
+ (for example, Lables or Buttons may do so if their contents changes).
+ Setting this flag will make the panel reorganize the elements whenever
+ any element changes its size."
+
+ elementsChangeSize := aBoolean.
+ aBoolean ifTrue:[
+ subViews notNil ifTrue:[
+ subViews do:[:aView |
+ aView addDependent:self
+ ]
+ ]
+ ]
+!
+
+horizontalSpace:numberOfPixels
+ "set the horizontal space between elements on pixels (default is 1mm)"
+
+ horizontalSpace ~= numberOfPixels ifTrue:[
+ horizontalSpace := numberOfPixels.
+ self layoutChanged
+ ]
+!
+
+space:numberOfPixels
+ "set the space between elements in pixels (default is 1mm) for both directions"
+
+ (verticalSpace ~= numberOfPixels
+ or:[horizontalSpace ~= numberOfPixels]) ifTrue:[
+ horizontalSpace := numberOfPixels.
+ verticalSpace := numberOfPixels.
+ self layoutChanged
+ ]
+!
+
+verticalSpace:numberOfPixels
+ "set the vertical space between elements (in pixels).
+ The default is computed for 1mm spacing."
+
+ verticalSpace ~= numberOfPixels ifTrue:[
+ verticalSpace := numberOfPixels.
+ self layoutChanged
+ ]
+! !
+
+!PanelView methodsFor:'adding & removing subviews'!
+
+addSubView:aView
+ "redefined to recompute layout when a subview is added"
+
+ super addSubView:aView.
+ self addedView:aView
+!
+
+addSubView:newView after:aView
+ "redefined to recompute layout when a subview is added"
+
+ super addSubView:newView after:aView.
+ self addedView:aView
+!
+
+addSubView:newView before:aView
+ "redefined to recompute layout when a subview is added"
+
+ super addSubView:newView before:aView.
+ self addedView:aView
+!
+
+removeSubView:aView
+ "redefined to recompute layout when a subview is removed"
+
+ super removeSubView:aView.
+ aView removeDependent:self.
+ self layoutChanged
! !
!PanelView methodsFor:'event processing'!
@@ -134,8 +211,51 @@
^ super update:something with:aParameter from:changedObject
! !
+!PanelView methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ hLayout := vLayout := #center. "/ notice, this is ignored in this class
+ "/ used by subclasses only
+ verticalSpace := ViewSpacing.
+ horizontalSpace := ViewSpacing.
+ mustRearrange := elementsChangeSize := false
+!
+
+realize
+ mustRearrange ifTrue:[
+ self setChildPositions
+ ].
+ super realize
+!
+
+setChildPositionsIfChanged
+ "set all of my child positions - this is usually delayed,
+ until the panel is actually shown (since we dont know, if more
+ elements are to be added) thus avoiding repositioning the elements
+ over and over. However, sometimes it is nescessary, to force positioning
+ the elements, for example, before querying the relative position of
+ an element (modalBoxes do so, to position the ok-button under the mouse
+ pointer)."
+
+ mustRearrange ifTrue:[
+ self setChildPositions
+ ].
+
+! !
+
!PanelView methodsFor:'private'!
+addedView:aView
+ "added a new element"
+
+ elementsChangeSize ifTrue:[
+ aView addDependent:self
+ ].
+ self layoutChanged
+!
+
layoutChanged
"called whenever repositioning is required. If the panel view is
already visible, reposition elements right now. Otherwise, remember
@@ -149,15 +269,6 @@
]
!
-addedView:aView
- "added a new element"
-
- elementsChangeSize ifTrue:[
- aView addDependent:self
- ].
- self layoutChanged
-!
-
setChildPositions
"(re)compute position of every child.
This method is redefined for different layout characteristics - you may
@@ -209,116 +320,3 @@
mustRearrange := false
! !
-!PanelView methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- hLayout := vLayout := #center. "/ notice, this is ignored in this class
- "/ used by subclasses only
- verticalSpace := ViewSpacing.
- horizontalSpace := ViewSpacing.
- mustRearrange := elementsChangeSize := false
-!
-
-realize
- mustRearrange ifTrue:[
- self setChildPositions
- ].
- super realize
-!
-
-setChildPositionsIfChanged
- "set all of my child positions - this is usually delayed,
- until the panel is actually shown (since we dont know, if more
- elements are to be added) thus avoiding repositioning the elements
- over and over. However, sometimes it is nescessary, to force positioning
- the elements, for example, before querying the relative position of
- an element (modalBoxes do so, to position the ok-button under the mouse
- pointer)."
-
- mustRearrange ifTrue:[
- self setChildPositions
- ].
-
-! !
-
-!PanelView methodsFor:'adding & removing subviews'!
-
-addSubView:aView
- "redefined to recompute layout when a subview is added"
-
- super addSubView:aView.
- self addedView:aView
-!
-
-addSubView:newView after:aView
- "redefined to recompute layout when a subview is added"
-
- super addSubView:newView after:aView.
- self addedView:aView
-!
-
-addSubView:newView before:aView
- "redefined to recompute layout when a subview is added"
-
- super addSubView:newView before:aView.
- self addedView:aView
-!
-
-removeSubView:aView
- "redefined to recompute layout when a subview is removed"
-
- super removeSubView:aView.
- aView removeDependent:self.
- self layoutChanged
-! !
-
-!PanelView methodsFor:'accessing'!
-
-elementsChangeSize:aBoolean
- "tell the panel if elements are to change their size by themselfes
- (for example, Lables or Buttons may do so if their contents changes).
- Setting this flag will make the panel reorganize the elements whenever
- any element changes its size."
-
- elementsChangeSize := aBoolean.
- aBoolean ifTrue:[
- subViews notNil ifTrue:[
- subViews do:[:aView |
- aView addDependent:self
- ]
- ]
- ]
-!
-
-verticalSpace:numberOfPixels
- "set the vertical space between elements (in pixels).
- The default is computed for 1mm spacing."
-
- verticalSpace ~= numberOfPixels ifTrue:[
- verticalSpace := numberOfPixels.
- self layoutChanged
- ]
-!
-
-horizontalSpace:numberOfPixels
- "set the horizontal space between elements on pixels (default is 1mm)"
-
- horizontalSpace ~= numberOfPixels ifTrue:[
- horizontalSpace := numberOfPixels.
- self layoutChanged
- ]
-!
-
-space:numberOfPixels
- "set the space between elements in pixels (default is 1mm) for both directions"
-
- (verticalSpace ~= numberOfPixels
- or:[horizontalSpace ~= numberOfPixels]) ifTrue:[
- horizontalSpace := numberOfPixels.
- verticalSpace := numberOfPixels.
- self layoutChanged
- ]
-! !
-
--- a/PopUpMenu.st Thu Nov 23 11:44:18 1995 +0100
+++ b/PopUpMenu.st Thu Nov 23 15:37:40 1995 +0100
@@ -11,12 +11,11 @@
"
PopUpView subclass:#PopUpMenu
- instanceVariableNames:'menuView lastSelection memorize hideOnLeave
- actionLabels actionLines actionValues
- hideOnRelease defaultHideOnRelease'
- classVariableNames:'DefaultHideOnRelease'
- poolDictionaries:''
- category:'Views-Menus'
+ instanceVariableNames:'menuView lastSelection memorize hideOnLeave actionLabels
+ actionLines actionValues hideOnRelease defaultHideOnRelease'
+ classVariableNames:'DefaultHideOnRelease'
+ poolDictionaries:''
+ category:'Views-Menus'
!
!PopUpMenu class methodsFor:'documentation'!
@@ -35,10 +34,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.26 1995-11-11 16:22:11 cg Exp $'
-!
-
documentation
"
This class provides PopUpMenu functionality; Actually, this class
@@ -242,12 +237,10 @@
Use whichever interface you prefer.
"
-! !
+!
-!PopUpMenu class methodsFor:'defaults'!
-
-updateStyleCache
- DefaultHideOnRelease := StyleSheet at:#popupHideOnRelease default:true.
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.27 1995-11-23 14:35:08 cg Exp $'
! !
!PopUpMenu class methodsFor:'instance creation'!
@@ -270,6 +263,52 @@
^ newMenu
!
+labels:labels selector:aSelector args:args receiver:anObject
+ "create and return a popup menu with labels as entries.
+ Each item will send aSelector with a corresponding argument from the
+ args array to anObject. The menu is created on the default DIsplay"
+
+ "
+ OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
+ "
+ ^ self labels:labels selectors:aSelector args:args receiver:anObject
+!
+
+labels:labels selector:aSelector args:args receiver:anObject for:aView
+ "create and return a popup menu with labels as entries.
+ Each item will send aSelector with a corresponding argument from the
+ args array to anObject. The menu is created on the same physical device
+ as aView (which is only of interrest in multi-Display applications;
+ typical applications can use the sibbling message without the for: argument)."
+
+ "
+ OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
+ "
+ ^ self labels:labels selectors:aSelector args:args receiver:anObject for:aView
+!
+
+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
+!
+
+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 args:argArray receiver:nil for:nil
+!
+
+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 args:args receiver:anObject for:nil
+!
+
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-
@@ -289,48 +328,6 @@
^ newMenu
!
-labels:labels selectors:selectors receiver:anObject for:aView
- "create and return a popup menu with labels as entries.
- Each item will send a corresponding selector from the selectors-array
- to anObject. The menu is created on the same physical device
- as aView (which is only of interrest 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
-!
-
-labels:labels selector:aSelector args:args receiver:anObject for:aView
- "create and return a popup menu with labels as entries.
- Each item will send aSelector with a corresponding argument from the
- args array to anObject. The menu is created on the same physical device
- as aView (which is only of interrest in multi-Display applications;
- typical applications can use the sibbling message without the for: argument)."
-
- "
- OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
- "
- ^ self labels:labels selectors:aSelector args:args receiver:anObject for:aView
-!
-
-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 args:args receiver:anObject for:nil
-!
-
-labels:labels selector:aSelector args:args receiver:anObject
- "create and return a popup menu with labels as entries.
- Each item will send aSelector with a corresponding argument from the
- args array to anObject. The menu is created on the default DIsplay"
-
- "
- OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
- "
- ^ self labels:labels selectors:aSelector args:args receiver:anObject
-!
-
labels:labels selectors:selectors receiver:anObject
"create and return a popup menu with labels as entries.
Each item will send a message with a selector from the corresponding
@@ -340,44 +337,22 @@
^ self labels:labels selectors:selectors args:nil receiver:anObject for:nil
!
-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)"
+labels:labels selectors:selectors receiver:anObject for:aView
+ "create and return a popup menu with labels as entries.
+ Each item will send a corresponding selector from the selectors-array
+ to anObject. The menu is created on the same physical device
+ as aView (which is only of interrest in multi-Display applications;
+ typical applications can use the sibbling message without the for: argument)."
- ^ self labels:labels selectors:selectors args:nil receiver:nil for:nil
-!
-
-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 args:argArray receiver:nil for:nil
+ ^ self labels:labels selectors:selectors args:nil receiver:anObject for:aView
! !
!PopUpMenu class methodsFor:'ST-80 instance creation'!
-labels:labels
- "ST80R2 compatibility"
-
- ^ self labels:labels lines:nil values:nil
-!
-
-labels:labels values:values
- "ST80R2 compatibility"
+labelArray:labels lines:lines values:values
+ "ST80R4 compatibility"
- ^ self labels:labels lines:nil values:values
-!
-
-labels:labels lines:lines
- "ST80R2 compatibility"
-
- ^ self labels:labels lines:lines values:nil
-!
-
-labels:labels lines:lines values:values
- "ST80R2 compatibility"
-
- ^ (self new) labels:labels lines:lines values:values
+ ^ self labels:labels lines:lines values:values
!
labelArray:labels values:values
@@ -386,10 +361,25 @@
^ self labels:labels lines:nil values:values
!
-labelArray:labels lines:lines values:values
- "ST80R4 compatibility"
+labelList:labels
+ "ST80R4 compatibility:
+ given a list consisting of group label entries (to be separated by
+ lines), convert into standard form (using '-' for lines.
+ "
+
+ ^ self labelList:labels values:nil
- ^ self labels:labels lines:lines values:values
+ "
+ (PopUpMenu labels:#('1' '2' '3')) showAtPointer
+ (PopUpMenu labelList:#(('1') ('2' '3'))) showAtPointer
+ (PopUpMenu labelList:#(('1') ('2') ('3'))) showAtPointer
+ "
+!
+
+labelList:labels lines:lines values:values
+ "mhmh what is that ?"
+
+ ^ (self new) labels:labels lines:lines values:values
!
labelList:labels values:values
@@ -434,288 +424,34 @@
"
!
-labelList:labels
- "ST80R4 compatibility:
- given a list consisting of group label entries (to be separated by
- lines), convert into standard form (using '-' for lines.
- "
-
- ^ self labelList:labels values:nil
-
- "
- (PopUpMenu labels:#('1' '2' '3')) showAtPointer
- (PopUpMenu labelList:#(('1') ('2' '3'))) showAtPointer
- (PopUpMenu labelList:#(('1') ('2') ('3'))) showAtPointer
- "
-!
-
-labelList:labels lines:lines values:values
- "mhmh what is that ?"
-
- ^ (self new) labels:labels lines:lines values:values
-! !
-
-!PopUpMenu methodsFor:'initialization'!
-
-initialize
- super initialize.
+labels:labels
+ "ST80R2 compatibility"
- memorize := true.
- hideOnLeave := false.
- defaultHideOnRelease := DefaultHideOnRelease.
-!
-
-initEvents
- super initEvents.
- self enableEnterLeaveEvents.
- self enableMotionEvents.
-! !
-
-!PopUpMenu methodsFor:'realization'!
-
-fixSize
- "called right before the view is made visible.
- adjust my size to the size of the actual menu"
-
- |extra newWidth newHeight|
-
- extra := margin * 2.
- menuView resizeIfChanged.
- newWidth := menuView width + extra.
- newHeight := menuView height + extra.
- ((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[
- self extent:(menuView width + extra) @ (menuView height + extra)
- ].
- super fixSize
+ ^ self labels:labels lines:nil values:nil
!
-realize
- menuView deselectWithoutRedraw.
- super realize.
- hideOnRelease := defaultHideOnRelease.
-! !
-
-!PopUpMenu methodsFor:'private accessing'!
-
-menu:aMenu
- "set the actual menu"
-
- menuView := aMenu.
- menuView origin:(margin @ margin).
- menuView borderWidth:0.
- menuView masterView:self
-!
+labels:labels lines:lines
+ "ST80R2 compatibility"
-menuView
- "return the actual menu"
-
- ^ menuView
-!
-
-superMenu:aMenu
- "return the superMenu"
-
- menuView superMenu:aMenu
-! !
-
-!PopUpMenu methodsFor:'accessing-mvc'!
-
-changeMessage:aSymbol
- "forward to my menu"
-
- menuView changeMessage:aSymbol
+ ^ self labels:labels lines:lines values:nil
!
-changeMessage
- "forward from my menu"
+labels:labels lines:lines values:values
+ "ST80R2 compatibility"
- ^ menuView changeMessage
-!
-
-model
- ^ menuView model
+ ^ (self new) labels:labels lines:lines values:values
!
-model:aModel
- menuView model:aModel
-! !
-
-!PopUpMenu methodsFor:'menuview messages'!
-
-doesNotUnderstand:aMessage
- "forward all menu-view messages"
-
- (menuView respondsTo:(aMessage selector)) ifTrue:[
- ^ aMessage sendTo:menuView
- ].
- ^ super doesNotUnderstand:aMessage
-! !
+labels:labels values:values
+ "ST80R2 compatibility"
-!PopUpMenu methodsFor:'accessing-behavior'!
-
-hideOnLeave:aBoolean
- "set/clear the hideOnLeave attribute, which controls
- if the menu should be hidden when the pointer leaves
- the view (used with multiple-menus)"
-
- hideOnLeave := aBoolean
-!
-
-hideOnRelease:aBoolean
- "set/clear the hideOnRelease attribute, which controls
- if the menu should be hidden when the button is released"
-
- hideOnRelease := aBoolean.
- menuView hideOnRelease:aBoolean
+ ^ self labels:labels lines:nil values:values
! !
-!PopUpMenu methodsFor:'accessing-look'!
-
-viewBackground:aColor
- "this is a kludge and will vanish ..."
-
- super viewBackground:aColor.
- menuView viewBackground:aColor
-!
-
-font:aFont
- menuView font:aFont
-! !
-
-!PopUpMenu methodsFor:'accessing-items'!
-
-labels
- "return the list of labels"
-
- actionLabels notNil ifTrue:[
- ^ actionLabels asStringCollection
- ].
- ^ menuView list
-!
-
-indexOf:indexOrName
- "return the index of a submenu - or 0 if there is none"
-
- ^ menuView indexOf:indexOrName
-!
-
-remove:indexOrName
- "remove a menu entry"
-
- menuView remove:indexOrName
-!
-
-subMenuAt:indexOrName put:aMenu
- "define a submenu to be shown for entry indexOrName"
-
-"
- aMenu hideOnLeave:true.
-"
- menuView subMenuAt:indexOrName put:aMenu.
- "tell the submenu to notify me when action is performed"
- aMenu superMenu:self.
-
- "
- |v m someObject|
-
- v := View new.
- m := PopUpMenu labels:#('1' '2' '3')
- selectors:#(one two nil)
- receiver:someObject
- for:nil.
- m subMenuAt:3 put:(PopUpMenu
- labels:#('a' 'b' 'c')
- selectors:#(a b c)
- receiver:someObject
- for:nil).
- v middleButtonMenu:m.
- v realize
- "
-!
-
-numberOfItems
- "return the number of items in the menu"
-
- actionLabels notNil ifTrue:[
- ^ actionLabels asStringCollection size
- ].
- ^ menuView list size
-!
+!PopUpMenu class methodsFor:'defaults'!
-values
- "st-80 compatibility"
-
- ^ actionValues
-!
-
-values:aValueArray
- "st-80 compatibility"
-
- actionValues := aValueArray
-!
-
-lines
- "st-80 compatibility"
-
- ^ actionLines
-!
-
-labels:labelString lines:lineArray values:valueArray
- "define the menu the ST-80 way (with labels and lines defined separately)"
-
- |labelArray argArray convertedLabels
- offs dstOffs linePos|
-
- actionLabels := labelString.
- actionLines := lineArray.
- actionValues := valueArray.
-
- labelArray := labelString asStringCollection.
-
- convertedLabels := Array new:(labelArray size + lineArray size).
- argArray := Array new:(labelArray size + lineArray size).
-
- offs := 1.
- dstOffs := 1.
- 1 to:lineArray size do:[:lineIndex |
- linePos := lineArray at:lineIndex.
- [offs <= linePos] whileTrue:[
- convertedLabels at:dstOffs put:(labelArray at:offs).
- argArray at:dstOffs put:offs.
- offs := offs + 1.
- dstOffs := dstOffs + 1
- ].
- convertedLabels at:dstOffs put:'-'.
- argArray at:dstOffs put:nil.
- dstOffs := dstOffs + 1
- ].
- [offs <= labelArray size] whileTrue:[
- convertedLabels at:dstOffs put:(labelArray at:offs).
- argArray at:dstOffs put:offs.
- offs := offs + 1.
- dstOffs := dstOffs + 1
- ].
- self menu:(MenuView
- labels:convertedLabels
- selectors:nil
- args:argArray
- receiver:nil
- in:self)
-! !
-
-!PopUpMenu methodsFor:'deactivation'!
-
-hide
- "hide the menu - if there are any pop-up-submenus, hide them also"
-
- menuView hideSubmenu.
- windowGroup notNil ifTrue:[
- windowGroup removeView:menuView.
- ].
- super hide.
- menuView superMenu notNil ifTrue:[
- menuView superMenu regainControl
- ].
+updateStyleCache
+ DefaultHideOnRelease := StyleSheet at:#popupHideOnRelease default:true.
! !
!PopUpMenu methodsFor:'ST-80 activation'!
@@ -834,6 +570,195 @@
"
! !
+!PopUpMenu methodsFor:'accessing-behavior'!
+
+hideOnLeave:aBoolean
+ "set/clear the hideOnLeave attribute, which controls
+ if the menu should be hidden when the pointer leaves
+ the view (used with multiple-menus)"
+
+ hideOnLeave := aBoolean
+!
+
+hideOnRelease:aBoolean
+ "set/clear the hideOnRelease attribute, which controls
+ if the menu should be hidden when the button is released"
+
+ hideOnRelease := aBoolean.
+ menuView hideOnRelease:aBoolean
+! !
+
+!PopUpMenu methodsFor:'accessing-items'!
+
+indexOf:indexOrName
+ "return the index of a submenu - or 0 if there is none"
+
+ ^ menuView indexOf:indexOrName
+!
+
+labels
+ "return the list of labels"
+
+ actionLabels notNil ifTrue:[
+ ^ actionLabels asStringCollection
+ ].
+ ^ menuView list
+!
+
+labels:labelString lines:lineArray values:valueArray
+ "define the menu the ST-80 way (with labels and lines defined separately)"
+
+ |labelArray argArray convertedLabels
+ offs dstOffs linePos|
+
+ actionLabels := labelString.
+ actionLines := lineArray.
+ actionValues := valueArray.
+
+ labelArray := labelString asStringCollection.
+
+ convertedLabels := Array new:(labelArray size + lineArray size).
+ argArray := Array new:(labelArray size + lineArray size).
+
+ offs := 1.
+ dstOffs := 1.
+ 1 to:lineArray size do:[:lineIndex |
+ linePos := lineArray at:lineIndex.
+ [offs <= linePos] whileTrue:[
+ convertedLabels at:dstOffs put:(labelArray at:offs).
+ argArray at:dstOffs put:offs.
+ offs := offs + 1.
+ dstOffs := dstOffs + 1
+ ].
+ convertedLabels at:dstOffs put:'-'.
+ argArray at:dstOffs put:nil.
+ dstOffs := dstOffs + 1
+ ].
+ [offs <= labelArray size] whileTrue:[
+ convertedLabels at:dstOffs put:(labelArray at:offs).
+ argArray at:dstOffs put:offs.
+ offs := offs + 1.
+ dstOffs := dstOffs + 1
+ ].
+ self menu:(MenuView
+ labels:convertedLabels
+ selectors:nil
+ args:argArray
+ receiver:nil
+ in:self)
+!
+
+lines
+ "st-80 compatibility"
+
+ ^ actionLines
+!
+
+numberOfItems
+ "return the number of items in the menu"
+
+ actionLabels notNil ifTrue:[
+ ^ actionLabels asStringCollection size
+ ].
+ ^ menuView list size
+!
+
+remove:indexOrName
+ "remove a menu entry"
+
+ menuView remove:indexOrName
+!
+
+subMenuAt:indexOrName put:aMenu
+ "define a submenu to be shown for entry indexOrName"
+
+"
+ aMenu hideOnLeave:true.
+"
+ menuView subMenuAt:indexOrName put:aMenu.
+ "tell the submenu to notify me when action is performed"
+ aMenu superMenu:self.
+
+ "
+ |v m someObject|
+
+ v := View new.
+ m := PopUpMenu labels:#('1' '2' '3')
+ selectors:#(one two nil)
+ receiver:someObject
+ for:nil.
+ m subMenuAt:3 put:(PopUpMenu
+ labels:#('a' 'b' 'c')
+ selectors:#(a b c)
+ receiver:someObject
+ for:nil).
+ v middleButtonMenu:m.
+ v realize
+ "
+!
+
+values
+ "st-80 compatibility"
+
+ ^ actionValues
+!
+
+values:aValueArray
+ "st-80 compatibility"
+
+ actionValues := aValueArray
+! !
+
+!PopUpMenu methodsFor:'accessing-look'!
+
+font:aFont
+ menuView font:aFont
+!
+
+viewBackground:aColor
+ "this is a kludge and will vanish ..."
+
+ super viewBackground:aColor.
+ menuView viewBackground:aColor
+! !
+
+!PopUpMenu methodsFor:'accessing-mvc'!
+
+changeMessage
+ "forward from my menu"
+
+ ^ menuView changeMessage
+!
+
+changeMessage:aSymbol
+ "forward to my menu"
+
+ menuView changeMessage:aSymbol
+!
+
+model
+ ^ menuView model
+!
+
+model:aModel
+ menuView model:aModel
+! !
+
+!PopUpMenu methodsFor:'deactivation'!
+
+hide
+ "hide the menu - if there are any pop-up-submenus, hide them also"
+
+ menuView hideSubmenu.
+ windowGroup notNil ifTrue:[
+ windowGroup removeView:menuView.
+ ].
+ super hide.
+ menuView superMenu notNil ifTrue:[
+ menuView superMenu regainControl
+ ].
+! !
+
!PopUpMenu methodsFor:'event handling'!
buttonMotion:state x:x y:y
@@ -867,24 +792,6 @@
].
!
-pointerEnter:state x:x y:y
- "catch quick release of button"
-
- hideOnLeave ifTrue:[
- state == 0 ifTrue:[^ self hide].
- ]
-!
-
-pointerLeave:state
-"/ menuView pointerLeave:state.
-"/ hideOnLeave ifTrue:[
-"/ self hide
-"/ ].
-"/ menuView superMenu notNil ifTrue:[
-"/ menuView superMenu regainControl
-"/ ]
-!
-
buttonPress:button x:x y:y
hideOnRelease ifTrue:[
self hide.
@@ -924,4 +831,97 @@
keyPress:key x:x y:y
"/ hideOnRelease := true.
menuView keyPress:key x:x y:y.
+!
+
+pointerEnter:state x:x y:y
+ "catch quick release of button"
+
+ hideOnLeave ifTrue:[
+ state == 0 ifTrue:[^ self hide].
+ ]
+!
+
+pointerLeave:state
+"/ menuView pointerLeave:state.
+"/ hideOnLeave ifTrue:[
+"/ self hide
+"/ ].
+"/ menuView superMenu notNil ifTrue:[
+"/ menuView superMenu regainControl
+"/ ]
! !
+
+!PopUpMenu methodsFor:'initialization'!
+
+initEvents
+ super initEvents.
+ self enableEnterLeaveEvents.
+ self enableMotionEvents.
+!
+
+initialize
+ super initialize.
+
+ memorize := true.
+ hideOnLeave := false.
+ defaultHideOnRelease := DefaultHideOnRelease.
+! !
+
+!PopUpMenu methodsFor:'menuview messages'!
+
+doesNotUnderstand:aMessage
+ "forward all menu-view messages"
+
+ (menuView respondsTo:(aMessage selector)) ifTrue:[
+ ^ aMessage sendTo:menuView
+ ].
+ ^ super doesNotUnderstand:aMessage
+! !
+
+!PopUpMenu methodsFor:'private accessing'!
+
+menu:aMenu
+ "set the actual menu"
+
+ menuView := aMenu.
+ menuView origin:(margin @ margin).
+ menuView borderWidth:0.
+ menuView masterView:self
+!
+
+menuView
+ "return the actual menu"
+
+ ^ menuView
+!
+
+superMenu:aMenu
+ "return the superMenu"
+
+ menuView superMenu:aMenu
+! !
+
+!PopUpMenu methodsFor:'realization'!
+
+fixSize
+ "called right before the view is made visible.
+ adjust my size to the size of the actual menu"
+
+ |extra newWidth newHeight|
+
+ extra := margin * 2.
+ menuView resizeIfChanged.
+ newWidth := menuView width + extra.
+ newHeight := menuView height + extra.
+ ((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[
+ self extent:(menuView width + extra) @ (menuView height + extra)
+ ].
+ super fixSize
+!
+
+realize
+ menuView deselectWithoutRedraw.
+ super realize.
+ hideOnRelease := defaultHideOnRelease.
+! !
+
--- a/PullDMenu.st Thu Nov 23 11:44:18 1995 +0100
+++ b/PullDMenu.st Thu Nov 23 15:37:40 1995 +0100
@@ -11,23 +11,17 @@
"
SimpleView subclass:#PullDownMenu
- instanceVariableNames:'receiver menus titles selectors activeMenuNumber
- showSeparatingLines topMargin
- fgColor bgColor activeFgColor activeBgColor
- onLevel offLevel edgeStyle
- keepMenu toggleKeep raiseTopWhenActivated'
- classVariableNames:'DefaultFont
- DefaultViewBackground
- DefaultForegroundColor
- DefaultBackgroundColor
- DefaultHilightForegroundColor
- DefaultHilightBackgroundColor
- DefaultLevel DefaultHilightLevel
- DefaultShadowColor DefaultLightColor
- DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep
- DefaultSeparatingLines'
- poolDictionaries:''
- category:'Views-Menus'
+ instanceVariableNames:'receiver menus titles selectors activeMenuNumber
+ showSeparatingLines topMargin fgColor bgColor activeFgColor
+ activeBgColor onLevel offLevel edgeStyle keepMenu toggleKeep
+ raiseTopWhenActivated'
+ classVariableNames:'DefaultFont DefaultViewBackground DefaultForegroundColor
+ DefaultBackgroundColor DefaultHilightForegroundColor
+ DefaultHilightBackgroundColor DefaultLevel DefaultHilightLevel
+ DefaultShadowColor DefaultLightColor DefaultEdgeStyle
+ DefaultKeepMenu DefaultToggleKeep DefaultSeparatingLines'
+ poolDictionaries:''
+ category:'Views-Menus'
!
!PullDownMenu class methodsFor:'documentation'!
@@ -46,10 +40,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.26 1995-11-11 16:22:17 cg Exp $'
-!
-
documentation
"
PullDown menu provides the top (always visible) part of these menus.
@@ -330,6 +320,18 @@
receiver:textView.
top open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.27 1995-11-23 14:35:27 cg Exp $'
+! !
+
+!PullDownMenu class methodsFor:'instance creation'!
+
+labels:titleArray
+ "create and return a new PullDownMenu"
+
+ ^ self new labels:titleArray
! !
!PullDownMenu class methodsFor:'defaults'!
@@ -384,23 +386,596 @@
"
! !
-!PullDownMenu class methodsFor:'instance creation'!
+!PullDownMenu methodsFor:'accessing'!
+
+at:aString putLabels:labels selector:selector args:args receiver:anObject
+ "create and set the menu under the title, aString"
+
+ |menuView|
+
+ menuView := MenuView labels:labels
+ selector:selector
+ args:args
+ receiver:anObject
+ for:self.
+ self at:aString putMenu:menuView
+!
+
+at:aString putLabels:labels selectors:selectors args:args receiver:anObject
+ "create and set the menu under the title, aString"
+
+ |menuView|
+
+ menuView := MenuView labels:labels
+ selectors:selectors
+ args:args
+ receiver:anObject
+ for:self.
+ self at:aString putMenu:menuView
+!
+
+at:aString putLabels:labels selectors:selectors receiver:anObject
+ "create and set the menu under the title, aString"
+
+ |menuView|
+
+ menuView := MenuView labels:labels
+ selectors:selectors
+ receiver:anObject
+ for:self.
+ self at:aString putMenu:menuView
+!
+
+at:aString putMenu:aMenu
+ "set the menu under the title, aString"
+
+ |index|
+
+ index := self indexOf:aString.
+ (index == 0) ifTrue:[
+ self error:'no such menu entry'.
+ ^ nil
+ ].
+
+"/ not needed:
+"/ aMenu origin:((left + (self titleLenUpTo:index))
+"/ @
+"/ (height + aMenu borderWidth)).
+ aMenu hiddenOnRealize:true.
+ menus at:index put:aMenu.
+ aMenu masterView:self.
+!
+
+labels
+ "return the menu-titles (group-headers)"
+
+ ^ titles
+!
labels:titleArray
- "create and return a new PullDownMenu"
+ "define the menu-titles (group-headers)"
+
+ |numberOfLabels|
+
+ numberOfLabels := titleArray size.
+ menus := Array new:numberOfLabels.
+ titles := Array new:numberOfLabels.
+
+ titleArray keysAndValuesDo:[:index :entry |
+ |e|
+
+ entry isImage ifTrue:[
+ e := entry on:device
+ ] ifFalse:[
+ e := entry printString
+ ].
+ titles at:index put:e
+ ].
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ]
+!
+
+labels:titleArray selectors:selectorArray
+ "define the menu-titles (group-headers) and selectors.
+ Selectors are mostly used as access keys to get to submenus later."
+
+ self labels:titleArray.
+ self selectors:selectorArray
+
+ "Created: 20.10.1995 / 20:15:54 / cg"
+!
+
+menuAt:stringOrNumber
+ "return the menu with the title; return nil if not found"
+
+ |index|
+
+ index := self indexOf:stringOrNumber.
+ (index == 0) ifTrue:[^ nil].
+ ^ menus at:index
+!
+
+numberOfTitles:n
+ "setup blank title-space to be filled in later"
+
+ menus := Array new:n.
+ titles := Array new:n
+!
+
+receiver:anObject
+ "set the menu-receiver. Thats the one who gets the
+ messages (both from myself and from my submenus).
+ This only sets the receiver for menus which are already
+ created - menus added later should get their receiver in
+ the creation send."
+
+ receiver := anObject.
+ menus notNil ifTrue:[
+ menus do:[:aMenu |
+ aMenu notNil ifTrue:[
+ aMenu receiver:anObject
+ ]
+ ]
+ ]
+!
+
+selectors:selectorArray
+ "define the menu-selectors. These are used as accesskey only
+ in menuAt: accesses. This makes PullDownMenu accesss
+ somewhat more compatible to PopUpMenus."
+
+ selectors := selectorArray.
+! !
+
+!PullDownMenu methodsFor:'accessing-look'!
+
+backgroundColor:aColor
+ "set the background drawing color.
+ You should not use this method; instead leave the value as
+ defined in the styleSheet."
+
+ bgColor := aColor on:device
+!
+
+font:aFont
+ "set the menus font.
+ adjusts menu-origins when font changes.
+ You should not use this method; instead leave the value as
+ defined in the styleSheet."
+
+ aFont ~~ font ifTrue:[
+ super font:(aFont on:device).
+ self height:(font height + (font descent * 2)).
+ shown ifTrue:[
+ self setMenuOrigins
+ ]
+ ]
+!
+
+foregroundColor:aColor
+ "set the foreground drawing color.
+ You should not use this method; instead leave the value as
+ defined in the styleSheet."
+
+ fgColor := aColor on:device
+!
+
+showSeparatingLines:aBoolean
+ "turn on/off drawing of separating lines.
+ You should not use this method; instead leave the value as
+ defined in the styleSheet."
+
+ showSeparatingLines := aBoolean.
+ shown ifTrue:[
+ self setMenuOrigins.
+ self redraw
+ ]
+! !
+
+!PullDownMenu methodsFor:'drawing '!
+
+drawActiveTitleSelected:selected
+ |x|
+ activeMenuNumber notNil ifTrue:[
+ x := self titleLenUpTo:activeMenuNumber.
+ self drawTitle:(titles at:activeMenuNumber) x:x selected:selected
+ ]
+!
+
+drawTitle:stringOrImage x:x0 selected:selected
+ |y w x wSpace fg bg map|
+
+ selected ifTrue:[
+ fg := activeFgColor.
+ bg := activeBgColor
+ ] ifFalse:[
+ fg := fgColor.
+ bg := bgColor
+ ].
+
+ wSpace := font widthOf:' '.
+ x := x0.
+ stringOrImage isString ifTrue:[
+ y := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
+ w := font widthOf:stringOrImage.
+ ] ifFalse:[
+ y := ((height - stringOrImage height) // 2) max:0.
+ w := stringOrImage width
+ ].
+ w := w + (wSpace * 2).
+
+ self paint:bg.
+ self fillRectangleX:x y:0 width:w height:height.
+
+ self is3D ifTrue:[
+ self drawEdgesForX:x y:0
+ width:w
+ height:height
+ level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
+ ].
+ self paint:fg.
+ x := x + wSpace.
+ stringOrImage isString ifTrue:[
+ self displayString:stringOrImage x:x y:y
+ ] ifFalse:[
+ stringOrImage isImageOrForm ifTrue:[
+ stringOrImage depth == 1 ifTrue:[
+ (map := stringOrImage colorMap) notNil ifTrue:[
+ self paint:(map at:2) on:(map at:1).
+ self displayOpaqueForm:stringOrImage x:x y:y.
+ ^ self
+ ]
+ ].
+ self displayForm:stringOrImage x:x y:y
+ ] ifFalse:[
+ stringOrImage displayOn:self x:x y:y
+ ]
+ ]
+
+ "Modified: 20.10.1995 / 22:03:27 / cg"
+!
+
+highlightActiveTitle
+ self drawActiveTitleSelected:true
+!
+
+redraw
+ |x "{ Class: SmallInteger }"
+ y "{ Class: SmallInteger }"
+ index "{ Class: SmallInteger }"
+ wSpace clr|
+
+ shown ifFalse: [ ^ self ].
+ titles isNil ifTrue:[^ self].
+
+ wSpace := (font widthOf:' ').
+ x := 0.
+ y := height "- 1".
+ index := 1.
+ titles do:[:title |
+ self drawTitle:title x:x selected:(index == activeMenuNumber).
+
+ title isString ifTrue:[
+ x := x + (font widthOf:title).
+ ] ifFalse:[
+ x := x + title width
+ ].
+ x := x + wSpace + wSpace.
+ showSeparatingLines ifTrue:[
+ self is3D ifTrue:[
+ self paint:shadowColor.
+ self displayLineFromX:x y:0 toX:x y:y.
+ x := x + 1.
+ clr := lightColor.
+ ] ifFalse:[
+ clr := fgColor.
+ ].
+ self paint:clr.
+ self displayLineFromX:x y:0 toX:x y:y.
+ x := x + 1
+ ].
+ index := index + 1
+ ]
+!
+
+unHighlightActiveTitle
+ self drawActiveTitleSelected:false
+! !
+
+!PullDownMenu methodsFor:'event handling'!
+
+buttonMotion:state x:x y:y
+ |titleIndex activeMenu activeLeft activeTop|
+
+ state == 0 ifTrue:[^ self].
+
+ activeMenuNumber notNil ifTrue:[
+ activeMenu := menus at:activeMenuNumber.
+ ].
- ^ self new labels:titleArray
+ (y < height) ifTrue:[
+ "moving around in title line"
+ activeMenu notNil ifTrue:[
+ activeMenu selection:nil
+ ].
+ titleIndex := self titleIndexForX:x.
+ titleIndex notNil ifTrue:[
+ (titleIndex ~~ activeMenuNumber) ifTrue:[
+ self pullMenu:titleIndex
+ ]
+ ] ifFalse:[
+ self hideActiveMenu
+ ]
+ ] ifFalse:[
+ "moving around below"
+ activeMenu isNil ifTrue:[^self].
+ activeLeft := activeMenu left.
+ (x between:activeLeft and:(activeMenu right)) ifTrue:[
+ activeTop := activeMenu top.
+ (y between:activeTop and:(activeMenu bottom)) ifTrue:[
+ "moving around in menu"
+ activeMenu buttonMotion:state
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ].
+ "moved outside menu"
+ activeMenu selection:nil
+ ]
+!
+
+buttonPress:button x:x y:y
+ |titleIndex activeMenu activeLeft activeTop m|
+
+ device ungrabPointer.
+
+ (y between:0 and:height) ifTrue:[
+ titleIndex := self titleIndexForX:x.
+ ].
+
+ "
+ now, titleIndex is non-nil if pressed within myself
+ "
+ (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
+ m := self pullMenu:titleIndex.
+ (keepMenu and:[m notNil]) ifTrue:[
+ device grabPointerInView:self.
+ self cursor:Cursor upRightArrow
+ ]
+ ] ifFalse:[
+ (keepMenu and:[toggleKeep not]) ifTrue:[
+ titleIndex == activeMenuNumber ifTrue:[
+ "same pressed again ... stay"
+ device grabPointerInView:self.
+ ^ self
+ ].
+ "moving around below"
+ activeMenuNumber isNil ifTrue:[^self].
+ activeMenu := menus at:activeMenuNumber.
+ activeLeft := activeMenu left.
+ (x between:activeLeft and:(activeMenu right)) ifTrue:[
+ activeTop := activeMenu top.
+ (y between:activeTop and:(activeMenu bottom)) ifTrue:[
+ "moving around in menu"
+ activeMenu buttonPress:button
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ].
+ ].
+ self hideActiveMenu
+ ]
+!
+
+buttonRelease:button x:x y:y
+ |activeMenu activeLeft activeTop hideMenu sel|
+
+ activeMenuNumber isNil ifTrue:[^self].
+ activeMenu := menus at:activeMenuNumber.
+
+ hideMenu := false.
+ (y >= height) ifTrue:[
+ "release below title-line"
+ activeLeft := activeMenu left.
+ "
+ released in a submenu ?
+ "
+ (x between:activeLeft and:(activeMenu right)) ifTrue:[
+ activeTop := activeMenu top.
+ (y between:activeTop and:(activeMenu bottom)) ifTrue:[
+ "release in menu"
+ self hideActiveMenu.
+ activeMenu buttonRelease:button
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ].
+ hideMenu := true.
+ ] ifFalse:[
+ y < 0 ifTrue:[
+ hideMenu := true
+ ] ifFalse:[
+ activeMenu isNil ifTrue:[
+ selectors notNil ifTrue:[
+ sel := selectors at:activeMenuNumber.
+ sel notNil ifTrue:[
+ receiver perform:sel
+ ].
+ ].
+ hideMenu := true.
+ ] ifFalse:[
+ keepMenu ifFalse:[
+ hideMenu := true
+ ]
+ ]
+ ]
+ ].
+ hideMenu ifTrue:[
+ self hideActiveMenu.
+ ]
+!
+
+keyPress:key x:x y:y
+ <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect)>
+
+ |index m sel|
+
+ "
+ handle CursorLeft/Right for non-mouse operation
+ (for example, if it has the explicit focus)
+ These will pull the previous/next menu
+ "
+ ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[
+ activeMenuNumber isNil ifTrue:[
+ index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size].
+ ] ifFalse:[
+ (key == #CursorRight) ifTrue:[
+ index := activeMenuNumber+1
+ ] ifFalse:[
+ index := activeMenuNumber-1
+ ].
+ index == 0 ifTrue:[index := menus size]
+ ifFalse:[
+ index > menus size ifTrue:[index := 1]
+ ]
+ ].
+ self pullMenu:index.
+ ^ self
+ ].
+
+ activeMenuNumber isNil ifTrue:[^self].
+
+ "
+ Return, space or the (virtual) MenuSelect key trigger
+ a menu entry (for non-submenu entries).
+ Otherwise, if we have a submenu open,
+ pass the key on to it ...
+ "
+ m := menus at:activeMenuNumber.
+ m isNil ifTrue:[
+ (key == #Return
+ or:[key == #MenuSelect
+ or:[key == Character space]]) ifTrue:[
+ sel := selectors at:activeMenuNumber.
+ sel notNil ifTrue:[
+ receiver perform:sel
+ ]
+ ].
+ ] ifFalse:[
+ m keyPress:key x:0 y:0.
+ ].
+!
+
+showNoFocus
+ "when stepping focus, hide any active menu"
+
+ self hideActiveMenu.
+ super showNoFocus
+! !
+
+!PullDownMenu methodsFor:'hiding/showing menus'!
+
+hideActiveMenu
+ "hide currently active menu - release grab if there is any grab (keepMenu)"
+
+ ^ self hideActiveMenuRelease:true
+!
+
+hideActiveMenuRelease:aBoolean
+ "hide currently active menu - release grab if aBoolean is true
+ and a grab was set (keepMenu)"
+
+ |m|
+
+ activeMenuNumber notNil ifTrue:[
+ (m := menus at:activeMenuNumber) notNil ifTrue:[
+ m hiddenOnRealize:true.
+ m unrealize.
+ ].
+ self unHighlightActiveTitle.
+ activeMenuNumber := nil
+ ].
+ aBoolean ifTrue:[
+ device ungrabPointer.
+ self cursor:Cursor normal
+ ].
+!
+
+pullMenu:aNumber
+ "activate a menu, return it or nil"
+
+ |subMenu r posY|
+
+ activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
+ activeMenuNumber := aNumber.
+ subMenu := menus at:aNumber.
+
+ raiseTopWhenActivated ifTrue:[
+ self topView raise.
+ ].
+
+ (activeMenuNumber notNil
+ and:[
+ subMenu notNil
+ or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[
+ self highlightActiveTitle.
+ ].
+
+ subMenu notNil ifTrue:[
+ subMenu origin:((left + (self titleLenUpTo:aNumber))
+ @
+ (posY := height + subMenu borderWidth)).
+ subMenu hiddenOnRealize:false.
+ subMenu deselect.
+ subMenu create.
+ subMenu saveUnder:true.
+ subMenu superMenu:self.
+
+ subMenu right > (r := self right) ifTrue:[
+ subMenu origin:((r - subMenu width) @ posY).
+ ].
+ subMenu raise show.
+ ].
+ ^ subMenu
+!
+
+regainControl
+ keepMenu ifTrue:[
+ device grabPointerInView:self.
+ self cursor:Cursor upRightArrow
+ ]
! !
!PullDownMenu methodsFor:'initialize / release'!
-initialize
- super initialize.
+create
+ super create.
+ self setMenuOrigins
+!
+
+destroy
+ "have to destroy the menus manually here,
+ since they are no real subviews of myself"
- font := font on:device.
- self origin:(0.0 @ 0.0)
- extent:(1.0 @ self preferredExtent y)
-"/ extent:(1.0 @ (font height + (font descent * 2) + topMargin)).
+ menus notNil ifTrue:[
+ menus do:[:m |
+ m notNil ifTrue:[m destroy]
+ ].
+ menus := nil
+ ].
+ activeMenuNumber := nil.
+ super destroy.
+!
+
+initCursor
+ "set up a hand cursor"
+
+ cursor := Cursor hand
!
initStyle
@@ -480,10 +1055,13 @@
raiseTopWhenActivated := styleSheet at:'pullDownMenuRaiseTop' default:true.
!
-initCursor
- "set up a hand cursor"
+initialize
+ super initialize.
- cursor := Cursor hand
+ font := font on:device.
+ self origin:(0.0 @ 0.0)
+ extent:(1.0 @ self preferredExtent y)
+"/ extent:(1.0 @ (font height + (font descent * 2) + topMargin)).
!
recreate
@@ -501,25 +1079,6 @@
self setMenuOrigins
!
-create
- super create.
- self setMenuOrigins
-!
-
-destroy
- "have to destroy the menus manually here,
- since they are no real subviews of myself"
-
- menus notNil ifTrue:[
- menus do:[:m |
- m notNil ifTrue:[m destroy]
- ].
- menus := nil
- ].
- activeMenuNumber := nil.
- super destroy.
-!
-
superView:aView
"when my superView changes, all of my menus must change as well"
@@ -533,240 +1092,8 @@
]
! !
-!PullDownMenu methodsFor:'accessing-look'!
-
-showSeparatingLines:aBoolean
- "turn on/off drawing of separating lines.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- showSeparatingLines := aBoolean.
- shown ifTrue:[
- self setMenuOrigins.
- self redraw
- ]
-!
-
-font:aFont
- "set the menus font.
- adjusts menu-origins when font changes.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- aFont ~~ font ifTrue:[
- super font:(aFont on:device).
- self height:(font height + (font descent * 2)).
- shown ifTrue:[
- self setMenuOrigins
- ]
- ]
-!
-
-foregroundColor:aColor
- "set the foreground drawing color.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- fgColor := aColor on:device
-!
-
-backgroundColor:aColor
- "set the background drawing color.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- bgColor := aColor on:device
-! !
-
-
-!PullDownMenu methodsFor:'accessing'!
-
-receiver:anObject
- "set the menu-receiver. Thats the one who gets the
- messages (both from myself and from my submenus).
- This only sets the receiver for menus which are already
- created - menus added later should get their receiver in
- the creation send."
-
- receiver := anObject.
- menus notNil ifTrue:[
- menus do:[:aMenu |
- aMenu notNil ifTrue:[
- aMenu receiver:anObject
- ]
- ]
- ]
-!
-
-numberOfTitles:n
- "setup blank title-space to be filled in later"
-
- menus := Array new:n.
- titles := Array new:n
-!
-
-labels:titleArray
- "define the menu-titles (group-headers)"
-
- |numberOfLabels|
-
- numberOfLabels := titleArray size.
- menus := Array new:numberOfLabels.
- titles := Array new:numberOfLabels.
-
- titleArray keysAndValuesDo:[:index :entry |
- |e|
-
- entry isImage ifTrue:[
- e := entry on:device
- ] ifFalse:[
- e := entry printString
- ].
- titles at:index put:e
- ].
- shown ifTrue:[
- self clear.
- self redraw
- ]
-!
-
-labels
- "return the menu-titles (group-headers)"
-
- ^ titles
-!
-
-selectors:selectorArray
- "define the menu-selectors. These are used as accesskey only
- in menuAt: accesses. This makes PullDownMenu accesss
- somewhat more compatible to PopUpMenus."
-
- selectors := selectorArray.
-!
-
-labels:titleArray selectors:selectorArray
- "define the menu-titles (group-headers) and selectors.
- Selectors are mostly used as access keys to get to submenus later."
-
- self labels:titleArray.
- self selectors:selectorArray
-
- "Created: 20.10.1995 / 20:15:54 / cg"
-!
-
-menuAt:stringOrNumber
- "return the menu with the title; return nil if not found"
-
- |index|
-
- index := self indexOf:stringOrNumber.
- (index == 0) ifTrue:[^ nil].
- ^ menus at:index
-!
-
-at:aString putMenu:aMenu
- "set the menu under the title, aString"
-
- |index|
-
- index := self indexOf:aString.
- (index == 0) ifTrue:[
- self error:'no such menu entry'.
- ^ nil
- ].
-
-"/ not needed:
-"/ aMenu origin:((left + (self titleLenUpTo:index))
-"/ @
-"/ (height + aMenu borderWidth)).
- aMenu hiddenOnRealize:true.
- menus at:index put:aMenu.
- aMenu masterView:self.
-!
-
-at:aString putLabels:labels selectors:selectors args:args receiver:anObject
- "create and set the menu under the title, aString"
-
- |menuView|
-
- menuView := MenuView labels:labels
- selectors:selectors
- args:args
- receiver:anObject
- for:self.
- self at:aString putMenu:menuView
-!
-
-at:aString putLabels:labels selector:selector args:args receiver:anObject
- "create and set the menu under the title, aString"
-
- |menuView|
-
- menuView := MenuView labels:labels
- selector:selector
- args:args
- receiver:anObject
- for:self.
- self at:aString putMenu:menuView
-!
-
-at:aString putLabels:labels selectors:selectors receiver:anObject
- "create and set the menu under the title, aString"
-
- |menuView|
-
- menuView := MenuView labels:labels
- selectors:selectors
- receiver:anObject
- for:self.
- self at:aString putMenu:menuView
-! !
-
-!PullDownMenu methodsFor:'queries'!
-
-preferredExtent
- |w|
-
- w := self titleLenUpTo:(titles size + 1).
- ^ w @ (font height + (font descent * 2) "+ topMargin" + (margin*2)).
-! !
-
!PullDownMenu methodsFor:'private'!
-titleLenUpTo:index
- "answer len (in pixels) of all title-strings up-to
- (but excluding) title-index. Used to compute x-position when drawing
- individual entries."
-
- |len "{ Class: SmallInteger }"
- wSpace wSep|
-
- (index <= 1) ifTrue:[^ 0].
- wSpace := (font widthOf:' ').
- showSeparatingLines ifTrue:[
- self is3D ifTrue:[
- wSep := 2
- ] ifFalse:[
- wSep := 1
- ]
- ] ifFalse:[
- wSep := 0
- ].
-
- len := 0.
- titles from:1 to:(index - 1) do:[:entry |
- |thisLength|
-
- entry isString ifTrue:[
- thisLength := (font widthOf:entry).
- ] ifFalse:[
- thisLength := entry width
- ].
- len := len + thisLength + wSpace + wSep + wSpace.
- ].
- ^ len
-!
-
indexOf:stringOrNumber
"return the index of the menu with title; return 0 if not found.
stringOrNumber may be a number, a selector from the selectorArray
@@ -784,6 +1111,20 @@
^ titles indexOf:stringOrNumber
!
+setMenuOrigins
+ "adjust origins of menus when font changes"
+
+ (font device == device) ifTrue:[
+ menus keysAndValuesDo:[:index :aMenu |
+ aMenu notNil ifTrue:[
+ aMenu origin:((left + (self titleLenUpTo:index))
+ @
+ (height + aMenu borderWidth))
+ ].
+ ]
+ ]
+!
+
someMenuItemLabeled:aLabel
"find a menu item.
Currently, in ST/X, instances of MenuItem are only created as dummy"
@@ -808,20 +1149,6 @@
^ nil
!
-setMenuOrigins
- "adjust origins of menus when font changes"
-
- (font device == device) ifTrue:[
- menus keysAndValuesDo:[:index :aMenu |
- aMenu notNil ifTrue:[
- aMenu origin:((left + (self titleLenUpTo:index))
- @
- (height + aMenu borderWidth))
- ].
- ]
- ]
-!
-
titleIndexForX:x
"given a click x-position, return index in title or nil"
@@ -854,189 +1181,49 @@
xstart := xend
].
^ nil
-! !
-
-!PullDownMenu methodsFor:'hiding/showing menus'!
-
-hideActiveMenuRelease:aBoolean
- "hide currently active menu - release grab if aBoolean is true
- and a grab was set (keepMenu)"
-
- |m|
-
- activeMenuNumber notNil ifTrue:[
- (m := menus at:activeMenuNumber) notNil ifTrue:[
- m hiddenOnRealize:true.
- m unrealize.
- ].
- self unHighlightActiveTitle.
- activeMenuNumber := nil
- ].
- aBoolean ifTrue:[
- device ungrabPointer.
- self cursor:Cursor normal
- ].
-!
-
-hideActiveMenu
- "hide currently active menu - release grab if there is any grab (keepMenu)"
-
- ^ self hideActiveMenuRelease:true
!
-pullMenu:aNumber
- "activate a menu, return it or nil"
+titleLenUpTo:index
+ "answer len (in pixels) of all title-strings up-to
+ (but excluding) title-index. Used to compute x-position when drawing
+ individual entries."
- |subMenu r posY|
+ |len "{ Class: SmallInteger }"
+ wSpace wSep|
- activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
- activeMenuNumber := aNumber.
- subMenu := menus at:aNumber.
-
- raiseTopWhenActivated ifTrue:[
- self topView raise.
+ (index <= 1) ifTrue:[^ 0].
+ wSpace := (font widthOf:' ').
+ showSeparatingLines ifTrue:[
+ self is3D ifTrue:[
+ wSep := 2
+ ] ifFalse:[
+ wSep := 1
+ ]
+ ] ifFalse:[
+ wSep := 0
].
- (activeMenuNumber notNil
- and:[
- subMenu notNil
- or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[
- self highlightActiveTitle.
- ].
+ len := 0.
+ titles from:1 to:(index - 1) do:[:entry |
+ |thisLength|
- subMenu notNil ifTrue:[
- subMenu origin:((left + (self titleLenUpTo:aNumber))
- @
- (posY := height + subMenu borderWidth)).
- subMenu hiddenOnRealize:false.
- subMenu deselect.
- subMenu create.
- subMenu saveUnder:true.
- subMenu superMenu:self.
-
- subMenu right > (r := self right) ifTrue:[
- subMenu origin:((r - subMenu width) @ posY).
+ entry isString ifTrue:[
+ thisLength := (font widthOf:entry).
+ ] ifFalse:[
+ thisLength := entry width
].
- subMenu raise show.
+ len := len + thisLength + wSpace + wSep + wSpace.
].
- ^ subMenu
-!
-
-regainControl
- keepMenu ifTrue:[
- device grabPointerInView:self.
- self cursor:Cursor upRightArrow
- ]
+ ^ len
! !
-!PullDownMenu methodsFor:'drawing '!
-
-redraw
- |x "{ Class: SmallInteger }"
- y "{ Class: SmallInteger }"
- index "{ Class: SmallInteger }"
- wSpace clr|
-
- shown ifFalse: [ ^ self ].
- titles isNil ifTrue:[^ self].
-
- wSpace := (font widthOf:' ').
- x := 0.
- y := height "- 1".
- index := 1.
- titles do:[:title |
- self drawTitle:title x:x selected:(index == activeMenuNumber).
-
- title isString ifTrue:[
- x := x + (font widthOf:title).
- ] ifFalse:[
- x := x + title width
- ].
- x := x + wSpace + wSpace.
- showSeparatingLines ifTrue:[
- self is3D ifTrue:[
- self paint:shadowColor.
- self displayLineFromX:x y:0 toX:x y:y.
- x := x + 1.
- clr := lightColor.
- ] ifFalse:[
- clr := fgColor.
- ].
- self paint:clr.
- self displayLineFromX:x y:0 toX:x y:y.
- x := x + 1
- ].
- index := index + 1
- ]
-!
-
-drawTitle:stringOrImage x:x0 selected:selected
- |y w x wSpace fg bg map|
-
- selected ifTrue:[
- fg := activeFgColor.
- bg := activeBgColor
- ] ifFalse:[
- fg := fgColor.
- bg := bgColor
- ].
+!PullDownMenu methodsFor:'queries'!
- wSpace := font widthOf:' '.
- x := x0.
- stringOrImage isString ifTrue:[
- y := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
- w := font widthOf:stringOrImage.
- ] ifFalse:[
- y := ((height - stringOrImage height) // 2) max:0.
- w := stringOrImage width
- ].
- w := w + (wSpace * 2).
-
- self paint:bg.
- self fillRectangleX:x y:0 width:w height:height.
+preferredExtent
+ |w|
- self is3D ifTrue:[
- self drawEdgesForX:x y:0
- width:w
- height:height
- level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
- ].
- self paint:fg.
- x := x + wSpace.
- stringOrImage isString ifTrue:[
- self displayString:stringOrImage x:x y:y
- ] ifFalse:[
- stringOrImage isImageOrForm ifTrue:[
- stringOrImage depth == 1 ifTrue:[
- (map := stringOrImage colorMap) notNil ifTrue:[
- self paint:(map at:2) on:(map at:1).
- self displayOpaqueForm:stringOrImage x:x y:y.
- ^ self
- ]
- ].
- self displayForm:stringOrImage x:x y:y
- ] ifFalse:[
- stringOrImage displayOn:self x:x y:y
- ]
- ]
-
- "Modified: 20.10.1995 / 22:03:27 / cg"
-!
-
-drawActiveTitleSelected:selected
- |x|
- activeMenuNumber notNil ifTrue:[
- x := self titleLenUpTo:activeMenuNumber.
- self drawTitle:(titles at:activeMenuNumber) x:x selected:selected
- ]
-!
-
-highlightActiveTitle
- self drawActiveTitleSelected:true
-!
-
-unHighlightActiveTitle
- self drawActiveTitleSelected:false
+ w := self titleLenUpTo:(titles size + 1).
+ ^ w @ (font height + (font descent * 2) "+ topMargin" + (margin*2)).
! !
!PullDownMenu methodsFor:'submenu notifications'!
@@ -1062,196 +1249,3 @@
self showPassive
! !
-!PullDownMenu methodsFor:'event handling'!
-
-showNoFocus
- "when stepping focus, hide any active menu"
-
- self hideActiveMenu.
- super showNoFocus
-!
-
-keyPress:key x:x y:y
- <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect)>
-
- |index m sel|
-
- "
- handle CursorLeft/Right for non-mouse operation
- (for example, if it has the explicit focus)
- These will pull the previous/next menu
- "
- ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[
- activeMenuNumber isNil ifTrue:[
- index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size].
- ] ifFalse:[
- (key == #CursorRight) ifTrue:[
- index := activeMenuNumber+1
- ] ifFalse:[
- index := activeMenuNumber-1
- ].
- index == 0 ifTrue:[index := menus size]
- ifFalse:[
- index > menus size ifTrue:[index := 1]
- ]
- ].
- self pullMenu:index.
- ^ self
- ].
-
- activeMenuNumber isNil ifTrue:[^self].
-
- "
- Return, space or the (virtual) MenuSelect key trigger
- a menu entry (for non-submenu entries).
- Otherwise, if we have a submenu open,
- pass the key on to it ...
- "
- m := menus at:activeMenuNumber.
- m isNil ifTrue:[
- (key == #Return
- or:[key == #MenuSelect
- or:[key == Character space]]) ifTrue:[
- sel := selectors at:activeMenuNumber.
- sel notNil ifTrue:[
- receiver perform:sel
- ]
- ].
- ] ifFalse:[
- m keyPress:key x:0 y:0.
- ].
-!
-
-buttonPress:button x:x y:y
- |titleIndex activeMenu activeLeft activeTop m|
-
- device ungrabPointer.
-
- (y between:0 and:height) ifTrue:[
- titleIndex := self titleIndexForX:x.
- ].
-
- "
- now, titleIndex is non-nil if pressed within myself
- "
- (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
- m := self pullMenu:titleIndex.
- (keepMenu and:[m notNil]) ifTrue:[
- device grabPointerInView:self.
- self cursor:Cursor upRightArrow
- ]
- ] ifFalse:[
- (keepMenu and:[toggleKeep not]) ifTrue:[
- titleIndex == activeMenuNumber ifTrue:[
- "same pressed again ... stay"
- device grabPointerInView:self.
- ^ self
- ].
- "moving around below"
- activeMenuNumber isNil ifTrue:[^self].
- activeMenu := menus at:activeMenuNumber.
- activeLeft := activeMenu left.
- (x between:activeLeft and:(activeMenu right)) ifTrue:[
- activeTop := activeMenu top.
- (y between:activeTop and:(activeMenu bottom)) ifTrue:[
- "moving around in menu"
- activeMenu buttonPress:button
- x:(x - activeLeft)
- y:(y - activeTop).
- ^ self
- ]
- ].
- ].
- self hideActiveMenu
- ]
-!
-
-buttonMotion:state x:x y:y
- |titleIndex activeMenu activeLeft activeTop|
-
- state == 0 ifTrue:[^ self].
-
- activeMenuNumber notNil ifTrue:[
- activeMenu := menus at:activeMenuNumber.
- ].
-
- (y < height) ifTrue:[
- "moving around in title line"
- activeMenu notNil ifTrue:[
- activeMenu selection:nil
- ].
- titleIndex := self titleIndexForX:x.
- titleIndex notNil ifTrue:[
- (titleIndex ~~ activeMenuNumber) ifTrue:[
- self pullMenu:titleIndex
- ]
- ] ifFalse:[
- self hideActiveMenu
- ]
- ] ifFalse:[
- "moving around below"
- activeMenu isNil ifTrue:[^self].
- activeLeft := activeMenu left.
- (x between:activeLeft and:(activeMenu right)) ifTrue:[
- activeTop := activeMenu top.
- (y between:activeTop and:(activeMenu bottom)) ifTrue:[
- "moving around in menu"
- activeMenu buttonMotion:state
- x:(x - activeLeft)
- y:(y - activeTop).
- ^ self
- ]
- ].
- "moved outside menu"
- activeMenu selection:nil
- ]
-!
-
-buttonRelease:button x:x y:y
- |activeMenu activeLeft activeTop hideMenu sel|
-
- activeMenuNumber isNil ifTrue:[^self].
- activeMenu := menus at:activeMenuNumber.
-
- hideMenu := false.
- (y >= height) ifTrue:[
- "release below title-line"
- activeLeft := activeMenu left.
- "
- released in a submenu ?
- "
- (x between:activeLeft and:(activeMenu right)) ifTrue:[
- activeTop := activeMenu top.
- (y between:activeTop and:(activeMenu bottom)) ifTrue:[
- "release in menu"
- self hideActiveMenu.
- activeMenu buttonRelease:button
- x:(x - activeLeft)
- y:(y - activeTop).
- ^ self
- ]
- ].
- hideMenu := true.
- ] ifFalse:[
- y < 0 ifTrue:[
- hideMenu := true
- ] ifFalse:[
- activeMenu isNil ifTrue:[
- selectors notNil ifTrue:[
- sel := selectors at:activeMenuNumber.
- sel notNil ifTrue:[
- receiver perform:sel
- ].
- ].
- hideMenu := true.
- ] ifFalse:[
- keepMenu ifFalse:[
- hideMenu := true
- ]
- ]
- ]
- ].
- hideMenu ifTrue:[
- self hideActiveMenu.
- ]
-! !
--- a/PullDownMenu.st Thu Nov 23 11:44:18 1995 +0100
+++ b/PullDownMenu.st Thu Nov 23 15:37:40 1995 +0100
@@ -11,23 +11,17 @@
"
SimpleView subclass:#PullDownMenu
- instanceVariableNames:'receiver menus titles selectors activeMenuNumber
- showSeparatingLines topMargin
- fgColor bgColor activeFgColor activeBgColor
- onLevel offLevel edgeStyle
- keepMenu toggleKeep raiseTopWhenActivated'
- classVariableNames:'DefaultFont
- DefaultViewBackground
- DefaultForegroundColor
- DefaultBackgroundColor
- DefaultHilightForegroundColor
- DefaultHilightBackgroundColor
- DefaultLevel DefaultHilightLevel
- DefaultShadowColor DefaultLightColor
- DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep
- DefaultSeparatingLines'
- poolDictionaries:''
- category:'Views-Menus'
+ instanceVariableNames:'receiver menus titles selectors activeMenuNumber
+ showSeparatingLines topMargin fgColor bgColor activeFgColor
+ activeBgColor onLevel offLevel edgeStyle keepMenu toggleKeep
+ raiseTopWhenActivated'
+ classVariableNames:'DefaultFont DefaultViewBackground DefaultForegroundColor
+ DefaultBackgroundColor DefaultHilightForegroundColor
+ DefaultHilightBackgroundColor DefaultLevel DefaultHilightLevel
+ DefaultShadowColor DefaultLightColor DefaultEdgeStyle
+ DefaultKeepMenu DefaultToggleKeep DefaultSeparatingLines'
+ poolDictionaries:''
+ category:'Views-Menus'
!
!PullDownMenu class methodsFor:'documentation'!
@@ -46,10 +40,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.26 1995-11-11 16:22:17 cg Exp $'
-!
-
documentation
"
PullDown menu provides the top (always visible) part of these menus.
@@ -330,6 +320,18 @@
receiver:textView.
top open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.27 1995-11-23 14:35:27 cg Exp $'
+! !
+
+!PullDownMenu class methodsFor:'instance creation'!
+
+labels:titleArray
+ "create and return a new PullDownMenu"
+
+ ^ self new labels:titleArray
! !
!PullDownMenu class methodsFor:'defaults'!
@@ -384,23 +386,596 @@
"
! !
-!PullDownMenu class methodsFor:'instance creation'!
+!PullDownMenu methodsFor:'accessing'!
+
+at:aString putLabels:labels selector:selector args:args receiver:anObject
+ "create and set the menu under the title, aString"
+
+ |menuView|
+
+ menuView := MenuView labels:labels
+ selector:selector
+ args:args
+ receiver:anObject
+ for:self.
+ self at:aString putMenu:menuView
+!
+
+at:aString putLabels:labels selectors:selectors args:args receiver:anObject
+ "create and set the menu under the title, aString"
+
+ |menuView|
+
+ menuView := MenuView labels:labels
+ selectors:selectors
+ args:args
+ receiver:anObject
+ for:self.
+ self at:aString putMenu:menuView
+!
+
+at:aString putLabels:labels selectors:selectors receiver:anObject
+ "create and set the menu under the title, aString"
+
+ |menuView|
+
+ menuView := MenuView labels:labels
+ selectors:selectors
+ receiver:anObject
+ for:self.
+ self at:aString putMenu:menuView
+!
+
+at:aString putMenu:aMenu
+ "set the menu under the title, aString"
+
+ |index|
+
+ index := self indexOf:aString.
+ (index == 0) ifTrue:[
+ self error:'no such menu entry'.
+ ^ nil
+ ].
+
+"/ not needed:
+"/ aMenu origin:((left + (self titleLenUpTo:index))
+"/ @
+"/ (height + aMenu borderWidth)).
+ aMenu hiddenOnRealize:true.
+ menus at:index put:aMenu.
+ aMenu masterView:self.
+!
+
+labels
+ "return the menu-titles (group-headers)"
+
+ ^ titles
+!
labels:titleArray
- "create and return a new PullDownMenu"
+ "define the menu-titles (group-headers)"
+
+ |numberOfLabels|
+
+ numberOfLabels := titleArray size.
+ menus := Array new:numberOfLabels.
+ titles := Array new:numberOfLabels.
+
+ titleArray keysAndValuesDo:[:index :entry |
+ |e|
+
+ entry isImage ifTrue:[
+ e := entry on:device
+ ] ifFalse:[
+ e := entry printString
+ ].
+ titles at:index put:e
+ ].
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ]
+!
+
+labels:titleArray selectors:selectorArray
+ "define the menu-titles (group-headers) and selectors.
+ Selectors are mostly used as access keys to get to submenus later."
+
+ self labels:titleArray.
+ self selectors:selectorArray
+
+ "Created: 20.10.1995 / 20:15:54 / cg"
+!
+
+menuAt:stringOrNumber
+ "return the menu with the title; return nil if not found"
+
+ |index|
+
+ index := self indexOf:stringOrNumber.
+ (index == 0) ifTrue:[^ nil].
+ ^ menus at:index
+!
+
+numberOfTitles:n
+ "setup blank title-space to be filled in later"
+
+ menus := Array new:n.
+ titles := Array new:n
+!
+
+receiver:anObject
+ "set the menu-receiver. Thats the one who gets the
+ messages (both from myself and from my submenus).
+ This only sets the receiver for menus which are already
+ created - menus added later should get their receiver in
+ the creation send."
+
+ receiver := anObject.
+ menus notNil ifTrue:[
+ menus do:[:aMenu |
+ aMenu notNil ifTrue:[
+ aMenu receiver:anObject
+ ]
+ ]
+ ]
+!
+
+selectors:selectorArray
+ "define the menu-selectors. These are used as accesskey only
+ in menuAt: accesses. This makes PullDownMenu accesss
+ somewhat more compatible to PopUpMenus."
+
+ selectors := selectorArray.
+! !
+
+!PullDownMenu methodsFor:'accessing-look'!
+
+backgroundColor:aColor
+ "set the background drawing color.
+ You should not use this method; instead leave the value as
+ defined in the styleSheet."
+
+ bgColor := aColor on:device
+!
+
+font:aFont
+ "set the menus font.
+ adjusts menu-origins when font changes.
+ You should not use this method; instead leave the value as
+ defined in the styleSheet."
+
+ aFont ~~ font ifTrue:[
+ super font:(aFont on:device).
+ self height:(font height + (font descent * 2)).
+ shown ifTrue:[
+ self setMenuOrigins
+ ]
+ ]
+!
+
+foregroundColor:aColor
+ "set the foreground drawing color.
+ You should not use this method; instead leave the value as
+ defined in the styleSheet."
+
+ fgColor := aColor on:device
+!
+
+showSeparatingLines:aBoolean
+ "turn on/off drawing of separating lines.
+ You should not use this method; instead leave the value as
+ defined in the styleSheet."
+
+ showSeparatingLines := aBoolean.
+ shown ifTrue:[
+ self setMenuOrigins.
+ self redraw
+ ]
+! !
+
+!PullDownMenu methodsFor:'drawing '!
+
+drawActiveTitleSelected:selected
+ |x|
+ activeMenuNumber notNil ifTrue:[
+ x := self titleLenUpTo:activeMenuNumber.
+ self drawTitle:(titles at:activeMenuNumber) x:x selected:selected
+ ]
+!
+
+drawTitle:stringOrImage x:x0 selected:selected
+ |y w x wSpace fg bg map|
+
+ selected ifTrue:[
+ fg := activeFgColor.
+ bg := activeBgColor
+ ] ifFalse:[
+ fg := fgColor.
+ bg := bgColor
+ ].
+
+ wSpace := font widthOf:' '.
+ x := x0.
+ stringOrImage isString ifTrue:[
+ y := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
+ w := font widthOf:stringOrImage.
+ ] ifFalse:[
+ y := ((height - stringOrImage height) // 2) max:0.
+ w := stringOrImage width
+ ].
+ w := w + (wSpace * 2).
+
+ self paint:bg.
+ self fillRectangleX:x y:0 width:w height:height.
+
+ self is3D ifTrue:[
+ self drawEdgesForX:x y:0
+ width:w
+ height:height
+ level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
+ ].
+ self paint:fg.
+ x := x + wSpace.
+ stringOrImage isString ifTrue:[
+ self displayString:stringOrImage x:x y:y
+ ] ifFalse:[
+ stringOrImage isImageOrForm ifTrue:[
+ stringOrImage depth == 1 ifTrue:[
+ (map := stringOrImage colorMap) notNil ifTrue:[
+ self paint:(map at:2) on:(map at:1).
+ self displayOpaqueForm:stringOrImage x:x y:y.
+ ^ self
+ ]
+ ].
+ self displayForm:stringOrImage x:x y:y
+ ] ifFalse:[
+ stringOrImage displayOn:self x:x y:y
+ ]
+ ]
+
+ "Modified: 20.10.1995 / 22:03:27 / cg"
+!
+
+highlightActiveTitle
+ self drawActiveTitleSelected:true
+!
+
+redraw
+ |x "{ Class: SmallInteger }"
+ y "{ Class: SmallInteger }"
+ index "{ Class: SmallInteger }"
+ wSpace clr|
+
+ shown ifFalse: [ ^ self ].
+ titles isNil ifTrue:[^ self].
+
+ wSpace := (font widthOf:' ').
+ x := 0.
+ y := height "- 1".
+ index := 1.
+ titles do:[:title |
+ self drawTitle:title x:x selected:(index == activeMenuNumber).
+
+ title isString ifTrue:[
+ x := x + (font widthOf:title).
+ ] ifFalse:[
+ x := x + title width
+ ].
+ x := x + wSpace + wSpace.
+ showSeparatingLines ifTrue:[
+ self is3D ifTrue:[
+ self paint:shadowColor.
+ self displayLineFromX:x y:0 toX:x y:y.
+ x := x + 1.
+ clr := lightColor.
+ ] ifFalse:[
+ clr := fgColor.
+ ].
+ self paint:clr.
+ self displayLineFromX:x y:0 toX:x y:y.
+ x := x + 1
+ ].
+ index := index + 1
+ ]
+!
+
+unHighlightActiveTitle
+ self drawActiveTitleSelected:false
+! !
+
+!PullDownMenu methodsFor:'event handling'!
+
+buttonMotion:state x:x y:y
+ |titleIndex activeMenu activeLeft activeTop|
+
+ state == 0 ifTrue:[^ self].
+
+ activeMenuNumber notNil ifTrue:[
+ activeMenu := menus at:activeMenuNumber.
+ ].
- ^ self new labels:titleArray
+ (y < height) ifTrue:[
+ "moving around in title line"
+ activeMenu notNil ifTrue:[
+ activeMenu selection:nil
+ ].
+ titleIndex := self titleIndexForX:x.
+ titleIndex notNil ifTrue:[
+ (titleIndex ~~ activeMenuNumber) ifTrue:[
+ self pullMenu:titleIndex
+ ]
+ ] ifFalse:[
+ self hideActiveMenu
+ ]
+ ] ifFalse:[
+ "moving around below"
+ activeMenu isNil ifTrue:[^self].
+ activeLeft := activeMenu left.
+ (x between:activeLeft and:(activeMenu right)) ifTrue:[
+ activeTop := activeMenu top.
+ (y between:activeTop and:(activeMenu bottom)) ifTrue:[
+ "moving around in menu"
+ activeMenu buttonMotion:state
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ].
+ "moved outside menu"
+ activeMenu selection:nil
+ ]
+!
+
+buttonPress:button x:x y:y
+ |titleIndex activeMenu activeLeft activeTop m|
+
+ device ungrabPointer.
+
+ (y between:0 and:height) ifTrue:[
+ titleIndex := self titleIndexForX:x.
+ ].
+
+ "
+ now, titleIndex is non-nil if pressed within myself
+ "
+ (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
+ m := self pullMenu:titleIndex.
+ (keepMenu and:[m notNil]) ifTrue:[
+ device grabPointerInView:self.
+ self cursor:Cursor upRightArrow
+ ]
+ ] ifFalse:[
+ (keepMenu and:[toggleKeep not]) ifTrue:[
+ titleIndex == activeMenuNumber ifTrue:[
+ "same pressed again ... stay"
+ device grabPointerInView:self.
+ ^ self
+ ].
+ "moving around below"
+ activeMenuNumber isNil ifTrue:[^self].
+ activeMenu := menus at:activeMenuNumber.
+ activeLeft := activeMenu left.
+ (x between:activeLeft and:(activeMenu right)) ifTrue:[
+ activeTop := activeMenu top.
+ (y between:activeTop and:(activeMenu bottom)) ifTrue:[
+ "moving around in menu"
+ activeMenu buttonPress:button
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ].
+ ].
+ self hideActiveMenu
+ ]
+!
+
+buttonRelease:button x:x y:y
+ |activeMenu activeLeft activeTop hideMenu sel|
+
+ activeMenuNumber isNil ifTrue:[^self].
+ activeMenu := menus at:activeMenuNumber.
+
+ hideMenu := false.
+ (y >= height) ifTrue:[
+ "release below title-line"
+ activeLeft := activeMenu left.
+ "
+ released in a submenu ?
+ "
+ (x between:activeLeft and:(activeMenu right)) ifTrue:[
+ activeTop := activeMenu top.
+ (y between:activeTop and:(activeMenu bottom)) ifTrue:[
+ "release in menu"
+ self hideActiveMenu.
+ activeMenu buttonRelease:button
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ].
+ hideMenu := true.
+ ] ifFalse:[
+ y < 0 ifTrue:[
+ hideMenu := true
+ ] ifFalse:[
+ activeMenu isNil ifTrue:[
+ selectors notNil ifTrue:[
+ sel := selectors at:activeMenuNumber.
+ sel notNil ifTrue:[
+ receiver perform:sel
+ ].
+ ].
+ hideMenu := true.
+ ] ifFalse:[
+ keepMenu ifFalse:[
+ hideMenu := true
+ ]
+ ]
+ ]
+ ].
+ hideMenu ifTrue:[
+ self hideActiveMenu.
+ ]
+!
+
+keyPress:key x:x y:y
+ <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect)>
+
+ |index m sel|
+
+ "
+ handle CursorLeft/Right for non-mouse operation
+ (for example, if it has the explicit focus)
+ These will pull the previous/next menu
+ "
+ ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[
+ activeMenuNumber isNil ifTrue:[
+ index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size].
+ ] ifFalse:[
+ (key == #CursorRight) ifTrue:[
+ index := activeMenuNumber+1
+ ] ifFalse:[
+ index := activeMenuNumber-1
+ ].
+ index == 0 ifTrue:[index := menus size]
+ ifFalse:[
+ index > menus size ifTrue:[index := 1]
+ ]
+ ].
+ self pullMenu:index.
+ ^ self
+ ].
+
+ activeMenuNumber isNil ifTrue:[^self].
+
+ "
+ Return, space or the (virtual) MenuSelect key trigger
+ a menu entry (for non-submenu entries).
+ Otherwise, if we have a submenu open,
+ pass the key on to it ...
+ "
+ m := menus at:activeMenuNumber.
+ m isNil ifTrue:[
+ (key == #Return
+ or:[key == #MenuSelect
+ or:[key == Character space]]) ifTrue:[
+ sel := selectors at:activeMenuNumber.
+ sel notNil ifTrue:[
+ receiver perform:sel
+ ]
+ ].
+ ] ifFalse:[
+ m keyPress:key x:0 y:0.
+ ].
+!
+
+showNoFocus
+ "when stepping focus, hide any active menu"
+
+ self hideActiveMenu.
+ super showNoFocus
+! !
+
+!PullDownMenu methodsFor:'hiding/showing menus'!
+
+hideActiveMenu
+ "hide currently active menu - release grab if there is any grab (keepMenu)"
+
+ ^ self hideActiveMenuRelease:true
+!
+
+hideActiveMenuRelease:aBoolean
+ "hide currently active menu - release grab if aBoolean is true
+ and a grab was set (keepMenu)"
+
+ |m|
+
+ activeMenuNumber notNil ifTrue:[
+ (m := menus at:activeMenuNumber) notNil ifTrue:[
+ m hiddenOnRealize:true.
+ m unrealize.
+ ].
+ self unHighlightActiveTitle.
+ activeMenuNumber := nil
+ ].
+ aBoolean ifTrue:[
+ device ungrabPointer.
+ self cursor:Cursor normal
+ ].
+!
+
+pullMenu:aNumber
+ "activate a menu, return it or nil"
+
+ |subMenu r posY|
+
+ activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
+ activeMenuNumber := aNumber.
+ subMenu := menus at:aNumber.
+
+ raiseTopWhenActivated ifTrue:[
+ self topView raise.
+ ].
+
+ (activeMenuNumber notNil
+ and:[
+ subMenu notNil
+ or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[
+ self highlightActiveTitle.
+ ].
+
+ subMenu notNil ifTrue:[
+ subMenu origin:((left + (self titleLenUpTo:aNumber))
+ @
+ (posY := height + subMenu borderWidth)).
+ subMenu hiddenOnRealize:false.
+ subMenu deselect.
+ subMenu create.
+ subMenu saveUnder:true.
+ subMenu superMenu:self.
+
+ subMenu right > (r := self right) ifTrue:[
+ subMenu origin:((r - subMenu width) @ posY).
+ ].
+ subMenu raise show.
+ ].
+ ^ subMenu
+!
+
+regainControl
+ keepMenu ifTrue:[
+ device grabPointerInView:self.
+ self cursor:Cursor upRightArrow
+ ]
! !
!PullDownMenu methodsFor:'initialize / release'!
-initialize
- super initialize.
+create
+ super create.
+ self setMenuOrigins
+!
+
+destroy
+ "have to destroy the menus manually here,
+ since they are no real subviews of myself"
- font := font on:device.
- self origin:(0.0 @ 0.0)
- extent:(1.0 @ self preferredExtent y)
-"/ extent:(1.0 @ (font height + (font descent * 2) + topMargin)).
+ menus notNil ifTrue:[
+ menus do:[:m |
+ m notNil ifTrue:[m destroy]
+ ].
+ menus := nil
+ ].
+ activeMenuNumber := nil.
+ super destroy.
+!
+
+initCursor
+ "set up a hand cursor"
+
+ cursor := Cursor hand
!
initStyle
@@ -480,10 +1055,13 @@
raiseTopWhenActivated := styleSheet at:'pullDownMenuRaiseTop' default:true.
!
-initCursor
- "set up a hand cursor"
+initialize
+ super initialize.
- cursor := Cursor hand
+ font := font on:device.
+ self origin:(0.0 @ 0.0)
+ extent:(1.0 @ self preferredExtent y)
+"/ extent:(1.0 @ (font height + (font descent * 2) + topMargin)).
!
recreate
@@ -501,25 +1079,6 @@
self setMenuOrigins
!
-create
- super create.
- self setMenuOrigins
-!
-
-destroy
- "have to destroy the menus manually here,
- since they are no real subviews of myself"
-
- menus notNil ifTrue:[
- menus do:[:m |
- m notNil ifTrue:[m destroy]
- ].
- menus := nil
- ].
- activeMenuNumber := nil.
- super destroy.
-!
-
superView:aView
"when my superView changes, all of my menus must change as well"
@@ -533,240 +1092,8 @@
]
! !
-!PullDownMenu methodsFor:'accessing-look'!
-
-showSeparatingLines:aBoolean
- "turn on/off drawing of separating lines.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- showSeparatingLines := aBoolean.
- shown ifTrue:[
- self setMenuOrigins.
- self redraw
- ]
-!
-
-font:aFont
- "set the menus font.
- adjusts menu-origins when font changes.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- aFont ~~ font ifTrue:[
- super font:(aFont on:device).
- self height:(font height + (font descent * 2)).
- shown ifTrue:[
- self setMenuOrigins
- ]
- ]
-!
-
-foregroundColor:aColor
- "set the foreground drawing color.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- fgColor := aColor on:device
-!
-
-backgroundColor:aColor
- "set the background drawing color.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- bgColor := aColor on:device
-! !
-
-
-!PullDownMenu methodsFor:'accessing'!
-
-receiver:anObject
- "set the menu-receiver. Thats the one who gets the
- messages (both from myself and from my submenus).
- This only sets the receiver for menus which are already
- created - menus added later should get their receiver in
- the creation send."
-
- receiver := anObject.
- menus notNil ifTrue:[
- menus do:[:aMenu |
- aMenu notNil ifTrue:[
- aMenu receiver:anObject
- ]
- ]
- ]
-!
-
-numberOfTitles:n
- "setup blank title-space to be filled in later"
-
- menus := Array new:n.
- titles := Array new:n
-!
-
-labels:titleArray
- "define the menu-titles (group-headers)"
-
- |numberOfLabels|
-
- numberOfLabels := titleArray size.
- menus := Array new:numberOfLabels.
- titles := Array new:numberOfLabels.
-
- titleArray keysAndValuesDo:[:index :entry |
- |e|
-
- entry isImage ifTrue:[
- e := entry on:device
- ] ifFalse:[
- e := entry printString
- ].
- titles at:index put:e
- ].
- shown ifTrue:[
- self clear.
- self redraw
- ]
-!
-
-labels
- "return the menu-titles (group-headers)"
-
- ^ titles
-!
-
-selectors:selectorArray
- "define the menu-selectors. These are used as accesskey only
- in menuAt: accesses. This makes PullDownMenu accesss
- somewhat more compatible to PopUpMenus."
-
- selectors := selectorArray.
-!
-
-labels:titleArray selectors:selectorArray
- "define the menu-titles (group-headers) and selectors.
- Selectors are mostly used as access keys to get to submenus later."
-
- self labels:titleArray.
- self selectors:selectorArray
-
- "Created: 20.10.1995 / 20:15:54 / cg"
-!
-
-menuAt:stringOrNumber
- "return the menu with the title; return nil if not found"
-
- |index|
-
- index := self indexOf:stringOrNumber.
- (index == 0) ifTrue:[^ nil].
- ^ menus at:index
-!
-
-at:aString putMenu:aMenu
- "set the menu under the title, aString"
-
- |index|
-
- index := self indexOf:aString.
- (index == 0) ifTrue:[
- self error:'no such menu entry'.
- ^ nil
- ].
-
-"/ not needed:
-"/ aMenu origin:((left + (self titleLenUpTo:index))
-"/ @
-"/ (height + aMenu borderWidth)).
- aMenu hiddenOnRealize:true.
- menus at:index put:aMenu.
- aMenu masterView:self.
-!
-
-at:aString putLabels:labels selectors:selectors args:args receiver:anObject
- "create and set the menu under the title, aString"
-
- |menuView|
-
- menuView := MenuView labels:labels
- selectors:selectors
- args:args
- receiver:anObject
- for:self.
- self at:aString putMenu:menuView
-!
-
-at:aString putLabels:labels selector:selector args:args receiver:anObject
- "create and set the menu under the title, aString"
-
- |menuView|
-
- menuView := MenuView labels:labels
- selector:selector
- args:args
- receiver:anObject
- for:self.
- self at:aString putMenu:menuView
-!
-
-at:aString putLabels:labels selectors:selectors receiver:anObject
- "create and set the menu under the title, aString"
-
- |menuView|
-
- menuView := MenuView labels:labels
- selectors:selectors
- receiver:anObject
- for:self.
- self at:aString putMenu:menuView
-! !
-
-!PullDownMenu methodsFor:'queries'!
-
-preferredExtent
- |w|
-
- w := self titleLenUpTo:(titles size + 1).
- ^ w @ (font height + (font descent * 2) "+ topMargin" + (margin*2)).
-! !
-
!PullDownMenu methodsFor:'private'!
-titleLenUpTo:index
- "answer len (in pixels) of all title-strings up-to
- (but excluding) title-index. Used to compute x-position when drawing
- individual entries."
-
- |len "{ Class: SmallInteger }"
- wSpace wSep|
-
- (index <= 1) ifTrue:[^ 0].
- wSpace := (font widthOf:' ').
- showSeparatingLines ifTrue:[
- self is3D ifTrue:[
- wSep := 2
- ] ifFalse:[
- wSep := 1
- ]
- ] ifFalse:[
- wSep := 0
- ].
-
- len := 0.
- titles from:1 to:(index - 1) do:[:entry |
- |thisLength|
-
- entry isString ifTrue:[
- thisLength := (font widthOf:entry).
- ] ifFalse:[
- thisLength := entry width
- ].
- len := len + thisLength + wSpace + wSep + wSpace.
- ].
- ^ len
-!
-
indexOf:stringOrNumber
"return the index of the menu with title; return 0 if not found.
stringOrNumber may be a number, a selector from the selectorArray
@@ -784,6 +1111,20 @@
^ titles indexOf:stringOrNumber
!
+setMenuOrigins
+ "adjust origins of menus when font changes"
+
+ (font device == device) ifTrue:[
+ menus keysAndValuesDo:[:index :aMenu |
+ aMenu notNil ifTrue:[
+ aMenu origin:((left + (self titleLenUpTo:index))
+ @
+ (height + aMenu borderWidth))
+ ].
+ ]
+ ]
+!
+
someMenuItemLabeled:aLabel
"find a menu item.
Currently, in ST/X, instances of MenuItem are only created as dummy"
@@ -808,20 +1149,6 @@
^ nil
!
-setMenuOrigins
- "adjust origins of menus when font changes"
-
- (font device == device) ifTrue:[
- menus keysAndValuesDo:[:index :aMenu |
- aMenu notNil ifTrue:[
- aMenu origin:((left + (self titleLenUpTo:index))
- @
- (height + aMenu borderWidth))
- ].
- ]
- ]
-!
-
titleIndexForX:x
"given a click x-position, return index in title or nil"
@@ -854,189 +1181,49 @@
xstart := xend
].
^ nil
-! !
-
-!PullDownMenu methodsFor:'hiding/showing menus'!
-
-hideActiveMenuRelease:aBoolean
- "hide currently active menu - release grab if aBoolean is true
- and a grab was set (keepMenu)"
-
- |m|
-
- activeMenuNumber notNil ifTrue:[
- (m := menus at:activeMenuNumber) notNil ifTrue:[
- m hiddenOnRealize:true.
- m unrealize.
- ].
- self unHighlightActiveTitle.
- activeMenuNumber := nil
- ].
- aBoolean ifTrue:[
- device ungrabPointer.
- self cursor:Cursor normal
- ].
-!
-
-hideActiveMenu
- "hide currently active menu - release grab if there is any grab (keepMenu)"
-
- ^ self hideActiveMenuRelease:true
!
-pullMenu:aNumber
- "activate a menu, return it or nil"
+titleLenUpTo:index
+ "answer len (in pixels) of all title-strings up-to
+ (but excluding) title-index. Used to compute x-position when drawing
+ individual entries."
- |subMenu r posY|
+ |len "{ Class: SmallInteger }"
+ wSpace wSep|
- activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
- activeMenuNumber := aNumber.
- subMenu := menus at:aNumber.
-
- raiseTopWhenActivated ifTrue:[
- self topView raise.
+ (index <= 1) ifTrue:[^ 0].
+ wSpace := (font widthOf:' ').
+ showSeparatingLines ifTrue:[
+ self is3D ifTrue:[
+ wSep := 2
+ ] ifFalse:[
+ wSep := 1
+ ]
+ ] ifFalse:[
+ wSep := 0
].
- (activeMenuNumber notNil
- and:[
- subMenu notNil
- or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[
- self highlightActiveTitle.
- ].
+ len := 0.
+ titles from:1 to:(index - 1) do:[:entry |
+ |thisLength|
- subMenu notNil ifTrue:[
- subMenu origin:((left + (self titleLenUpTo:aNumber))
- @
- (posY := height + subMenu borderWidth)).
- subMenu hiddenOnRealize:false.
- subMenu deselect.
- subMenu create.
- subMenu saveUnder:true.
- subMenu superMenu:self.
-
- subMenu right > (r := self right) ifTrue:[
- subMenu origin:((r - subMenu width) @ posY).
+ entry isString ifTrue:[
+ thisLength := (font widthOf:entry).
+ ] ifFalse:[
+ thisLength := entry width
].
- subMenu raise show.
+ len := len + thisLength + wSpace + wSep + wSpace.
].
- ^ subMenu
-!
-
-regainControl
- keepMenu ifTrue:[
- device grabPointerInView:self.
- self cursor:Cursor upRightArrow
- ]
+ ^ len
! !
-!PullDownMenu methodsFor:'drawing '!
-
-redraw
- |x "{ Class: SmallInteger }"
- y "{ Class: SmallInteger }"
- index "{ Class: SmallInteger }"
- wSpace clr|
-
- shown ifFalse: [ ^ self ].
- titles isNil ifTrue:[^ self].
-
- wSpace := (font widthOf:' ').
- x := 0.
- y := height "- 1".
- index := 1.
- titles do:[:title |
- self drawTitle:title x:x selected:(index == activeMenuNumber).
-
- title isString ifTrue:[
- x := x + (font widthOf:title).
- ] ifFalse:[
- x := x + title width
- ].
- x := x + wSpace + wSpace.
- showSeparatingLines ifTrue:[
- self is3D ifTrue:[
- self paint:shadowColor.
- self displayLineFromX:x y:0 toX:x y:y.
- x := x + 1.
- clr := lightColor.
- ] ifFalse:[
- clr := fgColor.
- ].
- self paint:clr.
- self displayLineFromX:x y:0 toX:x y:y.
- x := x + 1
- ].
- index := index + 1
- ]
-!
-
-drawTitle:stringOrImage x:x0 selected:selected
- |y w x wSpace fg bg map|
-
- selected ifTrue:[
- fg := activeFgColor.
- bg := activeBgColor
- ] ifFalse:[
- fg := fgColor.
- bg := bgColor
- ].
+!PullDownMenu methodsFor:'queries'!
- wSpace := font widthOf:' '.
- x := x0.
- stringOrImage isString ifTrue:[
- y := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
- w := font widthOf:stringOrImage.
- ] ifFalse:[
- y := ((height - stringOrImage height) // 2) max:0.
- w := stringOrImage width
- ].
- w := w + (wSpace * 2).
-
- self paint:bg.
- self fillRectangleX:x y:0 width:w height:height.
+preferredExtent
+ |w|
- self is3D ifTrue:[
- self drawEdgesForX:x y:0
- width:w
- height:height
- level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
- ].
- self paint:fg.
- x := x + wSpace.
- stringOrImage isString ifTrue:[
- self displayString:stringOrImage x:x y:y
- ] ifFalse:[
- stringOrImage isImageOrForm ifTrue:[
- stringOrImage depth == 1 ifTrue:[
- (map := stringOrImage colorMap) notNil ifTrue:[
- self paint:(map at:2) on:(map at:1).
- self displayOpaqueForm:stringOrImage x:x y:y.
- ^ self
- ]
- ].
- self displayForm:stringOrImage x:x y:y
- ] ifFalse:[
- stringOrImage displayOn:self x:x y:y
- ]
- ]
-
- "Modified: 20.10.1995 / 22:03:27 / cg"
-!
-
-drawActiveTitleSelected:selected
- |x|
- activeMenuNumber notNil ifTrue:[
- x := self titleLenUpTo:activeMenuNumber.
- self drawTitle:(titles at:activeMenuNumber) x:x selected:selected
- ]
-!
-
-highlightActiveTitle
- self drawActiveTitleSelected:true
-!
-
-unHighlightActiveTitle
- self drawActiveTitleSelected:false
+ w := self titleLenUpTo:(titles size + 1).
+ ^ w @ (font height + (font descent * 2) "+ topMargin" + (margin*2)).
! !
!PullDownMenu methodsFor:'submenu notifications'!
@@ -1062,196 +1249,3 @@
self showPassive
! !
-!PullDownMenu methodsFor:'event handling'!
-
-showNoFocus
- "when stepping focus, hide any active menu"
-
- self hideActiveMenu.
- super showNoFocus
-!
-
-keyPress:key x:x y:y
- <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect)>
-
- |index m sel|
-
- "
- handle CursorLeft/Right for non-mouse operation
- (for example, if it has the explicit focus)
- These will pull the previous/next menu
- "
- ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[
- activeMenuNumber isNil ifTrue:[
- index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size].
- ] ifFalse:[
- (key == #CursorRight) ifTrue:[
- index := activeMenuNumber+1
- ] ifFalse:[
- index := activeMenuNumber-1
- ].
- index == 0 ifTrue:[index := menus size]
- ifFalse:[
- index > menus size ifTrue:[index := 1]
- ]
- ].
- self pullMenu:index.
- ^ self
- ].
-
- activeMenuNumber isNil ifTrue:[^self].
-
- "
- Return, space or the (virtual) MenuSelect key trigger
- a menu entry (for non-submenu entries).
- Otherwise, if we have a submenu open,
- pass the key on to it ...
- "
- m := menus at:activeMenuNumber.
- m isNil ifTrue:[
- (key == #Return
- or:[key == #MenuSelect
- or:[key == Character space]]) ifTrue:[
- sel := selectors at:activeMenuNumber.
- sel notNil ifTrue:[
- receiver perform:sel
- ]
- ].
- ] ifFalse:[
- m keyPress:key x:0 y:0.
- ].
-!
-
-buttonPress:button x:x y:y
- |titleIndex activeMenu activeLeft activeTop m|
-
- device ungrabPointer.
-
- (y between:0 and:height) ifTrue:[
- titleIndex := self titleIndexForX:x.
- ].
-
- "
- now, titleIndex is non-nil if pressed within myself
- "
- (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
- m := self pullMenu:titleIndex.
- (keepMenu and:[m notNil]) ifTrue:[
- device grabPointerInView:self.
- self cursor:Cursor upRightArrow
- ]
- ] ifFalse:[
- (keepMenu and:[toggleKeep not]) ifTrue:[
- titleIndex == activeMenuNumber ifTrue:[
- "same pressed again ... stay"
- device grabPointerInView:self.
- ^ self
- ].
- "moving around below"
- activeMenuNumber isNil ifTrue:[^self].
- activeMenu := menus at:activeMenuNumber.
- activeLeft := activeMenu left.
- (x between:activeLeft and:(activeMenu right)) ifTrue:[
- activeTop := activeMenu top.
- (y between:activeTop and:(activeMenu bottom)) ifTrue:[
- "moving around in menu"
- activeMenu buttonPress:button
- x:(x - activeLeft)
- y:(y - activeTop).
- ^ self
- ]
- ].
- ].
- self hideActiveMenu
- ]
-!
-
-buttonMotion:state x:x y:y
- |titleIndex activeMenu activeLeft activeTop|
-
- state == 0 ifTrue:[^ self].
-
- activeMenuNumber notNil ifTrue:[
- activeMenu := menus at:activeMenuNumber.
- ].
-
- (y < height) ifTrue:[
- "moving around in title line"
- activeMenu notNil ifTrue:[
- activeMenu selection:nil
- ].
- titleIndex := self titleIndexForX:x.
- titleIndex notNil ifTrue:[
- (titleIndex ~~ activeMenuNumber) ifTrue:[
- self pullMenu:titleIndex
- ]
- ] ifFalse:[
- self hideActiveMenu
- ]
- ] ifFalse:[
- "moving around below"
- activeMenu isNil ifTrue:[^self].
- activeLeft := activeMenu left.
- (x between:activeLeft and:(activeMenu right)) ifTrue:[
- activeTop := activeMenu top.
- (y between:activeTop and:(activeMenu bottom)) ifTrue:[
- "moving around in menu"
- activeMenu buttonMotion:state
- x:(x - activeLeft)
- y:(y - activeTop).
- ^ self
- ]
- ].
- "moved outside menu"
- activeMenu selection:nil
- ]
-!
-
-buttonRelease:button x:x y:y
- |activeMenu activeLeft activeTop hideMenu sel|
-
- activeMenuNumber isNil ifTrue:[^self].
- activeMenu := menus at:activeMenuNumber.
-
- hideMenu := false.
- (y >= height) ifTrue:[
- "release below title-line"
- activeLeft := activeMenu left.
- "
- released in a submenu ?
- "
- (x between:activeLeft and:(activeMenu right)) ifTrue:[
- activeTop := activeMenu top.
- (y between:activeTop and:(activeMenu bottom)) ifTrue:[
- "release in menu"
- self hideActiveMenu.
- activeMenu buttonRelease:button
- x:(x - activeLeft)
- y:(y - activeTop).
- ^ self
- ]
- ].
- hideMenu := true.
- ] ifFalse:[
- y < 0 ifTrue:[
- hideMenu := true
- ] ifFalse:[
- activeMenu isNil ifTrue:[
- selectors notNil ifTrue:[
- sel := selectors at:activeMenuNumber.
- sel notNil ifTrue:[
- receiver perform:sel
- ].
- ].
- hideMenu := true.
- ] ifFalse:[
- keepMenu ifFalse:[
- hideMenu := true
- ]
- ]
- ]
- ].
- hideMenu ifTrue:[
- self hideActiveMenu.
- ]
-! !
--- a/VPanelV.st Thu Nov 23 11:44:18 1995 +0100
+++ b/VPanelV.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:07:08 pm'!
-
PanelView subclass:#VerticalPanelView
instanceVariableNames:''
classVariableNames:''
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.15 1995-11-11 16:23:31 cg Exp $'
-!
-
documentation
"
a View which arranges its child-views in a vertical column.
@@ -527,6 +521,122 @@
panel extent:(panel preferredExtent).
panel open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.16 1995-11-23 14:37:40 cg Exp $'
+! !
+
+!VerticalPanelView methodsFor:'accessing'!
+
+horizontalLayout
+ "return the horizontal layout as symbol.
+ the returned value is one of
+ #left place element at the left
+ #leftSpace place element at the left, offset by horizontalSpace
+ #center place elements horizontally centered; ignore horizontalSpace
+ #right place it at the right
+ #rightSpace place it at the right, offset by horizontalSpace
+ #fit resize elements horizontally to fit this panel; ignore horizontalSpace
+ #fitSpace like #fit, but add spacing; ignore horizontalSpace
+
+ #leftMax like #left, but resize elements to max of them
+ #leftSpaceMax like #leftSpace, but resize elements
+ #centerMax like #center, but resize elements
+ #rightMax like #right, but resize elements to max of them
+ #rightSpaceMax like #rightSpace, but resize elements
+ the default is #centered
+ "
+
+ ^ hLayout
+!
+
+horizontalLayout:aSymbol
+ "change the horizontal layout as symbol.
+ The argument, aSymbol must be one of:
+ #left place element at the left
+ #leftSpace place element at the left, offset by horizontalSpace
+ #center place elements horizontally centered; ignore horizontalSpace
+ #right place it at the right
+ #rightSpace place it at the right, offset by horizontalSpace
+ #fit resize elements horizontally to fit this panel; ignore horizontalSpace
+ #fitSpace like #fit, but add spacing; ignore horizontalSpace
+
+ #leftMax like #left, but resize elements to max of them
+ #leftSpaceMax like #leftSpace, but resize elements
+ #centerMax like #center, but resize elements
+ #rightMax like #right, but resize elements to max of them
+ #rightSpaceMax like #rightSpace, but resize elements
+ the default (if never changed) is #centered
+ "
+
+ (hLayout ~~ aSymbol) ifTrue:[
+ hLayout := aSymbol.
+ self layoutChanged
+ ]
+!
+
+layout
+ "leftover for historic reasons - do not use any more"
+
+ self obsoleteMethodWarning:'use #verticalLayout'.
+ ^ self verticalLayout
+!
+
+layout:something
+ "OBSOLETE compatibility interface. Will vanish.
+ leftover for historic reasons - do not use any more.
+ In the meantime, try to figure out what is meant ... a kludge"
+
+ something isLayout ifTrue:[^ super layout:something].
+
+ self obsoleteMethodWarning:'use #verticalLayout:'.
+ ^ self verticalLayout:something
+
+ "Modified: 31.8.1995 / 23:08:54 / claus"
+!
+
+verticalLayout
+ "return the vertical layout as a symbol.
+ the returned value is one of
+ #top arrange elements at the top
+ #topSpace arrange elements at the top, start with spacing
+ #bottom arrange elements at the bottom
+ #bottomSpace arrange elements at the bottom, start with spacing
+ #center arrange elements in the center; ignore verticalSpace
+ #spread spread elements evenly; ignore verticalSpace
+ #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
+ #fit like #spread, but resize elements for tight packing; ignore verticalSpace
+ #fitSpace like #fit, with spacing; ignore verticalSpace
+ #topFit like #top, but extend the last element to the bottom
+ #topSpaceFit like #topSpace, but extend the last element to the bottom
+ the default is #centered
+ "
+
+ ^ vLayout
+!
+
+verticalLayout:aSymbol
+ "change the vertical layout as a symbol.
+ The argument, aSymbol must be one of:
+ #top arrange elements at the top
+ #topSpace arrange elements at the top, start with spacing
+ #bottom arrange elements at the bottom
+ #bottomSpace arrange elements at the bottom, start with spacing
+ #center arrange elements in the center; ignore verticalSpace
+ #spread spread elements evenly; ignore verticalSpace
+ #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
+ #fit like #spread, but resize elements for tight packing; ignore verticalSpace
+ #fitSpace like #fit, with spacing; ignore verticalSpace
+ #topFit like #top, but extend the last element to the bottom
+ #topSpaceFit like #topSpace, but extend the last element to the bottom
+ the default (if never changed) is #centered
+ "
+
+ (vLayout ~~ aSymbol) ifTrue:[
+ vLayout := aSymbol.
+ self layoutChanged
+ ]
! !
!VerticalPanelView methodsFor:'layout'!
@@ -740,118 +850,6 @@
"Modified: 4.9.1995 / 18:43:29 / claus"
! !
-!VerticalPanelView methodsFor:'accessing'!
-
-horizontalLayout
- "return the horizontal layout as symbol.
- the returned value is one of
- #left place element at the left
- #leftSpace place element at the left, offset by horizontalSpace
- #center place elements horizontally centered; ignore horizontalSpace
- #right place it at the right
- #rightSpace place it at the right, offset by horizontalSpace
- #fit resize elements horizontally to fit this panel; ignore horizontalSpace
- #fitSpace like #fit, but add spacing; ignore horizontalSpace
-
- #leftMax like #left, but resize elements to max of them
- #leftSpaceMax like #leftSpace, but resize elements
- #centerMax like #center, but resize elements
- #rightMax like #right, but resize elements to max of them
- #rightSpaceMax like #rightSpace, but resize elements
- the default is #centered
- "
-
- ^ hLayout
-!
-
-horizontalLayout:aSymbol
- "change the horizontal layout as symbol.
- The argument, aSymbol must be one of:
- #left place element at the left
- #leftSpace place element at the left, offset by horizontalSpace
- #center place elements horizontally centered; ignore horizontalSpace
- #right place it at the right
- #rightSpace place it at the right, offset by horizontalSpace
- #fit resize elements horizontally to fit this panel; ignore horizontalSpace
- #fitSpace like #fit, but add spacing; ignore horizontalSpace
-
- #leftMax like #left, but resize elements to max of them
- #leftSpaceMax like #leftSpace, but resize elements
- #centerMax like #center, but resize elements
- #rightMax like #right, but resize elements to max of them
- #rightSpaceMax like #rightSpace, but resize elements
- the default (if never changed) is #centered
- "
-
- (hLayout ~~ aSymbol) ifTrue:[
- hLayout := aSymbol.
- self layoutChanged
- ]
-!
-
-verticalLayout
- "return the vertical layout as a symbol.
- the returned value is one of
- #top arrange elements at the top
- #topSpace arrange elements at the top, start with spacing
- #bottom arrange elements at the bottom
- #bottomSpace arrange elements at the bottom, start with spacing
- #center arrange elements in the center; ignore verticalSpace
- #spread spread elements evenly; ignore verticalSpace
- #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
- #fit like #spread, but resize elements for tight packing; ignore verticalSpace
- #fitSpace like #fit, with spacing; ignore verticalSpace
- #topFit like #top, but extend the last element to the bottom
- #topSpaceFit like #topSpace, but extend the last element to the bottom
- the default is #centered
- "
-
- ^ vLayout
-!
-
-verticalLayout:aSymbol
- "change the vertical layout as a symbol.
- The argument, aSymbol must be one of:
- #top arrange elements at the top
- #topSpace arrange elements at the top, start with spacing
- #bottom arrange elements at the bottom
- #bottomSpace arrange elements at the bottom, start with spacing
- #center arrange elements in the center; ignore verticalSpace
- #spread spread elements evenly; ignore verticalSpace
- #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
- #fit like #spread, but resize elements for tight packing; ignore verticalSpace
- #fitSpace like #fit, with spacing; ignore verticalSpace
- #topFit like #top, but extend the last element to the bottom
- #topSpaceFit like #topSpace, but extend the last element to the bottom
- the default (if never changed) is #centered
- "
-
- (vLayout ~~ aSymbol) ifTrue:[
- vLayout := aSymbol.
- self layoutChanged
- ]
-!
-
-layout:something
- "OBSOLETE compatibility interface. Will vanish.
- leftover for historic reasons - do not use any more.
- In the meantime, try to figure out what is meant ... a kludge"
-
- something isLayout ifTrue:[^ super layout:something].
-
- self obsoleteMethodWarning:'use #verticalLayout:'.
- ^ self verticalLayout:something
-
- "Modified: 31.8.1995 / 23:08:54 / claus"
-!
-
-layout
- "leftover for historic reasons - do not use any more"
-
- self obsoleteMethodWarning:'use #verticalLayout'.
- ^ self verticalLayout
-! !
-
!VerticalPanelView methodsFor:'queries'!
preferredExtent
--- a/VarHPanel.st Thu Nov 23 11:44:18 1995 +0100
+++ b/VarHPanel.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:10:40 am'!
-
VariableVerticalPanel subclass:#VariableHorizontalPanel
instanceVariableNames:''
classVariableNames:'DefaultCursor'
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.15 1995-11-14 20:27:51 cg Exp $'
-!
-
documentation
"
a View to separate its subviews horizontally by a movable bar
@@ -91,6 +85,135 @@
corner:1.0 @ 1.0.
top open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.16 1995-11-23 14:36:56 cg Exp $'
+! !
+
+!VariableHorizontalPanel methodsFor:'drawing'!
+
+drawHandleAtX:hx y:hy
+ |w x m|
+
+ shadowForm notNil ifTrue:[
+ w := shadowForm width
+ ] ifFalse:[
+ w := barHeight - 4
+ ].
+
+ self paint:viewBackground.
+ self fillRectangleX:hx y:margin
+ width:barHeight
+ height:(height - margin - margin).
+
+ (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
+ m := (barHeight - w) // 2.
+ shadowForm isNil ifTrue:[
+ x := hx + (barHeight // 2).
+ separatingLine ifTrue:[
+ self paint:shadowColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ x := x + 1.
+ self paint:lightColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ ].
+ self paint:viewBackground.
+ self fillRectangleX:hx y:(hy - barWidth)
+ width:w
+ height:(barWidth + barWidth).
+
+ handleStyle == #line ifTrue:[
+ self paint:handleColor.
+ self displayLineFromX:x y:hy - barWidth toX:x y:hy + barWidth.
+ ] ifFalse:[
+ x := hx.
+ handleStyle == #st80 ifTrue:[
+ x := x - 1.
+ ].
+ self drawEdgesForX:(x + m)
+ y:(hy - barWidth)
+ width:w
+ height:(barWidth + barWidth)
+ level:handleLevel.
+ handleStyle == #iris ifTrue:[
+ self paint:handleColor.
+ self fillDeviceRectangleX:(x + m + 2)
+ y:(hy - barWidth + 2)
+ width:w - 4
+ height:(barWidth + barWidth - 4)
+ ].
+ ]
+ ] ifFalse:[
+ x := hx.
+ self drawHandleFormAtX:(x + m) y:hy
+ ].
+ handleStyle == #st80 ifTrue:[
+ x := hx - 1.
+ self paint:lightColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ self displayLineFromX:hx y:0 toX:(hx + barHeight - 1) y:0.
+ x := hx + barHeight - 2.
+ self paint:shadowColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ "uncomment the -1 if you dont like the notch at the bottom end"
+ " VVV"
+ self displayLineFromX:hx" "-1" " y:height-1 toX:(hx + barHeight - 1) y:height-1.
+ ].
+ ] ifFalse:[
+ x := hx + barHeight - 1.
+ self paint:handleColor.
+ separatingLine ifTrue:[
+ self displayLineFromX:hx+1 y:0 toX:hx+1 y:height.
+ self displayLineFromX:x y:0 toX:x y:height.
+ ].
+ self fillRectangleX:hx y:hy width:barHeight height:barWidth
+ ]
+
+ "Modified: 14.11.1995 / 20:30:12 / cg"
+!
+
+invertHandleBarAtX:hx y:hy
+ self noClipByChildren.
+ self xoring:[
+ |x|
+
+ trackLine ifTrue:[
+ x := hx + (barHeight // 2).
+ self displayLineFromX:x y:0 toX:x y:height.
+ ] ifFalse:[
+ self fillRectangleX:hx y:0 width:barHeight height:height
+ ]
+ ].
+ self clipByChildren.
+! !
+
+!VariableHorizontalPanel methodsFor:'initializing'!
+
+defaultControllerClass
+ ^ VariableHorizontalPanelController
+!
+
+initCursor
+ "set the cursor - a horizontal double arrow"
+
+ DefaultCursor notNil ifTrue:[
+ cursor := DefaultCursor
+ ] ifFalse:[
+ cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
+ maskForm:(Form fromFile:'VHPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor leftRightArrow
+ "cursor := Cursor leftLimitArrow"
+ ].
+ DefaultCursor := cursor
+ ]
! !
!VariableHorizontalPanel methodsFor:'private'!
@@ -197,33 +320,6 @@
]
!
-setupSubviewSizes
- "setup subviews sizes (in case of non-relative sizes)"
-
- |x w |
-
- self anyNonRelativeSubviews ifTrue:[
- "there is at least one subview without
- relative origin/extent - setup all subviews
- to spread evenly ..."
-
- x := 0.0.
- w := 1.0 / (subViews size).
-
- 1 to:(subViews size) do:[:index |
- |view|
-
- view := subViews at:index.
- index == subViews size ifTrue:[
- view origin:(x @ 0.0) corner:(1.0 @ 1.0)
- ] ifFalse:[
- view origin:(x @ 0.0) corner:((x + w) @ 1.0)
- ].
- x := x + w
- ]
- ]
-!
-
setupSubviewOrigins
"setup subviews origins (SV 16.1.95)"
@@ -251,130 +347,32 @@
].
]
-! !
-
-!VariableHorizontalPanel methodsFor:'initializing'!
-
-initCursor
- "set the cursor - a horizontal double arrow"
-
- DefaultCursor notNil ifTrue:[
- cursor := DefaultCursor
- ] ifFalse:[
- cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
- maskForm:(Form fromFile:'VHPanel_m.xbm')
- hotX:8
- hotY:8.
- "
- if bitmaps are not available, use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor leftRightArrow
- "cursor := Cursor leftLimitArrow"
- ].
- DefaultCursor := cursor
- ]
!
-defaultControllerClass
- ^ VariableHorizontalPanelController
+setupSubviewSizes
+ "setup subviews sizes (in case of non-relative sizes)"
+
+ |x w |
+
+ self anyNonRelativeSubviews ifTrue:[
+ "there is at least one subview without
+ relative origin/extent - setup all subviews
+ to spread evenly ..."
+
+ x := 0.0.
+ w := 1.0 / (subViews size).
+
+ 1 to:(subViews size) do:[:index |
+ |view|
+
+ view := subViews at:index.
+ index == subViews size ifTrue:[
+ view origin:(x @ 0.0) corner:(1.0 @ 1.0)
+ ] ifFalse:[
+ view origin:(x @ 0.0) corner:((x + w) @ 1.0)
+ ].
+ x := x + w
+ ]
+ ]
! !
-!VariableHorizontalPanel methodsFor:'drawing'!
-
-drawHandleAtX:hx y:hy
- |w x m|
-
- shadowForm notNil ifTrue:[
- w := shadowForm width
- ] ifFalse:[
- w := barHeight - 4
- ].
-
- self paint:viewBackground.
- self fillRectangleX:hx y:margin
- width:barHeight
- height:(height - margin - margin).
-
- (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
- m := (barHeight - w) // 2.
- shadowForm isNil ifTrue:[
- x := hx + (barHeight // 2).
- separatingLine ifTrue:[
- self paint:shadowColor.
- self displayLineFromX:x y:margin toX:x y:(height - margin).
- x := x + 1.
- self paint:lightColor.
- self displayLineFromX:x y:margin toX:x y:(height - margin).
- ].
- self paint:viewBackground.
- self fillRectangleX:hx y:(hy - barWidth)
- width:w
- height:(barWidth + barWidth).
-
- handleStyle == #line ifTrue:[
- self paint:handleColor.
- self displayLineFromX:x y:hy - barWidth toX:x y:hy + barWidth.
- ] ifFalse:[
- x := hx.
- handleStyle == #st80 ifTrue:[
- x := x - 1.
- ].
- self drawEdgesForX:(x + m)
- y:(hy - barWidth)
- width:w
- height:(barWidth + barWidth)
- level:handleLevel.
- handleStyle == #iris ifTrue:[
- self paint:handleColor.
- self fillDeviceRectangleX:(x + m + 2)
- y:(hy - barWidth + 2)
- width:w - 4
- height:(barWidth + barWidth - 4)
- ].
- ]
- ] ifFalse:[
- x := hx.
- self drawHandleFormAtX:(x + m) y:hy
- ].
- handleStyle == #st80 ifTrue:[
- x := hx - 1.
- self paint:lightColor.
- self displayLineFromX:x y:margin toX:x y:(height - margin).
- self displayLineFromX:hx y:0 toX:(hx + barHeight - 1) y:0.
- x := hx + barHeight - 2.
- self paint:shadowColor.
- self displayLineFromX:x y:margin toX:x y:(height - margin).
- "uncomment the -1 if you dont like the notch at the bottom end"
- " VVV"
- self displayLineFromX:hx" "-1" " y:height-1 toX:(hx + barHeight - 1) y:height-1.
- ].
- ] ifFalse:[
- x := hx + barHeight - 1.
- self paint:handleColor.
- separatingLine ifTrue:[
- self displayLineFromX:hx+1 y:0 toX:hx+1 y:height.
- self displayLineFromX:x y:0 toX:x y:height.
- ].
- self fillRectangleX:hx y:hy width:barHeight height:barWidth
- ]
-
- "Modified: 14.11.1995 / 20:30:12 / cg"
-!
-
-invertHandleBarAtX:hx y:hy
- self noClipByChildren.
- self xoring:[
- |x|
-
- trackLine ifTrue:[
- x := hx + (barHeight // 2).
- self displayLineFromX:x y:0 toX:x y:height.
- ] ifFalse:[
- self fillRectangleX:hx y:0 width:barHeight height:height
- ]
- ].
- self clipByChildren.
-! !
-
--- a/VarVPanel.st Thu Nov 23 11:44:18 1995 +0100
+++ b/VarVPanel.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,15 +10,13 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:10:57 am'!
-
SimpleView subclass:#VariableVerticalPanel
instanceVariableNames:'barHeight barWidth separatingLine shadowForm lightForm showHandle
- handlePosition handleColor handleStyle handleLevel noColor trackLine
- redrawLocked'
+ handlePosition handleColor handleStyle handleLevel noColor
+ trackLine redrawLocked'
classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
- DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor DefaultHandleLevel
- DefaultCursor'
+ DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
+ DefaultHandleLevel DefaultCursor'
poolDictionaries:''
category:'Views-Layout'
!
@@ -39,10 +37,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.22 1995-11-14 20:27:45 cg Exp $'
-!
-
documentation
"
a View to separate its subviews vertically by a movable bar;
@@ -152,10 +146,26 @@
v3 origin:0.0 @ 0.8 corner:1.0 @ 1.0.
top open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.23 1995-11-23 14:37:11 cg Exp $'
! !
!VariableVerticalPanel class methodsFor:'defaults'!
+lightFormOn:aDisplay
+ "use same handle as Scroller"
+
+ ^ Scroller handleLightFormOn:aDisplay
+!
+
+shadowFormOn:aDisplay
+ "use same handle as Scroller"
+
+ ^ Scroller handleShadowFormOn:aDisplay
+!
+
updateStyleCache
DefaultShowHandle := StyleSheet at:'variablePanelShowHandle' default:true.
DefaultHandleStyle := StyleSheet at:'variablePanelHandleStyle'.
@@ -164,18 +174,104 @@
DefaultTrackingLine := StyleSheet at:'variablePanelTrackingLine' default:false.
DefaultSeparatingLine := StyleSheet at:'variablePanelSeparatingLine' default:false.
DefaultHandleColor := StyleSheet colorAt:'variablePanelHandleColor' default:Black.
+! !
+
+!VariableVerticalPanel methodsFor:'accessing'!
+
+add:aView
+ "a view is added; make its size relative (if not already done)"
+
+"obsolete" self halt.
+
+ super add:aView.
+ shown ifTrue:[
+ (superView isNil or:[superView shown]) ifTrue:[
+ self setupSubviewSizes
+ ]
+ ]
+!
+
+barHeight
+ "return the height of the separating bar"
+
+ ^ barHeight
+!
+
+barHeight:nPixel
+ "set the height of the separating bar"
+
+ barHeight := nPixel.
+
+ "if screen is very low-res, make certain bar is visible and catchable"
+ (barHeight < 4) ifTrue:[
+ barHeight := 4
+ ].
+
+ "make it even so spacing is equally spreadable among subviews"
+ barHeight odd ifTrue:[
+ barHeight := barHeight + 1
+ ]
+!
+
+handleLevel:aNumber
+ "define the 3D level of the handle (only with some styles).
+ Normally, this is defined via styleSheet files, but this entry allows
+ individual views to be manipulated."
+
+ handleLevel := aNumber
!
-shadowFormOn:aDisplay
- "use same handle as Scroller"
+handlePosition
+ "return the position of the handle"
+
+ ^ handlePosition
+!
+
+handlePosition:aSymbol
+ "define the position of the handle; the argument aSymbol
+ may be one of #left, #right or #center"
- ^ Scroller handleShadowFormOn:aDisplay
+ handlePosition := aSymbol
+!
+
+removeSubView:aView
+ "a view is removed; adjust other subviews sizes"
+
+ super removeSubView:aView.
+ shown ifTrue:[
+ (superView isNil or:[superView shown]) ifTrue:[
+ self setupSubviewSizes
+ ]
+ ]
!
-lightFormOn:aDisplay
- "use same handle as Scroller"
+style:styleSymbol
+ "define the style of the handle;
+ styleSymbol may be #motif to draw a little knob or
+ anything else to draw scrollBars handleForm.
+ Normally, this is defined via styleSheet files, but this entry allows
+ individual views to be manipulated."
- ^ Scroller handleLightFormOn:aDisplay
+ (styleSymbol ~~ handleStyle) ifTrue:[
+ handleStyle := styleSymbol.
+ handleStyle == #next ifTrue:[
+ shadowForm := self class shadowFormOn:device.
+ lightForm := self class lightFormOn:device.
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ shadowForm notNil ifTrue:[
+ (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
+ self barHeight:(shadowForm height + 2).
+ barWidth := shadowForm width
+ ]
+ ].
+ shown ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size).
+ self redraw
+ ]
+ ]
! !
!VariableVerticalPanel methodsFor:'drawing'!
@@ -263,32 +359,14 @@
"Modified: 14.11.1995 / 20:31:02 / cg"
!
-redrawHandlesFrom:start to:stop
- "redraw some handles"
-
- subViews notNil ifTrue:[
- showHandle ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- ]
- ]
-!
+drawHandleFormAtX:hx y:hy
+ "draw a handles bitmap at hx/hy"
-lockRedraw
- redrawLocked := true
-!
-
-unlockRedraw
- redrawLocked := false
-!
-
-redraw
- "redraw all of the handles"
-
- redrawLocked ~~ true ifTrue:[
- self redrawHandlesFrom:1 to:(subViews size)
- ]
+ self paint:shadowColor.
+ self displayForm:shadowForm x:hx y:hy.
+ self paint:lightColor.
+ self displayForm:lightForm x:hx y:hy.
+ self paint:viewBackground
!
invertHandleBarAtX:hx y:hy
@@ -306,116 +384,57 @@
self clipByChildren.
!
-drawHandleFormAtX:hx y:hy
- "draw a handles bitmap at hx/hy"
-
- self paint:shadowColor.
- self displayForm:shadowForm x:hx y:hy.
- self paint:lightColor.
- self displayForm:lightForm x:hx y:hy.
- self paint:viewBackground
-! !
-
-!VariableVerticalPanel methodsFor:'accessing'!
+lockRedraw
+ redrawLocked := true
+!
-barHeight:nPixel
- "set the height of the separating bar"
-
- barHeight := nPixel.
+redraw
+ "redraw all of the handles"
- "if screen is very low-res, make certain bar is visible and catchable"
- (barHeight < 4) ifTrue:[
- barHeight := 4
- ].
-
- "make it even so spacing is equally spreadable among subviews"
- barHeight odd ifTrue:[
- barHeight := barHeight + 1
+ redrawLocked ~~ true ifTrue:[
+ self redrawHandlesFrom:1 to:(subViews size)
]
!
-barHeight
- "return the height of the separating bar"
-
- ^ barHeight
-!
+redrawHandlesFrom:start to:stop
+ "redraw some handles"
-add:aView
- "a view is added; make its size relative (if not already done)"
-
-"obsolete" self halt.
-
- super add:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviewSizes
+ subViews notNil ifTrue:[
+ showHandle ifTrue:[
+ self handleOriginsFrom:start to:stop do:[:hPoint |
+ self drawHandleAtX:(hPoint x) y:(hPoint y)
+ ].
]
]
!
-removeSubView:aView
- "a view is removed; adjust other subviews sizes"
-
- super removeSubView:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviewSizes
- ]
- ]
-!
+unlockRedraw
+ redrawLocked := false
+! !
-handlePosition:aSymbol
- "define the position of the handle; the argument aSymbol
- may be one of #left, #right or #center"
-
- handlePosition := aSymbol
-!
+!VariableVerticalPanel methodsFor:'event handling'!
-handlePosition
- "return the position of the handle"
-
- ^ handlePosition
-!
-
-handleLevel:aNumber
- "define the 3D level of the handle (only with some styles).
- Normally, this is defined via styleSheet files, but this entry allows
- individual views to be manipulated."
+sizeChanged:how
+ "tell subviews if I change size"
- handleLevel := aNumber
-!
-
-style:styleSymbol
- "define the style of the handle;
- styleSymbol may be #motif to draw a little knob or
- anything else to draw scrollBars handleForm.
- Normally, this is defined via styleSheet files, but this entry allows
- individual views to be manipulated."
-
- (styleSymbol ~~ handleStyle) ifTrue:[
- handleStyle := styleSymbol.
- handleStyle == #next ifTrue:[
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
+ shown ifTrue:[
+ (how == #smaller) ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size)
] ifFalse:[
- shadowForm := lightForm := nil
- ].
-
- shadowForm notNil ifTrue:[
- (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
- self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width
- ]
- ].
- shown ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size).
- self redraw
+ self resizeSubviewsFrom:(subViews size) to:1
]
- ]
+ ].
+ self changed:#sizeOfView with:how.
! !
!VariableVerticalPanel methodsFor:'initializing'!
+defaultControllerClass
+ ^ VariableVerticalPanelController
+
+
+!
+
fixSize
extentChanged ifTrue:[
super fixSize.
@@ -425,9 +444,26 @@
]
!
-initialize
- super initialize.
- noColor := Color noColor.
+initCursor
+ "set the cursor - a double arrow"
+
+ DefaultCursor notNil ifTrue:[
+ cursor := DefaultCursor
+ ] ifFalse:[
+ cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
+ maskForm:(Form fromFile:'VVPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor upDownArrow
+ "cursor := Cursor upLimitArrow"
+ ].
+ DefaultCursor := cursor
+ ]
!
initStyle
@@ -471,36 +507,32 @@
].
!
-defaultControllerClass
- ^ VariableVerticalPanelController
-
-
-!
-
-initCursor
- "set the cursor - a double arrow"
-
- DefaultCursor notNil ifTrue:[
- cursor := DefaultCursor
- ] ifFalse:[
- cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
- maskForm:(Form fromFile:'VVPanel_m.xbm')
- hotX:8
- hotY:8.
- "
- if bitmaps are not available, use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor upDownArrow
- "cursor := Cursor upLimitArrow"
- ].
- DefaultCursor := cursor
- ]
+initialize
+ super initialize.
+ noColor := Color noColor.
! !
!VariableVerticalPanel methodsFor:'private'!
+anyNonRelativeSubviews
+ "return true, if any of my subviews has no relative origin/extent"
+
+ 1 to:(subViews size) do:[:index |
+ |view|
+
+ view := subViews at:index.
+ view relativeExtent isNil ifTrue:[^ true].
+ view relativeOrigin isNil ifTrue:[^ true]
+ ].
+ ^ false
+!
+
+handleOriginsDo:aBlock
+ "evaluate the argument block for every handle-origin"
+
+ self handleOriginsFrom:1 to:(subViews size) do:aBlock
+!
+
handleOriginsFrom:start to:stop do:aBlock
"evaluate the argument block for some handle-origins"
@@ -606,25 +638,6 @@
]
!
-handleOriginsDo:aBlock
- "evaluate the argument block for every handle-origin"
-
- self handleOriginsFrom:1 to:(subViews size) do:aBlock
-!
-
-anyNonRelativeSubviews
- "return true, if any of my subviews has no relative origin/extent"
-
- 1 to:(subViews size) do:[:index |
- |view|
-
- view := subViews at:index.
- view relativeExtent isNil ifTrue:[^ true].
- view relativeOrigin isNil ifTrue:[^ true]
- ].
- ^ false
-!
-
setupSubviewSizes
"setup subviews sizes (in case of non-relative sizes)"
@@ -652,17 +665,3 @@
]
! !
-!VariableVerticalPanel methodsFor:'event handling'!
-
-sizeChanged:how
- "tell subviews if I change size"
-
- shown ifTrue:[
- (how == #smaller) ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size)
- ] ifFalse:[
- self resizeSubviewsFrom:(subViews size) to:1
- ]
- ].
- self changed:#sizeOfView with:how.
-! !
--- a/VariableHorizontalPanel.st Thu Nov 23 11:44:18 1995 +0100
+++ b/VariableHorizontalPanel.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:10:40 am'!
-
VariableVerticalPanel subclass:#VariableHorizontalPanel
instanceVariableNames:''
classVariableNames:'DefaultCursor'
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.15 1995-11-14 20:27:51 cg Exp $'
-!
-
documentation
"
a View to separate its subviews horizontally by a movable bar
@@ -91,6 +85,135 @@
corner:1.0 @ 1.0.
top open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.16 1995-11-23 14:36:56 cg Exp $'
+! !
+
+!VariableHorizontalPanel methodsFor:'drawing'!
+
+drawHandleAtX:hx y:hy
+ |w x m|
+
+ shadowForm notNil ifTrue:[
+ w := shadowForm width
+ ] ifFalse:[
+ w := barHeight - 4
+ ].
+
+ self paint:viewBackground.
+ self fillRectangleX:hx y:margin
+ width:barHeight
+ height:(height - margin - margin).
+
+ (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
+ m := (barHeight - w) // 2.
+ shadowForm isNil ifTrue:[
+ x := hx + (barHeight // 2).
+ separatingLine ifTrue:[
+ self paint:shadowColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ x := x + 1.
+ self paint:lightColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ ].
+ self paint:viewBackground.
+ self fillRectangleX:hx y:(hy - barWidth)
+ width:w
+ height:(barWidth + barWidth).
+
+ handleStyle == #line ifTrue:[
+ self paint:handleColor.
+ self displayLineFromX:x y:hy - barWidth toX:x y:hy + barWidth.
+ ] ifFalse:[
+ x := hx.
+ handleStyle == #st80 ifTrue:[
+ x := x - 1.
+ ].
+ self drawEdgesForX:(x + m)
+ y:(hy - barWidth)
+ width:w
+ height:(barWidth + barWidth)
+ level:handleLevel.
+ handleStyle == #iris ifTrue:[
+ self paint:handleColor.
+ self fillDeviceRectangleX:(x + m + 2)
+ y:(hy - barWidth + 2)
+ width:w - 4
+ height:(barWidth + barWidth - 4)
+ ].
+ ]
+ ] ifFalse:[
+ x := hx.
+ self drawHandleFormAtX:(x + m) y:hy
+ ].
+ handleStyle == #st80 ifTrue:[
+ x := hx - 1.
+ self paint:lightColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ self displayLineFromX:hx y:0 toX:(hx + barHeight - 1) y:0.
+ x := hx + barHeight - 2.
+ self paint:shadowColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ "uncomment the -1 if you dont like the notch at the bottom end"
+ " VVV"
+ self displayLineFromX:hx" "-1" " y:height-1 toX:(hx + barHeight - 1) y:height-1.
+ ].
+ ] ifFalse:[
+ x := hx + barHeight - 1.
+ self paint:handleColor.
+ separatingLine ifTrue:[
+ self displayLineFromX:hx+1 y:0 toX:hx+1 y:height.
+ self displayLineFromX:x y:0 toX:x y:height.
+ ].
+ self fillRectangleX:hx y:hy width:barHeight height:barWidth
+ ]
+
+ "Modified: 14.11.1995 / 20:30:12 / cg"
+!
+
+invertHandleBarAtX:hx y:hy
+ self noClipByChildren.
+ self xoring:[
+ |x|
+
+ trackLine ifTrue:[
+ x := hx + (barHeight // 2).
+ self displayLineFromX:x y:0 toX:x y:height.
+ ] ifFalse:[
+ self fillRectangleX:hx y:0 width:barHeight height:height
+ ]
+ ].
+ self clipByChildren.
+! !
+
+!VariableHorizontalPanel methodsFor:'initializing'!
+
+defaultControllerClass
+ ^ VariableHorizontalPanelController
+!
+
+initCursor
+ "set the cursor - a horizontal double arrow"
+
+ DefaultCursor notNil ifTrue:[
+ cursor := DefaultCursor
+ ] ifFalse:[
+ cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
+ maskForm:(Form fromFile:'VHPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor leftRightArrow
+ "cursor := Cursor leftLimitArrow"
+ ].
+ DefaultCursor := cursor
+ ]
! !
!VariableHorizontalPanel methodsFor:'private'!
@@ -197,33 +320,6 @@
]
!
-setupSubviewSizes
- "setup subviews sizes (in case of non-relative sizes)"
-
- |x w |
-
- self anyNonRelativeSubviews ifTrue:[
- "there is at least one subview without
- relative origin/extent - setup all subviews
- to spread evenly ..."
-
- x := 0.0.
- w := 1.0 / (subViews size).
-
- 1 to:(subViews size) do:[:index |
- |view|
-
- view := subViews at:index.
- index == subViews size ifTrue:[
- view origin:(x @ 0.0) corner:(1.0 @ 1.0)
- ] ifFalse:[
- view origin:(x @ 0.0) corner:((x + w) @ 1.0)
- ].
- x := x + w
- ]
- ]
-!
-
setupSubviewOrigins
"setup subviews origins (SV 16.1.95)"
@@ -251,130 +347,32 @@
].
]
-! !
-
-!VariableHorizontalPanel methodsFor:'initializing'!
-
-initCursor
- "set the cursor - a horizontal double arrow"
-
- DefaultCursor notNil ifTrue:[
- cursor := DefaultCursor
- ] ifFalse:[
- cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
- maskForm:(Form fromFile:'VHPanel_m.xbm')
- hotX:8
- hotY:8.
- "
- if bitmaps are not available, use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor leftRightArrow
- "cursor := Cursor leftLimitArrow"
- ].
- DefaultCursor := cursor
- ]
!
-defaultControllerClass
- ^ VariableHorizontalPanelController
+setupSubviewSizes
+ "setup subviews sizes (in case of non-relative sizes)"
+
+ |x w |
+
+ self anyNonRelativeSubviews ifTrue:[
+ "there is at least one subview without
+ relative origin/extent - setup all subviews
+ to spread evenly ..."
+
+ x := 0.0.
+ w := 1.0 / (subViews size).
+
+ 1 to:(subViews size) do:[:index |
+ |view|
+
+ view := subViews at:index.
+ index == subViews size ifTrue:[
+ view origin:(x @ 0.0) corner:(1.0 @ 1.0)
+ ] ifFalse:[
+ view origin:(x @ 0.0) corner:((x + w) @ 1.0)
+ ].
+ x := x + w
+ ]
+ ]
! !
-!VariableHorizontalPanel methodsFor:'drawing'!
-
-drawHandleAtX:hx y:hy
- |w x m|
-
- shadowForm notNil ifTrue:[
- w := shadowForm width
- ] ifFalse:[
- w := barHeight - 4
- ].
-
- self paint:viewBackground.
- self fillRectangleX:hx y:margin
- width:barHeight
- height:(height - margin - margin).
-
- (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
- m := (barHeight - w) // 2.
- shadowForm isNil ifTrue:[
- x := hx + (barHeight // 2).
- separatingLine ifTrue:[
- self paint:shadowColor.
- self displayLineFromX:x y:margin toX:x y:(height - margin).
- x := x + 1.
- self paint:lightColor.
- self displayLineFromX:x y:margin toX:x y:(height - margin).
- ].
- self paint:viewBackground.
- self fillRectangleX:hx y:(hy - barWidth)
- width:w
- height:(barWidth + barWidth).
-
- handleStyle == #line ifTrue:[
- self paint:handleColor.
- self displayLineFromX:x y:hy - barWidth toX:x y:hy + barWidth.
- ] ifFalse:[
- x := hx.
- handleStyle == #st80 ifTrue:[
- x := x - 1.
- ].
- self drawEdgesForX:(x + m)
- y:(hy - barWidth)
- width:w
- height:(barWidth + barWidth)
- level:handleLevel.
- handleStyle == #iris ifTrue:[
- self paint:handleColor.
- self fillDeviceRectangleX:(x + m + 2)
- y:(hy - barWidth + 2)
- width:w - 4
- height:(barWidth + barWidth - 4)
- ].
- ]
- ] ifFalse:[
- x := hx.
- self drawHandleFormAtX:(x + m) y:hy
- ].
- handleStyle == #st80 ifTrue:[
- x := hx - 1.
- self paint:lightColor.
- self displayLineFromX:x y:margin toX:x y:(height - margin).
- self displayLineFromX:hx y:0 toX:(hx + barHeight - 1) y:0.
- x := hx + barHeight - 2.
- self paint:shadowColor.
- self displayLineFromX:x y:margin toX:x y:(height - margin).
- "uncomment the -1 if you dont like the notch at the bottom end"
- " VVV"
- self displayLineFromX:hx" "-1" " y:height-1 toX:(hx + barHeight - 1) y:height-1.
- ].
- ] ifFalse:[
- x := hx + barHeight - 1.
- self paint:handleColor.
- separatingLine ifTrue:[
- self displayLineFromX:hx+1 y:0 toX:hx+1 y:height.
- self displayLineFromX:x y:0 toX:x y:height.
- ].
- self fillRectangleX:hx y:hy width:barHeight height:barWidth
- ]
-
- "Modified: 14.11.1995 / 20:30:12 / cg"
-!
-
-invertHandleBarAtX:hx y:hy
- self noClipByChildren.
- self xoring:[
- |x|
-
- trackLine ifTrue:[
- x := hx + (barHeight // 2).
- self displayLineFromX:x y:0 toX:x y:height.
- ] ifFalse:[
- self fillRectangleX:hx y:0 width:barHeight height:height
- ]
- ].
- self clipByChildren.
-! !
-
--- a/VariableVerticalPanel.st Thu Nov 23 11:44:18 1995 +0100
+++ b/VariableVerticalPanel.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,15 +10,13 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:10:57 am'!
-
SimpleView subclass:#VariableVerticalPanel
instanceVariableNames:'barHeight barWidth separatingLine shadowForm lightForm showHandle
- handlePosition handleColor handleStyle handleLevel noColor trackLine
- redrawLocked'
+ handlePosition handleColor handleStyle handleLevel noColor
+ trackLine redrawLocked'
classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
- DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor DefaultHandleLevel
- DefaultCursor'
+ DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
+ DefaultHandleLevel DefaultCursor'
poolDictionaries:''
category:'Views-Layout'
!
@@ -39,10 +37,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.22 1995-11-14 20:27:45 cg Exp $'
-!
-
documentation
"
a View to separate its subviews vertically by a movable bar;
@@ -152,10 +146,26 @@
v3 origin:0.0 @ 0.8 corner:1.0 @ 1.0.
top open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.23 1995-11-23 14:37:11 cg Exp $'
! !
!VariableVerticalPanel class methodsFor:'defaults'!
+lightFormOn:aDisplay
+ "use same handle as Scroller"
+
+ ^ Scroller handleLightFormOn:aDisplay
+!
+
+shadowFormOn:aDisplay
+ "use same handle as Scroller"
+
+ ^ Scroller handleShadowFormOn:aDisplay
+!
+
updateStyleCache
DefaultShowHandle := StyleSheet at:'variablePanelShowHandle' default:true.
DefaultHandleStyle := StyleSheet at:'variablePanelHandleStyle'.
@@ -164,18 +174,104 @@
DefaultTrackingLine := StyleSheet at:'variablePanelTrackingLine' default:false.
DefaultSeparatingLine := StyleSheet at:'variablePanelSeparatingLine' default:false.
DefaultHandleColor := StyleSheet colorAt:'variablePanelHandleColor' default:Black.
+! !
+
+!VariableVerticalPanel methodsFor:'accessing'!
+
+add:aView
+ "a view is added; make its size relative (if not already done)"
+
+"obsolete" self halt.
+
+ super add:aView.
+ shown ifTrue:[
+ (superView isNil or:[superView shown]) ifTrue:[
+ self setupSubviewSizes
+ ]
+ ]
+!
+
+barHeight
+ "return the height of the separating bar"
+
+ ^ barHeight
+!
+
+barHeight:nPixel
+ "set the height of the separating bar"
+
+ barHeight := nPixel.
+
+ "if screen is very low-res, make certain bar is visible and catchable"
+ (barHeight < 4) ifTrue:[
+ barHeight := 4
+ ].
+
+ "make it even so spacing is equally spreadable among subviews"
+ barHeight odd ifTrue:[
+ barHeight := barHeight + 1
+ ]
+!
+
+handleLevel:aNumber
+ "define the 3D level of the handle (only with some styles).
+ Normally, this is defined via styleSheet files, but this entry allows
+ individual views to be manipulated."
+
+ handleLevel := aNumber
!
-shadowFormOn:aDisplay
- "use same handle as Scroller"
+handlePosition
+ "return the position of the handle"
+
+ ^ handlePosition
+!
+
+handlePosition:aSymbol
+ "define the position of the handle; the argument aSymbol
+ may be one of #left, #right or #center"
- ^ Scroller handleShadowFormOn:aDisplay
+ handlePosition := aSymbol
+!
+
+removeSubView:aView
+ "a view is removed; adjust other subviews sizes"
+
+ super removeSubView:aView.
+ shown ifTrue:[
+ (superView isNil or:[superView shown]) ifTrue:[
+ self setupSubviewSizes
+ ]
+ ]
!
-lightFormOn:aDisplay
- "use same handle as Scroller"
+style:styleSymbol
+ "define the style of the handle;
+ styleSymbol may be #motif to draw a little knob or
+ anything else to draw scrollBars handleForm.
+ Normally, this is defined via styleSheet files, but this entry allows
+ individual views to be manipulated."
- ^ Scroller handleLightFormOn:aDisplay
+ (styleSymbol ~~ handleStyle) ifTrue:[
+ handleStyle := styleSymbol.
+ handleStyle == #next ifTrue:[
+ shadowForm := self class shadowFormOn:device.
+ lightForm := self class lightFormOn:device.
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ shadowForm notNil ifTrue:[
+ (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
+ self barHeight:(shadowForm height + 2).
+ barWidth := shadowForm width
+ ]
+ ].
+ shown ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size).
+ self redraw
+ ]
+ ]
! !
!VariableVerticalPanel methodsFor:'drawing'!
@@ -263,32 +359,14 @@
"Modified: 14.11.1995 / 20:31:02 / cg"
!
-redrawHandlesFrom:start to:stop
- "redraw some handles"
-
- subViews notNil ifTrue:[
- showHandle ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- ]
- ]
-!
+drawHandleFormAtX:hx y:hy
+ "draw a handles bitmap at hx/hy"
-lockRedraw
- redrawLocked := true
-!
-
-unlockRedraw
- redrawLocked := false
-!
-
-redraw
- "redraw all of the handles"
-
- redrawLocked ~~ true ifTrue:[
- self redrawHandlesFrom:1 to:(subViews size)
- ]
+ self paint:shadowColor.
+ self displayForm:shadowForm x:hx y:hy.
+ self paint:lightColor.
+ self displayForm:lightForm x:hx y:hy.
+ self paint:viewBackground
!
invertHandleBarAtX:hx y:hy
@@ -306,116 +384,57 @@
self clipByChildren.
!
-drawHandleFormAtX:hx y:hy
- "draw a handles bitmap at hx/hy"
-
- self paint:shadowColor.
- self displayForm:shadowForm x:hx y:hy.
- self paint:lightColor.
- self displayForm:lightForm x:hx y:hy.
- self paint:viewBackground
-! !
-
-!VariableVerticalPanel methodsFor:'accessing'!
+lockRedraw
+ redrawLocked := true
+!
-barHeight:nPixel
- "set the height of the separating bar"
-
- barHeight := nPixel.
+redraw
+ "redraw all of the handles"
- "if screen is very low-res, make certain bar is visible and catchable"
- (barHeight < 4) ifTrue:[
- barHeight := 4
- ].
-
- "make it even so spacing is equally spreadable among subviews"
- barHeight odd ifTrue:[
- barHeight := barHeight + 1
+ redrawLocked ~~ true ifTrue:[
+ self redrawHandlesFrom:1 to:(subViews size)
]
!
-barHeight
- "return the height of the separating bar"
-
- ^ barHeight
-!
+redrawHandlesFrom:start to:stop
+ "redraw some handles"
-add:aView
- "a view is added; make its size relative (if not already done)"
-
-"obsolete" self halt.
-
- super add:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviewSizes
+ subViews notNil ifTrue:[
+ showHandle ifTrue:[
+ self handleOriginsFrom:start to:stop do:[:hPoint |
+ self drawHandleAtX:(hPoint x) y:(hPoint y)
+ ].
]
]
!
-removeSubView:aView
- "a view is removed; adjust other subviews sizes"
-
- super removeSubView:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviewSizes
- ]
- ]
-!
+unlockRedraw
+ redrawLocked := false
+! !
-handlePosition:aSymbol
- "define the position of the handle; the argument aSymbol
- may be one of #left, #right or #center"
-
- handlePosition := aSymbol
-!
+!VariableVerticalPanel methodsFor:'event handling'!
-handlePosition
- "return the position of the handle"
-
- ^ handlePosition
-!
-
-handleLevel:aNumber
- "define the 3D level of the handle (only with some styles).
- Normally, this is defined via styleSheet files, but this entry allows
- individual views to be manipulated."
+sizeChanged:how
+ "tell subviews if I change size"
- handleLevel := aNumber
-!
-
-style:styleSymbol
- "define the style of the handle;
- styleSymbol may be #motif to draw a little knob or
- anything else to draw scrollBars handleForm.
- Normally, this is defined via styleSheet files, but this entry allows
- individual views to be manipulated."
-
- (styleSymbol ~~ handleStyle) ifTrue:[
- handleStyle := styleSymbol.
- handleStyle == #next ifTrue:[
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
+ shown ifTrue:[
+ (how == #smaller) ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size)
] ifFalse:[
- shadowForm := lightForm := nil
- ].
-
- shadowForm notNil ifTrue:[
- (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
- self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width
- ]
- ].
- shown ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size).
- self redraw
+ self resizeSubviewsFrom:(subViews size) to:1
]
- ]
+ ].
+ self changed:#sizeOfView with:how.
! !
!VariableVerticalPanel methodsFor:'initializing'!
+defaultControllerClass
+ ^ VariableVerticalPanelController
+
+
+!
+
fixSize
extentChanged ifTrue:[
super fixSize.
@@ -425,9 +444,26 @@
]
!
-initialize
- super initialize.
- noColor := Color noColor.
+initCursor
+ "set the cursor - a double arrow"
+
+ DefaultCursor notNil ifTrue:[
+ cursor := DefaultCursor
+ ] ifFalse:[
+ cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
+ maskForm:(Form fromFile:'VVPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor upDownArrow
+ "cursor := Cursor upLimitArrow"
+ ].
+ DefaultCursor := cursor
+ ]
!
initStyle
@@ -471,36 +507,32 @@
].
!
-defaultControllerClass
- ^ VariableVerticalPanelController
-
-
-!
-
-initCursor
- "set the cursor - a double arrow"
-
- DefaultCursor notNil ifTrue:[
- cursor := DefaultCursor
- ] ifFalse:[
- cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
- maskForm:(Form fromFile:'VVPanel_m.xbm')
- hotX:8
- hotY:8.
- "
- if bitmaps are not available, use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor upDownArrow
- "cursor := Cursor upLimitArrow"
- ].
- DefaultCursor := cursor
- ]
+initialize
+ super initialize.
+ noColor := Color noColor.
! !
!VariableVerticalPanel methodsFor:'private'!
+anyNonRelativeSubviews
+ "return true, if any of my subviews has no relative origin/extent"
+
+ 1 to:(subViews size) do:[:index |
+ |view|
+
+ view := subViews at:index.
+ view relativeExtent isNil ifTrue:[^ true].
+ view relativeOrigin isNil ifTrue:[^ true]
+ ].
+ ^ false
+!
+
+handleOriginsDo:aBlock
+ "evaluate the argument block for every handle-origin"
+
+ self handleOriginsFrom:1 to:(subViews size) do:aBlock
+!
+
handleOriginsFrom:start to:stop do:aBlock
"evaluate the argument block for some handle-origins"
@@ -606,25 +638,6 @@
]
!
-handleOriginsDo:aBlock
- "evaluate the argument block for every handle-origin"
-
- self handleOriginsFrom:1 to:(subViews size) do:aBlock
-!
-
-anyNonRelativeSubviews
- "return true, if any of my subviews has no relative origin/extent"
-
- 1 to:(subViews size) do:[:index |
- |view|
-
- view := subViews at:index.
- view relativeExtent isNil ifTrue:[^ true].
- view relativeOrigin isNil ifTrue:[^ true]
- ].
- ^ false
-!
-
setupSubviewSizes
"setup subviews sizes (in case of non-relative sizes)"
@@ -652,17 +665,3 @@
]
! !
-!VariableVerticalPanel methodsFor:'event handling'!
-
-sizeChanged:how
- "tell subviews if I change size"
-
- shown ifTrue:[
- (how == #smaller) ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size)
- ] ifFalse:[
- self resizeSubviewsFrom:(subViews size) to:1
- ]
- ].
- self changed:#sizeOfView with:how.
-! !
--- a/VerticalPanelView.st Thu Nov 23 11:44:18 1995 +0100
+++ b/VerticalPanelView.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:07:08 pm'!
-
PanelView subclass:#VerticalPanelView
instanceVariableNames:''
classVariableNames:''
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.15 1995-11-11 16:23:31 cg Exp $'
-!
-
documentation
"
a View which arranges its child-views in a vertical column.
@@ -527,6 +521,122 @@
panel extent:(panel preferredExtent).
panel open
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.16 1995-11-23 14:37:40 cg Exp $'
+! !
+
+!VerticalPanelView methodsFor:'accessing'!
+
+horizontalLayout
+ "return the horizontal layout as symbol.
+ the returned value is one of
+ #left place element at the left
+ #leftSpace place element at the left, offset by horizontalSpace
+ #center place elements horizontally centered; ignore horizontalSpace
+ #right place it at the right
+ #rightSpace place it at the right, offset by horizontalSpace
+ #fit resize elements horizontally to fit this panel; ignore horizontalSpace
+ #fitSpace like #fit, but add spacing; ignore horizontalSpace
+
+ #leftMax like #left, but resize elements to max of them
+ #leftSpaceMax like #leftSpace, but resize elements
+ #centerMax like #center, but resize elements
+ #rightMax like #right, but resize elements to max of them
+ #rightSpaceMax like #rightSpace, but resize elements
+ the default is #centered
+ "
+
+ ^ hLayout
+!
+
+horizontalLayout:aSymbol
+ "change the horizontal layout as symbol.
+ The argument, aSymbol must be one of:
+ #left place element at the left
+ #leftSpace place element at the left, offset by horizontalSpace
+ #center place elements horizontally centered; ignore horizontalSpace
+ #right place it at the right
+ #rightSpace place it at the right, offset by horizontalSpace
+ #fit resize elements horizontally to fit this panel; ignore horizontalSpace
+ #fitSpace like #fit, but add spacing; ignore horizontalSpace
+
+ #leftMax like #left, but resize elements to max of them
+ #leftSpaceMax like #leftSpace, but resize elements
+ #centerMax like #center, but resize elements
+ #rightMax like #right, but resize elements to max of them
+ #rightSpaceMax like #rightSpace, but resize elements
+ the default (if never changed) is #centered
+ "
+
+ (hLayout ~~ aSymbol) ifTrue:[
+ hLayout := aSymbol.
+ self layoutChanged
+ ]
+!
+
+layout
+ "leftover for historic reasons - do not use any more"
+
+ self obsoleteMethodWarning:'use #verticalLayout'.
+ ^ self verticalLayout
+!
+
+layout:something
+ "OBSOLETE compatibility interface. Will vanish.
+ leftover for historic reasons - do not use any more.
+ In the meantime, try to figure out what is meant ... a kludge"
+
+ something isLayout ifTrue:[^ super layout:something].
+
+ self obsoleteMethodWarning:'use #verticalLayout:'.
+ ^ self verticalLayout:something
+
+ "Modified: 31.8.1995 / 23:08:54 / claus"
+!
+
+verticalLayout
+ "return the vertical layout as a symbol.
+ the returned value is one of
+ #top arrange elements at the top
+ #topSpace arrange elements at the top, start with spacing
+ #bottom arrange elements at the bottom
+ #bottomSpace arrange elements at the bottom, start with spacing
+ #center arrange elements in the center; ignore verticalSpace
+ #spread spread elements evenly; ignore verticalSpace
+ #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
+ #fit like #spread, but resize elements for tight packing; ignore verticalSpace
+ #fitSpace like #fit, with spacing; ignore verticalSpace
+ #topFit like #top, but extend the last element to the bottom
+ #topSpaceFit like #topSpace, but extend the last element to the bottom
+ the default is #centered
+ "
+
+ ^ vLayout
+!
+
+verticalLayout:aSymbol
+ "change the vertical layout as a symbol.
+ The argument, aSymbol must be one of:
+ #top arrange elements at the top
+ #topSpace arrange elements at the top, start with spacing
+ #bottom arrange elements at the bottom
+ #bottomSpace arrange elements at the bottom, start with spacing
+ #center arrange elements in the center; ignore verticalSpace
+ #spread spread elements evenly; ignore verticalSpace
+ #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
+ #fit like #spread, but resize elements for tight packing; ignore verticalSpace
+ #fitSpace like #fit, with spacing; ignore verticalSpace
+ #topFit like #top, but extend the last element to the bottom
+ #topSpaceFit like #topSpace, but extend the last element to the bottom
+ the default (if never changed) is #centered
+ "
+
+ (vLayout ~~ aSymbol) ifTrue:[
+ vLayout := aSymbol.
+ self layoutChanged
+ ]
! !
!VerticalPanelView methodsFor:'layout'!
@@ -740,118 +850,6 @@
"Modified: 4.9.1995 / 18:43:29 / claus"
! !
-!VerticalPanelView methodsFor:'accessing'!
-
-horizontalLayout
- "return the horizontal layout as symbol.
- the returned value is one of
- #left place element at the left
- #leftSpace place element at the left, offset by horizontalSpace
- #center place elements horizontally centered; ignore horizontalSpace
- #right place it at the right
- #rightSpace place it at the right, offset by horizontalSpace
- #fit resize elements horizontally to fit this panel; ignore horizontalSpace
- #fitSpace like #fit, but add spacing; ignore horizontalSpace
-
- #leftMax like #left, but resize elements to max of them
- #leftSpaceMax like #leftSpace, but resize elements
- #centerMax like #center, but resize elements
- #rightMax like #right, but resize elements to max of them
- #rightSpaceMax like #rightSpace, but resize elements
- the default is #centered
- "
-
- ^ hLayout
-!
-
-horizontalLayout:aSymbol
- "change the horizontal layout as symbol.
- The argument, aSymbol must be one of:
- #left place element at the left
- #leftSpace place element at the left, offset by horizontalSpace
- #center place elements horizontally centered; ignore horizontalSpace
- #right place it at the right
- #rightSpace place it at the right, offset by horizontalSpace
- #fit resize elements horizontally to fit this panel; ignore horizontalSpace
- #fitSpace like #fit, but add spacing; ignore horizontalSpace
-
- #leftMax like #left, but resize elements to max of them
- #leftSpaceMax like #leftSpace, but resize elements
- #centerMax like #center, but resize elements
- #rightMax like #right, but resize elements to max of them
- #rightSpaceMax like #rightSpace, but resize elements
- the default (if never changed) is #centered
- "
-
- (hLayout ~~ aSymbol) ifTrue:[
- hLayout := aSymbol.
- self layoutChanged
- ]
-!
-
-verticalLayout
- "return the vertical layout as a symbol.
- the returned value is one of
- #top arrange elements at the top
- #topSpace arrange elements at the top, start with spacing
- #bottom arrange elements at the bottom
- #bottomSpace arrange elements at the bottom, start with spacing
- #center arrange elements in the center; ignore verticalSpace
- #spread spread elements evenly; ignore verticalSpace
- #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
- #fit like #spread, but resize elements for tight packing; ignore verticalSpace
- #fitSpace like #fit, with spacing; ignore verticalSpace
- #topFit like #top, but extend the last element to the bottom
- #topSpaceFit like #topSpace, but extend the last element to the bottom
- the default is #centered
- "
-
- ^ vLayout
-!
-
-verticalLayout:aSymbol
- "change the vertical layout as a symbol.
- The argument, aSymbol must be one of:
- #top arrange elements at the top
- #topSpace arrange elements at the top, start with spacing
- #bottom arrange elements at the bottom
- #bottomSpace arrange elements at the bottom, start with spacing
- #center arrange elements in the center; ignore verticalSpace
- #spread spread elements evenly; ignore verticalSpace
- #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
- #fit like #spread, but resize elements for tight packing; ignore verticalSpace
- #fitSpace like #fit, with spacing; ignore verticalSpace
- #topFit like #top, but extend the last element to the bottom
- #topSpaceFit like #topSpace, but extend the last element to the bottom
- the default (if never changed) is #centered
- "
-
- (vLayout ~~ aSymbol) ifTrue:[
- vLayout := aSymbol.
- self layoutChanged
- ]
-!
-
-layout:something
- "OBSOLETE compatibility interface. Will vanish.
- leftover for historic reasons - do not use any more.
- In the meantime, try to figure out what is meant ... a kludge"
-
- something isLayout ifTrue:[^ super layout:something].
-
- self obsoleteMethodWarning:'use #verticalLayout:'.
- ^ self verticalLayout:something
-
- "Modified: 31.8.1995 / 23:08:54 / claus"
-!
-
-layout
- "leftover for historic reasons - do not use any more"
-
- self obsoleteMethodWarning:'use #verticalLayout'.
- ^ self verticalLayout
-! !
-
!VerticalPanelView methodsFor:'queries'!
preferredExtent