.
--- a/ArrButton.st Fri May 12 20:25:18 1995 +0200
+++ b/ArrButton.st Wed May 17 14:26:27 1995 +0200
@@ -18,6 +18,7 @@
DefaultBackgroundColor DefaultForegroundColor
DefaultActiveBackgroundColor DefaultActiveForegroundColor
DefaultEnteredBackgroundColor DefaultEnteredForegroundColor
+ DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel
DownArrowFormFile UpArrowFormFile
LeftArrowFormFile RightArrowFormFile'
poolDictionaries:''
@@ -28,7 +29,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.11 1995-02-06 00:51:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.12 1995-05-17 12:24:24 claus Exp $
'!
!ArrowButton class methodsFor:'documentation'!
@@ -49,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.11 1995-02-06 00:51:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.12 1995-05-17 12:24:24 claus Exp $
"
!
@@ -168,6 +169,9 @@
DefaultArrowStyle := StyleSheet at:'arrowButtonStyle' default:StyleSheet name.
DefaultArrowStyle := DefaultArrowStyle asSymbol.
+ DefaultArrowButtonActiveLevel := StyleSheet at:'arrowButtonActiveLevel' default:nil.
+ DefaultArrowButtonPassiveLevel := StyleSheet at:'arrowButtonPassiveLevel' default:nil.
+
DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.
DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.
DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.
@@ -555,15 +559,19 @@
].
arrowStyle := DefaultArrowStyle.
- "
- special treatment for motif arrows
- - they do not really fit into the general (bitmap) scheme ...
- "
- arrowStyle == #motif ifTrue:[
- onLevel := 0.
- offLevel := 0.
- self level:0.
- ]
+ DefaultArrowButtonActiveLevel notNil ifTrue:[onLevel := DefaultArrowButtonActiveLevel].
+ DefaultArrowButtonPassiveLevel notNil ifTrue:[offLevel := DefaultArrowButtonPassiveLevel].
+ offLevel ~~ level ifTrue:[self level:offLevel].
+
+"/ "
+"/ special treatment for motif arrows
+"/ - they do not really fit into the general (bitmap) scheme ...
+"/ "
+"/ arrowStyle == #motif ifTrue:[
+"/ onLevel := 0.
+"/ offLevel := 0.
+"/ self level:0.
+"/ ]
! !
!ArrowButton methodsFor:'redrawing'!
--- a/ArrowButton.st Fri May 12 20:25:18 1995 +0200
+++ b/ArrowButton.st Wed May 17 14:26:27 1995 +0200
@@ -18,6 +18,7 @@
DefaultBackgroundColor DefaultForegroundColor
DefaultActiveBackgroundColor DefaultActiveForegroundColor
DefaultEnteredBackgroundColor DefaultEnteredForegroundColor
+ DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel
DownArrowFormFile UpArrowFormFile
LeftArrowFormFile RightArrowFormFile'
poolDictionaries:''
@@ -28,7 +29,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.11 1995-02-06 00:51:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.12 1995-05-17 12:24:24 claus Exp $
'!
!ArrowButton class methodsFor:'documentation'!
@@ -49,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.11 1995-02-06 00:51:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.12 1995-05-17 12:24:24 claus Exp $
"
!
@@ -168,6 +169,9 @@
DefaultArrowStyle := StyleSheet at:'arrowButtonStyle' default:StyleSheet name.
DefaultArrowStyle := DefaultArrowStyle asSymbol.
+ DefaultArrowButtonActiveLevel := StyleSheet at:'arrowButtonActiveLevel' default:nil.
+ DefaultArrowButtonPassiveLevel := StyleSheet at:'arrowButtonPassiveLevel' default:nil.
+
DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.
DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.
DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.
@@ -555,15 +559,19 @@
].
arrowStyle := DefaultArrowStyle.
- "
- special treatment for motif arrows
- - they do not really fit into the general (bitmap) scheme ...
- "
- arrowStyle == #motif ifTrue:[
- onLevel := 0.
- offLevel := 0.
- self level:0.
- ]
+ DefaultArrowButtonActiveLevel notNil ifTrue:[onLevel := DefaultArrowButtonActiveLevel].
+ DefaultArrowButtonPassiveLevel notNil ifTrue:[offLevel := DefaultArrowButtonPassiveLevel].
+ offLevel ~~ level ifTrue:[self level:offLevel].
+
+"/ "
+"/ special treatment for motif arrows
+"/ - they do not really fit into the general (bitmap) scheme ...
+"/ "
+"/ arrowStyle == #motif ifTrue:[
+"/ onLevel := 0.
+"/ offLevel := 0.
+"/ self level:0.
+"/ ]
! !
!ArrowButton methodsFor:'redrawing'!
--- a/Button.st Fri May 12 20:25:18 1995 +0200
+++ b/Button.st Wed May 17 14:26:27 1995 +0200
@@ -39,7 +39,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.22 1995-05-12 18:23:34 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.23 1995-05-17 12:24:30 claus Exp $
'!
!Button class methodsFor:'documentation'!
@@ -60,7 +60,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.22 1995-05-12 18:23:34 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.23 1995-05-17 12:24:30 claus Exp $
"
!
@@ -903,7 +903,8 @@
"set the level of the button when pressed (i.e. how deep)"
onLevel := aNumber.
- controller pressed ifTrue:[
+ (controller notNil
+ and:[controller pressed]) ifTrue:[
self level:onLevel.
margin := onLevel abs max:offLevel abs.
self redraw
@@ -920,7 +921,8 @@
"set the level of the button when not pressed (i.e. how high)"
offLevel := aNumber.
- controller pressed ifFalse:[
+ (controller notNil
+ and:[controller pressed not]) ifTrue:[
self level:offLevel.
margin := onLevel abs max:offLevel abs.
self redraw
@@ -1102,8 +1104,8 @@
"turn the button off (if not already off)"
controller pressed ifTrue:[
+ self level:offLevel.
self turnOffWithoutRedraw.
- offLevel ~~ onLevel ifTrue:[self redrawEdges].
self redraw
]
!
@@ -1124,8 +1126,8 @@
"turn the button on (if not already on)"
controller pressed ifFalse:[
+ self level:onLevel.
self turnOnWithoutRedraw.
- offLevel ~~ onLevel ifTrue:[self redrawEdges].
self redraw
]
!
--- a/ButtonC.st Fri May 12 20:25:18 1995 +0200
+++ b/ButtonC.st Wed May 17 14:26:27 1995 +0200
@@ -39,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ButtonC.st,v 1.9 1995-05-10 02:29:13 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ButtonC.st,v 1.10 1995-05-17 12:24:35 claus Exp $
"
!
@@ -98,7 +98,7 @@
^ 0.2
! !
-!ButtonController methodsFor:'accessing'!
+!ButtonController methodsFor:'accessing-state'!
pressed
"return true, if I am pressed"
@@ -126,14 +126,38 @@
^ entered
!
+entered:aBoolean
+ entered := aBoolean
+!
+
+active:aBoolean
+ active := aBoolean
+!
+
+pressed:aBoolean
+ pressed := aBoolean
+! !
+
+!ButtonController methodsFor:'accessing-behavior'!
+
beTriggerOnDown
"make the receiver act on button press"
isTriggerOnDown := true
!
-active:aBoolean
- active := aBoolean
+beTriggerOnUp
+ "make the receiver act on button release"
+
+ isTriggerOnDown := false
+!
+
+triggerOnDown:aBoolean
+ "set/clear the flag which controls if the action block is to be evaluated
+ on press or on release.
+ (see also ST-80 compatibility methods beTriggerOn*)"
+
+ isTriggerOnDown := aBoolean
!
isTriggerOnDown
@@ -143,8 +167,18 @@
^ isTriggerOnDown
!
-pressed:aBoolean
- pressed := aBoolean
+beToggle
+ "make the receiver act like a toggle"
+
+ isTriggerOnDown := true.
+ isToggle := true
+!
+
+autoRepeat
+ "turn on autorepeat"
+
+ autoRepeat := true.
+ repeatBlock := [self repeat]
!
action:aBlock
@@ -161,13 +195,6 @@
]
!
-beToggle
- "make the receiver act like a toggle"
-
- isTriggerOnDown := true.
- isToggle := true
-!
-
pressAction:aBlock
"define the action to be performed on press"
@@ -180,32 +207,6 @@
releaseActionBlock := aBlock
!
-autoRepeat
- "turn on autorepeat"
-
- autoRepeat := true.
- repeatBlock := [self repeat]
-!
-
-entered:aBoolean
- entered := aBoolean
-!
-
-beTriggerOnUp
- "make the receiver act on button release"
-
- isTriggerOnDown := false
-!
-
-enable
- "enable the button"
-
- enabled ifFalse:[
- enabled := true.
- view redraw
- ]
-!
-
toggleNoAction
"toggle, but do NOT perform any action"
@@ -218,14 +219,6 @@
].
!
-triggerOnDown:aBoolean
- "set/clear the flag which controls if the action block is to be evaluated
- on press or on release.
- (see also ST-80 compatibility methods beTriggerOn*)"
-
- isTriggerOnDown := aBoolean
-!
-
toggle
"toggle and perform the action"
@@ -250,6 +243,15 @@
^ releaseActionBlock
!
+enable
+ "enable the button"
+
+ enabled ifFalse:[
+ enabled := true.
+ view redraw
+ ]
+!
+
disable
"disable the button"
--- a/ButtonController.st Fri May 12 20:25:18 1995 +0200
+++ b/ButtonController.st Wed May 17 14:26:27 1995 +0200
@@ -39,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ButtonController.st,v 1.9 1995-05-10 02:29:13 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ButtonController.st,v 1.10 1995-05-17 12:24:35 claus Exp $
"
!
@@ -98,7 +98,7 @@
^ 0.2
! !
-!ButtonController methodsFor:'accessing'!
+!ButtonController methodsFor:'accessing-state'!
pressed
"return true, if I am pressed"
@@ -126,14 +126,38 @@
^ entered
!
+entered:aBoolean
+ entered := aBoolean
+!
+
+active:aBoolean
+ active := aBoolean
+!
+
+pressed:aBoolean
+ pressed := aBoolean
+! !
+
+!ButtonController methodsFor:'accessing-behavior'!
+
beTriggerOnDown
"make the receiver act on button press"
isTriggerOnDown := true
!
-active:aBoolean
- active := aBoolean
+beTriggerOnUp
+ "make the receiver act on button release"
+
+ isTriggerOnDown := false
+!
+
+triggerOnDown:aBoolean
+ "set/clear the flag which controls if the action block is to be evaluated
+ on press or on release.
+ (see also ST-80 compatibility methods beTriggerOn*)"
+
+ isTriggerOnDown := aBoolean
!
isTriggerOnDown
@@ -143,8 +167,18 @@
^ isTriggerOnDown
!
-pressed:aBoolean
- pressed := aBoolean
+beToggle
+ "make the receiver act like a toggle"
+
+ isTriggerOnDown := true.
+ isToggle := true
+!
+
+autoRepeat
+ "turn on autorepeat"
+
+ autoRepeat := true.
+ repeatBlock := [self repeat]
!
action:aBlock
@@ -161,13 +195,6 @@
]
!
-beToggle
- "make the receiver act like a toggle"
-
- isTriggerOnDown := true.
- isToggle := true
-!
-
pressAction:aBlock
"define the action to be performed on press"
@@ -180,32 +207,6 @@
releaseActionBlock := aBlock
!
-autoRepeat
- "turn on autorepeat"
-
- autoRepeat := true.
- repeatBlock := [self repeat]
-!
-
-entered:aBoolean
- entered := aBoolean
-!
-
-beTriggerOnUp
- "make the receiver act on button release"
-
- isTriggerOnDown := false
-!
-
-enable
- "enable the button"
-
- enabled ifFalse:[
- enabled := true.
- view redraw
- ]
-!
-
toggleNoAction
"toggle, but do NOT perform any action"
@@ -218,14 +219,6 @@
].
!
-triggerOnDown:aBoolean
- "set/clear the flag which controls if the action block is to be evaluated
- on press or on release.
- (see also ST-80 compatibility methods beTriggerOn*)"
-
- isTriggerOnDown := aBoolean
-!
-
toggle
"toggle and perform the action"
@@ -250,6 +243,15 @@
^ releaseActionBlock
!
+enable
+ "enable the button"
+
+ enabled ifFalse:[
+ enabled := true.
+ view redraw
+ ]
+!
+
disable
"disable the button"
--- a/ChckTggle.st Fri May 12 20:25:18 1995 +0200
+++ b/ChckTggle.st Wed May 17 14:26:27 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.9 1995-05-12 18:23:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.10 1995-05-17 12:24:38 claus Exp $
'!
!CheckToggle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.9 1995-05-12 18:23:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.10 1995-05-17 12:24:38 claus Exp $
"
!
@@ -141,35 +141,59 @@
!CheckToggle class methodsFor:'defaults'!
-checkFormOn:aDevice
- "answer the form used when checkToggle is turned on"
+updateStyleCache
+ |checkFileName bits|
- DefaultCheckForm isNil ifTrue:[
- DefaultCheckForm := Form fromFile:'CheckOn.xbm'
+ checkFileName := StyleSheet at:'checkToggleBitmapFile' default:'CheckOn.xbm'.
+ checkFileName notNil ifTrue:[
+ DefaultCheckForm := Form fromFile:checkFileName
resolution:100
- on:aDevice
- ].
- DefaultCheckForm isNil ifTrue:[
- DefaultCheckForm :=
- Form width:16 height:16 fromArray:#[2r00000000 2r00000000
- 2r00000000 2r00000010
- 2r00000000 2r00000010
- 2r00000000 2r00000100
- 2r00000000 2r00000100
- 2r00000000 2r00001000
- 2r00000000 2r00001000
- 2r00000000 2r00010000
- 2r01000000 2r00010000
- 2r00100000 2r00100000
- 2r00010000 2r00100000
- 2r00001000 2r01000000
- 2r00000100 2r01000000
- 2r00000010 2r10000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000]
- on:aDevice
- ].
- ^ DefaultCheckForm
+ on:Display.
+ ] ifFalse:[
+ (StyleSheet at:'checkToggleStyle' default:#check) == #cross ifTrue:[
+ bits := #[2r10000000 2r00000001
+ 2r01000000 2r00000010
+ 2r00100000 2r00000100
+ 2r00010000 2r00001000
+ 2r00001000 2r00010000
+ 2r00000100 2r00100000
+ 2r00000010 2r01000000
+ 2r00000001 2r10000000
+ 2r00000001 2r10000000
+ 2r00000010 2r01000000
+ 2r00000100 2r00100000
+ 2r00001000 2r00010000
+ 2r00010000 2r00001000
+ 2r00100000 2r00000100
+ 2r01000000 2r00000010
+ 2r10000000 2r00000001]
+
+ ] ifFalse:[
+ bits := #[2r00000000 2r00000000
+ 2r00000000 2r00000010
+ 2r00000000 2r00000010
+ 2r00000000 2r00000100
+ 2r00000000 2r00000100
+ 2r00000000 2r00001000
+ 2r00000000 2r00001000
+ 2r00000000 2r00010000
+ 2r01000000 2r00010000
+ 2r00100000 2r00100000
+ 2r00010000 2r00100000
+ 2r00001000 2r01000000
+ 2r00000100 2r01000000
+ 2r00000010 2r10000000
+ 2r00000001 2r10000000
+ 2r00000000 2r00000000]
+ ].
+ DefaultCheckForm := Form width:16 height:16 fromArray:bits on:Display
+ ]
+!
+
+checkFormOn:aDevice
+ "return the form used when checkToggle is turned on"
+
+ ^ DefaultCheckForm on:aDevice.
! !
!CheckToggle methodsFor:'initialization'!
@@ -177,17 +201,23 @@
initialize
super initialize.
- onLevel := offLevel.
- activeLogo := self class checkFormOn:device.
- passiveLogo := nil.
- self form:activeLogo
+ self form:activeLogo "/ to let me compute some defaultExtent
!
initStyle
super initStyle.
+ onLevel := offLevel.
+ activeLogo := DefaultCheckForm on:device.
+ passiveLogo := nil.
+
self activeForegroundColor:(StyleSheet at:'checkToggleCheckColor' default:activeFgColor).
- showLamp := false
+ showLamp := false.
+ StyleSheet name == #mswindows ifTrue:[
+ self borderWidth:1; level:0.
+ onLevel := offLevel := 0.
+ activeBgColor := bgColor := Color white.
+ ]
! !
!CheckToggle methodsFor:'redrawing'!
--- a/CheckToggle.st Fri May 12 20:25:18 1995 +0200
+++ b/CheckToggle.st Wed May 17 14:26:27 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.9 1995-05-12 18:23:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.10 1995-05-17 12:24:38 claus Exp $
'!
!CheckToggle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.9 1995-05-12 18:23:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.10 1995-05-17 12:24:38 claus Exp $
"
!
@@ -141,35 +141,59 @@
!CheckToggle class methodsFor:'defaults'!
-checkFormOn:aDevice
- "answer the form used when checkToggle is turned on"
+updateStyleCache
+ |checkFileName bits|
- DefaultCheckForm isNil ifTrue:[
- DefaultCheckForm := Form fromFile:'CheckOn.xbm'
+ checkFileName := StyleSheet at:'checkToggleBitmapFile' default:'CheckOn.xbm'.
+ checkFileName notNil ifTrue:[
+ DefaultCheckForm := Form fromFile:checkFileName
resolution:100
- on:aDevice
- ].
- DefaultCheckForm isNil ifTrue:[
- DefaultCheckForm :=
- Form width:16 height:16 fromArray:#[2r00000000 2r00000000
- 2r00000000 2r00000010
- 2r00000000 2r00000010
- 2r00000000 2r00000100
- 2r00000000 2r00000100
- 2r00000000 2r00001000
- 2r00000000 2r00001000
- 2r00000000 2r00010000
- 2r01000000 2r00010000
- 2r00100000 2r00100000
- 2r00010000 2r00100000
- 2r00001000 2r01000000
- 2r00000100 2r01000000
- 2r00000010 2r10000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000]
- on:aDevice
- ].
- ^ DefaultCheckForm
+ on:Display.
+ ] ifFalse:[
+ (StyleSheet at:'checkToggleStyle' default:#check) == #cross ifTrue:[
+ bits := #[2r10000000 2r00000001
+ 2r01000000 2r00000010
+ 2r00100000 2r00000100
+ 2r00010000 2r00001000
+ 2r00001000 2r00010000
+ 2r00000100 2r00100000
+ 2r00000010 2r01000000
+ 2r00000001 2r10000000
+ 2r00000001 2r10000000
+ 2r00000010 2r01000000
+ 2r00000100 2r00100000
+ 2r00001000 2r00010000
+ 2r00010000 2r00001000
+ 2r00100000 2r00000100
+ 2r01000000 2r00000010
+ 2r10000000 2r00000001]
+
+ ] ifFalse:[
+ bits := #[2r00000000 2r00000000
+ 2r00000000 2r00000010
+ 2r00000000 2r00000010
+ 2r00000000 2r00000100
+ 2r00000000 2r00000100
+ 2r00000000 2r00001000
+ 2r00000000 2r00001000
+ 2r00000000 2r00010000
+ 2r01000000 2r00010000
+ 2r00100000 2r00100000
+ 2r00010000 2r00100000
+ 2r00001000 2r01000000
+ 2r00000100 2r01000000
+ 2r00000010 2r10000000
+ 2r00000001 2r10000000
+ 2r00000000 2r00000000]
+ ].
+ DefaultCheckForm := Form width:16 height:16 fromArray:bits on:Display
+ ]
+!
+
+checkFormOn:aDevice
+ "return the form used when checkToggle is turned on"
+
+ ^ DefaultCheckForm on:aDevice.
! !
!CheckToggle methodsFor:'initialization'!
@@ -177,17 +201,23 @@
initialize
super initialize.
- onLevel := offLevel.
- activeLogo := self class checkFormOn:device.
- passiveLogo := nil.
- self form:activeLogo
+ self form:activeLogo "/ to let me compute some defaultExtent
!
initStyle
super initStyle.
+ onLevel := offLevel.
+ activeLogo := DefaultCheckForm on:device.
+ passiveLogo := nil.
+
self activeForegroundColor:(StyleSheet at:'checkToggleCheckColor' default:activeFgColor).
- showLamp := false
+ showLamp := false.
+ StyleSheet name == #mswindows ifTrue:[
+ self borderWidth:1; level:0.
+ onLevel := offLevel := 0.
+ activeBgColor := bgColor := Color white.
+ ]
! !
!CheckToggle methodsFor:'redrawing'!
--- a/DialogBox.st Fri May 12 20:25:18 1995 +0200
+++ b/DialogBox.st Wed May 17 14:26:27 1995 +0200
@@ -14,8 +14,8 @@
ModalBox subclass:#DialogBox
instanceVariableNames:'buttonPanel okButton okAction abortButton abortAction
- acceptReturnAsOK yPosition leftIndent addedComponents
- inputFieldGroup acceptOnLeave accepted tabableElements'
+ acceptReturnAsOK yPosition leftIndent rightIndent bindings addedComponents
+ inputFieldGroup acceptOnLeave acceptValue tabableElements'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
@@ -25,7 +25,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/DialogBox.st,v 1.13 1995-05-10 02:29:19 claus Exp $
+$Header: /cvs/stx/stx/libwidg/DialogBox.st,v 1.14 1995-05-17 12:24:44 claus Exp $
"
!
@@ -64,7 +64,9 @@
yPosisition <Integer> current y position when adding components
- leftIndent <Integer> x position to use when adding components
+ leftIndent <Integer> left inset to use when adding components
+
+ rightIndent <Integer> right inset to use when adding components
addedComponents <Collection> programmatically added components
@@ -76,8 +78,10 @@
the last field is left. If false, the ok
button must be pressed to close the box.
- accepted <Boolean> after close: true if box was accepted
- (i.e. ok-Button was pressed)
+ acceptedValue v(<Boolean>) valueHolder on a boolean
+ after close: holds true if box was accepted
+ (i.e. ok-Button was pressed), false if box was
+ closed via cancel or window manager.
For compatibility with ST-80, this class is also available under
@@ -508,10 +512,10 @@
logDoits := Smalltalk logDoits asValue.
listOfLanguages := SelectionInList with:#('english'
+ 'french'
'german'
- 'french'
+ 'italian'
'spanish'
- 'italian'
).
listOfLanguages selection:(Language asString).
@@ -521,7 +525,7 @@
styleNames := dir select:[:aFileName | aFileName endsWith:'.style'].
styleNames := styleNames collect:[:aFileName | aFileName copyWithoutLast:6].
- listOfStyles := SelectionInList with:styleNames.
+ listOfStyles := SelectionInList with:styleNames sort.
listOfStyles selection:(View defaultStyle asString).
box := Dialog new.
@@ -547,14 +551,14 @@
panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:frame.
panel horizontalLayout:#leftSpace.
- panel add:(PopUpList on:listOfLanguages).
+ panel add:((PopUpList on:listOfLanguages) width:0.5).
box addComponent:frame.
frame := FramedBox label:'Style'.
panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:frame.
panel horizontalLayout:#leftSpace.
- panel add:(PopUpList on:listOfStyles).
+ panel add:((PopUpList on:listOfStyles) width:0.5).
box addComponent:frame.
box addAbortButton; addOkButton.
@@ -577,7 +581,6 @@
View defaultStyle:listOfStyles selection asSymbol.
]
]
-
"
!
@@ -595,7 +598,7 @@
"
! !
-!DialogBox class methodsFor:'startup'!
+!DialogBox class methodsFor:'common dialogs'!
request:aString
"launch a Dialog, which allows user to enter something.
@@ -857,8 +860,12 @@
!DialogBox methodsFor:'user actions'!
-accept
- "let all components accept (i.e. update their model from the values)"
+doAccept
+ "let all components accept (i.e. update their model from the values),
+ then set my accept value to true.
+ This is confusing: this method was originally called #accept,
+ but renamed for compatibility with ST-80, where #accept returns the
+ accept-valueHolder (which looks like a bad name to me ...)."
addedComponents notNil ifTrue:[
addedComponents do:[:aComponent |
@@ -867,7 +874,7 @@
]
].
].
- accepted := true.
+ acceptValue value:true.
!
lastFieldLeft
@@ -875,25 +882,26 @@
when the last field is left by Return-key or NextField-key"
acceptOnLeave ifTrue:[
- accepted := true.
+ acceptValue value:true.
self okPressed
].
!
okPressed
- "user pressed ok-button; make myself invisible and if an action was
- specified do it"
+ "sent by the okButton; user pressed ok-button
+ - make myself invisible and if an action was specified do it"
okButton notNil ifTrue:[okButton turnOffWithoutRedraw].
- self accept.
+ self doAccept.
self hideAndEvaluate:okAction.
!
abortPressed
- "user pressed abort button - hide myself and evaluate okAction"
+ "sent by the cancel button; user pressed abort button
+ - hide myself and evaluate okAction"
abortButton turnOffWithoutRedraw.
- accepted := false.
+ acceptValue value:false.
self hideAndEvaluate:abortAction
!
@@ -933,17 +941,6 @@
^ self addButton:okButton.
!
-XXaddOkButton:action
- "create an okButton - to be sent from redefined initialize
- methods in subclasses or when creating a box programmatically."
-
- okButton := Button okButton.
- action notNil ifTrue:[okButton action:action].
- okButton model:self; change:#okPressed.
- okButton isReturnButton:acceptReturnAsOK.
- ^ self addButton:okButton.
-!
-
addOkButton
"create an okButton - to be sent from redefined initialize
methods in subclasses or when creating a box programmatically.
@@ -987,8 +984,8 @@
aComponent height:height.
aComponent origin:0.0@yPosition;
width:1.0;
- leftInset:leftIndent+ViewSpacing;
- rightInset:ViewSpacing.
+ leftInset:leftIndent;
+ rightInset:rightIndent.
yPosition := yPosition + aComponent height.
^ aComponent
!
@@ -1001,7 +998,7 @@
aComponent extent:ext.
aComponent origin:0.0@yPosition;
leftInset:leftIndent;
- rightInset:ViewSpacing.
+ rightInset:rightIndent.
yPosition := yPosition + aComponent height.
^ aComponent
!
@@ -1170,6 +1167,12 @@
"
!
+addHorizontalLine
+ "add a horizontal line as separator"
+
+ self addComponent:(Separator new extent:1.0 @ 5).
+!
+
addVerticalSpace
"add a default vertical space (1 mm)"
@@ -1201,6 +1204,12 @@
will be located)."
leftIndent := aNumber.
+!
+
+rightIndent:aNumber
+ "set the right indent"
+
+ rightIndent := aNumber.
! !
!DialogBox methodsFor:'initialization'!
@@ -1211,7 +1220,7 @@
super initialize.
label := 'Dialog'.
- accepted := false.
+ acceptValue := false asValue.
mm := ViewSpacing.
@@ -1227,7 +1236,7 @@
layout:#spread.
yPosition := ViewSpacing.
- leftIndent := 0.
+ leftIndent := rightIndent := ViewSpacing.
"
|b|
@@ -1294,10 +1303,10 @@
!DialogBox methodsFor:'queries'!
accepted
- "after the box has closed: return true if accepted,
- false if canceled"
+ "after the box has closed:
+ return true if accepted, false if canceled"
- ^ accepted
+ ^ acceptValue value
!
positionOffset
@@ -1379,22 +1388,35 @@
aBlock notNil ifTrue:[aBlock value]
! !
-!DialogBox methodsFor:'accessing'!
+!DialogBox methodsFor:'accessing-elements'!
-okText:aString
- "define the text in the ok-button"
+name:element as:name
+ bindings isNil ifTrue:[
+ bindings := IdentityDictionary new.
+ ].
+ bindings at:name put:element
+!
- |oldSize|
+componentAt:name
+ bindings isNil ifTrue:[^ nil].
+ ^ bindings at:name ifAbsent:nil
+! !
- aString ~= okButton label ifTrue:[
- oldSize := okButton extent.
- okButton label:aString.
- okButton resize.
- okButton extent ~= oldSize ifTrue:[
- shown ifTrue:[self resize]
- ]
- ]
-!
+!DialogBox methodsFor:'accessing-models'!
+
+accept
+ "return the valueHolder holding true when the box
+ is accepted, false if closed via the windowManager or
+ the cancel button.
+ This is confusing: this method was originally called #acceptValue,
+ but renamed for compatibility with ST-80.
+ This looks like a bad name to me, since in most other situations, #accept
+ is used to force an accept, not to return some valueHolder ...)."
+
+ ^ acceptValue
+! !
+
+!DialogBox methodsFor:'accessing-behavior'!
okAction:aBlock
"define the action to be performed when ok is pressed"
@@ -1402,6 +1424,12 @@
okAction := aBlock
!
+abortAction:aBlock
+ "define the action to be performed when abort is pressed"
+
+ abortAction := aBlock
+!
+
action:aBlock
"set the action to be performed when user presses ok-button;
aBlock must be nil or a block. This method simply
@@ -1419,18 +1447,39 @@
okButton notNil ifTrue:[
okButton isReturnButton:aBoolean.
]
-!
+! !
+
+!DialogBox methodsFor:'accessing-components'!
okButton
- "return the okButton"
+ "return the okButton - this access is provided to allow
+ setting the buttons look (for example: colors or font)"
^ okButton
!
-abortAction:aBlock
- "define the action to be performed when abort is pressed"
+abortButton
+ "return the abortButton - this access is provided to allow
+ setting the buttons look (for example: colors or font)"
+
+ ^ abortButton
+! !
+
+!DialogBox methodsFor:'accessing'!
- abortAction := aBlock
+okText:aString
+ "define the text in the ok-button"
+
+ |oldSize|
+
+ aString ~= okButton label ifTrue:[
+ oldSize := okButton extent.
+ okButton label:aString.
+ okButton resize.
+ okButton extent ~= oldSize ifTrue:[
+ shown ifTrue:[self resize]
+ ]
+ ]
!
abortText:aString
@@ -1448,12 +1497,6 @@
]
!
-abortButton
- "return the abortButton"
-
- ^ abortButton
-!
-
okText:okString abortText:abortString
"set both texts displayed in the buttons"
--- a/EditField.st Fri May 12 20:25:18 1995 +0200
+++ b/EditField.st Wed May 17 14:26:27 1995 +0200
@@ -27,7 +27,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.22 1995-05-12 18:23:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.23 1995-05-17 12:24:53 claus Exp $
'!
!EditField class methodsFor:'documentation'!
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.22 1995-05-12 18:23:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.23 1995-05-17 12:24:53 claus Exp $
"
!
@@ -100,7 +100,7 @@
acceptOnReturn <Boolean> if true, leaving the field via return
automatically accepts the value into the model.
- Default is true.
+ Default is false.
"
!
@@ -297,6 +297,7 @@
field leftInset:ViewSpacing;
rightInset:ViewSpacing.
field model:model.
+ field acceptOnReturn:true.
top open.
model inspect.
@@ -315,6 +316,7 @@
field1 leftInset:ViewSpacing;
rightInset:ViewSpacing.
field1 model:model.
+ field1 acceptOnReturn:true.
top1 open.
top2 := StandardSystemView new.
@@ -324,6 +326,7 @@
field2 leftInset:ViewSpacing;
rightInset:ViewSpacing.
field2 model:model.
+ field2 acceptOnReturn:true.
top2 open.
two views on the same model (no accept on return):
@@ -485,6 +488,12 @@
!EditField class methodsFor:'defaults'!
defaultLeaveKeys
+ "return the set of keys which are taken as leave-keys.
+ If the field is in an enterFieldGroup, all leave keys will be
+ forwarded to the group and possible step to the next/previous field.
+ Also, if acceptOnLeave is true, leave keys will store the current
+ value into their model (if any)"
+
^ #(Return CursorUp CursorDown Next Previous Accept)
!
@@ -681,7 +690,7 @@
!
acceptOnReturn:aBoolean
- "set/clear the acceptOnReturn flag. The default is true."
+ "set/clear the acceptOnReturn flag. The default is false."
acceptOnReturn := aBoolean
!
@@ -799,7 +808,7 @@
nFullLinesShown := 1.
nLinesShown := 1.
immediateAccept := acceptOnLeave := false.
- acceptOnReturn := true.
+ acceptOnReturn := false. "/ true.
cursorShown := true.
leaveKeys := self class defaultLeaveKeys.
!
--- a/FontPanel.st Fri May 12 20:25:18 1995 +0200
+++ b/FontPanel.st Wed May 17 14:26:27 1995 +0200
@@ -17,7 +17,7 @@
DialogBox subclass:#FontPanel
instanceVariableNames:'previewField familyList faceList sizeList revertButton
currentFamily currentFace currentStyle currentFaceAndStyle
- currentSize'
+ currentSize selectedFont'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
@@ -27,7 +27,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.9 1995-03-25 22:20:15 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.10 1995-05-17 12:25:02 claus Exp $
"
!
@@ -113,23 +113,10 @@
!FontPanel methodsFor:'accessing'!
initialFont:aFont
- |family face style size|
+ "set the font to be selected initially"
- family := aFont family.
- face := aFont face.
- style := aFont style.
- size := aFont size.
- family notNil ifTrue:[
- self familySelected:family.
- face notNil ifTrue:[
- style notNil ifTrue:[
- self faceSelected:(face , '-' , style).
- size notNil ifTrue:[
- self sizeSelected:size
- ]
- ]
- ]
- ]
+ selectedFont := aFont.
+ self showSelectedFont
!
action:aBlock
@@ -156,8 +143,10 @@
].
familyList list:families
].
+ selectedFont notNil ifTrue:[
+ self showSelectedFont
+ ].
super realize
-
!
initialize
@@ -198,6 +187,7 @@
(familyLabel origin y + familyLabel height "+ ViewSpacing"))
corner:(1.0 @ 1.0).
familyList inset:ViewSpacing.
+ familyList := familyList scrolledView.
v2 := View origin:0.4@0.0 corner:0.8@1.0
in:fontBrowserView.
@@ -212,6 +202,7 @@
(faceLabel origin y + faceLabel height "+ ViewSpacing"))
corner:(1.0 @ 1.0).
faceList inset:ViewSpacing.
+ faceList := faceList scrolledView.
v3 := View origin:0.8@0.0 corner:1.0@1.0
in:fontBrowserView.
@@ -226,6 +217,7 @@
(sizeLabel origin y + sizeLabel height "+ ViewSpacing"))
corner:(1.0 @ 1.0).
sizeList inset:ViewSpacing.
+ sizeList := sizeList scrolledView.
familyList action:[:lineNr | self familySelected:(familyList selectionValue)].
faceList action:[:lineNr | self faceSelected:(faceList selectionValue)].
@@ -250,6 +242,26 @@
!FontPanel methodsFor:'private'!
+showSelectedFont
+ |fam face style sz|
+
+ fam := selectedFont family.
+ fam notNil ifTrue:[
+ self familySelected:fam.
+ face := selectedFont face.
+ face notNil ifTrue:[
+ style := selectedFont style.
+ style notNil ifTrue:[
+ self faceSelected:(face , '-' , style).
+ sz := selectedFont size.
+ sz notNil ifTrue:[
+ self sizeSelected:sz
+ ]
+ ]
+ ]
+ ]
+!
+
showPreview
shown ifTrue:[
previewField clear.
--- a/HScrBar.st Fri May 12 20:25:18 1995 +0200
+++ b/HScrBar.st Wed May 17 14:26:27 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.12 1995-05-12 18:24:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.13 1995-05-17 12:25:08 claus Exp $
'!
!HorizontalScrollBar class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.12 1995-05-12 18:24:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.13 1995-05-17 12:25:08 claus Exp $
"
!
@@ -273,11 +273,18 @@
].
"button around thumb"
-style == #motif ifTrue:[
- sep2 := sep2 + 1
-].
+ style == #motif ifTrue:[
+ sep2 := sep2 + 1
+ ].
+
button1 origin:(bwn @ bwn).
- button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
- thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
- thumb origin:((leftWidth - borderWidth + elementSpacing) @ bwn)
+ style == #os2 ifTrue:[
+ button2 origin:((leftWidth + thumbWidth + sep2 - margin) @ bwn).
+ thumb extent:((thumbWidth - margin - margin) @ thumbHeight).
+ thumb origin:((leftWidth - borderWidth + elementSpacing + margin) @ bwn)
+ ] ifFalse:[
+ button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
+ thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
+ thumb origin:((leftWidth - borderWidth + elementSpacing) @ bwn)
+ ].
! !
--- a/HorizontalScrollBar.st Fri May 12 20:25:18 1995 +0200
+++ b/HorizontalScrollBar.st Wed May 17 14:26:27 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.12 1995-05-12 18:24:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.13 1995-05-17 12:25:08 claus Exp $
'!
!HorizontalScrollBar class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.12 1995-05-12 18:24:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.13 1995-05-17 12:25:08 claus Exp $
"
!
@@ -273,11 +273,18 @@
].
"button around thumb"
-style == #motif ifTrue:[
- sep2 := sep2 + 1
-].
+ style == #motif ifTrue:[
+ sep2 := sep2 + 1
+ ].
+
button1 origin:(bwn @ bwn).
- button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
- thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
- thumb origin:((leftWidth - borderWidth + elementSpacing) @ bwn)
+ style == #os2 ifTrue:[
+ button2 origin:((leftWidth + thumbWidth + sep2 - margin) @ bwn).
+ thumb extent:((thumbWidth - margin - margin) @ thumbHeight).
+ thumb origin:((leftWidth - borderWidth + elementSpacing + margin) @ bwn)
+ ] ifFalse:[
+ button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
+ thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
+ thumb origin:((leftWidth - borderWidth + elementSpacing) @ bwn)
+ ].
! !
--- a/LSelBox.st Fri May 12 20:25:18 1995 +0200
+++ b/LSelBox.st Wed May 17 14:26:27 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.12 1995-05-09 01:55:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.13 1995-05-17 12:25:14 claus Exp $
'!
!ListSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.12 1995-05-09 01:55:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.13 1995-05-17 12:25:14 claus Exp $
"
!
@@ -163,6 +163,8 @@
enterField contents:(selectionList selectionValue).
self okPressed
].
+ enterField removeDependent:self. "dont want preferedExtent-changes"
+
"
mhm: the lists keyboard functions are disabled,
and input passed to the enterfield
@@ -213,6 +215,13 @@
!ListSelectionBox methodsFor:'accessing'!
+initialText:someString
+ "in addition to showing the initial text, also select it in the list"
+
+ super initialText:someString.
+ selectionList selectElement:someString.
+!
+
list:aList
"set the list to be displayed in selection list"
--- a/Label.st Fri May 12 20:25:18 1995 +0200
+++ b/Label.st Wed May 17 14:26:27 1995 +0200
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.22 1995-05-09 01:56:01 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.23 1995-05-17 12:25:17 claus Exp $
'!
!Label class methodsFor:'documentation'!
@@ -45,7 +45,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.22 1995-05-09 01:56:01 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.23 1995-05-17 12:25:17 claus Exp $
"
!
@@ -618,8 +618,6 @@
]
! !
-!
-
!Label methodsFor:'accessing-mvc'!
model:aModel
@@ -745,7 +743,10 @@
!
sizeFixed:aBoolean
- "set/clear the fix-size attribute (will not change size on label-change)"
+ "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
!
@@ -1022,7 +1023,7 @@
]
] ifFalse:[
numberOfLines := logo size.
- (numberOfLines == 1) ifTrue:[
+ (numberOfLines <= 1) ifTrue:[
logo := logo asString
]
].
--- a/ListSelectionBox.st Fri May 12 20:25:18 1995 +0200
+++ b/ListSelectionBox.st Wed May 17 14:26:27 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.12 1995-05-09 01:55:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.13 1995-05-17 12:25:14 claus Exp $
'!
!ListSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.12 1995-05-09 01:55:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.13 1995-05-17 12:25:14 claus Exp $
"
!
@@ -163,6 +163,8 @@
enterField contents:(selectionList selectionValue).
self okPressed
].
+ enterField removeDependent:self. "dont want preferedExtent-changes"
+
"
mhm: the lists keyboard functions are disabled,
and input passed to the enterfield
@@ -213,6 +215,13 @@
!ListSelectionBox methodsFor:'accessing'!
+initialText:someString
+ "in addition to showing the initial text, also select it in the list"
+
+ super initialText:someString.
+ selectionList selectElement:someString.
+!
+
list:aList
"set the list to be displayed in selection list"
--- a/ListView.st Fri May 12 20:25:18 1995 +0200
+++ b/ListView.st Wed May 17 14:26:27 1995 +0200
@@ -38,7 +38,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.27 1995-05-12 18:24:28 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.28 1995-05-17 12:25:24 claus Exp $
'!
!ListView class methodsFor:'documentation'!
@@ -59,7 +59,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.27 1995-05-12 18:24:28 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.28 1995-05-17 12:25:24 claus Exp $
"
!
@@ -330,6 +330,13 @@
!
list:aCollection
+ "set the contents (a collection of strings or list entries)
+ and scroll to top-left"
+
+ self list:aCollection expandTabs:true
+!
+
+list:aCollection expandTabs:expand
"set the contents (a collection of strings) and scroll to top-left"
|oldFirst oldLeft|
@@ -342,8 +349,10 @@
].
list := aCollection.
- list notNil ifTrue:[
- self expandTabs
+ expand ifTrue:[
+ list notNil ifTrue:[
+ self expandTabs
+ ]
].
widthOfWidestLine := nil. "/ i.e. unknown
oldFirst := firstLineShown.
@@ -1244,8 +1253,8 @@
"
font := font on:device.
^ numLines * fontHeight + textStartTop
- + (font descent) "makes it look better".
-"/ + (font descent * 2) "makes it look better".
+"/ + (font descent)
+ + (font descent * 2) "makes it look better".
"/ "it used to be that code - which is wrong"
"/ (nLinesShown == nFullLinesShown) ifTrue:[
@@ -2273,26 +2282,14 @@
DefaultFont notNil ifTrue:[font := DefaultFont on:device]
!
-initMargins
- device width <= 800 ifTrue:[
- "
- some more pixels of real estate ...
- "
- leftMargin := topMargin := 1
- ] ifFalse:[
- leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
- topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
- ].
- textStartLeft := leftMargin + margin.
- textStartTop := topMargin + margin.
- innerWidth := width - textStartLeft - margin.
-!
-
initialize
super initialize.
viewOrigin := 0@0.
- self initMargins.
+
+ topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
+ self leftMargin:(self horizontalPixelPerMillimeter:0.5) rounded.
+ textStartTop := topMargin + margin.
bitGravity := #NorthWest.
list := nil.
@@ -2321,7 +2318,8 @@
recompute margins and font parameters
- display may have different resolution/font sizes.
"
- self initMargins.
+ topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
+ self leftMargin:(self horizontalPixelPerMillimeter:0.5) rounded.
self getFontParameters
! !
--- a/MenuView.st Fri May 12 20:25:18 1995 +0200
+++ b/MenuView.st Wed May 17 14:26:27 1995 +0200
@@ -33,7 +33,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.26 1995-05-12 18:24:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.27 1995-05-17 12:25:35 claus Exp $
'!
!MenuView class methodsFor:'documentation'!
@@ -54,7 +54,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.26 1995-05-12 18:24:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.27 1995-05-17 12:25:35 claus Exp $
"
!
@@ -222,7 +222,14 @@
((style ~~ #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
@@ -789,6 +796,7 @@
indexOrName isString ifTrue:[
^ list indexOf:indexOrName
].
+ indexOrName isNil ifTrue:[^ 0].
^ indexOrName
!
@@ -1421,7 +1429,7 @@
index := self visibleLineToListLine:start.
index notNil ifTrue:[
[current <= stop] whileTrue:[
- line := self visibleAt:current.
+ line := (self visibleAt:current) string.
special := line notNil and:[
(line = '-')
--- a/PopUpList.st Fri May 12 20:25:18 1995 +0200
+++ b/PopUpList.st Wed May 17 14:26:27 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.14 1995-05-12 18:24:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.15 1995-05-17 12:25:44 claus Exp $
'!
!PopUpList class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.14 1995-05-12 18:24:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.15 1995-05-17 12:25:44 claus Exp $
"
!
@@ -299,6 +299,18 @@
!PopUpList methodsFor:'drawing'!
+showActive
+ "no need to redraw - will pop menu ontop of me anyway ..."
+
+ ^ self
+!
+
+showPassive
+ "no need to redraw - will redraw from unpopped menu anyway ..."
+
+ ^ self
+!
+
drawWith:fgColor and:bgColor
|mmH mmV mW mH|
@@ -319,7 +331,7 @@
!PopUpList methodsFor:'event handling'!
popMenu
- |org mv|
+ |org mv w|
menu notNil ifTrue:[
self turnOffWithoutRedraw.
@@ -330,7 +342,9 @@
"
mv := menu menuView.
mv create. "/ stupid: it resizes itself upon first create
- mv width:(self width - (2 * menu margin) - (menu borderWidth*2)).
+ w := mv width. "/ to its preferred size.
+ w := w max:(self width - (2 * menu margin) - (menu borderWidth*2)).
+ mv width:w.
mv level:0; borderWidth:0.
"
--- a/PullDMenu.st Fri May 12 20:25:18 1995 +0200
+++ b/PullDMenu.st Wed May 17 14:26:27 1995 +0200
@@ -11,7 +11,7 @@
"
SimpleView subclass:#PullDownMenu
- instanceVariableNames:'menus titles selectors activeMenuNumber
+ instanceVariableNames:'receiver menus titles selectors activeMenuNumber
showSeparatingLines topMargin
fgColor bgColor activeFgColor activeBgColor
onLevel offLevel edgeStyle
@@ -24,7 +24,8 @@
DefaultHilightBackgroundColor
DefaultLevel DefaultHilightLevel
DefaultShadowColor DefaultLightColor
- DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep'
+ DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep
+ DefaultSeparatingLines'
poolDictionaries:''
category:'Views-Menus'
!
@@ -33,7 +34,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.17 1995-05-03 00:37:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.18 1995-05-17 12:25:49 claus Exp $
'!
!PullDownMenu class methodsFor:'documentation'!
@@ -54,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.17 1995-05-03 00:37:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.18 1995-05-17 12:25:49 claus Exp $
"
!
@@ -64,22 +65,49 @@
It controls display of its menus, which become visible when one of the
PullDownMenus entries is pressed.
+ A PullDownMenu itself consists of a single row of labels, which activate
+ a pulled menu when clicked. Entries may be empty (i.e. have no menu)
+ and empty entries may (optionally) also perform some action when clicked.
+ An entries selector is used as the key to define and access submenus
+ and (for empty entries:) the selector sent to the receiver of the menu.
+
Instance variables:
- menus <aCollection> the sub menus
- titles <aCollection> the strings in the menu
+ menus <Collection> the sub menus
+
+ titles <Collection> the strings in the menu
+
+ selectors <Collection> the selectors to send to the menu-
+ receiver (for empty pull-menus)
+ if nil (the default), title entries
+ do not send anything.
+
activeMenuNumber <Number> the index of the currently active menu
+
showSeparatingLines <Boolean> show separating lines between my menu-strings
+
topMargin <Number> number of pixels at top
- fgColor <Color> color to draw passive menu-titles
- bgColor <Color> color to draw passive menu-titles
- activeFgColor <Color> color to draw activated menu-titles
- activeBgColor <Color> color to draw activated menu-titles
- onLevel <Integer> level of entry-buttons when pressed
- offLevel <Integer> level of entry-buttons when released
+
+ fgColor <Color> fg color to draw passive menu-titles
+ bgColor <Color> bg color to draw passive menu-titles
+
+ activeFgColor <Color> fg color to draw activated menu-titles
+ activeBgColor <Color> bg color to draw activated menu-titles
+
+ onLevel <Integer> 3D level of entry-buttons when pressed
+ offLevel <Integer> 3D level of entry-buttons when released
+
+ edgeStyle <Symbol> how to draw edges
+
keepmenu <Boolean> if on, pulled menu stays on click,
till clicked again (motif & windows behavior)
+ toggleKeep <Boolean> if on and keepMenu is on,
+ clicking again on label closes menu
+
+ except menus, titles and selectors, instvars are usually defined from
+ defaults in the styleSheet; you should not care for them.
+
StyleSheet values:
@@ -104,150 +132,208 @@
pullDownMenuEdgeStyle edge style (nil or #soft)
pullDownMenuKeepMenu if true, pulled menu stays open until button
- is pressed again (motif behavior)
+ is pressed again outside of the item-area (motif behavior)
if false, menu closes on release (default)
pullDownMenuToggleKeep if true, pulled menu closes when an entry is pressed
- again. Otherwise, only press outside outside of
- the entry hides it.
- default is false
+ again. Otherwise, only press outside of the items area
+ hides it. default is false
pullDownMenuLevel level (3D only)
pullDownMenuFont font to use for the menu bar
default: menuFont
+
+ pullDownMenuShowSeparatingLines if true, lines are drawn between items.
+ default: false
"
!
examples
"
- |top menu|
+ |top menu|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
+ menu labels:#('foo' 'bar').
+ menu selectors:#(foo bar).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ menu at:#bar
+ putLabels:#('bar1' 'bar2' 'bar3')
+ selectors:#(bar1 bar2 bar3)
+ receiver:nil.
+ top open
+
+
- top := StandardSystemView new.
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- menu at:#bar
- putLabels:#('bar1' 'bar2' 'bar3')
- selectors:#(bar1 bar2 bar3)
- receiver:nil.
- top open
+ empty entries are possible as selectable items (with non-nil seletor) ...
+
+ |top menu|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
+ menu labels:#('foo' 'bar' 'baz').
+ menu selectors:#(foo bar baz).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ menu at:#baz
+ putLabels:#('baz1' 'baz2' 'baz3')
+ selectors:#(baz1 baz2 baz3)
+ receiver:nil.
+ top open
- 'empty entries are possible ...'
+ ... or as separators (with nil selector)
- |top menu|
+ |top menu|
+
+ top := StandardSystemView new.
+ top extent:500@200.
- top := StandardSystemView new.
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- top open
+ menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
+ menu labels:#('foo' ' ' 'bar' ' baz' ' ' 'moreFoo' 'moreBar' 'moreBaz').
+ menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ menu at:#bar
+ putLabels:#('bar1' 'bar2' 'bar3')
+ selectors:#(bar1 bar2 bar3)
+ receiver:nil.
+ menu at:#baz
+ putLabels:#('baz1' 'baz2' 'baz3')
+ selectors:#(baz1 baz2 baz3)
+ receiver:nil.
+ top open
- '... for example as separators'
+
+ use the menus default height
- |top menu|
+ |top menu|
+
+ top := StandardSystemView new.
+ top extent:300@300.
- top := StandardSystemView new.
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' ' ' 'bar' ' baz' ' ' 'moreFoo' 'moreBar' 'moreBaz').
- menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
- menu showSeparatingLines:true.
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- menu at:#bar
- putLabels:#('bar1' 'bar2' 'bar3')
- selectors:#(bar1 bar2 bar3)
- receiver:nil.
- menu at:#baz
- putLabels:#('baz1' 'baz2' 'baz3')
- selectors:#(baz1 baz2 baz3)
- receiver:nil.
- top open
+ menu := PullDownMenu in:top.
+ menu origin:0.0@0.0 corner:1.0@(menu height).
+ menu labels:#('foo' 'bar').
+ menu selectors:#(foo bar).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ top open
- 'use menus default height'
+ although you can change the font, colors etc (as shown below)
+ you should NOT do it - since if you do so, the styleSheet settings
+ are ineffective (which users wont like probably)
+ BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
+ pullDownMenuBackgroundColor and pullDownMenuFont
- |top menu|
+ |top menu|
- top := StandardSystemView new.
- menu := PullDownMenu in:top.
- menu origin:0.0@0.0 corner:1.0@(menu height).
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- top open
+ top := StandardSystemView new.
+ menu := PullDownMenu in:top.
+ menu font:(Font family:'courier' size:20).
+ menu foregroundColor:Color red.
+ menu backgroundColor:Color yellow.
+ menu viewBackground:Color yellow.
+ menu showSeparatingLines:true.
+ menu origin:0.0@0.0 corner:1.0@(menu height).
+ menu labels:#('foo' 'bar').
+ menu selectors:#(foo bar).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ (menu menuAt:#foo) font:(Font family:'courier' size:36).
+ top open
- 'although you can change the font, colors etc (as shown below)
- you should NOT do it - since if you do so, the styleSheet settings
- are ineffective (which users wont like probably)
- BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
- pullDownMenuBackgroundColor and pullDownMenuFont'
+ you can use icons, too ...
- |top menu|
+ |labels top menu|
+
+ top := StandardSystemView new.
+ top extent:300@300.
- top := StandardSystemView new.
- menu := PullDownMenu in:top.
- menu font:(Font family:'courier' size:20).
- menu foregroundColor:Color red.
- menu backgroundColor:Color yellow.
- menu viewBackground:Color yellow.
- menu showSeparatingLines:true.
-
- menu origin:0.0@0.0 corner:1.0@(menu height).
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- (menu menuAt:#foo) font:(Font family:'courier' size:36).
- top open
+ menu := PullDownMenu in:top.
+ menu origin:0.0@0.0 corner:1.0@(menu height).
+ labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
+ with:'foo'
+ with:'bar'.
+ menu labels:labels.
+ menu selectors:#(about foo bar).
+ menu at:#about
+ putLabels:#('about PullDownMenus')
+ selectors:#(aboutMenus)
+ receiver:nil.
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ top open
- 'you can use icons, too ...'
+ a concrete example (combining things described above)
+ (using a Plug, since we have no application class here):
+
+ |labels top menu textView appModel|
- |labels top menu|
+ appModel := Plug new.
+ appModel respondTo:#quit with:[top destroy].
+ appModel respondTo:#showAbout with:[self information:'some info here ...'].
+ appModel respondTo:#help with:[self information:'some help here ...'].
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ menu := PullDownMenu in:top.
+ menu receiver:appModel.
+ menu origin:0.0@0.0 corner:1.0@(menu height).
- top := StandardSystemView new.
- menu := PullDownMenu in:top.
- menu origin:0.0@0.0 corner:1.0@(menu height).
- labels := Array with:(Image fromFile:'SmalltalkX.xbm')
- with:'foo'
- with:'bar'.
- menu labels:labels.
- menu selectors:#(about foo bar).
- menu at:#about
- putLabels:#('about PullDownMenus')
- selectors:#(aboutMenus)
- receiver:nil.
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- top open
+ textView := ScrollableView forView:(EditTextView new).
+ textView origin:0.0@menu height corner:1.0@1.0.
+ top addSubView:textView.
+
+ labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
+ with:'file'
+ with:'edit'
+ with:'help'.
+ menu labels:labels.
+ menu selectors:#(about file edit help).
+ menu at:#about
+ putLabels:#('about PullDownMenus')
+ selectors:#(showAbout)
+ receiver:appModel.
+ menu at:#file
+ putLabels:#('quit')
+ selectors:#(quit)
+ receiver:appModel.
+ menu at:#edit
+ putLabels:#('copy' 'cut' 'paste')
+ selectors:#(copySelection cut paste)
+ receiver:textView.
+ top open
"
! !
@@ -292,6 +378,7 @@
DefaultFont isNil ifTrue:[
DefaultFont := StyleSheet fontAt:'menuFont'.
].
+ DefaultSeparatingLines := StyleSheet at:'pullDownMenuSeparatingLines' default:false.
"
PullDownMenu updateStyleCache
@@ -319,7 +406,7 @@
initStyle
super initStyle.
- showSeparatingLines := false.
+ showSeparatingLines := DefaultSeparatingLines. "/ false.
DefaultViewBackground notNil ifTrue:[
viewBackground := DefaultViewBackground on:device
].
@@ -389,10 +476,14 @@
!
recreate
- "if saved with an active menu, hide it"
+ "if the image was saved with an active menu, hide it"
+
+ |m|
activeMenuNumber notNil ifTrue:[
- (menus at:activeMenuNumber) unrealize.
+ (m := menus at:activeMenuNumber) notNil ifTrue:[
+ m unrealize.
+ ].
activeMenuNumber := nil.
].
super recreate.
@@ -405,10 +496,9 @@
!
destroy
- "
- have to destroy the menus manually here,
- since they are no real subviews of myself
- "
+ "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]
@@ -419,17 +509,69 @@
super destroy.
! !
-!PullDownMenu methodsFor:'accessing'!
+!PullDownMenu methodsFor:'accessing-look'!
showSeparatingLines:aBoolean
- "turn on/off drawing of separating lines"
+ "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 receiver:anObject
+ ]
+ ]
+!
+
numberOfTitles:n
"setup blank title-space to be filled in later"
@@ -476,24 +618,6 @@
selectors := selectorArray.
!
-font:aFont
- "adjust menu-origins when font changes"
-
- super font:(aFont on:device).
- self height:(font height + (font descent * 2)).
- shown ifTrue:[
- self setMenuOrigins
- ]
-!
-
-foregroundColor:aColor
- fgColor := aColor on:device
-!
-
-backgroundColor:aColor
- bgColor := aColor on:device
-!
-
menuAt:string
"return the menu with the title; return nil if not found"
@@ -666,8 +790,12 @@
"hide currently active menu - release grab if aBoolean is true
and a grab was set (keepMenu)"
+ |m|
+
activeMenuNumber notNil ifTrue:[
- (menus at:activeMenuNumber) unrealize.
+ (m := menus at:activeMenuNumber) notNil ifTrue:[
+ m unrealize.
+ ].
self unHighlightActiveTitle.
activeMenuNumber := nil
].
@@ -689,10 +817,17 @@
|subMenu|
activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
+ activeMenuNumber := aNumber.
subMenu := menus at:aNumber.
+
+ (activeMenuNumber notNil
+ and:[
+ subMenu notNil
+ or:[(selectors at:activeMenuNumber) notNil]]) ifTrue:[
+ self highlightActiveTitle.
+ ].
+
subMenu notNil ifTrue:[
- activeMenuNumber := aNumber.
- self highlightActiveTitle.
subMenu deselect.
subMenu create.
subMenu saveUnder:true.
@@ -712,8 +847,7 @@
!PullDownMenu methodsFor:'drawing '!
redraw
- |string
- x "{ Class: SmallInteger }"
+ |x "{ Class: SmallInteger }"
y "{ Class: SmallInteger }"
index "{ Class: SmallInteger }"
wSpace|
@@ -809,12 +943,13 @@
!PullDownMenu methodsFor:'submenu notifications'!
showActive
- "sent by a submenu to tell me that it started to perform
- its menu action"
+ "sent by a menu to tell me that it starts to perform
+ its menu action."
!
showPassive
- "sent by a submenu to tell me that it finished its menu-action."
+ "sent by a menu to tell me that it finished its menu-action.
+ Here, we hide the currently active menu."
self hideActiveMenu
!
@@ -827,8 +962,15 @@
!PullDownMenu methodsFor:'event handling'!
+showNoFocus
+ "when stepping focus, hide any active menu"
+
+ self hideActiveMenu.
+ super showNoFocus
+!
+
keyPress:key x:x y:y
- |index m|
+ |index m sel|
"
handle CursorLeft/Right for non-mouse operation
@@ -848,18 +990,26 @@
index > menus size ifTrue:[index := 1]
]
].
- m := self pullMenu:index.
+ self pullMenu:index.
^ self
].
activeMenuNumber isNil ifTrue:[^self].
"
- pass it on to the active menu
+ pass it on to the active menu or perform the items action
"
m := menus at:activeMenuNumber.
- m keyPress:key x:0 y:0.
- ^ self
+ m isNil ifTrue:[
+ key == #Return 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
@@ -923,6 +1073,8 @@
(titleIndex ~~ activeMenuNumber) ifTrue:[
self pullMenu:titleIndex
]
+ ] ifFalse:[
+ self hideActiveMenu
]
] ifFalse:[
"moving around below"
@@ -944,13 +1096,14 @@
!
buttonRelease:button x:x y:y
- |activeMenu activeLeft activeTop hideMenu|
+ |activeMenu activeLeft activeTop hideMenu sel|
+
+ activeMenuNumber isNil ifTrue:[^self].
+ activeMenu := menus at:activeMenuNumber.
hideMenu := false.
(y >= height) ifTrue:[
"release below title-line"
- activeMenuNumber isNil ifTrue:[^self].
- activeMenu := menus at:activeMenuNumber.
activeLeft := activeMenu left.
"
released in a submenu ?
@@ -971,8 +1124,16 @@
y < 0 ifTrue:[
hideMenu := true
] ifFalse:[
- keepMenu ifFalse:[
- hideMenu := true
+ activeMenu isNil ifTrue:[
+ sel := selectors at:activeMenuNumber.
+ sel notNil ifTrue:[
+ receiver perform:sel
+ ].
+ hideMenu := true.
+ ] ifFalse:[
+ keepMenu ifFalse:[
+ hideMenu := true
+ ]
]
]
].
--- a/PullDownMenu.st Fri May 12 20:25:18 1995 +0200
+++ b/PullDownMenu.st Wed May 17 14:26:27 1995 +0200
@@ -11,7 +11,7 @@
"
SimpleView subclass:#PullDownMenu
- instanceVariableNames:'menus titles selectors activeMenuNumber
+ instanceVariableNames:'receiver menus titles selectors activeMenuNumber
showSeparatingLines topMargin
fgColor bgColor activeFgColor activeBgColor
onLevel offLevel edgeStyle
@@ -24,7 +24,8 @@
DefaultHilightBackgroundColor
DefaultLevel DefaultHilightLevel
DefaultShadowColor DefaultLightColor
- DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep'
+ DefaultEdgeStyle DefaultKeepMenu DefaultToggleKeep
+ DefaultSeparatingLines'
poolDictionaries:''
category:'Views-Menus'
!
@@ -33,7 +34,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.17 1995-05-03 00:37:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.18 1995-05-17 12:25:49 claus Exp $
'!
!PullDownMenu class methodsFor:'documentation'!
@@ -54,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.17 1995-05-03 00:37:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.18 1995-05-17 12:25:49 claus Exp $
"
!
@@ -64,22 +65,49 @@
It controls display of its menus, which become visible when one of the
PullDownMenus entries is pressed.
+ A PullDownMenu itself consists of a single row of labels, which activate
+ a pulled menu when clicked. Entries may be empty (i.e. have no menu)
+ and empty entries may (optionally) also perform some action when clicked.
+ An entries selector is used as the key to define and access submenus
+ and (for empty entries:) the selector sent to the receiver of the menu.
+
Instance variables:
- menus <aCollection> the sub menus
- titles <aCollection> the strings in the menu
+ menus <Collection> the sub menus
+
+ titles <Collection> the strings in the menu
+
+ selectors <Collection> the selectors to send to the menu-
+ receiver (for empty pull-menus)
+ if nil (the default), title entries
+ do not send anything.
+
activeMenuNumber <Number> the index of the currently active menu
+
showSeparatingLines <Boolean> show separating lines between my menu-strings
+
topMargin <Number> number of pixels at top
- fgColor <Color> color to draw passive menu-titles
- bgColor <Color> color to draw passive menu-titles
- activeFgColor <Color> color to draw activated menu-titles
- activeBgColor <Color> color to draw activated menu-titles
- onLevel <Integer> level of entry-buttons when pressed
- offLevel <Integer> level of entry-buttons when released
+
+ fgColor <Color> fg color to draw passive menu-titles
+ bgColor <Color> bg color to draw passive menu-titles
+
+ activeFgColor <Color> fg color to draw activated menu-titles
+ activeBgColor <Color> bg color to draw activated menu-titles
+
+ onLevel <Integer> 3D level of entry-buttons when pressed
+ offLevel <Integer> 3D level of entry-buttons when released
+
+ edgeStyle <Symbol> how to draw edges
+
keepmenu <Boolean> if on, pulled menu stays on click,
till clicked again (motif & windows behavior)
+ toggleKeep <Boolean> if on and keepMenu is on,
+ clicking again on label closes menu
+
+ except menus, titles and selectors, instvars are usually defined from
+ defaults in the styleSheet; you should not care for them.
+
StyleSheet values:
@@ -104,150 +132,208 @@
pullDownMenuEdgeStyle edge style (nil or #soft)
pullDownMenuKeepMenu if true, pulled menu stays open until button
- is pressed again (motif behavior)
+ is pressed again outside of the item-area (motif behavior)
if false, menu closes on release (default)
pullDownMenuToggleKeep if true, pulled menu closes when an entry is pressed
- again. Otherwise, only press outside outside of
- the entry hides it.
- default is false
+ again. Otherwise, only press outside of the items area
+ hides it. default is false
pullDownMenuLevel level (3D only)
pullDownMenuFont font to use for the menu bar
default: menuFont
+
+ pullDownMenuShowSeparatingLines if true, lines are drawn between items.
+ default: false
"
!
examples
"
- |top menu|
+ |top menu|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
+ menu labels:#('foo' 'bar').
+ menu selectors:#(foo bar).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ menu at:#bar
+ putLabels:#('bar1' 'bar2' 'bar3')
+ selectors:#(bar1 bar2 bar3)
+ receiver:nil.
+ top open
+
+
- top := StandardSystemView new.
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- menu at:#bar
- putLabels:#('bar1' 'bar2' 'bar3')
- selectors:#(bar1 bar2 bar3)
- receiver:nil.
- top open
+ empty entries are possible as selectable items (with non-nil seletor) ...
+
+ |top menu|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
+ menu labels:#('foo' 'bar' 'baz').
+ menu selectors:#(foo bar baz).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ menu at:#baz
+ putLabels:#('baz1' 'baz2' 'baz3')
+ selectors:#(baz1 baz2 baz3)
+ receiver:nil.
+ top open
- 'empty entries are possible ...'
+ ... or as separators (with nil selector)
- |top menu|
+ |top menu|
+
+ top := StandardSystemView new.
+ top extent:500@200.
- top := StandardSystemView new.
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- top open
+ menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
+ menu labels:#('foo' ' ' 'bar' ' baz' ' ' 'moreFoo' 'moreBar' 'moreBaz').
+ menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ menu at:#bar
+ putLabels:#('bar1' 'bar2' 'bar3')
+ selectors:#(bar1 bar2 bar3)
+ receiver:nil.
+ menu at:#baz
+ putLabels:#('baz1' 'baz2' 'baz3')
+ selectors:#(baz1 baz2 baz3)
+ receiver:nil.
+ top open
- '... for example as separators'
+
+ use the menus default height
- |top menu|
+ |top menu|
+
+ top := StandardSystemView new.
+ top extent:300@300.
- top := StandardSystemView new.
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' ' ' 'bar' ' baz' ' ' 'moreFoo' 'moreBar' 'moreBaz').
- menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
- menu showSeparatingLines:true.
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- menu at:#bar
- putLabels:#('bar1' 'bar2' 'bar3')
- selectors:#(bar1 bar2 bar3)
- receiver:nil.
- menu at:#baz
- putLabels:#('baz1' 'baz2' 'baz3')
- selectors:#(baz1 baz2 baz3)
- receiver:nil.
- top open
+ menu := PullDownMenu in:top.
+ menu origin:0.0@0.0 corner:1.0@(menu height).
+ menu labels:#('foo' 'bar').
+ menu selectors:#(foo bar).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ top open
- 'use menus default height'
+ although you can change the font, colors etc (as shown below)
+ you should NOT do it - since if you do so, the styleSheet settings
+ are ineffective (which users wont like probably)
+ BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
+ pullDownMenuBackgroundColor and pullDownMenuFont
- |top menu|
+ |top menu|
- top := StandardSystemView new.
- menu := PullDownMenu in:top.
- menu origin:0.0@0.0 corner:1.0@(menu height).
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- top open
+ top := StandardSystemView new.
+ menu := PullDownMenu in:top.
+ menu font:(Font family:'courier' size:20).
+ menu foregroundColor:Color red.
+ menu backgroundColor:Color yellow.
+ menu viewBackground:Color yellow.
+ menu showSeparatingLines:true.
+ menu origin:0.0@0.0 corner:1.0@(menu height).
+ menu labels:#('foo' 'bar').
+ menu selectors:#(foo bar).
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ (menu menuAt:#foo) font:(Font family:'courier' size:36).
+ top open
- 'although you can change the font, colors etc (as shown below)
- you should NOT do it - since if you do so, the styleSheet settings
- are ineffective (which users wont like probably)
- BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
- pullDownMenuBackgroundColor and pullDownMenuFont'
+ you can use icons, too ...
- |top menu|
+ |labels top menu|
+
+ top := StandardSystemView new.
+ top extent:300@300.
- top := StandardSystemView new.
- menu := PullDownMenu in:top.
- menu font:(Font family:'courier' size:20).
- menu foregroundColor:Color red.
- menu backgroundColor:Color yellow.
- menu viewBackground:Color yellow.
- menu showSeparatingLines:true.
-
- menu origin:0.0@0.0 corner:1.0@(menu height).
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- (menu menuAt:#foo) font:(Font family:'courier' size:36).
- top open
+ menu := PullDownMenu in:top.
+ menu origin:0.0@0.0 corner:1.0@(menu height).
+ labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
+ with:'foo'
+ with:'bar'.
+ menu labels:labels.
+ menu selectors:#(about foo bar).
+ menu at:#about
+ putLabels:#('about PullDownMenus')
+ selectors:#(aboutMenus)
+ receiver:nil.
+ menu at:#foo
+ putLabels:#('foo1' 'foo2' 'foo3')
+ selectors:#(foo1 foo2 foo3)
+ receiver:nil.
+ top open
- 'you can use icons, too ...'
+ a concrete example (combining things described above)
+ (using a Plug, since we have no application class here):
+
+ |labels top menu textView appModel|
- |labels top menu|
+ appModel := Plug new.
+ appModel respondTo:#quit with:[top destroy].
+ appModel respondTo:#showAbout with:[self information:'some info here ...'].
+ appModel respondTo:#help with:[self information:'some help here ...'].
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ menu := PullDownMenu in:top.
+ menu receiver:appModel.
+ menu origin:0.0@0.0 corner:1.0@(menu height).
- top := StandardSystemView new.
- menu := PullDownMenu in:top.
- menu origin:0.0@0.0 corner:1.0@(menu height).
- labels := Array with:(Image fromFile:'SmalltalkX.xbm')
- with:'foo'
- with:'bar'.
- menu labels:labels.
- menu selectors:#(about foo bar).
- menu at:#about
- putLabels:#('about PullDownMenus')
- selectors:#(aboutMenus)
- receiver:nil.
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- top open
+ textView := ScrollableView forView:(EditTextView new).
+ textView origin:0.0@menu height corner:1.0@1.0.
+ top addSubView:textView.
+
+ labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
+ with:'file'
+ with:'edit'
+ with:'help'.
+ menu labels:labels.
+ menu selectors:#(about file edit help).
+ menu at:#about
+ putLabels:#('about PullDownMenus')
+ selectors:#(showAbout)
+ receiver:appModel.
+ menu at:#file
+ putLabels:#('quit')
+ selectors:#(quit)
+ receiver:appModel.
+ menu at:#edit
+ putLabels:#('copy' 'cut' 'paste')
+ selectors:#(copySelection cut paste)
+ receiver:textView.
+ top open
"
! !
@@ -292,6 +378,7 @@
DefaultFont isNil ifTrue:[
DefaultFont := StyleSheet fontAt:'menuFont'.
].
+ DefaultSeparatingLines := StyleSheet at:'pullDownMenuSeparatingLines' default:false.
"
PullDownMenu updateStyleCache
@@ -319,7 +406,7 @@
initStyle
super initStyle.
- showSeparatingLines := false.
+ showSeparatingLines := DefaultSeparatingLines. "/ false.
DefaultViewBackground notNil ifTrue:[
viewBackground := DefaultViewBackground on:device
].
@@ -389,10 +476,14 @@
!
recreate
- "if saved with an active menu, hide it"
+ "if the image was saved with an active menu, hide it"
+
+ |m|
activeMenuNumber notNil ifTrue:[
- (menus at:activeMenuNumber) unrealize.
+ (m := menus at:activeMenuNumber) notNil ifTrue:[
+ m unrealize.
+ ].
activeMenuNumber := nil.
].
super recreate.
@@ -405,10 +496,9 @@
!
destroy
- "
- have to destroy the menus manually here,
- since they are no real subviews of myself
- "
+ "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]
@@ -419,17 +509,69 @@
super destroy.
! !
-!PullDownMenu methodsFor:'accessing'!
+!PullDownMenu methodsFor:'accessing-look'!
showSeparatingLines:aBoolean
- "turn on/off drawing of separating lines"
+ "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 receiver:anObject
+ ]
+ ]
+!
+
numberOfTitles:n
"setup blank title-space to be filled in later"
@@ -476,24 +618,6 @@
selectors := selectorArray.
!
-font:aFont
- "adjust menu-origins when font changes"
-
- super font:(aFont on:device).
- self height:(font height + (font descent * 2)).
- shown ifTrue:[
- self setMenuOrigins
- ]
-!
-
-foregroundColor:aColor
- fgColor := aColor on:device
-!
-
-backgroundColor:aColor
- bgColor := aColor on:device
-!
-
menuAt:string
"return the menu with the title; return nil if not found"
@@ -666,8 +790,12 @@
"hide currently active menu - release grab if aBoolean is true
and a grab was set (keepMenu)"
+ |m|
+
activeMenuNumber notNil ifTrue:[
- (menus at:activeMenuNumber) unrealize.
+ (m := menus at:activeMenuNumber) notNil ifTrue:[
+ m unrealize.
+ ].
self unHighlightActiveTitle.
activeMenuNumber := nil
].
@@ -689,10 +817,17 @@
|subMenu|
activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
+ activeMenuNumber := aNumber.
subMenu := menus at:aNumber.
+
+ (activeMenuNumber notNil
+ and:[
+ subMenu notNil
+ or:[(selectors at:activeMenuNumber) notNil]]) ifTrue:[
+ self highlightActiveTitle.
+ ].
+
subMenu notNil ifTrue:[
- activeMenuNumber := aNumber.
- self highlightActiveTitle.
subMenu deselect.
subMenu create.
subMenu saveUnder:true.
@@ -712,8 +847,7 @@
!PullDownMenu methodsFor:'drawing '!
redraw
- |string
- x "{ Class: SmallInteger }"
+ |x "{ Class: SmallInteger }"
y "{ Class: SmallInteger }"
index "{ Class: SmallInteger }"
wSpace|
@@ -809,12 +943,13 @@
!PullDownMenu methodsFor:'submenu notifications'!
showActive
- "sent by a submenu to tell me that it started to perform
- its menu action"
+ "sent by a menu to tell me that it starts to perform
+ its menu action."
!
showPassive
- "sent by a submenu to tell me that it finished its menu-action."
+ "sent by a menu to tell me that it finished its menu-action.
+ Here, we hide the currently active menu."
self hideActiveMenu
!
@@ -827,8 +962,15 @@
!PullDownMenu methodsFor:'event handling'!
+showNoFocus
+ "when stepping focus, hide any active menu"
+
+ self hideActiveMenu.
+ super showNoFocus
+!
+
keyPress:key x:x y:y
- |index m|
+ |index m sel|
"
handle CursorLeft/Right for non-mouse operation
@@ -848,18 +990,26 @@
index > menus size ifTrue:[index := 1]
]
].
- m := self pullMenu:index.
+ self pullMenu:index.
^ self
].
activeMenuNumber isNil ifTrue:[^self].
"
- pass it on to the active menu
+ pass it on to the active menu or perform the items action
"
m := menus at:activeMenuNumber.
- m keyPress:key x:0 y:0.
- ^ self
+ m isNil ifTrue:[
+ key == #Return 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
@@ -923,6 +1073,8 @@
(titleIndex ~~ activeMenuNumber) ifTrue:[
self pullMenu:titleIndex
]
+ ] ifFalse:[
+ self hideActiveMenu
]
] ifFalse:[
"moving around below"
@@ -944,13 +1096,14 @@
!
buttonRelease:button x:x y:y
- |activeMenu activeLeft activeTop hideMenu|
+ |activeMenu activeLeft activeTop hideMenu sel|
+
+ activeMenuNumber isNil ifTrue:[^self].
+ activeMenu := menus at:activeMenuNumber.
hideMenu := false.
(y >= height) ifTrue:[
"release below title-line"
- activeMenuNumber isNil ifTrue:[^self].
- activeMenu := menus at:activeMenuNumber.
activeLeft := activeMenu left.
"
released in a submenu ?
@@ -971,8 +1124,16 @@
y < 0 ifTrue:[
hideMenu := true
] ifFalse:[
- keepMenu ifFalse:[
- hideMenu := true
+ activeMenu isNil ifTrue:[
+ sel := selectors at:activeMenuNumber.
+ sel notNil ifTrue:[
+ receiver perform:sel
+ ].
+ hideMenu := true.
+ ] ifFalse:[
+ keepMenu ifFalse:[
+ hideMenu := true
+ ]
]
]
].
--- a/RButtC.st Fri May 12 20:25:18 1995 +0200
+++ b/RButtC.st Wed May 17 14:26:27 1995 +0200
@@ -1,3 +1,15 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:07:27 am'!
ToggleController subclass:#RadioButtonController
@@ -7,11 +19,47 @@
category:'Interface-Support-Controllers'
!
+!RadioButtonController class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/RButtC.st,v 1.3 1995-05-17 12:25:53 claus Exp $
+"
+!
+
+documentation
+"
+ RadioButtonControllers redefine the response to a button-click.
+ While toggles (i.e. ToggleControllers) change state with every click,
+ radioButtons will only do so for an off-to-on transition.
+ They will NEVER turn themselfes off with a click.
+ To turn a radioButton off, another button in its buttonGroup must
+ be turned on and thereby (via the buttonGroup) turn the first button off.
+
+ You can place both toggles (for 'zero-or-one-on' behavior) or
+ radiobuttons (for 'one-on' behavior) into a buttongroup.
+"
+! !
+
!RadioButtonController methodsFor:'event handling'!
buttonPress:button x:x y:y
"radiobuttons change only off-to-on; turning off is done by other
- buttons"
+ buttons."
pressed ifFalse:[
view toggle
--- a/RadioButtonController.st Fri May 12 20:25:18 1995 +0200
+++ b/RadioButtonController.st Wed May 17 14:26:27 1995 +0200
@@ -1,3 +1,15 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:07:27 am'!
ToggleController subclass:#RadioButtonController
@@ -7,11 +19,47 @@
category:'Interface-Support-Controllers'
!
+!RadioButtonController class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/RadioButtonController.st,v 1.3 1995-05-17 12:25:53 claus Exp $
+"
+!
+
+documentation
+"
+ RadioButtonControllers redefine the response to a button-click.
+ While toggles (i.e. ToggleControllers) change state with every click,
+ radioButtons will only do so for an off-to-on transition.
+ They will NEVER turn themselfes off with a click.
+ To turn a radioButton off, another button in its buttonGroup must
+ be turned on and thereby (via the buttonGroup) turn the first button off.
+
+ You can place both toggles (for 'zero-or-one-on' behavior) or
+ radiobuttons (for 'one-on' behavior) into a buttongroup.
+"
+! !
+
!RadioButtonController methodsFor:'event handling'!
buttonPress:button x:x y:y
"radiobuttons change only off-to-on; turning off is done by other
- buttons"
+ buttons."
pressed ifFalse:[
view toggle
--- a/ScrollBar.st Fri May 12 20:25:18 1995 +0200
+++ b/ScrollBar.st Wed May 17 14:26:27 1995 +0200
@@ -15,7 +15,7 @@
SimpleView subclass:#ScrollBar
instanceVariableNames:'thumb button1 button2 layout elementSpacing'
classVariableNames:'DefaultButtonPositions DefaultLevel DefaultElementSpacing
- DefaultScrollerBordered'
+ DefaultScrollerBordered'
poolDictionaries:''
category:'Views-Interactors'
!
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.12 1995-05-03 00:37:35 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.13 1995-05-17 12:25:59 claus Exp $
'!
!ScrollBar class methodsFor:'documentation'!
@@ -45,7 +45,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.12 1995-05-03 00:37:35 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.13 1995-05-17 12:25:59 claus Exp $
"
!
@@ -72,6 +72,9 @@
Most often scrollbars are used hidden with ScrollableView or HVScrollableView (i.e. you
dont have to care for all the details).
+
+ The scrollBars and scrollers protocols have been made similar enough to
+ allow transparent use of either a scroller or a scrollBar in applications.
"
! !
@@ -153,29 +156,29 @@
the if should not be needed ..."
style := StyleSheet name.
style == #mswindows ifTrue:[
- w := button1 width max:button2 width.
- h := button1 height + button2 height + (Scroller defaultExtent y).
+ w := button1 width max:button2 width.
+ h := button1 height + button2 height + (Scroller defaultExtent y).
] ifFalse:[
- upForm := ArrowButton upArrowButtonForm:style on:device.
- downForm := ArrowButton downArrowButtonForm:style on:device.
- upForm isNil ifTrue:[
- upHeight := upWidth := 16.
- ] ifFalse:[
- upHeight := upForm height.
- upWidth := upForm width
- ].
- downForm isNil ifTrue:[
- downHeight := downWidth := 16
- ] ifFalse:[
- downHeight := downForm height.
- downWidth := downForm width
- ].
- h := upHeight + downHeight + (1 * 2) + (Scroller defaultExtent y).
- w := upWidth max:downWidth.
- style ~~ #normal ifTrue:[
- h := h + 4.
- w := w + 4
- ].
+ upForm := ArrowButton upArrowButtonForm:style on:device.
+ downForm := ArrowButton downArrowButtonForm:style on:device.
+ upForm isNil ifTrue:[
+ upHeight := upWidth := 16.
+ ] ifFalse:[
+ upHeight := upForm height.
+ upWidth := upForm width
+ ].
+ downForm isNil ifTrue:[
+ downHeight := downWidth := 16
+ ] ifFalse:[
+ downHeight := downForm height.
+ downWidth := downForm width
+ ].
+ h := upHeight + downHeight + (1 * 2) + (Scroller defaultExtent y).
+ w := upWidth max:downWidth.
+ style ~~ #normal ifTrue:[
+ h := h + 4.
+ w := w + 4
+ ].
].
self extent:w @ h.
@@ -190,6 +193,10 @@
self createElements.
+ (StyleSheet at:'scrollBarDisableButtons' default:false) ifTrue:[
+ thumb addDependent:self
+ ].
+
button1 autoRepeat.
button2 autoRepeat.
@@ -197,42 +204,42 @@
button1 borderWidth:borderWidth.
DefaultScrollerBordered ifFalse:[
- thumb borderWidth:borderWidth.
+ thumb borderWidth:borderWidth.
].
button2 borderWidth:borderWidth.
style := StyleSheet name.
((style = #iris) and:[Display hasGreyscales]) ifTrue:[
- "have to change some of Buttons defaults"
- clr := (Color grey:25) on:device.
- button1 offLevel:2.
- button2 offLevel:2.
- button1 foregroundColor:clr.
- button1 activeForegroundColor:clr.
- button1 enteredForegroundColor:clr.
- button2 foregroundColor:clr.
- button2 activeForegroundColor:clr.
- button2 enteredForegroundColor:clr.
+ "have to change some of Buttons defaults"
+ clr := (Color grey:25) on:device.
+ button1 offLevel:2.
+ button2 offLevel:2.
+ button1 foregroundColor:clr.
+ button1 activeForegroundColor:clr.
+ button1 enteredForegroundColor:clr.
+ button2 foregroundColor:clr.
+ button2 activeForegroundColor:clr.
+ button2 enteredForegroundColor:clr.
].
self setElementPositions.
style = #motif ifTrue:[
- clr := thumb thumbColor.
- button1 foregroundColor:clr.
- button2 foregroundColor:clr.
+ clr := thumb thumbColor.
+ button1 foregroundColor:clr.
+ button2 foregroundColor:clr.
- clr := thumb viewBackground.
- button1 viewBackground:clr.
- button2 viewBackground:clr.
- button1 backgroundColor:clr.
- button2 backgroundColor:clr.
- button1 activeBackgroundColor:clr.
- button2 activeBackgroundColor:clr.
- device hasGreyscales ifFalse:[
- button1 activeForegroundColor:Black.
- button2 activeForegroundColor:Black.
- ]
+ clr := thumb viewBackground.
+ button1 viewBackground:clr.
+ button2 viewBackground:clr.
+ button1 backgroundColor:clr.
+ button2 backgroundColor:clr.
+ button1 activeBackgroundColor:clr.
+ button2 activeBackgroundColor:clr.
+ device hasGreyscales ifFalse:[
+ button1 activeForegroundColor:Black.
+ button2 activeForegroundColor:Black.
+ ]
]
!
@@ -241,44 +248,109 @@
self setElementPositions.
! !
-!ScrollBar methodsFor:'accessing'!
+!ScrollBar methodsFor:'change & update'!
-setThumbFor:aView
- "adjust thumb for aView"
+update:something with:aParameter from:changedObject
+ changedObject == thumb ifTrue:[
+ self enableDisableButtons
+ ]
+! !
- thumb setThumbFor:aView
-!
+!ScrollBar methodsFor:'private'!
+
+enableDisableButtons
+ |e1 e2|
+
+ (StyleSheet at:'scrollBarDisableButtons' default:false) ifFalse:[^ self].
-setThumbOriginFor:aView
- "adjust thumbs origin for aView"
-
- thumb setThumbOriginFor:aView
-!
+ e1 := e2 := true.
+ thumb thumbHeight >= 99.99999 ifTrue:[
+ e1 := false.
+ e2 := false
+ ] ifFalse:[
+ thumb thumbOrigin <= 0.00001 ifTrue:[
+ e1 := false
+ ] ifFalse:[
+ (thumb thumbOrigin + thumb thumbHeight) >= 99.99999 ifTrue:[
+ e2 := false
+ ]
+ ]
+ ].
+ e1 ifTrue:[button1 enable] ifFalse:[button1 disable].
+ e2 ifTrue:[button2 enable] ifFalse:[button2 disable].
+! !
-thumbOrigin:newOrigin thumbHeight:newHeight
- "set origin and height of thumb in percent"
-
- ^ thumb thumbOrigin:newOrigin thumbHeight:newHeight
-!
+!ScrollBar methodsFor:'accessing-behavior'!
scrollAction:aBlock
- "set the action, aBlock to be performed when the scroller is moved"
-
+ "set the action, aBlock to be performed when the scroller is moved.
+ This is forwarded to the scroller here."
+
thumb scrollAction:aBlock
!
scrollUpAction:aBlock
- "set the action, aBlock to be performed when the up-button is pressed"
-
+ "set the action, aBlock to be performed when the up-button is pressed."
+
button1 action:aBlock
!
scrollDownAction:aBlock
- "set the action, aBlock to be performed when the down-button is pressed"
-
+ "set the action, aBlock to be performed when the down-button is pressed."
+
button2 action:aBlock
!
+asynchronousOperation
+ "set asynchronous-mode - scroll action is performed after movement
+ of scroller (i.e. when mouse-button is finally released).
+ This is forwarded to the scroller here."
+
+ thumb asynchronousOperation
+!
+
+synchronousOperation
+ "set synchronous-mode - scroll action is performed for every movement
+ of scroller.
+ This is forwarded to the scroller here."
+
+ thumb synchronousOperation
+! !
+
+!ScrollBar methodsFor:'accessing'!
+
+setThumbFor:aView
+ "adjust thumb for aView
+ (i.e. adjust thumbs origin & size for views size & views contents).
+ This is forwarded to the scroller here."
+
+ thumb setThumbFor:aView.
+ self enableDisableButtons
+!
+
+setThumbOriginFor:aView
+ "adjust thumbs origin for aViews size & contents.
+ This is forwarded to the scroller here."
+
+ thumb setThumbOriginFor:aView.
+ self enableDisableButtons
+!
+
+setThumbHeightFor:aView
+ "adjust thumbs height for aViews size & contents.
+ This is forwarded to the scroller here."
+
+ thumb setThumbHeightFor:aView.
+ self enableDisableButtons
+!
+
+thumbOrigin:newOrigin thumbHeight:newHeight
+ "set origin and height of thumb (both in percent)"
+
+ thumb thumbOrigin:newOrigin thumbHeight:newHeight.
+ self enableDisableButtons
+!
+
thumbColor:aColor
"set the thumbs color"
@@ -294,7 +366,8 @@
thumbOrigin:newOrigin
"set position of (top of) thumb in percent"
- ^ thumb thumbOrigin:newOrigin
+ thumb thumbOrigin:newOrigin.
+ self enableDisableButtons
!
thumbHeight
@@ -306,41 +379,25 @@
thumbHeight:newHeight
"set height of thumb in percent"
- ^ thumb thumbHeight:newHeight
-!
-
-setThumbHeightFor:aView
- "adjust thumbs height for aView"
-
- thumb setThumbHeightFor:aView
-!
-
-asynchronousOperation
- "set asynchronous-mode - scroll action is performed after movement
- of scroller (i.e. when mouse-button is finally released)"
-
- thumb asynchronousOperation
-!
-
-synchronousOperation
- "set synchronous-mode - scroll action is performed for every movement
- of scroller"
-
- thumb synchronousOperation
+ thumb thumbHeight:newHeight.
+ self enableDisableButtons
! !
!ScrollBar methodsFor:'events'!
sizeChanged:how
- "when my size changes, I have to resize/reposition the subviews"
+ "when my size changes, I have to resize/reposition the subviews.
+ Also, if I became too small, hide thumb/buttons."
|upHeight downHeight thumbHeight upAndDownHeight bwn sep2
- thumbWidth w|
+ thumbWidth w style|
button1 isNil ifTrue:[^ self].
thumb isNil ifTrue:[^ self].
button2 isNil ifTrue:[^ self].
+ style := StyleSheet name.
+
upHeight := button1 height + borderWidth.
downHeight := button2 height + borderWidth.
upAndDownHeight := upHeight + downHeight.
@@ -395,11 +452,11 @@
].
thumbWidth := w.
- StyleSheet name == #next ifTrue:[
+ style == #next ifTrue:[
thumbWidth := thumbWidth - (thumb borderWidth * 2).
thumbHeight := thumbHeight - 1
].
- StyleSheet name == #motif ifTrue:[
+ style == #motif ifTrue:[
thumbHeight := thumbHeight - margin
].
@@ -434,13 +491,20 @@
].
"buttons around thumb"
-StyleSheet name == #motif ifTrue:[
- sep2 := sep2 + 1
-].
+ style == #motif ifTrue:[
+ sep2 := sep2 + 1
+ ].
button1 origin:(bwn @ bwn).
- button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - (margin // 2) "+ borderWidth")).
- thumb extent:(thumbWidth @ (thumbHeight + margin - (margin // 2))).
- thumb origin:(bwn @ (upHeight - borderWidth + elementSpacing))
+
+ style == #os2 ifTrue:[
+ button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - margin "+ borderWidth")).
+ thumb extent:(thumbWidth @ (thumbHeight - margin - margin "+ margin - (margin // 2)")).
+ thumb origin:(bwn @ (upHeight - borderWidth + elementSpacing + margin))
+ ] ifFalse:[
+ button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - (margin // 2) "+ borderWidth")).
+ thumb extent:(thumbWidth @ (thumbHeight + margin - (margin // 2))).
+ thumb origin:(bwn @ (upHeight - borderWidth + elementSpacing))
+ ].
! !
!ScrollBar methodsFor:'forced scroll'!
--- a/Scroller.st Fri May 12 20:25:18 1995 +0200
+++ b/Scroller.st Wed May 17 14:26:27 1995 +0200
@@ -28,7 +28,7 @@
DefaultTallyLevel DefaultLevel DefaultBorderWidth
DefaultThumbLevel DefaultInset DefaultThumbFrameColor
DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
- DefaultFixThumbHeight DefaultEdgeStyle'
+ DefaultFixThumbHeight DefaultEdgeStyle DefaultFullViewBackground'
poolDictionaries:''
category:'Views-Interactors'
!
@@ -37,7 +37,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.22 1995-05-12 18:25:06 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.23 1995-05-17 12:26:04 claus Exp $
'!
!Scroller class methodsFor:'documentation'!
@@ -58,7 +58,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.22 1995-05-12 18:25:06 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.23 1995-05-17 12:26:04 claus Exp $
"
!
@@ -202,6 +202,7 @@
updateStyleCache
DefaultViewBackground := StyleSheet colorAt:'scrollerViewBackground'.
+ DefaultFullViewBackground := StyleSheet colorAt:'scrollerFullViewBackground'.
DefaultThumbColor := StyleSheet colorAt:'scrollerThumbColor'.
DefaultShadowColor := StyleSheet colorAt:'scrollerShadowColor'.
DefaultLightColor := StyleSheet colorAt:'scrollerLightColor'.
@@ -428,7 +429,9 @@
gW := frameBeforeMove width.
gH := frameBeforeMove height.
- self fillRectangle:frameBeforeMove with:ghostColor.
+ ghostColor notNil ifTrue:[
+ self fillRectangle:frameBeforeMove with:ghostColor.
+ ].
(ghostLevel ~~ 0) ifTrue:[
self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel
].
@@ -666,7 +669,9 @@
scrolling ifFalse: [^ self]. "should not happen"
frameBeforeMove isNil ifTrue:[
- ghostColor notNil ifTrue:[
+ (ghostColor notNil
+ or:[ghostFrameColor notNil
+ or:[ghostLevel ~~ 0]]) ifTrue:[
frameBeforeMove := thumbFrame insetBy:1@1
]
].
@@ -780,7 +785,7 @@
thumbHeight:aNumber
"set the thumbs height (in percent by default)"
- |newHeight realNewHeight oldFrame|
+ |newHeight realNewHeight oldFrame nBg|
newHeight := aNumber / (rangeEnd - rangeStart / 100).
@@ -791,6 +796,22 @@
].
((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
thumbHeight := realNewHeight.
+
+ (DefaultFullViewBackground notNil
+ and:[DefaultViewBackground notNil
+ and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
+ realNewHeight >= 100 ifTrue:[
+ nBg := DefaultFullViewBackground.
+ ] ifFalse:[
+ nBg := DefaultViewBackground
+ ].
+ nBg := nBg on:device.
+ nBg ~~ viewBackground ifTrue:[
+ self viewBackground:nBg.
+ shown ifTrue:[self clear].
+ ]
+ ].
+
shown ifTrue:[
oldFrame := thumbFrame.
self computeThumbFrame.
@@ -957,7 +978,7 @@
thumbOrigin:originNumber thumbHeight:heightNumber
"set both thumbs height and origin (in percent by default)"
- |newHeight newOrigin realNewOrigin realNewHeight old new changed|
+ |newHeight newOrigin realNewOrigin realNewHeight old new changed nBg|
newOrigin := originNumber / (rangeEnd - rangeStart / 100) - rangeStart.
newHeight := heightNumber / (rangeEnd - rangeStart / 100).
@@ -989,6 +1010,22 @@
(changed or:[thumbFrame isNil]) ifTrue:[
thumbOrigin := realNewOrigin.
thumbHeight := realNewHeight.
+
+ (DefaultFullViewBackground notNil
+ and:[DefaultViewBackground notNil
+ and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
+ realNewHeight >= 100 ifTrue:[
+ nBg := DefaultFullViewBackground.
+ ] ifFalse:[
+ nBg := DefaultViewBackground
+ ].
+ nBg := nBg on:device.
+ nBg ~~ viewBackground ifTrue:[
+ self viewBackground:nBg.
+ shown ifTrue:[self clear].
+ ]
+ ].
+
shown ifTrue:[
thumbFrame notNil ifTrue:[
self drawThumbBackgroundInX:(thumbFrame left)
--- a/SelListV.st Fri May 12 20:25:18 1995 +0200
+++ b/SelListV.st Wed May 17 14:26:27 1995 +0200
@@ -14,20 +14,20 @@
ListView subclass:#SelectionInListView
instanceVariableNames:'selection actionBlock enabled hilightFgColor hilightBgColor
- halfIntensityFgColor doubleClickActionBlock selectConditionBlock
- listAttributes multipleSelectOk clickLine initialSelectionMsg
- printItems oneItem useIndex hilightLevel hilightFrameColor
- ignoreReselect arrowLevel smallArrow keyActionStyle
- returnKeyActionStyle toggleSelect strikeOut iSearchString items
- doubleClickMsg'
+ halfIntensityFgColor doubleClickActionBlock selectConditionBlock
+ listAttributes multipleSelectOk clickLine initialSelectionMsg
+ printItems oneItem useIndex hilightLevel hilightFrameColor
+ ignoreReselect arrowLevel smallArrow keyActionStyle
+ returnKeyActionStyle toggleSelect strikeOut iSearchString items
+ doubleClickMsg'
classVariableNames:'RightArrowShadowForm RightArrowLightForm RightArrowForm
- SmallRightArrowShadowForm SmallRightArrowLightForm
- DefaultForegroundColor DefaultBackgroundColor
- DefaultHilightForegroundColor DefaultHilightBackgroundColor
- DefaultHilightFrameColor DefaultHilightLevel DefaultFont
- DefaultRightArrowStyle DefaultRightArrowLevel
- DefaultDisabledForegroundColor DefaultShadowColor
- DefaultLightColor'
+ SmallRightArrowShadowForm SmallRightArrowLightForm
+ DefaultForegroundColor DefaultBackgroundColor
+ DefaultHilightForegroundColor DefaultHilightBackgroundColor
+ DefaultHilightFrameColor DefaultHilightLevel DefaultFont
+ DefaultRightArrowStyle DefaultRightArrowLevel
+ DefaultDisabledForegroundColor DefaultShadowColor
+ DefaultLightColor'
poolDictionaries:''
category:'Views-Text'
!
@@ -36,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.32 1995-05-09 01:56:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.33 1995-05-17 12:26:12 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.32 1995-05-09 01:56:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.33 1995-05-17 12:26:12 claus Exp $
"
!
@@ -175,218 +175,218 @@
basic interface:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:#('one' 'two' 'three').
- slv action:[:index | Transcript showCr:'selected ' , index printString].
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:#('one' 'two' 'three').
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+
+ top add:slv in:(0.0@0.0 corner:1.0@1.0).
+ top open
get element instead of index:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:#('one' 'two' 'three').
- slv action:[:element | Transcript showCr:'selected ' , element printString].
- slv useIndex:false.
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:#('one' 'two' 'three').
+ slv action:[:element | Transcript showCr:'selected ' , element printString].
+ slv useIndex:false.
+
+ top add:slv in:(0.0@0.0 corner:1.0@1.0).
+ top open
concrete example; show filenames:
(notice: normally, you would use a FileSelectionList)
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index |
- Transcript showCr:'selected ' , index printString.
- Transcript showCr:' the value is: ', slv selectionValue].
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index |
+ Transcript showCr:'selected ' , index printString.
+ Transcript showCr:' the value is: ', slv selectionValue].
+
+ top add:slv in:(0.0@0.0 corner:1.0@1.0).
+ top open
add a scrollbar:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
allow reselect (clicking on already selected entry):
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
- slv ignoreReselect:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+ slv ignoreReselect:false.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
allow multiple selections:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
- slv multipleSelectOk:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
+ slv multipleSelectOk:true.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
same, not using index:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
- slv multipleSelectOk:true; useIndex:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
+ slv multipleSelectOk:true; useIndex:false.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
strikeout mode (single):
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
- slv strikeOut:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+ slv strikeOut:true.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
strikeout mode (multiple):
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
- slv strikeOut:true; multipleSelectOk:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+ slv strikeOut:true; multipleSelectOk:true.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
define what to do on double-click:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
- slv doubleClickAction:[:index | Transcript showCr:'doubleclick on ' , index printString].
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+ slv doubleClickAction:[:index | Transcript showCr:'doubleclick on ' , index printString].
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
using a Model:
- |top slv model|
-
- model := Plug new.
- model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
- model respondTo:#initial with:[1].
- model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#someAspect
- change:#setSelection:
- list:#getList
- initialSelection:#initial.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv model|
+
+ model := Plug new.
+ model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
+ model respondTo:#initial with:[1].
+ model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView
+ on:model
+ aspect:#someAspect
+ change:#setSelection:
+ list:#getList
+ initialSelection:#initial.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
notice, that the ST-80 behavaior on reselect is to send a selection change
with an index of 0.
@@ -394,80 +394,80 @@
same, with useIndex false:
- |top slv model|
-
- model := Plug new.
- model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
- model respondTo:#initial with:['bar'].
- model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#someAspect
- change:#setSelection:
- list:#getList
- initialSelection:#initial.
- slv useIndex:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv model|
+
+ model := Plug new.
+ model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
+ model respondTo:#initial with:['bar'].
+ model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView
+ on:model
+ aspect:#someAspect
+ change:#setSelection:
+ list:#getList
+ initialSelection:#initial.
+ slv useIndex:false.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
using a SelectionInList-Model:
(see how changes in the model (via list:...) are reflected in the view)
- |top slv model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
- model selection:'bar'.
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView on:model.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
-
- model inspect
+ |top slv model|
+
+ model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
+ model selection:'bar'.
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView on:model.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open.
+
+ model inspect
two selectionInListViews on the same selectionInList model:
- |top1 slv1 top2 slv2 model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
-
- top1 := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv1 := SelectionInListView on:model.
-
- top1 add:(ScrollableView forView:slv1) in:(0.0@0.0 corner:1.0@1.0).
- top1 open.
-
- top2 := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv2 := SelectionInListView on:model.
-
- top2 add:(ScrollableView forView:slv2) in:(0.0@0.0 corner:1.0@1.0).
- top2 open.
+ |top1 slv1 top2 slv2 model|
+
+ model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
+
+ top1 := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv1 := SelectionInListView on:model.
+
+ top1 add:(ScrollableView forView:slv1) in:(0.0@0.0 corner:1.0@1.0).
+ top1 open.
+
+ top2 := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv2 := SelectionInListView on:model.
+
+ top2 add:(ScrollableView forView:slv2) in:(0.0@0.0 corner:1.0@1.0).
+ top2 open.
"
! !
@@ -1322,11 +1322,11 @@
] ifFalse:[
text := items
].
- text notNil ifTrue:[
- text := text asStringCollection.
- ]
+"/ text notNil ifTrue:[
+"/ text := text asStringCollection.
+"/ ]
].
- self list:text
+ self list:text expandTabs:false
].
].
!
@@ -1584,14 +1584,14 @@
|index startSearch backSearch searchPrefix|
(key == #CursorUp) ifTrue:[
- index := self previousBeforeSelection.
- self key:key select:index x:x y:y.
- ^ self
+ index := self previousBeforeSelection.
+ self key:key select:index x:x y:y.
+ ^ self
].
(key == #CursorDown) ifTrue:[
- index := self nextAfterSelection.
- self key:key select:index x:x y:y.
- ^ self
+ index := self nextAfterSelection.
+ self key:key select:index x:x y:y.
+ ^ self
].
"/
"/ stupid: Home and End are cought in ScrollableView
@@ -1600,24 +1600,24 @@
"/ ... and implement it here)
"/
(key == #Home) ifTrue:[
- self key:key select:1 x:x y:y.
- ^ self
+ self key:key select:1 x:x y:y.
+ ^ self
].
(key == #End) ifTrue:[
- index := self size.
- self key:key select:index x:x y:y.
- ^ self
+ index := self size.
+ self key:key select:index x:x y:y.
+ ^ self
].
key == #Return ifTrue:[
- returnKeyActionStyle == #doubleClick ifTrue:[
- selection notNil ifTrue:[
- self doubleClicked
- ].
- ^ self
- ].
- returnKeyActionStyle ~~ #pass ifTrue:[
- ^ self
- ].
+ returnKeyActionStyle == #doubleClick ifTrue:[
+ selection notNil ifTrue:[
+ self doubleClicked
+ ].
+ ^ self
+ ].
+ returnKeyActionStyle ~~ #pass ifTrue:[
+ ^ self
+ ].
].
"
@@ -1627,9 +1627,9 @@
(self size > 0
and:[key isCharacter
and:[key isLetter]]) ifTrue:[
- keyActionStyle isNil ifTrue:[^ self].
- keyActionStyle == #pass ifFalse:[
- searchPrefix := key asLowercase asString.
+ keyActionStyle isNil ifTrue:[^ self].
+ keyActionStyle == #pass ifFalse:[
+ searchPrefix := key asLowercase asString.
"/ ... isISearch... ifFalse:[
"/ iSearchString := ''
@@ -1638,52 +1638,52 @@
"/ searchPrefix := iSearchString
"/ ].
- backSearch := device shiftDown.
- backSearch ifTrue:[
- selection notNil ifTrue:[
- selection size > 0 ifTrue:[
- startSearch := selection first - 1
- ] ifFalse:[
- startSearch := selection - 1
- ]
- ] ifFalse:[
- startSearch := self size
- ].
- startSearch < 1 ifTrue:[
- startSearch := self size.
- ].
- ] ifFalse:[
- selection notNil ifTrue:[
- selection size > 0 ifTrue:[
- startSearch := selection last + 1
- ] ifFalse:[
- startSearch := selection + 1
- ]
- ] ifFalse:[
- startSearch := 1
- ].
- startSearch > self size ifTrue:[
- startSearch := 1.
- ].
- ].
- index := startSearch.
- [true] whileTrue:[
- (((self at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
- index = selection ifTrue:[^ self].
- ^ self key:key select:index x:x y:y
- ].
- backSearch ifTrue:[
- index := index - 1.
- index < 1 ifTrue:[index := self size]
- ] ifFalse:[
- index := index + 1.
- index > self size ifTrue:[index := 1].
- ].
- index == startSearch ifTrue:[
- ^ self
- ]
- ]
- ].
+ backSearch := device shiftDown.
+ backSearch ifTrue:[
+ selection notNil ifTrue:[
+ selection size > 0 ifTrue:[
+ startSearch := selection first - 1
+ ] ifFalse:[
+ startSearch := selection - 1
+ ]
+ ] ifFalse:[
+ startSearch := self size
+ ].
+ startSearch < 1 ifTrue:[
+ startSearch := self size.
+ ].
+ ] ifFalse:[
+ selection notNil ifTrue:[
+ selection size > 0 ifTrue:[
+ startSearch := selection last + 1
+ ] ifFalse:[
+ startSearch := selection + 1
+ ]
+ ] ifFalse:[
+ startSearch := 1
+ ].
+ startSearch > self size ifTrue:[
+ startSearch := 1.
+ ].
+ ].
+ index := startSearch.
+ [true] whileTrue:[
+ (((self at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
+ index = selection ifTrue:[^ self].
+ ^ self key:key select:index x:x y:y
+ ].
+ backSearch ifTrue:[
+ index := index - 1.
+ index < 1 ifTrue:[index := self size]
+ ] ifFalse:[
+ index := index + 1.
+ index > self size ifTrue:[index := 1].
+ ].
+ index == startSearch ifTrue:[
+ ^ self
+ ]
+ ]
+ ].
].
^ super keyPress:key x:x y:y
!
@@ -1752,17 +1752,17 @@
|oldSelection|
(selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- keyActionStyle notNil ifTrue:[
- keyActionStyle == #pass ifTrue:[
- ^ super keyPress:key x:x y:y
- ].
- oldSelection := selection.
- self selection:index.
- self selectionChangedFrom:oldSelection.
- keyActionStyle == #selectAndDoubleClick ifTrue:[
- self doubleClicked
- ]
- ]
+ keyActionStyle notNil ifTrue:[
+ keyActionStyle == #pass ifTrue:[
+ ^ super keyPress:key x:x y:y
+ ].
+ oldSelection := selection.
+ self selection:index.
+ self selectionChangedFrom:oldSelection.
+ keyActionStyle == #selectAndDoubleClick ifTrue:[
+ self doubleClicked
+ ]
+ ]
].
!
@@ -2067,6 +2067,19 @@
!SelectionInListView methodsFor:'accessing-contents'!
+printItems:aBoolean
+ "set/clear the printItems flag. If set, items (as set via #list: or
+ as returned from the model) are sent #printString to display them.
+ If false, items are assumed to be either strings, or know how to
+ display themself in a GC (i.e. they are instances of ListEntry).
+ The default is false.
+ Caveat: printString seems to be too specialized - I'd rather have
+ a definable printSelector or - better - a printConverter.
+ This may be added in the future."
+
+ printItems := aBoolean
+!
+
list:aCollection
"set the list - redefined, since setting the list implies unselecting
and clearing attributes."
@@ -2165,7 +2178,7 @@
realize
super realize.
- self getListFromModel.
+"/ self getListFromModel. -- not needed; superclass did it already
self getSelectionFromModel.
selection notNil ifTrue:[
@@ -2278,23 +2291,23 @@
update:something with:aParameter from:changedObject
changedObject == model ifTrue:[
- something == aspectMsg ifTrue:[
- self getListFromModel.
- self getSelectionFromModel.
- ^ self
- ].
- something == listMsg ifTrue:[
- self getListFromModel.
- ^ self
- ].
- something == initialSelectionMsg ifTrue:[
- self getSelectionFromModel.
- ^ self
- ].
- something == #empty ifTrue:[
- self list:nil.
- ^ self
- ].
+ something == aspectMsg ifTrue:[
+ self getListFromModel.
+ self getSelectionFromModel.
+ ^ self
+ ].
+ something == listMsg ifTrue:[
+ self getListFromModel.
+ ^ self
+ ].
+ something == initialSelectionMsg ifTrue:[
+ self getSelectionFromModel.
+ ^ self
+ ].
+ something == #empty ifTrue:[
+ self list:nil.
+ ^ self
+ ].
].
^ super update:something with:aParameter from:changedObject
! !
@@ -2424,4 +2437,3 @@
SelectionInListView new modelInterface
"
! !
-
--- a/SelectionInListView.st Fri May 12 20:25:18 1995 +0200
+++ b/SelectionInListView.st Wed May 17 14:26:27 1995 +0200
@@ -14,20 +14,20 @@
ListView subclass:#SelectionInListView
instanceVariableNames:'selection actionBlock enabled hilightFgColor hilightBgColor
- halfIntensityFgColor doubleClickActionBlock selectConditionBlock
- listAttributes multipleSelectOk clickLine initialSelectionMsg
- printItems oneItem useIndex hilightLevel hilightFrameColor
- ignoreReselect arrowLevel smallArrow keyActionStyle
- returnKeyActionStyle toggleSelect strikeOut iSearchString items
- doubleClickMsg'
+ halfIntensityFgColor doubleClickActionBlock selectConditionBlock
+ listAttributes multipleSelectOk clickLine initialSelectionMsg
+ printItems oneItem useIndex hilightLevel hilightFrameColor
+ ignoreReselect arrowLevel smallArrow keyActionStyle
+ returnKeyActionStyle toggleSelect strikeOut iSearchString items
+ doubleClickMsg'
classVariableNames:'RightArrowShadowForm RightArrowLightForm RightArrowForm
- SmallRightArrowShadowForm SmallRightArrowLightForm
- DefaultForegroundColor DefaultBackgroundColor
- DefaultHilightForegroundColor DefaultHilightBackgroundColor
- DefaultHilightFrameColor DefaultHilightLevel DefaultFont
- DefaultRightArrowStyle DefaultRightArrowLevel
- DefaultDisabledForegroundColor DefaultShadowColor
- DefaultLightColor'
+ SmallRightArrowShadowForm SmallRightArrowLightForm
+ DefaultForegroundColor DefaultBackgroundColor
+ DefaultHilightForegroundColor DefaultHilightBackgroundColor
+ DefaultHilightFrameColor DefaultHilightLevel DefaultFont
+ DefaultRightArrowStyle DefaultRightArrowLevel
+ DefaultDisabledForegroundColor DefaultShadowColor
+ DefaultLightColor'
poolDictionaries:''
category:'Views-Text'
!
@@ -36,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.32 1995-05-09 01:56:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.33 1995-05-17 12:26:12 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.32 1995-05-09 01:56:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.33 1995-05-17 12:26:12 claus Exp $
"
!
@@ -175,218 +175,218 @@
basic interface:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:#('one' 'two' 'three').
- slv action:[:index | Transcript showCr:'selected ' , index printString].
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:#('one' 'two' 'three').
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+
+ top add:slv in:(0.0@0.0 corner:1.0@1.0).
+ top open
get element instead of index:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:#('one' 'two' 'three').
- slv action:[:element | Transcript showCr:'selected ' , element printString].
- slv useIndex:false.
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:#('one' 'two' 'three').
+ slv action:[:element | Transcript showCr:'selected ' , element printString].
+ slv useIndex:false.
+
+ top add:slv in:(0.0@0.0 corner:1.0@1.0).
+ top open
concrete example; show filenames:
(notice: normally, you would use a FileSelectionList)
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index |
- Transcript showCr:'selected ' , index printString.
- Transcript showCr:' the value is: ', slv selectionValue].
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index |
+ Transcript showCr:'selected ' , index printString.
+ Transcript showCr:' the value is: ', slv selectionValue].
+
+ top add:slv in:(0.0@0.0 corner:1.0@1.0).
+ top open
add a scrollbar:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
allow reselect (clicking on already selected entry):
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
- slv ignoreReselect:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+ slv ignoreReselect:false.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
allow multiple selections:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
- slv multipleSelectOk:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
+ slv multipleSelectOk:true.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
same, not using index:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
- slv multipleSelectOk:true; useIndex:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
+ slv multipleSelectOk:true; useIndex:false.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
strikeout mode (single):
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
- slv strikeOut:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+ slv strikeOut:true.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
strikeout mode (multiple):
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
- slv strikeOut:true; multipleSelectOk:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+ slv strikeOut:true; multipleSelectOk:true.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
define what to do on double-click:
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCr:'selected ' , index printString].
- slv doubleClickAction:[:index | Transcript showCr:'doubleclick on ' , index printString].
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv|
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView new.
+ slv list:(Filename currentDirectory directoryContents).
+ slv action:[:index | Transcript showCr:'selected ' , index printString].
+ slv doubleClickAction:[:index | Transcript showCr:'doubleclick on ' , index printString].
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
using a Model:
- |top slv model|
-
- model := Plug new.
- model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
- model respondTo:#initial with:[1].
- model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#someAspect
- change:#setSelection:
- list:#getList
- initialSelection:#initial.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv model|
+
+ model := Plug new.
+ model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
+ model respondTo:#initial with:[1].
+ model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView
+ on:model
+ aspect:#someAspect
+ change:#setSelection:
+ list:#getList
+ initialSelection:#initial.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
notice, that the ST-80 behavaior on reselect is to send a selection change
with an index of 0.
@@ -394,80 +394,80 @@
same, with useIndex false:
- |top slv model|
-
- model := Plug new.
- model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
- model respondTo:#initial with:['bar'].
- model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#someAspect
- change:#setSelection:
- list:#getList
- initialSelection:#initial.
- slv useIndex:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |top slv model|
+
+ model := Plug new.
+ model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
+ model respondTo:#initial with:['bar'].
+ model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView
+ on:model
+ aspect:#someAspect
+ change:#setSelection:
+ list:#getList
+ initialSelection:#initial.
+ slv useIndex:false.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open
using a SelectionInList-Model:
(see how changes in the model (via list:...) are reflected in the view)
- |top slv model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
- model selection:'bar'.
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView on:model.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
-
- model inspect
+ |top slv model|
+
+ model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
+ model selection:'bar'.
+
+ top := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv := SelectionInListView on:model.
+
+ top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
+ top open.
+
+ model inspect
two selectionInListViews on the same selectionInList model:
- |top1 slv1 top2 slv2 model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
-
- top1 := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv1 := SelectionInListView on:model.
-
- top1 add:(ScrollableView forView:slv1) in:(0.0@0.0 corner:1.0@1.0).
- top1 open.
-
- top2 := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv2 := SelectionInListView on:model.
-
- top2 add:(ScrollableView forView:slv2) in:(0.0@0.0 corner:1.0@1.0).
- top2 open.
+ |top1 slv1 top2 slv2 model|
+
+ model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
+
+ top1 := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv1 := SelectionInListView on:model.
+
+ top1 add:(ScrollableView forView:slv1) in:(0.0@0.0 corner:1.0@1.0).
+ top1 open.
+
+ top2 := StandardSystemView new
+ label:'select';
+ minExtent:100@100;
+ maxExtent:300@400;
+ extent:200@200.
+
+ slv2 := SelectionInListView on:model.
+
+ top2 add:(ScrollableView forView:slv2) in:(0.0@0.0 corner:1.0@1.0).
+ top2 open.
"
! !
@@ -1322,11 +1322,11 @@
] ifFalse:[
text := items
].
- text notNil ifTrue:[
- text := text asStringCollection.
- ]
+"/ text notNil ifTrue:[
+"/ text := text asStringCollection.
+"/ ]
].
- self list:text
+ self list:text expandTabs:false
].
].
!
@@ -1584,14 +1584,14 @@
|index startSearch backSearch searchPrefix|
(key == #CursorUp) ifTrue:[
- index := self previousBeforeSelection.
- self key:key select:index x:x y:y.
- ^ self
+ index := self previousBeforeSelection.
+ self key:key select:index x:x y:y.
+ ^ self
].
(key == #CursorDown) ifTrue:[
- index := self nextAfterSelection.
- self key:key select:index x:x y:y.
- ^ self
+ index := self nextAfterSelection.
+ self key:key select:index x:x y:y.
+ ^ self
].
"/
"/ stupid: Home and End are cought in ScrollableView
@@ -1600,24 +1600,24 @@
"/ ... and implement it here)
"/
(key == #Home) ifTrue:[
- self key:key select:1 x:x y:y.
- ^ self
+ self key:key select:1 x:x y:y.
+ ^ self
].
(key == #End) ifTrue:[
- index := self size.
- self key:key select:index x:x y:y.
- ^ self
+ index := self size.
+ self key:key select:index x:x y:y.
+ ^ self
].
key == #Return ifTrue:[
- returnKeyActionStyle == #doubleClick ifTrue:[
- selection notNil ifTrue:[
- self doubleClicked
- ].
- ^ self
- ].
- returnKeyActionStyle ~~ #pass ifTrue:[
- ^ self
- ].
+ returnKeyActionStyle == #doubleClick ifTrue:[
+ selection notNil ifTrue:[
+ self doubleClicked
+ ].
+ ^ self
+ ].
+ returnKeyActionStyle ~~ #pass ifTrue:[
+ ^ self
+ ].
].
"
@@ -1627,9 +1627,9 @@
(self size > 0
and:[key isCharacter
and:[key isLetter]]) ifTrue:[
- keyActionStyle isNil ifTrue:[^ self].
- keyActionStyle == #pass ifFalse:[
- searchPrefix := key asLowercase asString.
+ keyActionStyle isNil ifTrue:[^ self].
+ keyActionStyle == #pass ifFalse:[
+ searchPrefix := key asLowercase asString.
"/ ... isISearch... ifFalse:[
"/ iSearchString := ''
@@ -1638,52 +1638,52 @@
"/ searchPrefix := iSearchString
"/ ].
- backSearch := device shiftDown.
- backSearch ifTrue:[
- selection notNil ifTrue:[
- selection size > 0 ifTrue:[
- startSearch := selection first - 1
- ] ifFalse:[
- startSearch := selection - 1
- ]
- ] ifFalse:[
- startSearch := self size
- ].
- startSearch < 1 ifTrue:[
- startSearch := self size.
- ].
- ] ifFalse:[
- selection notNil ifTrue:[
- selection size > 0 ifTrue:[
- startSearch := selection last + 1
- ] ifFalse:[
- startSearch := selection + 1
- ]
- ] ifFalse:[
- startSearch := 1
- ].
- startSearch > self size ifTrue:[
- startSearch := 1.
- ].
- ].
- index := startSearch.
- [true] whileTrue:[
- (((self at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
- index = selection ifTrue:[^ self].
- ^ self key:key select:index x:x y:y
- ].
- backSearch ifTrue:[
- index := index - 1.
- index < 1 ifTrue:[index := self size]
- ] ifFalse:[
- index := index + 1.
- index > self size ifTrue:[index := 1].
- ].
- index == startSearch ifTrue:[
- ^ self
- ]
- ]
- ].
+ backSearch := device shiftDown.
+ backSearch ifTrue:[
+ selection notNil ifTrue:[
+ selection size > 0 ifTrue:[
+ startSearch := selection first - 1
+ ] ifFalse:[
+ startSearch := selection - 1
+ ]
+ ] ifFalse:[
+ startSearch := self size
+ ].
+ startSearch < 1 ifTrue:[
+ startSearch := self size.
+ ].
+ ] ifFalse:[
+ selection notNil ifTrue:[
+ selection size > 0 ifTrue:[
+ startSearch := selection last + 1
+ ] ifFalse:[
+ startSearch := selection + 1
+ ]
+ ] ifFalse:[
+ startSearch := 1
+ ].
+ startSearch > self size ifTrue:[
+ startSearch := 1.
+ ].
+ ].
+ index := startSearch.
+ [true] whileTrue:[
+ (((self at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
+ index = selection ifTrue:[^ self].
+ ^ self key:key select:index x:x y:y
+ ].
+ backSearch ifTrue:[
+ index := index - 1.
+ index < 1 ifTrue:[index := self size]
+ ] ifFalse:[
+ index := index + 1.
+ index > self size ifTrue:[index := 1].
+ ].
+ index == startSearch ifTrue:[
+ ^ self
+ ]
+ ]
+ ].
].
^ super keyPress:key x:x y:y
!
@@ -1752,17 +1752,17 @@
|oldSelection|
(selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- keyActionStyle notNil ifTrue:[
- keyActionStyle == #pass ifTrue:[
- ^ super keyPress:key x:x y:y
- ].
- oldSelection := selection.
- self selection:index.
- self selectionChangedFrom:oldSelection.
- keyActionStyle == #selectAndDoubleClick ifTrue:[
- self doubleClicked
- ]
- ]
+ keyActionStyle notNil ifTrue:[
+ keyActionStyle == #pass ifTrue:[
+ ^ super keyPress:key x:x y:y
+ ].
+ oldSelection := selection.
+ self selection:index.
+ self selectionChangedFrom:oldSelection.
+ keyActionStyle == #selectAndDoubleClick ifTrue:[
+ self doubleClicked
+ ]
+ ]
].
!
@@ -2067,6 +2067,19 @@
!SelectionInListView methodsFor:'accessing-contents'!
+printItems:aBoolean
+ "set/clear the printItems flag. If set, items (as set via #list: or
+ as returned from the model) are sent #printString to display them.
+ If false, items are assumed to be either strings, or know how to
+ display themself in a GC (i.e. they are instances of ListEntry).
+ The default is false.
+ Caveat: printString seems to be too specialized - I'd rather have
+ a definable printSelector or - better - a printConverter.
+ This may be added in the future."
+
+ printItems := aBoolean
+!
+
list:aCollection
"set the list - redefined, since setting the list implies unselecting
and clearing attributes."
@@ -2165,7 +2178,7 @@
realize
super realize.
- self getListFromModel.
+"/ self getListFromModel. -- not needed; superclass did it already
self getSelectionFromModel.
selection notNil ifTrue:[
@@ -2278,23 +2291,23 @@
update:something with:aParameter from:changedObject
changedObject == model ifTrue:[
- something == aspectMsg ifTrue:[
- self getListFromModel.
- self getSelectionFromModel.
- ^ self
- ].
- something == listMsg ifTrue:[
- self getListFromModel.
- ^ self
- ].
- something == initialSelectionMsg ifTrue:[
- self getSelectionFromModel.
- ^ self
- ].
- something == #empty ifTrue:[
- self list:nil.
- ^ self
- ].
+ something == aspectMsg ifTrue:[
+ self getListFromModel.
+ self getSelectionFromModel.
+ ^ self
+ ].
+ something == listMsg ifTrue:[
+ self getListFromModel.
+ ^ self
+ ].
+ something == initialSelectionMsg ifTrue:[
+ self getSelectionFromModel.
+ ^ self
+ ].
+ something == #empty ifTrue:[
+ self list:nil.
+ ^ self
+ ].
].
^ super update:something with:aParameter from:changedObject
! !
@@ -2424,4 +2437,3 @@
SelectionInListView new modelInterface
"
! !
-
--- a/Toggle.st Fri May 12 20:25:18 1995 +0200
+++ b/Toggle.st Wed May 17 14:26:27 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.16 1995-05-06 14:18:02 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.17 1995-05-17 12:26:23 claus Exp $
'!
!Toggle class methodsFor:'documentation'!
@@ -44,15 +44,15 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.16 1995-05-06 14:18:02 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.17 1995-05-17 12:26:23 claus Exp $
"
!
documentation
"
- this button changes state whenever pressed and stays pressed until pressed
- again. All the main action is in Button, Toggle just redefines buttonpress/
- release behavior.
+ this button changes state whenever clicked upon and stays down (pressed)
+ until clicked again. All the main action is in Button and the controller
+ (ToggleController).
The toggle may optionally display a little kind-of-lamp (or LED), which
is turned on when the toggle is pressed. (i.e. as in the Interviews toolkit).
@@ -61,7 +61,8 @@
pressAction or releaseAction.
For ST-80 compatibility, if the model is nonNil, this one gets a new
- value and is sent a changed message.
+ value and is sent a changed message. Also, the toggle will follow changes
+ in the model and update its display as appropriate.
If nonNil, the model is supposed to be a ValueHolder holding true or false.
@@ -80,12 +81,13 @@
examples
"
Examples:
- Try these, to see what is possible.
+ Try all, to see what is possible.
(notice, that these examples are meant to show what can be done;
usually, all style-related stuff is preinitialized - you should not
normally play around with onLevel, offLevel, showLamp: etc)
+
simple:
|v t|
@@ -96,6 +98,7 @@
t action:[:value | Transcript show:'toggle state: '; showCr:value.].
v open
+
separate press/release actions:
|v t|
@@ -107,6 +110,7 @@
t releaseAction:[Transcript showCr:'toggle released'.].
v open
+
changing logo:
|v t|
@@ -118,6 +122,7 @@
t releaseAction:[Transcript showCr:'larger'. t label:'eat me'].
v open
+
changing logo and freezing size (looks better):
|v t|
@@ -133,6 +138,7 @@
t releaseAction:[Transcript showCr:'larger'. t label:'eat me'].
v open
+
adding a lamp (in some view styles, this is the default anyway):
|v t|
@@ -145,6 +151,7 @@
t releaseAction:[Transcript showCr:'off'. t label:'off'].
v open
+
changing lamps color:
|v t|
@@ -158,6 +165,7 @@
t releaseAction:[Transcript showCr:'off'. t label:'off'.].
v open
+
changing lamps color & size:
|v t|
@@ -171,6 +179,7 @@
t releaseAction:[Transcript showCr:'off'. t label:'off'.].
v open
+
lamp only - no '3D going-in' (this is the default with IRIS style)
|v t|
@@ -184,6 +193,7 @@
t releaseAction:[Transcript showCr:'off'. t label:'off'].
v open
+
lamp and freezing size of the label (looks better):
|v t|
@@ -197,6 +207,7 @@
t releaseAction:[Transcript showCr:'off'. t label:'off'].
v open
+
another variation:
|v t|
@@ -211,6 +222,7 @@
t releaseAction:[Transcript showCr:'off'. t label:'off'].
v open
+
and another one:
|v t|
@@ -228,6 +240,7 @@
t releaseAction:[Transcript showCr:'off'. t showLamp:false. t label:'off'].
v open
+
another font:
|v t|
@@ -241,6 +254,7 @@
t releaseAction:[Transcript showCr:'off'.].
v open
+
another font (no, I dont know what it means :-):
|v t|
@@ -255,7 +269,8 @@
t releaseAction:[Transcript showCr:'off'.].
v open
- using a model (look at value of model in inspector):
+
+ using a model (look at 'value' in the inspector):
|m v t|
@@ -268,6 +283,7 @@
t model:m.
v open
+
using a model with different changeSelector:
|m v t|
@@ -284,6 +300,23 @@
t origin:10 @ 50.
t model:m; change:#setValue2:.
v open
+
+
+ two toggles on the same model:
+
+ |m v t|
+
+ m := true asValue.
+
+ v := StandardSystemView new extent:200@200.
+ t := Toggle label:'press here' in:v.
+ t origin:10 @ 10.
+ t model:m.
+
+ t := Toggle label:'or here' in:v.
+ t origin:10 @ 50.
+ t model:m.
+ v open
"
! !
--- a/ToggleC.st Fri May 12 20:25:18 1995 +0200
+++ b/ToggleC.st Wed May 17 14:26:27 1995 +0200
@@ -35,7 +35,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ToggleC.st,v 1.6 1995-05-10 02:30:25 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ToggleC.st,v 1.7 1995-05-17 12:26:27 claus Exp $
"
!
@@ -45,11 +45,14 @@
user interaction: they always triggerOnDown, and ignore buttonrelease.
Finally, every buttonPress leads to a toggle action.
- ToggleController redefines the actionBlock, since it inherits press-
+ ToggleController adds another actionBlock, since it inherits press-
and releaseActions, while we want one actionBlock to be used for both
on- and off. The actionBlock (if any) is evaluated with the current
toggles state if it expects an argument, or without argument if its a no-arg
block.
+
+ Other than that, all model relations are inherited - i.e. if the view has a model,
+ that one gets change-messages and the toggle updates on aspect changes.
"
! !
--- a/ToggleController.st Fri May 12 20:25:18 1995 +0200
+++ b/ToggleController.st Wed May 17 14:26:27 1995 +0200
@@ -35,7 +35,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ToggleController.st,v 1.6 1995-05-10 02:30:25 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ToggleController.st,v 1.7 1995-05-17 12:26:27 claus Exp $
"
!
@@ -45,11 +45,14 @@
user interaction: they always triggerOnDown, and ignore buttonrelease.
Finally, every buttonPress leads to a toggle action.
- ToggleController redefines the actionBlock, since it inherits press-
+ ToggleController adds another actionBlock, since it inherits press-
and releaseActions, while we want one actionBlock to be used for both
on- and off. The actionBlock (if any) is evaluated with the current
toggles state if it expects an argument, or without argument if its a no-arg
block.
+
+ Other than that, all model relations are inherited - i.e. if the view has a model,
+ that one gets change-messages and the toggle updates on aspect changes.
"
! !