.
--- a/Button.st Sun Apr 30 15:40:03 1995 +0200
+++ b/Button.st Wed May 03 02:30:14 1995 +0200
@@ -39,7 +39,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.19 1995-03-31 03:01:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.20 1995-05-03 00:28:40 claus Exp $
'!
!Button class methodsFor:'documentation'!
@@ -60,7 +60,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.19 1995-03-31 03:01:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.20 1995-05-03 00:28:40 claus Exp $
"
!
@@ -77,13 +77,17 @@
#pressAction or #releaseAction messages.
Model-View interaction:
- buttons with a model and an aspectSymbol react to changes of this
- aspect, and perform this message on the model to aquire a new labelString.
+ buttons with a model and a labelMsg react to changes of the aspect
+ and perform a labelMsg-message on the model to aquire a new labelString.
The model is should send 'self changed:<aspect>' if it wants the label to
- change and return a string from the <aspect> message.
- If the changeSymbol is non-nil, the button sends a <change> to the model
- when pressed. If the changeSymbol is for a one-argument message, the current
+ change and return a string from the labelSymbol-message.
+ By default, the labelMsg is nil, therefore no update of the label is done.
+ (this behavior is inherited from label, see documentation there)
+
+ When pressed, the button sends a <change> message to the model.
+ If the changeMsg is for a one-argument message, the current
press-state is passed as argument (i.e. true if pressed, false if released).
+ By default, the change-Message is #value: (for ST-80 compatibility).
button model:aModel.
button aspect:aspectSymbol.
@@ -95,6 +99,10 @@
button changes state:
---> button sends changeSymbolSymbol / changeSymbol:state
+ By default (as inherited), the labelMsg is nil; therefore, buttons
+ do not try to aquire a new labelString from the model.
+ If you want this behavior, you must set labelMsg and aspectMsg
+ as appropriate.
Instance variables:
@@ -158,11 +166,12 @@
for buttons with a string-label,
and:
- b := Button form:someImage in:aView.
+ b := Button label:someImage in:aView.
b action:[ .. things to do, when pressed ... ]
for buttons with a bitmap label.
+
Although you can specify a lot in a button,
use the default in most applications.
As you specify more things in your program,
@@ -179,7 +188,7 @@
top := StandardSystemView new.
top extent:100@100.
- b := Button in:top
+ b := Button in:top.
b label:'hello'.
b action:[Transcript flash].
top open.
@@ -234,7 +243,7 @@
top extent:100@100.
b := Button in:top.
- b form:(Image fromFile:'bitmaps/SBrowser.xbm').
+ b label:(Image fromFile:'bitmaps/SBrowser.xbm').
b action:[Transcript flash].
b enteredForegroundColor:(Color green darkened).
b enteredBackgroundColor:(b backgroundColor).
@@ -243,7 +252,7 @@
top open.
- changing the image:
+ changing the image when pressed:
|top b|
@@ -264,7 +273,7 @@
well, even that is possible (but you should NEVER do it):
(notice the changing size and the resulting problem when
pressed near the bottom, since the button thinks the pointer
- leaves the view and changes back ...)
+ leaves the view and changes back and forth ...)
|top b|
@@ -360,7 +369,83 @@
(reading, lightning & darkening of images is a bit slow)
- Model-View interaction:
+ ST/X Buttons allow simulation of the ST-80 MVC way of interacting.
+ To do so, instead (or in addition) to defining actionBlocks, set the
+ buttons model to have this be informed instead (in addition):
+
+ Model-View interaction (ST-80 style):
+ (have a look at the models values in the inspector, as the toggles change)
+
+ |bool1 bool2 b panel top|
+
+ bool1 := ValueHolder newBoolean.
+ bool2 := ValueHolder newBoolean value:true.
+
+ top := StandardSystemView new.
+ top extent:200@100.
+
+ panel := HorizontalPanelView
+ origin:0.0 @ 0.0 corner:1.0 @ 50 in:top.
+
+ b := Toggle label:'eat me' in:panel.
+ b model:bool1.
+
+ b := Toggle label:'drink me' in:panel.
+ b model:bool2.
+
+ top open.
+ bool1 inspect.
+ bool2 inspect.
+
+ Using a PluggableAdaptor (ST-80 style):
+ (notice, that this is almost what ST/X buttons did originally,
+ therefore, you may use actionBlocks right away ...)
+
+ |adaptor1 adaptor2 b panel top|
+
+ adaptor1 := PluggableAdaptor new
+ getBlock:[:m | true]
+ putBlock:[:m :v | Transcript show:'eat: '; showCr:v]
+ updateBlock:nil.
+ adaptor2 := PluggableAdaptor new
+ getBlock:[:m | true]
+ putBlock:[:m :v | Transcript show:'drink: '; showCr:v]
+ updateBlock:nil.
+
+ top := StandardSystemView new.
+ top extent:200@100.
+
+ panel := HorizontalPanelView
+ origin:0.0 @ 0.0 corner:1.0 @ 50 in:top.
+
+ b := Toggle label:'eat me' in:panel.
+ b model:adaptor1.
+
+ b := Toggle label:'drink me' in:panel.
+ b model:adaptor2.
+
+ top open.
+
+
+ as a reminder, the corresponding ST/X setup is:
+
+ |b panel top|
+
+ top := StandardSystemView new.
+ top extent:200@100.
+
+ panel := HorizontalPanelView
+ origin:0.0 @ 0.0 corner:1.0 @ 50 in:top.
+
+ b := Toggle label:'eat me' in:panel.
+ b action:[:v | Transcript show:'eat: '; showCr:v].
+
+ b := Toggle label:'drink me' in:panel.
+ b action:[:v | Transcript show:'drink: '; showCr:v].
+
+ top open.
+
+
(using a plug to simulate a model ...)
|myModel b panel top|
@@ -384,7 +469,7 @@
b model:myModel; change:#shrink.
top open.
-
+
see 'doc/coding-examples' and 'doc/misc/quick_view_intro.doc'
for more variations on this theme.
@@ -393,6 +478,17 @@
!Button class methodsFor:'defaults'!
+XXdefaultAspectSymbol
+ "in contrast to labels, by default, Buttons do not react on changes
+ in the model (i.e. the buttons label stays constant).
+ However, if you set the aspectSymbol, it will ...
+ This has been done since most buttons have a constant label and therefore
+ there is no need to define a corresponding method in the model for return
+ of a label string"
+
+ ^ nil
+!
+
updateStyleCache
|defaultLevel|
@@ -538,31 +634,65 @@
^ ((self in:aView) form:aForm) action:aBlock
!
-okButtonIn:aView
+okButton
"since ok-buttons are very common, here is a convenient
method to create one ..."
|aButton|
- aButton := Button
- label:(self classResources at:'ok')
- in:aView.
+ aButton := Button label:(self classResources at:'ok').
aButton cursor:(Cursor thumbsUp).
aButton isReturnButton:true.
^ aButton
!
+abortButton
+ "since abort-buttons are very common, here is a convenient
+ method to create one ..."
+
+ |aButton|
+
+ aButton := Button label:(self classResources at:'abort').
+ aButton cursor:(Cursor thumbsDown).
+ ^ aButton
+!
+
+okButtonIn:aView
+ "since ok-buttons are very common, here is a convenient
+ method to create one ..."
+
+ |b|
+
+ aView addSubView:(b := self okButton).
+ ^ b
+!
+
abortButtonIn:aView
"since abort-buttons are very common, here is a convenient
method to create one ..."
- |aButton|
+ |b|
+
+ aView addSubView:(b := self abortButton).
+ ^ b
+!
+
+toggle
+ "ST-80 compatibility: create & return a new toggle."
+
+ ^ Toggle new
- aButton := Button
- label:(self classResources at:'abort')
- in:aView.
- aButton cursor:(Cursor thumbsDown).
- ^ aButton
+ "
+ Button toggle label:'press me';
+ model:((PluggableAdaptor on:(Point new))
+ getSelector:#x putSelector:#x:)
+ "
+ "this is the same as"
+ "
+ Toggle new label:'press me';
+ model:((PluggableAdaptor on:(Point new))
+ getSelector:#x putSelector:#x:)
+ "
! !
!Button methodsFor:'initialization'!
@@ -711,6 +841,7 @@
realize
super realize.
+
controller active:false.
controller entered:false.
@@ -762,52 +893,6 @@
]
!
-disable
- "disable the button"
-
- controller disable.
-!
-
-enable
- "enable the button"
-
- controller enable
-!
-
-turnOffWithoutRedraw
- "turn the button off - no redraw"
-
- controller pressed:false.
- controller active:false.
-
- "do not use super level:offLevel
- - because that one does redraw the edges.
- Sure, this is no good coding style"
- level := offLevel.
- margin := level abs
-!
-
-turnOff
- "turn the button off (if not already off)"
-
- controller pressed ifTrue:[
- controller active:false.
- controller pressed:false.
- self level:offLevel.
- self redraw
- ]
-!
-
-turnOn
- "turn the button on (if not already on)"
-
- controller pressed ifFalse:[
- controller pressed:true.
- self level:onLevel.
- self redraw
- ]
-!
-
pressAction
"return the pressAction; thats the block which gets evaluated
when the button is pressed (if non-nil)"
@@ -978,6 +1063,81 @@
enteredBgColor := aColor
! !
+!Button methodsFor:'changing state'!
+
+disable
+ "disable the button"
+
+ controller disable.
+!
+
+enable
+ "enable the button"
+
+ controller enable
+!
+
+turnOffWithoutRedraw
+ "turn the button off - no redraw"
+
+ controller pressed:false.
+ controller active:false.
+
+ "do not use super level:offLevel
+ - because that one does redraw the edges.
+ Sure, this is no good coding style"
+ level := offLevel.
+ margin := level abs
+!
+
+turnOff
+ "turn the button off (if not already off)"
+
+ controller pressed ifTrue:[
+ self turnOffWithoutRedraw.
+"/ controller active:false.
+"/ controller pressed:false.
+"/ self level:offLevel.
+ self redraw
+ ]
+!
+
+turnOnWithoutRedraw
+ "turn the button on - no redraw"
+
+ controller pressed:true.
+
+ "do not use super level:offLevel
+ - because that one does redraw the edges.
+ Sure, this is no good coding style"
+ level := onLevel.
+ margin := level abs
+!
+
+turnOn
+ "turn the button on (if not already on)"
+
+ controller pressed ifFalse:[
+ self turnOnWithoutRedraw.
+"/ controller pressed:true.
+"/ self level:onLevel.
+ self redraw
+ ]
+!
+
+toggleNoAction
+ "toggle, but do NOT perform any action - can be used to change a toggle
+ under program control (i.e. turn one toggle off from another one)"
+
+ controller toggleNoAction
+!
+
+toggle
+ "toggle and perform the action"
+
+ controller toggle
+! !
+
!Button methodsFor:'queries'!
preferedExtent
@@ -1156,7 +1316,7 @@
!
showActive
- "redraw myself as active"
+ "redraw myself as active (i.e. busy)"
onLevel ~~ level ifTrue:[
self level:onLevel.
--- a/ButtonC.st Sun Apr 30 15:40:03 1995 +0200
+++ b/ButtonC.st Wed May 03 02:30:14 1995 +0200
@@ -11,9 +11,9 @@
"
Controller subclass:#ButtonController
- instanceVariableNames:'enabled pressed active entered triggerOnDown autoRepeat
+ instanceVariableNames:'enabled pressed active entered isTriggerOnDown autoRepeat
repeatBlock initialDelay repeatDelay
- pressActionBlock releaseActionBlock'
+ pressActionBlock releaseActionBlock isToggle'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -37,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ButtonC.st,v 1.5 1995-03-06 19:27:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ButtonC.st,v 1.6 1995-05-03 00:28:46 claus Exp $
"
!
@@ -52,7 +52,7 @@
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
- triggerOnDown <Boolean> controls if the action should be executed on
+ isTriggerOnDown <Boolean> controls if the action should be executed on
press or on release (default: on release).
pressActionBlock <Block> block to evaluate when pressed (default: noop)
releaseActionBlock <Block> block to evaluate when released (default: noop)
@@ -92,21 +92,29 @@
autoRepeat := false.
initialDelay := self class defaultInitialDelay.
repeatDelay := self class defaultRepeatDelay.
- triggerOnDown := false.
+ isTriggerOnDown := false.
+ isToggle := false.
! !
!ButtonController methodsFor:'accessing'!
+beToggle
+ "make the receiver act like a toggle"
+
+ isTriggerOnDown := true.
+ isToggle := true
+!
+
beTriggerOnUp
"make the receiver act on button release"
- triggerOnDown := false
+ isTriggerOnDown := false
!
beTriggerOnDown
"make the receiver act on button press"
- triggerOnDown := true
+ isTriggerOnDown := true
!
triggerOnDown:aBoolean
@@ -114,14 +122,14 @@
on press or on release.
(see also ST-80 compatibility methods beTriggerOn*)"
- triggerOnDown := aBoolean
+ isTriggerOnDown := aBoolean
!
isTriggerOnDown
"return true, if I trigger on press
(in contrast to triggering on up, which is the default)"
- ^ triggerOnDown
+ ^ isTriggerOnDown
!
pressAction
@@ -155,7 +163,7 @@
either set the press-action clear any release-action or
vice versa, set the release-action and clear the press-action."
- triggerOnDown ifTrue:[
+ isTriggerOnDown ifTrue:[
releaseActionBlock := nil.
pressActionBlock := aBlock
] ifFalse:[
@@ -224,19 +232,58 @@
active:aBoolean
active := aBoolean
+!
+
+toggleNoAction
+ "toggle, but do NOT perform any action"
+
+ pressed ifTrue:[
+ view turnOff.
+ pressed := false.
+ ] ifFalse:[
+ view turnOn.
+ pressed := true.
+ ].
+!
+
+toggle
+ "toggle and perform the action"
+
+ enabled ifTrue:[
+ self toggleNoAction.
+ self performAction.
+ view sendChangeMessageWith:pressed.
+ view changed:#toggle with:pressed
+ ]
! !
!ButtonController methodsFor:'event handling'!
+performAction
+ |action|
+
+ pressed ifTrue:[
+ action := pressActionBlock
+ ] ifFalse:[
+ action := releaseActionBlock
+ ].
+ action notNil ifTrue:[action value].
+!
+
buttonPress:button x:x y:y
- |sym|
+ |sym action|
(button == 1 or:[button == #select]) ifFalse:[
^ super buttonPress:button x:x y:y
].
- pressed ifFalse:[
- enabled ifTrue:[
+ enabled ifTrue:[
+ isToggle ifTrue:[
+ self toggle.
+ ^ self
+ ].
+
+ pressed ifFalse:[
pressed := true.
view showActive.
@@ -250,11 +297,9 @@
active := true.
- pressActionBlock notNil ifTrue:[
- pressActionBlock value
- ].
+ self performAction.
- triggerOnDown ifTrue:[
+ isTriggerOnDown ifTrue:[
"the ST-80 way of doing things"
view notNil ifTrue:[
view sendChangeMessageWith:true
@@ -278,6 +323,11 @@
(button == 1 or:[button == #select]) ifFalse:[
^ super buttonRelease:button x:x y:y
].
+
+ isToggle ifTrue:[
+ ^ self
+ ].
+
pressed ifTrue:[
autoRepeat ifTrue:[
Processor removeTimedBlock:repeatBlock
@@ -303,10 +353,9 @@
active := true.
- releaseActionBlock notNil ifTrue:[
- releaseActionBlock value
- ].
- triggerOnDown ifFalse:[
+ self performAction.
+
+ isTriggerOnDown ifFalse:[
"the ST-80 way of doing things"
view notNil ifTrue:[
view sendChangeMessageWith:false.
@@ -327,13 +376,13 @@
"
reentered after a leave with mouse-button down;
restart autorepeating and/or if I am a button with
- triggerOnDown, show active again.
+ isTriggerOnDown, show active again.
"
enabled ifTrue:[
autoRepeat ifTrue:[
Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
].
- triggerOnDown ifFalse:[
+ isTriggerOnDown ifFalse:[
view showActive.
]
]
@@ -399,7 +448,7 @@
autoRepeat ifTrue:[
Processor removeTimedBlock:repeatBlock
].
- triggerOnDown ifFalse:[
+ isTriggerOnDown ifFalse:[
view showPassive.
]
] ifFalse:[
--- a/ButtonController.st Sun Apr 30 15:40:03 1995 +0200
+++ b/ButtonController.st Wed May 03 02:30:14 1995 +0200
@@ -11,9 +11,9 @@
"
Controller subclass:#ButtonController
- instanceVariableNames:'enabled pressed active entered triggerOnDown autoRepeat
+ instanceVariableNames:'enabled pressed active entered isTriggerOnDown autoRepeat
repeatBlock initialDelay repeatDelay
- pressActionBlock releaseActionBlock'
+ pressActionBlock releaseActionBlock isToggle'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -37,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ButtonController.st,v 1.5 1995-03-06 19:27:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ButtonController.st,v 1.6 1995-05-03 00:28:46 claus Exp $
"
!
@@ -52,7 +52,7 @@
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
- triggerOnDown <Boolean> controls if the action should be executed on
+ isTriggerOnDown <Boolean> controls if the action should be executed on
press or on release (default: on release).
pressActionBlock <Block> block to evaluate when pressed (default: noop)
releaseActionBlock <Block> block to evaluate when released (default: noop)
@@ -92,21 +92,29 @@
autoRepeat := false.
initialDelay := self class defaultInitialDelay.
repeatDelay := self class defaultRepeatDelay.
- triggerOnDown := false.
+ isTriggerOnDown := false.
+ isToggle := false.
! !
!ButtonController methodsFor:'accessing'!
+beToggle
+ "make the receiver act like a toggle"
+
+ isTriggerOnDown := true.
+ isToggle := true
+!
+
beTriggerOnUp
"make the receiver act on button release"
- triggerOnDown := false
+ isTriggerOnDown := false
!
beTriggerOnDown
"make the receiver act on button press"
- triggerOnDown := true
+ isTriggerOnDown := true
!
triggerOnDown:aBoolean
@@ -114,14 +122,14 @@
on press or on release.
(see also ST-80 compatibility methods beTriggerOn*)"
- triggerOnDown := aBoolean
+ isTriggerOnDown := aBoolean
!
isTriggerOnDown
"return true, if I trigger on press
(in contrast to triggering on up, which is the default)"
- ^ triggerOnDown
+ ^ isTriggerOnDown
!
pressAction
@@ -155,7 +163,7 @@
either set the press-action clear any release-action or
vice versa, set the release-action and clear the press-action."
- triggerOnDown ifTrue:[
+ isTriggerOnDown ifTrue:[
releaseActionBlock := nil.
pressActionBlock := aBlock
] ifFalse:[
@@ -224,19 +232,58 @@
active:aBoolean
active := aBoolean
+!
+
+toggleNoAction
+ "toggle, but do NOT perform any action"
+
+ pressed ifTrue:[
+ view turnOff.
+ pressed := false.
+ ] ifFalse:[
+ view turnOn.
+ pressed := true.
+ ].
+!
+
+toggle
+ "toggle and perform the action"
+
+ enabled ifTrue:[
+ self toggleNoAction.
+ self performAction.
+ view sendChangeMessageWith:pressed.
+ view changed:#toggle with:pressed
+ ]
! !
!ButtonController methodsFor:'event handling'!
+performAction
+ |action|
+
+ pressed ifTrue:[
+ action := pressActionBlock
+ ] ifFalse:[
+ action := releaseActionBlock
+ ].
+ action notNil ifTrue:[action value].
+!
+
buttonPress:button x:x y:y
- |sym|
+ |sym action|
(button == 1 or:[button == #select]) ifFalse:[
^ super buttonPress:button x:x y:y
].
- pressed ifFalse:[
- enabled ifTrue:[
+ enabled ifTrue:[
+ isToggle ifTrue:[
+ self toggle.
+ ^ self
+ ].
+
+ pressed ifFalse:[
pressed := true.
view showActive.
@@ -250,11 +297,9 @@
active := true.
- pressActionBlock notNil ifTrue:[
- pressActionBlock value
- ].
+ self performAction.
- triggerOnDown ifTrue:[
+ isTriggerOnDown ifTrue:[
"the ST-80 way of doing things"
view notNil ifTrue:[
view sendChangeMessageWith:true
@@ -278,6 +323,11 @@
(button == 1 or:[button == #select]) ifFalse:[
^ super buttonRelease:button x:x y:y
].
+
+ isToggle ifTrue:[
+ ^ self
+ ].
+
pressed ifTrue:[
autoRepeat ifTrue:[
Processor removeTimedBlock:repeatBlock
@@ -303,10 +353,9 @@
active := true.
- releaseActionBlock notNil ifTrue:[
- releaseActionBlock value
- ].
- triggerOnDown ifFalse:[
+ self performAction.
+
+ isTriggerOnDown ifFalse:[
"the ST-80 way of doing things"
view notNil ifTrue:[
view sendChangeMessageWith:false.
@@ -327,13 +376,13 @@
"
reentered after a leave with mouse-button down;
restart autorepeating and/or if I am a button with
- triggerOnDown, show active again.
+ isTriggerOnDown, show active again.
"
enabled ifTrue:[
autoRepeat ifTrue:[
Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
].
- triggerOnDown ifFalse:[
+ isTriggerOnDown ifFalse:[
view showActive.
]
]
@@ -399,7 +448,7 @@
autoRepeat ifTrue:[
Processor removeTimedBlock:repeatBlock
].
- triggerOnDown ifFalse:[
+ isTriggerOnDown ifFalse:[
view showPassive.
]
] ifFalse:[
--- a/ChckTggle.st Sun Apr 30 15:40:03 1995 +0200
+++ b/ChckTggle.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.7 1995-02-06 00:51:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.8 1995-05-03 00:28:49 claus Exp $
'!
!CheckToggle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.7 1995-02-06 00:51:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.8 1995-05-03 00:28:49 claus Exp $
"
!
@@ -50,6 +50,92 @@
"
CheckButtons are like Toggles in toggling their state when pressed.
However, they show an ok-marker if on; nothing if off.
+ CheckButtons are mostly used as part of a checkBox (since normally,
+ you want to have some label along the check)
+"
+!
+
+examples
+"
+ checkToggle alone:
+
+ |top check|
+
+ top := StandardSystemView new.
+ top extent:100@100.
+
+ check := CheckToggle in:top.
+ check origin:10@10.
+
+ top open
+
+ give it an action:
+
+ |top check|
+
+ top := StandardSystemView new.
+ top extent:100@100.
+
+ check := CheckToggle in:top.
+ check origin:10@10.
+ check action:[:value | Transcript showCr:'changed to: ' , value printString].
+
+ top open
+
+ give it a model:
+
+ |top check model|
+
+ model := false asValue.
+
+ top := StandardSystemView new.
+ top extent:100@100.
+
+ check := CheckToggle in:top.
+ check origin:10@10.
+ check model:model.
+
+ top openModal.
+
+ Transcript showCr:'value after closing box: ' , model value printString
+
+ multiple checks on a single model (with different change selectors):
+ (using a checkBox here, for the demonstration ...)
+
+ |top model panel ext1 ext2
+ readFlag writeFlag executeFlag|
+
+ readFlag := writeFlag := true.
+ executeFlag := false.
+
+ model := Plug new.
+ model respondTo:#read with:[readFlag].
+ model respondTo:#write with:[writeFlag].
+ model respondTo:#execute with:[executeFlag].
+ model respondTo:#read: with:[:val | readFlag := val].
+ model respondTo:#write: with:[:val | writeFlag := val].
+ model respondTo:#execute: with:[:val | executeFlag := val].
+
+ top := StandardSystemView new.
+ top extent:200@200.
+ top label:'File permissions:'.
+
+ panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+
+ #(read write execute) do:[:sym |
+ |check|
+
+ check := CheckBox in:panel.
+ check label:sym.
+ check model:model; aspect:sym; change:(sym , ':') asSymbol.
+ ].
+
+ top openModal.
+
+ Transcript showCr:'settings after closing box:'.
+ Transcript showCr:' read -> ' , readFlag printString.
+ Transcript showCr:' write -> ' , writeFlag printString.
+ Transcript showCr:' execute -> ' , executeFlag printString.
"
! !
--- a/CheckToggle.st Sun Apr 30 15:40:03 1995 +0200
+++ b/CheckToggle.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.7 1995-02-06 00:51:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.8 1995-05-03 00:28:49 claus Exp $
'!
!CheckToggle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.7 1995-02-06 00:51:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.8 1995-05-03 00:28:49 claus Exp $
"
!
@@ -50,6 +50,92 @@
"
CheckButtons are like Toggles in toggling their state when pressed.
However, they show an ok-marker if on; nothing if off.
+ CheckButtons are mostly used as part of a checkBox (since normally,
+ you want to have some label along the check)
+"
+!
+
+examples
+"
+ checkToggle alone:
+
+ |top check|
+
+ top := StandardSystemView new.
+ top extent:100@100.
+
+ check := CheckToggle in:top.
+ check origin:10@10.
+
+ top open
+
+ give it an action:
+
+ |top check|
+
+ top := StandardSystemView new.
+ top extent:100@100.
+
+ check := CheckToggle in:top.
+ check origin:10@10.
+ check action:[:value | Transcript showCr:'changed to: ' , value printString].
+
+ top open
+
+ give it a model:
+
+ |top check model|
+
+ model := false asValue.
+
+ top := StandardSystemView new.
+ top extent:100@100.
+
+ check := CheckToggle in:top.
+ check origin:10@10.
+ check model:model.
+
+ top openModal.
+
+ Transcript showCr:'value after closing box: ' , model value printString
+
+ multiple checks on a single model (with different change selectors):
+ (using a checkBox here, for the demonstration ...)
+
+ |top model panel ext1 ext2
+ readFlag writeFlag executeFlag|
+
+ readFlag := writeFlag := true.
+ executeFlag := false.
+
+ model := Plug new.
+ model respondTo:#read with:[readFlag].
+ model respondTo:#write with:[writeFlag].
+ model respondTo:#execute with:[executeFlag].
+ model respondTo:#read: with:[:val | readFlag := val].
+ model respondTo:#write: with:[:val | writeFlag := val].
+ model respondTo:#execute: with:[:val | executeFlag := val].
+
+ top := StandardSystemView new.
+ top extent:200@200.
+ top label:'File permissions:'.
+
+ panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+
+ #(read write execute) do:[:sym |
+ |check|
+
+ check := CheckBox in:panel.
+ check label:sym.
+ check model:model; aspect:sym; change:(sym , ':') asSymbol.
+ ].
+
+ top openModal.
+
+ Transcript showCr:'settings after closing box:'.
+ Transcript showCr:' read -> ' , readFlag printString.
+ Transcript showCr:' write -> ' , writeFlag printString.
+ Transcript showCr:' execute -> ' , executeFlag printString.
"
! !
--- a/CodeView.st Sun Apr 30 15:40:03 1995 +0200
+++ b/CodeView.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.13 1995-03-06 19:28:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.14 1995-05-03 00:28:53 claus Exp $
'!
!CodeView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.13 1995-03-06 19:28:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.14 1995-05-03 00:28:53 claus Exp $
"
!
@@ -69,8 +69,9 @@
"
idx := m indexOf:#inspectIt.
idx ~~ 0 ifTrue:[
- m addLabel:'-' selector:nil after:idx.
- m addLabel:(resources string:'accept') selector:#accept after:idx + 1.
+ m addLabels:(resources array:#('-' 'accept'))
+ selectors:#(nil accept)
+ after:idx.
].
"
@@ -79,8 +80,9 @@
sub := m subMenuAt:#others.
sub notNil ifTrue:[
idx := sub indexOf:#gotoLine.
- sub addLabel:'-' selector:nil after:idx.
- sub addLabel:(resources string:'explain') selector:#explain after:idx + 1.
+ sub addLabels:(resources array:#('-' 'explain'))
+ selectors:#(nil explain)
+ after:idx.
self hasSelection ifFalse:[
sub disable:#explain
].
--- a/DialogBox.st Sun Apr 30 15:40:03 1995 +0200
+++ b/DialogBox.st Wed May 03 02:30:14 1995 +0200
@@ -15,7 +15,7 @@
ModalBox subclass:#DialogBox
instanceVariableNames:'buttonPanel okButton okAction abortButton abortAction
- acceptReturnAsOK'
+ acceptReturnAsOK yPosition leftIndent addedComponents'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
@@ -25,7 +25,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/DialogBox.st,v 1.7 1995-03-26 20:15:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/DialogBox.st,v 1.8 1995-05-03 00:28:59 claus Exp $
"
!
@@ -61,8 +61,10 @@
examples
"
- since DialogBox is abstract and meant as a base for InfoBox, YesNoBox etc,
- the following examples are somewhat artificial ...
+ mostly, DialogBox is used as an abstract class as a base for InfoBox,
+ YesNoBox etc.
+ However, you can construct dialogs programmatically, as shown in
+ the following examples:
DialogBox new open
@@ -70,6 +72,110 @@
DialogBox new addOkButton; open
DialogBox new addAbortButton; addOkButton; open
+
+ DialogBox new
+ addTextLabel:'hello';
+ addAbortButton;
+ addOkButton;
+ open
+
+ DialogBox new
+ label:'a simple dialog';
+ addTextLabel:'hello';
+ addAbortButton;
+ addOkButton;
+ extent:200@200;
+ sizeFixed:true;
+ open
+
+ DialogBox new
+ addTextLabel:(Image fromFile:'bitmaps/garfield.gif');
+ addAbortButton;
+ addOkButton;
+ open
+
+ DialogBox new
+ addTextLabel:'hello';
+ addTextLabel:(Image fromFile:'bitmaps/garfield.gif');
+ addTextLabel:'world';
+ addAbortButton;
+ addOkButton;
+ open
+
+ constructing a dialog from elements:
+
+ adding a fileSelectionList:
+
+ |top panel l scr fileName ok|
+
+ fileName := '' asValue.
+
+ top := DialogBox new.
+ top extent:200@300; sizeFixed:true.
+
+ panel := VerticalPanelView new.
+
+ l := FileSelectionList on:fileName.
+ l useIndex:false.
+ scr := ScrollableView forView:l.
+ panel addSubView:scr.
+ scr left:0.0; width:1.0.
+
+ top addComponent:panel.
+ top addAbortButton; addOkButton.
+ top okAction:[ok := true].
+ ok := false.
+ top openModal.
+
+ ok ifTrue:[
+ Transcript show:'fileName: '; showCr:fileName value storeString.
+ ]
+
+
+ adding a panel with checkBoxes:
+
+ |top panel b model value1 value2 value3 value4 ok|
+
+ value1 := true asValue.
+ value2 := false asValue.
+ value3 := false asValue.
+ value4 := true asValue.
+
+ top := DialogBox new.
+ top extent:200@300.
+
+ panel := VerticalPanelView new.
+
+ b := CheckBox on:value1.
+ b label:'check1'.
+ panel addSubView:b.
+
+ b := CheckBox on:value2.
+ b label:'check2'.
+ panel addSubView:b.
+
+ b := CheckBox on:value3.
+ b label:'check3'.
+ panel addSubView:b.
+
+ b := CheckBox on:value4.
+ b label:'check4'.
+ panel addSubView:b.
+
+ top addComponent:panel.
+ top addAbortButton; addOkButton.
+ top okAction:[ok := true].
+ ok := false.
+ top openModal.
+
+ ok ifTrue:[
+ Transcript show:'value1: '; showCr:value1 value.
+ Transcript show:'value2: '; showCr:value2 value.
+ Transcript show:'value3: '; showCr:value3 value.
+ Transcript show:'value4: '; showCr:value4 value.
+ ]
+
+
"
!
@@ -125,6 +231,30 @@
"
!
+request:aString initialAnswer:initial onCancel:cancelAction
+ "launch a Dialog, which allows user to enter something.
+ Return the entered string (may be empty string)
+ or cancelValue (if cancel was pressed)"
+
+ |val|
+
+ val :=self
+ request:aString
+ displayAt:nil
+ centered:true
+ action:[:result | ^ result]
+ initialAnswer:initial.
+
+ ^ cancelAction value
+
+ "
+ Dialog
+ request:'enter a string:'
+ initialAnswer:'the default'
+ onCancel:['foooo']
+ "
+!
+
request:aString displayAt:aPoint initialAnswer:initial
"launch a Dialog, which allows user to enter something.
Return the entered string (may be empty string) or nil (if cancel was pressed)"
@@ -368,15 +498,35 @@
|w h p|
- okButton isNil ifTrue:[
- ^ super preferedExtent
+ addedComponents notNil ifTrue:[
+ w := addedComponents
+ inject:0
+ into:[:max :element |
+ max max:(element preferedExtent x + element leftInset)].
+ ] ifFalse:[
+ w := super preferedExtent x.
].
- p := buttonPanel preferedExtent.
- w := p x.
h := ViewSpacing
- + "okButton preferedExtent" p y
+ + yPosition
+ ViewSpacing.
+ okButton notNil ifTrue:[
+ p := buttonPanel preferedExtent.
+ w := w max:p x.
+ h := h
+ + p y
+ + ViewSpacing.
+ ].
+
+"/ okButton isNil ifTrue:[
+"/ ^ super preferedExtent
+"/ ].
+"/ p := buttonPanel preferedExtent.
+"/ w := p x.
+"/ h := ViewSpacing
+"/ + p y
+"/ + ViewSpacing.
+"/
^ w @ h
! !
@@ -394,45 +544,44 @@
acceptReturnAsOK := true.
buttonPanel := HorizontalPanelView in:self.
- buttonPanel origin:(0.0 @ 1.0) corner:(1.0 @ 1.0).
- buttonPanel bottomInset:mm;
- topInset:(font height + mm * 2) negated.
- buttonPanel borderWidth:0.
- buttonPanel layout:#spread.
+ buttonPanel
+ origin:(0.0 @ 1.0) corner:(1.0 @ 1.0);
+ bottomInset:mm;
+ topInset:(font height + mm * 2) negated;
+ borderWidth:0;
+ layout:#spread.
+
+ yPosition := 0.
+ leftIndent := 0.
"
|b|
b := DialogBox new.
- b addAbortButton; addOkButton; showAtPointer
+ b addAbortButton;
+ addOkButton;
+ showAtPointer
"
"
|b|
b := DialogBox new.
- b addOkButton; showAtPointer
+ b addOkButton;
+ showAtPointer
+ "
"
-!
-
-addOkButton
- "create an okButton - to be sent from redefined initialize
- methods in subclasses."
-
- okButton := Button okButtonIn:buttonPanel.
- okButton model:self; change:#okPressed.
- okButton isReturnButton:acceptReturnAsOK.
- buttonPanel subViews size > 1 ifTrue:[
- buttonPanel layout:#fitSpace.
- ].
-!
-
-addAbortButton
- "create an abortButton - to be sent from redefined initialize
- methods in subclasses."
-
- abortButton := Button abortButtonIn:buttonPanel.
- abortButton model:self; change:#abortPressed.
- buttonPanel subViews size > 1 ifTrue:[
- buttonPanel layout:#fitSpace.
- ].
+ |b|
+ b := DialogBox new.
+ b addTextLabel:'hello world';
+ addOkButton;
+ showAtPointer
+ "
+ "
+ |b|
+ b := DialogBox new.
+ b addTextLabel:'hello world';
+ addVerticalSpace:50;
+ addOkButton;
+ showAtPointer
+ "
!
reAdjustGeometry
@@ -449,6 +598,152 @@
^ buttonPanel subViews
! !
+!DialogBox methodsFor:'construction-adding'!
+
+addButton:aButton after:someOtherButtonOrNil
+ "add a button in the buttonPanel.
+ If the argument someOtherButtonOrNil is nil, the button is
+ added at the end."
+
+ buttonPanel addSubView:aButton after:someOtherButtonOrNil.
+ buttonPanel subViews size > 1 ifTrue:[
+ buttonPanel layout:#fitSpace.
+ ].
+!
+
+addButton:aButton
+ "add a button in the buttonPanel"
+
+ self addButton:aButton after:nil
+!
+
+addOkButton:action
+ "create an okButton - to be sent from redefined initialize
+ methods in subclasses."
+
+ okButton := Button okButton.
+ action notNil ifTrue:[okButton action:action].
+ okButton model:self; change:#okPressed.
+ okButton isReturnButton:acceptReturnAsOK.
+ self addButton:okButton.
+!
+
+addOkButton
+ "create an okButton - to be sent from redefined initialize
+ methods in subclasses."
+
+ self addOkButton:nil
+!
+
+addAbortButton
+ "create an abortButton - to be sent from redefined initialize
+ methods in subclasses."
+
+ abortButton := Button abortButton.
+ abortButton model:self; change:#abortPressed.
+ self addButton:abortButton.
+!
+
+addVerticalSpace:nPixel
+ yPosition := yPosition + nPixel.
+!
+
+addComponent:aComponent
+ "add a component with its prefered height and full width"
+
+ addedComponents isNil ifTrue:[
+ addedComponents := OrderedCollection new.
+ ].
+ addedComponents add:aComponent.
+ self addSubView:aComponent.
+ aComponent height:(aComponent preferedExtent y).
+ aComponent origin:0.0@yPosition; width:1.0; leftInset:leftIndent.
+ yPosition := yPosition + aComponent height.
+!
+
+addTextLabel:aString
+ "create a text label - the name has been choosen for ST-80 compatibility;
+ however, ST/X labels allow image labels too."
+
+ |l|
+
+ l := Label new label:aString.
+ l
+ origin:(0.0 @ 0.0);
+ topInset:yPosition;
+ bottomInset:yPosition negated;
+ leftInset:leftIndent;
+ rightInset:leftIndent negated.
+
+ self addComponent:l.
+
+ "
+ |b|
+
+ b := DialogBox new.
+ b addTextLabel:'hello'.
+ b showAtPointer
+ "
+ "
+ |b|
+
+ b := DialogBox new.
+ b leftIndent:100.
+ b addTextLabel:'hello'.
+ b leftIndent:0.
+ b addTextLabel:'world'.
+ b showAtPointer
+ "
+ "
+ |b|
+
+ b := DialogBox new.
+ b addTextLabel:'hello'.
+ b addTextLabel:'world'.
+ b addOkButton.
+ b showAtPointer
+ "
+ "
+ |b|
+
+ b := DialogBox new.
+ b addTextLabel:'hello world\\How about this ?' withCRs.
+ b addOkButton.
+ b showAtPointer
+ "
+ "
+ |b|
+
+ b := DialogBox new.
+ b addTextLabel:'hello world\\How about this ?' withCRs.
+ b addTextLabel:'not bad'.
+ b addAbortButton.
+ b addOkButton.
+ b showAtPointer
+ "
+!
+
+addCheckBox:label on:aModel
+ |b|
+
+ b := CheckBox on:aModel.
+ b label:label.
+ self addComponent:b.
+ ^ b
+!
+
+yPosition
+ ^ yPosition
+!
+
+yPosition:aNumber
+ yPosition := aNumber.
+!
+
+leftIndent:aNumber
+ leftIndent := aNumber.
+! !
+
!DialogBox methodsFor:'private'!
hideAndEvaluate:aBlock
--- a/ETxtView.st Sun Apr 30 15:40:03 1995 +0200
+++ b/ETxtView.st Wed May 03 02:30:14 1995 +0200
@@ -14,12 +14,12 @@
TextView subclass:#EditTextView
instanceVariableNames:'cursorLine cursorVisibleLine cursorCol cursorShown
- prevCursorState readOnly modified fixedSize exceptionBlock
- errorMessage cursorFgColor cursorBgColor cursorType undoAction
- typeOfSelection lastString lastReplacement lastAction replacing
- showMatchingParenthesis hasKeyboardFocus'
+ prevCursorState readOnly modified fixedSize exceptionBlock
+ errorMessage cursorFgColor cursorBgColor cursorType undoAction
+ typeOfSelection lastString lastReplacement lastAction replacing
+ showMatchingParenthesis hasKeyboardFocus'
classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
- DefaultCursorType'
+ DefaultCursorType'
poolDictionaries:''
category:'Views-Text'
!
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.23 1995-03-18 05:14:09 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.24 1995-05-03 00:29:07 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.23 1995-03-18 05:14:09 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.24 1995-05-03 00:29:07 claus Exp $
"
!
@@ -117,52 +117,55 @@
|line lineSize newLine drawCharacterOnly|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
aCharacter == (Character cr) ifTrue:[
- self splitLine:lineNr before:colNr.
- ^ self
+ self splitLine:lineNr before:colNr.
+ ^ self
].
drawCharacterOnly := false.
self checkForExistingLine:lineNr.
line := list at:lineNr.
lineSize := line size.
(aCharacter == Character space) ifTrue:[
- (colNr > lineSize) ifTrue:[
- ^ self
- ]
+ (colNr > lineSize) ifTrue:[
+ ^ self
+ ]
].
(lineSize == 0) ifTrue: [
- newLine := String new:colNr.
- drawCharacterOnly := true
+ newLine := String new:colNr.
+ drawCharacterOnly := true
] ifFalse: [
- (colNr > lineSize) ifTrue: [
- newLine := String new:colNr.
- newLine replaceFrom:1 to:lineSize
- with:line startingAt:1.
- drawCharacterOnly := true
- ] ifFalse: [
- newLine := String new:(lineSize + 1).
- newLine replaceFrom:1 to:(colNr - 1)
- with:line startingAt:1.
- newLine replaceFrom:(colNr + 1) to:(lineSize + 1)
- with:line startingAt:colNr
- ]
+ (colNr > lineSize) ifTrue: [
+ newLine := String new:colNr.
+ newLine replaceFrom:1 to:lineSize
+ with:line startingAt:1.
+ drawCharacterOnly := true
+ ] ifFalse: [
+ newLine := String new:(lineSize + 1).
+ newLine replaceFrom:1 to:(colNr - 1)
+ with:line startingAt:1.
+ newLine replaceFrom:(colNr + 1) to:(lineSize + 1)
+ with:line startingAt:colNr
+ ]
].
newLine at:colNr put:aCharacter.
aCharacter == (Character tab) ifTrue:[
- newLine := self withTabsExpanded:newLine.
- drawCharacterOnly := false
+ newLine := self withTabsExpanded:newLine.
+ drawCharacterOnly := false
].
list at:lineNr put:newLine.
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
+ ].
self textChanged.
shown ifTrue:[
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
- ]
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
]
!
@@ -173,46 +176,48 @@
aString isNil ifTrue:[^ self].
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
strLen := aString size.
self checkForExistingLine:lineNr.
line := list at:lineNr.
line notNil ifTrue:[
- lineSize := line size
+ lineSize := line size
] ifFalse:[
- lineSize := 0
+ lineSize := 0
].
((colNr == 1) and:[lineSize == 0]) ifTrue: [
- newLine := aString
+ newLine := aString
] ifFalse:[
- (lineSize == 0) ifTrue: [
- newLine := String new:(colNr + strLen - 1)
- ] ifFalse: [
- (colNr > lineSize) ifTrue: [
- newLine := String new:(colNr + strLen - 1).
- newLine replaceFrom:1 to:lineSize
- with:line startingAt:1
- ] ifFalse: [
- newLine := String new:(lineSize + strLen).
- newLine replaceFrom:1 to:(colNr - 1)
- with:line startingAt:1.
- newLine replaceFrom:(colNr + strLen) to:(lineSize + strLen)
- with:line startingAt:colNr
- ]
- ].
- newLine replaceFrom:colNr to:(colNr + strLen - 1)
- with:aString startingAt:1
+ (lineSize == 0) ifTrue: [
+ newLine := String new:(colNr + strLen - 1)
+ ] ifFalse: [
+ (colNr > lineSize) ifTrue: [
+ newLine := String new:(colNr + strLen - 1).
+ newLine replaceFrom:1 to:lineSize
+ with:line startingAt:1
+ ] ifFalse: [
+ newLine := String new:(lineSize + strLen).
+ newLine replaceFrom:1 to:(colNr - 1)
+ with:line startingAt:1.
+ newLine replaceFrom:(colNr + strLen) to:(lineSize + strLen)
+ with:line startingAt:colNr
+ ]
+ ].
+ newLine replaceFrom:colNr to:(colNr + strLen - 1)
+ with:aString startingAt:1
].
(aString occurrencesOf:(Character tab)) == 0 ifFalse:[
- newLine := self withTabsExpanded:newLine
+ newLine := self withTabsExpanded:newLine
].
list at:lineNr put:newLine.
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:newLine).
+ ].
self textChanged.
-
!
splitLine:lineNr before:colNr
@@ -223,45 +228,46 @@
srcY "{ Class: SmallInteger }" |
list isNil ifFalse:[
- lineNr > (list size) ifFalse:[
- (colNr == 1) ifTrue:[
- self insertLine:nil before:lineNr.
- ^ self
- ].
- line := list at:lineNr.
- line isNil ifFalse:[
- lineSize := line size.
- (colNr <= lineSize) ifTrue:[
- rightRest := line copyFrom:colNr to:lineSize.
- (colNr > 1) ifTrue:[
- leftRest := line copyTo:(colNr - 1)
- ]
- ] ifFalse:[
- leftRest := line
- ]
- ].
- leftRest notNil ifTrue:[
- leftRest isBlank ifTrue:[leftRest := nil]
- ].
- list at:lineNr put:leftRest.
- self withoutRedrawInsertLine:rightRest before:(lineNr + 1).
-
- visLine := self listLineToVisibleLine:(lineNr).
- visLine notNil ifTrue:[
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- srcY := topMargin + (visLine * fontHeight).
- self catchExpose.
- self copyFrom:self x:textStartLeft y:srcY
- toX:textStartLeft y:(srcY + fontHeight)
- width:w
- height:((nLinesShown - visLine - 1) * fontHeight).
- self redrawLine:lineNr.
- self redrawLine:(lineNr + 1).
- self waitForExpose
- ].
- self textChanged.
- ]
+ lineNr > (list size) ifFalse:[
+ (colNr == 1) ifTrue:[
+ self insertLine:nil before:lineNr.
+ ^ self
+ ].
+ line := list at:lineNr.
+ line isNil ifFalse:[
+ lineSize := line size.
+ (colNr <= lineSize) ifTrue:[
+ rightRest := line copyFrom:colNr to:lineSize.
+ (colNr > 1) ifTrue:[
+ leftRest := line copyTo:(colNr - 1)
+ ]
+ ] ifFalse:[
+ leftRest := line
+ ]
+ ].
+ leftRest notNil ifTrue:[
+ leftRest isBlank ifTrue:[leftRest := nil]
+ ].
+ list at:lineNr put:leftRest.
+ self withoutRedrawInsertLine:rightRest before:(lineNr + 1).
+
+ visLine := self listLineToVisibleLine:(lineNr).
+ visLine notNil ifTrue:[
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ srcY := topMargin + (visLine * fontHeight).
+ self catchExpose.
+ self copyFrom:self x:textStartLeft y:srcY
+ toX:textStartLeft y:(srcY + fontHeight)
+ width:w
+ height:((nLinesShown - visLine - 1) * fontHeight).
+ self redrawLine:lineNr.
+ self redrawLine:(lineNr + 1).
+ self waitForExpose
+ ].
+ widthOfWidestLine := nil. "/ unknown
+ self textChanged.
+ ]
]
!
@@ -314,42 +320,45 @@
dstY "{ Class: SmallInteger }" |
readOnly ifTrue:[
- ^ self
+ ^ self
].
visLine := self listLineToVisibleLine:lineNr.
(shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- self textChanged.
- ^ self
- ].
-
- nLines := end - start + 1.
- ((visLine + nLines) >= nLinesShown) ifTrue:[
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- self redrawFromVisibleLine:visLine to:nLinesShown
+ self withoutRedrawInsertLines:someText
+ from:start to:end
+ before:lineNr.
] ifFalse:[
- w := self widthForScrollBetween:(lineNr + nLines)
- and:(firstLineShown + nLines + nLinesShown).
- srcY := topMargin + ((visLine - 1) * fontHeight).
- dstY := srcY + (nLines * fontHeight).
- "
- stupid: must catchExpose before inserting new
- stuff - since catchExpose may perform redraws
- "
- self catchExpose.
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- self copyFrom:self x:textStartLeft y:srcY
- toX:textStartLeft y:dstY
- width:w
- height:(height - dstY).
- self redrawFromVisibleLine:visLine to:(visLine + nLines - 1).
- self waitForExpose
+ nLines := end - start + 1.
+ ((visLine + nLines) >= nLinesShown) ifTrue:[
+ self withoutRedrawInsertLines:someText
+ from:start to:end
+ before:lineNr.
+ self redrawFromVisibleLine:visLine to:nLinesShown
+ ] ifFalse:[
+ w := self widthForScrollBetween:(lineNr + nLines)
+ and:(firstLineShown + nLines + nLinesShown).
+ srcY := topMargin + ((visLine - 1) * fontHeight).
+ dstY := srcY + (nLines * fontHeight).
+ "
+ stupid: must catchExpose before inserting new
+ stuff - since catchExpose may perform redraws
+ "
+ self catchExpose.
+ self withoutRedrawInsertLines:someText
+ from:start to:end
+ before:lineNr.
+ self copyFrom:self x:textStartLeft y:srcY
+ toX:textStartLeft y:dstY
+ width:w
+ height:(height - dstY).
+ self redrawFromVisibleLine:visLine to:(visLine + nLines - 1).
+ self waitForExpose
+ ].
+ ].
+ widthOfWidestLine notNil ifTrue:[
+ someText do:[:line |
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
+ ]
].
self textChanged.
!
@@ -361,23 +370,23 @@
|line lineSize|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
list isNil ifTrue:[^ self].
(startLine == endLine) ifTrue:[
- "delete chars within a line"
- self deleteCharsAtLine:startLine fromCol:startCol toCol:endCol.
- ^ self
+ "delete chars within a line"
+ self deleteCharsAtLine:startLine fromCol:startCol toCol:endCol.
+ ^ self
].
((startCol == 1) and:[endCol == 0]) ifTrue:[
- "delete full lines only"
- endLine > startLine ifTrue:[
- self deleteFromLine:startLine toLine:(endLine - 1)
- ].
- ^ self
+ "delete full lines only"
+ endLine > startLine ifTrue:[
+ self deleteFromLine:startLine toLine:(endLine - 1)
+ ].
+ ^ self
].
"delete right rest of 1st line"
@@ -385,25 +394,26 @@
"delete the inner lines ..."
endLine > (startLine + 1) ifTrue:[
- self deleteFromLine:(startLine + 1) toLine:(endLine - 1)
+ self deleteFromLine:(startLine + 1) toLine:(endLine - 1)
].
(endCol ~~ 0) ifTrue:[
- "delete the left rest of the last line"
- self deleteCharsAtLine:(startLine + 1) toCol:endCol.
-
- "must add blanks, if startCal lies behond end of startLine"
- line := list at:startLine.
- lineSize := line size.
- (startCol > lineSize) ifTrue:[
- line isNil ifTrue:[
- line := String new:(startCol - 1)
- ] ifFalse:[
- line := line , (String new:(startCol - 1 - lineSize))
- ].
- list at:startLine put:line.
- self textChanged.
- ]
+ "delete the left rest of the last line"
+ self deleteCharsAtLine:(startLine + 1) toCol:endCol.
+
+ "must add blanks, if startCal lies behond end of startLine"
+ line := list at:startLine.
+ lineSize := line size.
+ (startCol > lineSize) ifTrue:[
+ line isNil ifTrue:[
+ line := String new:(startCol - 1)
+ ] ifFalse:[
+ line := line , (String new:(startCol - 1 - lineSize))
+ ].
+ list at:startLine put:line.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ ]
].
"merge the left rest of 1st line with right rest of last line into one"
@@ -564,47 +574,6 @@
list replaceFrom:lineNr to:(lineNr + nLines - 1) with:newLines startingAt:start.
!
-deleteCharsAtLine:lineNr fromCol:startCol toCol:endCol
- "delete characters from startCol to endCol in line lineNr"
-
- |line lineSize newLine|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue: [^self].
- (list size < lineNr) ifTrue: [^ self].
-
- line := list at:lineNr.
- line isNil ifTrue: [^self].
- lineSize := line size.
- (startCol > lineSize) ifTrue: [^ self].
- (endCol == 0) ifTrue:[^ self].
- (endCol < startCol) ifTrue:[^ self].
- (startCol == endCol) ifTrue:[
- self deleteCharAtLine:lineNr col:startCol.
- ^ self
- ].
- (endCol >= lineSize) ifTrue:[
- self deleteCharsAtLine:lineNr fromCol:startCol.
- ^ self
- ].
- (startCol <= 1) ifTrue:[
- self deleteCharsAtLine:lineNr toCol:endCol.
- ^ self
- ].
- newLine := (line copyTo:(startCol - 1))
- , (line copyFrom:(endCol + 1) to:lineSize).
-
- newLine isBlank ifTrue:[
- newLine := nil
- ].
- list at:lineNr put:newLine.
- self textChanged.
- self redrawLine:lineNr
-!
-
insertStringWithoutCRs:aString atLine:lineNr col:colNr
"insert aString (which has no crs) at lineNr/colNr"
@@ -662,22 +631,6 @@
]
!
-deleteFromLine:startLineNr toLine:endLineNr
- "delete some lines"
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue:[^ self].
- list removeFromIndex:startLineNr toIndex:endLineNr.
- self textChanged.
- self redrawFromLine:startLineNr.
- (firstLineShown >= list size) ifTrue:[
- self makeLineVisible:(list size)
- ]
-!
-
insertLine:aString before:lineNr
"insert the line aString before line lineNr"
@@ -686,19 +639,22 @@
visLine := self listLineToVisibleLine:lineNr.
(shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLine:aString before:lineNr.
+ self withoutRedrawInsertLine:aString before:lineNr.
] ifFalse:[
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- dstY := topMargin + ((visLine ) * fontHeight).
- self catchExpose.
- self withoutRedrawInsertLine:aString before:lineNr.
- self copyFrom:self x:textStartLeft y:(dstY - fontHeight)
- toX:textStartLeft y:dstY
- width:w
- height:((nLinesShown - visLine "- 1") * fontHeight).
- self redrawVisibleLine:visLine.
- self waitForExpose.
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ dstY := topMargin + ((visLine ) * fontHeight).
+ self catchExpose.
+ self withoutRedrawInsertLine:aString before:lineNr.
+ self copyFrom:self x:textStartLeft y:(dstY - fontHeight)
+ toX:textStartLeft y:dstY
+ width:w
+ height:((nLinesShown - visLine "- 1") * fontHeight).
+ self redrawVisibleLine:visLine.
+ self waitForExpose.
+ ].
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:aString).
].
self textChanged.
!
@@ -742,14 +698,56 @@
toLine:cursorLine col:(cursorCol - 1)
!
+deleteCharsAtLine:lineNr fromCol:startCol toCol:endCol
+ "delete characters from startCol to endCol in line lineNr"
+
+ |line lineSize newLine|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ list isNil ifTrue: [^self].
+ (list size < lineNr) ifTrue: [^ self].
+
+ line := list at:lineNr.
+ line isNil ifTrue: [^self].
+ lineSize := line size.
+ (startCol > lineSize) ifTrue: [^ self].
+ (endCol == 0) ifTrue:[^ self].
+ (endCol < startCol) ifTrue:[^ self].
+ (startCol == endCol) ifTrue:[
+ self deleteCharAtLine:lineNr col:startCol.
+ ^ self
+ ].
+ (endCol >= lineSize) ifTrue:[
+ self deleteCharsAtLine:lineNr fromCol:startCol.
+ ^ self
+ ].
+ (startCol <= 1) ifTrue:[
+ self deleteCharsAtLine:lineNr toCol:endCol.
+ ^ self
+ ].
+ newLine := (line copyTo:(startCol - 1))
+ , (line copyFrom:(endCol + 1) to:lineSize).
+
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ].
+ list at:lineNr put:newLine.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ self redrawLine:lineNr
+!
+
deleteCharAtLine:lineNr col:colNr
"delete single character at colNr in line lineNr"
- |line lineSize newLine drawCharacterOnly|
+ |line lineSize newLine drawCharacterOnly wasLargest|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
list isNil ifTrue: [^self].
(list size < lineNr) ifTrue: [^ self].
@@ -759,29 +757,34 @@
lineSize := line size.
(colNr > lineSize) ifTrue: [^ self].
+ wasLargest := (self widthOfLineString:line) == widthOfWidestLine.
+
drawCharacterOnly := false.
(colNr == lineSize) ifTrue:[
- newLine := line copyTo:(lineSize - 1).
- fontIsFixedWidth ifTrue:[
- drawCharacterOnly := true
- ]
+ newLine := line copyTo:(lineSize - 1).
+ fontIsFixedWidth ifTrue:[
+ drawCharacterOnly := true
+ ]
] ifFalse:[
- newLine := String new:(lineSize - 1).
- newLine replaceFrom:1 to:(colNr - 1)
- with:line startingAt:1.
- newLine replaceFrom:colNr to:(lineSize - 1)
- with:line startingAt:(colNr + 1)
+ newLine := String new:(lineSize - 1).
+ newLine replaceFrom:1 to:(colNr - 1)
+ with:line startingAt:1.
+ newLine replaceFrom:colNr to:(lineSize - 1)
+ with:line startingAt:(colNr + 1)
].
newLine isBlank ifTrue:[
- newLine := nil
+ newLine := nil
].
list at:lineNr put:newLine.
+ wasLargest ifTrue:[
+ widthOfWidestLine := nil. "/ i.e. unknown
+ ].
self textChanged.
drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
+ self redrawLine:lineNr col:colNr
] ifFalse:[
- self redrawLine:lineNr from:colNr
+ self redrawLine:lineNr from:colNr
]
!
@@ -794,25 +797,25 @@
lastLine := list size.
finished := false.
[finished] whileFalse:[
- (lastLine <= 1) ifTrue:[
- finished := true
- ] ifFalse:[
- line := list at:lastLine.
- line notNil ifTrue:[
- line isBlank ifTrue:[
- list at:lastLine put:nil.
- line := nil
- ]
- ].
- line notNil ifTrue:[
- finished := true
- ] ifFalse:[
- lastLine := lastLine - 1
- ]
- ]
+ (lastLine <= 1) ifTrue:[
+ finished := true
+ ] ifFalse:[
+ line := list at:lastLine.
+ line notNil ifTrue:[
+ line isBlank ifTrue:[
+ list at:lastLine put:nil.
+ line := nil
+ ]
+ ].
+ line notNil ifTrue:[
+ finished := true
+ ] ifFalse:[
+ lastLine := lastLine - 1
+ ]
+ ]
].
(lastLine ~~ list size) ifTrue:[
- list grow:lastLine.
+ list grow:lastLine.
"/ self textChanged
]
!
@@ -823,8 +826,8 @@
|line lineSize newLine|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
list isNil ifTrue: [^self].
(list size < lineNr) ifTrue: [^ self].
@@ -832,14 +835,15 @@
line isNil ifTrue: [^self].
lineSize := line size.
(colNr >= lineSize) ifTrue:[
- newLine := nil
+ newLine := nil
] ifFalse:[
- newLine := line copyFrom:(colNr + 1) to:lineSize.
- newLine isBlank ifTrue:[
- newLine := nil
- ]
+ newLine := line copyFrom:(colNr + 1) to:lineSize.
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ]
].
list at:lineNr put:newLine.
+ widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
self redrawLine:lineNr
!
@@ -882,16 +886,34 @@
]
!
+deleteFromLine:startLineNr toLine:endLineNr
+ "delete some lines"
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ list isNil ifTrue:[^ self].
+ list removeFromIndex:startLineNr toIndex:endLineNr.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ self redrawFromLine:startLineNr.
+ (firstLineShown >= list size) ifTrue:[
+ self makeLineVisible:(list size)
+ ]
+!
+
deleteLineWithoutRedraw:lineNr
"delete line - no redraw;
return true, if something was really deleted"
readOnly ifTrue:[
- exceptionBlock value:errorMessage.
- ^ false
+ exceptionBlock value:errorMessage.
+ ^ false
].
(list isNil or:[lineNr > list size]) ifTrue:[^ false].
list removeIndex:lineNr.
+ widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
^ true
!
@@ -903,16 +925,17 @@
|lastLine|
readOnly ifTrue:[
- exceptionBlock value:errorMessage.
- ^ false
+ exceptionBlock value:errorMessage.
+ ^ false
].
(list isNil or:[startLine > list size]) ifTrue:[^ false].
(endLine > list size) ifTrue:[
- lastLine := list size
+ lastLine := list size
] ifFalse:[
- lastLine := endLine
+ lastLine := endLine
].
list removeFromIndex:startLine toIndex:lastLine.
+ widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
^ true
!
@@ -956,8 +979,8 @@
|line newLine|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
list isNil ifTrue: [^self].
(list size < lineNr) ifTrue: [^ self].
@@ -966,9 +989,10 @@
(colNr > line size) ifTrue: [^ self].
newLine := line copyTo:(colNr - 1).
newLine isBlank ifTrue:[
- newLine := nil
+ newLine := nil
].
list at:lineNr put:newLine.
+ widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
self redrawLine:lineNr
!
@@ -2198,8 +2222,8 @@
leftStart := 0.
lnr := start.
[(leftStart == 0) and:[lnr ~~ 1]] whileTrue:[
- lnr := lnr - 1.
- leftStart := self leftIndentOfLine:lnr
+ lnr := lnr - 1.
+ leftStart := self leftIndentOfLine:lnr
].
(leftStart == 0) ifTrue:[^ self].
@@ -2207,30 +2231,34 @@
delta := leftStart - (self leftIndentOfLine:start).
(delta == 0) ifTrue:[^ self].
(delta > 0) ifTrue:[
- spaces := String new:delta
+ spaces := String new:delta
].
start to:end do:[:lineNr |
- line := self listAt:lineNr.
- line notNil ifTrue:[
- line isBlank ifTrue:[
- list at:lineNr put:nil
- ] ifFalse:[
- (delta > 0) ifTrue:[
- line := spaces , line
- ] ifFalse:[
- "check if deletion is ok"
- d := delta negated + 1.
-
- line size > d ifTrue:[
- (line copyTo:(d - 1)) withoutSeparators isEmpty ifTrue:[
- line := line copyFrom:d
- ]
- ]
- ].
- list at:lineNr put:line.
- self textChanged.
- ]
- ]
+ line := self listAt:lineNr.
+ line notNil ifTrue:[
+ line isBlank ifTrue:[
+ list at:lineNr put:nil
+ ] ifFalse:[
+ (delta > 0) ifTrue:[
+ line := spaces , line.
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
+ ]
+ ] ifFalse:[
+ "check if deletion is ok"
+ d := delta negated + 1.
+
+ line size > d ifTrue:[
+ (line copyTo:(d - 1)) withoutSeparators isEmpty ifTrue:[
+ line := line copyFrom:d
+ ]
+ ].
+ widthOfWidestLine := nil
+ ].
+ list at:lineNr put:line.
+ self textChanged.
+ ]
+ ]
].
self redrawFromLine:start to:end
! !
@@ -2527,7 +2555,18 @@
searchFwd:pattern ifAbsent:aBlock
"do a forward search"
- self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock
+ |startCol|
+
+ "/ if there is no selection and the cursor is at the origin,
+ "/ assume its the first search and do not skip the very first match
+ startCol := cursorCol.
+ self hasSelection ifFalse:[
+ (cursorLine == 1 and:[cursorCol == 1]) ifTrue:[
+ startCol := 0
+ ]
+ ].
+
+ self searchFwd:pattern startingAtLine:cursorLine col:startCol ifAbsent:aBlock
!
searchBwd:pattern ifAbsent:aBlock
--- a/EditField.st Sun Apr 30 15:40:03 1995 +0200
+++ b/EditField.st Wed May 03 02:30:14 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.16 1995-03-31 03:01:35 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.17 1995-05-03 00:29:16 claus Exp $
'!
!EditField class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.16 1995-03-31 03:01:35 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.17 1995-05-03 00:29:16 claus Exp $
"
!
@@ -313,9 +313,7 @@
leaveAction value:#Return
].
"model-view behavior"
- (model notNil and:[changeSymbol notNil]) ifTrue:[
- model perform:changeSymbol with:(self contents).
- ].
+ self sendChangeMessageWith:(self contents).
].
!
@@ -424,4 +422,3 @@
^ true
! !
-
--- a/EditTextView.st Sun Apr 30 15:40:03 1995 +0200
+++ b/EditTextView.st Wed May 03 02:30:14 1995 +0200
@@ -14,12 +14,12 @@
TextView subclass:#EditTextView
instanceVariableNames:'cursorLine cursorVisibleLine cursorCol cursorShown
- prevCursorState readOnly modified fixedSize exceptionBlock
- errorMessage cursorFgColor cursorBgColor cursorType undoAction
- typeOfSelection lastString lastReplacement lastAction replacing
- showMatchingParenthesis hasKeyboardFocus'
+ prevCursorState readOnly modified fixedSize exceptionBlock
+ errorMessage cursorFgColor cursorBgColor cursorType undoAction
+ typeOfSelection lastString lastReplacement lastAction replacing
+ showMatchingParenthesis hasKeyboardFocus'
classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
- DefaultCursorType'
+ DefaultCursorType'
poolDictionaries:''
category:'Views-Text'
!
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.23 1995-03-18 05:14:09 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.24 1995-05-03 00:29:07 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.23 1995-03-18 05:14:09 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.24 1995-05-03 00:29:07 claus Exp $
"
!
@@ -117,52 +117,55 @@
|line lineSize newLine drawCharacterOnly|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
aCharacter == (Character cr) ifTrue:[
- self splitLine:lineNr before:colNr.
- ^ self
+ self splitLine:lineNr before:colNr.
+ ^ self
].
drawCharacterOnly := false.
self checkForExistingLine:lineNr.
line := list at:lineNr.
lineSize := line size.
(aCharacter == Character space) ifTrue:[
- (colNr > lineSize) ifTrue:[
- ^ self
- ]
+ (colNr > lineSize) ifTrue:[
+ ^ self
+ ]
].
(lineSize == 0) ifTrue: [
- newLine := String new:colNr.
- drawCharacterOnly := true
+ newLine := String new:colNr.
+ drawCharacterOnly := true
] ifFalse: [
- (colNr > lineSize) ifTrue: [
- newLine := String new:colNr.
- newLine replaceFrom:1 to:lineSize
- with:line startingAt:1.
- drawCharacterOnly := true
- ] ifFalse: [
- newLine := String new:(lineSize + 1).
- newLine replaceFrom:1 to:(colNr - 1)
- with:line startingAt:1.
- newLine replaceFrom:(colNr + 1) to:(lineSize + 1)
- with:line startingAt:colNr
- ]
+ (colNr > lineSize) ifTrue: [
+ newLine := String new:colNr.
+ newLine replaceFrom:1 to:lineSize
+ with:line startingAt:1.
+ drawCharacterOnly := true
+ ] ifFalse: [
+ newLine := String new:(lineSize + 1).
+ newLine replaceFrom:1 to:(colNr - 1)
+ with:line startingAt:1.
+ newLine replaceFrom:(colNr + 1) to:(lineSize + 1)
+ with:line startingAt:colNr
+ ]
].
newLine at:colNr put:aCharacter.
aCharacter == (Character tab) ifTrue:[
- newLine := self withTabsExpanded:newLine.
- drawCharacterOnly := false
+ newLine := self withTabsExpanded:newLine.
+ drawCharacterOnly := false
].
list at:lineNr put:newLine.
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
+ ].
self textChanged.
shown ifTrue:[
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
- ]
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
]
!
@@ -173,46 +176,48 @@
aString isNil ifTrue:[^ self].
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
strLen := aString size.
self checkForExistingLine:lineNr.
line := list at:lineNr.
line notNil ifTrue:[
- lineSize := line size
+ lineSize := line size
] ifFalse:[
- lineSize := 0
+ lineSize := 0
].
((colNr == 1) and:[lineSize == 0]) ifTrue: [
- newLine := aString
+ newLine := aString
] ifFalse:[
- (lineSize == 0) ifTrue: [
- newLine := String new:(colNr + strLen - 1)
- ] ifFalse: [
- (colNr > lineSize) ifTrue: [
- newLine := String new:(colNr + strLen - 1).
- newLine replaceFrom:1 to:lineSize
- with:line startingAt:1
- ] ifFalse: [
- newLine := String new:(lineSize + strLen).
- newLine replaceFrom:1 to:(colNr - 1)
- with:line startingAt:1.
- newLine replaceFrom:(colNr + strLen) to:(lineSize + strLen)
- with:line startingAt:colNr
- ]
- ].
- newLine replaceFrom:colNr to:(colNr + strLen - 1)
- with:aString startingAt:1
+ (lineSize == 0) ifTrue: [
+ newLine := String new:(colNr + strLen - 1)
+ ] ifFalse: [
+ (colNr > lineSize) ifTrue: [
+ newLine := String new:(colNr + strLen - 1).
+ newLine replaceFrom:1 to:lineSize
+ with:line startingAt:1
+ ] ifFalse: [
+ newLine := String new:(lineSize + strLen).
+ newLine replaceFrom:1 to:(colNr - 1)
+ with:line startingAt:1.
+ newLine replaceFrom:(colNr + strLen) to:(lineSize + strLen)
+ with:line startingAt:colNr
+ ]
+ ].
+ newLine replaceFrom:colNr to:(colNr + strLen - 1)
+ with:aString startingAt:1
].
(aString occurrencesOf:(Character tab)) == 0 ifFalse:[
- newLine := self withTabsExpanded:newLine
+ newLine := self withTabsExpanded:newLine
].
list at:lineNr put:newLine.
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:newLine).
+ ].
self textChanged.
-
!
splitLine:lineNr before:colNr
@@ -223,45 +228,46 @@
srcY "{ Class: SmallInteger }" |
list isNil ifFalse:[
- lineNr > (list size) ifFalse:[
- (colNr == 1) ifTrue:[
- self insertLine:nil before:lineNr.
- ^ self
- ].
- line := list at:lineNr.
- line isNil ifFalse:[
- lineSize := line size.
- (colNr <= lineSize) ifTrue:[
- rightRest := line copyFrom:colNr to:lineSize.
- (colNr > 1) ifTrue:[
- leftRest := line copyTo:(colNr - 1)
- ]
- ] ifFalse:[
- leftRest := line
- ]
- ].
- leftRest notNil ifTrue:[
- leftRest isBlank ifTrue:[leftRest := nil]
- ].
- list at:lineNr put:leftRest.
- self withoutRedrawInsertLine:rightRest before:(lineNr + 1).
-
- visLine := self listLineToVisibleLine:(lineNr).
- visLine notNil ifTrue:[
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- srcY := topMargin + (visLine * fontHeight).
- self catchExpose.
- self copyFrom:self x:textStartLeft y:srcY
- toX:textStartLeft y:(srcY + fontHeight)
- width:w
- height:((nLinesShown - visLine - 1) * fontHeight).
- self redrawLine:lineNr.
- self redrawLine:(lineNr + 1).
- self waitForExpose
- ].
- self textChanged.
- ]
+ lineNr > (list size) ifFalse:[
+ (colNr == 1) ifTrue:[
+ self insertLine:nil before:lineNr.
+ ^ self
+ ].
+ line := list at:lineNr.
+ line isNil ifFalse:[
+ lineSize := line size.
+ (colNr <= lineSize) ifTrue:[
+ rightRest := line copyFrom:colNr to:lineSize.
+ (colNr > 1) ifTrue:[
+ leftRest := line copyTo:(colNr - 1)
+ ]
+ ] ifFalse:[
+ leftRest := line
+ ]
+ ].
+ leftRest notNil ifTrue:[
+ leftRest isBlank ifTrue:[leftRest := nil]
+ ].
+ list at:lineNr put:leftRest.
+ self withoutRedrawInsertLine:rightRest before:(lineNr + 1).
+
+ visLine := self listLineToVisibleLine:(lineNr).
+ visLine notNil ifTrue:[
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ srcY := topMargin + (visLine * fontHeight).
+ self catchExpose.
+ self copyFrom:self x:textStartLeft y:srcY
+ toX:textStartLeft y:(srcY + fontHeight)
+ width:w
+ height:((nLinesShown - visLine - 1) * fontHeight).
+ self redrawLine:lineNr.
+ self redrawLine:(lineNr + 1).
+ self waitForExpose
+ ].
+ widthOfWidestLine := nil. "/ unknown
+ self textChanged.
+ ]
]
!
@@ -314,42 +320,45 @@
dstY "{ Class: SmallInteger }" |
readOnly ifTrue:[
- ^ self
+ ^ self
].
visLine := self listLineToVisibleLine:lineNr.
(shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- self textChanged.
- ^ self
- ].
-
- nLines := end - start + 1.
- ((visLine + nLines) >= nLinesShown) ifTrue:[
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- self redrawFromVisibleLine:visLine to:nLinesShown
+ self withoutRedrawInsertLines:someText
+ from:start to:end
+ before:lineNr.
] ifFalse:[
- w := self widthForScrollBetween:(lineNr + nLines)
- and:(firstLineShown + nLines + nLinesShown).
- srcY := topMargin + ((visLine - 1) * fontHeight).
- dstY := srcY + (nLines * fontHeight).
- "
- stupid: must catchExpose before inserting new
- stuff - since catchExpose may perform redraws
- "
- self catchExpose.
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- self copyFrom:self x:textStartLeft y:srcY
- toX:textStartLeft y:dstY
- width:w
- height:(height - dstY).
- self redrawFromVisibleLine:visLine to:(visLine + nLines - 1).
- self waitForExpose
+ nLines := end - start + 1.
+ ((visLine + nLines) >= nLinesShown) ifTrue:[
+ self withoutRedrawInsertLines:someText
+ from:start to:end
+ before:lineNr.
+ self redrawFromVisibleLine:visLine to:nLinesShown
+ ] ifFalse:[
+ w := self widthForScrollBetween:(lineNr + nLines)
+ and:(firstLineShown + nLines + nLinesShown).
+ srcY := topMargin + ((visLine - 1) * fontHeight).
+ dstY := srcY + (nLines * fontHeight).
+ "
+ stupid: must catchExpose before inserting new
+ stuff - since catchExpose may perform redraws
+ "
+ self catchExpose.
+ self withoutRedrawInsertLines:someText
+ from:start to:end
+ before:lineNr.
+ self copyFrom:self x:textStartLeft y:srcY
+ toX:textStartLeft y:dstY
+ width:w
+ height:(height - dstY).
+ self redrawFromVisibleLine:visLine to:(visLine + nLines - 1).
+ self waitForExpose
+ ].
+ ].
+ widthOfWidestLine notNil ifTrue:[
+ someText do:[:line |
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
+ ]
].
self textChanged.
!
@@ -361,23 +370,23 @@
|line lineSize|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
list isNil ifTrue:[^ self].
(startLine == endLine) ifTrue:[
- "delete chars within a line"
- self deleteCharsAtLine:startLine fromCol:startCol toCol:endCol.
- ^ self
+ "delete chars within a line"
+ self deleteCharsAtLine:startLine fromCol:startCol toCol:endCol.
+ ^ self
].
((startCol == 1) and:[endCol == 0]) ifTrue:[
- "delete full lines only"
- endLine > startLine ifTrue:[
- self deleteFromLine:startLine toLine:(endLine - 1)
- ].
- ^ self
+ "delete full lines only"
+ endLine > startLine ifTrue:[
+ self deleteFromLine:startLine toLine:(endLine - 1)
+ ].
+ ^ self
].
"delete right rest of 1st line"
@@ -385,25 +394,26 @@
"delete the inner lines ..."
endLine > (startLine + 1) ifTrue:[
- self deleteFromLine:(startLine + 1) toLine:(endLine - 1)
+ self deleteFromLine:(startLine + 1) toLine:(endLine - 1)
].
(endCol ~~ 0) ifTrue:[
- "delete the left rest of the last line"
- self deleteCharsAtLine:(startLine + 1) toCol:endCol.
-
- "must add blanks, if startCal lies behond end of startLine"
- line := list at:startLine.
- lineSize := line size.
- (startCol > lineSize) ifTrue:[
- line isNil ifTrue:[
- line := String new:(startCol - 1)
- ] ifFalse:[
- line := line , (String new:(startCol - 1 - lineSize))
- ].
- list at:startLine put:line.
- self textChanged.
- ]
+ "delete the left rest of the last line"
+ self deleteCharsAtLine:(startLine + 1) toCol:endCol.
+
+ "must add blanks, if startCal lies behond end of startLine"
+ line := list at:startLine.
+ lineSize := line size.
+ (startCol > lineSize) ifTrue:[
+ line isNil ifTrue:[
+ line := String new:(startCol - 1)
+ ] ifFalse:[
+ line := line , (String new:(startCol - 1 - lineSize))
+ ].
+ list at:startLine put:line.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ ]
].
"merge the left rest of 1st line with right rest of last line into one"
@@ -564,47 +574,6 @@
list replaceFrom:lineNr to:(lineNr + nLines - 1) with:newLines startingAt:start.
!
-deleteCharsAtLine:lineNr fromCol:startCol toCol:endCol
- "delete characters from startCol to endCol in line lineNr"
-
- |line lineSize newLine|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue: [^self].
- (list size < lineNr) ifTrue: [^ self].
-
- line := list at:lineNr.
- line isNil ifTrue: [^self].
- lineSize := line size.
- (startCol > lineSize) ifTrue: [^ self].
- (endCol == 0) ifTrue:[^ self].
- (endCol < startCol) ifTrue:[^ self].
- (startCol == endCol) ifTrue:[
- self deleteCharAtLine:lineNr col:startCol.
- ^ self
- ].
- (endCol >= lineSize) ifTrue:[
- self deleteCharsAtLine:lineNr fromCol:startCol.
- ^ self
- ].
- (startCol <= 1) ifTrue:[
- self deleteCharsAtLine:lineNr toCol:endCol.
- ^ self
- ].
- newLine := (line copyTo:(startCol - 1))
- , (line copyFrom:(endCol + 1) to:lineSize).
-
- newLine isBlank ifTrue:[
- newLine := nil
- ].
- list at:lineNr put:newLine.
- self textChanged.
- self redrawLine:lineNr
-!
-
insertStringWithoutCRs:aString atLine:lineNr col:colNr
"insert aString (which has no crs) at lineNr/colNr"
@@ -662,22 +631,6 @@
]
!
-deleteFromLine:startLineNr toLine:endLineNr
- "delete some lines"
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue:[^ self].
- list removeFromIndex:startLineNr toIndex:endLineNr.
- self textChanged.
- self redrawFromLine:startLineNr.
- (firstLineShown >= list size) ifTrue:[
- self makeLineVisible:(list size)
- ]
-!
-
insertLine:aString before:lineNr
"insert the line aString before line lineNr"
@@ -686,19 +639,22 @@
visLine := self listLineToVisibleLine:lineNr.
(shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLine:aString before:lineNr.
+ self withoutRedrawInsertLine:aString before:lineNr.
] ifFalse:[
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- dstY := topMargin + ((visLine ) * fontHeight).
- self catchExpose.
- self withoutRedrawInsertLine:aString before:lineNr.
- self copyFrom:self x:textStartLeft y:(dstY - fontHeight)
- toX:textStartLeft y:dstY
- width:w
- height:((nLinesShown - visLine "- 1") * fontHeight).
- self redrawVisibleLine:visLine.
- self waitForExpose.
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ dstY := topMargin + ((visLine ) * fontHeight).
+ self catchExpose.
+ self withoutRedrawInsertLine:aString before:lineNr.
+ self copyFrom:self x:textStartLeft y:(dstY - fontHeight)
+ toX:textStartLeft y:dstY
+ width:w
+ height:((nLinesShown - visLine "- 1") * fontHeight).
+ self redrawVisibleLine:visLine.
+ self waitForExpose.
+ ].
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:aString).
].
self textChanged.
!
@@ -742,14 +698,56 @@
toLine:cursorLine col:(cursorCol - 1)
!
+deleteCharsAtLine:lineNr fromCol:startCol toCol:endCol
+ "delete characters from startCol to endCol in line lineNr"
+
+ |line lineSize newLine|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ list isNil ifTrue: [^self].
+ (list size < lineNr) ifTrue: [^ self].
+
+ line := list at:lineNr.
+ line isNil ifTrue: [^self].
+ lineSize := line size.
+ (startCol > lineSize) ifTrue: [^ self].
+ (endCol == 0) ifTrue:[^ self].
+ (endCol < startCol) ifTrue:[^ self].
+ (startCol == endCol) ifTrue:[
+ self deleteCharAtLine:lineNr col:startCol.
+ ^ self
+ ].
+ (endCol >= lineSize) ifTrue:[
+ self deleteCharsAtLine:lineNr fromCol:startCol.
+ ^ self
+ ].
+ (startCol <= 1) ifTrue:[
+ self deleteCharsAtLine:lineNr toCol:endCol.
+ ^ self
+ ].
+ newLine := (line copyTo:(startCol - 1))
+ , (line copyFrom:(endCol + 1) to:lineSize).
+
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ].
+ list at:lineNr put:newLine.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ self redrawLine:lineNr
+!
+
deleteCharAtLine:lineNr col:colNr
"delete single character at colNr in line lineNr"
- |line lineSize newLine drawCharacterOnly|
+ |line lineSize newLine drawCharacterOnly wasLargest|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
list isNil ifTrue: [^self].
(list size < lineNr) ifTrue: [^ self].
@@ -759,29 +757,34 @@
lineSize := line size.
(colNr > lineSize) ifTrue: [^ self].
+ wasLargest := (self widthOfLineString:line) == widthOfWidestLine.
+
drawCharacterOnly := false.
(colNr == lineSize) ifTrue:[
- newLine := line copyTo:(lineSize - 1).
- fontIsFixedWidth ifTrue:[
- drawCharacterOnly := true
- ]
+ newLine := line copyTo:(lineSize - 1).
+ fontIsFixedWidth ifTrue:[
+ drawCharacterOnly := true
+ ]
] ifFalse:[
- newLine := String new:(lineSize - 1).
- newLine replaceFrom:1 to:(colNr - 1)
- with:line startingAt:1.
- newLine replaceFrom:colNr to:(lineSize - 1)
- with:line startingAt:(colNr + 1)
+ newLine := String new:(lineSize - 1).
+ newLine replaceFrom:1 to:(colNr - 1)
+ with:line startingAt:1.
+ newLine replaceFrom:colNr to:(lineSize - 1)
+ with:line startingAt:(colNr + 1)
].
newLine isBlank ifTrue:[
- newLine := nil
+ newLine := nil
].
list at:lineNr put:newLine.
+ wasLargest ifTrue:[
+ widthOfWidestLine := nil. "/ i.e. unknown
+ ].
self textChanged.
drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
+ self redrawLine:lineNr col:colNr
] ifFalse:[
- self redrawLine:lineNr from:colNr
+ self redrawLine:lineNr from:colNr
]
!
@@ -794,25 +797,25 @@
lastLine := list size.
finished := false.
[finished] whileFalse:[
- (lastLine <= 1) ifTrue:[
- finished := true
- ] ifFalse:[
- line := list at:lastLine.
- line notNil ifTrue:[
- line isBlank ifTrue:[
- list at:lastLine put:nil.
- line := nil
- ]
- ].
- line notNil ifTrue:[
- finished := true
- ] ifFalse:[
- lastLine := lastLine - 1
- ]
- ]
+ (lastLine <= 1) ifTrue:[
+ finished := true
+ ] ifFalse:[
+ line := list at:lastLine.
+ line notNil ifTrue:[
+ line isBlank ifTrue:[
+ list at:lastLine put:nil.
+ line := nil
+ ]
+ ].
+ line notNil ifTrue:[
+ finished := true
+ ] ifFalse:[
+ lastLine := lastLine - 1
+ ]
+ ]
].
(lastLine ~~ list size) ifTrue:[
- list grow:lastLine.
+ list grow:lastLine.
"/ self textChanged
]
!
@@ -823,8 +826,8 @@
|line lineSize newLine|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
list isNil ifTrue: [^self].
(list size < lineNr) ifTrue: [^ self].
@@ -832,14 +835,15 @@
line isNil ifTrue: [^self].
lineSize := line size.
(colNr >= lineSize) ifTrue:[
- newLine := nil
+ newLine := nil
] ifFalse:[
- newLine := line copyFrom:(colNr + 1) to:lineSize.
- newLine isBlank ifTrue:[
- newLine := nil
- ]
+ newLine := line copyFrom:(colNr + 1) to:lineSize.
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ]
].
list at:lineNr put:newLine.
+ widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
self redrawLine:lineNr
!
@@ -882,16 +886,34 @@
]
!
+deleteFromLine:startLineNr toLine:endLineNr
+ "delete some lines"
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ list isNil ifTrue:[^ self].
+ list removeFromIndex:startLineNr toIndex:endLineNr.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ self redrawFromLine:startLineNr.
+ (firstLineShown >= list size) ifTrue:[
+ self makeLineVisible:(list size)
+ ]
+!
+
deleteLineWithoutRedraw:lineNr
"delete line - no redraw;
return true, if something was really deleted"
readOnly ifTrue:[
- exceptionBlock value:errorMessage.
- ^ false
+ exceptionBlock value:errorMessage.
+ ^ false
].
(list isNil or:[lineNr > list size]) ifTrue:[^ false].
list removeIndex:lineNr.
+ widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
^ true
!
@@ -903,16 +925,17 @@
|lastLine|
readOnly ifTrue:[
- exceptionBlock value:errorMessage.
- ^ false
+ exceptionBlock value:errorMessage.
+ ^ false
].
(list isNil or:[startLine > list size]) ifTrue:[^ false].
(endLine > list size) ifTrue:[
- lastLine := list size
+ lastLine := list size
] ifFalse:[
- lastLine := endLine
+ lastLine := endLine
].
list removeFromIndex:startLine toIndex:lastLine.
+ widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
^ true
!
@@ -956,8 +979,8 @@
|line newLine|
readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
+ exceptionBlock value:errorMessage.
+ ^ self
].
list isNil ifTrue: [^self].
(list size < lineNr) ifTrue: [^ self].
@@ -966,9 +989,10 @@
(colNr > line size) ifTrue: [^ self].
newLine := line copyTo:(colNr - 1).
newLine isBlank ifTrue:[
- newLine := nil
+ newLine := nil
].
list at:lineNr put:newLine.
+ widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
self redrawLine:lineNr
!
@@ -2198,8 +2222,8 @@
leftStart := 0.
lnr := start.
[(leftStart == 0) and:[lnr ~~ 1]] whileTrue:[
- lnr := lnr - 1.
- leftStart := self leftIndentOfLine:lnr
+ lnr := lnr - 1.
+ leftStart := self leftIndentOfLine:lnr
].
(leftStart == 0) ifTrue:[^ self].
@@ -2207,30 +2231,34 @@
delta := leftStart - (self leftIndentOfLine:start).
(delta == 0) ifTrue:[^ self].
(delta > 0) ifTrue:[
- spaces := String new:delta
+ spaces := String new:delta
].
start to:end do:[:lineNr |
- line := self listAt:lineNr.
- line notNil ifTrue:[
- line isBlank ifTrue:[
- list at:lineNr put:nil
- ] ifFalse:[
- (delta > 0) ifTrue:[
- line := spaces , line
- ] ifFalse:[
- "check if deletion is ok"
- d := delta negated + 1.
-
- line size > d ifTrue:[
- (line copyTo:(d - 1)) withoutSeparators isEmpty ifTrue:[
- line := line copyFrom:d
- ]
- ]
- ].
- list at:lineNr put:line.
- self textChanged.
- ]
- ]
+ line := self listAt:lineNr.
+ line notNil ifTrue:[
+ line isBlank ifTrue:[
+ list at:lineNr put:nil
+ ] ifFalse:[
+ (delta > 0) ifTrue:[
+ line := spaces , line.
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
+ ]
+ ] ifFalse:[
+ "check if deletion is ok"
+ d := delta negated + 1.
+
+ line size > d ifTrue:[
+ (line copyTo:(d - 1)) withoutSeparators isEmpty ifTrue:[
+ line := line copyFrom:d
+ ]
+ ].
+ widthOfWidestLine := nil
+ ].
+ list at:lineNr put:line.
+ self textChanged.
+ ]
+ ]
].
self redrawFromLine:start to:end
! !
@@ -2527,7 +2555,18 @@
searchFwd:pattern ifAbsent:aBlock
"do a forward search"
- self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock
+ |startCol|
+
+ "/ if there is no selection and the cursor is at the origin,
+ "/ assume its the first search and do not skip the very first match
+ startCol := cursorCol.
+ self hasSelection ifFalse:[
+ (cursorLine == 1 and:[cursorCol == 1]) ifTrue:[
+ startCol := 0
+ ]
+ ].
+
+ self searchFwd:pattern startingAtLine:cursorLine col:startCol ifAbsent:aBlock
!
searchBwd:pattern ifAbsent:aBlock
--- a/EnterBox.st Sun Apr 30 15:40:03 1995 +0200
+++ b/EnterBox.st Wed May 03 02:30:14 1995 +0200
@@ -37,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.20 1995-03-31 03:01:43 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.21 1995-05-03 00:29:20 claus Exp $
"
!
@@ -212,8 +212,10 @@
labelField label:aString.
labelField forceResize.
- labelField extent ~= oldSize ifTrue:[
- shown ifTrue:[self resize]
+ shown ifTrue:[
+ labelField extent ~= oldSize ifTrue:[
+ self resize
+ ]
]
]
!
@@ -275,25 +277,29 @@
innerWidth := width - space2.
labelField := Label in:self.
- labelField label:'';
- borderWidth:0.
- labelField adjust:#left.
-
- labelField origin:(0.0 @ ViewSpacing)
- extent:[1.0 @ labelField height].
- labelField leftInset:ViewSpacing; rightInset:ViewSpacing.
+ labelField
+ label:'';
+ borderWidth:0;
+ adjust:#left;
+ origin:(0.0 @ ViewSpacing) extent:[1.0 @ labelField height];
+ leftInset:ViewSpacing;
+ rightInset:ViewSpacing.
self createEnterField.
- enterField origin:[0.0 @ (space2 + labelField preferedExtent y "height")]
- extent:[1.0 @ enterField height].
- enterField leftInset:ViewSpacing; rightInset:ViewSpacing.
- enterField leaveAction:[:key | self okPressed].
+ enterField
+ origin:[0.0 @ (space2 + labelField preferedExtent y "height")]
+ extent:[1.0 @ enterField height].
+ enterField
+ leftInset:ViewSpacing;
+ rightInset:ViewSpacing;
+ leaveAction:[:key | self okPressed].
+
enterField addDependent:self. "to get preferedExtent-changes"
"
forward keyboard input to the enterfield
"
- self delegate:(KeyboardForwarder to:enterField)
+ self delegate:(KeyboardForwarder to:enterField condition:#noFocus)
!
reAdjustGeometry
--- a/FSaveBox.st Sun Apr 30 15:40:03 1995 +0200
+++ b/FSaveBox.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.3 1995-02-06 00:52:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.4 1995-05-03 00:29:24 claus Exp $
'!
!FileSaveBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.3 1995-02-06 00:52:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.4 1995-05-03 00:29:24 claus Exp $
"
!
@@ -78,7 +78,7 @@
"
insert an append-button between abort- and save-buttons
"
- appendButton := Button okButtonIn:nil.
+ appendButton := Button okButton.
appendButton isReturnButton:false.
appendButton label:(resources string:'append').
appendButton action:[appendButton turnOffWithoutRedraw. self appendPressed].
--- a/FileSaveBox.st Sun Apr 30 15:40:03 1995 +0200
+++ b/FileSaveBox.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FileSaveBox.st,v 1.3 1995-02-06 00:52:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FileSaveBox.st,v 1.4 1995-05-03 00:29:24 claus Exp $
'!
!FileSaveBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/FileSaveBox.st,v 1.3 1995-02-06 00:52:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FileSaveBox.st,v 1.4 1995-05-03 00:29:24 claus Exp $
"
!
@@ -78,7 +78,7 @@
"
insert an append-button between abort- and save-buttons
"
- appendButton := Button okButtonIn:nil.
+ appendButton := Button okButton.
appendButton isReturnButton:false.
appendButton label:(resources string:'append').
appendButton action:[appendButton turnOffWithoutRedraw. self appendPressed].
--- a/FramedBox.st Sun Apr 30 15:40:03 1995 +0200
+++ b/FramedBox.st Wed May 03 02:30:14 1995 +0200
@@ -10,7 +10,7 @@
hereby transferred.
"
-View subclass:#FramedBox
+SimpleView subclass:#FramedBox
instanceVariableNames:'label layout fgColor showFrame frame3D'
classVariableNames:''
poolDictionaries:''
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.9 1994-11-28 21:05:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.10 1995-05-03 00:29:32 claus Exp $
'!
!FramedBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.9 1994-11-28 21:05:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.10 1995-05-03 00:29:32 claus Exp $
"
!
--- a/HMiniScr.st Sun Apr 30 15:40:03 1995 +0200
+++ b/HMiniScr.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/HMiniScr.st,v 1.2 1994-11-17 14:34:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HMiniScr.st,v 1.3 1995-05-03 00:29:35 claus Exp $
'!
!HorizontalMiniScroller class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/HMiniScr.st,v 1.2 1994-11-17 14:34:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HMiniScr.st,v 1.3 1995-05-03 00:29:35 claus Exp $
"
!
@@ -66,7 +66,10 @@
!
initStyle
+ |style lvl|
+
super initStyle.
+ style := StyleSheet name.
style == #iris ifTrue:[
tallyLevel := 0.
tallyMarks := 0.
@@ -75,11 +78,11 @@
].
((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
style == #st80 ifTrue:[
- self level:1.
- inset := 1.
+ lvl := inset := 1.
] ifFalse:[
- self level:-1.
+ lvl := -1.
].
+ self level:lvl.
self borderWidth:0
].
shadowForm := lightForm := nil.
--- a/HPanelV.st Sun Apr 30 15:40:03 1995 +0200
+++ b/HPanelV.st Wed May 03 02:30:14 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.8 1995-02-06 00:52:25 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.9 1995-05-03 00:29:39 claus Exp $
'!
!HorizontalPanelView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.8 1995-02-06 00:52:25 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.9 1995-05-03 00:29:39 claus Exp $
"
!
@@ -60,6 +60,8 @@
#left arrange elements at the left
#leftSpace arrange elements at the left, start with spacing
+ #fixLeft same as #left, but do not reduce spacing in case of no fit
+ #fixLeftSpace same as #leftSpace, but do not reduce spacing in case of no fit
#right arrange elements at the right
#rightSpace arrange elements at the right, start with spacing
#center arrange elements in the center
@@ -85,8 +87,11 @@
For backward compatibility (to times, where only hLayout existed), the simple
#layout: does the same as #horizontalLayout:. Do not use this old method.
- If none of these layout/space combinations is exactly what you need in
- your application, create a subclass, and redefine the setChildPositions method.
+ By combining Horizontal- and VerticalPanels (i.e. place a hPanel into a
+ vPanel), most layouts should be implementable.
+ 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.
"
!
@@ -98,8 +103,8 @@
setting different values for the spacing.
Try resizing the view and see how the elements get rearranged.
- All of the below examples place 3 buttons onto a panel - of course,
- you can put any other view into a panel ... the last example shows this.
+ Most of the examples below place 3 buttons onto a panel; Of course,
+ you can put any other view into a panel ... the last examples show this.
example: default layout (centered)
@@ -107,7 +112,7 @@
|v p b1 b2 b3|
v := StandardSystemView new.
- v label:'default'.
+ v label:'default: center'.
p := HorizontalPanelView in:v.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -124,7 +129,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=left'.
+ v label:'hL=left; vL=default (center)'.
p horizontalLayout:#left.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -141,7 +146,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=leftSpace'.
+ v label:'hL=leftSpace; vL=center'.
p horizontalLayout:#leftSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -158,7 +163,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=leftFit'.
+ v label:'hL=leftFit; vL=center'.
p horizontalLayout:#leftFit.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -175,7 +180,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=leftFit'.
+ v label:'hL=leftSpaceFit; vL=center'.
p horizontalLayout:#leftSpaceFit.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -192,7 +197,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=right'.
+ v label:'hL=right; vL=center'.
p horizontalLayout:#right.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -209,7 +214,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=rightSpace'.
+ v label:'hL=rightSpace; vL=center'.
p horizontalLayout:#rightSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -227,7 +232,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
p horizontalLayout:#fit.
- v label:'hL=fit'.
+ v label:'hL=fit; vL=center'.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -245,7 +250,7 @@
p := HorizontalPanelView in:v.
p horizontalLayout:#fit.
p horizontalSpace:0.
- v label:'hL=fit hS=0'.
+ v label:'hL=fit hS=0; vL=center'.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -261,7 +266,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace'.
+ v label:'hL=fitSpace; vL=center'.
p horizontalLayout:#fitSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -279,7 +284,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
p horizontalLayout:#spread.
- v label:'hL=spread'.
+ v label:'hL=spread; vL=center'.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -295,7 +300,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace'.
+ v label:'hL=spreadSpace; vL=center'.
p horizontalLayout:#spreadSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -312,7 +317,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace vL=fit'.
+ v label:'hL=spreadSpace; vL=fit'.
p horizontalLayout:#spreadSpace.
p verticalLayout:#fit.
@@ -330,7 +335,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace vL=fitSpace'.
+ v label:'hL=spreadSpace; vL=fitSpace'.
p horizontalLayout:#spreadSpace.
p verticalLayout:#fitSpace.
@@ -348,7 +353,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fit vL=top'.
+ v label:'hL=fit; vL=top'.
p horizontalLayout:#fit.
p verticalLayout:#top.
@@ -366,7 +371,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace vL=top'.
+ v label:'hL=fitSpace; vL=top'.
p horizontalLayout:#fitSpace.
p verticalLayout:#top.
@@ -384,7 +389,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace vL=fitSpace'.
+ v label:'hL=fitSpace; vL=fitSpace'.
p horizontalLayout:#fitSpace.
p verticalLayout:#fitSpace.
@@ -402,7 +407,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fit vL=fit hS=0'.
+ v label:'hL=fit hS=0; vL=fit'.
p horizontalLayout:#fit.
p verticalLayout:#fit.
@@ -421,7 +426,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace vL=topSpace'.
+ v label:'hL=fitSpace; vL=topSpace'.
p horizontalLayout:#fitSpace.
p verticalLayout:#topSpace.
@@ -439,7 +444,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fit vL=top'.
+ v label:'hL=fit; vL=top'.
p horizontalLayout:#fit.
p verticalLayout:#top.
@@ -458,7 +463,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace vL=bottomSpace'.
+ v label:'hL=fitSpace; vL=bottomSpace'.
p horizontalLayout:#fitSpace.
p verticalLayout:#bottomSpace.
@@ -476,7 +481,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fit vL=bottomSpace'.
+ v label:'hL=fit; vL=bottomSpace'.
p horizontalLayout:#fit.
p verticalLayout:#bottomSpace.
@@ -488,6 +493,41 @@
v extent:300 @ 100.
v open
+ example: placing hPanels into a vPanel
+
+ |v vP hP1 hP2 hP3 b1 b2 b3 b4 b5 b6 b7 b8 b9|
+
+ v := StandardSystemView new.
+ vP := VerticalPanelView in:v.
+ vP origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ vP verticalLayout:#fit;
+ verticalSpace:0;
+ horizontalLayout:#fit.
+
+ hP1 := HorizontalPanelView in:vP.
+ hP1 horizontalLayout:#fitSpace;
+ verticalLayout:#center.
+ b1 := Button label:'button1' in:hP1.
+ b2 := Button label:'button2' in:hP1.
+ b3 := Button label:'button3' in:hP1.
+
+ hP2 := HorizontalPanelView in:vP.
+ hP2 horizontalLayout:#fitSpace;
+ verticalLayout:#center.
+ b4 := Button label:'button4' in:hP2.
+ b5 := Button label:'button5' in:hP2.
+ b6 := Button label:'button6' in:hP2.
+
+ hP3 := HorizontalPanelView in:vP.
+ hP3 horizontalLayout:#fitSpace;
+ verticalLayout:#center.
+ b7 := Button label:'button7' in:hP3.
+ b8 := Button label:'button8' in:hP3.
+ b9 := Button label:'button9' in:hP3.
+
+ v extent:300 @ 300.
+ v open
+
example: a browser like table, where the rightmost list
extends to the far right.
@@ -515,7 +555,7 @@
l3 := ScrollableView for:FileSelectionList in:p.
l3 directory:nil.
- l3 ignoreParentDirectory:true.
+ l3 ignoreParentDirectory:false.
v extent:400 @ 300.
v open
"
@@ -528,12 +568,15 @@
the returned value is one of
#left
#leftSpace
+ #leftFit
+ #leftSpaceFit
#center
#spread
#fit
#right
#rightSpace
the default is #center
+ See the class documentation for the meanings.
"
^ hLayout
@@ -547,6 +590,7 @@
#bottom / #bottomSpace
#fit
the default is #center
+ See the class documentation for the meanings.
"
^ vLayout
@@ -556,11 +600,13 @@
"change the horizontal layout as symbol.
The argument, aSymbol must be one of:
#left / #leftSpace
+ #leftFit / #leftSpaceFit
#center
- #spread / spredSpace
+ #spread / spreadSpace
#fit / fitSpace
#right / #rightSpace
- the default (if never changed) is #center
+ the default (if never changed) is #center.
+ See the class documentation for the meanings.
"
(hLayout ~~ aSymbol) ifTrue:[
@@ -577,6 +623,7 @@
#bottom / #bottomSpace
#fit
the default (if never changed) is #center
+ See the class documentation for the meanings.
"
(vLayout ~~ aSymbol) ifTrue:[
@@ -655,7 +702,7 @@
"(re)compute position of every child whenever childs are added or
my size has changed"
- |xpos space sumOfWidths numChilds l wEach wInside|
+ |xpos space sumOfWidths numChilds l wEach wInside hL vL|
subViews isNil ifTrue:[^ self].
@@ -663,7 +710,10 @@
numChilds := subViews size.
wInside := width - (margin * 2) + (borderWidth*2) - subViews last borderWidth.
- hLayout == #fitSpace ifTrue:[
+ hL := hLayout.
+ vL := vLayout.
+
+ hL == #fitSpace ifTrue:[
"
adjust childs extents and set origins.
Be careful to avoid accumulation of rounding errors
@@ -671,7 +721,7 @@
wEach := (wInside - (numChilds + 1 * space)) / numChilds.
xpos := space + margin - borderWidth.
] ifFalse:[
- hLayout == #fit ifTrue:[
+ hL == #fit ifTrue:[
"
adjust childs extents and set origins.
Be careful to avoid accumulation of rounding errors
@@ -684,7 +734,7 @@
"
sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
- l := hLayout.
+ l := hL.
((l == #center) and:[numChilds == 1]) ifTrue:[
l := #spread
].
@@ -696,10 +746,18 @@
compute position of leftmost subview and space between them;
if they do hardly fit, leave no space between them
"
- (sumOfWidths >= (width - (margin * 2))) ifTrue:[
+ ((sumOfWidths >= (width - (margin * 2)))
+ and:[l ~~ #fixLeftSpace and:[l ~~ #fixLeft]]) ifTrue:[
xpos := 0.
space := 0
] ifFalse: [
+ l == #fixLeftSpace ifTrue:[
+ l := #leftSpace
+ ] ifFalse:[
+ l == #fixLeft ifTrue:[
+ l := #left
+ ]
+ ].
((l == #right) or:[l == #rightSpace]) ifTrue:[
xpos := width - (space * (numChilds - 1)) - sumOfWidths.
"
@@ -737,6 +795,11 @@
or:[l == #leftFit
or:[l == #leftSpaceFit]]]) ifTrue:[
space := space min:(width - sumOfWidths) // (numChilds + 1).
+ (hL == #fixLeft or:[hL == #fixLeftSpace]) ifTrue:[
+ space := space max:horizontalSpace.
+ ] ifFalse:[
+ space := space max:0.
+ ].
(l == #leftSpace
or:[l == #leftSpaceFit]) ifTrue:[
xpos := space.
@@ -770,23 +833,23 @@
subViews keysAndValuesDo:[:index :child |
|ypos advance|
- vLayout == #top ifTrue:[
+ vL == #top ifTrue:[
ypos := 0
] ifFalse:[
- vLayout == #topSpace ifTrue:[
+ vL == #topSpace ifTrue:[
ypos := verticalSpace
] ifFalse:[
- vLayout == #bottom ifTrue:[
+ vL == #bottom ifTrue:[
ypos := height - child heightIncludingBorder
] ifFalse:[
- vLayout == #bottomSpace ifTrue:[
+ vL == #bottomSpace ifTrue:[
ypos := height - verticalSpace - child heightIncludingBorder.
] ifFalse:[
- vLayout == #fitSpace ifTrue:[
+ vL == #fitSpace ifTrue:[
ypos := verticalSpace.
child height:(height - (verticalSpace + child borderWidth * 2))
] ifFalse:[
- vLayout == #fit ifTrue:[
+ vL == #fit ifTrue:[
ypos := 0.
child height:(height - (child borderWidth * 2))
] ifFalse:[
@@ -800,7 +863,7 @@
].
(ypos < 0) ifTrue:[ypos := 0].
- (hLayout == #fit or:[hLayout == #fitSpace]) ifTrue:[
+ (hL == #fit or:[hL == #fitSpace]) ifTrue:[
child origin:(xpos truncated @ ypos)
corner:(xpos + wEach - (child borderWidth)) truncated
@ (ypos + child height).
@@ -814,10 +877,10 @@
index == numChilds ifTrue:[
|x|
- hLayout == #leftFit ifTrue:[
+ hL == #leftFit ifTrue:[
x := width - margin.
].
- hLayout == #leftSpaceFit ifTrue:[
+ hL == #leftSpaceFit ifTrue:[
x := width - margin - space
].
x notNil ifTrue:[
--- a/HScroller.st Sun Apr 30 15:40:03 1995 +0200
+++ b/HScroller.st Wed May 03 02:30:14 1995 +0200
@@ -1,30 +1,20 @@
-"
- COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
+'From Smalltalk/X, Version:2.10.5 on 30-apr-1995 at 1:46:18 am'!
Scroller subclass:#HorizontalScroller
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Interactors'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
!
HorizontalScroller comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
the scroller part of a horizontal scrollbar
-$Header: /cvs/stx/stx/libwidg/Attic/HScroller.st,v 1.5 1994-08-07 13:22:36 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HScroller.st,v 1.6 1995-05-03 00:29:44 claus Exp $
written spring/summer 89 by claus
'!
@@ -32,96 +22,18 @@
initialize
super initialize.
- moveDirection := #x
+ orientation := #horizontal
! !
!HorizontalScroller methodsFor:'accessing'!
-thumbOrigin:newOrigin
- "set the thumbs origin (in percent)"
-
- |realNewOrigin oldFrame oldLeft oldRight thumbLeft thumbRight
- tH tW delta top|
-
- ((newOrigin + thumbHeight) > 100) ifTrue:[
- realNewOrigin := 100 - thumbHeight
- ] ifFalse: [
- realNewOrigin := newOrigin
- ].
- (realNewOrigin > 100) ifTrue:[
- realNewOrigin := 100
- ] ifFalse: [
- (realNewOrigin < 0) ifTrue:[
- realNewOrigin := 0
- ]
- ].
- (realNewOrigin = thumbOrigin) ifFalse:[
- thumbOrigin := realNewOrigin.
-
- shown ifTrue:[
- oldFrame := thumbFrame.
- self computeThumbFrame.
- (thumbHeight = 100) ifTrue:[^ self].
-
- (thumbFrame ~~ oldFrame) ifTrue:[
- oldFrame isNil ifTrue:[
- self drawThumb.
- ^ self
- ].
- tH := thumbFrame height.
- tW := thumbFrame width.
- oldLeft := oldFrame left.
- oldRight := oldLeft + tW.
-
- thumbLeft := thumbFrame left.
- thumbRight := thumbLeft + tW.
-
- top := thumbFrame top.
-
- (oldRight >= width) ifTrue:[
- "cannot copy - thumb was behind end"
- self drawThumbBackgroundInX:oldLeft y:top
- width:(width - oldLeft" - 1") height:tH.
- self drawThumb.
- ^ self
- ].
-
- self catchExpose.
- self copyFrom:self x:oldLeft y:top
- toX:thumbLeft y:top
- width:tW height:tH.
-
- oldLeft > thumbLeft ifTrue:[
- delta := oldLeft - thumbLeft.
- oldLeft > thumbRight ifTrue:[
- self drawThumbBackgroundInX:oldLeft y:top
- width:(tW + 1) height:tH
- ] ifFalse:[
- self drawThumbBackgroundInX:thumbRight y:top
- width:delta height:tH
- ]
- ] ifFalse:[
- delta := thumbLeft - oldLeft.
- oldRight < thumbLeft ifTrue:[
- self drawThumbBackgroundInX:oldLeft y:top
- width:tW + 1 height:tH
- ] ifFalse:[
- self drawThumbBackgroundInX:oldLeft y:top
- width:delta height:tH
- ]
- ].
- self waitForExpose
- ]
- ]
- ]
+scrollRightAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
!
scrollLeftAction:aBlock
"ignored -
but implemented, so that scroller can be used in place of a scrollbar"
-!
+! !
-scrollRightAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-! !
--- a/HorizontalMiniScroller.st Sun Apr 30 15:40:03 1995 +0200
+++ b/HorizontalMiniScroller.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/HorizontalMiniScroller.st,v 1.2 1994-11-17 14:34:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalMiniScroller.st,v 1.3 1995-05-03 00:29:35 claus Exp $
'!
!HorizontalMiniScroller class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/HorizontalMiniScroller.st,v 1.2 1994-11-17 14:34:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalMiniScroller.st,v 1.3 1995-05-03 00:29:35 claus Exp $
"
!
@@ -66,7 +66,10 @@
!
initStyle
+ |style lvl|
+
super initStyle.
+ style := StyleSheet name.
style == #iris ifTrue:[
tallyLevel := 0.
tallyMarks := 0.
@@ -75,11 +78,11 @@
].
((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
style == #st80 ifTrue:[
- self level:1.
- inset := 1.
+ lvl := inset := 1.
] ifFalse:[
- self level:-1.
+ lvl := -1.
].
+ self level:lvl.
self borderWidth:0
].
shadowForm := lightForm := nil.
--- a/HorizontalPanelView.st Sun Apr 30 15:40:03 1995 +0200
+++ b/HorizontalPanelView.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.8 1995-02-06 00:52:25 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.9 1995-05-03 00:29:39 claus Exp $
'!
!HorizontalPanelView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.8 1995-02-06 00:52:25 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.9 1995-05-03 00:29:39 claus Exp $
"
!
@@ -60,6 +60,8 @@
#left arrange elements at the left
#leftSpace arrange elements at the left, start with spacing
+ #fixLeft same as #left, but do not reduce spacing in case of no fit
+ #fixLeftSpace same as #leftSpace, but do not reduce spacing in case of no fit
#right arrange elements at the right
#rightSpace arrange elements at the right, start with spacing
#center arrange elements in the center
@@ -85,8 +87,11 @@
For backward compatibility (to times, where only hLayout existed), the simple
#layout: does the same as #horizontalLayout:. Do not use this old method.
- If none of these layout/space combinations is exactly what you need in
- your application, create a subclass, and redefine the setChildPositions method.
+ By combining Horizontal- and VerticalPanels (i.e. place a hPanel into a
+ vPanel), most layouts should be implementable.
+ 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.
"
!
@@ -98,8 +103,8 @@
setting different values for the spacing.
Try resizing the view and see how the elements get rearranged.
- All of the below examples place 3 buttons onto a panel - of course,
- you can put any other view into a panel ... the last example shows this.
+ Most of the examples below place 3 buttons onto a panel; Of course,
+ you can put any other view into a panel ... the last examples show this.
example: default layout (centered)
@@ -107,7 +112,7 @@
|v p b1 b2 b3|
v := StandardSystemView new.
- v label:'default'.
+ v label:'default: center'.
p := HorizontalPanelView in:v.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -124,7 +129,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=left'.
+ v label:'hL=left; vL=default (center)'.
p horizontalLayout:#left.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -141,7 +146,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=leftSpace'.
+ v label:'hL=leftSpace; vL=center'.
p horizontalLayout:#leftSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -158,7 +163,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=leftFit'.
+ v label:'hL=leftFit; vL=center'.
p horizontalLayout:#leftFit.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -175,7 +180,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=leftFit'.
+ v label:'hL=leftSpaceFit; vL=center'.
p horizontalLayout:#leftSpaceFit.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -192,7 +197,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=right'.
+ v label:'hL=right; vL=center'.
p horizontalLayout:#right.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -209,7 +214,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=rightSpace'.
+ v label:'hL=rightSpace; vL=center'.
p horizontalLayout:#rightSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -227,7 +232,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
p horizontalLayout:#fit.
- v label:'hL=fit'.
+ v label:'hL=fit; vL=center'.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -245,7 +250,7 @@
p := HorizontalPanelView in:v.
p horizontalLayout:#fit.
p horizontalSpace:0.
- v label:'hL=fit hS=0'.
+ v label:'hL=fit hS=0; vL=center'.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -261,7 +266,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace'.
+ v label:'hL=fitSpace; vL=center'.
p horizontalLayout:#fitSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -279,7 +284,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
p horizontalLayout:#spread.
- v label:'hL=spread'.
+ v label:'hL=spread; vL=center'.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -295,7 +300,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace'.
+ v label:'hL=spreadSpace; vL=center'.
p horizontalLayout:#spreadSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -312,7 +317,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace vL=fit'.
+ v label:'hL=spreadSpace; vL=fit'.
p horizontalLayout:#spreadSpace.
p verticalLayout:#fit.
@@ -330,7 +335,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace vL=fitSpace'.
+ v label:'hL=spreadSpace; vL=fitSpace'.
p horizontalLayout:#spreadSpace.
p verticalLayout:#fitSpace.
@@ -348,7 +353,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fit vL=top'.
+ v label:'hL=fit; vL=top'.
p horizontalLayout:#fit.
p verticalLayout:#top.
@@ -366,7 +371,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace vL=top'.
+ v label:'hL=fitSpace; vL=top'.
p horizontalLayout:#fitSpace.
p verticalLayout:#top.
@@ -384,7 +389,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace vL=fitSpace'.
+ v label:'hL=fitSpace; vL=fitSpace'.
p horizontalLayout:#fitSpace.
p verticalLayout:#fitSpace.
@@ -402,7 +407,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fit vL=fit hS=0'.
+ v label:'hL=fit hS=0; vL=fit'.
p horizontalLayout:#fit.
p verticalLayout:#fit.
@@ -421,7 +426,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace vL=topSpace'.
+ v label:'hL=fitSpace; vL=topSpace'.
p horizontalLayout:#fitSpace.
p verticalLayout:#topSpace.
@@ -439,7 +444,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fit vL=top'.
+ v label:'hL=fit; vL=top'.
p horizontalLayout:#fit.
p verticalLayout:#top.
@@ -458,7 +463,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fitSpace vL=bottomSpace'.
+ v label:'hL=fitSpace; vL=bottomSpace'.
p horizontalLayout:#fitSpace.
p verticalLayout:#bottomSpace.
@@ -476,7 +481,7 @@
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- v label:'hL=fit vL=bottomSpace'.
+ v label:'hL=fit; vL=bottomSpace'.
p horizontalLayout:#fit.
p verticalLayout:#bottomSpace.
@@ -488,6 +493,41 @@
v extent:300 @ 100.
v open
+ example: placing hPanels into a vPanel
+
+ |v vP hP1 hP2 hP3 b1 b2 b3 b4 b5 b6 b7 b8 b9|
+
+ v := StandardSystemView new.
+ vP := VerticalPanelView in:v.
+ vP origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ vP verticalLayout:#fit;
+ verticalSpace:0;
+ horizontalLayout:#fit.
+
+ hP1 := HorizontalPanelView in:vP.
+ hP1 horizontalLayout:#fitSpace;
+ verticalLayout:#center.
+ b1 := Button label:'button1' in:hP1.
+ b2 := Button label:'button2' in:hP1.
+ b3 := Button label:'button3' in:hP1.
+
+ hP2 := HorizontalPanelView in:vP.
+ hP2 horizontalLayout:#fitSpace;
+ verticalLayout:#center.
+ b4 := Button label:'button4' in:hP2.
+ b5 := Button label:'button5' in:hP2.
+ b6 := Button label:'button6' in:hP2.
+
+ hP3 := HorizontalPanelView in:vP.
+ hP3 horizontalLayout:#fitSpace;
+ verticalLayout:#center.
+ b7 := Button label:'button7' in:hP3.
+ b8 := Button label:'button8' in:hP3.
+ b9 := Button label:'button9' in:hP3.
+
+ v extent:300 @ 300.
+ v open
+
example: a browser like table, where the rightmost list
extends to the far right.
@@ -515,7 +555,7 @@
l3 := ScrollableView for:FileSelectionList in:p.
l3 directory:nil.
- l3 ignoreParentDirectory:true.
+ l3 ignoreParentDirectory:false.
v extent:400 @ 300.
v open
"
@@ -528,12 +568,15 @@
the returned value is one of
#left
#leftSpace
+ #leftFit
+ #leftSpaceFit
#center
#spread
#fit
#right
#rightSpace
the default is #center
+ See the class documentation for the meanings.
"
^ hLayout
@@ -547,6 +590,7 @@
#bottom / #bottomSpace
#fit
the default is #center
+ See the class documentation for the meanings.
"
^ vLayout
@@ -556,11 +600,13 @@
"change the horizontal layout as symbol.
The argument, aSymbol must be one of:
#left / #leftSpace
+ #leftFit / #leftSpaceFit
#center
- #spread / spredSpace
+ #spread / spreadSpace
#fit / fitSpace
#right / #rightSpace
- the default (if never changed) is #center
+ the default (if never changed) is #center.
+ See the class documentation for the meanings.
"
(hLayout ~~ aSymbol) ifTrue:[
@@ -577,6 +623,7 @@
#bottom / #bottomSpace
#fit
the default (if never changed) is #center
+ See the class documentation for the meanings.
"
(vLayout ~~ aSymbol) ifTrue:[
@@ -655,7 +702,7 @@
"(re)compute position of every child whenever childs are added or
my size has changed"
- |xpos space sumOfWidths numChilds l wEach wInside|
+ |xpos space sumOfWidths numChilds l wEach wInside hL vL|
subViews isNil ifTrue:[^ self].
@@ -663,7 +710,10 @@
numChilds := subViews size.
wInside := width - (margin * 2) + (borderWidth*2) - subViews last borderWidth.
- hLayout == #fitSpace ifTrue:[
+ hL := hLayout.
+ vL := vLayout.
+
+ hL == #fitSpace ifTrue:[
"
adjust childs extents and set origins.
Be careful to avoid accumulation of rounding errors
@@ -671,7 +721,7 @@
wEach := (wInside - (numChilds + 1 * space)) / numChilds.
xpos := space + margin - borderWidth.
] ifFalse:[
- hLayout == #fit ifTrue:[
+ hL == #fit ifTrue:[
"
adjust childs extents and set origins.
Be careful to avoid accumulation of rounding errors
@@ -684,7 +734,7 @@
"
sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
- l := hLayout.
+ l := hL.
((l == #center) and:[numChilds == 1]) ifTrue:[
l := #spread
].
@@ -696,10 +746,18 @@
compute position of leftmost subview and space between them;
if they do hardly fit, leave no space between them
"
- (sumOfWidths >= (width - (margin * 2))) ifTrue:[
+ ((sumOfWidths >= (width - (margin * 2)))
+ and:[l ~~ #fixLeftSpace and:[l ~~ #fixLeft]]) ifTrue:[
xpos := 0.
space := 0
] ifFalse: [
+ l == #fixLeftSpace ifTrue:[
+ l := #leftSpace
+ ] ifFalse:[
+ l == #fixLeft ifTrue:[
+ l := #left
+ ]
+ ].
((l == #right) or:[l == #rightSpace]) ifTrue:[
xpos := width - (space * (numChilds - 1)) - sumOfWidths.
"
@@ -737,6 +795,11 @@
or:[l == #leftFit
or:[l == #leftSpaceFit]]]) ifTrue:[
space := space min:(width - sumOfWidths) // (numChilds + 1).
+ (hL == #fixLeft or:[hL == #fixLeftSpace]) ifTrue:[
+ space := space max:horizontalSpace.
+ ] ifFalse:[
+ space := space max:0.
+ ].
(l == #leftSpace
or:[l == #leftSpaceFit]) ifTrue:[
xpos := space.
@@ -770,23 +833,23 @@
subViews keysAndValuesDo:[:index :child |
|ypos advance|
- vLayout == #top ifTrue:[
+ vL == #top ifTrue:[
ypos := 0
] ifFalse:[
- vLayout == #topSpace ifTrue:[
+ vL == #topSpace ifTrue:[
ypos := verticalSpace
] ifFalse:[
- vLayout == #bottom ifTrue:[
+ vL == #bottom ifTrue:[
ypos := height - child heightIncludingBorder
] ifFalse:[
- vLayout == #bottomSpace ifTrue:[
+ vL == #bottomSpace ifTrue:[
ypos := height - verticalSpace - child heightIncludingBorder.
] ifFalse:[
- vLayout == #fitSpace ifTrue:[
+ vL == #fitSpace ifTrue:[
ypos := verticalSpace.
child height:(height - (verticalSpace + child borderWidth * 2))
] ifFalse:[
- vLayout == #fit ifTrue:[
+ vL == #fit ifTrue:[
ypos := 0.
child height:(height - (child borderWidth * 2))
] ifFalse:[
@@ -800,7 +863,7 @@
].
(ypos < 0) ifTrue:[ypos := 0].
- (hLayout == #fit or:[hLayout == #fitSpace]) ifTrue:[
+ (hL == #fit or:[hL == #fitSpace]) ifTrue:[
child origin:(xpos truncated @ ypos)
corner:(xpos + wEach - (child borderWidth)) truncated
@ (ypos + child height).
@@ -814,10 +877,10 @@
index == numChilds ifTrue:[
|x|
- hLayout == #leftFit ifTrue:[
+ hL == #leftFit ifTrue:[
x := width - margin.
].
- hLayout == #leftSpaceFit ifTrue:[
+ hL == #leftSpaceFit ifTrue:[
x := width - margin - space
].
x notNil ifTrue:[
--- a/HorizontalScroller.st Sun Apr 30 15:40:03 1995 +0200
+++ b/HorizontalScroller.st Wed May 03 02:30:14 1995 +0200
@@ -1,30 +1,20 @@
-"
- COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
+'From Smalltalk/X, Version:2.10.5 on 30-apr-1995 at 1:46:18 am'!
Scroller subclass:#HorizontalScroller
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Interactors'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
!
HorizontalScroller comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
the scroller part of a horizontal scrollbar
-$Header: /cvs/stx/stx/libwidg/HorizontalScroller.st,v 1.5 1994-08-07 13:22:36 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalScroller.st,v 1.6 1995-05-03 00:29:44 claus Exp $
written spring/summer 89 by claus
'!
@@ -32,96 +22,18 @@
initialize
super initialize.
- moveDirection := #x
+ orientation := #horizontal
! !
!HorizontalScroller methodsFor:'accessing'!
-thumbOrigin:newOrigin
- "set the thumbs origin (in percent)"
-
- |realNewOrigin oldFrame oldLeft oldRight thumbLeft thumbRight
- tH tW delta top|
-
- ((newOrigin + thumbHeight) > 100) ifTrue:[
- realNewOrigin := 100 - thumbHeight
- ] ifFalse: [
- realNewOrigin := newOrigin
- ].
- (realNewOrigin > 100) ifTrue:[
- realNewOrigin := 100
- ] ifFalse: [
- (realNewOrigin < 0) ifTrue:[
- realNewOrigin := 0
- ]
- ].
- (realNewOrigin = thumbOrigin) ifFalse:[
- thumbOrigin := realNewOrigin.
-
- shown ifTrue:[
- oldFrame := thumbFrame.
- self computeThumbFrame.
- (thumbHeight = 100) ifTrue:[^ self].
-
- (thumbFrame ~~ oldFrame) ifTrue:[
- oldFrame isNil ifTrue:[
- self drawThumb.
- ^ self
- ].
- tH := thumbFrame height.
- tW := thumbFrame width.
- oldLeft := oldFrame left.
- oldRight := oldLeft + tW.
-
- thumbLeft := thumbFrame left.
- thumbRight := thumbLeft + tW.
-
- top := thumbFrame top.
-
- (oldRight >= width) ifTrue:[
- "cannot copy - thumb was behind end"
- self drawThumbBackgroundInX:oldLeft y:top
- width:(width - oldLeft" - 1") height:tH.
- self drawThumb.
- ^ self
- ].
-
- self catchExpose.
- self copyFrom:self x:oldLeft y:top
- toX:thumbLeft y:top
- width:tW height:tH.
-
- oldLeft > thumbLeft ifTrue:[
- delta := oldLeft - thumbLeft.
- oldLeft > thumbRight ifTrue:[
- self drawThumbBackgroundInX:oldLeft y:top
- width:(tW + 1) height:tH
- ] ifFalse:[
- self drawThumbBackgroundInX:thumbRight y:top
- width:delta height:tH
- ]
- ] ifFalse:[
- delta := thumbLeft - oldLeft.
- oldRight < thumbLeft ifTrue:[
- self drawThumbBackgroundInX:oldLeft y:top
- width:tW + 1 height:tH
- ] ifFalse:[
- self drawThumbBackgroundInX:oldLeft y:top
- width:delta height:tH
- ]
- ].
- self waitForExpose
- ]
- ]
- ]
+scrollRightAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
!
scrollLeftAction:aBlock
"ignored -
but implemented, so that scroller can be used in place of a scrollbar"
-!
+! !
-scrollRightAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-! !
--- a/LSelBox.st Sun Apr 30 15:40:03 1995 +0200
+++ b/LSelBox.st Wed May 03 02:30:14 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.9 1995-03-31 03:02:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.10 1995-05-03 00:29:49 claus Exp $
'!
!ListSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.9 1995-03-31 03:02:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.10 1995-05-03 00:29:49 claus Exp $
"
!
@@ -166,7 +166,7 @@
mhm: the lists keyboard functions are disabled,
and input passed to the enterfield
"
- selectionList delegate:(KeyboardForwarder to:enterField)
+ selectionList delegate:(KeyboardForwarder to:enterField condition:#noFocus)
!
updateList
@@ -181,7 +181,7 @@
!
focusSequence
- ^ Array with:enterField with:selectionList with:okButton with:abortButton
+ ^ Array with:enterField with:selectionList with:abortButton with:okButton
! !
!ListSelectionBox methodsFor:'queries'!
--- a/Label.st Sun Apr 30 15:40:03 1995 +0200
+++ b/Label.st Wed May 03 02:30:14 1995 +0200
@@ -14,7 +14,7 @@
View subclass:#Label
instanceVariableNames:'logo labelWidth labelHeight labelOriginX labelOriginY adjust
- hSpace vSpace bgColor fgColor fixSize'
+ hSpace vSpace bgColor fgColor fixSize labelMsg'
classVariableNames:'DefaultFont DefaultForegroundColor DefaultBackgroundColor'
poolDictionaries:''
category:'Views-Layout'
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.20 1995-03-31 03:02:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.21 1995-05-03 00:29:53 claus Exp $
'!
!Label class methodsFor:'documentation'!
@@ -45,7 +45,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.20 1995-03-31 03:02:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.21 1995-05-03 00:29:53 claus Exp $
"
!
@@ -54,7 +54,7 @@
This class implements labels, which are views to display a string or image.
The Label will try to do its best to make its contents fit into the
view. The contents can be a String, a collection of Strings (i.e.
- Text) or a Form/Image.
+ a StringCollection) or a Form/Image.
The contents is drawn in fgColor/bgColor, which can be changed using:
@@ -69,7 +69,9 @@
This can be used, if resizing of the label is not wanted.
However, in this case you have to make certain that the size is big enough
- to hold changed logos later.
+ 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).
The placement of the contents within the label is controlled by
the adjust attribute, it can be set with:
@@ -79,6 +81,34 @@
where how is one of the symbols left, #right, #center, #centerLeft or
#centerRight (see the comment in Label>>adjust:). The default is #center.
+ model-less operation:
+ if no model is set, the labels contents is set with:
+
+ aLabel label:aStringOrImage
+
+ and stays constant unless changed by new calls to #label:.
+
+
+ model operation:
+ labels with a model, aspectMsg and labelMsg react to
+ changes of the aspect, and send a labelMsg-message
+ to the model in order to aquire a new labelString or image.
+ The model should send 'self changed:aspectMsg' if it thinks the label
+ should change and return a string or image from the labelMsg-message.
+
+ label model:aModel.
+ label aspect:aspectSymbol.
+ label labelMessage:labelSymbol.
+
+ model sends #changed:aspectSymbol
+ ---> label will redraw its label from value of model perform:labelSymbol
+
+ Having a labelSymbol different from the aspectSymbol allows for two labels
+ to react on the same aspect-change, but use different messages when asking
+ the model for a new label contents. By default, the labelMsg is nil,
+ 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
@@ -99,17 +129,15 @@
resize the label; otherwise, its size is adjusted.
default:false.
- Model-View interaction:
- labels with a model and an aspectSymbol react to changes of this
- aspect, and perform this message on the model to aquire a new labelString.
- The model is should send 'self changed:<aspect>' if it changes and return
- a string from the <aspect> message.
+ labelMsg <Symbol> if non-nil, this is sent to the model to
+ aquire the labelString or labelImage.
+ If nil, the label stays as is
- label model:aModel.
- label aspect:aspectSymbol.
+ styleSheet parameters:
- model sends #changed:aspectSymbol
- ---> label will redraw its label from value of model>>aspectSymbol
+ labelForegroundColor <Color> color to draw foreground pixels (i.e. the string)
+ labelBackgroundColor <Color> color to draw background pixels
+ labelFont <Font> font to use for textual labels
"
!
@@ -183,6 +211,23 @@
top open
+ colors & font:
+ |top l|
+
+ top := StandardSystemView new.
+ top extent:(200 @ 200).
+
+ l := Label in:top.
+ l level:-1.
+ l font:(Font family:'Times' size:18).
+ l foregroundColor:Color yellow.
+ l backgroundColor:Color red.
+ l label:'hello world'.
+ l origin:50@100.
+
+ top open
+
+
border & colors:
|top l|
@@ -210,13 +255,20 @@
l := Label in:top.
l borderWidth:1.
l label:'default - centered'.
- l origin:0.0@70.
+ l origin:0.0@40.
l width:1.0.
l := Label in:top.
l borderWidth:1.
l adjust:#left.
l label:'left adjust'.
+ l origin:0.0@70.
+ l width:1.0.
+
+ l := Label in:top.
+ l borderWidth:1.
+ l adjust:#centerLeft.
+ l label:'centerLeft adjust and a bit too long'.
l origin:0.0@100.
l width:1.0.
@@ -227,11 +279,19 @@
l origin:0.0@130.
l width:1.0.
+ l := Label in:top.
+ l borderWidth:1.
+ l adjust:#centerRight.
+ l label:'centerRight adjust and a bit too long'.
+ l origin:0.0@160.
+ l width:1.0.
+
top open
just a reminder, that instead of doing placement manually
as in ...:
+
|top l|
top := StandardSystemView new.
@@ -302,7 +362,7 @@
l := Label in:top.
l level:-1.
- l form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.2 @ 0.2).
+ l label:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.2 @ 0.2).
l origin:50@100.
top open
@@ -310,7 +370,7 @@
MVC operation (model provides the label):
(have to use a plug to simulate a model which responds to
- the #getLabel message):
+ the #someAspect message):
|top l model|
@@ -321,41 +381,97 @@
top extent:(200 @ 200).
l := Label in:top.
- l model:model; aspect:#someAspect.
+ l model:model; labelMessage:#someAspect.
top open
+ ...
+
+ model changed:#someAspect
+ ...
- MVC operation (model changes aspect after a while):
+ 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).
|top l model|
- model := Plug new.
- model respondTo:#someAspect with:['models labelString'].
+ model := ValueHolder new.
+ model value:0.
+ [
+ 1 to:20 do:[:i |
+ (Delay forSeconds:1) wait.
+ model value:i
+ ].
+ top destroy
+ ] fork.
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
- l model:model; aspect:#someAspect .
+ l model:model; labelMessage:#value.
+
+ top open
+
+
+ MVC operation (model changes aspect after a while;
+ two labels on the same model):
+
+ |top l model|
+
+ model := Plug new.
+ model respondTo:#labelValue1 with:['models labelString1'].
+ model respondTo:#labelValue2 with:['models labelString2'].
+
+ top := StandardSystemView new.
+ top extent:(200 @ 200).
+
+ l := Label origin:0.0@0.0 corner:1.0@0.5 in:top.
+ l model:model; aspect:#someAspect; labelMessage:#labelValue1.
+ l := Label origin:0.0@0.5 corner:1.0@1.0 in:top.
+ l model:model; aspect:#someAspect; labelMessage:#labelValue2.
top open.
+
(Delay forSeconds:5) wait.
- model respondTo:#someAspect with:['new string'].
+ model respondTo:#labelValue1 with:['new string1'].
+ model respondTo:#labelValue2 with:['new string2'].
+
model changed:#someAspect
+
+
+ plugged MVC operation (getBlock returns the label):
+
+ |top l model|
+
+ model := PluggableAdaptor new
+ getBlock:[:m | 'hello']
+ putBlock:nil
+ updateBlock:nil.
+
+ top := StandardSystemView new.
+ top extent:(200 @ 200).
+
+ l := Label origin:0.0@0.0 corner:1.0@0.5 in:top.
+ l model:model; labelMessage:#value.
+
+ top open.
"
! !
!Label class methodsFor:'instance creation'!
form:aForm
- "return a new Label showing a form"
+ "return a new Label showing a form.
+ OBSOLETE: you should now use #label: for both text and bitmap labels."
^ (self on:Display) form:aForm
!
form:aForm in:aView
- "return a new Label showing a form"
+ "return a new Label showing a form.
+ OBSOLETE: you should now use #label:in: for both text and bitmap labels."
^ (self in:aView) form:aForm
! !
@@ -368,6 +484,10 @@
^ 16 @ 16
!
+defaultFont
+ ^ DefaultFont notNil ifTrue:[DefaultFont] ifFalse:[super defaultFont]
+!
+
updateStyleCache
DefaultForegroundColor := StyleSheet colorAt:'labelForegroundColor'.
DefaultForegroundColor isNil ifTrue:[
@@ -417,22 +537,6 @@
^ fgColor
!
-labelString:aString
- "for ST-80 compatibility: same as label:
- set the label-string; adjust extent if not already realized"
-
- self label:aString
-!
-
-label:aString
- "set the label-string; adjust extent if not already realized"
-
- (logo = aString) ifFalse:[
- logo := aString.
- self newLayout
- ]
-!
-
backgroundColor:aColor
"set the background color"
@@ -454,25 +558,65 @@
self redraw
!
-form:aForm
- "set the labels form; adjust extent if not already realized"
+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"
+
+ self label:aString
+!
- (aForm notNil and:[aForm ~~ logo]) ifTrue:[
- logo notNil ifTrue:[
- logo isImageOrForm ifTrue:[
- logo extent = aForm extent ifTrue:[
- logo := aForm.
- ^ self
+label:aStringOrFormOrImage
+ "set the labelString or image; adjust extent if not already realized and
+ not fixedSize"
+
+ (aStringOrFormOrImage ~~ logo) ifTrue:[
+ "/
+ "/ avoid recompute of size, if its an image with
+ "/ the same size
+ "/
+ aStringOrFormOrImage isImageOrForm ifTrue:[
+ logo notNil ifTrue:[
+ logo isImageOrForm ifTrue:[
+ logo extent = aStringOrFormOrImage extent ifTrue:[
+ logo := aStringOrFormOrImage.
+ ^ self
+ ]
]
]
+ ] ifFalse:[
+ (logo = aStringOrFormOrImage) ifTrue:[
+ ^ self
+ ]
].
- logo := aForm.
+ logo := aStringOrFormOrImage.
self newLayout
]
!
+form:aForm
+ "set the labels form; adjust extent if not already realized.
+ OBSOLETE: you should now use #label: for both strings and images"
+
+ self label:aForm
+!
+
+logo:something
+ "set the labels form or string.
+ OBSOLETE: the old version used #form: for images and #label: for strings.
+ you should now use #label: for any."
+
+ self label:something
+!
+
label
- "return the labels string"
+ "return the labels string or image"
^ logo
!
@@ -501,9 +645,14 @@
#left -> left adjust logo
#right -> right adjust logo
#center -> center logo
+ #centerRight -> center logo; if no fit, right adjust
+ (use with filenames, where the interresting part is
+ at the right if the label is too small)
#centerLeft -> center logo; if it does not fit, left adjust it
- #centerRight -> center logo; if no fit, right adjust
+ (use with strings where the interresting part is at the
+ left if the label is too small)
"
+
(adjust ~~ how) ifTrue:[
adjust := how.
self newLayout
@@ -511,22 +660,12 @@
!
font:aFont
- "set the font - if I'm not realized, adjust my size"
+ "set the font - if I'm not realized and not fixedSize, adjust my size"
(aFont ~~ font) ifTrue:[
super font:(aFont on:device).
self newLayout
]
-!
-
-logo:something
- "set the labels form or string"
-
- something isImageOrForm ifTrue:[
- self form:something
- ] ifFalse:[
- self label:something
- ]
! !
!Label methodsFor:'initialization'!
@@ -549,10 +688,10 @@
realize
super realize.
- fgColor := fgColor on:device.
- bgColor := bgColor on:device.
+"/ fgColor := fgColor on:device.
+"/ bgColor := bgColor on:device.
(model notNil
- and:[aspectSymbol notNil]) ifTrue:[
+ and:[aspectMsg notNil]) ifTrue:[
self getLabelFromModel.
]
!
@@ -563,10 +702,8 @@
font := font on:device.
self height:(font height + font descent).
adjust := #center.
- labelOriginX := 0.
- labelOriginY := 0.
- labelWidth := 0.
- labelHeight := 0.
+ labelOriginX := labelOriginY := 0.
+ labelWidth := labelHeight := 0.
logo := nil.
fixSize := false.
hSpace := (self horizontalPixelPerMillimeter:0.5) rounded.
@@ -652,11 +789,20 @@
!Label methodsFor:'private'!
getLabelFromModel
- "ask my model for the label to show"
+ "ask my model for the label to show.
+ Here, we use labelMsg.
+ This allows multiple labels to react on the same aspect,
+ but show different labels when changed (also, constant labels
+ which have a nil labelMsg will not try to aquire a labelString)."
- (model notNil
- and:[aspectSymbol notNil]) ifTrue:[
- self label:(model perform: aspectSymbol) printString.
+ |sym|
+
+ model notNil ifTrue:[
+ sym := labelMsg.
+"/ sym isNil ifTrue:[sym := aspect<sg].
+ sym notNil ifTrue:[
+ self label:(model perform:sym) printString.
+ ]
].
!
@@ -758,7 +904,8 @@
!Label methodsFor:'resizing'!
forceResize
- "resize myself to make text fit into myself."
+ "resize myself to make text fit into myself. Here, this is done even if
+ fixSize is set."
logo notNil ifTrue:[
self extent:self preferedExtent.
@@ -768,8 +915,8 @@
resize
"resize myself to make text fit into myself.
- but only do so, if I have not been given a relative extent
- or an extend computation block."
+ but only do so, if I am not fixedSize and I have NOT been
+ given a relative extent or an extend computation block."
(logo notNil
and:[fixSize not
@@ -785,13 +932,16 @@
!Label methodsFor:'change & update'!
-update:something
+update:something with:aParameter from:changedObject
"the MVC way of changing the label ..."
- (aspectSymbol notNil
- and:[something == aspectSymbol]) ifTrue:[
- self getLabelFromModel.
- ^ self.
+ changedObject == model ifTrue:[
+ something == aspectMsg ifTrue:[
+ labelMsg notNil ifTrue:[
+ self getLabelFromModel.
+ ].
+ ^ self.
+ ]
].
super update:something
! !
@@ -810,4 +960,3 @@
^ super preferedExtent
! !
-
--- a/ListSelectionBox.st Sun Apr 30 15:40:03 1995 +0200
+++ b/ListSelectionBox.st Wed May 03 02:30:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.9 1995-03-31 03:02:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.10 1995-05-03 00:29:49 claus Exp $
'!
!ListSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.9 1995-03-31 03:02:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.10 1995-05-03 00:29:49 claus Exp $
"
!
@@ -166,7 +166,7 @@
mhm: the lists keyboard functions are disabled,
and input passed to the enterfield
"
- selectionList delegate:(KeyboardForwarder to:enterField)
+ selectionList delegate:(KeyboardForwarder to:enterField condition:#noFocus)
!
updateList
@@ -181,7 +181,7 @@
!
focusSequence
- ^ Array with:enterField with:selectionList with:okButton with:abortButton
+ ^ Array with:enterField with:selectionList with:abortButton with:okButton
! !
!ListSelectionBox methodsFor:'queries'!
--- a/ListView.st Sun Apr 30 15:40:03 1995 +0200
+++ b/ListView.st Wed May 03 02:30:14 1995 +0200
@@ -19,7 +19,7 @@
fontHeight fontAscent fontIsFixedWidth fontWidth normalFont
boldFont italicFont autoScrollBlock autoScrollDeltaT
searchPattern wordCheck includesNonStrings widthOfWidestLine
- printItems listSymbol viewOrigin'
+ printItems listMsg viewOrigin'
classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultFont'
poolDictionaries:''
category:'Views-Text'
@@ -29,7 +29,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.22 1995-04-11 16:23:50 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.23 1995-05-03 00:30:03 claus Exp $
'!
!ListView class methodsFor:'documentation'!
@@ -50,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.22 1995-04-11 16:23:50 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.23 1995-05-03 00:30:03 claus Exp $
"
!
@@ -190,7 +190,9 @@
!
withoutRedrawAt:index put:aString
- "change a line and redisplay"
+ "change a line without redisplay"
+
+ |w|
self checkForExistingLine:index.
list at:index put:aString.
@@ -201,6 +203,18 @@
includesNonStrings := (list findFirst:[:l | l notNil and:[l isString not]]) ~~ 0.
]
].
+ widthOfWidestLine notNil ifTrue:[
+ aString isString ifTrue:[
+ w := font widthOf:aString
+ ] ifFalse:[
+ w := aString widthIn:self
+ ].
+ w > widthOfWidestLine ifTrue:[
+ widthOfWidestLine := w
+ ] ifFalse:[
+ widthOfWidestLine := nil "/ means: unknown
+ ].
+ ]
!
at:index put:aString
@@ -384,8 +398,72 @@
! !
+!ListView methodsFor:'accessing-mvc'!
+
+on:aModel aspect:aspectSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:nil
+!
+
+on:aModel aspect:aspectSymbol list:listSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:nil list:listSymbol menu:menuSymbol
+!
+
+on:aModel aspect:aspectSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:menuSymbol
+!
+
+on:aModel aspect:aspectSymbol change:changeSymbol
+ "ST-80 compatibility"
+
+ ^self on:aModel aspect:aspectSymbol change:changeSymbol list:aspectSymbol menu:nil
+!
+
+on:aModel aspect:aspectSymbol change:changeSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:changeSymbol list:nil menu:menuSymbol
+!
+
+on:aModel aspect:aspectSymbol change:changeSymbol list:listSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ aspectSymbol notNil ifTrue:[aspectMsg := aspectSymbol. listMsg := aspectSymbol].
+ listSymbol notNil ifTrue:[listMsg := listSymbol].
+ changeSymbol notNil ifTrue:[changeMsg := changeSymbol].
+ menuMsg := menuSymbol.
+ self model:aModel.
+
+ listMsg notNil ifTrue:[
+ self getListFromModel
+ ].
+!
+
+listMessage:listSymbol
+ "ST-80 compatibility"
+
+ listMsg := listSymbol.
+! !
+
!ListView methodsFor:'private'!
+getListFromModel
+ |text|
+
+ listMsg notNil ifTrue:[
+ text := model perform:listMsg.
+ text notNil ifTrue:[
+ text := text asStringCollection.
+ ].
+ self list:text
+ ].
+!
+
visibleLineToListLine:visibleLineNr
"given a visible line (1..) return linenr in list or nil
(this one returns nil if the given visibleLineNr is one of the
@@ -698,6 +776,16 @@
^ line copyFrom:startCol to:stop
!
+widthOfLineString:entry
+ "return the width of an entry"
+
+ entry isNil ifTrue:[^ 0].
+ entry isString ifTrue:[
+ ^ font widthOf:entry
+ ].
+ ^ entry widthIn:self
+!
+
widthOfWidestLineBetween:firstLine and:lastLine
"return the width in pixels of the widest line in a range
- used to optimize scrolling, by limiting the scrolled area"
@@ -1009,6 +1097,7 @@
|max|
list isNil ifTrue:[^ 0].
+ widthOfWidestLine notNil ifTrue:[^ widthOfWidestLine + (leftMargin * 2)].
includesNonStrings ifTrue:[
max := list
@@ -1035,8 +1124,9 @@
max := max max:(font widthOf:list)
].
].
- ^ max + (leftMargin * 2)
- ]
+ ].
+ widthOfWidestLine := max.
+ ^ max + (leftMargin * 2)
!
yOriginOfContents
@@ -1214,7 +1304,7 @@
makeColVisible:aCol inLine:aLineNr
"if column aCol is not visible, scroll horizontal to make it visible"
- |xWant xVis visLnr oldLeft|
+ |xWant xVis visLnr|
(aCol isNil or:[shown not]) ifTrue:[^ self].
@@ -1584,8 +1674,8 @@
expandTabs
"go through whole text expanding tabs into spaces.
- This is meant to be called for text being imported. Therefore,
- 8-col tabs are assumed - ignoring of any private tab setting."
+ This is meant to be called for text being imported from a file.
+ Therefore, 8-col tabs are assumed - independent of any private tab setting."
|line newLine nLines "{ Class: SmallInteger }"|
@@ -2096,6 +2186,11 @@
includesNonStrings := false
!
+defaultControllerClass
+ self class == ListView ifTrue:[^ ListViewController].
+ ^ super defaultControllerClass
+!
+
recreate
"recreate after a snapin"
@@ -2121,26 +2216,58 @@
|lineString col savedCursor patternSize
line1 "{Class: SmallInteger}"
- line2 "{Class: SmallInteger}"|
+ line2 "{Class: SmallInteger}"
+ p realPattern|
patternSize := pattern size.
(list notNil and:[patternSize ~~ 0]) ifTrue:[
savedCursor := cursor.
self cursor:(Cursor questionMark).
-"/ searchPattern := pattern.
+
col := startCol + 1.
line1 := startLine.
line2 := list size.
- line1 to:line2 do:[:lnr |
- lineString := list at:lnr.
- lineString notNil ifTrue:[
- col := lineString findString:pattern startingAt:col ifAbsent:[0].
- col ~~ 0 ifTrue:[
- self cursor:savedCursor.
- ^ block1 value:lnr value:col.
- ]
+
+ pattern includesMatchCharacters ifTrue:[
+ p := ''.
+ (pattern startsWith:$*) ifFalse:[
+ p := p , '*'
+ ].
+ p := p , pattern.
+ (pattern endsWith:$*) ifFalse:[
+ p := p , '*'
+ ].
+ realPattern := pattern.
+ (realPattern startsWith:$*) ifTrue:[
+ realPattern := realPattern copyFrom:2
].
- col := 1
+ line1 to:line2 do:[:lnr |
+ lineString := list at:lnr.
+ lineString notNil ifTrue:[
+ "/ first a crude check ...
+ (p match:lineString) ifTrue:[
+ "/ ok, there it is; look at which position
+ col := lineString findMatchString:realPattern startingAt:col ignoreCase:false ifAbsent:[0].
+ col ~~ 0 ifTrue:[
+ self cursor:savedCursor.
+ ^ block1 value:lnr value:col.
+ ]
+ ].
+ ].
+ col := 1
+ ]
+ ] ifFalse:[
+ line1 to:line2 do:[:lnr |
+ lineString := list at:lnr.
+ lineString notNil ifTrue:[
+ col := lineString findString:pattern startingAt:col ifAbsent:[0].
+ col ~~ 0 ifTrue:[
+ self cursor:savedCursor.
+ ^ block1 value:lnr value:col.
+ ]
+ ].
+ col := 1
+ ]
]
].
"not found"
@@ -2290,19 +2417,10 @@
!ListView methodsFor:'change and update '!
update:something with:aParameter from:changedObject
- |newList|
-
changedObject == model ifTrue:[
- (aspectSymbol notNil
- and:[something == aspectSymbol]) ifTrue:[
- newList := (model perform:aspectSymbol).
- newList notNil ifTrue:[
- newList := newList asStringCollection.
- ].
- (newList = list) ifFalse:[
- self list:newList
- ].
- ^ self
+ (aspectMsg notNil
+ and:[something == aspectMsg]) ifTrue:[
+ ^ self getListFromModel.
].
].
^ super update:something with:aParameter from:changedObject
@@ -2409,4 +2527,3 @@
super keyPress:key x:x y:y
! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ListViewC.st Wed May 03 02:30:14 1995 +0200
@@ -0,0 +1,74 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Controller subclass:#ListViewController
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+ListViewController comment:'
+COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+$Header: /cvs/stx/stx/libwidg/Attic/ListViewC.st,v 1.1 1995-05-03 00:30:14 claus Exp $
+'!
+
+!ListViewController class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/ListViewC.st,v 1.1 1995-05-03 00:30:14 claus Exp $
+"
+!
+
+documentation
+"
+ a very simple controller: only handles some keys to pageup/down
+ the view.
+"
+! !
+
+!ListViewController methodsFor:'event processing'!
+
+keyPress:key x:x y:y
+ "a key was pressed - handle page-keys here"
+
+ (key == #Prior) ifTrue: [^ view pageUp].
+ (key == #Next) ifTrue: [^ view pageDown].
+
+ (key == #Ctrlb) ifTrue:[^ view pageUp].
+ (key == #Ctrlf) ifTrue:[^ view pageDown].
+ (key == #Ctrld) ifTrue:[^ view halfPageDown].
+ (key == #Ctrlu) ifTrue:[^ view halfPageUp].
+
+ (key == #ScrollUp) ifTrue:[^ view scrollUp].
+ (key == #ScrollDown) ifTrue:[^ view scrollDown].
+
+ super keyPress:key x:x y:y
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ListViewController.st Wed May 03 02:30:14 1995 +0200
@@ -0,0 +1,74 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Controller subclass:#ListViewController
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+ListViewController comment:'
+COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+$Header: /cvs/stx/stx/libwidg/ListViewController.st,v 1.1 1995-05-03 00:30:14 claus Exp $
+'!
+
+!ListViewController class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/ListViewController.st,v 1.1 1995-05-03 00:30:14 claus Exp $
+"
+!
+
+documentation
+"
+ a very simple controller: only handles some keys to pageup/down
+ the view.
+"
+! !
+
+!ListViewController methodsFor:'event processing'!
+
+keyPress:key x:x y:y
+ "a key was pressed - handle page-keys here"
+
+ (key == #Prior) ifTrue: [^ view pageUp].
+ (key == #Next) ifTrue: [^ view pageDown].
+
+ (key == #Ctrlb) ifTrue:[^ view pageUp].
+ (key == #Ctrlf) ifTrue:[^ view pageDown].
+ (key == #Ctrld) ifTrue:[^ view halfPageDown].
+ (key == #Ctrlu) ifTrue:[^ view halfPageUp].
+
+ (key == #ScrollUp) ifTrue:[^ view scrollUp].
+ (key == #ScrollDown) ifTrue:[^ view scrollDown].
+
+ super keyPress:key x:x y:y
+! !
+