.
--- a/Button.st Mon May 08 17:19:27 1995 +0200
+++ b/Button.st Tue May 09 03:57:16 1995 +0200
@@ -39,7 +39,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.20 1995-05-03 00:28:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.21 1995-05-09 01:54:53 claus Exp $
'!
!Button class methodsFor:'documentation'!
@@ -60,7 +60,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.20 1995-05-03 00:28:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.21 1995-05-09 01:54:53 claus Exp $
"
!
@@ -1095,9 +1095,7 @@
controller pressed ifTrue:[
self turnOffWithoutRedraw.
-"/ controller active:false.
-"/ controller pressed:false.
-"/ self level:offLevel.
+ offLevel ~~ onLevel ifTrue:[self redrawEdges].
self redraw
]
!
@@ -1119,8 +1117,7 @@
controller pressed ifFalse:[
self turnOnWithoutRedraw.
-"/ controller pressed:true.
-"/ self level:onLevel.
+ offLevel ~~ onLevel ifTrue:[self redrawEdges].
self redraw
]
!
--- a/ButtonC.st Mon May 08 17:19:27 1995 +0200
+++ b/ButtonC.st Tue May 09 03:57:16 1995 +0200
@@ -14,8 +14,8 @@
Controller subclass:#ButtonController
instanceVariableNames:'enabled pressed active entered isTriggerOnDown autoRepeat
- repeatBlock initialDelay repeatDelay pressActionBlock
- releaseActionBlock isToggle'
+ repeatBlock initialDelay repeatDelay pressActionBlock
+ releaseActionBlock isToggle'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -39,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ButtonC.st,v 1.7 1995-05-06 14:16:24 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ButtonC.st,v 1.8 1995-05-09 01:54:58 claus Exp $
"
!
@@ -48,20 +48,36 @@
ButtonControllers are used with buttons and handle all user interaction.
These are automatically created when a Button is created, therefore no manual
action is required for creation.
+ In normal applications, you dont have to care for the controller; access to the
+ controllers behavior is also possible via messages to the button.
+ (setting actions, controlling autorepeat etc.)
Instance variables:
enabled <Boolean> pressing is allowed (default: true)
+
pressed <Boolean> true if currently pressed (read-only)
+
entered <Boolean> true if the cursor is currently in this view
+
isTriggerOnDown <Boolean> controls if the action should be executed on
press or on release (default: on release).
+
+ isToggle <Boolean> controls if the button should show toggle
+ behavior (as opposed to one-shot behavior)
+
pressActionBlock <Block> block to evaluate when pressed (default: noop)
+
releaseActionBlock <Block> block to evaluate when released (default: noop)
+
autoRepeat <Boolean> auto-repeats when pressed long enough (default: false)
+
initialDelay <Number> seconds till first auto-repeat (default: 0.2)
+
repeatDelay <Number> seconds of repeat intervall (default: 0.025)
+
repeatBlock <Block> block evaluated for auto-repeat (internal)
+
active <Boolean> true during action evaluation (internal)
"
! !
@@ -91,8 +107,9 @@
!
active
- "return true, if I am active; that is currently performing my
- action."
+ "return true, if I am active;
+ that is: currently performing my action.
+ This query can be used to avoid multiple redraws."
^ active
!
@@ -213,9 +230,9 @@
"toggle and perform the action"
enabled ifTrue:[
- self toggleNoAction.
- self performAction.
- view changed:#toggle with:pressed
+ self toggleNoAction.
+ self performAction.
+ view changed:#toggle with:pressed
]
!
@@ -248,37 +265,33 @@
|sym action|
(button == 1 or:[button == #select]) ifFalse:[
- ^ super buttonPress:button x:x y:y
+ ^ super buttonPress:button x:x y:y
].
enabled ifTrue:[
- isToggle ifTrue:[
- self toggle.
- ^ self
- ].
+ isToggle ifTrue:[
+ self toggle.
+ ^ self
+ ].
- pressed ifFalse:[
- pressed := true.
- view showActive.
+ pressed ifFalse:[
+ pressed := true.
+ view showActive.
- (pressActionBlock notNil or:[model notNil]) ifTrue:[
- "
- force output - so that button is drawn correctly in case
- of any long-computation (at high priority)
- "
- view device synchronizeOutput.
- ].
+ (pressActionBlock notNil or:[model notNil]) ifTrue:[
+ "
+ force output - so that button is drawn correctly in case
+ of any long-computation (at high priority)
+ "
+ view device synchronizeOutput.
+ ].
- active := true.
-
- self performAction.
+ self performAction.
- active := false.
-
- autoRepeat ifTrue:[
- Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
- ]
- ]
+ autoRepeat ifTrue:[
+ Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
+ ]
+ ]
]
!
@@ -288,73 +301,69 @@
|sym|
(button == 1 or:[button == #select]) ifFalse:[
- ^ super buttonRelease:button x:x y:y
+ ^ super buttonRelease:button x:x y:y
].
isToggle ifTrue:[
- ^ self
+ ^ self
].
pressed ifTrue:[
- autoRepeat ifTrue:[
- Processor removeTimedBlock:repeatBlock
- ].
- pressed := false.
- view showPassive.
+ autoRepeat ifTrue:[
+ Processor removeTimedBlock:repeatBlock
+ ].
+ pressed := false.
+ view showPassive.
- enabled ifTrue:[
- "
- only perform action if released within myself
- "
- ((x >= 0)
- and:[x <= view width
- and:[y >= 0
- and:[y <= view height]]]) ifTrue:[
- (releaseActionBlock notNil or:[model notNil]) ifTrue:[
- "
- force output - so that button is drawn correctly in case
- of any long-computation (at high priority)
- "
- view device synchronizeOutput.
- ].
+ enabled ifTrue:[
+ "
+ only perform action if released within myself
+ "
+ ((x >= 0)
+ and:[x <= view width
+ and:[y >= 0
+ and:[y <= view height]]]) ifTrue:[
+ (releaseActionBlock notNil or:[model notNil]) ifTrue:[
+ "
+ force output - so that button is drawn correctly in case
+ of any long-computation (at high priority)
+ "
+ view device synchronizeOutput.
+ ].
- active := true.
-
- self performAction.
-
- active := false.
- ]
- ]
+ self performAction.
+ ]
+ ]
]
!
pointerEnter:state x:x y:y
- "redraw with enteredColors if they differ from the normal colors"
+ "mouse pointer entered my view.
+ Redraw with enteredColors if they differ from the normal colors"
entered := true.
- pressed ifTrue:[
- "
- reentered after a leave with mouse-button down;
- restart autorepeating and/or if I am a button with
- isTriggerOnDown, show active again.
- "
- enabled ifTrue:[
+ enabled ifTrue:[
+ pressed ifTrue:[
+ "
+ reentered after a leave with mouse-button down;
+ restart autorepeating and/or if I am a button with
+ triggerOnDown, show active again.
+ "
autoRepeat ifTrue:[
Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
].
isTriggerOnDown ifFalse:[
view showActive.
]
- ]
- ] ifFalse:[
- enabled ifTrue:[
+ ] ifFalse:[
view redraw
]
]
!
pointerLeave:state
- "redraw with normal colors if they differ from enteredColors"
+ "mouse pointer left my view.
+ Redraw with normal colors if they differ from enteredColors"
entered := false.
pressed ifTrue:[
@@ -379,20 +388,36 @@
performAction
|action|
+ "
+ ST/X style actionBlock evaluation ...
+ "
pressed ifTrue:[
- action := pressActionBlock
+ action := pressActionBlock
] ifFalse:[
- action := releaseActionBlock
+ action := releaseActionBlock
].
- action notNil ifTrue:[action value].
+ action notNil ifTrue:[
+ active := true.
+ action numArgs == 0 ifTrue:[
+ action value
+ ] ifFalse:[
+ action value:pressed
+ ].
+ active := false.
+ ].
+ "
+ ST-80 style model notification ...
+ "
(isToggle
or:[(isTriggerOnDown and:[pressed])
or:[isTriggerOnDown not and:[pressed not]]]) ifTrue:[
- "the ST-80 way of doing things"
- view notNil ifTrue:[
- view sendChangeMessageWith:pressed.
- ].
+ "the ST-80 way of doing things"
+ view notNil ifTrue:[
+ active := true.
+ view sendChangeMessageWith:pressed.
+ active := false.
+ ].
].
!
@@ -401,13 +426,11 @@
!
keyPress:key x:x y:y
- "only trigger, if I am the focusView of my group"
-
- |group|
+ "trigger on Return and space, if I am the focusView of my group
+ (i.e. if I got an explicit focus)"
- ((group := view windowGroup) notNil
- and:[group focusView == view]) ifTrue:[
- (key == #Return or:[key == Character space]) ifTrue:[
+ (key == #Return or:[key == Character space]) ifTrue:[
+ view hasFocus ifTrue:[
"just simulate a buttonPress/release here."
self buttonPress:1 x:0 y:0.
self buttonRelease:1 x:0 y:0.
--- a/ButtonController.st Mon May 08 17:19:27 1995 +0200
+++ b/ButtonController.st Tue May 09 03:57:16 1995 +0200
@@ -14,8 +14,8 @@
Controller subclass:#ButtonController
instanceVariableNames:'enabled pressed active entered isTriggerOnDown autoRepeat
- repeatBlock initialDelay repeatDelay pressActionBlock
- releaseActionBlock isToggle'
+ repeatBlock initialDelay repeatDelay pressActionBlock
+ releaseActionBlock isToggle'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -39,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ButtonController.st,v 1.7 1995-05-06 14:16:24 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ButtonController.st,v 1.8 1995-05-09 01:54:58 claus Exp $
"
!
@@ -48,20 +48,36 @@
ButtonControllers are used with buttons and handle all user interaction.
These are automatically created when a Button is created, therefore no manual
action is required for creation.
+ In normal applications, you dont have to care for the controller; access to the
+ controllers behavior is also possible via messages to the button.
+ (setting actions, controlling autorepeat etc.)
Instance variables:
enabled <Boolean> pressing is allowed (default: true)
+
pressed <Boolean> true if currently pressed (read-only)
+
entered <Boolean> true if the cursor is currently in this view
+
isTriggerOnDown <Boolean> controls if the action should be executed on
press or on release (default: on release).
+
+ isToggle <Boolean> controls if the button should show toggle
+ behavior (as opposed to one-shot behavior)
+
pressActionBlock <Block> block to evaluate when pressed (default: noop)
+
releaseActionBlock <Block> block to evaluate when released (default: noop)
+
autoRepeat <Boolean> auto-repeats when pressed long enough (default: false)
+
initialDelay <Number> seconds till first auto-repeat (default: 0.2)
+
repeatDelay <Number> seconds of repeat intervall (default: 0.025)
+
repeatBlock <Block> block evaluated for auto-repeat (internal)
+
active <Boolean> true during action evaluation (internal)
"
! !
@@ -91,8 +107,9 @@
!
active
- "return true, if I am active; that is currently performing my
- action."
+ "return true, if I am active;
+ that is: currently performing my action.
+ This query can be used to avoid multiple redraws."
^ active
!
@@ -213,9 +230,9 @@
"toggle and perform the action"
enabled ifTrue:[
- self toggleNoAction.
- self performAction.
- view changed:#toggle with:pressed
+ self toggleNoAction.
+ self performAction.
+ view changed:#toggle with:pressed
]
!
@@ -248,37 +265,33 @@
|sym action|
(button == 1 or:[button == #select]) ifFalse:[
- ^ super buttonPress:button x:x y:y
+ ^ super buttonPress:button x:x y:y
].
enabled ifTrue:[
- isToggle ifTrue:[
- self toggle.
- ^ self
- ].
+ isToggle ifTrue:[
+ self toggle.
+ ^ self
+ ].
- pressed ifFalse:[
- pressed := true.
- view showActive.
+ pressed ifFalse:[
+ pressed := true.
+ view showActive.
- (pressActionBlock notNil or:[model notNil]) ifTrue:[
- "
- force output - so that button is drawn correctly in case
- of any long-computation (at high priority)
- "
- view device synchronizeOutput.
- ].
+ (pressActionBlock notNil or:[model notNil]) ifTrue:[
+ "
+ force output - so that button is drawn correctly in case
+ of any long-computation (at high priority)
+ "
+ view device synchronizeOutput.
+ ].
- active := true.
-
- self performAction.
+ self performAction.
- active := false.
-
- autoRepeat ifTrue:[
- Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
- ]
- ]
+ autoRepeat ifTrue:[
+ Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
+ ]
+ ]
]
!
@@ -288,73 +301,69 @@
|sym|
(button == 1 or:[button == #select]) ifFalse:[
- ^ super buttonRelease:button x:x y:y
+ ^ super buttonRelease:button x:x y:y
].
isToggle ifTrue:[
- ^ self
+ ^ self
].
pressed ifTrue:[
- autoRepeat ifTrue:[
- Processor removeTimedBlock:repeatBlock
- ].
- pressed := false.
- view showPassive.
+ autoRepeat ifTrue:[
+ Processor removeTimedBlock:repeatBlock
+ ].
+ pressed := false.
+ view showPassive.
- enabled ifTrue:[
- "
- only perform action if released within myself
- "
- ((x >= 0)
- and:[x <= view width
- and:[y >= 0
- and:[y <= view height]]]) ifTrue:[
- (releaseActionBlock notNil or:[model notNil]) ifTrue:[
- "
- force output - so that button is drawn correctly in case
- of any long-computation (at high priority)
- "
- view device synchronizeOutput.
- ].
+ enabled ifTrue:[
+ "
+ only perform action if released within myself
+ "
+ ((x >= 0)
+ and:[x <= view width
+ and:[y >= 0
+ and:[y <= view height]]]) ifTrue:[
+ (releaseActionBlock notNil or:[model notNil]) ifTrue:[
+ "
+ force output - so that button is drawn correctly in case
+ of any long-computation (at high priority)
+ "
+ view device synchronizeOutput.
+ ].
- active := true.
-
- self performAction.
-
- active := false.
- ]
- ]
+ self performAction.
+ ]
+ ]
]
!
pointerEnter:state x:x y:y
- "redraw with enteredColors if they differ from the normal colors"
+ "mouse pointer entered my view.
+ Redraw with enteredColors if they differ from the normal colors"
entered := true.
- pressed ifTrue:[
- "
- reentered after a leave with mouse-button down;
- restart autorepeating and/or if I am a button with
- isTriggerOnDown, show active again.
- "
- enabled ifTrue:[
+ enabled ifTrue:[
+ pressed ifTrue:[
+ "
+ reentered after a leave with mouse-button down;
+ restart autorepeating and/or if I am a button with
+ triggerOnDown, show active again.
+ "
autoRepeat ifTrue:[
Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
].
isTriggerOnDown ifFalse:[
view showActive.
]
- ]
- ] ifFalse:[
- enabled ifTrue:[
+ ] ifFalse:[
view redraw
]
]
!
pointerLeave:state
- "redraw with normal colors if they differ from enteredColors"
+ "mouse pointer left my view.
+ Redraw with normal colors if they differ from enteredColors"
entered := false.
pressed ifTrue:[
@@ -379,20 +388,36 @@
performAction
|action|
+ "
+ ST/X style actionBlock evaluation ...
+ "
pressed ifTrue:[
- action := pressActionBlock
+ action := pressActionBlock
] ifFalse:[
- action := releaseActionBlock
+ action := releaseActionBlock
].
- action notNil ifTrue:[action value].
+ action notNil ifTrue:[
+ active := true.
+ action numArgs == 0 ifTrue:[
+ action value
+ ] ifFalse:[
+ action value:pressed
+ ].
+ active := false.
+ ].
+ "
+ ST-80 style model notification ...
+ "
(isToggle
or:[(isTriggerOnDown and:[pressed])
or:[isTriggerOnDown not and:[pressed not]]]) ifTrue:[
- "the ST-80 way of doing things"
- view notNil ifTrue:[
- view sendChangeMessageWith:pressed.
- ].
+ "the ST-80 way of doing things"
+ view notNil ifTrue:[
+ active := true.
+ view sendChangeMessageWith:pressed.
+ active := false.
+ ].
].
!
@@ -401,13 +426,11 @@
!
keyPress:key x:x y:y
- "only trigger, if I am the focusView of my group"
-
- |group|
+ "trigger on Return and space, if I am the focusView of my group
+ (i.e. if I got an explicit focus)"
- ((group := view windowGroup) notNil
- and:[group focusView == view]) ifTrue:[
- (key == #Return or:[key == Character space]) ifTrue:[
+ (key == #Return or:[key == Character space]) ifTrue:[
+ view hasFocus ifTrue:[
"just simulate a buttonPress/release here."
self buttonPress:1 x:0 y:0.
self buttonRelease:1 x:0 y:0.
--- a/CodeView.st Mon May 08 17:19:27 1995 +0200
+++ b/CodeView.st Tue May 09 03:57:16 1995 +0200
@@ -11,7 +11,7 @@
"
Workspace subclass:#CodeView
- instanceVariableNames:'acceptAction explainAction'
+ instanceVariableNames:'explainAction'
classVariableNames:''
poolDictionaries:''
category:'Interface-Workspace'
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.16 1995-05-07 01:58:01 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.17 1995-05-09 01:55:04 claus Exp $
'!
!CodeView class methodsFor:'documentation'!
@@ -42,21 +42,20 @@
version
"
-$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.16 1995-05-07 01:58:01 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.17 1995-05-09 01:55:04 claus Exp $
"
!
documentation
"
- a view for code which can recompile its contents.
- It adds accept and explain to the menu, and defines two new actions:
- acceptAction to be performed for accept
- and explainAction to be performed for explain.
+ a view for text which is known to be smalltalk code.
+ It adds explain to the menu, and defines another action:
+ explainAction to be performed for explain.
- These actions are to be defined by the user of this view
+ This action is to be defined by the user of this view
(i.e. ususally the owning browser)
- If used with a model, accept sends the changeMsg to it.
+ If used with a model, accept sends the changeMsg to it (as defined in EditTextView).
(however, it is possible to define moth changeMsg and acceptAction)
@@ -109,18 +108,6 @@
!CodeView methodsFor:'accessing'!
-acceptAction:aBlock
- "set the action to be performed on accept"
-
- acceptAction := aBlock
-!
-
-acceptAction
- "return the action to be performed on accept (or nil)"
-
- ^ acceptAction
-!
-
explainAction:aBlock
"set the action to be performed on explain"
@@ -130,9 +117,10 @@
!CodeView methodsFor:'user actions'!
accept
- "accept action;
- save cursor and selection; then execute the accept-action and/or
- changeMessage. Finally restore cursor and selection."
+ "redefined accept action;
+ save cursor and selection to allow restore in case of an error
+ (we are typically compiling here ... and the compiler may show
+ errors by highlighting them)"
codeStartPosition := 1.
[
@@ -143,18 +131,7 @@
toLine:selectionEndLine col:selectionEndCol.
ex return
] do:[
- |n|
-
- "/
- "/ ST/X way of doing things
- "/
- acceptAction notNil ifTrue:[
- acceptAction value:(self list "contents")
- ].
- "/
- "/ MVC way of doing it
- "/
- self sendChangeMessageWith:(self contents)
+ super accept.
]
] valueNowOrOnUnwindDo:[
self unselect.
--- a/DialogBox.st Mon May 08 17:19:27 1995 +0200
+++ b/DialogBox.st Tue May 09 03:57:16 1995 +0200
@@ -15,7 +15,7 @@
ModalBox subclass:#DialogBox
instanceVariableNames:'buttonPanel okButton okAction abortButton abortAction
acceptReturnAsOK yPosition leftIndent addedComponents
- inputFieldGroup accepted'
+ inputFieldGroup acceptOnLeave accepted tabableElements'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
@@ -25,7 +25,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/DialogBox.st,v 1.11 1995-05-07 00:15:45 claus Exp $
+$Header: /cvs/stx/stx/libwidg/DialogBox.st,v 1.12 1995-05-09 01:55:09 claus Exp $
"
!
@@ -71,6 +71,11 @@
inputFieldGroup <EnterFieldGroup>
for added input fields
+ acceptOnLeave <Boolean> if true (the default) and there are
+ tabable inputFields, accept and close when
+ 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)
@@ -84,10 +89,90 @@
"
mostly, DialogBox is used as an abstract class as a base for InfoBox,
YesNoBox etc.
+ For most simple standard dialogs, there are ready to use
+ methods in the class protocol.
+ For example:
+
+ info & warnings:
+
+ Dialog information:'hi there'
+
+ Dialog warn:'oops'
+
+
+ yes/no questions:
+
+ (Dialog confirm:'is this simple ?')
+ ifTrue:[
+ Transcript showCr:'thats what I expected'
+ ] ifFalse:[
+ Transcript showCr:'read more examples and documentation'
+ ]
+
+
+ yes/no question with cancel option:
+
+ |answer|
+
+ answer := Dialog confirmWithCancel:'is this simple ?'.
+ answer isNil ifTrue:[
+ Transcript showCr:'no easy decision'
+ ] ifFalse:[
+ answer ifTrue:[
+ Transcript showCr:'thats what I expected'
+ ] ifFalse:[
+ Transcript showCr:'read more examples and documentation'
+ ]
+ ]
+
+
+ asking for a string:
+
+ |s|
+
+ s := Dialog request:'enter your name, please:'.
+ s notNil ifTrue:[
+ Transcript showCr:'you entered: ' , s.
+ ]
+
+
+ asking for a string with given default:
+
+ |s|
+
+ s := Dialog
+ request:'enter your name, please:'
+ initialAnswer:(OperatingSystem getLoginName).
+ s notNil ifTrue:[
+ Transcript showCr:'you entered: ' , s.
+ ]
+
+
+ asking for a filename:
+
+ |s|
+
+ s := Dialog
+ requestFileName:'select a file, please:'
+ default:''.
+ Transcript show:'you entered: '; showCr:s.
+
+
+ with changed button label and pattern:
+
+ |s|
+
+ s := Dialog
+ requestFileName:'select a file, please:'
+ default:''
+ ok:'show'
+ abort:'cancel'
+ pattern:'*.rc'.
+ Transcript show:'you entered: '; showCr:s.
+
However, you can construct dialogs programmatically, as shown in
the following examples:
-
basic (unusable) example:
DialogBox new open
@@ -188,7 +273,8 @@
DialogBox new
addTextLabel:'hello';
- addTextLabel:(Image fromFile:'bitmaps/garfield.gif');
+ addTextLabel:((Image fromFile:'bitmaps/garfield.gif')
+ magnifiedTo:200@150);
addTextLabel:'world';
addAbortButton;
addOkButton;
@@ -391,8 +477,11 @@
box extent:200@300.
box addCheckBox:'check1' on:value1.
+ box addVerticalSpace.
box addCheckBox:'check2' on:value2.
+ box addVerticalSpace.
box addCheckBox:'check3' on:value3.
+ box addVerticalSpace.
box addCheckBox:'check4' on:value4.
box addAbortButton; addOkButton.
@@ -696,6 +785,16 @@
accepted := true.
!
+lastFieldLeft
+ "if the dialog involves input fields, this is called
+ when the last field is left by Return-key or NextField-key"
+
+ acceptOnLeave ifTrue:[
+ accepted := true.
+ self okPressed
+ ].
+!
+
okPressed
"user pressed ok-button; make myself invisible and if an action was
specified do it"
@@ -822,12 +921,25 @@
^ aComponent
!
+addComponent:aComponent tabable:tabable
+ "add a component with its prefered height and full width.
+ Returns the component."
+
+ tabable ifTrue:[
+ tabableElements isNil ifTrue:[
+ tabableElements := OrderedCollection new
+ ].
+ tabableElements add:aComponent
+ ].
+ ^ self addComponent:aComponent
+ withHeight:(aComponent preferedExtent y).
+!
+
addComponent:aComponent
"add a component with its prefered height and full width.
Returns the component."
- ^ self addComponent:aComponent
- withHeight:(aComponent preferedExtent y).
+ ^ self addComponent:aComponent tabable:false
!
addTextLabel:aString
@@ -896,7 +1008,7 @@
"
!
-addCheckBox:label on:aModel
+addCheckBox:label on:aModel tabable:tabable
"create a checkBox with label on aModel and add it.
Returns the box."
@@ -904,26 +1016,44 @@
b := CheckBox on:aModel.
b label:label.
- self addComponent:b.
+ self addComponent:b tabable:tabable.
^ b
!
+addCheckBox:label on:aModel
+ "create a checkBox with label on aModel and add it.
+ Returns the box."
+
+ ^ self addCheckBox:label on:aModel tabable:true
+!
+
+addInputField:aField tabable:tabable
+ "add an already created input field; return the field.
+ If tabable is true, the field is put into a group, to allow
+ stepping through the fields with #NextField/#PreviousField keys.
+ Returns the field."
+
+ self addComponent:aField tabable:tabable.
+ tabable ifTrue:[
+ inputFieldGroup isNil ifTrue:[
+ inputFieldGroup := EnterFieldGroup new.
+ inputFieldGroup leaveAction:[self lastFieldLeft].
+ aField hasKeyboardFocus:true.
+ ].
+ inputFieldGroup add:aField.
+ self delegate:(KeyboardForwarder to:inputFieldGroup condition:#noFocus).
+ ].
+ ^ aField
+!
+
addInputField:aField
"add an already created input field; return the field.
Returns the field."
- self addComponent:aField.
- inputFieldGroup isNil ifTrue:[
- inputFieldGroup := EnterFieldGroup new.
- inputFieldGroup leaveAction:[accepted := true. self okPressed].
- aField hasKeyboardFocus:true.
- ].
- inputFieldGroup add:aField.
- self delegate:(KeyboardForwarder to:inputFieldGroup condition:#noFocus).
- ^ aField
+ ^ self addInputField:aField tabable:true
!
-addInputFieldOn:aModel
+addInputFieldOn:aModel tabable:tabable
"create an input field on aModel and add it.
Returns the field."
@@ -931,21 +1061,27 @@
f := EditField new.
f model:aModel.
- self addInputField:f.
+ self addInputField:f tabable:tabable.
^ f
+!
+
+addInputFieldOn:aModel
+ "create an input field on aModel and add it.
+ Returns the field."
+
+ ^ self addInputFieldOn:aModel tabable:true
"
- |dialog model field ok|
+ |dialog model field|
model := '' asValue.
dialog := DialogBox new.
dialog addTextLabel:'enter a string'.
field := dialog addInputFieldOn:model.
- dialog addAbortButton; addOkButton:[field accept. ok := true].
- ok := false.
+ dialog addAbortButton; addOkButton.
dialog open.
- ok ifTrue:[Transcript showCr:model value].
+ dialog accepted ifTrue:[Transcript showCr:model value].
"
!
@@ -995,6 +1131,7 @@
mm := ViewSpacing.
acceptReturnAsOK := true.
+ acceptOnLeave := true.
buttonPanel := HorizontalPanelView in:self.
buttonPanel
@@ -1038,7 +1175,25 @@
!
focusSequence
- ^ buttonPanel subViews
+ "return the elements through which we can step via
+ NextField/PreviousField keys.
+ Here we return all tabable fields followed by all buttons in
+ the panel."
+
+ |fields buttons|
+
+ tabableElements isNil ifTrue:[
+ fields := #()
+ ] ifFalse:[
+ fields := tabableElements
+ ].
+ buttonPanel notNil ifTrue:[
+ buttons := buttonPanel subViews.
+ buttons notNil ifTrue:[
+ fields := fields , buttonPanel subViews
+ ]
+ ].
+ ^ fields
!
reAdjustGeometry
@@ -1054,6 +1209,9 @@
!DialogBox methodsFor:'queries'!
accepted
+ "after the box has closed: return true if accepted,
+ false if canceled"
+
^ accepted
!
--- a/EFGroup.st Mon May 08 17:19:27 1995 +0200
+++ b/EFGroup.st Tue May 09 03:57:16 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.9 1995-05-07 00:15:50 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.10 1995-05-09 01:55:13 claus Exp $
'!
!EnterFieldGroup class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.9 1995-05-07 00:15:50 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.10 1995-05-09 01:55:13 claus Exp $
"
!
@@ -343,10 +343,11 @@
aField enableAction:[
"/ Transcript showCr:'enable field with: ' , aField editValue.
- currentField notNil ifTrue:[
- currentField disable
- ].
- currentField := aField
+"/ currentField notNil ifTrue:[
+"/ currentField disable
+"/ ].
+"/ currentField := aField
+ self makeActive:aField
].
"set the fields leaveAction to enable next field"
@@ -472,7 +473,7 @@
"key-press in any field - forward the key to the active field"
currentField notNil ifTrue:[
- currentField keyPress:key x:0 y:0
+ currentField keyPress:key x:-1 y:-1
]
!
--- a/ETxtView.st Mon May 08 17:19:27 1995 +0200
+++ b/ETxtView.st Tue May 09 03:57:16 1995 +0200
@@ -17,7 +17,7 @@
prevCursorState readOnly modified fixedSize exceptionBlock
errorMessage cursorFgColor cursorBgColor cursorType undoAction
typeOfSelection lastString lastReplacement lastAction replacing
- showMatchingParenthesis hasKeyboardFocus'
+ showMatchingParenthesis hasKeyboardFocus acceptAction lockUpdates'
classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
DefaultCursorType'
poolDictionaries:''
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.26 1995-05-07 01:58:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.27 1995-05-09 01:55:23 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -49,13 +49,20 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.26 1995-05-07 01:58:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.27 1995-05-09 01:55:23 claus Exp $
"
!
documentation
"
a view for editable text - adds editing functionality to TextView
+ Also, it adds accept functionality, and defines a new actionBlock:
+ acceptAction to be performed for accept
+
+ If used with a model, this is informed by sending it a changeMsg with
+ the current contents as argument.
+ (however, it is possible to define moth changeMsg and acceptAction)
+
Instance variables:
@@ -104,6 +111,45 @@
DefaultCursorType := StyleSheet at:'textCursorType' default:#block.
! !
+!EditTextView methodsFor:'change & update '!
+
+getListFromModel
+ "get my contents from the model.
+ Redefined to ignore updates resulting from my own change."
+
+ "
+ ignore updates from my own change
+ "
+ lockUpdates ifTrue:[
+ lockUpdates := false.
+ ^ self
+ ].
+ ^ super getListFromModel
+!
+
+accept
+ "accept the current contents by executing the accept-action and/or
+ changeMessage."
+
+ lockUpdates := true.
+ "/
+ "/ ST/X way of doing things
+ "/ as a historic (and temporary) leftover,
+ "/ the block is called with a stringCollection
+ "/ - not with the actual string
+ "/
+ acceptAction notNil ifTrue:[
+ acceptAction value:self list
+ ].
+
+ "/
+ "/ ST-80 way of doing it
+ "/
+ self sendChangeMessageWith:self contents.
+
+ lockUpdates := false.
+! !
+
!EditTextView methodsFor:'event processing'!
hasKeyboardFocus:aBoolean
@@ -178,6 +224,10 @@
keyPress:key x:x y:y
"handle keyboard input"
+ |sensor n|
+
+ sensor := self sensor.
+
(key isMemberOf:Character) ifTrue:[
readOnly ifFalse:[
typeOfSelection == #paste ifTrue:[
@@ -235,7 +285,7 @@
Fn pastes a key-sequence (but only if not overlayed with
another function in the keyboard map)
- see TextView>>keyPress:x:y
+ see TextView>>:x:y
"
(#(F1 F2 F3 F4 F5 F6 F7 F8 F9) includes:key) ifTrue:[
device shiftDown ifFalse:[
@@ -301,7 +351,14 @@
self makeCursorVisible
].
self unselect.
- self cursorDown. ^self
+
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#CursorDown).
+ ].
+ self cursorDown:n.
+ ^ self
].
(key == #CursorLeft or:[key == #CursorUp]) ifTrue:[
selectionStartLine notNil ifTrue:[
@@ -315,7 +372,13 @@
self cursorLeft. ^self
].
(key == #CursorUp) ifTrue:[
- self cursorUp. ^self
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#CursorUp).
+ ].
+ self cursorUp:n.
+ ^ self
].
].
@@ -563,7 +626,8 @@
drawCursor:cursorType with:fgColor and:bgColor
"draw a cursor; the argument cursorType specifies what type
- of cursor should be drawn."
+ of cursor should be drawn.
+ Currently, supported are: #block, #frame, #ibeam, #caret and #solidCaret"
|x y w char y2 x1 x2|
@@ -611,11 +675,14 @@
self lineWidth:2.
self displayLineFromX:x1 y:y2 toX:x y:y.
self displayLineFromX:x y:y toX:x2 y:y2.
- ].
- cursorType == #solidCaret ifTrue:[
- self fillPolygon:(Array with:(x1 @ y2)
- with:(x @ y)
- with:(x1 @ y2))
+ ] ifFalse:[
+ "anything else: solidCaret"
+
+"/ cursorType == #solidCaret ifTrue:[
+ self fillPolygon:(Array with:(x1 @ y2)
+ with:(x @ y)
+ with:(x2 @ y2))
+"/ ]
].
!
@@ -678,15 +745,29 @@
cursorUp
"move cursor up; scroll if at start of visible text"
- |wasOn|
-
- (cursorLine == 1) ifFalse: [
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown + nFullLinesShown - 1.
+ self cursorUp:1
+!
+
+cursorUp:n
+ "move cursor up n lines; scroll if at start of visible text"
+
+ |wasOn nv nl|
+
+ cursorLine isNil ifTrue:[
+ cursorLine := firstLineShown + nFullLinesShown - 1.
+ ].
+ nl := cursorLine - n.
+ nl < 1 ifTrue:[nl := 1].
+
+ (nl ~~ cursorLine) ifTrue: [
+ wasOn := self hideCursor.
+ cursorVisibleLine notNil ifTrue:[
+ nv := cursorVisibleLine - n.
+ nv < 1 ifTrue:[
+ self scrollUp:(nv negated + 1)
+ ].
].
- wasOn := self hideCursor.
- (cursorVisibleLine == 1) ifTrue:[self scrollUp].
- cursorLine := cursorLine - 1.
+ cursorLine := nl.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
wasOn ifTrue:[self showCursor].
"/
@@ -718,19 +799,28 @@
cursorDown
"move cursor down; scroll if at end of visible text"
- |wasOn|
+ self cursorDown:1
+!
+
+cursorDown:n
+ "move cursor down by n lines; scroll if at end of visible text"
+
+ |wasOn nv|
cursorVisibleLine notNil ifTrue:[
wasOn := self hideCursor.
- (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown].
- cursorLine := cursorLine + 1.
+ nv := cursorVisibleLine + n - 1.
+ (nv >= nFullLinesShown) ifTrue:[
+ self scrollDown:(nv - nFullLinesShown + 1)
+ ].
+ cursorLine := cursorLine + n.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
wasOn ifTrue:[self showCursor].
] ifFalse:[
cursorLine isNil ifTrue:[
cursorLine := firstLineShown
].
- cursorLine := cursorLine + 1.
+ cursorLine := cursorLine + n.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
self makeCursorVisible.
].
@@ -851,7 +941,28 @@
self cursorLine:aLineNumber col:1
! !
-!EditTextView methodsFor:'accessing'!
+!EditTextView methodsFor:'accessing-behavior'!
+
+acceptAction:aBlock
+ "set the action to be performed on accept"
+
+ acceptAction := aBlock
+!
+
+acceptAction
+ "return the action to be performed on accept (or nil)"
+
+ ^ acceptAction
+!
+
+exceptionBlock:aBlock
+ "define the action to be triggered when user tries to modify
+ readonly text"
+
+ exceptionBlock := aBlock
+! !
+
+!EditTextView methodsFor:'accessing-contents'!
characterUnderCursor
"return the character under the cursor - space if behond line.
@@ -932,13 +1043,6 @@
]
!
-exceptionBlock:aBlock
- "define the action to be triggered when user tries to modify
- readonly text"
-
- exceptionBlock := aBlock
-!
-
fromFile:aFileName
"take contents from a named file"
@@ -1087,6 +1191,20 @@
]
! !
+!EditTextView methodsFor:'queries'!
+
+widthOfContents
+ "return the width of the contents in pixels
+ Redefined to add the size of a space (for the cursor).
+ this enables us to scroll one position further than the longest
+ line (and possibly see the cursor behind the line)"
+
+ |w|
+
+ w := super widthOfContents.
+ ^ w + (font widthOf:' ')
+! !
+
!EditTextView methodsFor:'private'!
textChanged
@@ -1341,7 +1459,7 @@
aCharacter == (Character cr) ifTrue:[
self cursorReturn
] ifFalse:[
- cursorCol := cursorCol + 1
+ self cursorRight.
].
self makeCursorVisibleAndShowCursor:wasOn.
!
@@ -1988,7 +2106,7 @@
"
somewhere in the middle of a line
"
- cursorCol := cursorCol - 1.
+ self cursorLeft.
self deleteCharAtLine:cursorLine col:cursorCol.
] ifTrue:[
"
@@ -2171,6 +2289,8 @@
"initialize style specific stuff"
super initStyle.
+ lockUpdates := false.
+
cursorFgColor := DefaultCursorForegroundColor.
cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
cursorBgColor := DefaultCursorBackgroundColor.
@@ -2279,17 +2399,6 @@
!EditTextView methodsFor:'menu actions'!
-accept
- "accept the contents"
-
- |value|
-
- value := self contents.
-
- "model-view behavior"
- self sendChangeMessageWith:value.
-!
-
paste:someText
"paste someText at cursor"
@@ -2798,4 +2907,3 @@
ifNotFound:[self showNotFound]
onError:[device beep]
! !
-
--- a/EditField.st Mon May 08 17:19:27 1995 +0200
+++ b/EditField.st Tue May 09 03:57:16 1995 +0200
@@ -10,14 +10,15 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 4-may-1995 at 8:46:55 am'!
+'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:09:38 pm'!
EditTextView subclass:#EditField
- instanceVariableNames:'leaveAction enabled enableAction crAction tabAction
- converter acceptAction leaveKeys alwaysAccept acceptOnLeave acceptOnReturn'
+ instanceVariableNames:'leaveAction enabled enableAction crAction tabAction converter
+ leaveKeys immediateAccept acceptOnLeave acceptOnReturn
+ lengthLimit'
classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
- DefaultSelectionForegroundColor DefaultSelectionBackgroundColor
- DefaultFont'
+ DefaultSelectionForegroundColor DefaultSelectionBackgroundColor
+ DefaultFont'
poolDictionaries:''
category:'Views-Text'
!
@@ -26,7 +27,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.20 1995-05-07 00:15:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.21 1995-05-09 01:55:33 claus Exp $
'!
!EditField class methodsFor:'documentation'!
@@ -47,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.20 1995-05-07 00:15:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.21 1995-05-09 01:55:33 claus Exp $
"
!
@@ -56,9 +57,6 @@
an editable text-field. Realized by using an EditTextView,
and forcing its size to 1 line - disabling cursor movement
in the vertical direction.
- An action (leaveAction) is performed when the field is left
- by either Return or a cursor movement, or if 'accept' is
- performed from the menu.
Instance variables:
@@ -70,7 +68,10 @@
enabled <Boolean> if false, input is ignored.
- enableAction <Block | nil>
+ enableAction <Block | nil> action performed if the field is
+ enabled via an explicit click.
+ (this is used by the group to
+ set the active field to the clicked upon field)
crAction <Block | nil> if non-nil, keyboard input of a cr are not
handled specially, instead this block is evaluated
@@ -85,15 +86,13 @@
the object and its printed representation.
Defaults to nil i.e. assume that strings are edited.
- acceptAction <Block | nil> if non-nil, this is performed in addition to
- the leaveAction.
-
leaveKeys <Collection> keys which are interpreted as 'leving the field'
- alwaysAccept <Boolean> if true, every change of the text is immediately
- forwardd to the model/acceptBlock.
- Default is false i.e. only forward changes
- on accept.
+ immediateAccept <Boolean> if true, every change of the text is immediately
+ forwarded to the model/acceptBlock. If false,
+ the changed value is only stored in the model
+ if the field is left or accepted.
+ Default is false.
acceptOnLeave <Boolean> if true, leaving the field (via cursor keys)
automatically accepts the value into the model.
@@ -123,7 +122,9 @@
top open
- forward input in topView to field:
+ forward input in topView to the field:
+ (currently, the field does not know this - therefore,
+ its been told here ... this may change)
|top field|
@@ -134,10 +135,11 @@
field width:1.0. 'let its height as-is'.
top delegate:(KeyboardForwarder toView:field).
+ field hasKeyboardFocus:true.
top open
- just to make it look better: set some inset:
+ to make it look better: set some inset:
|top field|
@@ -168,7 +170,7 @@
top open
- and have it preselected:
+ have it preselected:
|top field|
@@ -201,8 +203,25 @@
top open
+ set a size limit:
+
+ |top field|
+
+ top := StandardSystemView new.
+ top extent:200@100.
+
+ field := EditField origin:0.0@ViewSpacing in:top.
+ field width:1.0.
+ field leftInset:ViewSpacing;
+ rightInset:ViewSpacing.
+ field editValue:'hello';
+ maxChars:8.
+
+ top open
+
+
use a converter:
- - numbers:
+ - numbers (default to 0):
|top field|
@@ -234,13 +253,14 @@
field converter:(PrintConverter new initForDate).
field editValue:Date today.
- field acceptAction:[:value | Transcript show:value class name; space; showCr:value].
+ field acceptAction:[:value | Transcript showCr:value class name , ' ' , value printString].
field crAction:[field accept. top destroy].
top open.
- setting alwaysAccept, makes the field update with every key:
- - numbers:
+ setting immediateAccept, makes the field update with every key:
+
+ - immediate accept numbers, defaulting to nil:
|top field|
@@ -252,8 +272,8 @@
field leftInset:ViewSpacing;
rightInset:ViewSpacing.
- field converter:(PrintConverter new initForNumber).
- field alwaysAccept:true.
+ field converter:(PrintConverter new initForNumberOrNil).
+ field immediateAccept:true.
field editValue:1234.
field acceptAction:[:value | Transcript showCr:value].
field crAction:[field accept. top destroy].
@@ -304,6 +324,27 @@
field2 model:model.
top2 open.
+ with immediate accept:
+
+ |top1 top2 field1 field2 model|
+
+ model := 'hello world' asValue.
+
+ top1 := StandardSystemView new.
+ top1 extent:200@100.
+ field1 := EditField origin:0.0@ViewSpacing in:top1.
+ field1 width:1.0.
+ field1 leftInset:ViewSpacing; rightInset:ViewSpacing.
+ field1 model:model; immediateAccept:true.
+ top1 open.
+
+ top2 := StandardSystemView new.
+ top2 extent:200@100.
+ field2 := EditField origin:0.0@ViewSpacing in:top2.
+ field2 width:1.0.
+ field2 leftInset:ViewSpacing; rightInset:ViewSpacing.
+ field2 model:model; immediateAccept:true.
+ top2 open.
just an example; a checkBox and an editField on the same model:
@@ -329,11 +370,97 @@
top2 open.
model inspect.
+
+
+ connecting fields:
+ update field2 wehenever field1 is changed.
+ (normally, the processing below (xChanged) is done in your application
+ class, or in a complex model. For the demonstration below, we use
+ a Plug to simulate the protocol.)
+
+ |application top field1 field2 value1 value2|
+
+ application := Plug new.
+ application respondTo:#value1Changed
+ with:[value2 value:(value1 value isNil ifTrue:[nil]
+ ifFalse:[value1 value squared])].
+
+ value1 := 1 asValue.
+ value2 := 1 asValue.
+
+ top := Dialog new.
+ top extent:200@200.
+
+ (top addTextLabel:'some number:') layout:#left.
+ top addVerticalSpace.
+
+ (top addInputFieldOn:value1 tabable:false)
+ converter:(PrintConverter new initForNumberOrNil);
+ immediateAccept:true.
+ top addVerticalSpace.
+
+ (top addTextLabel:'squared:') layout:#left.
+ top addVerticalSpace.
+ (top addInputFieldOn:value2 tabable:false)
+ converter:(PrintConverter new initForNumberOrNil).
+
+ value1 onChangeSend:#value1Changed to:application.
+
+ top openModeless.
+
+
+ two-way connect:
+ each field updates the other (notice, that we have to turn off
+ onChange: notification, to avoid an endless notification cycle)
+
+ |application top field1 field2 value1 value2|
+
+ application := Plug new.
+ application respondTo:#value1Changed
+ with:[value2 retractInterrestFor:application.
+ value2 value:(value1 value isNil ifTrue:[nil]
+ ifFalse:[value1 value squared]).
+ value2 onChangeSend:#value2Changed to:application.
+ ].
+ application respondTo:#value2Changed
+ with:[value1 retractInterrestFor:application.
+ value1 value:(value2 value isNil ifTrue:[nil]
+ ifFalse:[value2 value sqrt]).
+ value1 onChangeSend:#value1Changed to:application.
+ ].
+
+ value1 := 1 asValue.
+ value2 := 1 asValue.
+
+ top := Dialog new.
+ top extent:200@200.
+
+ (top addTextLabel:'some number:') layout:#left.
+ top addVerticalSpace.
+
+ (top addInputFieldOn:value1 tabable:false)
+ converter:(PrintConverter new initForNumberOrNil);
+ immediateAccept:true.
+ top addVerticalSpace.
+
+ (top addTextLabel:'squared:') layout:#left.
+ top addVerticalSpace.
+ (top addInputFieldOn:value2 tabable:false)
+ converter:(PrintConverter new initForNumberOrNil).
+
+ value1 onChangeSend:#value1Changed to:application.
+ value2 onChangeSend:#value2Changed to:application.
+
+ top openModeless.
"
! !
!EditField class methodsFor:'defaults'!
+defaultLeaveKeys
+ ^ #(Return CursorUp CursorDown Next Previous Accept)
+!
+
updateStyleCache
DefaultForegroundColor := StyleSheet colorAt:'editFieldForegroundColor' default:Black.
DefaultBackgroundColor := StyleSheet colorAt:'editFieldBackgroundColor' default:White.
@@ -346,32 +473,275 @@
"
!
-defaultLeaveKeys
- ^ #(Return CursorUp CursorDown Next Previous Accept)
-!
-
defaultNumberOfLines
"the number of lines in the field"
^ 1
! !
-!EditField methodsFor:'initialization'!
+!EditField methodsFor:'private'!
+
+textChanged
+ "this is sent by mySelf (somewhere in a superclass) whenever
+ my contents has changed.
+ A good place to add immediateAccept functionality and check for the
+ lengthLimit."
+
+ |string|
+
+ super textChanged.
+ string := self contents.
+ lengthLimit notNil ifTrue:[
+ string size > lengthLimit ifTrue:[
+ self contents:(string := string copyTo:lengthLimit).
+ self flash.
+ ]
+ ].
+ immediateAccept ifTrue:[
+ self accept
+ ]
+!
+
+getListFromModel
+ "redefined to aquire the text via the aspectMsg - not the listMsg,
+ and to ignore updates resulting from my own change."
+
+ "
+ ignore updates from my own change
+ "
+ lockUpdates ifTrue:[
+ lockUpdates := false.
+ ^ self
+ ].
+
+ (model notNil and:[aspectMsg notNil]) ifTrue:[
+ self editValue:(model perform:aspectMsg).
+ ]
+!
+
+startAutoScrollUp:y
+ "no vertical scrolling in editfields"
+
+ ^ self
+!
+
+startAutoScrollDown:y
+ "no vertical scrolling in editfields"
+
+ ^ self
+! !
+
+!EditField methodsFor:'accessing'!
+
+contents
+ "return contents as a string
+ - redefined since EditFields hold only one line of text.
+ In your application, please use #editValue;
+ it uses a converter (if any) and is compatible to ST-80."
+
+ list isNil ifTrue:[^ ''].
+ (list size == 0) ifTrue:[^ ''].
+ ^ list at:1
+!
+
+leaveAction:aBlock
+ "define an action to be evaluated when field is left by return key"
+
+ leaveAction := aBlock
+!
+
+list:someText
+ "redefined to force text to 1 line, and notify dependents
+ of any changed extent-wishes."
+
+ |l oldWidth|
+
+ l := someText.
+ l size > 1 ifTrue:[
+ l := OrderedCollection with:(l at:1)
+ ].
+ oldWidth := self widthOfContents.
+ super list:l.
+ self widthOfContents ~~ oldWidth ifTrue:[
+ self changed:#preferedExtent
+ ]
+!
+
+contents:someText
+ "set the contents from a string
+ - redefined to place the cursor to the end.
+ In your application, please use #editValue:;
+ it uses a converter (if any) and is compatible to ST-80."
+
+ super contents:someText.
+ self cursorCol:(someText size + 1).
+!
+
+enable
+ "enable the field; show cursor and allow input"
+
+ enabled ifFalse:[
+"/ enableAction notNil ifTrue:[
+"/ enableAction value
+"/ ].
+ enabled := true.
+ super showCursor
+ ]
+!
+
+immediateAccept:aBoolean
+ "set/clear the immediateAccept flag. The default is false."
+
+ immediateAccept := aBoolean
+!
+
+editValue
+ "if the field edits a string, this is a name alias for #contents.
+ Otherwise, if there is a converter, return the edited string
+ converted to an appropriate object."
+
+ |string|
+
+ string := self contents.
+ converter isNil ifTrue:[^ string].
+ string isNil ifTrue:[string := ''].
+ ^ converter readValueFrom:string
+!
-initialize
- super initialize.
- self height:(font height + font descent + (topMargin * 2)).
- enabled := true.
- fixedSize := true.
- nFullLinesShown := 1.
- nLinesShown := 1.
- alwaysAccept := false.
- acceptOnLeave := false.
- acceptOnReturn := true.
- leaveKeys := self class defaultLeaveKeys.
- cursorShown := true
+leaveKeys:aCollectionOfKeySymbols
+ "define the set of keys which are interpreted as leaveKeys.
+ I.e. those that make the field inactive and accept (if acceptOnLeave is true).
+ The default is a set of #CursorUp, #CursorDown, #Next, #Prior and #Return."
+
+ leaveKeys := aCollectionOfKeySymbols
+!
+
+initialText:aString selected:aBoolean
+ "set the initialText and select it if aBoolean is true"
+
+ |len s|
+
+ leftOffset := 0.
+ aString isNil ifTrue:[
+ s := nil
+ ] ifFalse:[
+ s := aString asString
+ ].
+ self contents:s.
+ aBoolean ifTrue:[
+ (len := s size) ~~ 0 ifTrue:[
+ self selectFromLine:1 col:1 toLine:1 col:len
+ ]
+ ]
+!
+
+crAction:aBlock
+ "define an action to be evaluated when the return key is pressed."
+
+ crAction := aBlock
+!
+
+tabAction:aBlock
+ "define an action to be evaluated when the tabulator key is pressed."
+
+ tabAction := aBlock
+!
+
+acceptOnReturn:aBoolean
+ "set/clear the acceptOnReturn flag. The default is true."
+
+ acceptOnReturn := aBoolean
+!
+
+initialText:aString
+ "set the initialText and select it"
+
+ self initialText:aString selected:true
+!
+
+editValue:aStringOrObject
+ "set the contents. If there is a converter, use it to convert
+ the object into a printed representation.
+ Otherwise, the argument is supposed to be a string like object,
+ and used directly (i.e. this is equivalent to sending #contents:)."
+
+ self editValue:aStringOrObject selected:false
!
+disable
+ "disable the field; hide cursor and ignore input"
+
+ enabled ifTrue:[
+ enabled := false.
+ self hideCursor
+ ]
+!
+
+editValue:aStringOrObject selected:aBoolean
+ "set the contents. If there is a converter, use it to convert
+ the object into a printed representation.
+ Otherwise, the argument is supposed to be a string like object,
+ and used directly (i.e. this is equivalent to sending #contents:)."
+
+ |string|
+
+ converter notNil ifTrue:[
+ string := converter printStringFor:aStringOrObject
+ ] ifFalse:[
+ string := aStringOrObject.
+ ].
+ self contents:string.
+ aBoolean ifTrue:[
+ self selectFromLine:1 col:1 toLine:1 col:string size
+ ]
+!
+
+acceptOnLeave:aBoolean
+ "set/clear the acceptOnLeave flag. The default is false."
+
+ acceptOnLeave := aBoolean
+!
+
+converter:aConverter
+ "set the converter. If non-nil,
+ the converter is applied to the text to convert from the string
+ representation to the actual object value and vice versa.
+ The default converter is nil, meaning no-conversion
+ (i.e. the edited object is the string itself."
+
+ converter := aConverter
+!
+
+enableAction:aBlock
+ "define an action to be evaluated when enabled by clicking upon"
+
+ enableAction := aBlock
+!
+
+converter
+ "return the converter (if any)."
+
+ ^ converter
+!
+
+maxChars:aNumberOrNil
+ "set the maximum number of characters that are allowed in
+ the field. Additional input will be ignored by the field.
+ A limit of nil means: unlimited. This is the default.
+ This method has been renamed from #lengthLimit: for ST-80
+ compatibility."
+
+ lengthLimit := aNumberOrNil
+!
+
+stringValue
+ "alias for #contents - for ST-80 compatibility"
+
+ ^ self contents
+! !
+
+!EditField methodsFor:'initialization'!
+
initStyle
super initStyle.
@@ -388,6 +758,19 @@
]
!
+initialize
+ super initialize.
+ self height:(font height + font descent + (topMargin * 2)).
+ enabled := true.
+ fixedSize := true.
+ nFullLinesShown := 1.
+ nLinesShown := 1.
+ immediateAccept := acceptOnLeave := false.
+ acceptOnReturn := true.
+ cursorShown := true.
+ leaveKeys := self class defaultLeaveKeys.
+!
+
editMenu
|labels selectors m|
@@ -433,43 +816,6 @@
super realize
! !
-!EditField methodsFor:'private'!
-
-getListFromModel
- "redefined to aquire the text via the aspectMsg - not the listMsg"
-
- |savedCursorCol|
-
- (model notNil and:[aspectMsg notNil]) ifTrue:[
- "
- kludge: editValue positions cursor to beginning
- "
- savedCursorCol := cursorCol.
- self editValue:(model perform:aspectMsg).
- savedCursorCol ~~ 1 ifTrue:[self cursorLine:1 col:savedCursorCol].
- cursorVisibleLine := 1.
- ]
-!
-
-textChanged
- super textChanged.
- alwaysAccept ifTrue:[
- self accept
- ]
-!
-
-startAutoScrollUp:y
- "no vertical scrolling in editfields"
-
- ^ self
-!
-
-startAutoScrollDown:y
- "no vertical scrolling in editfields"
-
- ^ self
-! !
-
!EditField methodsFor:'queries'!
preferedExtent
@@ -488,211 +834,6 @@
^ w @ self height
! !
-!EditField methodsFor:'accessing'!
-
-list:someText
- "redefined to force text to 1 line, and notify dependents
- of any changed extent-wishes."
-
- |l oldWidth|
-
- l := someText.
- l size > 1 ifTrue:[
- l := OrderedCollection with:(l at:1)
- ].
- oldWidth := self widthOfContents.
- super list:l.
- self widthOfContents ~~ oldWidth ifTrue:[
- self changed:#preferedExtent
- ]
-!
-
-contents:someText
- "set the contents from a string
- - redefined to place the cursor to the end.
- In your application, please use #editValue:;
- it uses a converter (if any) and is compatible to ST-80."
-
- super contents:someText.
- self cursorCol:(someText size + 1).
-!
-
-contents
- "return contents as a string
- - redefined since EditFields hold only one line of text.
- In your application, please use #editValue;
- it uses a converter (if any) and is compatible to ST-80."
-
- list isNil ifTrue:[^ ''].
- (list size == 0) ifTrue:[^ ''].
- ^ list at:1
-!
-
-enable
- "enable the field; show cursor and allow input"
-
- enabled ifFalse:[
- enableAction notNil ifTrue:[
- enableAction value
- ].
- enabled := true.
- super showCursor
- ]
-!
-
-leaveAction:aBlock
- "define an action to be evaluated when field is left by return key"
-
- leaveAction := aBlock
-!
-
-leaveKeys:aCollectionOfKeySymbols
- "define the set of keys which are interpreted as leaveKeys.
- I.e. those that make the field inactive and accept (if acceptOnLeave is true).
- The default is a set of #CursorUp, #CursorDown, #Next, #Prior and #Return."
-
- leaveKeys := aCollectionOfKeySymbols
-!
-
-crAction:aBlock
- "define an action to be evaluated when the return key is pressed."
-
- crAction := aBlock
-!
-
-acceptAction:aBlock
- "define an action to be evaluated when accepted."
-
- acceptAction := aBlock
-!
-
-tabAction:aBlock
- "define an action to be evaluated when the tabulator key is pressed."
-
- tabAction := aBlock
-!
-
-alwaysAccept:aBoolean
- "set/clear the alwaysAccept flag. The default is false."
-
- alwaysAccept := aBoolean
-!
-
-acceptOnReturn:aBoolean
- "set/clear the acceptOnReturn flag. The default is true."
-
- acceptOnReturn := aBoolean
-!
-
-acceptOnLeave:aBoolean
- "set/clear the acceptOnLeave flag. The default is false."
-
- acceptOnLeave := aBoolean
-!
-
-converter
- "return the converter (if any)."
-
- ^ converter
-!
-
-editValue
- "if the field edits a string, this is a name alias for #contents.
- Otherwise, if there is a converter, return the edited string
- converted to an appropriate object."
-
- |text|
-
- text := self contents.
- converter isNil ifTrue:[^ text].
- ^ converter readValueFrom:text withoutSpaces
-!
-
-editValue:aStringOrObject
- "set the contents. If there is a converter, use it to convert
- the object into a printed representation.
- Otherwise, the argument is supposed to be a string like object,
- and used directly (i.e. this is equivalent to sending #contents:)."
-
- self editValue:aStringOrObject selected:false
-!
-
-editValue:aStringOrObject selected:aBoolean
- "set the contents. If there is a converter, use it to convert
- the object into a printed representation.
- Otherwise, the argument is supposed to be a string like object,
- and used directly (i.e. this is equivalent to sending #contents:)."
-
- |text|
-
- converter notNil ifTrue:[
- text := converter printStringFor:aStringOrObject
- ] ifFalse:[
- text := aStringOrObject.
- ].
- self contents:text.
- aBoolean ifTrue:[
- self selectFromLine:1 col:1 toLine:1 col:text size
- ]
-!
-
-converter:aConverter
- "set the converter. If non-nil,
- the converter is applied to the text to convert from the string
- representation to the actual object value and vice versa.
- The default converter is nil, meaning no-conversion
- (i.e. the edited object is the string itself."
-
- converter := aConverter
-!
-
-
-disable
- "disable the field; hide cursor and ignore input"
-
- enabled ifTrue:[
- enabled := false.
- self hideCursor
- ]
-!
-
-enableAction:aBlock
- "define an action to be evaluated when enabled by clicking upon"
-
- enableAction := aBlock
-!
-
-initialText:aString selected:aBoolean
- "set the initialText and select it if aBoolean is true"
-
- |len s|
-
- leftOffset := 0.
- self contents:(s := aString asString).
- aBoolean ifTrue:[
- (len := s size) ~~ 0 ifTrue:[
- self selectFromLine:1 col:1 toLine:1 col:len
- ]
- ]
-!
-
-initialText:aString
- "set the initialText and select it"
-
- self initialText:aString selected:true
-! !
-
-!EditField methodsFor:'editing'!
-
-paste:someText
- "redefined to force text to 1 line"
-
- super paste:someText.
- list size > 1 ifTrue:[
- self deleteFromLine:2 toLine:(list size)
- ]
-! !
-
!EditField methodsFor:'cursor drawing'!
showCursor
@@ -704,6 +845,21 @@
!EditField methodsFor:'cursor movement'!
+cursorCol:col
+ "redefined to lock the cursor at the end, if I have a lngthLimit"
+
+ |c sz|
+
+ c := col.
+ lengthLimit notNil ifTrue:[
+ sz := lengthLimit.
+ c > sz ifTrue:[
+ c := sz+1.
+ ]
+ ].
+ super cursorCol:c
+!
+
cursorLine:line col:col
"catch cursor movement"
@@ -720,19 +876,105 @@
!EditField methodsFor:'event handling'!
-accept
- "accept the fields contents - perform the leave action as if
- return was pressed."
+keyPress:key x:x y:y
+ "if keyHandler is defined, pass input; otherwise check for leave
+ keys"
+
+ |leave xCol newOffset oldWidth newWidth|
+
+ enabled ifFalse:[
+ ^ self
+ ].
+
+ (key == #DeleteLine) ifTrue:[
+ Smalltalk at:#CopyBuffer put:(self contents).
+ self contents:''. ^ self
+ ].
- |value|
+ (key == #Tab) ifTrue:[
+ tabAction notNil ifTrue:[tabAction value. ^ self].
+ ].
+ (key == #Return) ifTrue:[
+ crAction notNil ifTrue:[crAction value. ^ self].
+ ].
+ leave := leaveKeys includes:key.
+ leave ifTrue:[
+ leaveAction notNil ifTrue:[
+ leaveAction value:key
+ ].
- value := self editValue.
- acceptAction notNil ifTrue:[
- acceptAction value:value
+ ((key == #Return and:[acceptOnReturn])
+ or:[key ~~ #Return and:[acceptOnLeave]]) ifTrue:[
+ self accept.
+ ].
+
+ x >= 0 ifTrue:[
+ "
+ let superview know about the leave ...
+ This is a temporary kludge for the tableWidget -
+ it is no clean coding style. Should make the tableWidget
+ a proper model and handle it via the changed mechanism ....
+ "
+ (superView notNil and:[superView canHandle:key from:self]) ifTrue:[
+ superView keyPress:key x:x y:y.
+ ].
+ ].
+ ^ self
].
- "model-view behavior"
- self sendChangeMessageWith:value.
+ "
+ ignore some keys (if not a leaveKey) ...
+ "
+ (key == #Find) ifTrue:[^self].
+ (key == #FindNext) ifTrue:[^self].
+ (key == #FindPrev) ifTrue:[^self].
+ (key == #GotoLine) ifTrue:[^self].
+
+ "
+ a normal key - let superclass's method insert it
+ "
+ oldWidth := self widthOfContents.
+ super keyPress:key x:x y:y.
+
+ "
+ for end-of-text, also move to end-of-line
+ "
+ key == #EndOfText ifTrue:[
+ super keyPress:#EndOfLine x:x y:y.
+ ].
+ newWidth := self widthOfContents.
+
+ "
+ should (& can) we resize ?
+ "
+ xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
+ (xCol > (width * (5/6))) ifTrue:[
+ self changed:#preferedExtent
+ ] ifFalse:[
+ newWidth < (width * (1/6)) ifTrue:[
+ self changed:#preferedExtent
+ ]
+ ].
+
+ "
+ did someone react ?
+ (if not, we scroll horizontally)
+ "
+ xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
+ (xCol > (width * (5/6))) ifTrue:[
+ newOffset := leftOffset + (width // 2).
+ ] ifFalse:[
+ (xCol < (width * (1/6))) ifTrue:[
+ newOffset := 0 max: leftOffset - (width // 2).
+ ] ifFalse:[
+ newOffset := leftOffset
+ ]
+ ].
+ newOffset ~~ leftOffset ifTrue:[
+ leftOffset := newOffset.
+ self clear.
+ self redraw
+ ]
!
buttonPress:button x:x y:y
@@ -749,98 +991,18 @@
]
!
-keyPress:key x:x y:y
- "if keyHandler is defined, pass input; otherwise check for leave
- keys"
-
- |leave xCol newOffset oldWidth newWidth|
+focusIn
+ "got the explicit focus"
enabled ifFalse:[
- ^ self
- ].
-
- (key == #DeleteLine) ifTrue:[
- Smalltalk at:#CopyBuffer put:(self contents).
- self contents:''. ^ self
- ].
-
- (key == #Tab) ifTrue:[
- tabAction notNil ifTrue:[tabAction value. ^ self].
- ].
- (key == #Return) ifTrue:[
- crAction notNil ifTrue:[crAction value. ^ self].
- ].
- leave := leaveKeys includes:key.
- leave ifTrue:[
- leaveAction notNil ifTrue:[
- leaveAction value:key
- ].
-
- ((key == #Return and:[acceptOnReturn])
- or:[key ~~ #Return and:[acceptOnLeave]]) ifTrue:[
- self accept.
- ].
-
- x >= 0 ifTrue:[
- "
- let superview know about the leave ...
- This is a temporary kludge for the tableWidget -
- it is no clean coding style. Should make the tableWidget
- a proper model and handle it via the changed mechanism ....
- "
- (superView notNil and:[superView canHandle:key from:self]) ifTrue:[
- superView keyPress:key x:x y:y.
- ].
- ].
- ^ self
+ enabled := true.
+ super focusIn.
+ enableAction notNil ifTrue:[
+ enableAction value
+ ]
+ ] ifTrue:[
+ super focusIn
].
-
- "
- ignore some keys (if not a leaveKey) ...
- "
- (key == #Find) ifTrue:[^self].
- (key == #FindNext) ifTrue:[^self].
- (key == #FindPrev) ifTrue:[^self].
- (key == #GotoLine) ifTrue:[^self].
-
- "
- a normal key - let superclass's method insert it
- "
- oldWidth := self widthOfContents.
- super keyPress:key x:x y:y.
- newWidth := self widthOfContents.
-
- "
- should (& can) we resize ?
- "
- xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
- (xCol > (width * (5/6))) ifTrue:[
- self changed:#preferedExtent
- ] ifFalse:[
- newWidth < (width * (1/6)) ifTrue:[
- self changed:#preferedExtent
- ]
- ].
-
- "
- did someone react ?
- (if not, we scroll horizontally)
- "
- xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
- (xCol > (width * (5/6))) ifTrue:[
- newOffset := leftOffset + (width // 2).
- ] ifFalse:[
- (xCol < (width * (1/6))) ifTrue:[
- newOffset := 0 max: leftOffset - (width // 2).
- ] ifFalse:[
- newOffset := leftOffset
- ]
- ].
- newOffset ~~ leftOffset ifTrue:[
- leftOffset := newOffset.
- self clear.
- self redraw
- ]
!
canHandle:aKey
@@ -848,7 +1010,20 @@
(usually from another view, when the receiver is part of
a more complex dialog box).
We do return true here, since the editfield will handle
- all keys."
+ all keys.
+ OBSOLETE: dont use this anymore - its a leftover for the tableWidget"
^ true
! !
+
+!EditField methodsFor:'editing'!
+
+paste:someText
+ "redefined to force text to 1 line"
+
+ super paste:someText.
+ list size > 1 ifTrue:[
+ self deleteFromLine:2 toLine:(list size)
+ ]
+! !
+
--- a/EditTextView.st Mon May 08 17:19:27 1995 +0200
+++ b/EditTextView.st Tue May 09 03:57:16 1995 +0200
@@ -17,7 +17,7 @@
prevCursorState readOnly modified fixedSize exceptionBlock
errorMessage cursorFgColor cursorBgColor cursorType undoAction
typeOfSelection lastString lastReplacement lastAction replacing
- showMatchingParenthesis hasKeyboardFocus'
+ showMatchingParenthesis hasKeyboardFocus acceptAction lockUpdates'
classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
DefaultCursorType'
poolDictionaries:''
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.26 1995-05-07 01:58:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.27 1995-05-09 01:55:23 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -49,13 +49,20 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.26 1995-05-07 01:58:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.27 1995-05-09 01:55:23 claus Exp $
"
!
documentation
"
a view for editable text - adds editing functionality to TextView
+ Also, it adds accept functionality, and defines a new actionBlock:
+ acceptAction to be performed for accept
+
+ If used with a model, this is informed by sending it a changeMsg with
+ the current contents as argument.
+ (however, it is possible to define moth changeMsg and acceptAction)
+
Instance variables:
@@ -104,6 +111,45 @@
DefaultCursorType := StyleSheet at:'textCursorType' default:#block.
! !
+!EditTextView methodsFor:'change & update '!
+
+getListFromModel
+ "get my contents from the model.
+ Redefined to ignore updates resulting from my own change."
+
+ "
+ ignore updates from my own change
+ "
+ lockUpdates ifTrue:[
+ lockUpdates := false.
+ ^ self
+ ].
+ ^ super getListFromModel
+!
+
+accept
+ "accept the current contents by executing the accept-action and/or
+ changeMessage."
+
+ lockUpdates := true.
+ "/
+ "/ ST/X way of doing things
+ "/ as a historic (and temporary) leftover,
+ "/ the block is called with a stringCollection
+ "/ - not with the actual string
+ "/
+ acceptAction notNil ifTrue:[
+ acceptAction value:self list
+ ].
+
+ "/
+ "/ ST-80 way of doing it
+ "/
+ self sendChangeMessageWith:self contents.
+
+ lockUpdates := false.
+! !
+
!EditTextView methodsFor:'event processing'!
hasKeyboardFocus:aBoolean
@@ -178,6 +224,10 @@
keyPress:key x:x y:y
"handle keyboard input"
+ |sensor n|
+
+ sensor := self sensor.
+
(key isMemberOf:Character) ifTrue:[
readOnly ifFalse:[
typeOfSelection == #paste ifTrue:[
@@ -235,7 +285,7 @@
Fn pastes a key-sequence (but only if not overlayed with
another function in the keyboard map)
- see TextView>>keyPress:x:y
+ see TextView>>:x:y
"
(#(F1 F2 F3 F4 F5 F6 F7 F8 F9) includes:key) ifTrue:[
device shiftDown ifFalse:[
@@ -301,7 +351,14 @@
self makeCursorVisible
].
self unselect.
- self cursorDown. ^self
+
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#CursorDown).
+ ].
+ self cursorDown:n.
+ ^ self
].
(key == #CursorLeft or:[key == #CursorUp]) ifTrue:[
selectionStartLine notNil ifTrue:[
@@ -315,7 +372,13 @@
self cursorLeft. ^self
].
(key == #CursorUp) ifTrue:[
- self cursorUp. ^self
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#CursorUp).
+ ].
+ self cursorUp:n.
+ ^ self
].
].
@@ -563,7 +626,8 @@
drawCursor:cursorType with:fgColor and:bgColor
"draw a cursor; the argument cursorType specifies what type
- of cursor should be drawn."
+ of cursor should be drawn.
+ Currently, supported are: #block, #frame, #ibeam, #caret and #solidCaret"
|x y w char y2 x1 x2|
@@ -611,11 +675,14 @@
self lineWidth:2.
self displayLineFromX:x1 y:y2 toX:x y:y.
self displayLineFromX:x y:y toX:x2 y:y2.
- ].
- cursorType == #solidCaret ifTrue:[
- self fillPolygon:(Array with:(x1 @ y2)
- with:(x @ y)
- with:(x1 @ y2))
+ ] ifFalse:[
+ "anything else: solidCaret"
+
+"/ cursorType == #solidCaret ifTrue:[
+ self fillPolygon:(Array with:(x1 @ y2)
+ with:(x @ y)
+ with:(x2 @ y2))
+"/ ]
].
!
@@ -678,15 +745,29 @@
cursorUp
"move cursor up; scroll if at start of visible text"
- |wasOn|
-
- (cursorLine == 1) ifFalse: [
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown + nFullLinesShown - 1.
+ self cursorUp:1
+!
+
+cursorUp:n
+ "move cursor up n lines; scroll if at start of visible text"
+
+ |wasOn nv nl|
+
+ cursorLine isNil ifTrue:[
+ cursorLine := firstLineShown + nFullLinesShown - 1.
+ ].
+ nl := cursorLine - n.
+ nl < 1 ifTrue:[nl := 1].
+
+ (nl ~~ cursorLine) ifTrue: [
+ wasOn := self hideCursor.
+ cursorVisibleLine notNil ifTrue:[
+ nv := cursorVisibleLine - n.
+ nv < 1 ifTrue:[
+ self scrollUp:(nv negated + 1)
+ ].
].
- wasOn := self hideCursor.
- (cursorVisibleLine == 1) ifTrue:[self scrollUp].
- cursorLine := cursorLine - 1.
+ cursorLine := nl.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
wasOn ifTrue:[self showCursor].
"/
@@ -718,19 +799,28 @@
cursorDown
"move cursor down; scroll if at end of visible text"
- |wasOn|
+ self cursorDown:1
+!
+
+cursorDown:n
+ "move cursor down by n lines; scroll if at end of visible text"
+
+ |wasOn nv|
cursorVisibleLine notNil ifTrue:[
wasOn := self hideCursor.
- (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown].
- cursorLine := cursorLine + 1.
+ nv := cursorVisibleLine + n - 1.
+ (nv >= nFullLinesShown) ifTrue:[
+ self scrollDown:(nv - nFullLinesShown + 1)
+ ].
+ cursorLine := cursorLine + n.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
wasOn ifTrue:[self showCursor].
] ifFalse:[
cursorLine isNil ifTrue:[
cursorLine := firstLineShown
].
- cursorLine := cursorLine + 1.
+ cursorLine := cursorLine + n.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
self makeCursorVisible.
].
@@ -851,7 +941,28 @@
self cursorLine:aLineNumber col:1
! !
-!EditTextView methodsFor:'accessing'!
+!EditTextView methodsFor:'accessing-behavior'!
+
+acceptAction:aBlock
+ "set the action to be performed on accept"
+
+ acceptAction := aBlock
+!
+
+acceptAction
+ "return the action to be performed on accept (or nil)"
+
+ ^ acceptAction
+!
+
+exceptionBlock:aBlock
+ "define the action to be triggered when user tries to modify
+ readonly text"
+
+ exceptionBlock := aBlock
+! !
+
+!EditTextView methodsFor:'accessing-contents'!
characterUnderCursor
"return the character under the cursor - space if behond line.
@@ -932,13 +1043,6 @@
]
!
-exceptionBlock:aBlock
- "define the action to be triggered when user tries to modify
- readonly text"
-
- exceptionBlock := aBlock
-!
-
fromFile:aFileName
"take contents from a named file"
@@ -1087,6 +1191,20 @@
]
! !
+!EditTextView methodsFor:'queries'!
+
+widthOfContents
+ "return the width of the contents in pixels
+ Redefined to add the size of a space (for the cursor).
+ this enables us to scroll one position further than the longest
+ line (and possibly see the cursor behind the line)"
+
+ |w|
+
+ w := super widthOfContents.
+ ^ w + (font widthOf:' ')
+! !
+
!EditTextView methodsFor:'private'!
textChanged
@@ -1341,7 +1459,7 @@
aCharacter == (Character cr) ifTrue:[
self cursorReturn
] ifFalse:[
- cursorCol := cursorCol + 1
+ self cursorRight.
].
self makeCursorVisibleAndShowCursor:wasOn.
!
@@ -1988,7 +2106,7 @@
"
somewhere in the middle of a line
"
- cursorCol := cursorCol - 1.
+ self cursorLeft.
self deleteCharAtLine:cursorLine col:cursorCol.
] ifTrue:[
"
@@ -2171,6 +2289,8 @@
"initialize style specific stuff"
super initStyle.
+ lockUpdates := false.
+
cursorFgColor := DefaultCursorForegroundColor.
cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
cursorBgColor := DefaultCursorBackgroundColor.
@@ -2279,17 +2399,6 @@
!EditTextView methodsFor:'menu actions'!
-accept
- "accept the contents"
-
- |value|
-
- value := self contents.
-
- "model-view behavior"
- self sendChangeMessageWith:value.
-!
-
paste:someText
"paste someText at cursor"
@@ -2798,4 +2907,3 @@
ifNotFound:[self showNotFound]
onError:[device beep]
! !
-
--- a/EnterFieldGroup.st Mon May 08 17:19:27 1995 +0200
+++ b/EnterFieldGroup.st Tue May 09 03:57:16 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.9 1995-05-07 00:15:50 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.10 1995-05-09 01:55:13 claus Exp $
'!
!EnterFieldGroup class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.9 1995-05-07 00:15:50 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.10 1995-05-09 01:55:13 claus Exp $
"
!
@@ -343,10 +343,11 @@
aField enableAction:[
"/ Transcript showCr:'enable field with: ' , aField editValue.
- currentField notNil ifTrue:[
- currentField disable
- ].
- currentField := aField
+"/ currentField notNil ifTrue:[
+"/ currentField disable
+"/ ].
+"/ currentField := aField
+ self makeActive:aField
].
"set the fields leaveAction to enable next field"
@@ -472,7 +473,7 @@
"key-press in any field - forward the key to the active field"
currentField notNil ifTrue:[
- currentField keyPress:key x:0 y:0
+ currentField keyPress:key x:-1 y:-1
]
!
--- a/FramedBox.st Mon May 08 17:19:27 1995 +0200
+++ b/FramedBox.st Tue May 09 03:57:16 1995 +0200
@@ -10,6 +10,8 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:04:53 pm'!
+
SimpleView subclass:#FramedBox
instanceVariableNames:'label layout fgColor showFrame frame3D'
classVariableNames:''
@@ -21,7 +23,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.10 1995-05-03 00:29:32 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.11 1995-05-09 01:55:43 claus Exp $
'!
!FramedBox class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.10 1995-05-03 00:29:32 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.11 1995-05-09 01:55:43 claus Exp $
"
!
@@ -55,113 +57,122 @@
Its also possible, to not show the frame but only the label, by setting
showFrame to false.
"
-! !
-
-!FramedBox methodsFor:'private'!
-
-redrawIfShown
- shown ifTrue:[
- self clear.
- self redraw
- ]
-! !
-
-!FramedBox methodsFor:'accessing'!
-
-foregroundColor
- "return the frame labels foreground color"
-
- ^ fgColor
-!
-
-foregroundColor:aColor
- "set the frame labels foreground color"
-
- aColor ~= fgColor ifTrue:[
- fgColor := aColor.
- self redrawIfShown
- ]
-!
-
-frameShown
- "return true, if frame is shown;
- if false, oly the label is shown"
-
- ^ showFrame
-!
-
-showFrame:aBoolean
- "turn on/off showing of the frame -
- without a frame, only the label is shown at its position"
-
- aBoolean ~~ showFrame ifTrue:[
- showFrame := aBoolean.
- self redrawIfShown
- ]
-!
-
-label
- "return the frames labelstring"
-
- ^ label
!
-label:aString
- "set the frames labelstring"
+examples
+"
+ simple:
+
+ |top frame1 frame2 frame3|
+
+ top := StandardSystemView new.
+ top extent:300@200.
+
+ frame1 := FramedBox origin:0.0@0.0 corner:0.5@0.5 in:top.
+ frame1 label:'frame1'.
- (label ~= aString) ifTrue:[
- label := aString.
- self redrawIfShown
- ]
-!
+ frame2 := FramedBox origin:0.5@0.0 corner:1.0@0.5 in:top.
+ frame2 label:'frame2'.
+
+ frame3 := FramedBox origin:0.0@0.5 corner:1.0@1.0 in:top.
+ frame3 label:'frame3'.
-font:aFont
- "set the frame labelstrings font"
+ top open
+
+
+ placing something inside:
+
+ |top frame1 frame2 frame3 v1 v2 v3|
- (font ~= aFont) ifTrue:[
- super font:aFont.
- self redrawIfShown
- ]
-!
+ top := StandardSystemView new.
+ top extent:300@200.
+
+ frame1 := FramedBox origin:0.0@0.0 corner:0.5@0.5 in:top.
+ frame1 label:'frame1'.
+ v1 := View origin:0.0@0.0 corner:1.0@1.0 in:frame1.
+ v1 viewBackground:(Color yellow);
+ level:1.
+
+ frame2 := FramedBox origin:0.5@0.0 corner:1.0@0.5 in:top.
+ frame2 label:'frame2'.
+ v2 := View origin:0.0@0.0 corner:1.0@1.0 in:frame2.
+ v2 viewBackground:(Color red);
+ level:1.
-viewRectangle
- "return the inside area - redefined to save frame from
- relative computations"
+ frame3 := FramedBox origin:0.0@0.5 corner:1.0@1.0 in:top.
+ frame3 label:'frame3'.
+ v3 := View origin:0.0@0.0 corner:1.0@1.0 in:frame3.
+ v3 viewBackground:(Color green);
+ level:1.
- |m2 sep|
+ top open
+
- sep := font height.
- m2 := sep + sep "+ sep".
+ placing something inside a frame in a dialog:
+
+ |box panel frame1 frame2 frame3 v1 v1b v2 v3|
+
+ box := Dialog new.
- showFrame ifFalse:[
- ^ (0 @ sep) extent:(width @ height)
- ].
- ^ (sep @ sep) extent:((width - sep) @ (height - sep))
-!
+ frame1 := FramedBox label:'frame1'.
+ panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:frame1.
+ v1 := View extent:100@100 in:panel.
+ v1 viewBackground:(Color red);
+ level:1.
+ v1b := View extent:100@100 in:panel.
+ v1b viewBackground:(Color yellow);
+ level:1.
+
+ box addComponent:frame1.
-layout
- "return the current layout, which is a symbol describing
- the labels position."
+ frame2 := FramedBox label:'frame2'.
+ v2 := View origin:0.0@0.0 corner:1.0@1.0 in:frame2.
+ v2 viewBackground:(Color green);
+ level:1.
+ box addComponent:frame2.
- ^ layout
-!
+ frame3 := FramedBox label:'frame3'.
+ v3 := View origin:0.0@0.0 corner:1.0@1.0 in:frame3.
+ v3 viewBackground:(Color blue);
+ level:1.
+ box addComponent:frame3.
+
+ box addOkButton.
+ box open
+
+
+ placing something inside a frame in a dialog:
-layout:aSymbol
- "define the position of the label;
- aSymbol may be: #topLeft, #topCenter, #topRight;
- #bottomLeft, #bottomCenter or #bottomRight"
+ |box panel frame1 frame2 frame3 v1 v1b v2 v3|
+
+ box := Dialog new.
+
+ frame1 := FramedBox label:'frame1'.
+ panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:frame1.
+ v1 := View extent:100@100 in:panel.
+ v1 viewBackground:(Color red);
+ level:1.
+ v1b := View extent:100@100 in:panel.
+ v1b viewBackground:(Color yellow);
+ level:1.
+
+ box addComponent:frame1.
- layout ~~ aSymbol ifTrue:[
- layout := aSymbol.
- self redrawIfShown
- ]
-! !
+ frame2 := FramedBox label:'frame2'.
+ v2 := View origin:0.0@0.0 corner:1.0@1.0 in:frame2.
+ v2 viewBackground:(Color green);
+ level:1.
+ box addComponent:frame2.
-!FramedBox methodsFor:'event handling'!
+ frame3 := FramedBox label:'frame3'.
+ v3 := View origin:0.0@0.0 corner:1.0@1.0 in:frame3.
+ v3 viewBackground:(Color blue);
+ level:1.
+ box addComponent:frame3.
-sizeChanged:how
- self redrawIfShown.
- super sizeChanged:how
+ box addOkButton.
+ box open
+"
! !
!FramedBox methodsFor:'drawing'!
@@ -246,6 +257,132 @@
]
! !
+!FramedBox methodsFor:'queries'!
+
+viewRectangle
+ "return the inside area
+ - redefined to save frame from relative computations."
+
+ |m2 sep|
+
+ sep := font height.
+ m2 := sep + sep.
+
+ showFrame ifFalse:[
+ ^ (0 @ sep) extent:(width @ (height - m2))
+ ].
+ ^ (sep @ sep) extent:((width - m2) @ (height - m2))
+
+"/ |m2 sepH sepV|
+"/
+"/ sepV := font height.
+"/
+"/ showFrame ifFalse:[
+"/ ^ (0 @ sepV) extent:(width @ (height - sepV - sepV))
+"/ ].
+"/ sepH := sepV // 2.
+"/ ^ (sepH @ sepH) extent:((width - sepH - sepH) @ (height - sepV - sepV))
+!
+
+preferedExtent
+ "redefined to add space for the frame to the default extent"
+
+ |m2 sep|
+
+ sep := font height.
+ m2 := sep + sep.
+
+ showFrame ifFalse:[
+ ^ super preferedExtent + (0 @ m2)
+ ].
+ ^ super preferedExtent+(m2 @ m2)
+! !
+
+!FramedBox methodsFor:'private'!
+
+redrawIfShown
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ]
+! !
+
+!FramedBox methodsFor:'accessing'!
+
+label:aString
+ "set the frames labelstring"
+
+ (label ~= aString) ifTrue:[
+ label := aString.
+ self redrawIfShown
+ ]
+!
+
+foregroundColor
+ "return the frame labels foreground color"
+
+ ^ fgColor
+!
+
+foregroundColor:aColor
+ "set the frame labels foreground color"
+
+ aColor ~= fgColor ifTrue:[
+ fgColor := aColor.
+ self redrawIfShown
+ ]
+!
+
+frameShown
+ "return true, if frame is shown;
+ if false, oly the label is shown"
+
+ ^ showFrame
+!
+
+showFrame:aBoolean
+ "turn on/off showing of the frame -
+ without a frame, only the label is shown at its position"
+
+ aBoolean ~~ showFrame ifTrue:[
+ showFrame := aBoolean.
+ self redrawIfShown
+ ]
+!
+
+label
+ "return the frames labelstring"
+
+ ^ label
+!
+
+font:aFont
+ "set the frame labelstrings font"
+
+ (font ~= aFont) ifTrue:[
+ super font:aFont.
+ self redrawIfShown
+ ]
+!
+
+layout
+ "return the current layout, which is a symbol describing
+ the labels position."
+
+ ^ layout
+!
+
+layout:aSymbol
+ "define the position of the label;
+ aSymbol may be: #topLeft, #topCenter, #topRight;
+ #bottomLeft, #bottomCenter or #bottomRight"
+
+ layout ~~ aSymbol ifTrue:[
+ layout := aSymbol.
+ self redrawIfShown
+ ]
+! !
+
!FramedBox methodsFor:'initialization'!
initialize
@@ -263,3 +400,11 @@
layout := StyleSheet at:'framedBoxLabelPosition' default:#topCenter.
frame3D := StyleSheet at:'framedBox3DFrame' default:true.
! !
+
+!FramedBox methodsFor:'event handling'!
+
+sizeChanged:how
+ self redrawIfShown.
+ super sizeChanged:how
+! !
+
--- a/HPanelV.st Mon May 08 17:19:27 1995 +0200
+++ b/HPanelV.st Tue May 09 03:57:16 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.9 1995-05-03 00:29:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.10 1995-05-09 01:55:48 claus Exp $
'!
!HorizontalPanelView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.9 1995-05-03 00:29:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.10 1995-05-09 01:55:48 claus Exp $
"
!
@@ -92,6 +92,9 @@
However, ff none of these layout/space combinations is exactly what you need
in your application, create a subclass, and redefine the setChildPositions
method there.
+
+ TODO: for completeness, support #fixRight, #fixRightSpace,
+ #rightFit, #rightSpaceFit layouts
"
!
@@ -242,7 +245,7 @@
v open
- example: full fit (vertical is default -> centered)
+ example: full fit i.e. no spacing (vertical is default -> centered)
|v p b1 b2 b3|
@@ -535,9 +538,10 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=leftFit'.
+ v label:'hL=leftFit hS=0; vL=fit'.
p horizontalLayout:#leftFit.
+ p horizontalSpace:0.
p verticalLayout:#fit.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -558,6 +562,49 @@
l3 ignoreParentDirectory:false.
v extent:400 @ 300.
v open
+
+
+ trouble example: self resizing elements may cause trouble
+
+ |v p l1 l2 l3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:v.
+
+ l1 := (Label label:'one' in:p) level:-1.
+ l2 := (Label label:'two' in:p) level:-1.
+ l3 := (Label label:'three' in:p) level:-1.
+
+ v extent:400 @ 300.
+ v open.
+
+ (Delay forSeconds:5) wait.
+
+ l1 label:'oneone'.
+ l2 label:'twotwo'.
+ l3 label:'threethree'.
+
+
+ fixed trouble example: tell the panel that this situation may happen
+
+ |v p l1 l2 l3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:v.
+ p elementsChangeSize:true.
+
+ l1 := (Label label:'one' in:p) level:-1.
+ l2 := (Label label:'two' in:p) level:-1.
+ l3 := (Label label:'three' in:p) level:-1.
+
+ v extent:400 @ 300.
+ v open.
+
+ (Delay forSeconds:5) wait.
+
+ l1 label:'oneone'.
+ l2 label:'twotwo'.
+ l3 label:'threethree'.
"
! !
--- a/HorizontalPanelView.st Mon May 08 17:19:27 1995 +0200
+++ b/HorizontalPanelView.st Tue May 09 03:57:16 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.9 1995-05-03 00:29:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.10 1995-05-09 01:55:48 claus Exp $
'!
!HorizontalPanelView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.9 1995-05-03 00:29:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.10 1995-05-09 01:55:48 claus Exp $
"
!
@@ -92,6 +92,9 @@
However, ff none of these layout/space combinations is exactly what you need
in your application, create a subclass, and redefine the setChildPositions
method there.
+
+ TODO: for completeness, support #fixRight, #fixRightSpace,
+ #rightFit, #rightSpaceFit layouts
"
!
@@ -242,7 +245,7 @@
v open
- example: full fit (vertical is default -> centered)
+ example: full fit i.e. no spacing (vertical is default -> centered)
|v p b1 b2 b3|
@@ -535,9 +538,10 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=leftFit'.
+ v label:'hL=leftFit hS=0; vL=fit'.
p horizontalLayout:#leftFit.
+ p horizontalSpace:0.
p verticalLayout:#fit.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -558,6 +562,49 @@
l3 ignoreParentDirectory:false.
v extent:400 @ 300.
v open
+
+
+ trouble example: self resizing elements may cause trouble
+
+ |v p l1 l2 l3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:v.
+
+ l1 := (Label label:'one' in:p) level:-1.
+ l2 := (Label label:'two' in:p) level:-1.
+ l3 := (Label label:'three' in:p) level:-1.
+
+ v extent:400 @ 300.
+ v open.
+
+ (Delay forSeconds:5) wait.
+
+ l1 label:'oneone'.
+ l2 label:'twotwo'.
+ l3 label:'threethree'.
+
+
+ fixed trouble example: tell the panel that this situation may happen
+
+ |v p l1 l2 l3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:v.
+ p elementsChangeSize:true.
+
+ l1 := (Label label:'one' in:p) level:-1.
+ l2 := (Label label:'two' in:p) level:-1.
+ l3 := (Label label:'three' in:p) level:-1.
+
+ v extent:400 @ 300.
+ v open.
+
+ (Delay forSeconds:5) wait.
+
+ l1 label:'oneone'.
+ l2 label:'twotwo'.
+ l3 label:'threethree'.
"
! !
--- a/LSelBox.st Mon May 08 17:19:27 1995 +0200
+++ b/LSelBox.st Tue May 09 03:57:16 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.11 1995-05-07 00:16:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.12 1995-05-09 01:55:56 claus Exp $
'!
!ListSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.11 1995-05-07 00:16:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.12 1995-05-09 01:55:56 claus Exp $
"
!
@@ -111,7 +111,7 @@
!ListSelectionBox methodsFor:'initialization'!
initialize
- |space2 v|
+ |space2 halfSpace v|
super initialize.
@@ -122,21 +122,22 @@
"self height:(height + (font height * 5)). "
space2 := 2 * ViewSpacing.
+ halfSpace := ViewSpacing // 2.
v := ScrollableView for:(self class listViewType) in:self.
"kludge: see note in EnterBox"
- v origin:(0.0
- @
- (enterField origin y + enterField height + ViewSpacing)).
- v extent:(1.0
- @
- (height
- - ViewSpacing - labelField heightIncludingBorder
- - ViewSpacing - enterField heightIncludingBorder
- - buttonPanel heightIncludingBorder - ViewSpacing
- - space2)
- ).
+"/ v origin:(0.0
+"/ @
+"/ (enterField origin y + enterField height + ViewSpacing)).
+"/ v extent:(1.0
+"/ @
+"/ (height
+"/ - ViewSpacing - labelField heightIncludingBorder
+"/ - ViewSpacing - enterField heightIncludingBorder
+"/ - buttonPanel heightIncludingBorder - ViewSpacing
+"/ - space2)
+"/ ).
v origin:[0.0
@
(enterField origin y + enterField height + ViewSpacing)]
@@ -148,7 +149,7 @@
- buttonPanel heightIncludingBorder - ViewSpacing
- space2)
].
- v leftInset:ViewSpacing//2; rightInset:ViewSpacing//2.
+ v leftInset:halfSpace; rightInset:halfSpace.
selectionList := v scrolledView.
@@ -188,19 +189,21 @@
preferedExtent
"return my prefered extent - thats the minimum size
- to make everything visible"
+ I like to have, to make everything visible"
|wWanted hWanted|
+
wWanted := labelField width + ViewSpacing + ViewSpacing.
(wWanted > width) ifFalse:[
wWanted := width
].
+
hWanted := ViewSpacing + labelField height +
ViewSpacing + enterField height +
ViewSpacing + selectionList height +
ViewSpacing + buttonPanel preferedExtent y +
- ViewSpacing.
+ ViewSpacing - (ViewSpacing * 2).
(hWanted < height) ifTrue:[
hWanted := height
--- a/Label.st Mon May 08 17:19:27 1995 +0200
+++ b/Label.st Tue May 09 03:57:16 1995 +0200
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.21 1995-05-03 00:29:53 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.22 1995-05-09 01:56:01 claus Exp $
'!
!Label class methodsFor:'documentation'!
@@ -45,7 +45,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.21 1995-05-03 00:29:53 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.22 1995-05-09 01:56:01 claus Exp $
"
!
@@ -72,6 +72,9 @@
to hold any changed logos later. (usually, you create the label first with
the longest string first to have it compute its size, then set the fixSize
attribute to avoid resizing later).
+ Be careful when placing self-resizing labels into panels - by default,
+ panels do not react on the size change - leading to ugly looking geometry.
+ (but you can tell the panel to watch for changes with #elementsCHangeSize:)
The placement of the contents within the label is controlled by
the adjust attribute, it can be set with:
@@ -109,6 +112,7 @@
so the label does NOT update its shown contents.
The aspectMsg defaults to #value.
+
Instance variables:
logo <Object> the logo, can be a Form, String or Text
@@ -368,9 +372,10 @@
top open
- MVC operation (model provides the label):
- (have to use a plug to simulate a model which responds to
- the #someAspect message):
+ MVC operation
+ model provides the label):
+ (have to use a plug to simulate a model which responds to
+ the #someAspect message):
|top l model|
@@ -391,8 +396,8 @@
concrete example (track a counters value):
- (here, the default aspect #value is used both to notify the label about
- changes and to aquire a new value from the model).
+ (here, the default aspect #value is used both to notify the label about
+ changes and to aquire a new value from the model).
|top l model|
@@ -410,13 +415,13 @@
top extent:(200 @ 200).
l := Label in:top.
+ l level:-1.
l model:model; labelMessage:#value.
top open
- MVC operation (model changes aspect after a while;
- two labels on the same model):
+ model changes aspect after a while; two labels on the same model:
|top l model|
@@ -441,7 +446,7 @@
model changed:#someAspect
- plugged MVC operation (getBlock returns the label):
+ plugged MVC operation (getBlock returns the label):
|top l model|
@@ -457,6 +462,97 @@
l model:model; labelMessage:#value.
top open.
+
+
+ use different label-selectors to access fields of a complex model:
+
+ |top panel model|
+
+ model := Plug new.
+ model respondTo:#field1 with:['value1'].
+ model respondTo:#field2 with:['value2'].
+ model respondTo:#field3 with:['value3'].
+ model respondTo:#field4 with:['value4'].
+
+ top := StandardSystemView new.
+
+ panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+ panel elementsChangeSize:true.
+
+ panel addSubView:((Label on:model) labelMessage:#field1).
+ panel addSubView:((Label on:model) labelMessage:#field2).
+ panel addSubView:((Label on:model) labelMessage:#field3).
+ panel addSubView:((Label on:model) labelMessage:#field4).
+
+ top extent:(200 @ 200).
+ top open.
+
+ (Delay forSeconds:5) wait.
+
+ model respondTo:#field2 with:['new value2'].
+ model changed:#value
+
+
+ same as above, using default aspects in the label, and an adaptor
+ to translate aspects:
+
+ |top panel model v1|
+
+ model := Plug new.
+ model respondTo:#field1 with:[v1].
+ model respondTo:#field1: with:[:arg | v1 := arg. model changed:#field1].
+ model respondTo:#field2 with:['value2'].
+ model respondTo:#field2: with:[:arg |].
+ model respondTo:#field3 with:['value3'].
+ model respondTo:#field3: with:[:arg |].
+ model respondTo:#field4 with:['value4'].
+ model respondTo:#field4: with:[:arg |].
+
+ top := StandardSystemView new.
+
+ panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+ panel elementsChangeSize:true.
+
+ panel addSubView:((Label on:((AspectAdaptor subject:model) forAspect:#field1)) labelMessage:#value).
+ panel addSubView:((Label on:((AspectAdaptor subject:model) forAspect:#field2)) labelMessage:#value).
+ panel addSubView:((Label on:((AspectAdaptor subject:model) forAspect:#field3)) labelMessage:#value).
+ panel addSubView:((Label on:((AspectAdaptor subject:model) forAspect:#field4)) labelMessage:#value).
+
+ top extent:(200 @ 200).
+ top open.
+
+ (Delay forSeconds:5) wait.
+
+ model field1:'new value1'.
+
+
+ use an adapter to access fields of a complex model:
+
+ |top l panel model|
+
+ model := #('one' 'two' 'three') asValue.
+
+ top := StandardSystemView new.
+
+ panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+ panel elementsChangeSize:true.
+
+ panel addSubView:((Label on:(ProtocolAdaptor
+ subjectChannel:model
+ accessPath:#(1))) labelMessage:#value).
+ panel addSubView:((Label on:(ProtocolAdaptor
+ subjectChannel:model
+ accessPath:#(2))) labelMessage:#value).
+ panel addSubView:((Label on:(ProtocolAdaptor
+ subjectChannel:model
+ accessPath:#(3))) labelMessage:#value).
+
+ top extent:(200 @ 200).
+ top open.
+
+ (Delay forSeconds:5) wait.
+
+ model value:#('oneone' 'twotwo' 'threethree').
"
! !
@@ -522,6 +618,40 @@
]
! !
+!
+
+!Label methodsFor:'accessing-mvc'!
+
+model:aModel
+ super model:aModel.
+ self getLabelFromModel.
+!
+
+labelMessage
+ "return the symbol used to aquire the labelString/image from the model
+ when the aspect changes.
+ The default is nil, which means: leave the label unchanged."
+
+ ^ labelMsg
+!
+
+labelMessage:aSymbol
+ "set the symbol used to aquire the labelString/image from the model.
+ The default is nil, which means: leave the label unchanged."
+
+ labelMsg ~~ aSymbol ifTrue:[
+ labelMsg := aSymbol.
+ self getLabelFromModel
+ ]
+!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#labelMessage put:labelMsg
+! !
+
!Label methodsFor:'accessing'!
foregroundColor:aColor
@@ -558,13 +688,6 @@
self redraw
!
-labelMessage:aSymbol
- "set the symbol used to aquire the labelString/image from the model.
- The default is nil, which means: leave the label unchanged."
-
- labelMsg := aSymbol
-!
-
labelString:aString
"for ST-80 compatibility: same as #label:
set the label-string; adjust extent if not already realized and not fixedSize"
@@ -639,6 +762,18 @@
^ labelWidth
!
+layout:how
+ "for protocol compatibility: alias for #adjust:"
+
+ self adjust:how
+!
+
+layout
+ "for protocol compatibility: alias for #adjust"
+
+ ^ self adjust
+!
+
adjust:how
"set the adjust, how which must be one of
@@ -659,6 +794,12 @@
]
!
+adjust
+ "return the adjust symbol"
+
+ ^ adjust
+!
+
font:aFont
"set the font - if I'm not realized and not fixedSize, adjust my size"
@@ -690,10 +831,6 @@
super realize.
"/ fgColor := fgColor on:device.
"/ bgColor := bgColor on:device.
- (model notNil
- and:[aspectMsg notNil]) ifTrue:[
- self getLabelFromModel.
- ]
!
initialize
@@ -795,14 +932,9 @@
but show different labels when changed (also, constant labels
which have a nil labelMsg will not try to aquire a labelString)."
- |sym|
-
- model notNil ifTrue:[
- sym := labelMsg.
-"/ sym isNil ifTrue:[sym := aspect<sg].
- sym notNil ifTrue:[
- self label:(model perform:sym) printString.
- ]
+ (model notNil
+ and:[labelMsg notNil]) ifTrue:[
+ self label:(model perform:labelMsg) printString.
].
!
@@ -937,13 +1069,11 @@
changedObject == model ifTrue:[
something == aspectMsg ifTrue:[
- labelMsg notNil ifTrue:[
- self getLabelFromModel.
- ].
+ self getLabelFromModel.
^ self.
]
].
- super update:something
+ ^ super update:something with:aParameter from:changedObject
! !
!Label methodsFor:'queries'!
--- a/ListSelectionBox.st Mon May 08 17:19:27 1995 +0200
+++ b/ListSelectionBox.st Tue May 09 03:57:16 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.11 1995-05-07 00:16:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.12 1995-05-09 01:55:56 claus Exp $
'!
!ListSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.11 1995-05-07 00:16:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.12 1995-05-09 01:55:56 claus Exp $
"
!
@@ -111,7 +111,7 @@
!ListSelectionBox methodsFor:'initialization'!
initialize
- |space2 v|
+ |space2 halfSpace v|
super initialize.
@@ -122,21 +122,22 @@
"self height:(height + (font height * 5)). "
space2 := 2 * ViewSpacing.
+ halfSpace := ViewSpacing // 2.
v := ScrollableView for:(self class listViewType) in:self.
"kludge: see note in EnterBox"
- v origin:(0.0
- @
- (enterField origin y + enterField height + ViewSpacing)).
- v extent:(1.0
- @
- (height
- - ViewSpacing - labelField heightIncludingBorder
- - ViewSpacing - enterField heightIncludingBorder
- - buttonPanel heightIncludingBorder - ViewSpacing
- - space2)
- ).
+"/ v origin:(0.0
+"/ @
+"/ (enterField origin y + enterField height + ViewSpacing)).
+"/ v extent:(1.0
+"/ @
+"/ (height
+"/ - ViewSpacing - labelField heightIncludingBorder
+"/ - ViewSpacing - enterField heightIncludingBorder
+"/ - buttonPanel heightIncludingBorder - ViewSpacing
+"/ - space2)
+"/ ).
v origin:[0.0
@
(enterField origin y + enterField height + ViewSpacing)]
@@ -148,7 +149,7 @@
- buttonPanel heightIncludingBorder - ViewSpacing
- space2)
].
- v leftInset:ViewSpacing//2; rightInset:ViewSpacing//2.
+ v leftInset:halfSpace; rightInset:halfSpace.
selectionList := v scrolledView.
@@ -188,19 +189,21 @@
preferedExtent
"return my prefered extent - thats the minimum size
- to make everything visible"
+ I like to have, to make everything visible"
|wWanted hWanted|
+
wWanted := labelField width + ViewSpacing + ViewSpacing.
(wWanted > width) ifFalse:[
wWanted := width
].
+
hWanted := ViewSpacing + labelField height +
ViewSpacing + enterField height +
ViewSpacing + selectionList height +
ViewSpacing + buttonPanel preferedExtent y +
- ViewSpacing.
+ ViewSpacing - (ViewSpacing * 2).
(hWanted < height) ifTrue:[
hWanted := height
--- a/ListView.st Mon May 08 17:19:27 1995 +0200
+++ b/ListView.st Tue May 09 03:57:16 1995 +0200
@@ -38,7 +38,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.25 1995-05-06 14:17:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.26 1995-05-09 01:56:08 claus Exp $
'!
!ListView class methodsFor:'documentation'!
@@ -59,7 +59,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.25 1995-05-06 14:17:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.26 1995-05-09 01:56:08 claus Exp $
"
!
@@ -345,6 +345,7 @@
list notNil ifTrue:[
self expandTabs
].
+ widthOfWidestLine := nil. "/ i.e. unknown
oldFirst := firstLineShown.
oldLeft := leftOffset.
firstLineShown := 1.
@@ -466,10 +467,10 @@
^ self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:nil
!
-on:aModel aspect:aspectSymbol list:listSymbol menu:menuSymbol
+on:aModel aspect:aspectSymbol change:changeSymbol
"ST-80 compatibility"
- ^ self on:aModel aspect:aspectSymbol change:nil list:listSymbol menu:menuSymbol
+ ^self on:aModel aspect:aspectSymbol change:changeSymbol list:aspectSymbol menu:nil
!
on:aModel aspect:aspectSymbol menu:menuSymbol
@@ -478,10 +479,10 @@
^self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:menuSymbol
!
-on:aModel aspect:aspectSymbol change:changeSymbol
+on:aModel aspect:aspectSymbol list:listSymbol menu:menuSymbol
"ST-80 compatibility"
- ^self on:aModel aspect:aspectSymbol change:changeSymbol list:aspectSymbol menu:nil
+ ^ self on:aModel aspect:aspectSymbol change:nil list:listSymbol menu:menuSymbol
!
on:aModel aspect:aspectSymbol change:changeSymbol menu:menuSymbol
@@ -500,12 +501,22 @@
self model:aModel.
!
-listMessage:listSymbol
- "ST-80 compatibility: set the listMsg selector; this is sent to
- the model (if any) to aquire a new text upon change of the aspect.
+listMessage
+ "return the listMsg selector;
+ if non-nil, this is the message sent to the model (if any) to aquire
+ a new text upon change of the aspect.
This defaults to the aspect-selector."
- listMsg := listSymbol.
+ ^ listMsg
+!
+
+listMessage:aSymbol
+ "ST-80 compatibility: set the listMsg selector;
+ if non-nil, this will be sent to the model (if any) to aquire a
+ new text upon change of the aspect.
+ This defaults to the aspect-selector."
+
+ listMsg := aSymbol.
!
menuHolder
@@ -541,6 +552,13 @@
"change the one that does the menu actions."
menuPerformer := anObject
+!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#listMessage put:listMsg
! !
!ListView methodsFor:'private'!
@@ -2614,16 +2632,33 @@
keyPress:key x:x y:y
"a key was pressed - handle page-keys here"
+ |sensor n|
+
(key == #PreviousPage) ifTrue: [^ self pageUp].
(key == #NextPage) ifTrue: [^ self pageDown].
(key == #HalfPageUp) ifTrue: [^ self halfPageUp].
(key == #HalfPageDown) ifTrue: [^ self halfPageDown].
- (key == #ScrollUp) ifTrue:[^ self scrollUp].
- (key == #ScrollDown) ifTrue:[^ self scrollDown].
-
(key == #BeginOfText) ifTrue:[^ self scrollToTop].
(key == #EndOfText) ifTrue:[^ self scrollToBottom].
+ sensor := self sensor.
+ (key == #ScrollUp) ifTrue:[
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#ScrollUp).
+ ].
+ ^ self scrollUp:n
+ ].
+ (key == #ScrollDown) ifTrue:[
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#ScrollDown).
+ ].
+ ^ self scrollDown:n
+ ].
+
super keyPress:key x:x y:y
! !
--- a/PanelView.st Mon May 08 17:19:27 1995 +0200
+++ b/PanelView.st Tue May 09 03:57:16 1995 +0200
@@ -10,18 +10,21 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:05:18 pm'!
+
SimpleView subclass:#PanelView
- instanceVariableNames:'hLayout vLayout verticalSpace horizontalSpace mustRearrange'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
+ instanceVariableNames:'hLayout vLayout verticalSpace horizontalSpace mustRearrange
+ elementsChangeSize'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Layout'
!
PanelView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.8 1995-05-03 00:36:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.9 1995-05-09 01:56:22 claus Exp $
'!
!PanelView class methodsFor:'documentation'!
@@ -42,7 +45,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.8 1995-05-03 00:36:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.9 1995-05-09 01:56:22 claus Exp $
"
!
@@ -84,95 +87,13 @@
defaults to ViewSpacing, which is 1mm
mustRearrange <Boolean> internal flag, if rearrangement is needed
+
+ elementsChangeSize
+ <Boolean> if true, the panel takes care of this situation.
+ By default, this is false.
"
! !
-!PanelView methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- hLayout := vLayout := #center. "/ notice, this is ignored in this class
- verticalSpace := ViewSpacing.
- horizontalSpace := ViewSpacing.
- mustRearrange := false
-!
-
-realize
- mustRearrange ifTrue:[
- self setChildPositions
- ].
- super realize
-!
-
-setChildPositionsIfChanged
- "set all of my child positions - this is usually delayed,
- until the panel is actually shown (since we dont know, if more
- elements are to be added) thus avoiding repositioning the elements
- over and over. However, sometimes it is nescessary, to force positioning
- the elements, for example, before querying the relative position of
- an element (modalBoxes do so, to position the ok-button under the mouse
- pointer)."
-
- mustRearrange ifTrue:[
- self setChildPositions
- ].
-
-! !
-
-!PanelView methodsFor:'accessing'!
-
-verticalSpace:numberOfPixels
- "set the vertical space between elements (in pixels).
- The default is computed for 1mm spacing."
-
- verticalSpace ~= numberOfPixels ifTrue:[
- verticalSpace := numberOfPixels.
- self layoutChanged
- ]
-!
-
-horizontalSpace:numberOfPixels
- "set the horizontal space between elements on pixels (default is 1mm)"
-
- horizontalSpace ~= numberOfPixels ifTrue:[
- horizontalSpace := numberOfPixels.
- self layoutChanged
- ]
-!
-
-space:numberOfPixels
- "set the space between elements in pixels (default is 1mm) for both directions"
-
- (verticalSpace ~= numberOfPixels
- or:[horizontalSpace ~= numberOfPixels]) ifTrue:[
- horizontalSpace := numberOfPixels.
- verticalSpace := numberOfPixels.
- self layoutChanged
- ]
-!
-
-addSubView:aView
- "redefined to recompute layout when a subview is added"
-
- super addSubView:aView.
- self layoutChanged
-!
-
-addSubView:newView after:aView
- "redefined to recompute layout when a subview is added"
-
- super addSubView:newView after:aView.
- self layoutChanged
-!
-
-addSubView:newView before:aView
- "redefined to recompute layout when a subview is added"
-
- super addSubView:newView before:aView.
- self layoutChanged
-! !
-
!PanelView methodsFor:'event processing'!
sizeChanged:how
@@ -180,6 +101,19 @@
super sizeChanged:how.
self layoutChanged
+!
+
+update:something with:aParameter from:changedObject
+ something == #sizeOfView ifTrue:[
+ "
+ an element changed its size
+ "
+ (subViews includes:changedObject) ifTrue:[
+ self layoutChanged
+ ].
+ ^ self
+ ].
+ ^ super update:something with:aParameter from:changedObject
! !
!PanelView methodsFor:'private'!
@@ -197,6 +131,15 @@
]
!
+addedView:aView
+ "added a new element"
+
+ elementsChangeSize ifTrue:[
+ aView addDependent:self
+ ].
+ self layoutChanged
+!
+
setChildPositions
"(re)compute position of every child.
This method is redefined for different layout characteristics - you may
@@ -247,3 +190,107 @@
].
mustRearrange := false
! !
+
+!PanelView methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ hLayout := vLayout := #center. "/ notice, this is ignored in this class
+ "/ used by subclasses only
+ verticalSpace := ViewSpacing.
+ horizontalSpace := ViewSpacing.
+ mustRearrange := elementsChangeSize := false
+!
+
+realize
+ mustRearrange ifTrue:[
+ self setChildPositions
+ ].
+ super realize
+!
+
+setChildPositionsIfChanged
+ "set all of my child positions - this is usually delayed,
+ until the panel is actually shown (since we dont know, if more
+ elements are to be added) thus avoiding repositioning the elements
+ over and over. However, sometimes it is nescessary, to force positioning
+ the elements, for example, before querying the relative position of
+ an element (modalBoxes do so, to position the ok-button under the mouse
+ pointer)."
+
+ mustRearrange ifTrue:[
+ self setChildPositions
+ ].
+
+! !
+
+!PanelView methodsFor:'accessing'!
+
+addSubView:aView
+ "redefined to recompute layout when a subview is added"
+
+ super addSubView:aView.
+ self addedView:aView
+!
+
+addSubView:newView after:aView
+ "redefined to recompute layout when a subview is added"
+
+ super addSubView:newView after:aView.
+ self addedView:aView
+!
+
+elementsChangeSize:aBoolean
+ "tell the panel if elements are to change their size by themselfes
+ (for example, Lables or Buttons may do so if their contents changes).
+ Setting this flag will make the panel reorganize the elements whenever
+ any element changes its size."
+
+ elementsChangeSize := aBoolean.
+ aBoolean ifTrue:[
+ subViews notNil ifTrue:[
+ subViews do:[:aView |
+ aView addDependent:self
+ ]
+ ]
+ ]
+!
+
+addSubView:newView before:aView
+ "redefined to recompute layout when a subview is added"
+
+ super addSubView:newView before:aView.
+ self addedView:aView
+!
+
+verticalSpace:numberOfPixels
+ "set the vertical space between elements (in pixels).
+ The default is computed for 1mm spacing."
+
+ verticalSpace ~= numberOfPixels ifTrue:[
+ verticalSpace := numberOfPixels.
+ self layoutChanged
+ ]
+!
+
+horizontalSpace:numberOfPixels
+ "set the horizontal space between elements on pixels (default is 1mm)"
+
+ horizontalSpace ~= numberOfPixels ifTrue:[
+ horizontalSpace := numberOfPixels.
+ self layoutChanged
+ ]
+!
+
+space:numberOfPixels
+ "set the space between elements in pixels (default is 1mm) for both directions"
+
+ (verticalSpace ~= numberOfPixels
+ or:[horizontalSpace ~= numberOfPixels]) ifTrue:[
+ horizontalSpace := numberOfPixels.
+ verticalSpace := numberOfPixels.
+ self layoutChanged
+ ]
+! !
+
--- a/PopUpList.st Mon May 08 17:19:27 1995 +0200
+++ b/PopUpList.st Tue May 09 03:57:16 1995 +0200
@@ -10,10 +10,10 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 4-may-1995 at 6:16:25 am'!
+'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:04:16 pm'!
Button subclass:#PopUpList
- instanceVariableNames:'menu menuAction values useIndex listMsg'
+ instanceVariableNames:'menu menuAction values useIndex listMsg initialSelectionMsg'
classVariableNames:''
poolDictionaries:''
category:'Views-Interactors'
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.11 1995-05-06 14:17:44 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.12 1995-05-09 01:56:26 claus Exp $
'!
!PopUpList class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.11 1995-05-06 14:17:44 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.12 1995-05-09 01:56:26 claus Exp $
"
!
@@ -55,10 +55,33 @@
list.
When an entry is selected, an actionBlock (if nonNil) is evaluated
and (if nonNil), the model is notified via the changeMessage.
+
The default changeMessage used is #selection:, which allows a
PopUpList to be used with a SelectionInList as model.
(if used with some other model, either use an adaptor, or set the
- changeMessage to something else ..)
+ changeMessage to something else ..)
+
+ Instance variables:
+
+ menu helpers for the popup menu
+ menuAction
+ values
+
+ useIndex <Boolean> if true, the index of the selected entry
+ is passed to the action block and the
+ model in a change-message.
+ If false (the default), the value is passed.
+ Notice that the default changeMessage is
+ #selection:, which is not ok to be used
+ with useIndex:true and a selectionInList model.
+ (set the changeMessage to #selectionIndex: then)
+
+ listMsg <Symbol> message to aquire a new list from the
+ model. Default is #list.
+
+
+ initialSelectionMsg <Symbol> message to aquire a new selection from the
+ model. Default is #selection.
"
!
@@ -117,15 +140,15 @@
|p|
p := PopUpList label:'dummy'.
p list:#('apples' 'bananas' 'grape' 'lemon'
- '='
- 'margaritas' 'pina colada'
- '='
- 'smalltalk' 'c++' 'eiffel').
+ '='
+ 'margaritas' 'pina colada'
+ '='
+ 'smalltalk' 'c++' 'eiffel').
p values:#(apples bananas grape lemon
- nil
- 'mhmh - so good' 'makes headache'
- nil
- 'great' 'another headache' 'no bad').
+ nil
+ 'mhmh - so good' 'makes headache'
+ nil
+ 'great' 'another headache' 'no bad').
p selection:'apples'.
p action:[:what | Transcript show:'you selected: '; showCr:what].
p open
@@ -161,11 +184,27 @@
model := SelectionInList with:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
p := PopUpList label:'healthy fruit'.
- p model:model; useIndex:true.
+ p model:model; useIndex:true; change:#selectionIndex:.
p open.
model selectionIndexHolder inspect
+ a popupList and a SelectionInListView on the same model:
+
+ |p slv model|
+
+ model := SelectionInList with:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ model selection:'apples'.
+
+ p := PopUpList on:model.
+ p open.
+
+ slv := SelectionInListView on:model.
+ slv open.
+
+ model selectionIndexHolder inspect
+
+
two PopUpLists on the same model:
|top panel p model|
@@ -193,22 +232,48 @@
"
! !
-!PopUpList methodsFor:'initialization'!
+!PopUpList class methodsFor:'defaults'!
+
+defaultAspectMessage
+ ^ #selection
+!
+
+defaultListMessage
+ ^ #list
+!
+
+defaultChangeMessage
+ ^ #selection:
+! !
+
+!PopUpList methodsFor:'drawing'!
-initialize
- super initialize.
- controller beTriggerOnDown.
- controller action:[self popMenu].
- self adjust:#left.
- useIndex := false.
- changeMsg := #selection:.
- listMsg := #list.
- aspectMsg := #selection.
- onLevel := offLevel.
+drawWith:fgColor and:bgColor
+ |mmH mmV mW mH|
+
+ controller pressed ifTrue:[
+ super drawWith:enteredFgColor and:enteredBgColor
+ ] ifFalse:[
+ super drawWith:fgColor and:bgColor.
+ ].
+ mmH := device horizontalPixelPerMillimeter rounded.
+ mmV := device verticalPixelPerMillimeter rounded.
+ mW := (device horizontalPixelPerMillimeter * 2.5) rounded.
+ mH := (device verticalPixelPerMillimeter * 1.5) rounded.
+
+ self drawEdgesForX:(width - mW - (hSpace*2)) y:(height - mmV // 2)
+ width:mW height:mH level:2
! !
!PopUpList methodsFor:'private'!
+realize
+ super realize.
+ model notNil ifTrue:[
+ self getListFromModel
+ ].
+!
+
computeLabelSize
"compute the extent needed to hold the label plus the mark"
@@ -243,11 +308,12 @@
labelHeight := labelHeight max: (mmV * 2) rounded
!
-realize
- super realize.
- model notNil ifTrue:[
- self createMenuFor:(model perform:listMsg).
-
+getSelectionFromModel
+ "if I have a model and a listMsg, get my list from it"
+
+ (model notNil
+ and:[aspectMsg notNil]) ifTrue:[
+ self selection:(model perform:aspectMsg).
].
!
@@ -260,21 +326,12 @@
for:self.
!
-getSelectionFromModel
- "if I have a model and a listMsg, get my list from it"
-
- (model notNil
- and:[aspectMsg notNil]) ifTrue:[
- self selection:(model perform:aspectMsg).
- ].
-!
-
getListFromModel
"if I have a model and a listMsg, get my list from it"
(model notNil
and:[listMsg notNil]) ifTrue:[
- self list:(model perform:listMsg).
+ self list:(model perform:listMsg).
].
! !
@@ -284,66 +341,52 @@
|org mv|
menu notNil ifTrue:[
- self turnOffWithoutRedraw.
- menu font:font.
+ self turnOffWithoutRedraw.
+ menu font:font.
- "
- adjust the menus width to my current width
- "
- mv := menu menuView.
- mv create. "/ stupid: it resizes itself upon first create
- mv width:(self width - (2 * menu margin) - (menu borderWidth*2)).
- mv level:0; borderWidth:0.
+ "
+ adjust the menus width to my current width
+ "
+ mv := menu menuView.
+ mv create. "/ stupid: it resizes itself upon first create
+ mv width:(self width - (2 * menu margin) - (menu borderWidth*2)).
+ mv level:0; borderWidth:0.
- "
- the popupMenu wants Display coordinates in its showAt: method
- "
- org := device translatePoint:0@0
- from:(self id)
- to:(DisplayRootView new id).
+ "
+ the popupMenu wants Display coordinates in its showAt: method
+ "
+ org := device translatePoint:0@0
+ from:(self id)
+ to:(DisplayRootView new id).
- menu showAt:org "resizing:false"
+ menu showAt:org "resizing:false"
].
! !
-!PopUpList methodsFor:'drawing'!
-
-drawWith:fgColor and:bgColor
- |mmH mmV mW mH|
-
- controller pressed ifTrue:[
- super drawWith:enteredFgColor and:enteredBgColor
- ] ifFalse:[
- super drawWith:fgColor and:bgColor.
- ].
- mmH := device horizontalPixelPerMillimeter rounded.
- mmV := device verticalPixelPerMillimeter rounded.
- mW := (device horizontalPixelPerMillimeter * 2.5) rounded.
- mH := (device verticalPixelPerMillimeter * 1.5) rounded.
-
- self drawEdgesForX:(width - mW - (hSpace*2)) y:(height - mmV // 2)
- width:mW height:mH level:2
-! !
-
!PopUpList methodsFor:'accessing'!
-useIndex:aBoolean
- useIndex := aBoolean
+selection:indexOrString
+ "set (force) a selection - usually done to set
+ an initial selection without updating others"
+
+ |index|
+
+ index := menu labels indexOf:indexOrString.
+ index == 0 ifTrue:[^ self].
+ self label:(menu labels at:index)
"
|p|
- p := PopUpList label:'fruit ?'.
+ p := PopUpList label:'what fruit ?'.
p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
- p action:[:val | Transcript showCr:'selected: ' , val printString].
- p open.
- "
- "
+ p selection:'grape'.
+ p open
+
|p|
- p := PopUpList label:'fruit ?'.
+ p := PopUpList label:'what fruit ?'.
p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
- p action:[:val | Transcript showCr:'selected: ' , val printString].
- p useIndex:true.
- p open.
+ p selection:'blabla'.
+ p open
"
!
@@ -372,6 +415,30 @@
menuAction := aOneArgBlock
!
+useIndex:aBoolean
+ "tell the popuplist to pass the index (instead of the value)
+ to both the actionBlock and model. Notice, that if you use a model,
+ the default changeSelector is not ok for using index and a SelectionInList"
+
+ useIndex := aBoolean
+
+ "
+ |p|
+ p := PopUpList label:'fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p action:[:val | Transcript showCr:'selected: ' , val printString].
+ p open.
+ "
+ "
+ |p|
+ p := PopUpList label:'fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p action:[:val | Transcript showCr:'selected: ' , val printString].
+ p useIndex:true.
+ p open.
+ "
+!
+
contents
^ self label
!
@@ -387,31 +454,6 @@
^ menu labels
!
-selection:indexOrString
- "set (force) a selection - usually done to set
- an initial selection"
-
- |index|
-
- index := menu labels indexOf:indexOrString.
- index == 0 ifTrue:[^ self].
- self label:(menu labels at:index)
-
- "
- |p|
- p := PopUpList label:'what fruit ?'.
- p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
- p selection:'grape'.
- p open
-
- |p|
- p := PopUpList label:'what fruit ?'.
- p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
- p selection:'blabla'.
- p open
- "
-!
-
values:aList
"set a value list - these are reported via the action or changeSymbol instead of
the labe strings."
@@ -434,6 +476,27 @@
Default is #list."
listMsg := aSelector
+!
+
+listMessage
+ "return the selector by which we ask the model for the list.
+ Default is #list."
+
+ ^ listMsg
+! !
+
+!PopUpList methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ controller beTriggerOnDown.
+ controller action:[self popMenu].
+ self adjust:#left.
+ useIndex := false.
+
+ listMsg := self class defaultListMessage.
+
+ onLevel := offLevel.
! !
!PopUpList methodsFor:'user actions'!
@@ -445,16 +508,16 @@
label := menu labels at:anEntry.
values isNil ifTrue:[
- value := anEntry.
- useIndex ifFalse:[
- value := menu labels at:anEntry.
- ]
+ value := anEntry.
+ useIndex ifFalse:[
+ value := menu labels at:anEntry.
+ ]
] ifFalse:[
- value := values at:anEntry
+ value := values at:anEntry
].
menuAction notNil ifTrue:[
- menuAction value:value.
+ menuAction value:value.
].
self sizeFixed:true.
self label:label printString.
@@ -467,16 +530,15 @@
!PopUpList methodsFor:'change & update'!
update:something with:aParameter from:changedObject
- (changedObject == model) ifTrue:[
-
- something == aspectMsg ifTrue:[
- self getSelectionFromModel.
- ] ifFalse:[
- something == listMsg ifTrue:[
- self getListFromModel.
- ].
- ].
- ^ self
+ changedObject == model ifTrue:[
+ something == aspectMsg ifTrue:[
+ self getSelectionFromModel.
+ ^ self
+ ].
+ something == listMsg ifTrue:[
+ self getListFromModel.
+ ].
+ ^ self
].
super update:something with:aParameter from:changedObject
! !
--- a/SelListV.st Mon May 08 17:19:27 1995 +0200
+++ b/SelListV.st Tue May 09 03:57:16 1995 +0200
@@ -10,23 +10,24 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:01:02 am'!
+'From Smalltalk/X, Version:2.10.5 on 8-may-1995 at 11:59:03 am'!
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 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'
!
@@ -35,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.31 1995-05-08 15:19:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.32 1995-05-09 01:56:42 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -56,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.31 1995-05-08 15:19:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.32 1995-05-09 01:56:42 claus Exp $
"
!
@@ -157,6 +158,8 @@
keyActionStyle <Symbol> controls how to respond to keyboard selects
+ returnKeyActionStyle <Symbol> controls how to respond to return key
+
written spring/summer 89 by claus
3D Jan 90 by claus
multiselect Jun 92 by claus
@@ -170,202 +173,301 @@
or in the traditional mvc way.
with actions:
- simple:
-
- |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:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ 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
+
+
+ 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
+
+
+ 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
+
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:[:index | Transcript showCr:'selected ' , index 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
+
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 | slv selectionValue asFilename edit].
-
- 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.
+ 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
+
+
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').
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#list
- change:#selection:
- list:#list
- initialSelection:#selection.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
- model inspect
-
-
- since the above selectors are the default anyway, you can also use:
-
- |top slv model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
-
- 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.
"
! !
@@ -387,6 +489,18 @@
useIndex:useIndex
!
+on:aModel aspect:aspect change:change list:list initialSelection:initial
+ ^ self on:aModel
+ printItems:true
+ oneItem:false
+ aspect:aspect
+ change:change
+ list:list
+ menu:nil
+ initialSelection:initial
+ useIndex:true
+!
+
on:aModel printItems:print oneItem:one aspect:aspect
change:change list:list menu:menu initialSelection:initial
@@ -413,22 +527,26 @@
menu:menu
initialSelection:initial
useIndex:true
-!
-
-on:aModel aspect:aspect change:change list:list initialSelection:initial
- ^ self on:aModel
- printItems:true
- oneItem:false
- aspect:aspect
- change:change
- list:list
- menu:nil
- initialSelection:initial
- useIndex:true
! !
!SelectionInListView class methodsFor:'defaults'!
+defaultListMessage
+ ^ #list
+!
+
+defaultChangeMessage
+ ^ #selectionIndex:
+!
+
+defaultAspectMessage
+ ^ nil
+!
+
+defaultSelectionMessage
+ ^ #selectionIndex
+!
+
rightArrowShadowFormOn:aDevice
"return the form used for the right arrow light pixels (3D only)"
@@ -604,14 +722,333 @@
^ f
! !
+!SelectionInListView methodsFor:'selections'!
+
+isInSelection:aNumber
+ "return true, if line, aNumber is in the selection"
+
+ selection isNil ifTrue:[^ false].
+ multipleSelectOk ifTrue:[
+ ^ (selection includes:aNumber)
+ ].
+ ^ (aNumber == selection)
+!
+
+selectWithoutScroll:aNumberOrNilOrCollection
+ "select line, aNumber or deselect if argument is nil"
+
+ |prevSelection newSelection|
+
+ newSelection := aNumberOrNilOrCollection.
+ newSelection notNil ifTrue:[
+ (self isValidSelection:newSelection) ifFalse:[
+ newSelection := nil
+ ]
+ ].
+
+ (newSelection = selection) ifTrue: [^ self].
+
+ "
+ redraw old selection unhighlighted
+ "
+ selection notNil ifTrue: [
+ prevSelection := selection.
+ selection := nil.
+ multipleSelectOk ifTrue:[
+ prevSelection do:[:line |
+ self redrawElement:line
+ ]
+ ] ifFalse:[
+ self redrawElement:prevSelection
+ ]
+ ].
+
+ selection := newSelection.
+
+ "
+ redraw new selection unhighlighted
+ "
+ newSelection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ newSelection isCollection ifFalse:[
+ selection := OrderedCollection with:newSelection.
+ ].
+ selection do:[:line |
+ self redrawElement:line
+ ]
+ ] ifFalse:[
+ self redrawElement:selection
+ ]
+ ]
+
+!
+
+makeSelectionVisible
+ "scroll to make the selection line visible"
+
+ |line|
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ line := selection first.
+ ] ifFalse:[
+ line := selection
+ ].
+ self makeLineVisible:line
+ ]
+!
+
+selection:aNumberOrNil
+ "select line, aNumber or deselect if argument is nil;
+ scroll to make the selected line visible"
+
+ self selectWithoutScroll:aNumberOrNil.
+ selection notNil ifTrue:[self makeSelectionVisible]
+!
+
+selectionValue
+ "return the selection value i.e. the text in the selected line.
+ For multiple selections a collection containing the entries is returned."
+
+ selection isNil ifTrue:[^ nil].
+
+ multipleSelectOk ifTrue:[
+ ^ selection collect:[:nr | self at:nr]
+ ].
+ ^ self at:selection
+
+!
+
+hasSelection
+ "return true, if the view has a selection"
+
+ ^ selection notNil
+!
+
+selectElement:anObject
+ "select the element with same printString as the argument, anObject.
+ Scroll to make the new selection visible."
+
+ |lineNo|
+
+ list notNil ifTrue:[
+ items notNil ifTrue:[
+ lineNo := items indexOf:anObject ifAbsent:nil
+ ] ifFalse:[
+ lineNo := list indexOf:(anObject printString) ifAbsent:nil.
+ ].
+ lineNo notNil ifTrue:[self selection:lineNo]
+ ]
+!
+
+selection
+ "return the selection index or collection of indices (if multipleSelect is on)"
+
+ ^ selection
+!
+
+selectionChangedFrom:oldSelection
+ "selection has changed. Call actionblock and/or send changeMessage if defined"
+
+ |arg|
+
+ arg := self argForChangeMessage.
+ "
+ the ST/X way of doing things - perform actionBlock
+ "
+ actionBlock notNil ifTrue:[actionBlock value:arg].
+ "
+ the ST-80 way of doing things - notify model via changeMsg
+ "
+ "/ ST80 sends 0 as index, if the same selection is reselected ...
+ selection == oldSelection ifTrue:[
+ arg := 0
+ ].
+ self sendChangeMessageWith:arg
+!
+
+deselect
+ "deselect"
+
+ self selection:nil
+!
+
+deselectWithoutRedraw
+ "deselect - no redraw"
+
+ selection := nil
+!
+
+numberOfSelections
+ "return the number of selected entries"
+
+ |sz|
+
+ selection isNil ifTrue:[^ 0].
+ sz := selection size.
+ sz > 0 ifTrue:[^ sz].
+ ^ 1
+!
+
+valueIsInSelection:someString
+ "return true, if someString is in the selection"
+
+ |sel|
+
+ selection isNil ifTrue:[^ false].
+ sel := self selectionValue.
+ self numberOfSelections > 1 ifTrue:[
+ ^ (sel includes:someString)
+ ].
+ ^ (someString = sel)
+!
+
+selectElementWithoutScroll:anObject
+ "select the element with same printString as the argument, anObject.
+ Do not scroll."
+
+ |lineNo|
+
+ list notNil ifTrue:[
+ items notNil ifTrue:[
+ lineNo := items indexOf:anObject ifAbsent:nil
+ ] ifFalse:[
+ lineNo := list indexOf:(anObject printString) ifAbsent:nil.
+ ].
+ lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
+ ]
+!
+
+nextAfterSelection
+ "return the index of the next selectable entry after the selection.
+ Wrap at end."
+
+ |next|
+
+ selection isNil ifTrue:[
+ next := firstLineShown
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ next := selection max + 1
+ ] ifFalse:[
+ next := selection + 1
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next > self size ifTrue:[
+ next := 1.
+ ] ifFalse:[
+ [next <= self size
+ and:[(self isValidSelection:next) not]] whileTrue:[
+ next := next + 1
+ ].
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next := nil
+ ].
+ ^ next
+!
+
+previousBeforeSelection
+ "return the index of the previous selectable entry before the selection.
+ Wrap at beginning."
+
+ |prev|
+
+ selection isNil ifTrue:[
+ prev := firstLineShown - 1
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ prev := selection min - 1
+ ] ifFalse:[
+ prev := selection - 1
+ ].
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev < 1 ifTrue:[
+ prev := self size.
+ ] ifFalse:[
+ [prev >= 1
+ and:[(self isValidSelection:prev) not]] whileTrue:[
+ prev := prev - 1
+ ].
+ ].
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev := nil
+ ].
+ ^ prev
+
+!
+
+selectAll
+ "select all entries."
+
+ |oldSelection|
+
+ multipleSelectOk ifTrue:[
+ oldSelection := selection.
+ selection := OrderedCollection withAll:(1 to:self size).
+ shown ifTrue:[self redraw].
+ self selectionChangedFrom:oldSelection.
+ ]
+!
+
+toggleSelection:aNumber
+ "toggle selection-state of entry, aNumber"
+
+ (self isInSelection:aNumber) ifTrue:[
+ self removeFromSelection:aNumber
+ ] ifFalse:[
+ self addToSelection:aNumber
+ ]
+!
+
+selectNext
+ "select next line or first visible if there is currrently no selection.
+ Wrap at end."
+
+ self selection:(self nextAfterSelection)
+!
+
+selectPrevious
+ "select previous line or previous visible if there is currently no selection.
+ Wrap at beginning."
+
+ self selection:(self previouseBeforeSelection).
+!
+
+selectionDo:aBlock
+ "perform aBlock for each nr in the selection.
+ For single selection, it is called once for the items nr.
+ For multiple selections, it is called for each."
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ selection do:aBlock
+ ] ifFalse:[
+ aBlock value:selection
+ ].
+ ].
+
+!
+
+selectionAsCollection
+ "return the selection as a collection of line numbers.
+ This allows users of this class to enumerate independent of
+ the multipleSelect style."
+
+ selection isNil ifTrue:[^ #()].
+
+ multipleSelectOk ifTrue:[
+ ^ (OrderedCollection new) add:selection; yourself.
+ ].
+ ^ selection
+! !
+
!SelectionInListView methodsFor:'redrawing'!
-redrawElement:aNumber
- "redraw an individual element"
-
- ^ self redrawLine:aNumber
-!
-
redrawVisibleLine:visLineNr
"redraw a single line.
Must check, if any is in the selection and handle this case.
@@ -626,43 +1063,52 @@
(self isInSelection:listLine) ifTrue:[
^ self drawVisibleLineSelected:visLineNr
].
- (self line:listLine hasAttribute:#halfIntensity) ifTrue:[
- fg := halfIntensityFgColor
- ] ifFalse:[
- (self line:listLine hasAttribute:#disabled) ifTrue:[
+
+ listAttributes notNil ifTrue:[
+ (self line:listLine hasAttribute:#halfIntensity) ifTrue:[
fg := halfIntensityFgColor
+ ] ifFalse:[
+ (self line:listLine hasAttribute:#disabled) ifTrue:[
+ fg := halfIntensityFgColor
+ ].
].
- ].
- (self line:listLine hasAttribute:#bold) ifTrue:[
- font bold ifTrue:[
- "
- mhmh - what can be done, if the font is already bold ?
- "
- newFont := font.
- fgColor brightness > 0.5 ifTrue:[
- fg := fgColor darkened "darkened".
+ (self line:listLine hasAttribute:#bold) ifTrue:[
+ font bold ifTrue:[
+ "
+ mhmh - what can be done, if the font is already bold ?
+ "
+ newFont := font.
+ fgColor brightness > 0.5 ifTrue:[
+ fg := fgColor darkened "darkened".
+ ] ifFalse:[
+ fg := fgColor lightened "lightened"
+ ].
+ (fg brightness - bg brightness) abs < 0.25 ifTrue:[
+ bgColor brightness > 0.5 ifTrue:[
+ fg := fg darkened.
+ ] ifFalse:[
+ fg := fg lightened
+ ].
+ ]
] ifFalse:[
- fg := fgColor lightened "lightened"
+ newFont := font asBold
].
- (fg brightness - bg brightness) abs < 0.25 ifTrue:[
- bgColor brightness > 0.5 ifTrue:[
- fg := fg darkened.
- ] ifFalse:[
- fg := fg lightened
- ].
- ]
- ] ifFalse:[
- newFont := font asBold
- ].
- device setFont:(newFont on:device) fontId in:gcId.
- self drawVisibleLine:visLineNr with:fg and:bg.
- device setFont:(font on:device) fontId in:gcId.
- ^ self
+ device setFont:(newFont on:device) fontId in:gcId.
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ device setFont:(font on:device) fontId in:gcId.
+ ^ self
+ ]
]
].
^ self drawVisibleLine:visLineNr with:fg and:bg
!
+redrawElement:aNumber
+ "redraw an individual element"
+
+ ^ self redrawLine:aNumber
+!
+
drawVisibleLineSelected:visLineNr
"redraw a single line as selected."
@@ -779,6 +1225,16 @@
]
!
+redrawVisibleLine:visLineNr from:startCol to:endCol
+ "redraw from a startCol to endCol.
+ Must check, if its in the selection and handle this case."
+
+ (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
+ ^ self redrawVisibleLine:visLineNr
+ ].
+ super redrawVisibleLine:visLineNr from:startCol to:endCol
+!
+
drawRightArrowInVisibleLine:visLineNr
"draw a right arrow (for submenus).
This method is not used here, but provided for subclasses such
@@ -840,16 +1296,6 @@
super redrawVisibleLine:visLineNr col:colNr
!
-redrawVisibleLine:visLineNr from:startCol to:endCol
- "redraw from a startCol to endCol.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr from:startCol to:endCol
-!
-
redrawVisibleLine:visLineNr from:startCol
"redraw from a col to the right end.
Must check, if its in the selection and handle this case."
@@ -860,883 +1306,8 @@
super redrawVisibleLine:visLineNr from:startCol
! !
-!SelectionInListView methodsFor:'selections'!
-
-selectWithoutScroll:aNumberOrNil
- "select line, aNumber or deselect if argument is nil"
-
- |prevSelection newSelection|
-
- newSelection := aNumberOrNil.
- newSelection notNil ifTrue:[
- (self isValidSelection:newSelection) ifFalse:[
- newSelection := nil
- ]
- ].
-
- (newSelection == selection) ifTrue: [^ self].
-
- selection notNil ifTrue: [
- prevSelection := selection.
- selection := nil.
- (prevSelection isCollection) ifTrue:[
- prevSelection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:prevSelection
- ]
- ].
- selection := newSelection.
- (selection isCollection) ifTrue:[
- selection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:selection
- ]
-
-!
-
-selection:aNumberOrNil
- "select line, aNumber or deselect if argument is nil;
- scroll to make the selected line visible"
-
- self selectWithoutScroll:aNumberOrNil.
- selection notNil ifTrue:[self makeSelectionVisible]
-!
-
-makeSelectionVisible
- "scroll to make the selection line visible"
-
- |line|
-
- selection notNil ifTrue:[
- (selection isCollection) ifTrue:[
- line := selection first.
- ] ifFalse:[
- line := selection
- ].
- self makeLineVisible:line
- ]
-!
-
-isInSelection:aNumber
- "return true, if line, aNumber is in the selection"
-
- selection isNil ifTrue:[^ false].
- selection isCollection ifTrue:[
- ^ (selection includes:aNumber)
- ].
- ^ (aNumber == selection)
-!
-
-toggleSelect:aBoolean
- "turn on/off toggle select"
-
- toggleSelect := aBoolean.
-!
-
-multipleSelectOk:aBoolean
- "allow/disallow multiple selections"
-
- multipleSelectOk := aBoolean.
- aBoolean ifTrue:[
- self enableButtonMotionEvents
- ] ifFalse:[
- self disableButtonMotionEvents
- ]
-!
-
-selectConditionBlock:aBlock
- "set the conditionBlock; this block is evaluated before a selection
- change is performed; the change will not be done, if the evaluation
- returns false. For example, this allows confirmation queries in
- the SystemBrowser"
-
- selectConditionBlock := aBlock
-!
-
-strikeOut:aBoolean
- "turn on/off strikeOut mode"
-
- strikeOut := aBoolean.
-!
-
-selection
- "return the selection line nr or collection of line numbers"
-
- ^ selection
-!
-
-ignoreReselect:aBoolean
- "set/clear the ignoreReselect flag -
- if set, a click on an already selected entry is ignored.
- Otherwise the notification is done, even if no
- change in the selection occurs.
- (for example, in browser to update a method)"
-
- ignoreReselect := aBoolean
-!
-
-enable
- "enable selections"
-
- enabled := true
-!
-
-disable
- "disable selections"
-
- enabled := false
-!
-
-selectionValue
- "return the selection value i.e. the text in the selected line.
- For multiple selections a collection containing the entries is returned."
-
- selection isNil ifTrue:[^ nil].
- (selection isCollection) ifTrue:[
- ^ selection collect:[:nr | self at:nr]
- ].
- ^ self at:selection
-
-!
-
-numberOfSelections
- "return the number of selected entries"
-
- |sz|
-
- selection isNil ifTrue:[^ 0].
- sz := selection size.
- sz > 0 ifTrue:[^ sz].
- ^ 1
-!
-
-hasSelection
- "return true, if the view has a selection"
-
- ^ selection notNil
-!
-
-deselectWithoutRedraw
- "deselect - no redraw"
-
- selection := nil
-!
-
-deselect
- "deselect"
-
- self selection:nil
-!
-
-selectElement:anObject
- "select the element with same printString as the argument, anObject.
- Scroll to make the new selection visible."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selection:lineNo]
- ]
-!
-
-valueIsInSelection:someString
- "return true, if someString is in the selection"
-
- |sel|
-
- selection isNil ifTrue:[^ false].
- sel := self selectionValue.
- self numberOfSelections > 1 ifTrue:[
- ^ (sel includes:someString)
- ].
- ^ (someString = sel)
-!
-
-selectElementWithoutScroll:anObject
- "select the element with same printString as the argument, anObject.
- Do not scroll."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
- ]
-!
-
-selectAll
- "select all entries."
-
- |oldSelection|
-
- oldSelection := selection.
- selection := OrderedCollection withAll:(1 to:self size).
- shown ifTrue:[self redraw].
- self selectionChangedFrom:oldSelection.
-!
-
-addElementToSelection:anObject
- "add the element with the same printstring as the argument, anObject
- to the selection. The entry is searched by comparing printStrings.
- No scrolling is done. Returns true, if ok, false if no such entry
- was found."
-
- |lineNo str|
-
- str := anObject printString.
- lineNo := list findFirst:[:entry | str = entry printString].
- lineNo ~~ 0 ifTrue:[
- self addToSelection:lineNo.
- ^ true
- ].
- ^ false
-!
-
-addToSelection:aNumber
- "add entry, aNumber to the selection. No scrolling is done."
-
- (self isValidSelection:aNumber) ifFalse:[^ self].
-
- selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifTrue:[^ self].
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
- selection add:aNumber
- ] ifFalse:[
- (aNumber == selection) ifTrue:[^ self].
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
- selection := OrderedCollection with:selection with:aNumber
- ].
- self redrawElement:aNumber
-!
-
-removeFromSelection:aNumber
- "remove entry, aNumber from the selection."
-
- selection isNil ifTrue:[^ self].
-
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifFalse:[^ self].
- selection remove:aNumber.
- selection size == 1 ifTrue:[
- selection := selection first
- ] ifFalse:[
- selection size == 0 ifTrue:[
- selection := nil
- ]
- ]
- ] ifFalse:[
- (aNumber == selection) ifFalse:[^ self].
- selection := nil
- ].
- self redrawElement:aNumber
-!
-
-nextAfterSelection
- "return the number of the next selectable entry after the selection.
- Wrap at end."
-
- |next|
-
- selection isNil ifTrue:[
- next := firstLineShown
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- next := selection max + 1
- ] ifFalse:[
- next := selection + 1
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next > self size ifTrue:[
- next := 1.
- ] ifFalse:[
- [next <= self size
- and:[(self isValidSelection:next) not]] whileTrue:[
- next := next + 1
- ].
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next := nil
- ].
- ^ next
-!
-
-previousBeforeSelection
- "return the number of the previous selectable entry before the selection.
- Wrap at beginning."
-
- |prev|
-
- selection isNil ifTrue:[
- prev := firstLineShown - 1
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- prev := selection min - 1
- ] ifFalse:[
- prev := selection - 1
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev < 1 ifTrue:[
- prev := self size.
- ] ifFalse:[
- [prev >= 1
- and:[(self isValidSelection:prev) not]] whileTrue:[
- prev := prev - 1
- ].
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev := nil
- ].
- ^ prev
-
-!
-
-toggleSelection:aNumber
- "toggle selection-state of entry, aNumber"
-
- (self isInSelection:aNumber) ifTrue:[
- self removeFromSelection:aNumber
- ] ifFalse:[
- self addToSelection:aNumber
- ]
-!
-
-selectNext
- "select next line or first visible if there is currrently no selection.
- Wrap at end."
-
- self selection:(self nextAfterSelection)
-!
-
-selectPrevious
- "select previous line or previous visible if there is currently no selection.
- Wrap at beginning."
-
- self selection:(self previouseBeforeSelection).
-!
-
-selectionDo:aBlock
- "perform aBlock for each nr in the selection.
- For single selection, it is called once for the items nr.
- For multiple selections, it is called for each."
-
- |sz|
-
- selection isNil ifTrue:[^ self].
- sz := selection size.
- sz > 0 ifTrue:[
- selection do:aBlock
- ] ifFalse:[
- aBlock value:selection
- ].
-!
-
-argForChangeMessage
- "return the argument for a selectionChange;
- depending on the setting of useIndex, this is either the numeric
- index of the selection or the value (i.e. the string)"
-
- useIndex == false ifTrue:[
- printItems ifFalse:[
- ^ self selectionValue
- ].
- ^ items at:selection
- ].
- "true or nil - strange"
- ^ selection.
-!
-
-selectionChangedFrom:oldSelection
- "selection has changed. Call actionblock and/or send changeMessage if defined"
-
- |arg|
-
- arg := self argForChangeMessage.
- "
- the ST/X way of doing things - perform actionBlock
- "
- actionBlock notNil ifTrue:[actionBlock value:arg].
- "
- the ST-80 way of doing things - notify model via changeMsg
- "
- "/ ST80 sends 0 as index, if the same selection is reselected ...
- selection == oldSelection ifTrue:[
- arg := 0
- ].
- self sendChangeMessageWith:arg
-!
-
-selectionAsCollection
- "return the selection as a collection of line numbers"
-
- selection size = 0 ifTrue:[
- selection isNil ifTrue:[^ #()].
- ^ (OrderedCollection new) add:selection; yourself.
- ] ifFalse:[
- ^ selection
- ].
-! !
-
-!SelectionInListView methodsFor:'accessing'!
-
-line:lineNr hasAttribute:aSymbol
- "return true, if line nr has attribute, aSymbol;
- currently supported attributes are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |attr|
-
- (lineNr > listAttributes size) ifTrue:[^ false].
- attr := listAttributes at:lineNr.
- attr isNil ifTrue:[^ false].
- attr isSymbol ifTrue:[^ attr == aSymbol].
- ^ (attr includes:aSymbol)
-!
-
-contents:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- selection := nil.
- listAttributes := nil.
- super contents:aCollection.
-!
-
-attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
- "set a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- (index > self size) ifFalse:[
- listAttributes isNil ifTrue:[
- listAttributes := (OrderedCollection new:index) grow:index
- ] ifFalse:[
- (index > listAttributes size) ifTrue:[
- listAttributes grow:index
- ]
- ].
- aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
- listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
- self redrawLine:index
- ]
- ]
-
-!
-
-setList:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- selection := nil.
- listAttributes := nil.
- super setList:aCollection.
-!
-
-list:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- "somewhat of a kludge: if selection is first line,
- we have to remove the highlight frame by hand here"
-
- (shown and:[hilightLevel ~~ 0]) ifTrue:[
- selection == firstLineShown ifTrue:[
- self paint:bgColor.
- self fillRectangleX:margin y:margin
- width:(width - (margin * 2))
- height:(hilightLevel abs).
- ].
- ].
-
- selection := nil.
- listAttributes := nil.
- super list:aCollection.
-!
-
-setAttributes:aList
- "set the attribute list.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- listAttributes := aList
-!
-
-keyActionStyle:aSymbol
- "defines how the view should respond to alpha-keys pressed.
- Possible values are:
- #select -> will select next entry starting with that
- character and perform the click-action
-
- #selectAndDoubleclick -> will select next & perform double-click action
-
- #pass -> will pass key to superclass (i.e. no special treatment)
-
- nil -> will ignore key
-
- the default (set in #initialize) is #select
- "
-
- keyActionStyle := aSymbol
-!
-
-attributeAt:index
- "return the line attribute of list line index.
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- listAttributes isNil ifFalse:[
- (index > listAttributes size) ifFalse:[
- ^ listAttributes at:index
- ]
- ].
- ^ nil
-!
-
-action:aBlock
- "set the action block to be performed on select"
-
- actionBlock := aBlock
-!
-
-attributeAt:index add:aSymbolOrCollectionOfSymbols
- "add to a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[
- current := Set new.
- ] ifFalse:[
- current isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
- current := Set with:current
- ]
- ].
-
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current add:aSymbolOrCollectionOfSymbols
- ] ifFalse:[
- (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
- current addAll:aSymbolOrCollectionOfSymbols
- ].
- self attributeAt:index put:current
-!
-
-doubleClickAction:aBlock
- "set the double click action block to be performed on select"
-
- doubleClickActionBlock := aBlock
-!
-
-attributeAt:index remove:aSymbolOrCollectionOfSymbols
- "remove a line attribute;
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[^ self].
- current isSymbol ifTrue:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
- ] ifFalse:[
- (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
- current := nil
- ]
- ]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
- ]
- ].
- self attributeAt:index put:current
-!
-
-removeIndexWithoutRedraw:lineNr
- "delete line - no redraw;
- return true, if something was really deleted.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndexWithoutRedraw:lineNr
-!
-
-removeIndex:lineNr
- "delete line - with redraw.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndex:lineNr
-!
-
-add:aValue beforeIndex:index
- "must recompute our current selections"
-
- selection notNil ifTrue:[
- selection size = 0 ifTrue:[
- selection >= index ifTrue:[
- selection := selection + 1.
- ].
- ] ifFalse:[
- selection := selection collect:[ :sel |
- sel >= index ifTrue:[
- sel + 1
- ] ifFalse:[
- sel
- ]
- ].
- ].
- ].
- ^ super add:aValue beforeIndex:index.
-!
-
-useIndex:aBoolean
- "set/clear the useIndex flag. If set, both actionBlock and change-messages
- are passed the index of the selection as argument. If clear, the value
- (i.e. the selected string) is passed.
- Default is true."
-
- useIndex := aBoolean
-! !
-
-!SelectionInListView methodsFor:'accessing-mvc'!
-
-on:aModel printItems:print oneItem:one aspect:aspectSymbol change:changeSymbol
- list:listSymbol menu:menuSymbol initialSelection:initialSymbol useIndex:use
-
- "ST-80 compatibility"
-
- aspectMsg := aspectSymbol.
- changeMsg := changeSymbol.
- listMsg := listSymbol.
- menuMsg := menuSymbol.
- initialSelectionMsg := initialSymbol.
- printItems := print.
- oneItem := one.
- useIndex := use.
- ignoreReselect := false. "/ ST80 behavior
- self model:aModel.
-!
-
-doubleClickMessage
- "return the symbol with which the model (if any) is informed about
- double-click. If nil (which is the default), it is not informed."
-
- ^ doubleClickMsg
-!
-
-doubleClickMessage:aSymbol
- "set the symbol with which the model (if any) is informed about double-click.
- If nil (which is the default), it is not informed."
-
- doubleClickMsg := aSymbol
-!
-
-doubleClick:aSymbol
- "set the symbol with which the model is informed about double-click.
- OBSOLETE: please use #doubleClickMessage:"
-
- self obsoleteMethodWarning:'please use #doubleClickMessage:'.
- doubleClickMsg := aSymbol
-!
-
-selectionMessage
- "return the symbol by which the model informes me about a changed
- selectionIndex. This is used both in change notification and to
- actually aquire a new selection value."
-
- ^ initialSelectionMsg
-!
-
-selectionMessage:aSymbol
- "set the symbol by which the model informes me about a changed
- selectionIndex. This is used both in change notification and to
- actually aquire a new selection value."
-
- initialSelectionMsg := aSymbol
-!
-
-addModelInterfaceTo:aDictionary
- "see comment in View>>modelInterface"
-
- super addModelInterfaceTo:aDictionary.
- aDictionary at:#doubleClickMessage put:doubleClickMsg.
- aDictionary at:#selectionMessage put:initialSelectionMsg.
-
- "
- SelectionInListView new modelInterface
- "
-! !
-
!SelectionInListView methodsFor:'private'!
-isValidSelection:aNumber
- "return true, if aNumber is ok for a selection lineNo"
-
- aNumber isNil ifTrue:[^ false].
- (aNumber isCollection) ifTrue:[
- (multipleSelectOk or:[aNumber size = 1]) ifFalse:[^ false].
- aNumber do:[ :line |
- (line between:1 and:self size) ifFalse:[^ false].
- ].
- ^ true.
- ] ifFalse:[
- ^ (aNumber between:1 and:self size).
- ].
-
-!
-
-widthForScrollBetween:start and:end
- "has to be redefined since WHOLE line is inverted/modified sometimes"
-
- | anySelectionInRange |
-
- selection notNil ifTrue:[
- selection isCollection ifTrue:[
- anySelectionInRange := false.
- selection do:[:s |
- (s between:start and:end) ifTrue:[
- anySelectionInRange := true
- ]
- ]
- ] ifFalse:[
- anySelectionInRange := selection between:start and:end
- ]
- ] ifFalse:[
- anySelectionInRange := false
- ].
-
- anySelectionInRange ifTrue:[
- ^ width
-"
- self is3D ifFalse:[
- ^ width
- ].
- ( #(next openwin) includes:style) ifTrue:[
- ^ width
- ].
- viewBackground = background ifFalse:[
- ^ width
- ]
-"
- ].
- ^ super widthForScrollBetween:start and:end
-!
-
-positionToSelectionX:x y:y
- "given a click position, return the selection lineNo"
-
- |visibleLine|
-
- (x between:0 and:width) ifTrue:[
- (y between:0 and:height) ifTrue:[
- visibleLine := self visibleLineOfY:y.
- ^ self visibleLineToListLine:visibleLine
- ]
- ].
- ^ nil
-!
-
-visibleLineNeedsSpecialCare:visLineNr
- |listLine|
-
- listLine := self visibleLineToListLine:visLineNr.
- listLine isNil ifTrue:[^ false].
- (self isInSelection:listLine) ifTrue:[^ true].
- listAttributes notNil ifTrue:[
- (listLine <= listAttributes size) ifTrue:[
- ^ (listAttributes at:listLine) notNil
- ]
- ].
- ^ false
-!
-
-checkRemovingSelection:lineNr
- "when a line is removed, we have to adjust selection"
-
- |newSelection|
-
- selection notNil ifTrue:[
- (selection size > 0) ifTrue:[
- newSelection := OrderedCollection new.
- selection do:[:sel |
- sel < lineNr ifTrue:[
- newSelection add:sel
- ] ifFalse:[
- sel > lineNr ifTrue:[
- newSelection add:(sel - 1)
- ]
- "otherwise remove it from the selection"
- ]
- ].
- newSelection size == 1 ifTrue:[
- selection := newSelection first
- ] ifFalse:[
- newSelection size == 0 ifTrue:[
- selection := nil
- ] ifFalse:[
- selection := newSelection
- ]
- ]
- ] ifFalse:[
- selection == lineNr ifTrue:[
- selection := nil
- ] ifFalse:[
- selection > lineNr ifTrue:[
- selection := selection - 1
- ]
- ]
- ]
- ]
-!
-
-scrollSelectDown
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollDown.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-scrollSelectUp
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollUp.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
getListFromModel
"if I have a model and a listMsg, get my list from it"
@@ -1775,6 +1346,795 @@
].
]
].
+!
+
+argForChangeMessage
+ "return the argument for a selectionChange;
+ depending on the setting of useIndex, this is either the numeric
+ index of the selection or the value (i.e. the string)"
+
+ useIndex ~~ false ifTrue:[ "/ i.e. everything except false
+ ^ selection
+ ].
+
+ printItems ifFalse:[
+ ^ self selectionValue
+ ].
+
+ items notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ ^ selection collect:[:nr | items at:nr]
+ ].
+ ^ items at:selection
+ ].
+
+ ^ nil "/ cannot happen
+!
+
+isValidSelection:aNumberOrCollection
+ "return true, if aNumber is ok as a selection index"
+
+ aNumberOrCollection isNil ifTrue:[^ false].
+
+ (aNumberOrCollection isCollection) ifTrue:[
+ multipleSelectOk ifFalse:[^ false].
+ aNumberOrCollection do:[:index |
+ (index between:1 and:self size) ifFalse:[^ false].
+ ].
+ ^ true.
+ ] ifFalse:[
+ ^ (aNumberOrCollection between:1 and:self size).
+ ].
+
+!
+
+positionToSelectionX:x y:y
+ "given a click position, return the selection lineNo"
+
+ |visibleLine|
+
+ (x between:0 and:width) ifTrue:[
+ (y between:0 and:height) ifTrue:[
+ visibleLine := self visibleLineOfY:y.
+ ^ self visibleLineToListLine:visibleLine
+ ]
+ ].
+ ^ nil
+!
+
+widthForScrollBetween:start and:end
+ "has to be redefined since WHOLE line is inverted/modified sometimes"
+
+ | anySelectionInRange |
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ anySelectionInRange := false.
+ selection do:[:s |
+ (s between:start and:end) ifTrue:[
+ anySelectionInRange := true
+ ]
+ ]
+ ] ifFalse:[
+ anySelectionInRange := selection between:start and:end
+ ]
+ ] ifFalse:[
+ anySelectionInRange := false
+ ].
+
+ anySelectionInRange ifTrue:[
+ ^ width
+"
+ self is3D ifFalse:[
+ ^ width
+ ].
+ ( #(next openwin) includes:style) ifTrue:[
+ ^ width
+ ].
+ viewBackground = background ifFalse:[
+ ^ width
+ ]
+"
+ ].
+ ^ super widthForScrollBetween:start and:end
+!
+
+visibleLineNeedsSpecialCare:visLineNr
+ |listLine|
+
+ listLine := self visibleLineToListLine:visLineNr.
+ listLine isNil ifTrue:[^ false].
+ (self isInSelection:listLine) ifTrue:[^ true].
+ listAttributes notNil ifTrue:[
+ (listLine <= listAttributes size) ifTrue:[
+ ^ (listAttributes at:listLine) notNil
+ ]
+ ].
+ ^ false
+!
+
+checkRemovingSelection:lineNr
+ "when a line is removed, we have to adjust selection"
+
+ |newSelection|
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ newSelection := OrderedCollection new.
+ selection do:[:sel |
+ sel < lineNr ifTrue:[
+ newSelection add:sel
+ ] ifFalse:[
+ sel > lineNr ifTrue:[
+ newSelection add:(sel - 1)
+ ]
+ "otherwise remove it from the selection"
+ ]
+ ].
+ newSelection size == 0 ifTrue:[
+ selection := nil
+ ] ifFalse:[
+ selection := newSelection
+ ]
+ ] ifFalse:[
+ selection == lineNr ifTrue:[
+ selection := nil
+ ] ifFalse:[
+ selection > lineNr ifTrue:[
+ selection := selection - 1
+ ]
+ ]
+ ]
+ ]
+!
+
+scrollSelectDown
+ "auto scroll action; scroll and reinstall timed-block"
+
+ self scrollDown.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+scrollSelectUp
+ "auto scroll action; scroll and reinstall timed-block"
+
+ self scrollUp.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+! !
+
+!SelectionInListView methodsFor:'event handling'!
+
+buttonRelease:button x:x y:y
+ "stop any autoscroll"
+
+ self stopAutoScroll
+!
+
+buttonPress:button x:x y:y
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ enabled ifTrue:[
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (toggleSelect
+ and:[self isInSelection:listLineNr]) ifTrue:[
+ oldSelection := selection copy.
+ self removeFromSelection:listLineNr
+ ] ifFalse:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+
+ (toggleSelect and:[multipleSelectOk]) ifTrue:[
+ oldSelection := selection copy.
+ self addToSelection:listLineNr
+ ] ifFalse:[
+ oldSelection := selection copy.
+ self selectWithoutScroll:listLineNr.
+ ].
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ self selectionChangedFrom:oldSelection.
+ ].
+ clickLine := listLineNr
+ ].
+ ]
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+!
+
+sizeChanged:how
+ "if there is a selection, make certain, its visible
+ after the sizechange"
+
+ |first wasAtEnd|
+
+ wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
+
+ super sizeChanged:how.
+
+ shown ifTrue:[
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ first := selection first
+ ] ifFalse:[
+ first := selection
+ ].
+ first notNil ifTrue:[self makeLineVisible:first]
+ ] ifFalse:[
+ "
+ if we where at the end before, move to the end again.
+ Still to be seen, if this is better in real life ...
+ "
+ wasAtEnd ifTrue:[
+ "at end"
+ self scrollToBottom
+ ]
+ ]
+ ]
+!
+
+keyPress:key x:x y:y
+ "handle keyboard input"
+
+ |index startSearch backSearch searchPrefix|
+
+ (key == #CursorUp) ifTrue:[
+ 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
+ ].
+ "/
+ "/ stupid: Home and End are cought in ScrollableView
+ "/ we normally do not get them ...
+ "/ (need to call handlesKey: from there ...
+ "/ ... and implement it here)
+ "/
+ (key == #Home) ifTrue:[
+ 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
+ ].
+ key == #Return ifTrue:[
+ returnKeyActionStyle == #doubleClick ifTrue:[
+ selection notNil ifTrue:[
+ self doubleClicked
+ ].
+ ^ self
+ ].
+ returnKeyActionStyle ~~ #pass ifTrue:[
+ ^ self
+ ].
+ ].
+
+ "
+ alphabetic keys: search for next entry
+ starting with keys character. If shift is pressed, search backward
+ "
+ (self size > 0
+ and:[key isCharacter
+ and:[key isLetter]]) ifTrue:[
+ keyActionStyle isNil ifTrue:[^ self].
+ keyActionStyle == #pass ifFalse:[
+ searchPrefix := key asLowercase asString.
+
+"/ ... isISearch... ifFalse:[
+"/ iSearchString := ''
+"/ ] ifTrue:[
+"/ iSearchString := iSearchString , searchPrefix.
+"/ 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
+ ]
+ ]
+ ].
+ ].
+ ^ super keyPress:key x:x y:y
+!
+
+buttonMotion:buttonMask x:x y:y
+ "mouse-move while button was pressed - handle selection changes"
+
+ |movedVisibleLine movedLine delta oldSelection oldSelCount|
+
+ "is it the select or 1-button ?"
+ (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
+ (device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
+ ^ self
+ ].
+ ].
+
+ clickLine isNil ifTrue:[^ self].
+
+ "if moved outside of view, start autoscroll"
+ (y < 0) ifTrue:[
+ self compressMotionEvents:false.
+ self startAutoScrollUp:y.
+ ^ self
+ ].
+ (y > height) ifTrue:[
+ self compressMotionEvents:false.
+ self startAutoScrollDown:(y - height).
+ ^ self
+ ].
+
+ "move inside - stop autoscroll if any"
+ self stopAutoScroll.
+
+ movedVisibleLine := self visibleLineOfY:y.
+ movedLine := self visibleLineToAbsoluteLine:movedVisibleLine.
+ (movedLine == clickLine) ifTrue:[^ self].
+
+ multipleSelectOk ifTrue:[
+ delta := (clickLine < movedLine) ifTrue:[1] ifFalse:[-1].
+
+ oldSelection := selection.
+ oldSelCount := selection size.
+
+ (clickLine+delta) to:movedLine by:delta do:[:line |
+ (self isInSelection:line) ifTrue:[
+ self removeFromSelection:line
+ ] ifFalse:[
+ self addToSelection:line
+ ]
+ ].
+ ((selection ~= oldSelection)
+ or:[selection size ~~ oldSelCount]) ifTrue:[
+ self selectionChangedFrom:oldSelection.
+ ]
+ ] ifFalse:[
+"/ self selectWithoutScroll:movedLine
+ ].
+
+ clickLine := movedLine
+!
+
+key:key select:index x:x y:y
+ "select an entry by a keyboard action.
+ This is treated like a doubleClick on that entry"
+
+ |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
+ ]
+ ]
+ ].
+!
+
+buttonMultiPress:button x:x y:y
+ ((button == 1) or:[button == #select]) ifTrue:[
+"/ doubleClickActionBlock isNil ifTrue:[
+"/ self buttonPress:button x:x y:y
+"/ ].
+ self doubleClicked.
+ ] ifFalse:[
+ super buttonMultiPress:button x:x y:y
+ ]
+!
+
+buttonShiftPress:button x:x y:y
+ "add to the selection (if multipleSelectOk); otherwise,
+ behave like normal select"
+
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ toggleSelect ifTrue:[
+ ^ self buttonPress:button x:x y:y
+ ].
+ enabled ifTrue:[
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+ ].
+ oldSelection := selection copy.
+ listLineNr notNil ifTrue: [
+ multipleSelectOk ifTrue:[
+ (self isInSelection:listLineNr) ifTrue:[
+ self removeFromSelection:listLineNr
+ ] ifFalse:[
+ self addToSelection:listLineNr
+ ]
+ ] ifFalse:[
+ self selectWithoutScroll:listLineNr
+ ]
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ self selectionChangedFrom:oldSelection.
+ ].
+ clickLine := listLineNr
+ ]
+ ] ifFalse:[
+ super buttonShiftPress:button x:x y:y
+ ]
+!
+
+doubleClicked
+ doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
+ (model notNil and:[doubleClickMsg notNil]) ifTrue:[
+ self sendChangeMessage:doubleClickMsg with:(self argForChangeMessage).
+ ].
+! !
+
+!SelectionInListView methodsFor:'accessing-actions'!
+
+action:aBlock
+ "set the action block to be performed on select"
+
+ actionBlock := aBlock
+!
+
+doubleClickAction:aBlock
+ "set the double click action block to be performed on select"
+
+ doubleClickActionBlock := aBlock
+!
+
+selectConditionBlock:aBlock
+ "set the conditionBlock; this block is evaluated before a selection
+ change is performed; the change will not be done, if the evaluation
+ returns false. For example, this allows confirmation queries in
+ the SystemBrowser"
+
+ selectConditionBlock := aBlock
+!
+
+useIndex:aBoolean
+ "set/clear the useIndex flag. If set, both actionBlock and change-messages
+ are passed the index(indices) of the selection as argument.
+ If clear, the value(s) (i.e. the selected string) is passed.
+ Default is true."
+
+ useIndex := aBoolean
+!
+
+keyActionStyle:aSymbol
+ "defines how the view should respond to alpha-keys pressed.
+ Possible values are:
+ #select -> will select next entry starting with that
+ character and perform the click-action
+
+ #selectAndDoubleclick -> will select next & perform double-click action
+
+ #pass -> will pass key to superclass (i.e. no special treatment)
+
+ nil -> will ignore key
+
+ the default (set in #initialize) is #select
+ "
+
+ keyActionStyle := aSymbol
+!
+
+returnKeyActionStyle:aSymbol
+ "defines how the view should respond to a return key pressed.
+ Possible values are:
+ #doubleClick -> perform double-click action
+
+ #pass -> will pass key to superclass (i.e. no special treatment)
+
+ nil -> will ignore key
+
+ the default (set in #initialize) is #doubleClick
+ "
+
+ returnKeyActionStyle := aSymbol
+! !
+
+!SelectionInListView methodsFor:'accessing-attributes'!
+
+line:lineNr hasAttribute:aSymbol
+ "return true, if line nr has attribute, aSymbol;
+ currently supported attributes are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |attr|
+
+ listAttributes isNil ifTrue:[^ false].
+ (lineNr > listAttributes size) ifTrue:[^ false].
+ attr := listAttributes at:lineNr.
+ attr isNil ifTrue:[^ false].
+ attr isSymbol ifTrue:[^ attr == aSymbol].
+ ^ (attr includes:aSymbol)
+!
+
+setAttributes:aList
+ "set the attribute list.
+ No redraw is done - the caller should make sure to redraw afterwards
+ (or use this only before the view is visible)."
+
+ listAttributes := aList
+!
+
+attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
+ "set a lines attribute(s);
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ (index > self size) ifFalse:[
+ listAttributes isNil ifTrue:[
+ listAttributes := (OrderedCollection new:index) grow:index
+ ] ifFalse:[
+ (index > listAttributes size) ifTrue:[
+ listAttributes grow:index
+ ]
+ ].
+ aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
+ listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
+ self redrawLine:index
+ ]
+ ]
+
+!
+
+strikeOut:aBoolean
+ "turn on/off strikeOut mode"
+
+ strikeOut := aBoolean.
+!
+
+attributeAt:index
+ "return the line attribute of list line index.
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ listAttributes isNil ifFalse:[
+ (index > listAttributes size) ifFalse:[
+ ^ listAttributes at:index
+ ]
+ ].
+ ^ nil
+!
+
+attributeAt:index add:aSymbolOrCollectionOfSymbols
+ "add to a lines attribute(s);
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |current|
+
+ current := self attributeAt:index.
+ current isNil ifTrue:[
+ current := Set new.
+ ] ifFalse:[
+ current isSymbol ifTrue:[
+ current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
+ current := Set with:current
+ ]
+ ].
+
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current := current add:aSymbolOrCollectionOfSymbols
+ ] ifFalse:[
+ (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
+ current addAll:aSymbolOrCollectionOfSymbols
+ ].
+ self attributeAt:index put:current
+!
+
+attributeAt:index remove:aSymbolOrCollectionOfSymbols
+ "remove a line attribute;
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |current|
+
+ current := self attributeAt:index.
+ current isNil ifTrue:[^ self].
+ current isSymbol ifTrue:[
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
+ ] ifFalse:[
+ (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
+ current := nil
+ ]
+ ]
+ ] ifFalse:[
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
+ ] ifFalse:[
+ aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
+ ]
+ ].
+ self attributeAt:index put:current
+! !
+
+!SelectionInListView methodsFor:'accessing-behavior'!
+
+ignoreReselect:aBoolean
+ "set/clear the ignoreReselect flag -
+ if set, a click on an already selected entry is ignored.
+ Otherwise the notification is done, even if no
+ change in the selection occurs.
+ (for example, in browser to update a method)"
+
+ ignoreReselect := aBoolean
+!
+
+toggleSelect:aBoolean
+ "turn on/off toggle select. If true, clicking on a selected entry
+ unselects it and vice versa. The default is false."
+
+ toggleSelect := aBoolean.
+!
+
+multipleSelectOk:aBoolean
+ "allow/disallow multiple selections"
+
+ multipleSelectOk := aBoolean.
+ aBoolean ifTrue:[
+ self enableButtonMotionEvents
+ ] ifFalse:[
+ self disableButtonMotionEvents
+ ]
+!
+
+enable
+ "enable the view - selection changes are allowed"
+
+ enabled := true
+!
+
+disable
+ "disable the view - no selection changes are allowed"
+
+ enabled := false
+! !
+
+!SelectionInListView methodsFor:'accessing-contents'!
+
+list:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes."
+
+ "somewhat of a kludge: if selection is first line,
+ we have to remove the highlight frame by hand here"
+
+ (shown and:[hilightLevel ~~ 0]) ifTrue:[
+ selection == firstLineShown ifTrue:[
+ self paint:bgColor.
+ self fillRectangleX:margin y:margin
+ width:(width - (margin * 2))
+ height:(hilightLevel abs).
+ ].
+ ].
+
+ selection := nil.
+ listAttributes := nil.
+ super list:aCollection.
+!
+
+setList:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes.
+ No redraw is done - the caller should make sure to redraw afterwards
+ (or use this only before the view is visible)."
+
+ selection := nil.
+ listAttributes := nil.
+ super setList:aCollection.
+!
+
+removeIndexWithoutRedraw:lineNr
+ "delete line - no redraw;
+ return true, if something was really deleted.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndexWithoutRedraw:lineNr
+!
+
+removeIndex:lineNr
+ "delete line - with redraw.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndex:lineNr
+!
+
+add:aValue beforeIndex:index
+ "must recompute our current selections"
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ selection := selection collect:[ :sel |
+ sel >= index ifTrue:[
+ sel + 1
+ ] ifFalse:[
+ sel
+ ]
+ ].
+ ] ifFalse:[
+ selection >= index ifTrue:[
+ selection := selection + 1.
+ ].
+ ].
+ ].
+ ^ super add:aValue beforeIndex:index.
! !
!SelectionInListView methodsFor:'initialization'!
@@ -1785,26 +2145,32 @@
cursor := Cursor hand
!
-realize
- super realize.
-
- selection notNil ifTrue:[
- self makeLineVisible:selection
- ].
- self getListFromModel.
- self getSelectionFromModel
-!
-
initialize
super initialize.
fontHeight := font height + lineSpacing.
enabled := true.
- multipleSelectOk := false.
ignoreReselect := true.
- toggleSelect := false.
- strikeOut := false.
+ multipleSelectOk := toggleSelect := strikeOut := printItems := false.
+ useIndex := true.
+
keyActionStyle := #select.
+ returnKeyActionStyle := #doubleClick.
+
+ listMsg := self class defaultListMessage.
+ initialSelectionMsg := self class defaultSelectionMessage.
+
+!
+
+realize
+ super realize.
+
+ self getListFromModel.
+ self getSelectionFromModel.
+
+ selection notNil ifTrue:[
+ self makeLineVisible:selection
+ ].
!
initStyle
@@ -1908,338 +2274,154 @@
hilightBgColor := hilightBgColor on:device.
! !
-!SelectionInListView methodsFor:'event handling'!
-
-buttonPress:button x:x y:y
- |oldSelection listLineNr|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- enabled ifTrue:[
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (toggleSelect
- and:[self isInSelection:listLineNr]) ifTrue:[
- oldSelection := selection copy.
- self removeFromSelection:listLineNr
- ] ifFalse:[
- (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
-
- (toggleSelect and:[multipleSelectOk]) ifTrue:[
- oldSelection := selection copy.
- self addToSelection:listLineNr
- ] ifFalse:[
- oldSelection := selection copy.
- self selectWithoutScroll:listLineNr.
- ].
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- self selectionChangedFrom:oldSelection.
- ].
- clickLine := listLineNr
- ].
- ]
- ] ifFalse:[
- super buttonPress:button x:x y:y
- ]
-!
-
-sizeChanged:how
- "if there is a selection, make certain, its visible
- after the sizechange"
-
- |first wasAtEnd|
-
- wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
-
- super sizeChanged:how.
-
- shown ifTrue:[
- selection notNil ifTrue:[
- selection isCollection ifTrue:[
- selection notEmpty ifTrue:[
- first := selection first
- ]
- ] ifFalse:[
- first := selection
- ].
- first notNil ifTrue:[self makeLineVisible:first]
- ] ifFalse:[
- "
- if we where at the end before, move to the end again.
- Still to be seen, if this is better in real life ...
- "
- wasAtEnd ifTrue:[
- "at end"
- self scrollToBottom
- ]
- ]
- ]
-!
-
-buttonRelease:button x:x y:y
- "stop any autoscroll"
-
- self stopAutoScroll
-!
-
-key:key select:selectAction x:x y:y
- "perform keyaction after a key-select"
-
- |oldSelection|
-
- keyActionStyle notNil ifTrue:[
- keyActionStyle == #pass ifTrue:[
- ^ super keyPress:key x:x y:y
- ].
- oldSelection := selection.
- selectAction value.
- self selectionChangedFrom:oldSelection.
- keyActionStyle == #selectAndDoubleClick ifTrue:[
- doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
- ]
- ].
-!
-
-keyPress:key x:x y:y
- "handle keyboard input"
-
- |index startSearch backSearch searchPrefix|
-
- (key == #CursorUp) ifTrue:[
- index := self previousBeforeSelection.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- (key == #CursorDown) ifTrue:[
- index := self nextAfterSelection.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- (key == #Home) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value:1]) ifTrue:[
- self key:key select:[self selection:1] x:x y:y
- ].
- ^ self
- ].
- (key == #End) ifTrue:[
- index := self size.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- key == #Return ifTrue:[
- selection notNil ifTrue:[
- doubleClickActionBlock notNil ifTrue:[
- doubleClickActionBlock value:selection
- ].
- ].
- ^ self
- ].
- "
- alphabetic keys: search for next entry
- starting with keys character. If shift is pressed, search backward
- "
- (self size > 0
- and:[key isCharacter
- and:[key isLetter]]) ifTrue:[
- keyActionStyle isNil ifTrue:[^ self].
- keyActionStyle == #pass ifFalse:[
- searchPrefix := key asLowercase asString.
-
-"/ ... isISearch... ifFalse:[
-"/ iSearchString := ''
-"/ ] ifTrue:[
-"/ iSearchString := iSearchString , searchPrefix.
-"/ 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:[self selection: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
-
-!
-
-buttonMultiPress:button x:x y:y
- ((button == 1) or:[button == #select]) ifTrue:[
- doubleClickActionBlock isNil ifTrue:[
- self buttonPress:button x:x y:y
- ] ifFalse:[
- doubleClickActionBlock value:selection
- ].
- (model notNil and:[doubleClickMsg notNil]) ifTrue:[
- self sendChangeMessage:doubleClickMsg with:(self argForChangeMessage).
- ]
- ] ifFalse:[
- super buttonMultiPress:button x:x y:y
- ]
-!
-
-buttonShiftPress:button x:x y:y
- "add to the selection (if multipleSelectOk); otherwise,
- behave like normal select"
-
- |oldSelection listLineNr|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- toggleSelect ifTrue:[
- ^ self buttonPress:button x:x y:y
- ].
- enabled ifTrue:[
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
- ].
- oldSelection := selection copy.
- listLineNr notNil ifTrue: [
- multipleSelectOk ifTrue:[
- (self isInSelection:listLineNr) ifTrue:[
- self removeFromSelection:listLineNr
- ] ifFalse:[
- self addToSelection:listLineNr
- ]
- ] ifFalse:[
- self selectWithoutScroll:listLineNr
- ]
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- self selectionChangedFrom:oldSelection.
- ].
- clickLine := listLineNr
- ]
- ] ifFalse:[
- super buttonShiftPress:button x:x y:y
- ]
-!
+!SelectionInListView methodsFor:'change & update'!
update:something with:aParameter from:changedObject
changedObject == model ifTrue:[
- something == aspectMsg 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
-!
-
-buttonMotion:buttonMask x:x y:y
- "mouse-move while button was pressed - handle selection changes"
-
- |movedVisibleLine movedLine delta oldSelection oldSelCount|
-
- "is it the select or 1-button ?"
- (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
- (device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
- ^ self
- ].
+! !
+
+!SelectionInListView methodsFor:'accessing-selection'!
+
+addToSelection:aNumber
+ "add entry, aNumber to the selection. No scrolling is done."
+
+ (self isValidSelection:aNumber) ifFalse:[^ self].
+
+ selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
+ selection isCollection ifTrue:[
+ (selection includes:aNumber) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection add:aNumber
+ ] ifFalse:[
+ (aNumber == selection) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection := OrderedCollection with:selection with:aNumber
].
-
- clickLine isNil ifTrue:[^ self].
-
- "if moved outside of view, start autoscroll"
- (y < 0) ifTrue:[
- self compressMotionEvents:false.
- self startAutoScrollUp:y.
- ^ self
+ self redrawElement:aNumber
+!
+
+addElementToSelection:anObject
+ "add the element with the same printstring as the argument, anObject
+ to the selection. The entry is searched by comparing printStrings.
+ No scrolling is done. Returns true, if ok, false if no such entry
+ was found."
+
+ |lineNo str|
+
+ str := anObject printString.
+ lineNo := list findFirst:[:entry | str = entry printString].
+ lineNo ~~ 0 ifTrue:[
+ self addToSelection:lineNo.
+ ^ true
].
- (y > height) ifTrue:[
- self compressMotionEvents:false.
- self startAutoScrollDown:(y - height).
- ^ self
- ].
-
- "move inside - stop autoscroll if any"
- self stopAutoScroll.
-
- movedVisibleLine := self visibleLineOfY:y.
- movedLine := self visibleLineToAbsoluteLine:movedVisibleLine.
- (movedLine == clickLine) ifTrue:[^ self].
+ ^ false
+!
+
+removeFromSelection:aNumber
+ "remove entry, aNumber from the selection."
+
+ selection isNil ifTrue:[^ self].
multipleSelectOk ifTrue:[
- delta := (clickLine < movedLine) ifTrue:[1] ifFalse:[-1].
-
- oldSelection := selection.
- oldSelCount := selection size.
-
- (clickLine+delta) to:movedLine by:delta do:[:line |
- (self isInSelection:line) ifTrue:[
- self removeFromSelection:line
- ] ifFalse:[
- self addToSelection:line
- ]
- ].
- ((selection ~= oldSelection)
- or:[selection size ~~ oldSelCount]) ifTrue:[
- self selectionChangedFrom:oldSelection.
+ (selection includes:aNumber) ifFalse:[^ self].
+ selection remove:aNumber.
+ selection size == 0 ifTrue:[
+ selection := nil
]
] ifFalse:[
-"/ self selectWithoutScroll:movedLine
+ (aNumber == selection) ifFalse:[^ self].
+ selection := nil
].
-
- clickLine := movedLine
+ self redrawElement:aNumber
! !
+
+!SelectionInListView methodsFor:'accessing-mvc'!
+
+on:aModel printItems:print oneItem:one aspect:aspectSymbol change:changeSymbol
+ list:listSymbol menu:menuSymbol initialSelection:initialSymbol useIndex:use
+
+ "ST-80 compatibility"
+
+ aspectMsg := aspectSymbol.
+ changeMsg := changeSymbol.
+ listMsg := listSymbol.
+ menuMsg := menuSymbol.
+ initialSelectionMsg := initialSymbol.
+ printItems := print.
+ oneItem := one.
+ useIndex := use.
+ ignoreReselect := false. "/ ST80 behavior
+ self model:aModel.
+!
+
+doubleClickMessage
+ "return the symbol with which the model (if any) is informed about
+ double-click. If nil (which is the default), it is not informed."
+
+ ^ doubleClickMsg
+!
+
+doubleClickMessage:aSymbol
+ "set the symbol with which the model (if any) is informed about double-click.
+ If nil (which is the default), it is not informed."
+
+ doubleClickMsg := aSymbol
+!
+
+doubleClick:aSymbol
+ "set the symbol with which the model is informed about double-click.
+ OBSOLETE: please use #doubleClickMessage:"
+
+ self obsoleteMethodWarning:'please use #doubleClickMessage:'.
+ doubleClickMsg := aSymbol
+!
+
+initialSelectionMessage
+ "return the symbol by which the model informes me about a changed
+ selectionIndex. This is used both in change notification and to
+ actually aquire a new selection value."
+
+ ^ initialSelectionMsg
+!
+
+initialSelectionMessage:aSymbol
+ "set the symbol by which the model informes me about a changed
+ selectionIndex. This is used both in change notification and to
+ actually aquire a new selection value."
+
+ initialSelectionMsg := aSymbol
+!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#doubleClickMessage put:doubleClickMsg.
+ aDictionary at:#initialSelectionMessage put:initialSelectionMsg.
+
+ "
+ SelectionInListView new modelInterface
+ "
+! !
+
--- a/SelectionInListView.st Mon May 08 17:19:27 1995 +0200
+++ b/SelectionInListView.st Tue May 09 03:57:16 1995 +0200
@@ -10,23 +10,24 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:01:02 am'!
+'From Smalltalk/X, Version:2.10.5 on 8-may-1995 at 11:59:03 am'!
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 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'
!
@@ -35,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.31 1995-05-08 15:19:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.32 1995-05-09 01:56:42 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -56,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.31 1995-05-08 15:19:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.32 1995-05-09 01:56:42 claus Exp $
"
!
@@ -157,6 +158,8 @@
keyActionStyle <Symbol> controls how to respond to keyboard selects
+ returnKeyActionStyle <Symbol> controls how to respond to return key
+
written spring/summer 89 by claus
3D Jan 90 by claus
multiselect Jun 92 by claus
@@ -170,202 +173,301 @@
or in the traditional mvc way.
with actions:
- simple:
-
- |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:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ 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
+
+
+ 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
+
+
+ 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
+
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:[:index | Transcript showCr:'selected ' , index 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
+
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 | slv selectionValue asFilename edit].
-
- 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.
+ 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
+
+
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').
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#list
- change:#selection:
- list:#list
- initialSelection:#selection.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
- model inspect
-
-
- since the above selectors are the default anyway, you can also use:
-
- |top slv model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
-
- 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.
"
! !
@@ -387,6 +489,18 @@
useIndex:useIndex
!
+on:aModel aspect:aspect change:change list:list initialSelection:initial
+ ^ self on:aModel
+ printItems:true
+ oneItem:false
+ aspect:aspect
+ change:change
+ list:list
+ menu:nil
+ initialSelection:initial
+ useIndex:true
+!
+
on:aModel printItems:print oneItem:one aspect:aspect
change:change list:list menu:menu initialSelection:initial
@@ -413,22 +527,26 @@
menu:menu
initialSelection:initial
useIndex:true
-!
-
-on:aModel aspect:aspect change:change list:list initialSelection:initial
- ^ self on:aModel
- printItems:true
- oneItem:false
- aspect:aspect
- change:change
- list:list
- menu:nil
- initialSelection:initial
- useIndex:true
! !
!SelectionInListView class methodsFor:'defaults'!
+defaultListMessage
+ ^ #list
+!
+
+defaultChangeMessage
+ ^ #selectionIndex:
+!
+
+defaultAspectMessage
+ ^ nil
+!
+
+defaultSelectionMessage
+ ^ #selectionIndex
+!
+
rightArrowShadowFormOn:aDevice
"return the form used for the right arrow light pixels (3D only)"
@@ -604,14 +722,333 @@
^ f
! !
+!SelectionInListView methodsFor:'selections'!
+
+isInSelection:aNumber
+ "return true, if line, aNumber is in the selection"
+
+ selection isNil ifTrue:[^ false].
+ multipleSelectOk ifTrue:[
+ ^ (selection includes:aNumber)
+ ].
+ ^ (aNumber == selection)
+!
+
+selectWithoutScroll:aNumberOrNilOrCollection
+ "select line, aNumber or deselect if argument is nil"
+
+ |prevSelection newSelection|
+
+ newSelection := aNumberOrNilOrCollection.
+ newSelection notNil ifTrue:[
+ (self isValidSelection:newSelection) ifFalse:[
+ newSelection := nil
+ ]
+ ].
+
+ (newSelection = selection) ifTrue: [^ self].
+
+ "
+ redraw old selection unhighlighted
+ "
+ selection notNil ifTrue: [
+ prevSelection := selection.
+ selection := nil.
+ multipleSelectOk ifTrue:[
+ prevSelection do:[:line |
+ self redrawElement:line
+ ]
+ ] ifFalse:[
+ self redrawElement:prevSelection
+ ]
+ ].
+
+ selection := newSelection.
+
+ "
+ redraw new selection unhighlighted
+ "
+ newSelection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ newSelection isCollection ifFalse:[
+ selection := OrderedCollection with:newSelection.
+ ].
+ selection do:[:line |
+ self redrawElement:line
+ ]
+ ] ifFalse:[
+ self redrawElement:selection
+ ]
+ ]
+
+!
+
+makeSelectionVisible
+ "scroll to make the selection line visible"
+
+ |line|
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ line := selection first.
+ ] ifFalse:[
+ line := selection
+ ].
+ self makeLineVisible:line
+ ]
+!
+
+selection:aNumberOrNil
+ "select line, aNumber or deselect if argument is nil;
+ scroll to make the selected line visible"
+
+ self selectWithoutScroll:aNumberOrNil.
+ selection notNil ifTrue:[self makeSelectionVisible]
+!
+
+selectionValue
+ "return the selection value i.e. the text in the selected line.
+ For multiple selections a collection containing the entries is returned."
+
+ selection isNil ifTrue:[^ nil].
+
+ multipleSelectOk ifTrue:[
+ ^ selection collect:[:nr | self at:nr]
+ ].
+ ^ self at:selection
+
+!
+
+hasSelection
+ "return true, if the view has a selection"
+
+ ^ selection notNil
+!
+
+selectElement:anObject
+ "select the element with same printString as the argument, anObject.
+ Scroll to make the new selection visible."
+
+ |lineNo|
+
+ list notNil ifTrue:[
+ items notNil ifTrue:[
+ lineNo := items indexOf:anObject ifAbsent:nil
+ ] ifFalse:[
+ lineNo := list indexOf:(anObject printString) ifAbsent:nil.
+ ].
+ lineNo notNil ifTrue:[self selection:lineNo]
+ ]
+!
+
+selection
+ "return the selection index or collection of indices (if multipleSelect is on)"
+
+ ^ selection
+!
+
+selectionChangedFrom:oldSelection
+ "selection has changed. Call actionblock and/or send changeMessage if defined"
+
+ |arg|
+
+ arg := self argForChangeMessage.
+ "
+ the ST/X way of doing things - perform actionBlock
+ "
+ actionBlock notNil ifTrue:[actionBlock value:arg].
+ "
+ the ST-80 way of doing things - notify model via changeMsg
+ "
+ "/ ST80 sends 0 as index, if the same selection is reselected ...
+ selection == oldSelection ifTrue:[
+ arg := 0
+ ].
+ self sendChangeMessageWith:arg
+!
+
+deselect
+ "deselect"
+
+ self selection:nil
+!
+
+deselectWithoutRedraw
+ "deselect - no redraw"
+
+ selection := nil
+!
+
+numberOfSelections
+ "return the number of selected entries"
+
+ |sz|
+
+ selection isNil ifTrue:[^ 0].
+ sz := selection size.
+ sz > 0 ifTrue:[^ sz].
+ ^ 1
+!
+
+valueIsInSelection:someString
+ "return true, if someString is in the selection"
+
+ |sel|
+
+ selection isNil ifTrue:[^ false].
+ sel := self selectionValue.
+ self numberOfSelections > 1 ifTrue:[
+ ^ (sel includes:someString)
+ ].
+ ^ (someString = sel)
+!
+
+selectElementWithoutScroll:anObject
+ "select the element with same printString as the argument, anObject.
+ Do not scroll."
+
+ |lineNo|
+
+ list notNil ifTrue:[
+ items notNil ifTrue:[
+ lineNo := items indexOf:anObject ifAbsent:nil
+ ] ifFalse:[
+ lineNo := list indexOf:(anObject printString) ifAbsent:nil.
+ ].
+ lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
+ ]
+!
+
+nextAfterSelection
+ "return the index of the next selectable entry after the selection.
+ Wrap at end."
+
+ |next|
+
+ selection isNil ifTrue:[
+ next := firstLineShown
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ next := selection max + 1
+ ] ifFalse:[
+ next := selection + 1
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next > self size ifTrue:[
+ next := 1.
+ ] ifFalse:[
+ [next <= self size
+ and:[(self isValidSelection:next) not]] whileTrue:[
+ next := next + 1
+ ].
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next := nil
+ ].
+ ^ next
+!
+
+previousBeforeSelection
+ "return the index of the previous selectable entry before the selection.
+ Wrap at beginning."
+
+ |prev|
+
+ selection isNil ifTrue:[
+ prev := firstLineShown - 1
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ prev := selection min - 1
+ ] ifFalse:[
+ prev := selection - 1
+ ].
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev < 1 ifTrue:[
+ prev := self size.
+ ] ifFalse:[
+ [prev >= 1
+ and:[(self isValidSelection:prev) not]] whileTrue:[
+ prev := prev - 1
+ ].
+ ].
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev := nil
+ ].
+ ^ prev
+
+!
+
+selectAll
+ "select all entries."
+
+ |oldSelection|
+
+ multipleSelectOk ifTrue:[
+ oldSelection := selection.
+ selection := OrderedCollection withAll:(1 to:self size).
+ shown ifTrue:[self redraw].
+ self selectionChangedFrom:oldSelection.
+ ]
+!
+
+toggleSelection:aNumber
+ "toggle selection-state of entry, aNumber"
+
+ (self isInSelection:aNumber) ifTrue:[
+ self removeFromSelection:aNumber
+ ] ifFalse:[
+ self addToSelection:aNumber
+ ]
+!
+
+selectNext
+ "select next line or first visible if there is currrently no selection.
+ Wrap at end."
+
+ self selection:(self nextAfterSelection)
+!
+
+selectPrevious
+ "select previous line or previous visible if there is currently no selection.
+ Wrap at beginning."
+
+ self selection:(self previouseBeforeSelection).
+!
+
+selectionDo:aBlock
+ "perform aBlock for each nr in the selection.
+ For single selection, it is called once for the items nr.
+ For multiple selections, it is called for each."
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ selection do:aBlock
+ ] ifFalse:[
+ aBlock value:selection
+ ].
+ ].
+
+!
+
+selectionAsCollection
+ "return the selection as a collection of line numbers.
+ This allows users of this class to enumerate independent of
+ the multipleSelect style."
+
+ selection isNil ifTrue:[^ #()].
+
+ multipleSelectOk ifTrue:[
+ ^ (OrderedCollection new) add:selection; yourself.
+ ].
+ ^ selection
+! !
+
!SelectionInListView methodsFor:'redrawing'!
-redrawElement:aNumber
- "redraw an individual element"
-
- ^ self redrawLine:aNumber
-!
-
redrawVisibleLine:visLineNr
"redraw a single line.
Must check, if any is in the selection and handle this case.
@@ -626,43 +1063,52 @@
(self isInSelection:listLine) ifTrue:[
^ self drawVisibleLineSelected:visLineNr
].
- (self line:listLine hasAttribute:#halfIntensity) ifTrue:[
- fg := halfIntensityFgColor
- ] ifFalse:[
- (self line:listLine hasAttribute:#disabled) ifTrue:[
+
+ listAttributes notNil ifTrue:[
+ (self line:listLine hasAttribute:#halfIntensity) ifTrue:[
fg := halfIntensityFgColor
+ ] ifFalse:[
+ (self line:listLine hasAttribute:#disabled) ifTrue:[
+ fg := halfIntensityFgColor
+ ].
].
- ].
- (self line:listLine hasAttribute:#bold) ifTrue:[
- font bold ifTrue:[
- "
- mhmh - what can be done, if the font is already bold ?
- "
- newFont := font.
- fgColor brightness > 0.5 ifTrue:[
- fg := fgColor darkened "darkened".
+ (self line:listLine hasAttribute:#bold) ifTrue:[
+ font bold ifTrue:[
+ "
+ mhmh - what can be done, if the font is already bold ?
+ "
+ newFont := font.
+ fgColor brightness > 0.5 ifTrue:[
+ fg := fgColor darkened "darkened".
+ ] ifFalse:[
+ fg := fgColor lightened "lightened"
+ ].
+ (fg brightness - bg brightness) abs < 0.25 ifTrue:[
+ bgColor brightness > 0.5 ifTrue:[
+ fg := fg darkened.
+ ] ifFalse:[
+ fg := fg lightened
+ ].
+ ]
] ifFalse:[
- fg := fgColor lightened "lightened"
+ newFont := font asBold
].
- (fg brightness - bg brightness) abs < 0.25 ifTrue:[
- bgColor brightness > 0.5 ifTrue:[
- fg := fg darkened.
- ] ifFalse:[
- fg := fg lightened
- ].
- ]
- ] ifFalse:[
- newFont := font asBold
- ].
- device setFont:(newFont on:device) fontId in:gcId.
- self drawVisibleLine:visLineNr with:fg and:bg.
- device setFont:(font on:device) fontId in:gcId.
- ^ self
+ device setFont:(newFont on:device) fontId in:gcId.
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ device setFont:(font on:device) fontId in:gcId.
+ ^ self
+ ]
]
].
^ self drawVisibleLine:visLineNr with:fg and:bg
!
+redrawElement:aNumber
+ "redraw an individual element"
+
+ ^ self redrawLine:aNumber
+!
+
drawVisibleLineSelected:visLineNr
"redraw a single line as selected."
@@ -779,6 +1225,16 @@
]
!
+redrawVisibleLine:visLineNr from:startCol to:endCol
+ "redraw from a startCol to endCol.
+ Must check, if its in the selection and handle this case."
+
+ (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
+ ^ self redrawVisibleLine:visLineNr
+ ].
+ super redrawVisibleLine:visLineNr from:startCol to:endCol
+!
+
drawRightArrowInVisibleLine:visLineNr
"draw a right arrow (for submenus).
This method is not used here, but provided for subclasses such
@@ -840,16 +1296,6 @@
super redrawVisibleLine:visLineNr col:colNr
!
-redrawVisibleLine:visLineNr from:startCol to:endCol
- "redraw from a startCol to endCol.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr from:startCol to:endCol
-!
-
redrawVisibleLine:visLineNr from:startCol
"redraw from a col to the right end.
Must check, if its in the selection and handle this case."
@@ -860,883 +1306,8 @@
super redrawVisibleLine:visLineNr from:startCol
! !
-!SelectionInListView methodsFor:'selections'!
-
-selectWithoutScroll:aNumberOrNil
- "select line, aNumber or deselect if argument is nil"
-
- |prevSelection newSelection|
-
- newSelection := aNumberOrNil.
- newSelection notNil ifTrue:[
- (self isValidSelection:newSelection) ifFalse:[
- newSelection := nil
- ]
- ].
-
- (newSelection == selection) ifTrue: [^ self].
-
- selection notNil ifTrue: [
- prevSelection := selection.
- selection := nil.
- (prevSelection isCollection) ifTrue:[
- prevSelection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:prevSelection
- ]
- ].
- selection := newSelection.
- (selection isCollection) ifTrue:[
- selection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:selection
- ]
-
-!
-
-selection:aNumberOrNil
- "select line, aNumber or deselect if argument is nil;
- scroll to make the selected line visible"
-
- self selectWithoutScroll:aNumberOrNil.
- selection notNil ifTrue:[self makeSelectionVisible]
-!
-
-makeSelectionVisible
- "scroll to make the selection line visible"
-
- |line|
-
- selection notNil ifTrue:[
- (selection isCollection) ifTrue:[
- line := selection first.
- ] ifFalse:[
- line := selection
- ].
- self makeLineVisible:line
- ]
-!
-
-isInSelection:aNumber
- "return true, if line, aNumber is in the selection"
-
- selection isNil ifTrue:[^ false].
- selection isCollection ifTrue:[
- ^ (selection includes:aNumber)
- ].
- ^ (aNumber == selection)
-!
-
-toggleSelect:aBoolean
- "turn on/off toggle select"
-
- toggleSelect := aBoolean.
-!
-
-multipleSelectOk:aBoolean
- "allow/disallow multiple selections"
-
- multipleSelectOk := aBoolean.
- aBoolean ifTrue:[
- self enableButtonMotionEvents
- ] ifFalse:[
- self disableButtonMotionEvents
- ]
-!
-
-selectConditionBlock:aBlock
- "set the conditionBlock; this block is evaluated before a selection
- change is performed; the change will not be done, if the evaluation
- returns false. For example, this allows confirmation queries in
- the SystemBrowser"
-
- selectConditionBlock := aBlock
-!
-
-strikeOut:aBoolean
- "turn on/off strikeOut mode"
-
- strikeOut := aBoolean.
-!
-
-selection
- "return the selection line nr or collection of line numbers"
-
- ^ selection
-!
-
-ignoreReselect:aBoolean
- "set/clear the ignoreReselect flag -
- if set, a click on an already selected entry is ignored.
- Otherwise the notification is done, even if no
- change in the selection occurs.
- (for example, in browser to update a method)"
-
- ignoreReselect := aBoolean
-!
-
-enable
- "enable selections"
-
- enabled := true
-!
-
-disable
- "disable selections"
-
- enabled := false
-!
-
-selectionValue
- "return the selection value i.e. the text in the selected line.
- For multiple selections a collection containing the entries is returned."
-
- selection isNil ifTrue:[^ nil].
- (selection isCollection) ifTrue:[
- ^ selection collect:[:nr | self at:nr]
- ].
- ^ self at:selection
-
-!
-
-numberOfSelections
- "return the number of selected entries"
-
- |sz|
-
- selection isNil ifTrue:[^ 0].
- sz := selection size.
- sz > 0 ifTrue:[^ sz].
- ^ 1
-!
-
-hasSelection
- "return true, if the view has a selection"
-
- ^ selection notNil
-!
-
-deselectWithoutRedraw
- "deselect - no redraw"
-
- selection := nil
-!
-
-deselect
- "deselect"
-
- self selection:nil
-!
-
-selectElement:anObject
- "select the element with same printString as the argument, anObject.
- Scroll to make the new selection visible."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selection:lineNo]
- ]
-!
-
-valueIsInSelection:someString
- "return true, if someString is in the selection"
-
- |sel|
-
- selection isNil ifTrue:[^ false].
- sel := self selectionValue.
- self numberOfSelections > 1 ifTrue:[
- ^ (sel includes:someString)
- ].
- ^ (someString = sel)
-!
-
-selectElementWithoutScroll:anObject
- "select the element with same printString as the argument, anObject.
- Do not scroll."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
- ]
-!
-
-selectAll
- "select all entries."
-
- |oldSelection|
-
- oldSelection := selection.
- selection := OrderedCollection withAll:(1 to:self size).
- shown ifTrue:[self redraw].
- self selectionChangedFrom:oldSelection.
-!
-
-addElementToSelection:anObject
- "add the element with the same printstring as the argument, anObject
- to the selection. The entry is searched by comparing printStrings.
- No scrolling is done. Returns true, if ok, false if no such entry
- was found."
-
- |lineNo str|
-
- str := anObject printString.
- lineNo := list findFirst:[:entry | str = entry printString].
- lineNo ~~ 0 ifTrue:[
- self addToSelection:lineNo.
- ^ true
- ].
- ^ false
-!
-
-addToSelection:aNumber
- "add entry, aNumber to the selection. No scrolling is done."
-
- (self isValidSelection:aNumber) ifFalse:[^ self].
-
- selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifTrue:[^ self].
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
- selection add:aNumber
- ] ifFalse:[
- (aNumber == selection) ifTrue:[^ self].
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
- selection := OrderedCollection with:selection with:aNumber
- ].
- self redrawElement:aNumber
-!
-
-removeFromSelection:aNumber
- "remove entry, aNumber from the selection."
-
- selection isNil ifTrue:[^ self].
-
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifFalse:[^ self].
- selection remove:aNumber.
- selection size == 1 ifTrue:[
- selection := selection first
- ] ifFalse:[
- selection size == 0 ifTrue:[
- selection := nil
- ]
- ]
- ] ifFalse:[
- (aNumber == selection) ifFalse:[^ self].
- selection := nil
- ].
- self redrawElement:aNumber
-!
-
-nextAfterSelection
- "return the number of the next selectable entry after the selection.
- Wrap at end."
-
- |next|
-
- selection isNil ifTrue:[
- next := firstLineShown
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- next := selection max + 1
- ] ifFalse:[
- next := selection + 1
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next > self size ifTrue:[
- next := 1.
- ] ifFalse:[
- [next <= self size
- and:[(self isValidSelection:next) not]] whileTrue:[
- next := next + 1
- ].
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next := nil
- ].
- ^ next
-!
-
-previousBeforeSelection
- "return the number of the previous selectable entry before the selection.
- Wrap at beginning."
-
- |prev|
-
- selection isNil ifTrue:[
- prev := firstLineShown - 1
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- prev := selection min - 1
- ] ifFalse:[
- prev := selection - 1
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev < 1 ifTrue:[
- prev := self size.
- ] ifFalse:[
- [prev >= 1
- and:[(self isValidSelection:prev) not]] whileTrue:[
- prev := prev - 1
- ].
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev := nil
- ].
- ^ prev
-
-!
-
-toggleSelection:aNumber
- "toggle selection-state of entry, aNumber"
-
- (self isInSelection:aNumber) ifTrue:[
- self removeFromSelection:aNumber
- ] ifFalse:[
- self addToSelection:aNumber
- ]
-!
-
-selectNext
- "select next line or first visible if there is currrently no selection.
- Wrap at end."
-
- self selection:(self nextAfterSelection)
-!
-
-selectPrevious
- "select previous line or previous visible if there is currently no selection.
- Wrap at beginning."
-
- self selection:(self previouseBeforeSelection).
-!
-
-selectionDo:aBlock
- "perform aBlock for each nr in the selection.
- For single selection, it is called once for the items nr.
- For multiple selections, it is called for each."
-
- |sz|
-
- selection isNil ifTrue:[^ self].
- sz := selection size.
- sz > 0 ifTrue:[
- selection do:aBlock
- ] ifFalse:[
- aBlock value:selection
- ].
-!
-
-argForChangeMessage
- "return the argument for a selectionChange;
- depending on the setting of useIndex, this is either the numeric
- index of the selection or the value (i.e. the string)"
-
- useIndex == false ifTrue:[
- printItems ifFalse:[
- ^ self selectionValue
- ].
- ^ items at:selection
- ].
- "true or nil - strange"
- ^ selection.
-!
-
-selectionChangedFrom:oldSelection
- "selection has changed. Call actionblock and/or send changeMessage if defined"
-
- |arg|
-
- arg := self argForChangeMessage.
- "
- the ST/X way of doing things - perform actionBlock
- "
- actionBlock notNil ifTrue:[actionBlock value:arg].
- "
- the ST-80 way of doing things - notify model via changeMsg
- "
- "/ ST80 sends 0 as index, if the same selection is reselected ...
- selection == oldSelection ifTrue:[
- arg := 0
- ].
- self sendChangeMessageWith:arg
-!
-
-selectionAsCollection
- "return the selection as a collection of line numbers"
-
- selection size = 0 ifTrue:[
- selection isNil ifTrue:[^ #()].
- ^ (OrderedCollection new) add:selection; yourself.
- ] ifFalse:[
- ^ selection
- ].
-! !
-
-!SelectionInListView methodsFor:'accessing'!
-
-line:lineNr hasAttribute:aSymbol
- "return true, if line nr has attribute, aSymbol;
- currently supported attributes are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |attr|
-
- (lineNr > listAttributes size) ifTrue:[^ false].
- attr := listAttributes at:lineNr.
- attr isNil ifTrue:[^ false].
- attr isSymbol ifTrue:[^ attr == aSymbol].
- ^ (attr includes:aSymbol)
-!
-
-contents:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- selection := nil.
- listAttributes := nil.
- super contents:aCollection.
-!
-
-attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
- "set a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- (index > self size) ifFalse:[
- listAttributes isNil ifTrue:[
- listAttributes := (OrderedCollection new:index) grow:index
- ] ifFalse:[
- (index > listAttributes size) ifTrue:[
- listAttributes grow:index
- ]
- ].
- aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
- listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
- self redrawLine:index
- ]
- ]
-
-!
-
-setList:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- selection := nil.
- listAttributes := nil.
- super setList:aCollection.
-!
-
-list:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- "somewhat of a kludge: if selection is first line,
- we have to remove the highlight frame by hand here"
-
- (shown and:[hilightLevel ~~ 0]) ifTrue:[
- selection == firstLineShown ifTrue:[
- self paint:bgColor.
- self fillRectangleX:margin y:margin
- width:(width - (margin * 2))
- height:(hilightLevel abs).
- ].
- ].
-
- selection := nil.
- listAttributes := nil.
- super list:aCollection.
-!
-
-setAttributes:aList
- "set the attribute list.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- listAttributes := aList
-!
-
-keyActionStyle:aSymbol
- "defines how the view should respond to alpha-keys pressed.
- Possible values are:
- #select -> will select next entry starting with that
- character and perform the click-action
-
- #selectAndDoubleclick -> will select next & perform double-click action
-
- #pass -> will pass key to superclass (i.e. no special treatment)
-
- nil -> will ignore key
-
- the default (set in #initialize) is #select
- "
-
- keyActionStyle := aSymbol
-!
-
-attributeAt:index
- "return the line attribute of list line index.
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- listAttributes isNil ifFalse:[
- (index > listAttributes size) ifFalse:[
- ^ listAttributes at:index
- ]
- ].
- ^ nil
-!
-
-action:aBlock
- "set the action block to be performed on select"
-
- actionBlock := aBlock
-!
-
-attributeAt:index add:aSymbolOrCollectionOfSymbols
- "add to a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[
- current := Set new.
- ] ifFalse:[
- current isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
- current := Set with:current
- ]
- ].
-
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current add:aSymbolOrCollectionOfSymbols
- ] ifFalse:[
- (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
- current addAll:aSymbolOrCollectionOfSymbols
- ].
- self attributeAt:index put:current
-!
-
-doubleClickAction:aBlock
- "set the double click action block to be performed on select"
-
- doubleClickActionBlock := aBlock
-!
-
-attributeAt:index remove:aSymbolOrCollectionOfSymbols
- "remove a line attribute;
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[^ self].
- current isSymbol ifTrue:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
- ] ifFalse:[
- (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
- current := nil
- ]
- ]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
- ]
- ].
- self attributeAt:index put:current
-!
-
-removeIndexWithoutRedraw:lineNr
- "delete line - no redraw;
- return true, if something was really deleted.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndexWithoutRedraw:lineNr
-!
-
-removeIndex:lineNr
- "delete line - with redraw.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndex:lineNr
-!
-
-add:aValue beforeIndex:index
- "must recompute our current selections"
-
- selection notNil ifTrue:[
- selection size = 0 ifTrue:[
- selection >= index ifTrue:[
- selection := selection + 1.
- ].
- ] ifFalse:[
- selection := selection collect:[ :sel |
- sel >= index ifTrue:[
- sel + 1
- ] ifFalse:[
- sel
- ]
- ].
- ].
- ].
- ^ super add:aValue beforeIndex:index.
-!
-
-useIndex:aBoolean
- "set/clear the useIndex flag. If set, both actionBlock and change-messages
- are passed the index of the selection as argument. If clear, the value
- (i.e. the selected string) is passed.
- Default is true."
-
- useIndex := aBoolean
-! !
-
-!SelectionInListView methodsFor:'accessing-mvc'!
-
-on:aModel printItems:print oneItem:one aspect:aspectSymbol change:changeSymbol
- list:listSymbol menu:menuSymbol initialSelection:initialSymbol useIndex:use
-
- "ST-80 compatibility"
-
- aspectMsg := aspectSymbol.
- changeMsg := changeSymbol.
- listMsg := listSymbol.
- menuMsg := menuSymbol.
- initialSelectionMsg := initialSymbol.
- printItems := print.
- oneItem := one.
- useIndex := use.
- ignoreReselect := false. "/ ST80 behavior
- self model:aModel.
-!
-
-doubleClickMessage
- "return the symbol with which the model (if any) is informed about
- double-click. If nil (which is the default), it is not informed."
-
- ^ doubleClickMsg
-!
-
-doubleClickMessage:aSymbol
- "set the symbol with which the model (if any) is informed about double-click.
- If nil (which is the default), it is not informed."
-
- doubleClickMsg := aSymbol
-!
-
-doubleClick:aSymbol
- "set the symbol with which the model is informed about double-click.
- OBSOLETE: please use #doubleClickMessage:"
-
- self obsoleteMethodWarning:'please use #doubleClickMessage:'.
- doubleClickMsg := aSymbol
-!
-
-selectionMessage
- "return the symbol by which the model informes me about a changed
- selectionIndex. This is used both in change notification and to
- actually aquire a new selection value."
-
- ^ initialSelectionMsg
-!
-
-selectionMessage:aSymbol
- "set the symbol by which the model informes me about a changed
- selectionIndex. This is used both in change notification and to
- actually aquire a new selection value."
-
- initialSelectionMsg := aSymbol
-!
-
-addModelInterfaceTo:aDictionary
- "see comment in View>>modelInterface"
-
- super addModelInterfaceTo:aDictionary.
- aDictionary at:#doubleClickMessage put:doubleClickMsg.
- aDictionary at:#selectionMessage put:initialSelectionMsg.
-
- "
- SelectionInListView new modelInterface
- "
-! !
-
!SelectionInListView methodsFor:'private'!
-isValidSelection:aNumber
- "return true, if aNumber is ok for a selection lineNo"
-
- aNumber isNil ifTrue:[^ false].
- (aNumber isCollection) ifTrue:[
- (multipleSelectOk or:[aNumber size = 1]) ifFalse:[^ false].
- aNumber do:[ :line |
- (line between:1 and:self size) ifFalse:[^ false].
- ].
- ^ true.
- ] ifFalse:[
- ^ (aNumber between:1 and:self size).
- ].
-
-!
-
-widthForScrollBetween:start and:end
- "has to be redefined since WHOLE line is inverted/modified sometimes"
-
- | anySelectionInRange |
-
- selection notNil ifTrue:[
- selection isCollection ifTrue:[
- anySelectionInRange := false.
- selection do:[:s |
- (s between:start and:end) ifTrue:[
- anySelectionInRange := true
- ]
- ]
- ] ifFalse:[
- anySelectionInRange := selection between:start and:end
- ]
- ] ifFalse:[
- anySelectionInRange := false
- ].
-
- anySelectionInRange ifTrue:[
- ^ width
-"
- self is3D ifFalse:[
- ^ width
- ].
- ( #(next openwin) includes:style) ifTrue:[
- ^ width
- ].
- viewBackground = background ifFalse:[
- ^ width
- ]
-"
- ].
- ^ super widthForScrollBetween:start and:end
-!
-
-positionToSelectionX:x y:y
- "given a click position, return the selection lineNo"
-
- |visibleLine|
-
- (x between:0 and:width) ifTrue:[
- (y between:0 and:height) ifTrue:[
- visibleLine := self visibleLineOfY:y.
- ^ self visibleLineToListLine:visibleLine
- ]
- ].
- ^ nil
-!
-
-visibleLineNeedsSpecialCare:visLineNr
- |listLine|
-
- listLine := self visibleLineToListLine:visLineNr.
- listLine isNil ifTrue:[^ false].
- (self isInSelection:listLine) ifTrue:[^ true].
- listAttributes notNil ifTrue:[
- (listLine <= listAttributes size) ifTrue:[
- ^ (listAttributes at:listLine) notNil
- ]
- ].
- ^ false
-!
-
-checkRemovingSelection:lineNr
- "when a line is removed, we have to adjust selection"
-
- |newSelection|
-
- selection notNil ifTrue:[
- (selection size > 0) ifTrue:[
- newSelection := OrderedCollection new.
- selection do:[:sel |
- sel < lineNr ifTrue:[
- newSelection add:sel
- ] ifFalse:[
- sel > lineNr ifTrue:[
- newSelection add:(sel - 1)
- ]
- "otherwise remove it from the selection"
- ]
- ].
- newSelection size == 1 ifTrue:[
- selection := newSelection first
- ] ifFalse:[
- newSelection size == 0 ifTrue:[
- selection := nil
- ] ifFalse:[
- selection := newSelection
- ]
- ]
- ] ifFalse:[
- selection == lineNr ifTrue:[
- selection := nil
- ] ifFalse:[
- selection > lineNr ifTrue:[
- selection := selection - 1
- ]
- ]
- ]
- ]
-!
-
-scrollSelectDown
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollDown.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-scrollSelectUp
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollUp.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
getListFromModel
"if I have a model and a listMsg, get my list from it"
@@ -1775,6 +1346,795 @@
].
]
].
+!
+
+argForChangeMessage
+ "return the argument for a selectionChange;
+ depending on the setting of useIndex, this is either the numeric
+ index of the selection or the value (i.e. the string)"
+
+ useIndex ~~ false ifTrue:[ "/ i.e. everything except false
+ ^ selection
+ ].
+
+ printItems ifFalse:[
+ ^ self selectionValue
+ ].
+
+ items notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ ^ selection collect:[:nr | items at:nr]
+ ].
+ ^ items at:selection
+ ].
+
+ ^ nil "/ cannot happen
+!
+
+isValidSelection:aNumberOrCollection
+ "return true, if aNumber is ok as a selection index"
+
+ aNumberOrCollection isNil ifTrue:[^ false].
+
+ (aNumberOrCollection isCollection) ifTrue:[
+ multipleSelectOk ifFalse:[^ false].
+ aNumberOrCollection do:[:index |
+ (index between:1 and:self size) ifFalse:[^ false].
+ ].
+ ^ true.
+ ] ifFalse:[
+ ^ (aNumberOrCollection between:1 and:self size).
+ ].
+
+!
+
+positionToSelectionX:x y:y
+ "given a click position, return the selection lineNo"
+
+ |visibleLine|
+
+ (x between:0 and:width) ifTrue:[
+ (y between:0 and:height) ifTrue:[
+ visibleLine := self visibleLineOfY:y.
+ ^ self visibleLineToListLine:visibleLine
+ ]
+ ].
+ ^ nil
+!
+
+widthForScrollBetween:start and:end
+ "has to be redefined since WHOLE line is inverted/modified sometimes"
+
+ | anySelectionInRange |
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ anySelectionInRange := false.
+ selection do:[:s |
+ (s between:start and:end) ifTrue:[
+ anySelectionInRange := true
+ ]
+ ]
+ ] ifFalse:[
+ anySelectionInRange := selection between:start and:end
+ ]
+ ] ifFalse:[
+ anySelectionInRange := false
+ ].
+
+ anySelectionInRange ifTrue:[
+ ^ width
+"
+ self is3D ifFalse:[
+ ^ width
+ ].
+ ( #(next openwin) includes:style) ifTrue:[
+ ^ width
+ ].
+ viewBackground = background ifFalse:[
+ ^ width
+ ]
+"
+ ].
+ ^ super widthForScrollBetween:start and:end
+!
+
+visibleLineNeedsSpecialCare:visLineNr
+ |listLine|
+
+ listLine := self visibleLineToListLine:visLineNr.
+ listLine isNil ifTrue:[^ false].
+ (self isInSelection:listLine) ifTrue:[^ true].
+ listAttributes notNil ifTrue:[
+ (listLine <= listAttributes size) ifTrue:[
+ ^ (listAttributes at:listLine) notNil
+ ]
+ ].
+ ^ false
+!
+
+checkRemovingSelection:lineNr
+ "when a line is removed, we have to adjust selection"
+
+ |newSelection|
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ newSelection := OrderedCollection new.
+ selection do:[:sel |
+ sel < lineNr ifTrue:[
+ newSelection add:sel
+ ] ifFalse:[
+ sel > lineNr ifTrue:[
+ newSelection add:(sel - 1)
+ ]
+ "otherwise remove it from the selection"
+ ]
+ ].
+ newSelection size == 0 ifTrue:[
+ selection := nil
+ ] ifFalse:[
+ selection := newSelection
+ ]
+ ] ifFalse:[
+ selection == lineNr ifTrue:[
+ selection := nil
+ ] ifFalse:[
+ selection > lineNr ifTrue:[
+ selection := selection - 1
+ ]
+ ]
+ ]
+ ]
+!
+
+scrollSelectDown
+ "auto scroll action; scroll and reinstall timed-block"
+
+ self scrollDown.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+scrollSelectUp
+ "auto scroll action; scroll and reinstall timed-block"
+
+ self scrollUp.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+! !
+
+!SelectionInListView methodsFor:'event handling'!
+
+buttonRelease:button x:x y:y
+ "stop any autoscroll"
+
+ self stopAutoScroll
+!
+
+buttonPress:button x:x y:y
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ enabled ifTrue:[
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (toggleSelect
+ and:[self isInSelection:listLineNr]) ifTrue:[
+ oldSelection := selection copy.
+ self removeFromSelection:listLineNr
+ ] ifFalse:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+
+ (toggleSelect and:[multipleSelectOk]) ifTrue:[
+ oldSelection := selection copy.
+ self addToSelection:listLineNr
+ ] ifFalse:[
+ oldSelection := selection copy.
+ self selectWithoutScroll:listLineNr.
+ ].
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ self selectionChangedFrom:oldSelection.
+ ].
+ clickLine := listLineNr
+ ].
+ ]
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+!
+
+sizeChanged:how
+ "if there is a selection, make certain, its visible
+ after the sizechange"
+
+ |first wasAtEnd|
+
+ wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
+
+ super sizeChanged:how.
+
+ shown ifTrue:[
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ first := selection first
+ ] ifFalse:[
+ first := selection
+ ].
+ first notNil ifTrue:[self makeLineVisible:first]
+ ] ifFalse:[
+ "
+ if we where at the end before, move to the end again.
+ Still to be seen, if this is better in real life ...
+ "
+ wasAtEnd ifTrue:[
+ "at end"
+ self scrollToBottom
+ ]
+ ]
+ ]
+!
+
+keyPress:key x:x y:y
+ "handle keyboard input"
+
+ |index startSearch backSearch searchPrefix|
+
+ (key == #CursorUp) ifTrue:[
+ 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
+ ].
+ "/
+ "/ stupid: Home and End are cought in ScrollableView
+ "/ we normally do not get them ...
+ "/ (need to call handlesKey: from there ...
+ "/ ... and implement it here)
+ "/
+ (key == #Home) ifTrue:[
+ 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
+ ].
+ key == #Return ifTrue:[
+ returnKeyActionStyle == #doubleClick ifTrue:[
+ selection notNil ifTrue:[
+ self doubleClicked
+ ].
+ ^ self
+ ].
+ returnKeyActionStyle ~~ #pass ifTrue:[
+ ^ self
+ ].
+ ].
+
+ "
+ alphabetic keys: search for next entry
+ starting with keys character. If shift is pressed, search backward
+ "
+ (self size > 0
+ and:[key isCharacter
+ and:[key isLetter]]) ifTrue:[
+ keyActionStyle isNil ifTrue:[^ self].
+ keyActionStyle == #pass ifFalse:[
+ searchPrefix := key asLowercase asString.
+
+"/ ... isISearch... ifFalse:[
+"/ iSearchString := ''
+"/ ] ifTrue:[
+"/ iSearchString := iSearchString , searchPrefix.
+"/ 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
+ ]
+ ]
+ ].
+ ].
+ ^ super keyPress:key x:x y:y
+!
+
+buttonMotion:buttonMask x:x y:y
+ "mouse-move while button was pressed - handle selection changes"
+
+ |movedVisibleLine movedLine delta oldSelection oldSelCount|
+
+ "is it the select or 1-button ?"
+ (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
+ (device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
+ ^ self
+ ].
+ ].
+
+ clickLine isNil ifTrue:[^ self].
+
+ "if moved outside of view, start autoscroll"
+ (y < 0) ifTrue:[
+ self compressMotionEvents:false.
+ self startAutoScrollUp:y.
+ ^ self
+ ].
+ (y > height) ifTrue:[
+ self compressMotionEvents:false.
+ self startAutoScrollDown:(y - height).
+ ^ self
+ ].
+
+ "move inside - stop autoscroll if any"
+ self stopAutoScroll.
+
+ movedVisibleLine := self visibleLineOfY:y.
+ movedLine := self visibleLineToAbsoluteLine:movedVisibleLine.
+ (movedLine == clickLine) ifTrue:[^ self].
+
+ multipleSelectOk ifTrue:[
+ delta := (clickLine < movedLine) ifTrue:[1] ifFalse:[-1].
+
+ oldSelection := selection.
+ oldSelCount := selection size.
+
+ (clickLine+delta) to:movedLine by:delta do:[:line |
+ (self isInSelection:line) ifTrue:[
+ self removeFromSelection:line
+ ] ifFalse:[
+ self addToSelection:line
+ ]
+ ].
+ ((selection ~= oldSelection)
+ or:[selection size ~~ oldSelCount]) ifTrue:[
+ self selectionChangedFrom:oldSelection.
+ ]
+ ] ifFalse:[
+"/ self selectWithoutScroll:movedLine
+ ].
+
+ clickLine := movedLine
+!
+
+key:key select:index x:x y:y
+ "select an entry by a keyboard action.
+ This is treated like a doubleClick on that entry"
+
+ |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
+ ]
+ ]
+ ].
+!
+
+buttonMultiPress:button x:x y:y
+ ((button == 1) or:[button == #select]) ifTrue:[
+"/ doubleClickActionBlock isNil ifTrue:[
+"/ self buttonPress:button x:x y:y
+"/ ].
+ self doubleClicked.
+ ] ifFalse:[
+ super buttonMultiPress:button x:x y:y
+ ]
+!
+
+buttonShiftPress:button x:x y:y
+ "add to the selection (if multipleSelectOk); otherwise,
+ behave like normal select"
+
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ toggleSelect ifTrue:[
+ ^ self buttonPress:button x:x y:y
+ ].
+ enabled ifTrue:[
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+ ].
+ oldSelection := selection copy.
+ listLineNr notNil ifTrue: [
+ multipleSelectOk ifTrue:[
+ (self isInSelection:listLineNr) ifTrue:[
+ self removeFromSelection:listLineNr
+ ] ifFalse:[
+ self addToSelection:listLineNr
+ ]
+ ] ifFalse:[
+ self selectWithoutScroll:listLineNr
+ ]
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ self selectionChangedFrom:oldSelection.
+ ].
+ clickLine := listLineNr
+ ]
+ ] ifFalse:[
+ super buttonShiftPress:button x:x y:y
+ ]
+!
+
+doubleClicked
+ doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
+ (model notNil and:[doubleClickMsg notNil]) ifTrue:[
+ self sendChangeMessage:doubleClickMsg with:(self argForChangeMessage).
+ ].
+! !
+
+!SelectionInListView methodsFor:'accessing-actions'!
+
+action:aBlock
+ "set the action block to be performed on select"
+
+ actionBlock := aBlock
+!
+
+doubleClickAction:aBlock
+ "set the double click action block to be performed on select"
+
+ doubleClickActionBlock := aBlock
+!
+
+selectConditionBlock:aBlock
+ "set the conditionBlock; this block is evaluated before a selection
+ change is performed; the change will not be done, if the evaluation
+ returns false. For example, this allows confirmation queries in
+ the SystemBrowser"
+
+ selectConditionBlock := aBlock
+!
+
+useIndex:aBoolean
+ "set/clear the useIndex flag. If set, both actionBlock and change-messages
+ are passed the index(indices) of the selection as argument.
+ If clear, the value(s) (i.e. the selected string) is passed.
+ Default is true."
+
+ useIndex := aBoolean
+!
+
+keyActionStyle:aSymbol
+ "defines how the view should respond to alpha-keys pressed.
+ Possible values are:
+ #select -> will select next entry starting with that
+ character and perform the click-action
+
+ #selectAndDoubleclick -> will select next & perform double-click action
+
+ #pass -> will pass key to superclass (i.e. no special treatment)
+
+ nil -> will ignore key
+
+ the default (set in #initialize) is #select
+ "
+
+ keyActionStyle := aSymbol
+!
+
+returnKeyActionStyle:aSymbol
+ "defines how the view should respond to a return key pressed.
+ Possible values are:
+ #doubleClick -> perform double-click action
+
+ #pass -> will pass key to superclass (i.e. no special treatment)
+
+ nil -> will ignore key
+
+ the default (set in #initialize) is #doubleClick
+ "
+
+ returnKeyActionStyle := aSymbol
+! !
+
+!SelectionInListView methodsFor:'accessing-attributes'!
+
+line:lineNr hasAttribute:aSymbol
+ "return true, if line nr has attribute, aSymbol;
+ currently supported attributes are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |attr|
+
+ listAttributes isNil ifTrue:[^ false].
+ (lineNr > listAttributes size) ifTrue:[^ false].
+ attr := listAttributes at:lineNr.
+ attr isNil ifTrue:[^ false].
+ attr isSymbol ifTrue:[^ attr == aSymbol].
+ ^ (attr includes:aSymbol)
+!
+
+setAttributes:aList
+ "set the attribute list.
+ No redraw is done - the caller should make sure to redraw afterwards
+ (or use this only before the view is visible)."
+
+ listAttributes := aList
+!
+
+attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
+ "set a lines attribute(s);
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ (index > self size) ifFalse:[
+ listAttributes isNil ifTrue:[
+ listAttributes := (OrderedCollection new:index) grow:index
+ ] ifFalse:[
+ (index > listAttributes size) ifTrue:[
+ listAttributes grow:index
+ ]
+ ].
+ aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
+ listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
+ self redrawLine:index
+ ]
+ ]
+
+!
+
+strikeOut:aBoolean
+ "turn on/off strikeOut mode"
+
+ strikeOut := aBoolean.
+!
+
+attributeAt:index
+ "return the line attribute of list line index.
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ listAttributes isNil ifFalse:[
+ (index > listAttributes size) ifFalse:[
+ ^ listAttributes at:index
+ ]
+ ].
+ ^ nil
+!
+
+attributeAt:index add:aSymbolOrCollectionOfSymbols
+ "add to a lines attribute(s);
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |current|
+
+ current := self attributeAt:index.
+ current isNil ifTrue:[
+ current := Set new.
+ ] ifFalse:[
+ current isSymbol ifTrue:[
+ current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
+ current := Set with:current
+ ]
+ ].
+
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current := current add:aSymbolOrCollectionOfSymbols
+ ] ifFalse:[
+ (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
+ current addAll:aSymbolOrCollectionOfSymbols
+ ].
+ self attributeAt:index put:current
+!
+
+attributeAt:index remove:aSymbolOrCollectionOfSymbols
+ "remove a line attribute;
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |current|
+
+ current := self attributeAt:index.
+ current isNil ifTrue:[^ self].
+ current isSymbol ifTrue:[
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
+ ] ifFalse:[
+ (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
+ current := nil
+ ]
+ ]
+ ] ifFalse:[
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
+ ] ifFalse:[
+ aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
+ ]
+ ].
+ self attributeAt:index put:current
+! !
+
+!SelectionInListView methodsFor:'accessing-behavior'!
+
+ignoreReselect:aBoolean
+ "set/clear the ignoreReselect flag -
+ if set, a click on an already selected entry is ignored.
+ Otherwise the notification is done, even if no
+ change in the selection occurs.
+ (for example, in browser to update a method)"
+
+ ignoreReselect := aBoolean
+!
+
+toggleSelect:aBoolean
+ "turn on/off toggle select. If true, clicking on a selected entry
+ unselects it and vice versa. The default is false."
+
+ toggleSelect := aBoolean.
+!
+
+multipleSelectOk:aBoolean
+ "allow/disallow multiple selections"
+
+ multipleSelectOk := aBoolean.
+ aBoolean ifTrue:[
+ self enableButtonMotionEvents
+ ] ifFalse:[
+ self disableButtonMotionEvents
+ ]
+!
+
+enable
+ "enable the view - selection changes are allowed"
+
+ enabled := true
+!
+
+disable
+ "disable the view - no selection changes are allowed"
+
+ enabled := false
+! !
+
+!SelectionInListView methodsFor:'accessing-contents'!
+
+list:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes."
+
+ "somewhat of a kludge: if selection is first line,
+ we have to remove the highlight frame by hand here"
+
+ (shown and:[hilightLevel ~~ 0]) ifTrue:[
+ selection == firstLineShown ifTrue:[
+ self paint:bgColor.
+ self fillRectangleX:margin y:margin
+ width:(width - (margin * 2))
+ height:(hilightLevel abs).
+ ].
+ ].
+
+ selection := nil.
+ listAttributes := nil.
+ super list:aCollection.
+!
+
+setList:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes.
+ No redraw is done - the caller should make sure to redraw afterwards
+ (or use this only before the view is visible)."
+
+ selection := nil.
+ listAttributes := nil.
+ super setList:aCollection.
+!
+
+removeIndexWithoutRedraw:lineNr
+ "delete line - no redraw;
+ return true, if something was really deleted.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndexWithoutRedraw:lineNr
+!
+
+removeIndex:lineNr
+ "delete line - with redraw.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndex:lineNr
+!
+
+add:aValue beforeIndex:index
+ "must recompute our current selections"
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ selection := selection collect:[ :sel |
+ sel >= index ifTrue:[
+ sel + 1
+ ] ifFalse:[
+ sel
+ ]
+ ].
+ ] ifFalse:[
+ selection >= index ifTrue:[
+ selection := selection + 1.
+ ].
+ ].
+ ].
+ ^ super add:aValue beforeIndex:index.
! !
!SelectionInListView methodsFor:'initialization'!
@@ -1785,26 +2145,32 @@
cursor := Cursor hand
!
-realize
- super realize.
-
- selection notNil ifTrue:[
- self makeLineVisible:selection
- ].
- self getListFromModel.
- self getSelectionFromModel
-!
-
initialize
super initialize.
fontHeight := font height + lineSpacing.
enabled := true.
- multipleSelectOk := false.
ignoreReselect := true.
- toggleSelect := false.
- strikeOut := false.
+ multipleSelectOk := toggleSelect := strikeOut := printItems := false.
+ useIndex := true.
+
keyActionStyle := #select.
+ returnKeyActionStyle := #doubleClick.
+
+ listMsg := self class defaultListMessage.
+ initialSelectionMsg := self class defaultSelectionMessage.
+
+!
+
+realize
+ super realize.
+
+ self getListFromModel.
+ self getSelectionFromModel.
+
+ selection notNil ifTrue:[
+ self makeLineVisible:selection
+ ].
!
initStyle
@@ -1908,338 +2274,154 @@
hilightBgColor := hilightBgColor on:device.
! !
-!SelectionInListView methodsFor:'event handling'!
-
-buttonPress:button x:x y:y
- |oldSelection listLineNr|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- enabled ifTrue:[
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (toggleSelect
- and:[self isInSelection:listLineNr]) ifTrue:[
- oldSelection := selection copy.
- self removeFromSelection:listLineNr
- ] ifFalse:[
- (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
-
- (toggleSelect and:[multipleSelectOk]) ifTrue:[
- oldSelection := selection copy.
- self addToSelection:listLineNr
- ] ifFalse:[
- oldSelection := selection copy.
- self selectWithoutScroll:listLineNr.
- ].
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- self selectionChangedFrom:oldSelection.
- ].
- clickLine := listLineNr
- ].
- ]
- ] ifFalse:[
- super buttonPress:button x:x y:y
- ]
-!
-
-sizeChanged:how
- "if there is a selection, make certain, its visible
- after the sizechange"
-
- |first wasAtEnd|
-
- wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
-
- super sizeChanged:how.
-
- shown ifTrue:[
- selection notNil ifTrue:[
- selection isCollection ifTrue:[
- selection notEmpty ifTrue:[
- first := selection first
- ]
- ] ifFalse:[
- first := selection
- ].
- first notNil ifTrue:[self makeLineVisible:first]
- ] ifFalse:[
- "
- if we where at the end before, move to the end again.
- Still to be seen, if this is better in real life ...
- "
- wasAtEnd ifTrue:[
- "at end"
- self scrollToBottom
- ]
- ]
- ]
-!
-
-buttonRelease:button x:x y:y
- "stop any autoscroll"
-
- self stopAutoScroll
-!
-
-key:key select:selectAction x:x y:y
- "perform keyaction after a key-select"
-
- |oldSelection|
-
- keyActionStyle notNil ifTrue:[
- keyActionStyle == #pass ifTrue:[
- ^ super keyPress:key x:x y:y
- ].
- oldSelection := selection.
- selectAction value.
- self selectionChangedFrom:oldSelection.
- keyActionStyle == #selectAndDoubleClick ifTrue:[
- doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
- ]
- ].
-!
-
-keyPress:key x:x y:y
- "handle keyboard input"
-
- |index startSearch backSearch searchPrefix|
-
- (key == #CursorUp) ifTrue:[
- index := self previousBeforeSelection.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- (key == #CursorDown) ifTrue:[
- index := self nextAfterSelection.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- (key == #Home) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value:1]) ifTrue:[
- self key:key select:[self selection:1] x:x y:y
- ].
- ^ self
- ].
- (key == #End) ifTrue:[
- index := self size.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- key == #Return ifTrue:[
- selection notNil ifTrue:[
- doubleClickActionBlock notNil ifTrue:[
- doubleClickActionBlock value:selection
- ].
- ].
- ^ self
- ].
- "
- alphabetic keys: search for next entry
- starting with keys character. If shift is pressed, search backward
- "
- (self size > 0
- and:[key isCharacter
- and:[key isLetter]]) ifTrue:[
- keyActionStyle isNil ifTrue:[^ self].
- keyActionStyle == #pass ifFalse:[
- searchPrefix := key asLowercase asString.
-
-"/ ... isISearch... ifFalse:[
-"/ iSearchString := ''
-"/ ] ifTrue:[
-"/ iSearchString := iSearchString , searchPrefix.
-"/ 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:[self selection: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
-
-!
-
-buttonMultiPress:button x:x y:y
- ((button == 1) or:[button == #select]) ifTrue:[
- doubleClickActionBlock isNil ifTrue:[
- self buttonPress:button x:x y:y
- ] ifFalse:[
- doubleClickActionBlock value:selection
- ].
- (model notNil and:[doubleClickMsg notNil]) ifTrue:[
- self sendChangeMessage:doubleClickMsg with:(self argForChangeMessage).
- ]
- ] ifFalse:[
- super buttonMultiPress:button x:x y:y
- ]
-!
-
-buttonShiftPress:button x:x y:y
- "add to the selection (if multipleSelectOk); otherwise,
- behave like normal select"
-
- |oldSelection listLineNr|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- toggleSelect ifTrue:[
- ^ self buttonPress:button x:x y:y
- ].
- enabled ifTrue:[
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
- ].
- oldSelection := selection copy.
- listLineNr notNil ifTrue: [
- multipleSelectOk ifTrue:[
- (self isInSelection:listLineNr) ifTrue:[
- self removeFromSelection:listLineNr
- ] ifFalse:[
- self addToSelection:listLineNr
- ]
- ] ifFalse:[
- self selectWithoutScroll:listLineNr
- ]
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- self selectionChangedFrom:oldSelection.
- ].
- clickLine := listLineNr
- ]
- ] ifFalse:[
- super buttonShiftPress:button x:x y:y
- ]
-!
+!SelectionInListView methodsFor:'change & update'!
update:something with:aParameter from:changedObject
changedObject == model ifTrue:[
- something == aspectMsg 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
-!
-
-buttonMotion:buttonMask x:x y:y
- "mouse-move while button was pressed - handle selection changes"
-
- |movedVisibleLine movedLine delta oldSelection oldSelCount|
-
- "is it the select or 1-button ?"
- (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
- (device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
- ^ self
- ].
+! !
+
+!SelectionInListView methodsFor:'accessing-selection'!
+
+addToSelection:aNumber
+ "add entry, aNumber to the selection. No scrolling is done."
+
+ (self isValidSelection:aNumber) ifFalse:[^ self].
+
+ selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
+ selection isCollection ifTrue:[
+ (selection includes:aNumber) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection add:aNumber
+ ] ifFalse:[
+ (aNumber == selection) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection := OrderedCollection with:selection with:aNumber
].
-
- clickLine isNil ifTrue:[^ self].
-
- "if moved outside of view, start autoscroll"
- (y < 0) ifTrue:[
- self compressMotionEvents:false.
- self startAutoScrollUp:y.
- ^ self
+ self redrawElement:aNumber
+!
+
+addElementToSelection:anObject
+ "add the element with the same printstring as the argument, anObject
+ to the selection. The entry is searched by comparing printStrings.
+ No scrolling is done. Returns true, if ok, false if no such entry
+ was found."
+
+ |lineNo str|
+
+ str := anObject printString.
+ lineNo := list findFirst:[:entry | str = entry printString].
+ lineNo ~~ 0 ifTrue:[
+ self addToSelection:lineNo.
+ ^ true
].
- (y > height) ifTrue:[
- self compressMotionEvents:false.
- self startAutoScrollDown:(y - height).
- ^ self
- ].
-
- "move inside - stop autoscroll if any"
- self stopAutoScroll.
-
- movedVisibleLine := self visibleLineOfY:y.
- movedLine := self visibleLineToAbsoluteLine:movedVisibleLine.
- (movedLine == clickLine) ifTrue:[^ self].
+ ^ false
+!
+
+removeFromSelection:aNumber
+ "remove entry, aNumber from the selection."
+
+ selection isNil ifTrue:[^ self].
multipleSelectOk ifTrue:[
- delta := (clickLine < movedLine) ifTrue:[1] ifFalse:[-1].
-
- oldSelection := selection.
- oldSelCount := selection size.
-
- (clickLine+delta) to:movedLine by:delta do:[:line |
- (self isInSelection:line) ifTrue:[
- self removeFromSelection:line
- ] ifFalse:[
- self addToSelection:line
- ]
- ].
- ((selection ~= oldSelection)
- or:[selection size ~~ oldSelCount]) ifTrue:[
- self selectionChangedFrom:oldSelection.
+ (selection includes:aNumber) ifFalse:[^ self].
+ selection remove:aNumber.
+ selection size == 0 ifTrue:[
+ selection := nil
]
] ifFalse:[
-"/ self selectWithoutScroll:movedLine
+ (aNumber == selection) ifFalse:[^ self].
+ selection := nil
].
-
- clickLine := movedLine
+ self redrawElement:aNumber
! !
+
+!SelectionInListView methodsFor:'accessing-mvc'!
+
+on:aModel printItems:print oneItem:one aspect:aspectSymbol change:changeSymbol
+ list:listSymbol menu:menuSymbol initialSelection:initialSymbol useIndex:use
+
+ "ST-80 compatibility"
+
+ aspectMsg := aspectSymbol.
+ changeMsg := changeSymbol.
+ listMsg := listSymbol.
+ menuMsg := menuSymbol.
+ initialSelectionMsg := initialSymbol.
+ printItems := print.
+ oneItem := one.
+ useIndex := use.
+ ignoreReselect := false. "/ ST80 behavior
+ self model:aModel.
+!
+
+doubleClickMessage
+ "return the symbol with which the model (if any) is informed about
+ double-click. If nil (which is the default), it is not informed."
+
+ ^ doubleClickMsg
+!
+
+doubleClickMessage:aSymbol
+ "set the symbol with which the model (if any) is informed about double-click.
+ If nil (which is the default), it is not informed."
+
+ doubleClickMsg := aSymbol
+!
+
+doubleClick:aSymbol
+ "set the symbol with which the model is informed about double-click.
+ OBSOLETE: please use #doubleClickMessage:"
+
+ self obsoleteMethodWarning:'please use #doubleClickMessage:'.
+ doubleClickMsg := aSymbol
+!
+
+initialSelectionMessage
+ "return the symbol by which the model informes me about a changed
+ selectionIndex. This is used both in change notification and to
+ actually aquire a new selection value."
+
+ ^ initialSelectionMsg
+!
+
+initialSelectionMessage:aSymbol
+ "set the symbol by which the model informes me about a changed
+ selectionIndex. This is used both in change notification and to
+ actually aquire a new selection value."
+
+ initialSelectionMsg := aSymbol
+!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#doubleClickMessage put:doubleClickMsg.
+ aDictionary at:#initialSelectionMessage put:initialSelectionMsg.
+
+ "
+ SelectionInListView new modelInterface
+ "
+! !
+
--- a/ToggleC.st Mon May 08 17:19:27 1995 +0200
+++ b/ToggleC.st Tue May 09 03:57:16 1995 +0200
@@ -35,7 +35,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ToggleC.st,v 1.4 1995-05-03 16:30:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ToggleC.st,v 1.5 1995-05-09 01:56:56 claus Exp $
"
!
@@ -44,6 +44,12 @@
ToggleControllers redefine some of ButtonControllers behavior;
user interaction: they always triggerOnDown, and ignore buttonrelease.
Finally, every buttonPress leads to a toggle action.
+
+ ToggleController redefines the 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.
"
! !
@@ -58,11 +64,13 @@
performAction
action notNil ifTrue:[
+ active := true.
action numArgs == 0 ifTrue:[
action value
] ifFalse:[
action value:pressed
].
+ active := false.
].
super performAction
! !
@@ -75,4 +83,3 @@
action := aBlock
! !
-
--- a/ToggleController.st Mon May 08 17:19:27 1995 +0200
+++ b/ToggleController.st Tue May 09 03:57:16 1995 +0200
@@ -35,7 +35,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ToggleController.st,v 1.4 1995-05-03 16:30:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ToggleController.st,v 1.5 1995-05-09 01:56:56 claus Exp $
"
!
@@ -44,6 +44,12 @@
ToggleControllers redefine some of ButtonControllers behavior;
user interaction: they always triggerOnDown, and ignore buttonrelease.
Finally, every buttonPress leads to a toggle action.
+
+ ToggleController redefines the 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.
"
! !
@@ -58,11 +64,13 @@
performAction
action notNil ifTrue:[
+ active := true.
action numArgs == 0 ifTrue:[
action value
] ifFalse:[
action value:pressed
].
+ active := false.
].
super performAction
! !
@@ -75,4 +83,3 @@
action := aBlock
! !
-
--- a/VPanelV.st Mon May 08 17:19:27 1995 +0200
+++ b/VPanelV.st Tue May 09 03:57:16 1995 +0200
@@ -10,18 +10,20 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:07:08 pm'!
+
PanelView subclass:#VerticalPanelView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Layout'
!
VerticalPanelView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.8 1995-02-06 00:53:30 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.9 1995-05-09 01:57:00 claus Exp $
'!
!VerticalPanelView class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.8 1995-02-06 00:53:30 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.9 1995-05-09 01:57:00 claus Exp $
"
!
@@ -98,375 +100,256 @@
example: default layout (centered)
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: top-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: top-layout; horizontal fit
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p horizontalLayout:#fit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: top-layout; horizontal fit with space
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: topSpace-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#topSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#topSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: bottom-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#bottom.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#bottom.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: bottomSpace-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#bottomSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#bottomSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: spread-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#spread.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#spread.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: spreadSpace-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#spreadSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#spreadSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: fit-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#fit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: fitSpace-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: fully fitSpace
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#fitSpace.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fitSpace.
+ p horizontalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: from top, each at left:
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p horizontalLayout:#left.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#left.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: centered, right:
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#centered.
- p horizontalLayout:#right.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#centered.
+ p horizontalLayout:#right.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: a panel in a panel
- |v hp p b1 b2 b3|
-
- v := StandardSystemView new.
-
- hp := HorizontalPanelView in:v.
- hp verticalLayout:#fit.
- hp horizontalLayout:#fitSpace.
- hp origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ |v hp p b1 b2 b3|
- 1 to:3 do:[:i |
- p := VerticalPanelView in:hp.
- p borderWidth:0.
- p verticalLayout:#fitSpace.
- p horizontalLayout:#fit.
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- ].
-
- v extent:300 @ 100.
- v open
-"
-! !
-
-!VerticalPanelView methodsFor:'accessing'!
+ v := StandardSystemView new.
-horizontalLayout
- "return the horizontal layout as symbol.
- the returned value is one of
- #left
- #leftSpace
- #center
- #right
- #rightSpace
- #fit
- the default is #centered
- "
-
- ^ hLayout
-!
-
-verticalLayout
- "return the vertical layout as a symbol.
- the returned value is one of
- #top
- #topSpace
- #spread
- #fit
- #center
- #bottom
- #bottomSpace
- the default is #centered
- "
-
- ^ vLayout
-!
-
-horizontalLayout:aSymbol
- "change the horizontal layout as symbol.
- The argument, aSymbol must be one of:
- #left
- #leftSpace
- #center
- #right
- #rightSpace
- #fit
- the default (if never changed) is #centered
- "
-
- (hLayout ~~ aSymbol) ifTrue:[
- hLayout := aSymbol.
- self layoutChanged
- ]
-!
+ hp := HorizontalPanelView in:v.
+ hp verticalLayout:#fit.
+ hp horizontalLayout:#fitSpace.
+ hp origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
-verticalLayout:aSymbol
- "change the vertical layout as a symbol.
- The argument, aSymbol must be one of:
- #top
- #topSpace
- #spread
- #fit
- #center
- #bottom
- #bottomSpace
- the default (if never changed) is #centered
- "
-
- (vLayout ~~ aSymbol) ifTrue:[
- vLayout := aSymbol.
- self layoutChanged
- ]
-!
+ 1 to:3 do:[:i |
+ p := VerticalPanelView in:hp.
+ p borderWidth:0.
+ p verticalLayout:#fitSpace.
+ p horizontalLayout:#fit.
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ ].
-layout
- "leftover for historic reasons - do not use any more"
-
- self verticalLayout
-!
-
-layout:aSymbol
- "leftover for historic reasons - do not use any more"
-
- self verticalLayout:aSymbol
-! !
-
-
-!VerticalPanelView methodsFor:'queries'!
-
-preferedExtent
- "return a good extent, one that makes subviews fit"
-
- |sumOfHeights maxWidth maxHeight|
+ v extent:300 @ 100.
+ v open
- subViews isNil ifTrue:[^ horizontalSpace @ verticalSpace].
-
- "compute net height needed"
-
- sumOfHeights := 0.
- maxWidth := 0.
- maxHeight := 0.
+ example: checkToggles in a panel
- subViews do:[:child |
- |childsPreference|
+ |panel|
- childsPreference := child preferedExtent.
- sumOfHeights := sumOfHeights + childsPreference y.
- maxHeight := maxHeight max:childsPreference y.
- maxWidth := maxWidth max:childsPreference x.
+ panel := VerticalPanelView new.
+ panel horizontalLayout:#left.
-"/ sumOfHeights := sumOfHeights + child heightIncludingBorder.
-"/ maxWidth := maxWidth max:(child widthIncludingBorder).
-"/ maxHeight := maxHeight max:(child heightIncludingBorder).
- ].
- borderWidth ~~ 0 ifTrue:[
- sumOfHeights := sumOfHeights + (horizontalSpace * 2).
- maxWidth := maxWidth + (horizontalSpace * 2).
- ].
- (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
- sumOfHeights := maxHeight * subViews size.
- borderWidth ~~ 0 ifTrue:[
- sumOfHeights := sumOfHeights + (verticalSpace * 2).
- ]
- ] ifFalse:[
- sumOfHeights := sumOfHeights + ((subViews size - 1) * verticalSpace).
- ].
+ panel add:((CheckBox on:true asValue) label:'this is toggle number 1'; resize).
+ panel add:((CheckBox on:false asValue) label:'nr 2 '; resize).
+ panel add:((CheckBox on:true asValue) label:'number 3 '; resize).
- ((hLayout == #leftSpace) or:[hLayout == #rightSpace]) ifTrue:[
- maxWidth := maxWidth + horizontalSpace
- ] ifFalse:[
- ((hLayout == #fitSpace) or:[hLayout == #center]) ifTrue:[
- maxWidth := maxWidth + (horizontalSpace * 2)
- ]
- ].
- ^ maxWidth @ sumOfHeights
+ panel extent:(panel preferedExtent).
+ panel open
+"
! !
!VerticalPanelView methodsFor:'layout'!
@@ -583,7 +466,10 @@
now set positions
"
subViews do:[:child |
- |xpos|
+ |xpos bwChild wChild|
+
+ wChild := child widthIncludingBorder.
+ bwChild := child borderWidth.
hLayout == #left ifTrue:[
xpos := 0
@@ -592,21 +478,21 @@
xpos := horizontalSpace
] ifFalse:[
hLayout == #right ifTrue:[
- xpos := width - child widthIncludingBorder
+ xpos := width - wChild
] ifFalse:[
hLayout == #rightSpace ifTrue:[
- xpos := width - horizontalSpace - child widthIncludingBorder.
+ xpos := width - horizontalSpace - wChild.
] ifFalse:[
hLayout == #fitSpace ifTrue:[
xpos := horizontalSpace.
- child width:(width - (horizontalSpace + child borderWidth * 2))
+ child width:(width - (horizontalSpace + bwChild * 2))
] ifFalse:[
hLayout == #fit ifTrue:[
xpos := 0.
- child width:(width - (child borderWidth * 2))
+ child width:(width - (bwChild * 2))
] ifFalse:[
"centered"
- xpos := (width - child widthIncludingBorder) // 2.
+ xpos := (width - wChild) // 2.
]
]
]
@@ -618,7 +504,7 @@
(vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
child origin:(xpos @ ypos rounded)
corner:(xpos + (child width))
- @ (ypos + hEach - (child borderWidth)) rounded.
+ @ (ypos + hEach - bwChild) rounded.
ypos := ypos + hEach + space
] ifFalse:[
child origin:(xpos@ypos).
@@ -626,3 +512,136 @@
]
]
! !
+
+!VerticalPanelView methodsFor:'accessing'!
+
+horizontalLayout
+ "return the horizontal layout as symbol.
+ the returned value is one of
+ #left
+ #leftSpace
+ #center
+ #right
+ #rightSpace
+ #fit
+ the default is #centered
+ "
+
+ ^ hLayout
+!
+
+horizontalLayout:aSymbol
+ "change the horizontal layout as symbol.
+ The argument, aSymbol must be one of:
+ #left
+ #leftSpace
+ #center
+ #right
+ #rightSpace
+ #fit
+ the default (if never changed) is #centered
+ "
+
+ (hLayout ~~ aSymbol) ifTrue:[
+ hLayout := aSymbol.
+ self layoutChanged
+ ]
+!
+
+verticalLayout
+ "return the vertical layout as a symbol.
+ the returned value is one of
+ #top
+ #topSpace
+ #spread
+ #fit
+ #center
+ #bottom
+ #bottomSpace
+ the default is #centered
+ "
+
+ ^ vLayout
+!
+
+verticalLayout:aSymbol
+ "change the vertical layout as a symbol.
+ The argument, aSymbol must be one of:
+ #top
+ #topSpace
+ #spread
+ #fit
+ #center
+ #bottom
+ #bottomSpace
+ the default (if never changed) is #centered
+ "
+
+ (vLayout ~~ aSymbol) ifTrue:[
+ vLayout := aSymbol.
+ self layoutChanged
+ ]
+!
+
+layout:aSymbol
+ "leftover for historic reasons - do not use any more"
+
+ self verticalLayout:aSymbol
+!
+
+layout
+ "leftover for historic reasons - do not use any more"
+
+ self verticalLayout
+! !
+
+!VerticalPanelView methodsFor:'queries'!
+
+preferedExtent
+ "return a good extent, one that makes subviews fit"
+
+ |sumOfHeights maxWidth maxHeight|
+
+ subViews isNil ifTrue:[^ horizontalSpace @ verticalSpace].
+
+ "compute net height needed"
+
+ sumOfHeights := 0.
+ maxWidth := 0.
+ maxHeight := 0.
+
+ subViews do:[:child |
+ |childsPreference|
+
+ childsPreference := child preferedExtent.
+ sumOfHeights := sumOfHeights + childsPreference y.
+ maxHeight := maxHeight max:childsPreference y.
+ maxWidth := maxWidth max:childsPreference x.
+
+"/ sumOfHeights := sumOfHeights + child heightIncludingBorder.
+"/ maxWidth := maxWidth max:(child widthIncludingBorder).
+"/ maxHeight := maxHeight max:(child heightIncludingBorder).
+ ].
+ borderWidth ~~ 0 ifTrue:[
+ sumOfHeights := sumOfHeights + (horizontalSpace * 2).
+ maxWidth := maxWidth + (horizontalSpace * 2).
+ ].
+ (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
+ sumOfHeights := maxHeight * subViews size.
+ borderWidth ~~ 0 ifTrue:[
+ sumOfHeights := sumOfHeights + (verticalSpace * 2).
+ ]
+ ] ifFalse:[
+ sumOfHeights := sumOfHeights + ((subViews size - 1) * verticalSpace).
+ ].
+
+ ((hLayout == #leftSpace) or:[hLayout == #rightSpace]) ifTrue:[
+ maxWidth := maxWidth + horizontalSpace
+ ] ifFalse:[
+ ((hLayout == #fitSpace) or:[hLayout == #center]) ifTrue:[
+ maxWidth := maxWidth + (horizontalSpace * 2)
+ ]
+ ].
+ ^ maxWidth @ sumOfHeights
+! !
+
--- a/VerticalPanelView.st Mon May 08 17:19:27 1995 +0200
+++ b/VerticalPanelView.st Tue May 09 03:57:16 1995 +0200
@@ -10,18 +10,20 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:07:08 pm'!
+
PanelView subclass:#VerticalPanelView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Layout'
!
VerticalPanelView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.8 1995-02-06 00:53:30 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.9 1995-05-09 01:57:00 claus Exp $
'!
!VerticalPanelView class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.8 1995-02-06 00:53:30 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.9 1995-05-09 01:57:00 claus Exp $
"
!
@@ -98,375 +100,256 @@
example: default layout (centered)
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: top-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: top-layout; horizontal fit
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p horizontalLayout:#fit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: top-layout; horizontal fit with space
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: topSpace-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#topSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#topSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: bottom-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#bottom.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#bottom.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: bottomSpace-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#bottomSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#bottomSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: spread-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#spread.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#spread.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: spreadSpace-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#spreadSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#spreadSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: fit-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#fit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: fitSpace-layout
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: fully fitSpace
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#fitSpace.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fitSpace.
+ p horizontalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: from top, each at left:
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p horizontalLayout:#left.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#left.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: centered, right:
- |v p b1 b2 b3|
+ |v p b1 b2 b3|
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- p verticalLayout:#centered.
- p horizontalLayout:#right.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#centered.
+ p horizontalLayout:#right.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
example: a panel in a panel
- |v hp p b1 b2 b3|
-
- v := StandardSystemView new.
-
- hp := HorizontalPanelView in:v.
- hp verticalLayout:#fit.
- hp horizontalLayout:#fitSpace.
- hp origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ |v hp p b1 b2 b3|
- 1 to:3 do:[:i |
- p := VerticalPanelView in:hp.
- p borderWidth:0.
- p verticalLayout:#fitSpace.
- p horizontalLayout:#fit.
- b1 := Button label:'button1' in:p.
- b2 := Button label:'button2' in:p.
- b3 := Button label:'button3' in:p.
- ].
-
- v extent:300 @ 100.
- v open
-"
-! !
-
-!VerticalPanelView methodsFor:'accessing'!
+ v := StandardSystemView new.
-horizontalLayout
- "return the horizontal layout as symbol.
- the returned value is one of
- #left
- #leftSpace
- #center
- #right
- #rightSpace
- #fit
- the default is #centered
- "
-
- ^ hLayout
-!
-
-verticalLayout
- "return the vertical layout as a symbol.
- the returned value is one of
- #top
- #topSpace
- #spread
- #fit
- #center
- #bottom
- #bottomSpace
- the default is #centered
- "
-
- ^ vLayout
-!
-
-horizontalLayout:aSymbol
- "change the horizontal layout as symbol.
- The argument, aSymbol must be one of:
- #left
- #leftSpace
- #center
- #right
- #rightSpace
- #fit
- the default (if never changed) is #centered
- "
-
- (hLayout ~~ aSymbol) ifTrue:[
- hLayout := aSymbol.
- self layoutChanged
- ]
-!
+ hp := HorizontalPanelView in:v.
+ hp verticalLayout:#fit.
+ hp horizontalLayout:#fitSpace.
+ hp origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
-verticalLayout:aSymbol
- "change the vertical layout as a symbol.
- The argument, aSymbol must be one of:
- #top
- #topSpace
- #spread
- #fit
- #center
- #bottom
- #bottomSpace
- the default (if never changed) is #centered
- "
-
- (vLayout ~~ aSymbol) ifTrue:[
- vLayout := aSymbol.
- self layoutChanged
- ]
-!
+ 1 to:3 do:[:i |
+ p := VerticalPanelView in:hp.
+ p borderWidth:0.
+ p verticalLayout:#fitSpace.
+ p horizontalLayout:#fit.
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ ].
-layout
- "leftover for historic reasons - do not use any more"
-
- self verticalLayout
-!
-
-layout:aSymbol
- "leftover for historic reasons - do not use any more"
-
- self verticalLayout:aSymbol
-! !
-
-
-!VerticalPanelView methodsFor:'queries'!
-
-preferedExtent
- "return a good extent, one that makes subviews fit"
-
- |sumOfHeights maxWidth maxHeight|
+ v extent:300 @ 100.
+ v open
- subViews isNil ifTrue:[^ horizontalSpace @ verticalSpace].
-
- "compute net height needed"
-
- sumOfHeights := 0.
- maxWidth := 0.
- maxHeight := 0.
+ example: checkToggles in a panel
- subViews do:[:child |
- |childsPreference|
+ |panel|
- childsPreference := child preferedExtent.
- sumOfHeights := sumOfHeights + childsPreference y.
- maxHeight := maxHeight max:childsPreference y.
- maxWidth := maxWidth max:childsPreference x.
+ panel := VerticalPanelView new.
+ panel horizontalLayout:#left.
-"/ sumOfHeights := sumOfHeights + child heightIncludingBorder.
-"/ maxWidth := maxWidth max:(child widthIncludingBorder).
-"/ maxHeight := maxHeight max:(child heightIncludingBorder).
- ].
- borderWidth ~~ 0 ifTrue:[
- sumOfHeights := sumOfHeights + (horizontalSpace * 2).
- maxWidth := maxWidth + (horizontalSpace * 2).
- ].
- (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
- sumOfHeights := maxHeight * subViews size.
- borderWidth ~~ 0 ifTrue:[
- sumOfHeights := sumOfHeights + (verticalSpace * 2).
- ]
- ] ifFalse:[
- sumOfHeights := sumOfHeights + ((subViews size - 1) * verticalSpace).
- ].
+ panel add:((CheckBox on:true asValue) label:'this is toggle number 1'; resize).
+ panel add:((CheckBox on:false asValue) label:'nr 2 '; resize).
+ panel add:((CheckBox on:true asValue) label:'number 3 '; resize).
- ((hLayout == #leftSpace) or:[hLayout == #rightSpace]) ifTrue:[
- maxWidth := maxWidth + horizontalSpace
- ] ifFalse:[
- ((hLayout == #fitSpace) or:[hLayout == #center]) ifTrue:[
- maxWidth := maxWidth + (horizontalSpace * 2)
- ]
- ].
- ^ maxWidth @ sumOfHeights
+ panel extent:(panel preferedExtent).
+ panel open
+"
! !
!VerticalPanelView methodsFor:'layout'!
@@ -583,7 +466,10 @@
now set positions
"
subViews do:[:child |
- |xpos|
+ |xpos bwChild wChild|
+
+ wChild := child widthIncludingBorder.
+ bwChild := child borderWidth.
hLayout == #left ifTrue:[
xpos := 0
@@ -592,21 +478,21 @@
xpos := horizontalSpace
] ifFalse:[
hLayout == #right ifTrue:[
- xpos := width - child widthIncludingBorder
+ xpos := width - wChild
] ifFalse:[
hLayout == #rightSpace ifTrue:[
- xpos := width - horizontalSpace - child widthIncludingBorder.
+ xpos := width - horizontalSpace - wChild.
] ifFalse:[
hLayout == #fitSpace ifTrue:[
xpos := horizontalSpace.
- child width:(width - (horizontalSpace + child borderWidth * 2))
+ child width:(width - (horizontalSpace + bwChild * 2))
] ifFalse:[
hLayout == #fit ifTrue:[
xpos := 0.
- child width:(width - (child borderWidth * 2))
+ child width:(width - (bwChild * 2))
] ifFalse:[
"centered"
- xpos := (width - child widthIncludingBorder) // 2.
+ xpos := (width - wChild) // 2.
]
]
]
@@ -618,7 +504,7 @@
(vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
child origin:(xpos @ ypos rounded)
corner:(xpos + (child width))
- @ (ypos + hEach - (child borderWidth)) rounded.
+ @ (ypos + hEach - bwChild) rounded.
ypos := ypos + hEach + space
] ifFalse:[
child origin:(xpos@ypos).
@@ -626,3 +512,136 @@
]
]
! !
+
+!VerticalPanelView methodsFor:'accessing'!
+
+horizontalLayout
+ "return the horizontal layout as symbol.
+ the returned value is one of
+ #left
+ #leftSpace
+ #center
+ #right
+ #rightSpace
+ #fit
+ the default is #centered
+ "
+
+ ^ hLayout
+!
+
+horizontalLayout:aSymbol
+ "change the horizontal layout as symbol.
+ The argument, aSymbol must be one of:
+ #left
+ #leftSpace
+ #center
+ #right
+ #rightSpace
+ #fit
+ the default (if never changed) is #centered
+ "
+
+ (hLayout ~~ aSymbol) ifTrue:[
+ hLayout := aSymbol.
+ self layoutChanged
+ ]
+!
+
+verticalLayout
+ "return the vertical layout as a symbol.
+ the returned value is one of
+ #top
+ #topSpace
+ #spread
+ #fit
+ #center
+ #bottom
+ #bottomSpace
+ the default is #centered
+ "
+
+ ^ vLayout
+!
+
+verticalLayout:aSymbol
+ "change the vertical layout as a symbol.
+ The argument, aSymbol must be one of:
+ #top
+ #topSpace
+ #spread
+ #fit
+ #center
+ #bottom
+ #bottomSpace
+ the default (if never changed) is #centered
+ "
+
+ (vLayout ~~ aSymbol) ifTrue:[
+ vLayout := aSymbol.
+ self layoutChanged
+ ]
+!
+
+layout:aSymbol
+ "leftover for historic reasons - do not use any more"
+
+ self verticalLayout:aSymbol
+!
+
+layout
+ "leftover for historic reasons - do not use any more"
+
+ self verticalLayout
+! !
+
+!VerticalPanelView methodsFor:'queries'!
+
+preferedExtent
+ "return a good extent, one that makes subviews fit"
+
+ |sumOfHeights maxWidth maxHeight|
+
+ subViews isNil ifTrue:[^ horizontalSpace @ verticalSpace].
+
+ "compute net height needed"
+
+ sumOfHeights := 0.
+ maxWidth := 0.
+ maxHeight := 0.
+
+ subViews do:[:child |
+ |childsPreference|
+
+ childsPreference := child preferedExtent.
+ sumOfHeights := sumOfHeights + childsPreference y.
+ maxHeight := maxHeight max:childsPreference y.
+ maxWidth := maxWidth max:childsPreference x.
+
+"/ sumOfHeights := sumOfHeights + child heightIncludingBorder.
+"/ maxWidth := maxWidth max:(child widthIncludingBorder).
+"/ maxHeight := maxHeight max:(child heightIncludingBorder).
+ ].
+ borderWidth ~~ 0 ifTrue:[
+ sumOfHeights := sumOfHeights + (horizontalSpace * 2).
+ maxWidth := maxWidth + (horizontalSpace * 2).
+ ].
+ (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
+ sumOfHeights := maxHeight * subViews size.
+ borderWidth ~~ 0 ifTrue:[
+ sumOfHeights := sumOfHeights + (verticalSpace * 2).
+ ]
+ ] ifFalse:[
+ sumOfHeights := sumOfHeights + ((subViews size - 1) * verticalSpace).
+ ].
+
+ ((hLayout == #leftSpace) or:[hLayout == #rightSpace]) ifTrue:[
+ maxWidth := maxWidth + horizontalSpace
+ ] ifFalse:[
+ ((hLayout == #fitSpace) or:[hLayout == #center]) ifTrue:[
+ maxWidth := maxWidth + (horizontalSpace * 2)
+ ]
+ ].
+ ^ maxWidth @ sumOfHeights
+! !
+
--- a/Workspace.st Mon May 08 17:19:27 1995 +0200
+++ b/Workspace.st Tue May 09 03:57:16 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.21 1995-05-07 01:58:55 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.22 1995-05-09 01:57:12 claus Exp $
'!
!Workspace class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.21 1995-05-07 01:58:55 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.22 1995-05-09 01:57:12 claus Exp $
"
!
@@ -53,14 +53,15 @@
a view for editable text which can evaluate expressions.
I.e. its basically a view for editable text, with added
'doIt', 'printIt' and 'inspectIt' functions on the popup-menu.
+
The action to be performed on doIt is defined by a block,
which can be defined by the owner of this view.
(thus you can put a workspace into more complex widgets, and
control what should happen on 'doIt').
A useful default action is setup, which simply evaluates the
- selection as a smalltalk expression. (but, a lisp or prolog
- view could define its own action ...)
+ selection as a smalltalk expression.
+ (but, a lisp or prolog view could define its own action ...)
Caveat:
--- a/YesNoBox.st Mon May 08 17:19:27 1995 +0200
+++ b/YesNoBox.st Tue May 09 03:57:16 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.14 1995-05-03 00:39:01 claus Exp $
+$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.15 1995-05-09 01:57:16 claus Exp $
'!
!YesNoBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.14 1995-05-03 00:39:01 claus Exp $
+$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.15 1995-05-09 01:57:16 claus Exp $
"
!
@@ -72,6 +72,9 @@
Use is:
self confirm:'some question'
and will return true or false.
+
+ For compatibility with ST-80, use:
+ Dialog confirm:'hello'
"
!
@@ -124,6 +127,14 @@
] ifFalse:[
Transcript showCr:'no'
]
+
+ or:
+
+ (Dialog confirm:'yes or no:') ifTrue:[
+ Transcript showCr:'yes'
+ ] ifFalse:[
+ Transcript showCr:'no'
+ ]
"
! !
@@ -168,7 +179,7 @@
textLabel label:'please Confirm'.
okButton label:(resources at:'yes').
- noButton := Button new.
+ noButton := Button abortButton.
buttonPanel addSubView:noButton before:okButton.
noButton label:(resources at:'no').
noButton height:(okButton height).