--- a/ArrButton.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ArrButton.st Mon Feb 06 01:53:30 1995 +0100
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.10 1995-01-26 18:17:37 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.11 1995-02-06 00:51:51 claus Exp $
'!
!ArrowButton class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.10 1995-01-26 18:17:37 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.11 1995-02-06 00:51:51 claus Exp $
"
!
@@ -529,7 +529,7 @@
initialize
super initialize.
- actionWhenPressed := true.
+ controller beTriggerOnDown.
!
initStyle
@@ -588,7 +588,7 @@
shadowColor := shadowColor on:device.
lightColor := lightColor on:device.
- pressed ifTrue:[
+ controller pressed ifTrue:[
topLeft := shadowColor.
botRight := lightColor
] ifFalse:[
--- a/ArrowButton.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ArrowButton.st Mon Feb 06 01:53:30 1995 +0100
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.10 1995-01-26 18:17:37 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.11 1995-02-06 00:51:51 claus Exp $
'!
!ArrowButton class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.10 1995-01-26 18:17:37 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.11 1995-02-06 00:51:51 claus Exp $
"
!
@@ -529,7 +529,7 @@
initialize
super initialize.
- actionWhenPressed := true.
+ controller beTriggerOnDown.
!
initStyle
@@ -588,7 +588,7 @@
shadowColor := shadowColor on:device.
lightColor := lightColor on:device.
- pressed ifTrue:[
+ controller pressed ifTrue:[
topLeft := shadowColor.
botRight := lightColor
] ifFalse:[
--- a/Button.st Mon Feb 06 01:52:01 1995 +0100
+++ b/Button.st Mon Feb 06 01:53:30 1995 +0100
@@ -12,12 +12,7 @@
Label subclass:#Button
instanceVariableNames:'activeLogo passiveLogo
- pressActionBlock releaseActionBlock
- actionWhenPressed
- enabled pressed active entered
- autoRepeat repeatBlock
onLevel offLevel
- initialDelay repeatDelay
disabledFgColor
activeFgColor activeBgColor
enteredFgColor enteredBgColor
@@ -44,7 +39,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.13 1995-01-26 16:04:47 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.14 1995-02-06 00:51:54 claus Exp $
'!
!Button class methodsFor:'documentation'!
@@ -65,7 +60,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.13 1995-01-26 16:04:47 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.14 1995-02-06 00:51:54 claus Exp $
"
!
@@ -79,18 +74,8 @@
passiveLogo <StringOrImage> logo to show when passive (released)
default is nil for both, so the normal logo is used
(see superclass: Label)
- pressActionBlock <Block> block to evaluate when pressed (default: noop)
- releaseActionBlock <Block> block to evaluate when released (default: noop)
- actionWhenPressed <Boolean> controls if the action should be executed on
- press or on release (default: on release).
- 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
- autoRepeat <Boolean> auto-repeats when pressed long enough (default: false)
onLevel <Integer> level when pressed (3D only) (default: depends on style)
offLevel <Integer> level when released (3D only) (default: depends on style)
- initialDelay <Number> seconds till first auto-repeat (default: 0.2)
- repeatDelay <Number> seconds of repeat intervall (default: 0.025)
disabledFgColor <Color> color used to draw logo when disabled (default: depends on style)
activeFgColor <Color> color to draw logo when pressed (default: depends on style)
activeBgColor <Color> bg color when pressed (default: depends on style)
@@ -108,9 +93,6 @@
formShadowColor <Color> color for shadowing the form (3D only & return)
formLightColor <Color> color for lighting the form (3D only)
- repeatBlock <Block> block evaluated for auto-repeat (internal)
- active <Boolean> true during action evaluation (internal)
-
styleSheet parameters:
@@ -185,20 +167,6 @@
!Button class methodsFor:'defaults'!
-defaultInitialDelay
- "when autorepeat is enabled, and button is not released,
- start repeating after initialDelay seconds"
-
- ^ 0.2
-!
-
-defaultRepeatDelay
- "when autorepeat is enabled, and button is not released,
- repeat every repeatDelay seconds"
-
- ^ 0.025
-!
-
updateStyleCache
|defaultLevel|
@@ -376,14 +344,6 @@
initialize
super initialize.
- actionWhenPressed := false.
- enabled := true.
- active := false.
- pressed := false.
- entered := false.
- autoRepeat := false.
- initialDelay := self class defaultInitialDelay.
- repeatDelay := self class defaultRepeatDelay.
isReturnButton := false.
!
@@ -530,8 +490,8 @@
realize
super realize.
- active := false.
- entered := false.
+ controller active:false.
+ controller entered:false.
fgColor := fgColor on:device.
bgColor := bgColor on:device.
@@ -542,8 +502,14 @@
reinitialize
super reinitialize.
- active := false.
- entered := false
+ controller notNil ifTrue:[
+ controller active:false.
+ controller entered:false.
+ ]
+!
+
+defaultController
+ ^ ButtonController
! !
!Button methodsFor:'queries'!
@@ -578,26 +544,20 @@
disable
"disable the button"
- enabled ifTrue:[
- enabled := false.
- self redraw
- ]
+ controller disable.
!
enable
"enable the button"
- enabled ifFalse:[
- enabled := true.
- self redraw
- ]
+ controller enable
!
turnOffWithoutRedraw
"turn the button off - no redraw"
- pressed := false.
- active := false.
+ controller pressed:false.
+ controller active:false.
"do not use super level:offLevel
- because that one does redraw the edges.
@@ -609,9 +569,9 @@
turnOff
"turn the button off (if not already off)"
- pressed ifTrue:[
- active := false.
- pressed := false.
+ controller pressed ifTrue:[
+ controller active:false.
+ controller pressed:false.
self level:offLevel.
self redraw
]
@@ -620,8 +580,8 @@
turnOn
"turn the button on (if not already on)"
- pressed ifFalse:[
- pressed := true.
+ controller pressed ifFalse:[
+ controller pressed:true.
self level:onLevel.
self redraw
]
@@ -631,60 +591,53 @@
"return the pressAction; thats the block which gets evaluated
when the button is pressed (if non-nil)"
- ^ pressActionBlock
+ ^ controller pressAction
!
pressAction:aBlock
"define the action to be performed on press"
- pressActionBlock := aBlock
+ controller pressAction:aBlock
!
releaseAction
"return the releaseAction; thats the block which gets evaluated
when the button is relreased (if non-nil)"
- ^ releaseActionBlock
+ ^ controller releaseAction
!
releaseAction:aBlock
"define the action to be performed on release"
- releaseActionBlock := aBlock
+ controller releaseAction:aBlock
!
action:aBlock
- "convenient method: depending on the setting of actionWhenPressed,
- either set the press-action clear any release-action or
+ "convenient method: depending on the setting of controllers triggerOnDown flag,
+ either set the press-action and clear any release-action or
vice versa, set the release-action and clear the press-action."
- actionWhenPressed ifTrue:[
- releaseActionBlock := nil.
- pressActionBlock := aBlock
- ] ifFalse:[
- releaseActionBlock := aBlock.
- pressActionBlock := nil
- ]
+ controller action:aBlock
!
autoRepeat
"turn on autorepeat"
- autoRepeat := true.
- repeatBlock := [self repeat]
+ controller autoRepeat
!
isOn
"return true, if this button is currently pressed"
- ^ pressed
+ ^ controller pressed
!
onLevel:aNumber
"set the level of the button when pressed (i.e. how deep)"
onLevel := aNumber.
- pressed ifTrue:[
+ controller pressed ifTrue:[
self level:onLevel.
margin := onLevel abs max:offLevel abs.
self redraw
@@ -701,7 +654,7 @@
"set the level of the button when not pressed (i.e. how high)"
offLevel := aNumber.
- pressed ifFalse:[
+ controller pressed ifFalse:[
self level:offLevel.
margin := onLevel abs max:offLevel abs.
self redraw
@@ -726,7 +679,7 @@
(logo) in both pressed and released states."
activeLogo := anImageOrString.
- pressed ifTrue:[
+ controller pressed ifTrue:[
self logo:anImageOrString
]
!
@@ -737,7 +690,7 @@
(logo) in both pressed and released states."
passiveLogo := anImageOrString.
- pressed ifFalse:[
+ controller pressed ifFalse:[
self logo:anImageOrString
]
!
@@ -752,9 +705,7 @@
"set the foreground color to be used when pressed"
activeFgColor := aColor.
- pressed ifTrue:[
- self redraw
- ]
+ self redrawIfPressed
!
activeBackgroundColor
@@ -767,19 +718,15 @@
"set the background color to be used when pressed"
activeBgColor := aColor.
- pressed ifTrue:[
- self redraw
- ]
+ self redrawIfPressed
!
activeForegroundColor:fgColor backgroundColor:bgColor
- "set the colors to be used when pressed"
+ "set both fg and bg colors to be used when pressed"
activeFgColor := fgColor.
activeBgColor := bgColor.
- pressed ifTrue:[
- self redraw
- ]
+ self redrawIfPressed
!
enteredForegroundColor
@@ -1001,25 +948,32 @@
self redraw.
!
+redrawIfPressed
+ controller pressed ifTrue:[
+ self redraw
+ ]
+!
+
redraw
"like redrawing a label, but hilight when pressed
(lolight when disabled)"
- |fg bg|
+ |fg bg entered|
shown ifFalse:[^ self].
- active ifTrue:[^ self].
+ controller active ifTrue:[^ self].
fg := fgColor.
bg := bgColor.
- enabled ifFalse:[
+ controller enabled ifFalse:[
fg := disabledFgColor
] ifTrue:[
+ entered := controller entered.
entered ifTrue:[
enteredFgColor notNil ifTrue:[fg := enteredFgColor].
enteredBgColor notNil ifTrue:[bg := enteredBgColor]
].
- (pressed and:[entered or:[actionWhenPressed]]) ifTrue:[
+ (controller pressed and:[entered or:[controller isTriggerOnDown]]) ifTrue:[
activeFgColor isNil ifTrue:[
onLevel == offLevel ifTrue:[
fg := bgColor
@@ -1048,191 +1002,3 @@
].
self drawWith:fg and:bg
! !
-
-!Button methodsFor:'event handling'!
-
-buttonPress:button x:x y:y
- "button was pressed - if enabled, perform pressaction"
-
- (button == 1 or:[button == #select]) ifFalse:[
- ^ super buttonPress:button x:x y:y
- ].
- pressed ifFalse:[
- enabled ifTrue:[
- pressed := true.
- self showActive.
-
- (pressActionBlock notNil or:[model notNil]) ifTrue:[
- "
- force output - so that button is drawn correctly in case
- of any long-computation (at high priority)
- "
- device synchronizeOutput.
- ].
-
- active := true.
-
- pressActionBlock notNil ifTrue:[
- pressActionBlock value
- ].
-
- actionWhenPressed ifTrue:[
- "the ST-80 way of doing things"
- (model notNil and:[changeSymbol notNil]) ifTrue:[
- model perform:changeSymbol
- ].
- ].
-
- active := false.
-
- autoRepeat ifTrue:[
- Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
- ]
- ]
- ]
-!
-
-buttonMultiPress:button x:x y:y
- ^ self buttonPress:button x:x y:y
-!
-
-buttonRelease:button x:x y:y
- "button was released - if enabled, perform releaseaction"
-
- (button == 1 or:[button == #select]) ifFalse:[
- ^ super buttonRelease:button x:x y:y
- ].
- pressed ifTrue:[
- autoRepeat ifTrue:[
- Processor removeTimedBlock:repeatBlock
- ].
- pressed := false.
- self showPassive.
- enabled ifTrue:[
- "
- only perform action if released within myself
- "
- ((x >= 0)
- and:[x <= width
- and:[y >= 0
- and:[y <= height]]]) ifTrue:[
-
- (releaseActionBlock notNil or:[model notNil]) ifTrue:[
- "
- force output - so that button is drawn correctly in case
- of any long-computation (at high priority)
- "
- device synchronizeOutput.
- ].
-
- active := true.
-
- releaseActionBlock notNil ifTrue:[
- releaseActionBlock value
- ].
- actionWhenPressed ifFalse:[
- "the ST-80 way of doing things"
- (model notNil and:[changeSymbol notNil]) ifTrue:[
- model perform:changeSymbol
- ].
- ].
-
- active := false.
-
- enteredFgColor notNil ifTrue:[
- self drawWith:enteredFgColor and:enteredBgColor
- ]
- ]
- ]
- ]
-!
-
-keyPress:key x:x y:y
- "only trigger, if I am the focusView of my group"
-
- (windowGroup notNil and:[windowGroup focusView == self]) ifTrue:[
- (key == #Return or:[key == Character space]) ifTrue:[
- "just simulate a buttonPress/release here."
- self buttonPress:1 x:0 y:0.
- self buttonRelease:1 x:0 y:0.
- ^ self.
- ]
- ].
- super keyPress:key x:x y:y
-!
-
-pointerLeave:state
- "redraw with normal colors if they differ from enteredColors"
-
- entered := false.
- pressed ifTrue:[
- "
- leave with mouse-button down;
- stop autorepeating and/or if I am a button with
- action on release, show passive
- "
- autoRepeat ifTrue:[
- Processor removeTimedBlock:repeatBlock
- ].
- actionWhenPressed ifFalse:[
- self showPassive.
- ]
- ] ifFalse:[
- enabled ifTrue:[
- ((enteredFgColor notNil and:[enteredFgColor ~~ fgColor])
- or:[enteredBgColor notNil and:[enteredBgColor ~~ bgColor]]) ifTrue:[
- self redraw
- ]
- ]
- ]
-!
-
-pointerEnter:state x:x y:y
- "redraw with enteredColors if they differ from the normal colors"
-
- entered := true.
- pressed ifTrue:[
- "
- reentered after a leave with mouse-button down;
- restart autorepeating and/or if I am a button with
- actionWhenReleased, show active again.
- "
- enabled ifTrue:[
- autoRepeat ifTrue:[
- Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
- ].
- actionWhenPressed ifFalse:[
- self showActive.
- ]
- ]
- ] ifFalse:[
- enabled ifTrue:[
- ((enteredFgColor notNil and:[enteredFgColor ~~ fgColor])
- or:[enteredBgColor notNil and:[enteredBgColor ~~ bgColor]]) ifTrue:[
- self redraw
- ]
- ]
- ]
-!
-
-repeat
- "this is sent from the autorepeat-block, when the button has been pressed long
- enough; it simulates a release-press, by evaluating both release
- and press actions."
-
- pressed ifTrue:[
- enabled ifTrue:[
- active ifFalse:[
- active := true.
- releaseActionBlock notNil ifTrue:[releaseActionBlock value].
- pressActionBlock notNil ifTrue:[pressActionBlock value].
- active := false.
-"/ device synchronizeOutput.
-
- autoRepeat ifTrue:[
- Processor addTimedBlock:repeatBlock afterSeconds:repeatDelay
- ]
- ]
- ]
- ]
-! !
--- a/ChckTggle.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ChckTggle.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.6 1994-10-10 03:00:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.7 1995-02-06 00:51:59 claus Exp $
'!
!CheckToggle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.6 1994-10-10 03:00:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.7 1995-02-06 00:51:59 claus Exp $
"
!
@@ -107,7 +107,7 @@
!CheckToggle methodsFor:'redrawing'!
redraw
- pressed ifTrue:[
+ controller pressed ifTrue:[
logo := activeLogo.
super redraw
] ifFalse:[
--- a/CheckToggle.st Mon Feb 06 01:52:01 1995 +0100
+++ b/CheckToggle.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.6 1994-10-10 03:00:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.7 1995-02-06 00:51:59 claus Exp $
'!
!CheckToggle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.6 1994-10-10 03:00:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.7 1995-02-06 00:51:59 claus Exp $
"
!
@@ -107,7 +107,7 @@
!CheckToggle methodsFor:'redrawing'!
redraw
- pressed ifTrue:[
+ controller pressed ifTrue:[
logo := activeLogo.
super redraw
] ifFalse:[
--- a/ETxtView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ETxtView.st Mon Feb 06 01:53:30 1995 +0100
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.18 1994-11-28 21:04:55 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.19 1995-02-06 00:52:03 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.18 1994-11-28 21:04:55 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.19 1995-02-06 00:52:03 claus Exp $
"
!
@@ -89,7 +89,6 @@
used globals:
- CopyBuffer <Text> text of last copy or cut
DeleteHistory <Text> last 1000 lines of deleted text
"
! !
@@ -121,10 +120,7 @@
cursorCol := 1.
modified := false.
showMatchingParenthesis := false.
- "
- this will change - focusIn/Out seems to not work always
- "
- hasKeyboardFocus := true.
+ hasKeyboardFocus := false. "/ true.
!
initStyle
@@ -450,20 +446,23 @@
|visLine w
dstY "{ Class: SmallInteger }" |
+ visLine := self listLineToVisibleLine:lineNr.
+ (shown not or:[visLine isNil]) ifTrue:[
+ self withoutRedrawInsertLine:aString before:lineNr.
+ ^ self
+ ].
+
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ dstY := topMargin + ((visLine ) * fontHeight).
+ self catchExpose.
self withoutRedrawInsertLine:aString before:lineNr.
- visLine := self listLineToVisibleLine:lineNr.
- visLine notNil ifTrue:[
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- dstY := topMargin + ((visLine ) * fontHeight).
- self catchExpose.
- self copyFrom:self x:textStartLeft y:(dstY - fontHeight)
- toX:textStartLeft y:dstY
- width:w
- height:((nLinesShown - visLine "- 1") * fontHeight).
- self redrawVisibleLine:visLine.
- self waitForExpose
- ]
+ self copyFrom:self x:textStartLeft y:(dstY - fontHeight)
+ toX:textStartLeft y:dstY
+ width:w
+ height:((nLinesShown - visLine "- 1") * fontHeight).
+ self redrawVisibleLine:visLine.
+ self waitForExpose
!
insertLines:someText from:start to:end before:lineNr
@@ -473,31 +472,42 @@
srcY "{ Class: SmallInteger }"
dstY "{ Class: SmallInteger }" |
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
+ readOnly ifTrue:[
+ ^ self
+ ].
+ visLine := self listLineToVisibleLine:lineNr.
+ (shown not or:[visLine isNil]) ifTrue:[
+ self withoutRedrawInsertLines:someText
+ from:start to:end
+ before:lineNr.
^ self
].
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- visLine := self listLineToVisibleLine:lineNr.
- visLine notNil ifTrue:[
- nLines := end - start + 1.
- ((visLine + nLines) >= nLinesShown) ifTrue:[
- self redrawFromVisibleLine:visLine to:nLinesShown
- ] ifFalse:[
- w := self widthForScrollBetween:(lineNr + nLines)
- and:(firstLineShown + nLines + nLinesShown).
- srcY := topMargin + ((visLine - 1) * fontHeight).
- dstY := srcY + (nLines * fontHeight).
- self catchExpose.
- 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
]
!
@@ -548,10 +558,12 @@
list at:lineNr put:newLine.
modified := true.
contentsWasSaved := false.
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
+ shown ifTrue:[
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
]
!
@@ -655,7 +667,7 @@
"insert aString (which has no crs) at lineNr/colNr"
self withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
- self redrawLine:lineNr from:colNr
+ shown ifTrue:[self redrawLine:lineNr from:colNr]
!
insertStringWithoutCRsAtCursor:aString
@@ -831,13 +843,13 @@
insertTabAtCursor
"insert spaces to next tab"
- |nextTab|
-
self withCursorOffDo:[
+ |nextTab|
+
nextTab := self nextTabAfter:cursorCol.
self insertStringAtCursor:(String new:(nextTab - cursorCol)).
+ self makeCursorVisible.
].
- self makeCursorVisible.
!
deleteFromLine:startLine col:startCol toLine:endLine col:endCol
@@ -957,6 +969,7 @@
w := self widthForScrollBetween:lineNr
and:(firstLineShown + nLinesShown).
(self deleteLineWithoutRedraw:lineNr) ifFalse:[^ self].
+ shown ifFalse:[^ self].
visLine := self listLineToVisibleLine:lineNr.
visLine notNil ifTrue:[
srcY := margin + topMargin + (visLine * fontHeight).
@@ -1193,25 +1206,24 @@
deleteSelection
"delete the selection"
- |startLine startCol endLine endCol|
-
readOnly ifTrue: [
exceptionBlock value:errorMessage.
^ self
].
selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- startCol := selectionStartCol.
- endLine := selectionEndLine.
- endCol := selectionEndCol.
self withCursorOffDo:[
+ |startLine startCol endLine endCol|
+
+ startLine := selectionStartLine.
+ startCol := selectionStartCol.
+ endLine := selectionEndLine.
+ endCol := selectionEndCol.
self unselectWithoutRedraw.
self deleteFromLine:startLine col:startCol
toLine:endLine col:endCol.
cursorCol := startCol.
cursorLine := startLine.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
-"/ self makeLineVisible:cursorLine
self makeCursorVisible
]
]
@@ -1382,7 +1394,8 @@
!
drawCursor:cursorType with:fgColor and:bgColor
- "draw the normal cursor."
+ "draw a cursor; the argument cursorType specifies what type
+ of cursor should be drawn."
|x y w char|
@@ -1392,6 +1405,7 @@
"
^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
].
+
cursorType == #block ifTrue:[
super drawVisibleLine:cursorVisibleLine
col:cursorCol
@@ -1399,11 +1413,12 @@
and:bgColor.
^ self
].
+ x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
+ y := self yOfVisibleLine:cursorVisibleLine.
+
cursorType == #frame ifTrue:[
super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- x := self xOfCol:cursorCol inVisibleLine:cursorVisibleLine.
- y := self yOfVisibleLine:cursorVisibleLine.
char := self characterUnderCursor asString.
self paint:bgColor.
self displayRectangleX:x y:y width:(font widthOf:char)
@@ -1411,8 +1426,6 @@
^ self
].
cursorType == #ibeam ifTrue:[
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := self yOfVisibleLine:cursorVisibleLine.
self paint:bgColor.
self displayLineFromX:x-1 y:y toX:x-1 y:(y + fontHeight - 1).
@@ -1420,8 +1433,7 @@
^ self
].
cursorType == #caret ifTrue:[
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := (self yOfVisibleLine:cursorVisibleLine) + fontHeight - 3.
+ y := y + fontHeight - 3.
w := fontWidth // 2.
self paint:bgColor.
self lineWidth:2.
@@ -1429,8 +1441,7 @@
self displayLineFromX:x y:y toX:x+w y:y+w.
].
cursorType == #solidCaret ifTrue:[
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := (self yOfVisibleLine:cursorVisibleLine) + fontHeight - 3.
+ y := y + fontHeight - 3.
w := fontWidth // 2.
self paint:bgColor.
self fillPolygon:(Array with:(x-w) @ (y+w)
@@ -1439,7 +1450,6 @@
].
!
-
drawFocusCursor
"draw the cursor when the focus is in the view."
@@ -1468,7 +1478,7 @@
cursorVisibleLine notNil ifTrue:[
((cursorType == #caret) or:[cursorType == #solidCaret]) ifTrue:[
"caret-cursor touches 4 characters"
- cursorCol > 1 ifTrue:[
+ ((cursorCol > 1) and:[fontIsFixedWidth]) ifTrue:[
super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
super redrawVisibleLine:cursorVisibleLine+1 from:cursorCol-1 to:cursorCol.
] ifFalse:[
@@ -1541,9 +1551,9 @@
cursorToBottom
"move cursor to last line of text"
- |newTop|
-
self withCursorOffDo:[
+ |newTop|
+
newTop := list size - nFullLinesShown.
(newTop < 1) ifTrue:[
newTop := 1
@@ -1622,13 +1632,17 @@
cursorToEndOfLine
"move cursor to end of current line"
- |line|
-
self withCursorOffDo:[
- line := list at:cursorLine.
- cursorCol := line size + 1
+ |line|
+
+ list isNil ifTrue:[
+ cursorCol := 1
+ ] ifFalse:[
+ line := list at:cursorLine.
+ cursorCol := line size + 1
+ ].
+ self makeCursorVisible.
].
- self makeCursorVisible.
!
cursorTab
@@ -1831,19 +1845,29 @@
paste
"paste copybuffer; if there is a selection, replace it.
otherwise paste at cursor position. Replace is not done
- for selections originating by a paste, to allow multiple
+ for originating by a paste, to allow multiple
paste."
- (self hasSelection notNil and:[typeOfSelection ~~ #paste]) ifTrue:[
+ |sel|
+
+ ((self hasSelection == true) and:[typeOfSelection ~~ #paste]) ifTrue:[
^ self replace
].
- self paste:(Smalltalk at:#CopyBuffer).
+ sel := self getTextSelection.
+ sel notNil ifTrue:[
+ self paste:sel.
+ ]
!
replace
"replace selection by copybuffer"
- self replace:(Smalltalk at:#CopyBuffer)
+ |sel|
+
+ sel := self getTextSelection.
+ sel notNil ifTrue:[
+ self replace:sel
+ ]
!
cut
@@ -1861,7 +1885,7 @@
"
remember in CopyBuffer
"
- Smalltalk at:#CopyBuffer put:lastString.
+ self setTextSelection:lastString.
"
append to DeleteHistory (if there is one)
@@ -1890,12 +1914,21 @@
paste:someText
"paste someText at cursor"
- |startLine startCol|
+ |s startLine startCol|
someText notNil ifTrue:[
+ s := someText.
+ s isString ifTrue:[
+ s := s asText
+ ] ifFalse:[
+ (s isMemberOf:Text) ifFalse:[
+ self warn:'selection not convertable to Text'.
+ ^ self
+ ]
+ ].
startLine := cursorLine.
startCol := cursorCol.
- self insertLines:someText asText withCr:false.
+ self insertLines:s asText withCr:false.
self selectFromLine:startLine col:startCol
toLine:cursorLine col:(cursorCol - 1).
typeOfSelection := #paste.
@@ -2159,8 +2192,14 @@
searchFwd:pattern ifAbsent:aBlock
"do a forward search"
+ self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock
+!
+
+searchFwd:pattern startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
cursorLine isNil ifTrue:[^ self].
- self searchForwardFor:pattern startingAtLine:cursorLine col:cursorCol
+ self searchForwardFor:pattern startingAtLine:startLine col:startCol
ifFound:[:line :col |
self cursorLine:line col:col.
self selectFromLine:line col:col
@@ -2386,65 +2425,83 @@
!
pointerEnter:state x:x y:y
- hasKeyboardFocus := true.
- self drawCursor.
+ (windowGroup isNil or:[windowGroup focusView isNil]) ifTrue:[
+ hasKeyboardFocus := true.
+ cursorShown ifTrue: [self drawCursor].
+ ].
super pointerEnter:state x:x y:y
!
pointerLeave:state
- hasKeyboardFocus := false.
- self drawCursor.
+ (windowGroup isNil or:[windowGroup focusView isNil]) ifTrue:[
+ hasKeyboardFocus := false.
+ cursorShown ifTrue: [self drawCursor].
+ ].
super pointerLeave:state
!
+showFocus
+ hasKeyboardFocus := true.
+ cursorShown ifTrue: [self drawCursor].
+ super showFocus
+!
+
+showNoFocus
+ hasKeyboardFocus := false.
+ cursorShown ifTrue: [self drawCursor].
+ super showNoFocus
+
+!
keyPress:key x:x y:y
"handle keyboard input"
(key isMemberOf:Character) ifTrue:[
- typeOfSelection == #paste ifTrue:[
- "pasted selection will NOT be replaced by keystroke"
- self unselect
- ].
-
- "replace selection by what is typed in -
- if word was selected with a space, keep it"
-
- (selectStyle == #wordLeft) ifTrue:[
- self replaceSelectionBy:(' ' copyWith:key)
- ] ifFalse:[
- (selectStyle == #wordRight) ifTrue:[
- self replaceSelectionBy:(key asString , ' ').
- self cursorLeft
+ readOnly ifFalse:[
+ typeOfSelection == #paste ifTrue:[
+ "pasted selection will NOT be replaced by keystroke"
+ self unselect
+ ].
+
+ "replace selection by what is typed in -
+ if word was selected with a space, keep it"
+
+ (selectStyle == #wordLeft) ifTrue:[
+ self replaceSelectionBy:(' ' copyWith:key)
] ifFalse:[
- self replaceSelectionBy:key
- ]
- ].
- selectStyle := nil.
-
- showMatchingParenthesis ifTrue:[
- "emacs style parenthesis shower"
-
- "claus: only do it for closing parenthesis -
- otherwise its too anoying.
- "
-"
- (#( $( $) $[ $] ${ $} ) includes:key) ifTrue:[
+ (selectStyle == #wordRight) ifTrue:[
+ self replaceSelectionBy:(key asString , ' ').
+ self cursorLeft
+ ] ifFalse:[
+ self replaceSelectionBy:key
+ ]
+ ].
+ selectStyle := nil.
+
+ showMatchingParenthesis ifTrue:[
+ "emacs style parenthesis shower"
+
+ "claus: only do it for closing parenthesis -
+ otherwise its too anoying.
+ "
"
- (#( $) $] $} ) includes:key) ifTrue:[
- self searchForMatchingParenthesisFromLine:cursorLine col:(cursorCol - 1)
- ifFound:[:line :col |
- |savLine savCol|
-
- savLine := cursorLine.
- savCol := cursorCol.
- self cursorLine:line col:col.
- device synchronizeOutput.
- OperatingSystem millisecondDelay:200.
- self cursorLine:savLine col:savCol
- ]
- ifNotFound:[self showNotFound]
- onError:[device beep]
+ (#( $( $) $[ $] ${ $} ) includes:key) ifTrue:[
+"
+ (#( $) $] $} ) includes:key) ifTrue:[
+ self searchForMatchingParenthesisFromLine:cursorLine col:(cursorCol - 1)
+ ifFound:[:line :col |
+ |savLine savCol|
+
+ savLine := cursorLine.
+ savCol := cursorCol.
+ self cursorLine:line col:col.
+ device synchronizeOutput.
+ OperatingSystem millisecondDelay:200.
+ self cursorLine:savLine col:savCol
+ ]
+ ifNotFound:[self showNotFound]
+ onError:[device beep]
+ ].
].
].
^ self
@@ -2577,7 +2634,7 @@
"
" new version deletes selection if any "
selectionStartLine notNil ifTrue:[
- Smalltalk at:#CopyBuffer put:(self selection).
+ self setTextSelection:(self selection).
self deleteSelection. ^ self
].
self makeCursorVisible.
@@ -2585,7 +2642,7 @@
].
(key == #Delete) ifTrue:[
selectionStartLine notNil ifTrue:[
- Smalltalk at:#CopyBuffer put:(self selection).
+ self setTextSelection:(self selection).
self deleteSelection. ^ self
].
self makeCursorVisible.
--- a/EditField.st Mon Feb 06 01:52:01 1995 +0100
+++ b/EditField.st Mon Feb 06 01:53:30 1995 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.11 1994-11-28 21:04:58 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.12 1995-02-06 00:52:10 claus Exp $
'!
!EditField class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.11 1994-11-28 21:04:58 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.12 1995-02-06 00:52:10 claus Exp $
"
!
@@ -379,7 +379,7 @@
(xCol > (width * (5/6))) ifTrue:[
self changed:#preferedExtent
] ifFalse:[
- self widthOfContents < (width * (1/6)) ifTrue:[
+ newWidth < (width * (1/6)) ifTrue:[
self changed:#preferedExtent
]
].
--- a/EditTextView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/EditTextView.st Mon Feb 06 01:53:30 1995 +0100
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.18 1994-11-28 21:04:55 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.19 1995-02-06 00:52:03 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.18 1994-11-28 21:04:55 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.19 1995-02-06 00:52:03 claus Exp $
"
!
@@ -89,7 +89,6 @@
used globals:
- CopyBuffer <Text> text of last copy or cut
DeleteHistory <Text> last 1000 lines of deleted text
"
! !
@@ -121,10 +120,7 @@
cursorCol := 1.
modified := false.
showMatchingParenthesis := false.
- "
- this will change - focusIn/Out seems to not work always
- "
- hasKeyboardFocus := true.
+ hasKeyboardFocus := false. "/ true.
!
initStyle
@@ -450,20 +446,23 @@
|visLine w
dstY "{ Class: SmallInteger }" |
+ visLine := self listLineToVisibleLine:lineNr.
+ (shown not or:[visLine isNil]) ifTrue:[
+ self withoutRedrawInsertLine:aString before:lineNr.
+ ^ self
+ ].
+
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ dstY := topMargin + ((visLine ) * fontHeight).
+ self catchExpose.
self withoutRedrawInsertLine:aString before:lineNr.
- visLine := self listLineToVisibleLine:lineNr.
- visLine notNil ifTrue:[
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- dstY := topMargin + ((visLine ) * fontHeight).
- self catchExpose.
- self copyFrom:self x:textStartLeft y:(dstY - fontHeight)
- toX:textStartLeft y:dstY
- width:w
- height:((nLinesShown - visLine "- 1") * fontHeight).
- self redrawVisibleLine:visLine.
- self waitForExpose
- ]
+ self copyFrom:self x:textStartLeft y:(dstY - fontHeight)
+ toX:textStartLeft y:dstY
+ width:w
+ height:((nLinesShown - visLine "- 1") * fontHeight).
+ self redrawVisibleLine:visLine.
+ self waitForExpose
!
insertLines:someText from:start to:end before:lineNr
@@ -473,31 +472,42 @@
srcY "{ Class: SmallInteger }"
dstY "{ Class: SmallInteger }" |
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
+ readOnly ifTrue:[
+ ^ self
+ ].
+ visLine := self listLineToVisibleLine:lineNr.
+ (shown not or:[visLine isNil]) ifTrue:[
+ self withoutRedrawInsertLines:someText
+ from:start to:end
+ before:lineNr.
^ self
].
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- visLine := self listLineToVisibleLine:lineNr.
- visLine notNil ifTrue:[
- nLines := end - start + 1.
- ((visLine + nLines) >= nLinesShown) ifTrue:[
- self redrawFromVisibleLine:visLine to:nLinesShown
- ] ifFalse:[
- w := self widthForScrollBetween:(lineNr + nLines)
- and:(firstLineShown + nLines + nLinesShown).
- srcY := topMargin + ((visLine - 1) * fontHeight).
- dstY := srcY + (nLines * fontHeight).
- self catchExpose.
- 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
]
!
@@ -548,10 +558,12 @@
list at:lineNr put:newLine.
modified := true.
contentsWasSaved := false.
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
+ shown ifTrue:[
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
]
!
@@ -655,7 +667,7 @@
"insert aString (which has no crs) at lineNr/colNr"
self withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
- self redrawLine:lineNr from:colNr
+ shown ifTrue:[self redrawLine:lineNr from:colNr]
!
insertStringWithoutCRsAtCursor:aString
@@ -831,13 +843,13 @@
insertTabAtCursor
"insert spaces to next tab"
- |nextTab|
-
self withCursorOffDo:[
+ |nextTab|
+
nextTab := self nextTabAfter:cursorCol.
self insertStringAtCursor:(String new:(nextTab - cursorCol)).
+ self makeCursorVisible.
].
- self makeCursorVisible.
!
deleteFromLine:startLine col:startCol toLine:endLine col:endCol
@@ -957,6 +969,7 @@
w := self widthForScrollBetween:lineNr
and:(firstLineShown + nLinesShown).
(self deleteLineWithoutRedraw:lineNr) ifFalse:[^ self].
+ shown ifFalse:[^ self].
visLine := self listLineToVisibleLine:lineNr.
visLine notNil ifTrue:[
srcY := margin + topMargin + (visLine * fontHeight).
@@ -1193,25 +1206,24 @@
deleteSelection
"delete the selection"
- |startLine startCol endLine endCol|
-
readOnly ifTrue: [
exceptionBlock value:errorMessage.
^ self
].
selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- startCol := selectionStartCol.
- endLine := selectionEndLine.
- endCol := selectionEndCol.
self withCursorOffDo:[
+ |startLine startCol endLine endCol|
+
+ startLine := selectionStartLine.
+ startCol := selectionStartCol.
+ endLine := selectionEndLine.
+ endCol := selectionEndCol.
self unselectWithoutRedraw.
self deleteFromLine:startLine col:startCol
toLine:endLine col:endCol.
cursorCol := startCol.
cursorLine := startLine.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
-"/ self makeLineVisible:cursorLine
self makeCursorVisible
]
]
@@ -1382,7 +1394,8 @@
!
drawCursor:cursorType with:fgColor and:bgColor
- "draw the normal cursor."
+ "draw a cursor; the argument cursorType specifies what type
+ of cursor should be drawn."
|x y w char|
@@ -1392,6 +1405,7 @@
"
^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
].
+
cursorType == #block ifTrue:[
super drawVisibleLine:cursorVisibleLine
col:cursorCol
@@ -1399,11 +1413,12 @@
and:bgColor.
^ self
].
+ x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
+ y := self yOfVisibleLine:cursorVisibleLine.
+
cursorType == #frame ifTrue:[
super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- x := self xOfCol:cursorCol inVisibleLine:cursorVisibleLine.
- y := self yOfVisibleLine:cursorVisibleLine.
char := self characterUnderCursor asString.
self paint:bgColor.
self displayRectangleX:x y:y width:(font widthOf:char)
@@ -1411,8 +1426,6 @@
^ self
].
cursorType == #ibeam ifTrue:[
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := self yOfVisibleLine:cursorVisibleLine.
self paint:bgColor.
self displayLineFromX:x-1 y:y toX:x-1 y:(y + fontHeight - 1).
@@ -1420,8 +1433,7 @@
^ self
].
cursorType == #caret ifTrue:[
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := (self yOfVisibleLine:cursorVisibleLine) + fontHeight - 3.
+ y := y + fontHeight - 3.
w := fontWidth // 2.
self paint:bgColor.
self lineWidth:2.
@@ -1429,8 +1441,7 @@
self displayLineFromX:x y:y toX:x+w y:y+w.
].
cursorType == #solidCaret ifTrue:[
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := (self yOfVisibleLine:cursorVisibleLine) + fontHeight - 3.
+ y := y + fontHeight - 3.
w := fontWidth // 2.
self paint:bgColor.
self fillPolygon:(Array with:(x-w) @ (y+w)
@@ -1439,7 +1450,6 @@
].
!
-
drawFocusCursor
"draw the cursor when the focus is in the view."
@@ -1468,7 +1478,7 @@
cursorVisibleLine notNil ifTrue:[
((cursorType == #caret) or:[cursorType == #solidCaret]) ifTrue:[
"caret-cursor touches 4 characters"
- cursorCol > 1 ifTrue:[
+ ((cursorCol > 1) and:[fontIsFixedWidth]) ifTrue:[
super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
super redrawVisibleLine:cursorVisibleLine+1 from:cursorCol-1 to:cursorCol.
] ifFalse:[
@@ -1541,9 +1551,9 @@
cursorToBottom
"move cursor to last line of text"
- |newTop|
-
self withCursorOffDo:[
+ |newTop|
+
newTop := list size - nFullLinesShown.
(newTop < 1) ifTrue:[
newTop := 1
@@ -1622,13 +1632,17 @@
cursorToEndOfLine
"move cursor to end of current line"
- |line|
-
self withCursorOffDo:[
- line := list at:cursorLine.
- cursorCol := line size + 1
+ |line|
+
+ list isNil ifTrue:[
+ cursorCol := 1
+ ] ifFalse:[
+ line := list at:cursorLine.
+ cursorCol := line size + 1
+ ].
+ self makeCursorVisible.
].
- self makeCursorVisible.
!
cursorTab
@@ -1831,19 +1845,29 @@
paste
"paste copybuffer; if there is a selection, replace it.
otherwise paste at cursor position. Replace is not done
- for selections originating by a paste, to allow multiple
+ for originating by a paste, to allow multiple
paste."
- (self hasSelection notNil and:[typeOfSelection ~~ #paste]) ifTrue:[
+ |sel|
+
+ ((self hasSelection == true) and:[typeOfSelection ~~ #paste]) ifTrue:[
^ self replace
].
- self paste:(Smalltalk at:#CopyBuffer).
+ sel := self getTextSelection.
+ sel notNil ifTrue:[
+ self paste:sel.
+ ]
!
replace
"replace selection by copybuffer"
- self replace:(Smalltalk at:#CopyBuffer)
+ |sel|
+
+ sel := self getTextSelection.
+ sel notNil ifTrue:[
+ self replace:sel
+ ]
!
cut
@@ -1861,7 +1885,7 @@
"
remember in CopyBuffer
"
- Smalltalk at:#CopyBuffer put:lastString.
+ self setTextSelection:lastString.
"
append to DeleteHistory (if there is one)
@@ -1890,12 +1914,21 @@
paste:someText
"paste someText at cursor"
- |startLine startCol|
+ |s startLine startCol|
someText notNil ifTrue:[
+ s := someText.
+ s isString ifTrue:[
+ s := s asText
+ ] ifFalse:[
+ (s isMemberOf:Text) ifFalse:[
+ self warn:'selection not convertable to Text'.
+ ^ self
+ ]
+ ].
startLine := cursorLine.
startCol := cursorCol.
- self insertLines:someText asText withCr:false.
+ self insertLines:s asText withCr:false.
self selectFromLine:startLine col:startCol
toLine:cursorLine col:(cursorCol - 1).
typeOfSelection := #paste.
@@ -2159,8 +2192,14 @@
searchFwd:pattern ifAbsent:aBlock
"do a forward search"
+ self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock
+!
+
+searchFwd:pattern startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
cursorLine isNil ifTrue:[^ self].
- self searchForwardFor:pattern startingAtLine:cursorLine col:cursorCol
+ self searchForwardFor:pattern startingAtLine:startLine col:startCol
ifFound:[:line :col |
self cursorLine:line col:col.
self selectFromLine:line col:col
@@ -2386,65 +2425,83 @@
!
pointerEnter:state x:x y:y
- hasKeyboardFocus := true.
- self drawCursor.
+ (windowGroup isNil or:[windowGroup focusView isNil]) ifTrue:[
+ hasKeyboardFocus := true.
+ cursorShown ifTrue: [self drawCursor].
+ ].
super pointerEnter:state x:x y:y
!
pointerLeave:state
- hasKeyboardFocus := false.
- self drawCursor.
+ (windowGroup isNil or:[windowGroup focusView isNil]) ifTrue:[
+ hasKeyboardFocus := false.
+ cursorShown ifTrue: [self drawCursor].
+ ].
super pointerLeave:state
!
+showFocus
+ hasKeyboardFocus := true.
+ cursorShown ifTrue: [self drawCursor].
+ super showFocus
+!
+
+showNoFocus
+ hasKeyboardFocus := false.
+ cursorShown ifTrue: [self drawCursor].
+ super showNoFocus
+
+!
keyPress:key x:x y:y
"handle keyboard input"
(key isMemberOf:Character) ifTrue:[
- typeOfSelection == #paste ifTrue:[
- "pasted selection will NOT be replaced by keystroke"
- self unselect
- ].
-
- "replace selection by what is typed in -
- if word was selected with a space, keep it"
-
- (selectStyle == #wordLeft) ifTrue:[
- self replaceSelectionBy:(' ' copyWith:key)
- ] ifFalse:[
- (selectStyle == #wordRight) ifTrue:[
- self replaceSelectionBy:(key asString , ' ').
- self cursorLeft
+ readOnly ifFalse:[
+ typeOfSelection == #paste ifTrue:[
+ "pasted selection will NOT be replaced by keystroke"
+ self unselect
+ ].
+
+ "replace selection by what is typed in -
+ if word was selected with a space, keep it"
+
+ (selectStyle == #wordLeft) ifTrue:[
+ self replaceSelectionBy:(' ' copyWith:key)
] ifFalse:[
- self replaceSelectionBy:key
- ]
- ].
- selectStyle := nil.
-
- showMatchingParenthesis ifTrue:[
- "emacs style parenthesis shower"
-
- "claus: only do it for closing parenthesis -
- otherwise its too anoying.
- "
-"
- (#( $( $) $[ $] ${ $} ) includes:key) ifTrue:[
+ (selectStyle == #wordRight) ifTrue:[
+ self replaceSelectionBy:(key asString , ' ').
+ self cursorLeft
+ ] ifFalse:[
+ self replaceSelectionBy:key
+ ]
+ ].
+ selectStyle := nil.
+
+ showMatchingParenthesis ifTrue:[
+ "emacs style parenthesis shower"
+
+ "claus: only do it for closing parenthesis -
+ otherwise its too anoying.
+ "
"
- (#( $) $] $} ) includes:key) ifTrue:[
- self searchForMatchingParenthesisFromLine:cursorLine col:(cursorCol - 1)
- ifFound:[:line :col |
- |savLine savCol|
-
- savLine := cursorLine.
- savCol := cursorCol.
- self cursorLine:line col:col.
- device synchronizeOutput.
- OperatingSystem millisecondDelay:200.
- self cursorLine:savLine col:savCol
- ]
- ifNotFound:[self showNotFound]
- onError:[device beep]
+ (#( $( $) $[ $] ${ $} ) includes:key) ifTrue:[
+"
+ (#( $) $] $} ) includes:key) ifTrue:[
+ self searchForMatchingParenthesisFromLine:cursorLine col:(cursorCol - 1)
+ ifFound:[:line :col |
+ |savLine savCol|
+
+ savLine := cursorLine.
+ savCol := cursorCol.
+ self cursorLine:line col:col.
+ device synchronizeOutput.
+ OperatingSystem millisecondDelay:200.
+ self cursorLine:savLine col:savCol
+ ]
+ ifNotFound:[self showNotFound]
+ onError:[device beep]
+ ].
].
].
^ self
@@ -2577,7 +2634,7 @@
"
" new version deletes selection if any "
selectionStartLine notNil ifTrue:[
- Smalltalk at:#CopyBuffer put:(self selection).
+ self setTextSelection:(self selection).
self deleteSelection. ^ self
].
self makeCursorVisible.
@@ -2585,7 +2642,7 @@
].
(key == #Delete) ifTrue:[
selectionStartLine notNil ifTrue:[
- Smalltalk at:#CopyBuffer put:(self selection).
+ self setTextSelection:(self selection).
self deleteSelection. ^ self
].
self makeCursorVisible.
--- a/EnterBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/EnterBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -10,22 +10,15 @@
hereby transferred.
"
-ModalBox subclass:#EnterBox
- instanceVariableNames:'labelField enterField buttonPanel
- okButton abortButton
- okAction abortAction'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-DialogBoxes'
+'From Smalltalk/X, Version:2.10.4 on 28-dec-1994 at 2:45:44 pm'!
+
+DialogBox subclass:#EnterBox
+ instanceVariableNames:'labelField enterField'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-DialogBoxes'
!
-EnterBox comment:'
-COPYRIGHT (c) 1990 by Claus Gittinger
- All Rights Reserved
-
-$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.13 1994-12-28 14:44:02 claus Exp $
-'!
-
!EnterBox class methodsFor:'documentation'!
copyright
@@ -44,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.13 1994-12-28 14:44:02 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.14 1995-02-06 00:52:12 claus Exp $
"
!
@@ -133,30 +126,6 @@
"
! !
-!EnterBox class methodsFor:'defaults'!
-
-defaultExtent
- ^ (Display pixelPerMillimeter * (60 @ 30)) rounded
-!
-
-minExtent
- ^ self defaultExtent
-! !
-
-!EnterBox class methodsFor:'easy startup '!
-
-request:aTitle
- "create and show an enterBox asking for aTitle.
- Return the enterred string or nil (if abort was pressed).
- The string may be empty, in case return was pressed immediately."
-
- ^ self new request:aTitle
-
- "
- EnterBox request:'enter a string'
- "
-! !
-
!EnterBox class methodsFor:'instance creation'!
action:aBlock
@@ -174,13 +143,6 @@
^ self new title:titleString
!
-title:titleString action:aBlock
- "create and return a new EnterBox with title aString,
- which will evaluate aBlock when 'ok' is pressed"
-
- ^ ((self new) title:titleString) action:aBlock
-!
-
title:titleString okText:okText abortText:abortText action:aBlock
"create and return a new EnterBox with title aString, and buttons showing
okText and abortText; it will evaluate aBlock when 'ok' is pressed"
@@ -188,19 +150,123 @@
^ ((self new) title:titleString
okText:okText
abortText:abortText) action:aBlock
+!
+
+title:titleString action:aBlock
+ "create and return a new EnterBox with title aString,
+ which will evaluate aBlock when 'ok' is pressed"
+
+ ^ ((self new) title:titleString) action:aBlock
+! !
+
+!EnterBox class methodsFor:'defaults'!
+
+minExtent
+ ^ self defaultExtent
+!
+
+defaultExtent
+ ^ (Display pixelPerMillimeter * (60 @ 30)) rounded
+! !
+
+!EnterBox class methodsFor:'easy startup '!
+
+request:aTitle
+ "create and show an enterBox asking for aTitle.
+ Return the enterred string or nil (if abort was pressed).
+ The string may be empty, in case return was pressed immediately."
+
+ ^ self new request:aTitle
+
+ "
+ EnterBox request:'enter a string'
+ "
+! !
+
+!EnterBox methodsFor:'accessing'!
+
+contents
+ "return my contents"
+
+ ^ enterField contents
+!
+
+initialText:aString
+ "define the initial text in the enterfield. all will be selected initially"
+
+ enterField initialText:aString
+!
+
+title:aString
+ "set the title to be displayed at top of enterBox"
+
+ |oldSize|
+
+ aString ~= labelField label ifTrue:[
+ oldSize := labelField extent.
+ labelField label:aString.
+ labelField resize.
+
+ labelField extent ~= oldSize ifTrue:[
+ self resize
+ ]
+ ]
+!
+
+initialText:aString selectFrom:start to:stop
+ "define the initial text in the enterfield, and the part to be selected"
+
+ enterField initialText:aString.
+ enterField selectFromLine:1 col:start toLine:1 col:stop
+!
+
+title:titleString okText:okString
+ "set title and text in okbutton"
+
+ (titleString ~= labelField label or:[okString ~= okButton label]) ifTrue:[
+ okButton label:okString.
+ okButton resize.
+ labelField label:titleString.
+ labelField resize.
+ self resize.
+ ]
+!
+
+title:titleString okText:okString abortText:abortString
+ "set title and texts in the buttons"
+
+ (titleString ~= labelField label
+ or:[okString ~= okButton label
+ or:[abortString ~= abortButton label]]) ifTrue:[
+ okButton label:okString.
+ okButton resize.
+ abortButton label:abortString.
+ abortButton resize.
+ labelField label:titleString.
+ labelField resize.
+ self resize.
+ ]
! !
!EnterBox methodsFor:'initialization'!
+createEnterField
+ "this has been extracted from the initialize method
+ to allow redefinition in subclasses. (FilenameEnterBox for example)"
+
+ enterField := EditField in:self.
+!
+
initialize
- |space2 innerWidth bw2 bh|
+ |space2 innerWidth bw2|
super initialize.
+ self addAbortButton; addOkButton.
+
label := 'Enter'.
space2 := 2 * ViewSpacing.
- bw2 := borderWidth * 2.
innerWidth := width - space2.
labelField := Label in:self.
@@ -217,38 +283,12 @@
enterField leaveAction:[:key | self okPressed].
enterField addDependent:self. "to get preferedExtent-changes"
- bh := font height * 2 + bw2.
- buttonPanel := HorizontalPanelView in:self.
- buttonPanel origin:[ViewSpacing @ (height - bh - ViewSpacing)]
- extent:[(width - space2) @ bh].
-
- buttonPanel layout:#fit; borderWidth:0.
-
- abortButton := Button abortButtonIn:buttonPanel.
- abortButton action:[
- abortButton turnOffWithoutRedraw.
- self abortPressed
- ].
-
- okButton := Button okButtonIn:buttonPanel.
- okButton action:[
- okButton turnOffWithoutRedraw.
- self okPressed
- ].
-
"
forward keyboard input to the enterfield
"
self keyboardHandler:enterField
!
-createEnterField
- "this has been extracted from the initialize method
- to allow redefinition in subclasses. (FilenameEnterBox for example)"
-
- enterField := EditField in:self.
-!
-
reAdjustGeometry
"sent late in snapin processing - gives me a chance
to resize for new font dimensions"
@@ -258,36 +298,22 @@
okButton resize.
abortButton resize.
self resize
-! !
-
-!EnterBox methodsFor:'realization'!
+!
-positionOffset
- "return the delta, by which the box should be displayed
- from the mouse pointer. Value returned here makes
- okButton appear under the cursor"
-
- buttonPanel setChildPositionsIfChanged.
- ^ (okButton originRelativeTo:self) + (okButton extent // 2)
+focusSequence
+ ^ Array with:enterField with:abortButton with:okButton
! !
-!EnterBox methodsFor:'startup'!
+!EnterBox methodsFor:'dependencies'!
-request
- "open the box and return the entered string or nil, if
- abort was pressed"
+update:something with:someArgument from:changedObject
+ "sent if my enterbox thinks it needs more real-estate ..."
- self action:[:string | ^ string].
- self open.
- ^ nil
-!
-
-request:title
- "set the title, open the box and return the entered string or nil, if
- abort was pressed"
-
- self title:title.
- ^ self request
+ changedObject == enterField ifTrue:[
+ something == #preferedExtent ifTrue:[
+ self resize
+ ]
+ ]
! !
!EnterBox methodsFor:'queries'!
@@ -315,147 +341,7 @@
^ wWanted @ hWanted
! !
-!EnterBox methodsFor:'accessing'!
-
-title:aString
- "set the title to be displayed at top of enterBox"
-
- |oldSize|
-
- aString ~= labelField label ifTrue:[
- oldSize := labelField extent.
- labelField label:aString.
- labelField resize.
-
- labelField extent ~= oldSize ifTrue:[
- self resize
- ]
- ]
-!
-
-title:titleString okText:okString abortText:abortString
- "set title and texts in the buttons"
-
- (titleString ~= labelField label
- or:[okString ~= okButton label
- or:[abortString ~= abortButton label]]) ifTrue:[
- okButton label:okString.
- okButton resize.
- abortButton label:abortString.
- abortButton resize.
- labelField label:titleString.
- labelField resize.
- self resize.
- ]
-!
-
-title:titleString okText:okString
- "set title and text in okbutton"
-
- (titleString ~= labelField label or:[okString ~= okButton label]) ifTrue:[
- okButton label:okString.
- okButton resize.
- labelField label:titleString.
- labelField resize.
- self resize.
- ]
-!
-
-okText:aString
- "set the text to be displayed in the ok-button"
-
- |oldSize|
-
- aString ~= okButton label ifTrue:[
- oldSize := okButton extent.
- okButton label:aString.
- okButton resize.
- okButton extent ~= oldSize ifTrue:[
- self resize
- ]
- ]
-!
-
-abortText:aString
- "set the text to be displayed in the abort-button"
-
- |oldSize|
-
- aString ~= abortButton label ifTrue:[
- oldSize := abortButton extent.
- abortButton label:aString.
- abortButton resize.
- abortButton extent ~= oldSize ifTrue:[
- self resize
- ]
- ]
-!
-
-okText:okString abortText:abortString
- "set both texts displayed in the buttons"
-
- (abortString ~= abortButton label
- or:[okString ~= okButton label]) ifTrue:[
- okButton label:okString.
- abortButton label:abortString.
- okButton resize.
- abortButton resize.
- self resize
- ]
-!
-
-contents
- "return my contents"
-
- ^ enterField contents
-!
-
-initialText:aString
- "define the initial text in the enterfield. all will be selected initially"
-
- enterField initialText:aString
-!
-
-initialText:aString selectFrom:start to:stop
- "define the initial text in the enterfield, and the part to be selected"
-
- enterField initialText:aString.
- enterField selectFromLine:1 col:start toLine:1 col:stop
-!
-
-action:aBlock
- "set the action to be performed when user presses ok-button;
- aBlock must be nil or a block with one argument "
-
- okAction := aBlock
-!
-
-okAction:aBlock
- "same as action - for your convenience"
-
- okAction := aBlock
-!
-
-abortAction:aBlock
- "set the action to be performed when user presses abort-button;
- aBlock must be nil or a block with no arguments"
-
- abortAction := aBlock
-! !
-
-!EnterBox methodsFor:'dependencies'!
-
-update:something with:someArgument from:changedObject
- "sent if my enterbox thinks it needs more real-estate ..."
-
- changedObject == enterField ifTrue:[
- something == #preferedExtent ifTrue:[
- self resize
- ]
- ]
-! !
-
-!EnterBox methodsFor:'user interaction'!
+!EnterBox methodsFor:'user actions'!
hideAndEvaluate:aBlock
"common processing for all ok-actions (see subclasses);
@@ -473,16 +359,24 @@
].
aBlock value:string
]
+! !
+
+!EnterBox methodsFor:'startup'!
+
+request
+ "open the box and return the entered string or nil, if
+ abort was pressed"
+
+ self action:[:string | ^ string].
+ self open.
+ ^ nil
!
-okPressed
- "user pressed ok button - hide myself and evaluate okAction"
-
- self hideAndEvaluate:okAction
-!
+request:title
+ "set the title, open the box and return the entered string or nil, if
+ abort was pressed"
-abortPressed
- "user pressed abort button - hide myself and evaluate okAction"
+ self title:title.
+ ^ self request
+! !
- self hideAndEvaluate:abortAction
-! !
--- a/EnterBox2.st Mon Feb 06 01:52:01 1995 +0100
+++ b/EnterBox2.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.8 1994-10-28 03:24:58 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.9 1995-02-06 00:52:15 claus Exp $
'!
!EnterBox2 class methodsFor:'documentation '!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.8 1994-10-28 03:24:58 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.9 1995-02-06 00:52:15 claus Exp $
"
!
@@ -83,12 +83,16 @@
self ok2Pressed
].
"
- the old (see superclass) ok-button is not a return-button
+ the old (see superclass) ok-button is no longer a return-button
"
okButton isReturnButton:false.
self resize.
enterField leaveAction:[:key | self ok2Pressed]
+!
+
+focusSequence
+ ^ Array with:enterField with:abortButton with:okButton with:okButton2
! !
!EnterBox2 methodsFor:'realization'!
@@ -135,4 +139,13 @@
"user pressed 2nd ok button - evaluate action"
self hideAndEvaluate:okAction2
+!
+
+keyPress:aKey x:x y:y
+ "return-key dublicates ok-function if acceptReturnAsOK is true"
+
+ acceptReturnAsOK ifTrue:[
+ (aKey == #Return) ifTrue:[^ self ok2Pressed]
+ ].
+ super keyPress:aKey x:x y:y
! !
--- a/FSaveBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/FSaveBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -11,7 +11,7 @@
"
FileSelectionBox subclass:#FileSaveBox
- instanceVariableNames:'appendAction'
+ instanceVariableNames:'appendButton appendAction'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.2 1994-10-10 03:01:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.3 1995-02-06 00:52:16 claus Exp $
'!
!FileSaveBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.2 1994-10-10 03:01:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.3 1995-02-06 00:52:16 claus Exp $
"
!
@@ -69,20 +69,40 @@
!FileSaveBox methodsFor:'initialization'!
initialize
- |b|
+ super initialize.
- super initialize.
+ label := 'Save file dialog'.
okButton label:(resources string:'save').
"
insert an append-button between abort- and save-buttons
"
- b := Button okButtonIn:nil.
- b isReturnButton:false.
- b label:(resources string:'append').
- b action:[b turnOffWithoutRedraw. self appendPressed].
- buttonPanel addSubView:b after:abortButton
+ appendButton := Button okButtonIn:nil.
+ appendButton isReturnButton:false.
+ appendButton label:(resources string:'append').
+ appendButton action:[appendButton turnOffWithoutRedraw. self appendPressed].
+ buttonPanel addSubView:appendButton after:abortButton
+!
+
+focusSequence
+ |a|
+
+ patternField shown ifTrue:[
+ a := Array new:6.
+ a at:1 put:enterField.
+ a at:2 put:patternField.
+ a at:3 put:selectionList.
+ a at:4 put:abortButton.
+ a at:5 put:appendButton.
+ a at:6 put:okButton.
+ ^ a
+ ].
+ ^ Array with:enterField
+ with:selectionList
+ with:abortButton
+ with:appendButton
+ with:okButton
! !
!FileSaveBox methodsFor:'accessing'!
--- a/FSelBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/FSelBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/FSelBox.st,v 1.11 1994-11-17 14:34:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/FSelBox.st,v 1.12 1995-02-06 00:52:18 claus Exp $
'!
!FileSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/FSelBox.st,v 1.11 1994-11-17 14:34:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/FSelBox.st,v 1.12 1995-02-06 00:52:18 claus Exp $
"
!
@@ -110,6 +110,33 @@
!FileSelectionBox class methodsFor:'defaults'!
+requestFilename
+ ^ self requestFilename:'filename:'
+
+ "
+ FileSelectionBox requestFilename
+ "
+!
+
+requestFilename:title
+ |fileBox|
+
+ fileBox := self
+ title:title
+ okText:'ok'
+ abortText:'cancel'
+ action:[:fileName | ^ fileName].
+
+ fileBox showAtPointer.
+ ^ nil
+
+ "
+ FileSelectionBox requestFilename:'which file ?'
+ "
+! !
+
+!FileSelectionBox class methodsFor:'requests'!
+
listViewType
"return the type of listView - using a FileSelectionList here"
@@ -121,14 +148,22 @@
initialize
super initialize.
+ label := 'File dialog'.
+
labelField extent:(0.7 @ labelField height).
labelField label:(resources string:'select a file:').
labelField adjust:#left.
patternField := EditField in:self.
- patternField
- origin:(0.7 @ labelField origin y)
- corner:(1.0 @ (labelField origin y+patternField heightIncludingBorder)).
+ self is3D ifTrue:[
+ patternField
+ origin:(0.7 @ labelField origin y)
+ corner:(1.0 @ (labelField origin y+patternField heightIncludingBorder)).
+ ] ifFalse:[
+ patternField
+ origin:(0.7 @ labelField origin y)
+ corner:[(width - ViewSpacing - (patternField borderWidth * 2)) @ (labelField origin y+patternField height"IncludingBorder")].
+ ].
patternField rightInset:(ViewSpacing // 2).
patternField initialText:'*'.
patternField leaveAction:[:reason |
@@ -171,11 +206,27 @@
] ifFalse:[
super createEnterField
]
+!
+
+focusSequence
+ patternField shown ifTrue:[
+ ^ Array
+ with:patternField
+ with:enterField
+ with:selectionList
+ with:abortButton
+ with:okButton
+ ].
+ ^ Array
+ with:enterField
+ with:selectionList
+ with:abortButton
+ with:okButton
! !
!FileSelectionBox methodsFor:'dependencies'!
-update:something with:argument
+update:something with:argument from:changedObject
|commonName index|
something == #directory ifTrue:[
@@ -226,6 +277,34 @@
selectionList updateList
! !
+!FileSelectionBox methodsFor:'queries'!
+
+preferedExtent
+ "return my prefered extent - thats the minimum size
+ to make everything visible"
+
+ |wWanted hWanted|
+
+ wWanted := ViewSpacing +
+ labelField preferedExtent x +
+ (ViewSpacing * 2) +
+ patternField preferedExtent x +
+ ViewSpacing.
+ (wWanted < width) ifTrue:[
+ wWanted := width
+ ].
+ hWanted := ViewSpacing + labelField height +
+ ViewSpacing + enterField height +
+ ViewSpacing + selectionList height +
+ ViewSpacing + buttonPanel preferedExtent y +
+ ViewSpacing.
+
+ (hWanted < height) ifTrue:[
+ hWanted := height
+ ].
+ ^ (wWanted @ hWanted)
+! !
+
!FileSelectionBox methodsFor:'accessing'!
openOn:aPath
@@ -236,10 +315,10 @@
self showAtPointer
!
-directory:nameOrDirectory
+directory:directoryName
"change the directory shown in the list."
- selectionList directory:nameOrDirectory
+ selectionList directory:directoryName
!
pattern:aPattern
@@ -252,12 +331,27 @@
patternField hidden:true.
realized ifTrue:[
patternField hide.
+ ].
+ windowGroup notNil ifTrue:[
+ windowGroup focusSequence:(Array
+ with:enterField
+ with:selectionList
+ with:okButton
+ with:abortButton)
]
] ifFalse:[
patternField hidden:false.
realized ifTrue:[
patternField realize.
].
+ windowGroup notNil ifTrue:[
+ windowGroup focusSequence:(Array
+ with:patternField
+ with:enterField
+ with:selectionList
+ with:okButton
+ with:abortButton)
+ ]
].
!
--- a/FSelList.st Mon Feb 06 01:52:01 1995 +0100
+++ b/FSelList.st Mon Feb 06 01:53:30 1995 +0100
@@ -10,20 +10,22 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 1-feb-1995 at 3:54:12 pm'!
+
SelectionInListView subclass:#FileSelectionList
- instanceVariableNames:'pattern directory timeStamp directoryId
- directoryContents directoryFileTypes
- fileTypes realAction matchBlock'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Text'
+ instanceVariableNames:'pattern directory timeStamp directoryId directoryContents
+ directoryFileTypes fileTypes realAction matchBlock
+ stayInDirectory ignoreParentDirectory'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Text'
!
FileSelectionList comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/FSelList.st,v 1.9 1994-11-17 14:34:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/FSelList.st,v 1.10 1995-02-06 00:52:21 claus Exp $
'!
!FileSelectionList class methodsFor:'documentation'!
@@ -44,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/FSelList.st,v 1.9 1994-11-17 14:34:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/FSelList.st,v 1.10 1995-02-06 00:52:21 claus Exp $
"
!
@@ -223,119 +225,22 @@
"
! !
-!FileSelectionList methodsFor:'initialization'!
-
-initialize
- directory := FileDirectory currentDirectory.
- super initialize.
-
- pattern := '*'.
- self initializeAction.
+!FileSelectionList methodsFor:'drawing'!
- "nontypical use ..."
- "
- FileSelectionList new open
- (FileSelectionList new directory:'/etc') open
- (ScrollableView for:FileSelectionList) open
- (HVScrollableView for:FileSelectionList) open
- "
-!
-
-initializeAction
- "setup action as: selections in list get forwarded to enterfield if not
- a directory; otherwise directory is changed"
-
- actionBlock := [:lineNr |
- |entry ok|
+redrawVisibleLine:visLineNr
+ "if the line is one for a directory, draw a right arrow"
- (self selection isKindOf:Collection) ifFalse:[
- entry := self selectionValue.
- (entry endsWith:' ...') ifTrue:[
- entry := entry copyTo:(entry size - 4).
- ].
- ((directory typeOf:entry) == #directory) ifTrue:[
- ok := false.
- (directory isReadable:entry) ifFalse:[
- self warn:(resources string:'not allowed to read directory %1' with:entry)
- ] ifTrue:[
- (directory isExecutable:entry) ifFalse:[
- self warn:(resources string:'not allowed to change to directory %1' with:entry)
- ] ifTrue:[
- self directory:(directory pathName , Filename separator asString , entry).
- ok := true.
- ]
- ].
- ok ifFalse:[
- self deselect
- ]
+ |l|
- ] ifFalse:[
- realAction notNil ifTrue:[
- realAction value:lineNr
- ]
- ]
+ super redrawVisibleLine:visLineNr.
+ l := self visibleLineToListLine:visLineNr.
+ l notNil ifTrue:[
+ (fileTypes at:l) == #directory ifTrue:[
+ self drawRightArrowInVisibleLine:visLineNr
]
]
!
-reinitialize
- directory := FileDirectory currentDirectory.
- super reinitialize
-! !
-
-!FileSelectionList methodsFor:'accessing'!
-
-action:aBlock
- "set the action to be performed on a selection"
-
- realAction := aBlock
-!
-
-directory
- "return the shown directory"
-
- ^ directory
-!
-
-directory:nameOrDirectory
- "set the lists contents to the filenames in the directory"
-
- |oldPath name|
-
- nameOrDirectory isString ifTrue:[
- name := nameOrDirectory
- ] ifFalse:[
- name := nameOrDirectory pathName
- ].
- oldPath := directory pathName.
- directory pathName:name.
- realized ifTrue:[
- (directory pathName = oldPath) ifFalse:[
- self updateList
- ]
- ]
-!
-
-pattern:aPattern
- "set the pattern - if it changes, update the list."
-
- pattern ~= aPattern ifTrue:[
- pattern := aPattern.
- realized ifTrue:[
- self updateList
- ].
- ].
-!
-
-matchBlock:aBlock
- "set the matchBlock - if non-nil, it controls which
- names are shown in the list."
-
- matchBlock := aBlock
-! !
-
-!FileSelectionList methodsFor:'drawing'!
-
redrawFromVisibleLine:startVisLineNr to:endVisLineNr
"redefined to look for directory in every line"
@@ -353,24 +258,169 @@
]
]
]
+! !
+
+!FileSelectionList methodsFor:'accessing'!
+
+directory:nameOrDirectory
+ "set the lists contents to the filenames in the directory"
+
+ |oldPath name|
+
+ nameOrDirectory isString ifTrue:[
+ name := nameOrDirectory
+ ] ifFalse:[
+ nameOrDirectory isNil ifTrue:[
+ directory := nil.
+ ^ self updateList
+ ].
+ name := nameOrDirectory pathName
+ ].
+ directory isNil ifTrue:[
+ directory := FileDirectory new.
+ oldPath := nil
+ ] ifFalse:[
+ oldPath := directory pathName.
+ ].
+ directory pathName:name.
+ realized ifTrue:[
+ (directory pathName = oldPath) ifFalse:[
+ self updateList
+ ]
+ ]
+!
+
+directory
+ "return the shown directory"
+
+ ^ directory
+!
+
+action:aBlock
+ "set the action to be performed on a selection"
+
+ realAction := aBlock
!
-redrawVisibleLine:visLineNr
- "if the line is one for a directory, draw a right arrow"
+stayInDirectory:aBoolean
+ "set/clear the flag which controls if selecting a directory
+ should locally change (if false) or be handled just like
+ the selection of a file (if true).
+ The default is false (i.e. change and do not tell via action)"
+
+ stayInDirectory := aBoolean
+!
- |l|
+ignoreParentDirectory:aBoolean
+ "set/clear the flag which controls if the parent directory (..)
+ is shown in the list. The default is false (i.e. show it)"
+
+ ignoreParentDirectory := aBoolean
+!
+
+pattern:aPattern
+ "set the pattern - if it changes, update the list."
- super redrawVisibleLine:visLineNr.
- l := self visibleLineToListLine:visLineNr.
- l notNil ifTrue:[
- (fileTypes at:l) == #directory ifTrue:[
- self drawRightArrowInVisibleLine:visLineNr
- ]
- ]
+ pattern ~= aPattern ifTrue:[
+ pattern := aPattern.
+ realized ifTrue:[
+ self updateList
+ ].
+ ].
+!
+
+selectedPathname
+ "if there is a selection, return its full pathname.
+ Of there is no selection, return nil."
+
+ |sel|
+
+ sel := self selectionValue.
+ sel isNil ifTrue:[^ nil].
+ ^ directory pathName , Filename separator asString , sel.
+
+!
+
+matchBlock:aBlock
+ "set the matchBlock - if non-nil, it controls which
+ names are shown in the list."
+
+ matchBlock := aBlock
! !
!FileSelectionList methodsFor:'private'!
+updateList
+ "set the lists contents to the filenames in the directory"
+
+ |oldCursor files newList index|
+
+ directory isNil ifTrue:[
+ super list:nil.
+ files := newList := fileTypes := nil.
+ ^ self
+ ].
+
+ oldCursor := cursor.
+ self cursor:(Cursor read).
+
+ "
+ if the directory-id changed, MUST update.
+ (can happen after a restart, when a file is no longer
+ there, has moved or is NFS-mounted differently)
+ "
+ directoryId == directory id ifFalse:[
+ timeStamp := directory timeOfLastChange.
+ directoryId := directory id.
+ directoryContents := directory asText sort.
+ directoryFileTypes := OrderedCollection new.
+ directoryContents do:[:name | directoryFileTypes add:(directory typeOf:name)].
+ ].
+
+ files := directoryContents.
+ newList := OrderedCollection new.
+ fileTypes := OrderedCollection new.
+ index := 1.
+ files do:[:name |
+ |fullName|
+
+ fullName := directory pathName , Filename separator asString , name.
+
+ (matchBlock isNil or:[matchBlock value:fullName]) ifTrue:[
+ (directoryFileTypes at:index) == #directory ifTrue:[
+ name = '..' ifTrue:[
+ ignoreParentDirectory ifFalse:[
+ newList add:name.
+ fileTypes add:(directoryFileTypes at:index)
+ ]
+ ] ifFalse:[
+ name = '.' ifTrue:[
+ "ignore"
+ ] ifFalse:[
+ newList add:(name ", ' ...'").
+ fileTypes add:(directoryFileTypes at:index)
+ ]
+ ]
+ ] ifFalse:[
+ (pattern isNil or:[pattern isEmpty or:[pattern = '*' or:[pattern match:name]]]) ifTrue:[
+ newList add:name.
+ fileTypes add:(directoryFileTypes at:index)
+ ]
+ ].
+ ].
+ index := index + 1
+ ].
+ super list:newList.
+ self cursor:oldCursor.
+!
+
+widthForScrollBetween:firstLine and:lastLine
+ "return the width in pixels for a scroll between firstLine and lastLine
+ - return full width here since there might be directory marks"
+
+ ^ (width - margin - margin)
+!
+
visibleLineNeedsSpecialCare:visLineNr
|l|
@@ -380,69 +430,70 @@
^ super visibleLineNeedsSpecialCare:visLineNr
].
^ false
-!
+! !
+
+!FileSelectionList methodsFor:'initialization'!
+
+initializeAction
+ "setup action as: selections in list get forwarded to enterfield if not
+ a directory; otherwise directory is changed"
+
+ actionBlock := [:lineNr |
+ |entry ok|
-widthForScrollBetween:firstLine and:lastLine
- "return the width in pixels for a scroll between firstLine and lastLine
- - return full width here since there might be directory marks"
+ (self selection isKindOf:Collection) ifFalse:[
+ entry := self selectionValue.
+ (entry endsWith:' ...') ifTrue:[
+ entry := entry copyTo:(entry size - 4).
+ ].
+ (stayInDirectory not
+ and:[(directory typeOf:entry) == #directory]) ifTrue:[
+ ok := false.
+ (directory isReadable:entry) ifFalse:[
+ self warn:(resources string:'not allowed to read directory %1' with:entry)
+ ] ifTrue:[
+ (directory isExecutable:entry) ifFalse:[
+ self warn:(resources string:'not allowed to change to directory %1' with:entry)
+ ] ifTrue:[
+ self directory:(directory pathName , Filename separator asString , entry).
+ ok := true.
+ ]
+ ].
+ ok ifFalse:[
+ self deselect
+ ]
- ^ (width - margin - margin)
+ ] ifFalse:[
+ realAction notNil ifTrue:[
+ realAction value:lineNr
+ ]
+ ]
+ ]
+ ]
!
-updateList
- "set the lists contents to the filenames in the directory"
-
- |oldCursor files newList index|
-
- oldCursor := cursor.
- self cursor:(Cursor read).
+initialize
+ directory := FileDirectory currentDirectory.
+ stayInDirectory := false.
+ ignoreParentDirectory := false.
- "
- if the directory-id changed, MUST update.
- (can happen after a restart, when a file is no longer
- there, has moved or is NFS-mounted differently)
- "
- directoryId == directory id ifFalse:[
- timeStamp := directory timeOfLastChange.
- directoryId := directory id.
- directoryContents := directory asText sort.
- directoryFileTypes := OrderedCollection new.
- directoryContents do:[:name | directoryFileTypes add:(directory typeOf:name)].
- ].
+ super initialize.
+
+ pattern := '*'.
+ self initializeAction.
- files := directoryContents.
- newList := OrderedCollection new.
- fileTypes := OrderedCollection new.
- index := 1.
- files do:[:name |
- |fullName|
-
- fullName := directory pathName , Filename separator asString , name.
+ "nontypical use ..."
+ "
+ FileSelectionList new open
+ (FileSelectionList new directory:'/etc') open
+ (ScrollableView for:FileSelectionList) open
+ (HVScrollableView for:FileSelectionList) open
+ "
+!
- (matchBlock isNil or:[matchBlock value:fullName]) ifTrue:[
- (directoryFileTypes at:index) == #directory ifTrue:[
- name = '..' ifTrue:[
- newList add:name.
- fileTypes add:(directoryFileTypes at:index)
- ] ifFalse:[
- name = '.' ifTrue:[
- "ignore"
- ] ifFalse:[
- newList add:(name ", ' ...'").
- fileTypes add:(directoryFileTypes at:index)
- ]
- ]
- ] ifFalse:[
- (pattern isNil or:[pattern isEmpty or:[pattern = '*' or:[pattern match:name]]]) ifTrue:[
- newList add:name.
- fileTypes add:(directoryFileTypes at:index)
- ]
- ].
- ].
- index := index + 1
- ].
- super list:newList.
- self cursor:oldCursor.
+reinitialize
+ directory := FileDirectory currentDirectory.
+ super reinitialize
! !
!FileSelectionList methodsFor:'realization'!
@@ -460,3 +511,4 @@
].
super realize
! !
+
--- a/FileSaveBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/FileSaveBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -11,7 +11,7 @@
"
FileSelectionBox subclass:#FileSaveBox
- instanceVariableNames:'appendAction'
+ instanceVariableNames:'appendButton appendAction'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FileSaveBox.st,v 1.2 1994-10-10 03:01:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FileSaveBox.st,v 1.3 1995-02-06 00:52:16 claus Exp $
'!
!FileSaveBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/FileSaveBox.st,v 1.2 1994-10-10 03:01:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FileSaveBox.st,v 1.3 1995-02-06 00:52:16 claus Exp $
"
!
@@ -69,20 +69,40 @@
!FileSaveBox methodsFor:'initialization'!
initialize
- |b|
+ super initialize.
- super initialize.
+ label := 'Save file dialog'.
okButton label:(resources string:'save').
"
insert an append-button between abort- and save-buttons
"
- b := Button okButtonIn:nil.
- b isReturnButton:false.
- b label:(resources string:'append').
- b action:[b turnOffWithoutRedraw. self appendPressed].
- buttonPanel addSubView:b after:abortButton
+ appendButton := Button okButtonIn:nil.
+ appendButton isReturnButton:false.
+ appendButton label:(resources string:'append').
+ appendButton action:[appendButton turnOffWithoutRedraw. self appendPressed].
+ buttonPanel addSubView:appendButton after:abortButton
+!
+
+focusSequence
+ |a|
+
+ patternField shown ifTrue:[
+ a := Array new:6.
+ a at:1 put:enterField.
+ a at:2 put:patternField.
+ a at:3 put:selectionList.
+ a at:4 put:abortButton.
+ a at:5 put:appendButton.
+ a at:6 put:okButton.
+ ^ a
+ ].
+ ^ Array with:enterField
+ with:selectionList
+ with:abortButton
+ with:appendButton
+ with:okButton
! !
!FileSaveBox methodsFor:'accessing'!
--- a/FileSelectionBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/FileSelectionBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FileSelectionBox.st,v 1.11 1994-11-17 14:34:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FileSelectionBox.st,v 1.12 1995-02-06 00:52:18 claus Exp $
'!
!FileSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/FileSelectionBox.st,v 1.11 1994-11-17 14:34:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FileSelectionBox.st,v 1.12 1995-02-06 00:52:18 claus Exp $
"
!
@@ -110,6 +110,33 @@
!FileSelectionBox class methodsFor:'defaults'!
+requestFilename
+ ^ self requestFilename:'filename:'
+
+ "
+ FileSelectionBox requestFilename
+ "
+!
+
+requestFilename:title
+ |fileBox|
+
+ fileBox := self
+ title:title
+ okText:'ok'
+ abortText:'cancel'
+ action:[:fileName | ^ fileName].
+
+ fileBox showAtPointer.
+ ^ nil
+
+ "
+ FileSelectionBox requestFilename:'which file ?'
+ "
+! !
+
+!FileSelectionBox class methodsFor:'requests'!
+
listViewType
"return the type of listView - using a FileSelectionList here"
@@ -121,14 +148,22 @@
initialize
super initialize.
+ label := 'File dialog'.
+
labelField extent:(0.7 @ labelField height).
labelField label:(resources string:'select a file:').
labelField adjust:#left.
patternField := EditField in:self.
- patternField
- origin:(0.7 @ labelField origin y)
- corner:(1.0 @ (labelField origin y+patternField heightIncludingBorder)).
+ self is3D ifTrue:[
+ patternField
+ origin:(0.7 @ labelField origin y)
+ corner:(1.0 @ (labelField origin y+patternField heightIncludingBorder)).
+ ] ifFalse:[
+ patternField
+ origin:(0.7 @ labelField origin y)
+ corner:[(width - ViewSpacing - (patternField borderWidth * 2)) @ (labelField origin y+patternField height"IncludingBorder")].
+ ].
patternField rightInset:(ViewSpacing // 2).
patternField initialText:'*'.
patternField leaveAction:[:reason |
@@ -171,11 +206,27 @@
] ifFalse:[
super createEnterField
]
+!
+
+focusSequence
+ patternField shown ifTrue:[
+ ^ Array
+ with:patternField
+ with:enterField
+ with:selectionList
+ with:abortButton
+ with:okButton
+ ].
+ ^ Array
+ with:enterField
+ with:selectionList
+ with:abortButton
+ with:okButton
! !
!FileSelectionBox methodsFor:'dependencies'!
-update:something with:argument
+update:something with:argument from:changedObject
|commonName index|
something == #directory ifTrue:[
@@ -226,6 +277,34 @@
selectionList updateList
! !
+!FileSelectionBox methodsFor:'queries'!
+
+preferedExtent
+ "return my prefered extent - thats the minimum size
+ to make everything visible"
+
+ |wWanted hWanted|
+
+ wWanted := ViewSpacing +
+ labelField preferedExtent x +
+ (ViewSpacing * 2) +
+ patternField preferedExtent x +
+ ViewSpacing.
+ (wWanted < width) ifTrue:[
+ wWanted := width
+ ].
+ hWanted := ViewSpacing + labelField height +
+ ViewSpacing + enterField height +
+ ViewSpacing + selectionList height +
+ ViewSpacing + buttonPanel preferedExtent y +
+ ViewSpacing.
+
+ (hWanted < height) ifTrue:[
+ hWanted := height
+ ].
+ ^ (wWanted @ hWanted)
+! !
+
!FileSelectionBox methodsFor:'accessing'!
openOn:aPath
@@ -236,10 +315,10 @@
self showAtPointer
!
-directory:nameOrDirectory
+directory:directoryName
"change the directory shown in the list."
- selectionList directory:nameOrDirectory
+ selectionList directory:directoryName
!
pattern:aPattern
@@ -252,12 +331,27 @@
patternField hidden:true.
realized ifTrue:[
patternField hide.
+ ].
+ windowGroup notNil ifTrue:[
+ windowGroup focusSequence:(Array
+ with:enterField
+ with:selectionList
+ with:okButton
+ with:abortButton)
]
] ifFalse:[
patternField hidden:false.
realized ifTrue:[
patternField realize.
].
+ windowGroup notNil ifTrue:[
+ windowGroup focusSequence:(Array
+ with:patternField
+ with:enterField
+ with:selectionList
+ with:okButton
+ with:abortButton)
+ ]
].
!
--- a/FileSelectionList.st Mon Feb 06 01:52:01 1995 +0100
+++ b/FileSelectionList.st Mon Feb 06 01:53:30 1995 +0100
@@ -10,20 +10,22 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 1-feb-1995 at 3:54:12 pm'!
+
SelectionInListView subclass:#FileSelectionList
- instanceVariableNames:'pattern directory timeStamp directoryId
- directoryContents directoryFileTypes
- fileTypes realAction matchBlock'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Text'
+ instanceVariableNames:'pattern directory timeStamp directoryId directoryContents
+ directoryFileTypes fileTypes realAction matchBlock
+ stayInDirectory ignoreParentDirectory'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Text'
!
FileSelectionList comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FileSelectionList.st,v 1.9 1994-11-17 14:34:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FileSelectionList.st,v 1.10 1995-02-06 00:52:21 claus Exp $
'!
!FileSelectionList class methodsFor:'documentation'!
@@ -44,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/FileSelectionList.st,v 1.9 1994-11-17 14:34:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FileSelectionList.st,v 1.10 1995-02-06 00:52:21 claus Exp $
"
!
@@ -223,119 +225,22 @@
"
! !
-!FileSelectionList methodsFor:'initialization'!
-
-initialize
- directory := FileDirectory currentDirectory.
- super initialize.
-
- pattern := '*'.
- self initializeAction.
+!FileSelectionList methodsFor:'drawing'!
- "nontypical use ..."
- "
- FileSelectionList new open
- (FileSelectionList new directory:'/etc') open
- (ScrollableView for:FileSelectionList) open
- (HVScrollableView for:FileSelectionList) open
- "
-!
-
-initializeAction
- "setup action as: selections in list get forwarded to enterfield if not
- a directory; otherwise directory is changed"
-
- actionBlock := [:lineNr |
- |entry ok|
+redrawVisibleLine:visLineNr
+ "if the line is one for a directory, draw a right arrow"
- (self selection isKindOf:Collection) ifFalse:[
- entry := self selectionValue.
- (entry endsWith:' ...') ifTrue:[
- entry := entry copyTo:(entry size - 4).
- ].
- ((directory typeOf:entry) == #directory) ifTrue:[
- ok := false.
- (directory isReadable:entry) ifFalse:[
- self warn:(resources string:'not allowed to read directory %1' with:entry)
- ] ifTrue:[
- (directory isExecutable:entry) ifFalse:[
- self warn:(resources string:'not allowed to change to directory %1' with:entry)
- ] ifTrue:[
- self directory:(directory pathName , Filename separator asString , entry).
- ok := true.
- ]
- ].
- ok ifFalse:[
- self deselect
- ]
+ |l|
- ] ifFalse:[
- realAction notNil ifTrue:[
- realAction value:lineNr
- ]
- ]
+ super redrawVisibleLine:visLineNr.
+ l := self visibleLineToListLine:visLineNr.
+ l notNil ifTrue:[
+ (fileTypes at:l) == #directory ifTrue:[
+ self drawRightArrowInVisibleLine:visLineNr
]
]
!
-reinitialize
- directory := FileDirectory currentDirectory.
- super reinitialize
-! !
-
-!FileSelectionList methodsFor:'accessing'!
-
-action:aBlock
- "set the action to be performed on a selection"
-
- realAction := aBlock
-!
-
-directory
- "return the shown directory"
-
- ^ directory
-!
-
-directory:nameOrDirectory
- "set the lists contents to the filenames in the directory"
-
- |oldPath name|
-
- nameOrDirectory isString ifTrue:[
- name := nameOrDirectory
- ] ifFalse:[
- name := nameOrDirectory pathName
- ].
- oldPath := directory pathName.
- directory pathName:name.
- realized ifTrue:[
- (directory pathName = oldPath) ifFalse:[
- self updateList
- ]
- ]
-!
-
-pattern:aPattern
- "set the pattern - if it changes, update the list."
-
- pattern ~= aPattern ifTrue:[
- pattern := aPattern.
- realized ifTrue:[
- self updateList
- ].
- ].
-!
-
-matchBlock:aBlock
- "set the matchBlock - if non-nil, it controls which
- names are shown in the list."
-
- matchBlock := aBlock
-! !
-
-!FileSelectionList methodsFor:'drawing'!
-
redrawFromVisibleLine:startVisLineNr to:endVisLineNr
"redefined to look for directory in every line"
@@ -353,24 +258,169 @@
]
]
]
+! !
+
+!FileSelectionList methodsFor:'accessing'!
+
+directory:nameOrDirectory
+ "set the lists contents to the filenames in the directory"
+
+ |oldPath name|
+
+ nameOrDirectory isString ifTrue:[
+ name := nameOrDirectory
+ ] ifFalse:[
+ nameOrDirectory isNil ifTrue:[
+ directory := nil.
+ ^ self updateList
+ ].
+ name := nameOrDirectory pathName
+ ].
+ directory isNil ifTrue:[
+ directory := FileDirectory new.
+ oldPath := nil
+ ] ifFalse:[
+ oldPath := directory pathName.
+ ].
+ directory pathName:name.
+ realized ifTrue:[
+ (directory pathName = oldPath) ifFalse:[
+ self updateList
+ ]
+ ]
+!
+
+directory
+ "return the shown directory"
+
+ ^ directory
+!
+
+action:aBlock
+ "set the action to be performed on a selection"
+
+ realAction := aBlock
!
-redrawVisibleLine:visLineNr
- "if the line is one for a directory, draw a right arrow"
+stayInDirectory:aBoolean
+ "set/clear the flag which controls if selecting a directory
+ should locally change (if false) or be handled just like
+ the selection of a file (if true).
+ The default is false (i.e. change and do not tell via action)"
+
+ stayInDirectory := aBoolean
+!
- |l|
+ignoreParentDirectory:aBoolean
+ "set/clear the flag which controls if the parent directory (..)
+ is shown in the list. The default is false (i.e. show it)"
+
+ ignoreParentDirectory := aBoolean
+!
+
+pattern:aPattern
+ "set the pattern - if it changes, update the list."
- super redrawVisibleLine:visLineNr.
- l := self visibleLineToListLine:visLineNr.
- l notNil ifTrue:[
- (fileTypes at:l) == #directory ifTrue:[
- self drawRightArrowInVisibleLine:visLineNr
- ]
- ]
+ pattern ~= aPattern ifTrue:[
+ pattern := aPattern.
+ realized ifTrue:[
+ self updateList
+ ].
+ ].
+!
+
+selectedPathname
+ "if there is a selection, return its full pathname.
+ Of there is no selection, return nil."
+
+ |sel|
+
+ sel := self selectionValue.
+ sel isNil ifTrue:[^ nil].
+ ^ directory pathName , Filename separator asString , sel.
+
+!
+
+matchBlock:aBlock
+ "set the matchBlock - if non-nil, it controls which
+ names are shown in the list."
+
+ matchBlock := aBlock
! !
!FileSelectionList methodsFor:'private'!
+updateList
+ "set the lists contents to the filenames in the directory"
+
+ |oldCursor files newList index|
+
+ directory isNil ifTrue:[
+ super list:nil.
+ files := newList := fileTypes := nil.
+ ^ self
+ ].
+
+ oldCursor := cursor.
+ self cursor:(Cursor read).
+
+ "
+ if the directory-id changed, MUST update.
+ (can happen after a restart, when a file is no longer
+ there, has moved or is NFS-mounted differently)
+ "
+ directoryId == directory id ifFalse:[
+ timeStamp := directory timeOfLastChange.
+ directoryId := directory id.
+ directoryContents := directory asText sort.
+ directoryFileTypes := OrderedCollection new.
+ directoryContents do:[:name | directoryFileTypes add:(directory typeOf:name)].
+ ].
+
+ files := directoryContents.
+ newList := OrderedCollection new.
+ fileTypes := OrderedCollection new.
+ index := 1.
+ files do:[:name |
+ |fullName|
+
+ fullName := directory pathName , Filename separator asString , name.
+
+ (matchBlock isNil or:[matchBlock value:fullName]) ifTrue:[
+ (directoryFileTypes at:index) == #directory ifTrue:[
+ name = '..' ifTrue:[
+ ignoreParentDirectory ifFalse:[
+ newList add:name.
+ fileTypes add:(directoryFileTypes at:index)
+ ]
+ ] ifFalse:[
+ name = '.' ifTrue:[
+ "ignore"
+ ] ifFalse:[
+ newList add:(name ", ' ...'").
+ fileTypes add:(directoryFileTypes at:index)
+ ]
+ ]
+ ] ifFalse:[
+ (pattern isNil or:[pattern isEmpty or:[pattern = '*' or:[pattern match:name]]]) ifTrue:[
+ newList add:name.
+ fileTypes add:(directoryFileTypes at:index)
+ ]
+ ].
+ ].
+ index := index + 1
+ ].
+ super list:newList.
+ self cursor:oldCursor.
+!
+
+widthForScrollBetween:firstLine and:lastLine
+ "return the width in pixels for a scroll between firstLine and lastLine
+ - return full width here since there might be directory marks"
+
+ ^ (width - margin - margin)
+!
+
visibleLineNeedsSpecialCare:visLineNr
|l|
@@ -380,69 +430,70 @@
^ super visibleLineNeedsSpecialCare:visLineNr
].
^ false
-!
+! !
+
+!FileSelectionList methodsFor:'initialization'!
+
+initializeAction
+ "setup action as: selections in list get forwarded to enterfield if not
+ a directory; otherwise directory is changed"
+
+ actionBlock := [:lineNr |
+ |entry ok|
-widthForScrollBetween:firstLine and:lastLine
- "return the width in pixels for a scroll between firstLine and lastLine
- - return full width here since there might be directory marks"
+ (self selection isKindOf:Collection) ifFalse:[
+ entry := self selectionValue.
+ (entry endsWith:' ...') ifTrue:[
+ entry := entry copyTo:(entry size - 4).
+ ].
+ (stayInDirectory not
+ and:[(directory typeOf:entry) == #directory]) ifTrue:[
+ ok := false.
+ (directory isReadable:entry) ifFalse:[
+ self warn:(resources string:'not allowed to read directory %1' with:entry)
+ ] ifTrue:[
+ (directory isExecutable:entry) ifFalse:[
+ self warn:(resources string:'not allowed to change to directory %1' with:entry)
+ ] ifTrue:[
+ self directory:(directory pathName , Filename separator asString , entry).
+ ok := true.
+ ]
+ ].
+ ok ifFalse:[
+ self deselect
+ ]
- ^ (width - margin - margin)
+ ] ifFalse:[
+ realAction notNil ifTrue:[
+ realAction value:lineNr
+ ]
+ ]
+ ]
+ ]
!
-updateList
- "set the lists contents to the filenames in the directory"
-
- |oldCursor files newList index|
-
- oldCursor := cursor.
- self cursor:(Cursor read).
+initialize
+ directory := FileDirectory currentDirectory.
+ stayInDirectory := false.
+ ignoreParentDirectory := false.
- "
- if the directory-id changed, MUST update.
- (can happen after a restart, when a file is no longer
- there, has moved or is NFS-mounted differently)
- "
- directoryId == directory id ifFalse:[
- timeStamp := directory timeOfLastChange.
- directoryId := directory id.
- directoryContents := directory asText sort.
- directoryFileTypes := OrderedCollection new.
- directoryContents do:[:name | directoryFileTypes add:(directory typeOf:name)].
- ].
+ super initialize.
+
+ pattern := '*'.
+ self initializeAction.
- files := directoryContents.
- newList := OrderedCollection new.
- fileTypes := OrderedCollection new.
- index := 1.
- files do:[:name |
- |fullName|
-
- fullName := directory pathName , Filename separator asString , name.
+ "nontypical use ..."
+ "
+ FileSelectionList new open
+ (FileSelectionList new directory:'/etc') open
+ (ScrollableView for:FileSelectionList) open
+ (HVScrollableView for:FileSelectionList) open
+ "
+!
- (matchBlock isNil or:[matchBlock value:fullName]) ifTrue:[
- (directoryFileTypes at:index) == #directory ifTrue:[
- name = '..' ifTrue:[
- newList add:name.
- fileTypes add:(directoryFileTypes at:index)
- ] ifFalse:[
- name = '.' ifTrue:[
- "ignore"
- ] ifFalse:[
- newList add:(name ", ' ...'").
- fileTypes add:(directoryFileTypes at:index)
- ]
- ]
- ] ifFalse:[
- (pattern isNil or:[pattern isEmpty or:[pattern = '*' or:[pattern match:name]]]) ifTrue:[
- newList add:name.
- fileTypes add:(directoryFileTypes at:index)
- ]
- ].
- ].
- index := index + 1
- ].
- super list:newList.
- self cursor:oldCursor.
+reinitialize
+ directory := FileDirectory currentDirectory.
+ super reinitialize
! !
!FileSelectionList methodsFor:'realization'!
@@ -460,3 +511,4 @@
].
super realize
! !
+
--- a/FontPanel.st Mon Feb 06 01:52:01 1995 +0100
+++ b/FontPanel.st Mon Feb 06 01:53:30 1995 +0100
@@ -10,38 +10,78 @@
hereby transferred.
"
-ModalBox subclass:#FontPanel
- instanceVariableNames:'previewField familyList faceList sizeList
- applyButton abortButton
- revertButton okAction abortAction
- currentFamily currentFace
- currentStyle currentFaceAndStyle currentSize'
+
+
+'From Smalltalk/X, Version:2.10.4 on 28-dec-1994 at 9:11:51 pm'!
+
+DialogBox subclass:#FontPanel
+ instanceVariableNames:'previewField familyList faceList sizeList revertButton
+ currentFamily currentFace currentStyle currentFaceAndStyle
+ currentSize'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
!
-FontPanel comment:'
+!FontPanel class methodsFor:'documentation'!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.7 1995-02-06 00:52:23 claus Exp $
+"
+!
+
+documentation
+"
+ this class implements a font chooser.
+
+ usage:
-COPYRIGHT (c) 1991 by Claus Gittinger
+ |panel|
+
+ panel := FontPanel new.
+ panel action:[:aFont | Transcript showCR:'the font is' , aFont printString].
+ panel show
+
+ or simply:
+
+ font := FontPanel fontFromUser
+"
+
+!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-this class implements a font chooser
+ 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.
+"
-$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.6 1994-10-10 03:01:33 claus Exp $
-written fall 91 by claus
-'!
+
+! !
!FontPanel class methodsFor:'defaults'!
defaultExtent
^ (Display pixelPerMillimeter * (120 @ 100)) rounded
+
+
! !
!FontPanel class methodsFor:'startup'!
fontFromUser
+ "open a fontPanel and return the selected font, or nil
+ if abort is pressed"
+
|fontPanel|
+
fontPanel := FontPanel new.
fontPanel action:[:family :face :style :size |
^ (Font family:family
@@ -52,253 +92,11 @@
fontPanel showAtPointer.
^ nil
- "FontPanel fontFromUser"
-! !
-
-!FontPanel methodsFor:'initializing'!
-
-initialize
- |buttonWidth buttonHeight space2 space3 space4 innerWidth
- familyLabel faceLabel sizeLabel bw list|
-
- super initialize.
-
- space2 := ViewSpacing * 2.
- space3 := ViewSpacing * 3.
- space4 := ViewSpacing * 4.
-
- previewField := EditField in:self.
- previewField contents:'The quick brown fox\jumps over the lazy dog\1234567890\!!@#$%^&*(){}[]:"~;,./<>?' withCRs.
- bw := previewField borderWidth.
-
- innerWidth := width - space2.
-
- previewField origin:(ViewSpacing @ ViewSpacing)
- extent:((innerWidth - (2 * bw) - (ViewSpacing // 2)) @ (height // 4)).
- previewField origin:(ViewSpacing @ ViewSpacing)
- extent:[(width - space2 - (2 * bw)) @ (height // 4)].
-
- familyLabel := Label in:self.
- familyLabel origin:(ViewSpacing
- @
- (previewField origin y +
- previewField height +
- ViewSpacing))
- extent:(((width - space4) // 5 * 2)
- @
- (familyLabel height)).
- familyLabel origin:[ViewSpacing
- @
- (previewField origin y +
- previewField height +
- ViewSpacing)]
- extent:[((width - space4) // 5 * 2)
- @
- (familyLabel height)].
- familyLabel label:'Family'.
-
- familyList := ScrollableView for:SelectionInListView in:self.
- familyList origin:(ViewSpacing
- @
- (familyLabel origin y + familyLabel height + ViewSpacing))
- extent:(((width - space4) // 5 * 2)
- @
- (height // 2)).
- familyList origin:[ViewSpacing
- @
- (familyLabel origin y + familyLabel height + ViewSpacing)]
- extent:[((width - space4) // 5 * 2)
- @
- (height // 2)].
-
- faceLabel := Label in:self.
- faceLabel origin:((familyList origin x +
- familyList width +
- ViewSpacing)
- @
- (previewField origin y +
- previewField height +
- ViewSpacing))
- extent:(((width - space4) // 5 * 2) @
- (faceLabel height)).
- faceLabel origin:[(familyList origin x +
- familyList width +
- ViewSpacing)
- @
- (previewField origin y +
- previewField height +
- ViewSpacing)]
- extent:[((width - space4) // 5 * 2) @
- (faceLabel height)].
- faceLabel label:'Typeface'.
-
- faceList := ScrollableView for:SelectionInListView in:self.
- faceList origin:((faceLabel origin x)
- @
- (faceLabel origin y + faceLabel height + ViewSpacing))
- extent:(((width - space4) // 5 * 2) @
- (height // 2)).
- faceList origin:[(faceLabel origin x)
- @
- (faceLabel origin y + faceLabel height + ViewSpacing)]
- extent:[((width - space4) // 5 * 2) @
- (height // 2)].
-
- sizeLabel := Label in:self.
- sizeLabel origin:((faceList origin x +
- faceList width +
- ViewSpacing)
- @
- (previewField origin y +
- previewField height +
- ViewSpacing))
- extent:(((width - space4) // 5 - sizeLabel borderWidth) @
- (sizeLabel height)).
- sizeLabel origin:[(faceList origin x +
- faceList width +
- ViewSpacing)
- @
- (previewField origin y +
- previewField height +
- ViewSpacing)]
- extent:[((width - space4) // 5 - sizeLabel borderWidth) @
- (sizeLabel height)].
- sizeLabel label:'Size'.
+ "
+ FontPanel fontFromUser
+ "
- sizeList := ScrollableView for:SelectionInListView in:self.
- sizeList origin:((sizeLabel origin x)
- @
- (sizeLabel origin y + sizeLabel height + ViewSpacing))
- extent:(((width - space4) // 5 - sizeList borderWidth) @
- (height // 2)).
- sizeList origin:[(sizeLabel origin x)
- @
- (sizeLabel origin y + sizeLabel height + ViewSpacing)]
- extent:[((width - space4) // 5 - sizeList borderWidth) @
- (height // 2)].
- applyButton := Button okButtonIn:self.
- applyButton action:[
- applyButton turnOffWithoutRedraw.
- self okPressed
- ].
-
- abortButton := Button abortButtonIn:self.
- abortButton action:[
- abortButton turnOffWithoutRedraw.
- self abortPressed
- ].
-
- buttonHeight := abortButton height.
- buttonWidth := (width - space3) // 2.
- abortButton extent:(buttonWidth @ buttonHeight).
- abortButton origin:[ViewSpacing @ (height - buttonHeight - space2)]
- extent:[((width - space3) // 2) @ buttonHeight].
-
- applyButton extent:(buttonWidth @ buttonHeight).
- applyButton origin:[((width + ViewSpacing) // 2) @ (height - buttonHeight - space2)]
- extent:[((width - space3) // 2) @ buttonHeight].
-
- familyList action:[:lineNr | self familySelected:(familyList selectionValue)].
- faceList action:[:lineNr | self faceSelected:(faceList selectionValue)].
- sizeList action:[:lineNr | self sizeSelected:(sizeList selectionValue)].
-
- list := device fontFamilies.
- list notNil ifTrue:[
- list := list asOrderedCollection
- ].
- familyList list:list
-
- "FontPanel new showAtPointer"
-!
-
-realize
- "kludge for sco - xlsfont fails sometimes - try again here"
-
- |families|
-
- familyList list isNil ifTrue:[
- families := device fontFamilies.
- families notNil ifTrue:[
- families := families asOrderedCollection
- ].
- familyList list:families
- ].
- super realize
-! !
-
-!FontPanel methodsFor:'user interaction'!
-
-okPressed
- self hide.
- okAction notNil ifTrue:[
- okAction value:currentFamily
- value:currentFace
- value:currentStyle
- value:currentSize
- ]
-!
-
-abortPressed
- self hide
-
-!
-
-familySelected:aFamilyName
- |faces styles list|
-
- familyList selectElement:aFamilyName.
-
- list := Text new.
- currentFamily := aFamilyName.
- faces := device facesInFamily:aFamilyName.
- faces notNil ifTrue:[
- faces do:[:aFace |
- styles := device stylesInFamily:aFamilyName face:aFace.
- styles do:[:aStyle |
- list add:(aFace , '-' , aStyle)
- ]
- ].
- ].
- faceList list:list.
- currentFaceAndStyle notNil ifTrue:[
- (list includes:currentFaceAndStyle) ifTrue:[
- faceList selectElement:currentFaceAndStyle.
- self faceSelected:currentFaceAndStyle.
- ^ self
- ]
- ].
- sizeList list:nil
-!
-
-faceSelected:aFaceAndStyleName
- |sizes|
-
- sizes := Text new.
- self extractFaceAndStyleFrom:aFaceAndStyleName.
- sizes := device
- sizesInFamily:currentFamily
- face:currentFace
- style:currentStyle.
- sizes notNil ifTrue:[
- sizes := sizes asOrderedCollection sort.
- ].
- sizeList list:sizes.
- currentSize notNil ifTrue:[
- (sizes includes:(currentSize printString)) ifTrue:[
- sizeList selectElement:currentSize.
- self showPreview
- ]
- ]
-!
-
-sizeSelected:aNumberOrString
- aNumberOrString isNumber ifTrue:[
- currentSize := aNumberOrString
- ] ifFalse:[
- currentSize := Number readFromString:aNumberOrString
- ].
- self showPreview
! !
!FontPanel methodsFor:'accessing'!
@@ -327,13 +125,129 @@
okAction := aBlock
! !
+!FontPanel methodsFor:'initialization'!
+
+realize
+ "kludge for sco - xlsfont fails sometimes - try again here"
+
+ |families|
+
+ familyList list isNil ifTrue:[
+ families := device fontFamilies.
+ families notNil ifTrue:[
+ families := families asOrderedCollection
+ ].
+ familyList list:families
+ ].
+ super realize
+
+!
+
+initialize
+ |familyLabel faceLabel sizeLabel panel fontBrowserView v1 v2 v3|
+
+ super initialize.
+
+ self addAbortButton.
+ self addOkButton.
+
+ panel := View origin:0.0@0.0 corner:1.0@1.0
+ in:self.
+ panel bottomInset:(buttonPanel preferedExtent y + (ViewSpacing*3)).
+
+ label := 'Font dialog'.
+
+ previewField := TextView origin:0.0@0.0 corner:1.0@0.3 in:panel.
+ previewField inset:ViewSpacing.
+
+ previewField contents:'The quick brown fox\jumps over the lazy dog\1234567890\!!@#$%^&*(){}[]:"~;,./<>?' withCRs.
+ self is3D ifTrue:[
+ previewField level:-1.
+ ] ifFalse:[
+ previewField borderWidth:1.
+ ].
+
+ fontBrowserView := View origin:0.0@0.3 corner:1.0@1.0 in:panel.
+
+ v1 := View origin:0.0@0.0 corner:0.4@1.0 in:fontBrowserView.
+
+ familyLabel := Label label:'Family' in:v1.
+ familyLabel borderWidth:0.
+ familyLabel origin:(0.0 @ 0.0) extent:(1.0 @ nil).
+
+ familyList := ScrollableView for:SelectionInListView in:v1.
+ familyList origin:(0.0
+ @
+ (familyLabel origin y + familyLabel height "+ ViewSpacing"))
+ corner:(1.0 @ 1.0).
+ familyList inset:ViewSpacing.
+
+ v2 := View origin:0.4@0.0 corner:0.8@1.0
+ in:fontBrowserView.
+
+ faceLabel := Label label:'Typeface' in:v2.
+ faceLabel borderWidth:0.
+ faceLabel origin:(0.0 @ 0.0) extent:(1.0 @ nil).
+
+ faceList := ScrollableView for:SelectionInListView in:v2.
+ faceList origin:(0.0
+ @
+ (faceLabel origin y + faceLabel height "+ ViewSpacing"))
+ corner:(1.0 @ 1.0).
+ faceList inset:ViewSpacing.
+
+ v3 := View origin:0.8@0.0 corner:1.0@1.0
+ in:fontBrowserView.
+
+ sizeLabel := Label label:'Size' in:v3.
+ sizeLabel borderWidth:0.
+ sizeLabel origin:(0.0 @ 0.0)extent:(1.0 @ nil).
+
+ sizeList := ScrollableView for:SelectionInListView in:v3.
+ sizeList origin:(0.0
+ @
+ (sizeLabel origin y + sizeLabel height "+ ViewSpacing"))
+ corner:(1.0 @ 1.0).
+ sizeList inset:ViewSpacing.
+
+ familyList action:[:lineNr | self familySelected:(familyList selectionValue)].
+ faceList action:[:lineNr | self faceSelected:(faceList selectionValue)].
+ sizeList action:[:lineNr | self sizeSelected:(sizeList selectionValue)].
+
+ "
+ FontPanel new showAtPointer
+ "
+!
+
+focusSequence
+ |a|
+
+ a := Array new:5.
+ a at:1 put:familyList.
+ a at:2 put:faceList.
+ a at:3 put:sizeList.
+ a at:4 put:abortButton.
+ a at:5 put:okButton.
+ ^ a
+! !
+
!FontPanel methodsFor:'private'!
showPreview
- previewField font:(Font family:currentFamily
- face:currentFace
- style:currentStyle
- size:currentSize)
+ shown ifTrue:[
+ previewField clear.
+ ].
+ "
+ show a wait cursor: for some fonts (kanji etc) the
+ X-server needs quites some time to load the font
+ "
+ self withCursor:Cursor wait do:[
+ previewField font:(Font family:currentFamily
+ face:currentFace
+ style:currentStyle
+ size:currentSize).
+ previewField contents:'The quick brown fox\jumps over the lazy dog\1234567890\!!@#$%^&*(){}[]:"~;,./<>?' withCRs.
+ ]
!
extractFaceAndStyleFrom:aString
@@ -347,3 +261,84 @@
]
! !
+
+!FontPanel methodsFor:'user interaction'!
+
+familySelected:aFamilyName
+ |faces styles list|
+
+ familyList selectElement:aFamilyName.
+
+ currentFamily := aFamilyName.
+ faces := device facesInFamily:aFamilyName.
+ (faces isNil or:[faces isEmpty]) ifTrue:[
+ currentFace := currentStyle := currentFaceAndStyle := nil.
+ faceList list:nil.
+ self faceSelected:nil.
+ ^ self.
+ ].
+
+ list := OrderedCollection new.
+ faces do:[:aFace |
+ styles := device stylesInFamily:aFamilyName face:aFace.
+ styles do:[:aStyle |
+ list add:(aFace , '-' , aStyle)
+ ]
+ ].
+ faceList list:list.
+ currentFaceAndStyle notNil ifTrue:[
+ (list includes:currentFaceAndStyle) ifTrue:[
+ faceList selectElement:currentFaceAndStyle.
+ self faceSelected:currentFaceAndStyle.
+ ^ self
+ ]
+ ].
+ sizeList list:nil
+!
+
+faceSelected:aFaceAndStyleName
+ |sizes|
+
+ aFaceAndStyleName notNil ifTrue:[
+ self extractFaceAndStyleFrom:aFaceAndStyleName.
+ ].
+ sizes := device
+ sizesInFamily:currentFamily
+ face:currentFace
+ style:currentStyle.
+ (sizes isNil or:[sizes isEmpty]) ifTrue:[
+ sizeList list:nil.
+ currentSize := nil.
+ self showPreview.
+ ^ self
+ ].
+
+ sizes := sizes asOrderedCollection sort.
+ sizeList list:sizes.
+ currentSize notNil ifTrue:[
+ (sizes includes:(currentSize printString)) ifTrue:[
+ sizeList selectElement:currentSize.
+ self showPreview
+ ]
+ ]
+!
+
+okPressed
+ self hide.
+ okAction notNil ifTrue:[
+ okAction value:currentFamily
+ value:currentFace
+ value:currentStyle
+ value:currentSize
+ ]
+!
+
+sizeSelected:aNumberOrString
+ aNumberOrString isNumber ifTrue:[
+ currentSize := aNumberOrString
+ ] ifFalse:[
+ currentSize := Number readFromString:aNumberOrString
+ ].
+ self showPreview
+! !
+
--- a/HPanelV.st Mon Feb 06 01:52:01 1995 +0100
+++ b/HPanelV.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.7 1994-11-21 16:45:24 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.8 1995-02-06 00:52:25 claus Exp $
'!
!HorizontalPanelView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.7 1994-11-21 16:45:24 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.8 1995-02-06 00:52:25 claus Exp $
"
!
@@ -52,7 +52,10 @@
All real work is done in PanelView - only the layout computation is
redefined here.
- The layout is controlled by two instance variables.
+ The layout is controlled the instance variables:
+ horizontalLayout and verticalLayout
+ in addition to horizontalSpace and verticalSpace.
+
The horizontal layout can be any of:
#left arrange elements at the left
@@ -61,7 +64,11 @@
#rightSpace arrange elements at the right, start with spacing
#center arrange elements in the center
#spread spread elements evenly
+ #spreadSpace spread elements evenly with spacing at the ends
#fit like spread, but resize elements for tight packing
+ #fitSpace like fit, with additional spacing at the far ends
+ #leftFit like left, but extend the last element to the right
+ #leftSpaceFit like leftSpace, but extend the last element to the right
the vertical layout can be:
@@ -71,21 +78,37 @@
#bottom place it at the bottom
#bottomSpace place it at the bottom, offset by verticalSpace
#fit resize elements vertically to fit this panel
+ #fitSpace like fit, but with spacing
- The defaults is #centered for both directions.
+ The defaults is #center for both directions.
The layout is changed by the messages #verticalLayout: and #horizontalLayout:.
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.
"
!
examples
"
+ These examples show the effect of various horizontalLayout and
+ verticalLayout settings. Try them all. Especially, notice the
+ differences between the xxx and xxxSpace layouts and the effect of
+ 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.
+
+
example: default layout (centered)
|v p b1 b2 b3|
v := StandardSystemView new.
+ v label:'default'.
+
p := HorizontalPanelView in:v.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -95,12 +118,14 @@
v open
- example: left-layout
+ example: left-layout (vertical is default -> centered)
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=left'.
+
p horizontalLayout:#left.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -110,12 +135,65 @@
v open
- example: right-layout
+ example: left starting with spacing (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=leftSpace'.
+
+ p horizontalLayout:#leftSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: leftFit-layout (vertical is default -> centered)
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=leftFit'.
+
+ p horizontalLayout:#leftFit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: leftSpaceFit-layout (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=leftFit'.
+
+ p horizontalLayout:#leftSpaceFit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: right-layout (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=right'.
+
p horizontalLayout:#right.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -125,13 +203,67 @@
v open
- example: spread-layout
+ example: right with initial spacing (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=rightSpace'.
+
+ p horizontalLayout:#rightSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit-layout (vertical is default -> centered)
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- p horizontalLayout:#spread.
+ p horizontalLayout:#fit.
+ v label:'hL=fit'.
+
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: full fit (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p horizontalLayout:#fit.
+ p horizontalSpace:0.
+ v label:'hL=fit hS=0'.
+
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit with spacing (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fitSpace'.
+
+ p horizontalLayout:#fitSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
b2 := Button label:'button2' in:p.
@@ -139,12 +271,85 @@
v extent:300 @ 100.
v open
+
+ example: spread-layout (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p horizontalLayout:#spread.
+ v label:'hL=spread'.
+
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: spread with spacing (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=spreadSpace'.
+
+ p horizontalLayout:#spreadSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: spread with spacing; vertical fit
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=spreadSpace vL=fit'.
+
+ p horizontalLayout:#spreadSpace.
+ p verticalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: spread with spacing; vertical fit with spacing
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=spreadSpace vL=fitSpace'.
+
+ p horizontalLayout:#spreadSpace.
+ p verticalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
example: fit - top
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=fit vL=top'.
+
p horizontalLayout:#fit.
p verticalLayout:#top.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -154,12 +359,88 @@
v extent:300 @ 100.
v open
+
+ example: fit with initial spacing
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fitSpace vL=top'.
+
+ p horizontalLayout:#fitSpace.
+ p verticalLayout:#top.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit with initial spacing in both directions
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fitSpace vL=fitSpace'.
+
+ p horizontalLayout:#fitSpace.
+ p verticalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit without spacing in both directions
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fit vL=fit hS=0'.
+
+ p horizontalLayout:#fit.
+ p verticalLayout:#fit.
+ p horizontalSpace:0.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit with initial spacing; top with spacing
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fitSpace vL=topSpace'.
+
+ p horizontalLayout:#fitSpace.
+ p verticalLayout:#topSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
example: fit - top without spacing
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=fit vL=top'.
+
p horizontalLayout:#fit.
p verticalLayout:#top.
p horizontalSpace:0.
@@ -170,13 +451,16 @@
v extent:300 @ 100.
v open
+
example: fit - bottom with spacing and bottomSpace
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- p horizontalLayout:#fit.
+ v label:'hL=fitSpace vL=bottomSpace'.
+
+ p horizontalLayout:#fitSpace.
p verticalLayout:#bottomSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -185,12 +469,15 @@
v extent:300 @ 100.
v open
+
example: fit no horizontal space - bottom with spacing and bottomSpace
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=fit vL=bottomSpace'.
+
p horizontalLayout:#fit.
p verticalLayout:#bottomSpace.
p horizontalSpace:0.
@@ -200,6 +487,37 @@
b3 := Button label:'button3' in:p.
v extent:300 @ 100.
v open
+
+ example: a browser like table, where the rightmost list
+ extends to the far right.
+
+ |v p l1 l2 l3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=leftFit'.
+
+ p horizontalLayout:#leftFit.
+ p verticalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+
+ l1 := ScrollableView for:FileSelectionList in:p.
+ l1 stayInDirectory:true.
+ l1 ignoreParentDirectory:true.
+ l1 directory:'/'.
+ l1 action:[:selection | l2 directory:(l1 selectedPathname)].
+
+ l2 := ScrollableView for:FileSelectionList in:p.
+ l2 stayInDirectory:true.
+ l2 directory:nil.
+ l2 ignoreParentDirectory:true.
+ l2 action:[:selection | l3 directory:(l2 selectedPathname)].
+
+ l3 := ScrollableView for:FileSelectionList in:p.
+ l3 directory:nil.
+ l3 ignoreParentDirectory:true.
+ v extent:400 @ 300.
+ v open
"
! !
@@ -215,7 +533,7 @@
#fit
#right
#rightSpace
- the default is #centered
+ the default is #center
"
^ hLayout
@@ -224,13 +542,11 @@
verticalLayout
"return the vertical layout as a symbol.
the returned value is one of
- #top
- #topSpace
+ #top / #topSpace
#center
- #bottom
- #bottomSpace
- #fit
- the default is #centered
+ #bottom / #bottomSpace
+ #fit
+ the default is #center
"
^ vLayout
@@ -239,14 +555,12 @@
horizontalLayout:aSymbol
"change the horizontal layout as symbol.
The argument, aSymbol must be one of:
- #left
- #leftSpace
+ #left / #leftSpace
#center
- #spread
- #fit
- #right
- #rightSpace
- the default (if never changed) is #centered
+ #spread / spredSpace
+ #fit / fitSpace
+ #right / #rightSpace
+ the default (if never changed) is #center
"
(hLayout ~~ aSymbol) ifTrue:[
@@ -258,13 +572,11 @@
verticalLayout:aSymbol
"change the vertical layout as a symbol.
The argument, aSymbol must be one of:
- #top
- #topSpace
+ #top / #topSpace
#center
- #bottom
- #bottomSpace
+ #bottom / #bottomSpace
#fit
- the default (if never changed) is #centered
+ the default (if never changed) is #center
"
(vLayout ~~ aSymbol) ifTrue:[
@@ -317,7 +629,7 @@
sumOfWidths := sumOfWidths + (horizontalSpace * 2).
maxHeight := maxHeight + (verticalSpace * 2).
].
- hLayout == #fit ifTrue:[
+ (hLayout == #fit or:[hLayout == #fitSpace]) ifTrue:[
sumOfWidths := maxWidth * subViews size.
borderWidth ~~ 0 ifTrue:[
sumOfWidths := sumOfWidths + (verticalSpace * 2).
@@ -329,7 +641,7 @@
((vLayout == #topSpace) or:[vLayout == #bottomSpace]) ifTrue:[
maxHeight := maxHeight + verticalSpace
] ifFalse:[
- ((vLayout == #fit) or:[vLayout == #center]) ifTrue:[
+ ((vLayout == #fitSpace) or:[vLayout == #center]) ifTrue:[
maxHeight := maxHeight + (verticalSpace * 2)
]
].
@@ -343,100 +655,125 @@
"(re)compute position of every child whenever childs are added or
my size has changed"
- |xpos space sumOfWidths numChilds l wEach|
+ |xpos space sumOfWidths numChilds l wEach wInside|
subViews isNil ifTrue:[^ self].
space := horizontalSpace.
numChilds := subViews size.
+ wInside := width - (margin * 2) + (borderWidth*2) - subViews last borderWidth.
- hLayout == #fit ifTrue:[
+ hLayout == #fitSpace ifTrue:[
"
adjust childs extents and set origins.
Be careful to avoid accumulation of rounding errors
"
- wEach := (width - (margin * 2) - (numChilds + 1 * space) + borderWidth) / numChilds.
+ wEach := (wInside - (numChilds + 1 * space)) / numChilds.
xpos := space + margin - borderWidth.
] ifFalse:[
-
- "
- compute net width needed
- "
- sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
+ hLayout == #fit ifTrue:[
+ "
+ adjust childs extents and set origins.
+ Be careful to avoid accumulation of rounding errors
+ "
+ wEach := (wInside - (numChilds - 1 * space)) / numChilds.
+ xpos := margin - borderWidth.
+ ] ifFalse:[
+ "
+ compute net width needed
+ "
+ sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
- l := hLayout.
- ((l == #center) and:[numChilds == 1]) ifTrue:[
- l := #spread
- ].
+ l := hLayout.
+ ((l == #center) and:[numChilds == 1]) ifTrue:[
+ l := #spread
+ ].
+ (l == #spread and:[numChilds == 1]) ifTrue:[
+ l := #spreadSpace
+ ].
- "
- compute position of leftmost subview and space between them;
- if they do hardly fit, leave no space between them
+ "
+ compute position of leftmost subview and space between them;
+ if they do hardly fit, leave no space between them
+ "
+ (sumOfWidths >= (width - (margin * 2))) ifTrue:[
+ xpos := 0.
+ space := 0
+ ] ifFalse: [
+ ((l == #right) or:[l == #rightSpace]) ifTrue:[
+ xpos := width - (space * (numChilds - 1)) - sumOfWidths.
"
- (sumOfWidths >= (width - (margin * 2))) ifTrue:[
- xpos := 0.
- space := 0
- ] ifFalse: [
- ((l == #right) or:[l == #rightSpace]) ifTrue:[
- xpos := width - (space * numChilds) - sumOfWidths.
- "
- borderWidth == 0 ifTrue:[
- xpos := xpos + space
- ].
- "
- l == #rightSpace ifTrue:[
- xpos > space ifTrue:[
- xpos := xpos - space
- ]
- ].
+ borderWidth == 0 ifTrue:[
+ xpos := xpos + space
+ ].
+ "
+ l == #rightSpace ifTrue:[
+ xpos >= space ifTrue:[
+ xpos := xpos - space
+ ]
+ ].
- xpos < 0 ifTrue:[
- space := space min:(width - sumOfWidths) // (numChilds + 1).
- xpos := width - (space * numChilds) - sumOfWidths.
- ]
- ] ifFalse:[
- (l == #spread) ifTrue:[
- space := (width - sumOfWidths) // (numChilds + 1).
- xpos := space.
- (space == 0) ifTrue:[
- xpos := (width - sumOfWidths) // 2
+ xpos < 0 ifTrue:[
+ space := space min:(width - sumOfWidths) // (numChilds + 1).
+ xpos := width - (space * numChilds) - sumOfWidths.
]
] ifFalse:[
- ((l == #left) or:[l == #leftSpace]) ifTrue:[
- space := space min:(width - sumOfWidths) // (numChilds + 1).
- l == #leftSpace ifTrue:[
- xpos := space.
- ] ifFalse:[
- xpos := 0
+ (l == #spread) ifTrue:[
+ space := (width - sumOfWidths) // (numChilds - 1).
+ xpos := 0.
+ (space == 0) ifTrue:[
+ xpos := (width - sumOfWidths) // 2
+ ]
+ ] ifFalse:[
+ (l == #spreadSpace) ifTrue:[
+ space := (width - sumOfWidths) // (numChilds + 1).
+ xpos := space.
+ (space == 0) ifTrue:[
+ xpos := (width - sumOfWidths) // 2
]
- "
- borderWidth == 0 ifTrue:[
- xpos := 0
- ].
- "
- ] ifFalse:[
- xpos := (width - (sumOfWidths
- + ((numChilds - 1) * space))) // 2.
- xpos < 0 ifTrue:[
- space := (width - sumOfWidths) // (numChilds + 1).
+ ] ifFalse:[
+ ((l == #left)
+ or:[l == #leftSpace
+ or:[l == #leftFit
+ or:[l == #leftSpaceFit]]]) ifTrue:[
+ space := space min:(width - sumOfWidths) // (numChilds + 1).
+ (l == #leftSpace
+ or:[l == #leftSpaceFit]) ifTrue:[
+ xpos := space.
+ ] ifFalse:[
+ xpos := 0
+ ]
+ "
+ borderWidth == 0 ifTrue:[
+ xpos := 0
+ ].
+ "
+ ] ifFalse:[
+ "center"
xpos := (width - (sumOfWidths
- + ((numChilds - 1) * space))) // 2.
+ + ((numChilds - 1) * space))) // 2.
+ xpos < 0 ifTrue:[
+ space := (width - sumOfWidths) // (numChilds + 1).
+ xpos := (width - (sumOfWidths
+ + ((numChilds - 1) * space))) // 2.
+ ]
]
+ ]
]
]
- ]
+ ].
].
].
"now set positions"
- subViews do:[:child |
- |ypos|
+ subViews keysAndValuesDo:[:index :child |
+ |ypos advance|
vLayout == #top ifTrue:[
ypos := 0
] ifFalse:[
- hLayout == #topSpace ifTrue:[
+ vLayout == #topSpace ifTrue:[
ypos := verticalSpace
] ifFalse:[
vLayout == #bottom ifTrue:[
@@ -445,12 +782,17 @@
vLayout == #bottomSpace ifTrue:[
ypos := height - verticalSpace - child heightIncludingBorder.
] ifFalse:[
- vLayout == #fit ifTrue:[
+ vLayout == #fitSpace ifTrue:[
ypos := verticalSpace.
child height:(height - (verticalSpace + child borderWidth * 2))
] ifFalse:[
- "centered"
- ypos := (height - child heightIncludingBorder) // 2.
+ vLayout == #fit ifTrue:[
+ ypos := 0.
+ child height:(height - (child borderWidth * 2))
+ ] ifFalse:[
+ "centered"
+ ypos := (height - child heightIncludingBorder) // 2.
+ ]
]
]
]
@@ -458,14 +800,29 @@
].
(ypos < 0) ifTrue:[ypos := 0].
- hLayout == #fit ifTrue:[
- child origin:(xpos rounded @ ypos)
- corner:(xpos + wEach - (child borderWidth)) rounded
+ (hLayout == #fit or:[hLayout == #fitSpace]) ifTrue:[
+ child origin:(xpos truncated @ ypos)
+ corner:(xpos + wEach - (child borderWidth)) truncated
@ (ypos + child height).
- xpos := xpos + wEach + space
+ advance := wEach.
] ifFalse:[
child origin:(xpos @ ypos).
- xpos := xpos + (child widthIncludingBorder) + space
+ advance := child widthIncludingBorder
+ ].
+ xpos := xpos + advance + space.
+
+ index == numChilds ifTrue:[
+ |x|
+
+ hLayout == #leftFit ifTrue:[
+ x := width - margin.
+ ].
+ hLayout == #leftSpaceFit ifTrue:[
+ x := width - margin - space
+ ].
+ x notNil ifTrue:[
+ subViews last corner:(x @ (ypos + child height))
+ ]
]
- ]
+ ].
! !
--- a/HorizontalPanelView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/HorizontalPanelView.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.7 1994-11-21 16:45:24 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.8 1995-02-06 00:52:25 claus Exp $
'!
!HorizontalPanelView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.7 1994-11-21 16:45:24 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.8 1995-02-06 00:52:25 claus Exp $
"
!
@@ -52,7 +52,10 @@
All real work is done in PanelView - only the layout computation is
redefined here.
- The layout is controlled by two instance variables.
+ The layout is controlled the instance variables:
+ horizontalLayout and verticalLayout
+ in addition to horizontalSpace and verticalSpace.
+
The horizontal layout can be any of:
#left arrange elements at the left
@@ -61,7 +64,11 @@
#rightSpace arrange elements at the right, start with spacing
#center arrange elements in the center
#spread spread elements evenly
+ #spreadSpace spread elements evenly with spacing at the ends
#fit like spread, but resize elements for tight packing
+ #fitSpace like fit, with additional spacing at the far ends
+ #leftFit like left, but extend the last element to the right
+ #leftSpaceFit like leftSpace, but extend the last element to the right
the vertical layout can be:
@@ -71,21 +78,37 @@
#bottom place it at the bottom
#bottomSpace place it at the bottom, offset by verticalSpace
#fit resize elements vertically to fit this panel
+ #fitSpace like fit, but with spacing
- The defaults is #centered for both directions.
+ The defaults is #center for both directions.
The layout is changed by the messages #verticalLayout: and #horizontalLayout:.
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.
"
!
examples
"
+ These examples show the effect of various horizontalLayout and
+ verticalLayout settings. Try them all. Especially, notice the
+ differences between the xxx and xxxSpace layouts and the effect of
+ 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.
+
+
example: default layout (centered)
|v p b1 b2 b3|
v := StandardSystemView new.
+ v label:'default'.
+
p := HorizontalPanelView in:v.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -95,12 +118,14 @@
v open
- example: left-layout
+ example: left-layout (vertical is default -> centered)
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=left'.
+
p horizontalLayout:#left.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -110,12 +135,65 @@
v open
- example: right-layout
+ example: left starting with spacing (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=leftSpace'.
+
+ p horizontalLayout:#leftSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: leftFit-layout (vertical is default -> centered)
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=leftFit'.
+
+ p horizontalLayout:#leftFit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: leftSpaceFit-layout (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=leftFit'.
+
+ p horizontalLayout:#leftSpaceFit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: right-layout (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=right'.
+
p horizontalLayout:#right.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -125,13 +203,67 @@
v open
- example: spread-layout
+ example: right with initial spacing (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=rightSpace'.
+
+ p horizontalLayout:#rightSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit-layout (vertical is default -> centered)
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- p horizontalLayout:#spread.
+ p horizontalLayout:#fit.
+ v label:'hL=fit'.
+
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: full fit (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p horizontalLayout:#fit.
+ p horizontalSpace:0.
+ v label:'hL=fit hS=0'.
+
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit with spacing (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fitSpace'.
+
+ p horizontalLayout:#fitSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
b2 := Button label:'button2' in:p.
@@ -139,12 +271,85 @@
v extent:300 @ 100.
v open
+
+ example: spread-layout (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p horizontalLayout:#spread.
+ v label:'hL=spread'.
+
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: spread with spacing (vertical is default -> centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=spreadSpace'.
+
+ p horizontalLayout:#spreadSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: spread with spacing; vertical fit
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=spreadSpace vL=fit'.
+
+ p horizontalLayout:#spreadSpace.
+ p verticalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: spread with spacing; vertical fit with spacing
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=spreadSpace vL=fitSpace'.
+
+ p horizontalLayout:#spreadSpace.
+ p verticalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
example: fit - top
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=fit vL=top'.
+
p horizontalLayout:#fit.
p verticalLayout:#top.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
@@ -154,12 +359,88 @@
v extent:300 @ 100.
v open
+
+ example: fit with initial spacing
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fitSpace vL=top'.
+
+ p horizontalLayout:#fitSpace.
+ p verticalLayout:#top.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit with initial spacing in both directions
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fitSpace vL=fitSpace'.
+
+ p horizontalLayout:#fitSpace.
+ p verticalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit without spacing in both directions
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fit vL=fit hS=0'.
+
+ p horizontalLayout:#fit.
+ p verticalLayout:#fit.
+ p horizontalSpace:0.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: fit with initial spacing; top with spacing
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=fitSpace vL=topSpace'.
+
+ p horizontalLayout:#fitSpace.
+ p verticalLayout:#topSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
example: fit - top without spacing
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=fit vL=top'.
+
p horizontalLayout:#fit.
p verticalLayout:#top.
p horizontalSpace:0.
@@ -170,13 +451,16 @@
v extent:300 @ 100.
v open
+
example: fit - bottom with spacing and bottomSpace
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
- p horizontalLayout:#fit.
+ v label:'hL=fitSpace vL=bottomSpace'.
+
+ p horizontalLayout:#fitSpace.
p verticalLayout:#bottomSpace.
p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
b1 := Button label:'button1' in:p.
@@ -185,12 +469,15 @@
v extent:300 @ 100.
v open
+
example: fit no horizontal space - bottom with spacing and bottomSpace
|v p b1 b2 b3|
v := StandardSystemView new.
p := HorizontalPanelView in:v.
+ v label:'hL=fit vL=bottomSpace'.
+
p horizontalLayout:#fit.
p verticalLayout:#bottomSpace.
p horizontalSpace:0.
@@ -200,6 +487,37 @@
b3 := Button label:'button3' in:p.
v extent:300 @ 100.
v open
+
+ example: a browser like table, where the rightmost list
+ extends to the far right.
+
+ |v p l1 l2 l3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ v label:'hL=leftFit'.
+
+ p horizontalLayout:#leftFit.
+ p verticalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+
+ l1 := ScrollableView for:FileSelectionList in:p.
+ l1 stayInDirectory:true.
+ l1 ignoreParentDirectory:true.
+ l1 directory:'/'.
+ l1 action:[:selection | l2 directory:(l1 selectedPathname)].
+
+ l2 := ScrollableView for:FileSelectionList in:p.
+ l2 stayInDirectory:true.
+ l2 directory:nil.
+ l2 ignoreParentDirectory:true.
+ l2 action:[:selection | l3 directory:(l2 selectedPathname)].
+
+ l3 := ScrollableView for:FileSelectionList in:p.
+ l3 directory:nil.
+ l3 ignoreParentDirectory:true.
+ v extent:400 @ 300.
+ v open
"
! !
@@ -215,7 +533,7 @@
#fit
#right
#rightSpace
- the default is #centered
+ the default is #center
"
^ hLayout
@@ -224,13 +542,11 @@
verticalLayout
"return the vertical layout as a symbol.
the returned value is one of
- #top
- #topSpace
+ #top / #topSpace
#center
- #bottom
- #bottomSpace
- #fit
- the default is #centered
+ #bottom / #bottomSpace
+ #fit
+ the default is #center
"
^ vLayout
@@ -239,14 +555,12 @@
horizontalLayout:aSymbol
"change the horizontal layout as symbol.
The argument, aSymbol must be one of:
- #left
- #leftSpace
+ #left / #leftSpace
#center
- #spread
- #fit
- #right
- #rightSpace
- the default (if never changed) is #centered
+ #spread / spredSpace
+ #fit / fitSpace
+ #right / #rightSpace
+ the default (if never changed) is #center
"
(hLayout ~~ aSymbol) ifTrue:[
@@ -258,13 +572,11 @@
verticalLayout:aSymbol
"change the vertical layout as a symbol.
The argument, aSymbol must be one of:
- #top
- #topSpace
+ #top / #topSpace
#center
- #bottom
- #bottomSpace
+ #bottom / #bottomSpace
#fit
- the default (if never changed) is #centered
+ the default (if never changed) is #center
"
(vLayout ~~ aSymbol) ifTrue:[
@@ -317,7 +629,7 @@
sumOfWidths := sumOfWidths + (horizontalSpace * 2).
maxHeight := maxHeight + (verticalSpace * 2).
].
- hLayout == #fit ifTrue:[
+ (hLayout == #fit or:[hLayout == #fitSpace]) ifTrue:[
sumOfWidths := maxWidth * subViews size.
borderWidth ~~ 0 ifTrue:[
sumOfWidths := sumOfWidths + (verticalSpace * 2).
@@ -329,7 +641,7 @@
((vLayout == #topSpace) or:[vLayout == #bottomSpace]) ifTrue:[
maxHeight := maxHeight + verticalSpace
] ifFalse:[
- ((vLayout == #fit) or:[vLayout == #center]) ifTrue:[
+ ((vLayout == #fitSpace) or:[vLayout == #center]) ifTrue:[
maxHeight := maxHeight + (verticalSpace * 2)
]
].
@@ -343,100 +655,125 @@
"(re)compute position of every child whenever childs are added or
my size has changed"
- |xpos space sumOfWidths numChilds l wEach|
+ |xpos space sumOfWidths numChilds l wEach wInside|
subViews isNil ifTrue:[^ self].
space := horizontalSpace.
numChilds := subViews size.
+ wInside := width - (margin * 2) + (borderWidth*2) - subViews last borderWidth.
- hLayout == #fit ifTrue:[
+ hLayout == #fitSpace ifTrue:[
"
adjust childs extents and set origins.
Be careful to avoid accumulation of rounding errors
"
- wEach := (width - (margin * 2) - (numChilds + 1 * space) + borderWidth) / numChilds.
+ wEach := (wInside - (numChilds + 1 * space)) / numChilds.
xpos := space + margin - borderWidth.
] ifFalse:[
-
- "
- compute net width needed
- "
- sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
+ hLayout == #fit ifTrue:[
+ "
+ adjust childs extents and set origins.
+ Be careful to avoid accumulation of rounding errors
+ "
+ wEach := (wInside - (numChilds - 1 * space)) / numChilds.
+ xpos := margin - borderWidth.
+ ] ifFalse:[
+ "
+ compute net width needed
+ "
+ sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
- l := hLayout.
- ((l == #center) and:[numChilds == 1]) ifTrue:[
- l := #spread
- ].
+ l := hLayout.
+ ((l == #center) and:[numChilds == 1]) ifTrue:[
+ l := #spread
+ ].
+ (l == #spread and:[numChilds == 1]) ifTrue:[
+ l := #spreadSpace
+ ].
- "
- compute position of leftmost subview and space between them;
- if they do hardly fit, leave no space between them
+ "
+ compute position of leftmost subview and space between them;
+ if they do hardly fit, leave no space between them
+ "
+ (sumOfWidths >= (width - (margin * 2))) ifTrue:[
+ xpos := 0.
+ space := 0
+ ] ifFalse: [
+ ((l == #right) or:[l == #rightSpace]) ifTrue:[
+ xpos := width - (space * (numChilds - 1)) - sumOfWidths.
"
- (sumOfWidths >= (width - (margin * 2))) ifTrue:[
- xpos := 0.
- space := 0
- ] ifFalse: [
- ((l == #right) or:[l == #rightSpace]) ifTrue:[
- xpos := width - (space * numChilds) - sumOfWidths.
- "
- borderWidth == 0 ifTrue:[
- xpos := xpos + space
- ].
- "
- l == #rightSpace ifTrue:[
- xpos > space ifTrue:[
- xpos := xpos - space
- ]
- ].
+ borderWidth == 0 ifTrue:[
+ xpos := xpos + space
+ ].
+ "
+ l == #rightSpace ifTrue:[
+ xpos >= space ifTrue:[
+ xpos := xpos - space
+ ]
+ ].
- xpos < 0 ifTrue:[
- space := space min:(width - sumOfWidths) // (numChilds + 1).
- xpos := width - (space * numChilds) - sumOfWidths.
- ]
- ] ifFalse:[
- (l == #spread) ifTrue:[
- space := (width - sumOfWidths) // (numChilds + 1).
- xpos := space.
- (space == 0) ifTrue:[
- xpos := (width - sumOfWidths) // 2
+ xpos < 0 ifTrue:[
+ space := space min:(width - sumOfWidths) // (numChilds + 1).
+ xpos := width - (space * numChilds) - sumOfWidths.
]
] ifFalse:[
- ((l == #left) or:[l == #leftSpace]) ifTrue:[
- space := space min:(width - sumOfWidths) // (numChilds + 1).
- l == #leftSpace ifTrue:[
- xpos := space.
- ] ifFalse:[
- xpos := 0
+ (l == #spread) ifTrue:[
+ space := (width - sumOfWidths) // (numChilds - 1).
+ xpos := 0.
+ (space == 0) ifTrue:[
+ xpos := (width - sumOfWidths) // 2
+ ]
+ ] ifFalse:[
+ (l == #spreadSpace) ifTrue:[
+ space := (width - sumOfWidths) // (numChilds + 1).
+ xpos := space.
+ (space == 0) ifTrue:[
+ xpos := (width - sumOfWidths) // 2
]
- "
- borderWidth == 0 ifTrue:[
- xpos := 0
- ].
- "
- ] ifFalse:[
- xpos := (width - (sumOfWidths
- + ((numChilds - 1) * space))) // 2.
- xpos < 0 ifTrue:[
- space := (width - sumOfWidths) // (numChilds + 1).
+ ] ifFalse:[
+ ((l == #left)
+ or:[l == #leftSpace
+ or:[l == #leftFit
+ or:[l == #leftSpaceFit]]]) ifTrue:[
+ space := space min:(width - sumOfWidths) // (numChilds + 1).
+ (l == #leftSpace
+ or:[l == #leftSpaceFit]) ifTrue:[
+ xpos := space.
+ ] ifFalse:[
+ xpos := 0
+ ]
+ "
+ borderWidth == 0 ifTrue:[
+ xpos := 0
+ ].
+ "
+ ] ifFalse:[
+ "center"
xpos := (width - (sumOfWidths
- + ((numChilds - 1) * space))) // 2.
+ + ((numChilds - 1) * space))) // 2.
+ xpos < 0 ifTrue:[
+ space := (width - sumOfWidths) // (numChilds + 1).
+ xpos := (width - (sumOfWidths
+ + ((numChilds - 1) * space))) // 2.
+ ]
]
+ ]
]
]
- ]
+ ].
].
].
"now set positions"
- subViews do:[:child |
- |ypos|
+ subViews keysAndValuesDo:[:index :child |
+ |ypos advance|
vLayout == #top ifTrue:[
ypos := 0
] ifFalse:[
- hLayout == #topSpace ifTrue:[
+ vLayout == #topSpace ifTrue:[
ypos := verticalSpace
] ifFalse:[
vLayout == #bottom ifTrue:[
@@ -445,12 +782,17 @@
vLayout == #bottomSpace ifTrue:[
ypos := height - verticalSpace - child heightIncludingBorder.
] ifFalse:[
- vLayout == #fit ifTrue:[
+ vLayout == #fitSpace ifTrue:[
ypos := verticalSpace.
child height:(height - (verticalSpace + child borderWidth * 2))
] ifFalse:[
- "centered"
- ypos := (height - child heightIncludingBorder) // 2.
+ vLayout == #fit ifTrue:[
+ ypos := 0.
+ child height:(height - (child borderWidth * 2))
+ ] ifFalse:[
+ "centered"
+ ypos := (height - child heightIncludingBorder) // 2.
+ ]
]
]
]
@@ -458,14 +800,29 @@
].
(ypos < 0) ifTrue:[ypos := 0].
- hLayout == #fit ifTrue:[
- child origin:(xpos rounded @ ypos)
- corner:(xpos + wEach - (child borderWidth)) rounded
+ (hLayout == #fit or:[hLayout == #fitSpace]) ifTrue:[
+ child origin:(xpos truncated @ ypos)
+ corner:(xpos + wEach - (child borderWidth)) truncated
@ (ypos + child height).
- xpos := xpos + wEach + space
+ advance := wEach.
] ifFalse:[
child origin:(xpos @ ypos).
- xpos := xpos + (child widthIncludingBorder) + space
+ advance := child widthIncludingBorder
+ ].
+ xpos := xpos + advance + space.
+
+ index == numChilds ifTrue:[
+ |x|
+
+ hLayout == #leftFit ifTrue:[
+ x := width - margin.
+ ].
+ hLayout == #leftSpaceFit ifTrue:[
+ x := width - margin - space
+ ].
+ x notNil ifTrue:[
+ subViews last corner:(x @ (ypos + child height))
+ ]
]
- ]
+ ].
! !
--- a/InfoBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/InfoBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -10,24 +10,24 @@
hereby transferred.
"
-ModalBox subclass:#InfoBox
- instanceVariableNames:'formLabel textLabel buttonPanel okButton okAction
- acceptReturnAsOK'
- classVariableNames:'InfoBitmap'
- poolDictionaries:''
- category:'Views-DialogBoxes'
+
+
+'From Smalltalk/X, Version:2.10.4 on 28-dec-1994 at 1:57:21 pm'!
+
+DialogBox subclass:#InfoBox
+ instanceVariableNames:'formLabel textLabel'
+ classVariableNames:'InfoBitmap'
+ poolDictionaries:''
+ category:'Views-DialogBoxes'
!
-InfoBox comment:'
-
-COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+!InfoBox class methodsFor:'documentation'!
-$Header: /cvs/stx/stx/libwidg/InfoBox.st,v 1.10 1994-12-28 13:53:57 claus Exp $
-written Spring/Summer 89 by claus
-'!
-
-!InfoBox class methodsFor:'documentation'!
+version
+"
+$Header: /cvs/stx/stx/libwidg/InfoBox.st,v 1.11 1995-02-06 00:52:28 claus Exp $
+"
+!
documentation
"
@@ -45,18 +45,12 @@
textLabel <Label> shows the boxes text
- buttonPanel <PanelView> contains the button(s)
-
- okButton <Button> the ok-Button
+"
- okAction <Block> the action to be performed when ok is pressed,
- or return is pressed.
+!
- acceptReturnAsOK <Boolean> if true, pressing the return-key counts
- as if ok was pressed. Default is true.
-
-
-
+examples
+"
InfoBoxes are created with:
aBox := InfoBox title:'some title'.
@@ -76,83 +70,104 @@
aBox form:aForm
(the name 'form:' is historical - any bitmap or image is allowed).
+
+
+ Since this type of information is pretty common, a convenient information
+ method has been added to Object.
+ Thus, you can use:
+ self information:'hello world'
+ everwhere in your program.
+
+ standard box:
+
+ |box|
+
+ box := InfoBox title:'hello world '.
+ box open
+
+
+ changing the buttons label:
+
+ |box|
+
+ box := InfoBox title:'hello world '.
+ box okText:'wow'.
+ box open
+
+
+ changing the icon:
+
+ |box|
+
+ box := InfoBox title:'hello world '.
+ box form:(Image fromFile:'bitmaps/SBrowser.xbm').
+ box okText:'wow'.
+ box open
+
+ or even:
+
+ |box|
+
+ box := InfoBox title:'hello garfield '.
+ box form:((Image fromFile:'bitmaps/garfield.gif') magnifyTo:200@100).
+ box okText:'wow'.
+ box open
+
+
+ If you plan to use boxes as in the last example, you may want to
+ keep the box around for reuse (since the image magnification takes some time).
+
+ |box|
+
+ box := InfoBox title:'hello garfield '.
+ box form:((Image fromFile:'bitmaps/garfield.gif') magnifyTo:200@100).
+ box okText:'wow'.
+ box open.
+
+ box title:'hello again'.
+ box open
+
"
!
-examples
+copyright
"
- Examples:
-
- |aBox|
- aBox := InfoBox title:'a simple Info'.
- aBox showAtPointer.
-
- |aBox|
- aBox := InfoBox title:'a simple Info'.
- aBox open.
-
- |aBox|
- aBox := InfoBox title:'a simple Info'.
- aBox showAt:0@0.
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
- |aBox|
- aBox := InfoBox title:'a simple Info'.
- aBox acceptReturnAsOK:false.
- aBox showAtPointer.
-
- |aBox|
- aBox := InfoBox title:'Press ''YES'' to continue\(or type return)' withCRs.
- aBox okText:'YES'.
- aBox showAtPointer.
+ 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.
+"
- |aBox|
- aBox := InfoBox title:'another one'.
- aBox form:(Form fromFile:'SBrowser.xbm').
- aBox showAtPointer
- |aBox|
- aBox := InfoBox title:'a nice one'.
- aBox form:(Image fromFile:'bitmaps/garfield.gif').
- aBox showAtPointer
+! !
+
+!InfoBox class methodsFor:'instance creation'!
- |aBox|
- aBox := InfoBox title:'a nice one'.
- aBox form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.3@0.3).
- aBox showAtPointer
+title:titleString
+ "create a new infoBox with title, aTitleString"
+
+ ^ (self new) title:titleString
- |aBox|
- aBox := InfoBox title:'a nice one'.
- aBox form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.3@0.3).
- aBox formLabel level:-1.
- aBox showAtPointer
-
- |aBox|
- aBox := InfoBox title:'a nice one'.
- aBox form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.3@0.3).
- aBox formLabel level:1.
- aBox showAtPointer
+ "
+ (InfoBox title:'hello') open
+ "
+! !
- |aBox|
- aBox := InfoBox title:'another nice one'.
- aBox form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.3@0.3).
- aBox formLabel level:1.
- aBox textLabel font:(Font family:'helvetica' face:'bold' style:'roman' size:20).
- aBox showAtPointer
+!InfoBox class methodsFor:'defaults'!
- |aBox|
- aBox := InfoBox title:'a nice one'.
- aBox form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.3@0.3).
- aBox formLabel borderWidth:2.
- aBox formLabel borderColor:Color red.
- aBox showAtPointer
+iconBitmap
+ "return the bitmap shown as icon in my instances.
+ The form is cached and reused, for faster opening."
- |aBox|
- aBox := InfoBox title:'start printing'.
- aBox form:(Image fromFile:'bitmaps/ljet3.xpm').
- aBox formLabel level:2.
- aBox okText:'print'.
- aBox showAtPointer
-"
+ InfoBitmap isNil ifTrue:[
+ InfoBitmap := (Image fromFile:'bitmaps/Information.xbm') on:Display
+ ].
+ ^ InfoBitmap
! !
!InfoBox class methodsFor:'styles'!
@@ -164,97 +179,8 @@
img notNil ifTrue:[InfoBitmap := img on:Display].
! !
-!InfoBox class methodsFor:'icon bitmap'!
-
-iconBitmap
- "return the bitmap shown as icon in my instances.
- The form is cached and reused, for faster opening."
-
- InfoBitmap isNil ifTrue:[
- InfoBitmap := (Image fromFile:'bitmaps/Information.xbm') on:Display
- ].
- ^ InfoBitmap
-! !
-
-!InfoBox class methodsFor:'instance creation'!
-
-title:titleString
- "create a new infoBox with title, aTitleString"
-
- ^ (self new) title:titleString
-! !
-
-!InfoBox methodsFor:'initialization'!
-
-initialize
- |mm|
-
- super initialize.
-
- label := 'Info'.
-
- mm := ViewSpacing.
-
- acceptReturnAsOK := true.
-
- formLabel := Label in:self.
- self initFormBitmap.
- formLabel borderWidth:0.
- formLabel origin:(mm @ mm).
-
- textLabel := Label label:'Information' in:self.
- textLabel borderWidth:0.
- textLabel origin:[(mm + formLabel widthIncludingBorder + mm)
- @
- mm].
-
- buttonPanel := HorizontalPanelView in:self.
- buttonPanel origin:(0.0 @ 1.0)
- corner:(1.0 @ 1.0).
- buttonPanel leftInset:mm;
- rightInset:mm;
- topInset:(font height * 2 + mm + mm) negated;
- bottomInset:mm.
-
- buttonPanel layout:#spread.
- buttonPanel borderWidth:0.
-
- okButton := Button okButtonIn:buttonPanel.
- okButton action:[
- okButton turnOffWithoutRedraw.
- self okPressed
- ].
-!
-
-initFormBitmap
- "setup the bitmap shown in the upper left -
- extracted into a separate method for easier redefinition
- in subclasses"
-
- formLabel form:(self class iconBitmap)
-! !
-
-!InfoBox methodsFor:'realization'!
-
-positionOffset
- "return the delta, by which the box should be displayed
- from the mouse pointer. Value returned here makes center of
- okButton appear under the cursor"
-
- buttonPanel setChildPositionsIfChanged.
- ^ (okButton originRelativeTo:self) + (okButton extent // 2)
-! !
-
!InfoBox methodsFor:'accessing'!
-acceptReturnAsOK:aBoolean
- "turn on/off interpretation of return-key as ok.
- Default is on"
-
- acceptReturnAsOK := aBoolean.
- okButton isReturnButton:aBoolean.
-!
-
form:aForm
"define a form to be displayed left of the title
- usually an exclamation-mark"
@@ -264,12 +190,6 @@
self resize
!
-textLabel
- "return the textLabel = can be used to change its appearance"
-
- ^ textLabel
-!
-
formLabel
"return the formLabel = can be used to change its appearance"
@@ -286,32 +206,16 @@
]
!
+textLabel
+ "return the textLabel = can be used to change its appearance"
+
+ ^ textLabel
+!
+
title
"return the boxes title string"
^ textLabel label
-!
-
-okButton
- "return the okButton"
-
- ^ okButton
-!
-
-okAction:aBlock
- "define the action to be performed when ok is pressed"
-
- okAction := aBlock
-!
-
-okText:aString
- "define the text in the ok-button"
-
- aString ~= okButton label ifTrue:[
- okButton label:aString.
- okButton resize.
- self resize
- ]
! !
!InfoBox methodsFor:'queries'!
@@ -340,26 +244,43 @@
^ (w + extra) @ (h + extra)
! !
-!InfoBox methodsFor:'user interaction'!
+!InfoBox methodsFor:'initialization'!
-hideAndEvaluate:aBlock
- "make myself invisible and evaluate aBlock"
+initFormBitmap
+ "setup the bitmap shown in the upper left -
+ extracted into a separate method for easier redefinition
+ in subclasses"
- self hide.
- aBlock notNil ifTrue:[aBlock value]
+ formLabel form:(self class iconBitmap)
!
-okPressed
- "user pressed ok-button; make myself invisible and if an action was
- specified do it"
+initialize
+ |mm|
+
+ super initialize.
+ self addOkButton.
- self hideAndEvaluate:okAction
-!
+ label := 'Info'.
+
+ mm := ViewSpacing.
+
+ formLabel := Label in:self.
+ self initFormBitmap.
+ formLabel borderWidth:0.
+ formLabel origin:(mm @ mm).
-keyPress:aKey x:x y:y
- "return-key dublicates ok-function"
+ textLabel := Label label:'Information' in:self.
+ textLabel borderWidth:0.
+ textLabel origin:[(mm + formLabel widthIncludingBorder + mm)
+ @
+ mm].
- acceptReturnAsOK ifTrue:[
- (aKey == #Return) ifTrue:[self okPressed]
- ]
+ "
+ |b|
+
+ b := InfoBox new.
+ b title:'hello'.
+ b open
+ "
! !
+
--- a/LSelBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/LSelBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.6 1994-10-10 03:01:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.7 1995-02-06 00:52:32 claus Exp $
'!
!ListSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.6 1994-10-10 03:01:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.7 1995-02-06 00:52:32 claus Exp $
"
!
@@ -51,7 +51,16 @@
this class implements boxes for selection from a list. It offers
both an ok- and abort-buttons. The ok-button, if pressed will
evaluate the okAction (see EnterBox>>action).
- typical use is:
+ see examples for typical uses.
+
+ Notice, for file selections there is a specialized FileSelectionBox,
+ which supports matchPatterns, changing directory etc.
+"
+!
+
+examples
+"
+ simple:
|box|
@@ -60,6 +69,17 @@
box list:#('foo' 'bar' 'baz').
box okAction:[:sel | Transcript showCr:'the selection was:' , sel].
box showAtPointer
+
+ with a default:
+
+ |box|
+
+ box := ListSelectionBox new.
+ box title:'select something:'.
+ box list:#('foo' 'bar' 'baz').
+ box okAction:[:sel | Transcript showCr:'the selection was:' , sel].
+ box initialText:'foo'.
+ box showAtPointer
"
! !
@@ -95,6 +115,8 @@
super initialize.
+ label := 'Select or enter'.
+
"need more space than an enterBox"
"self height:(height + (font height * 5)). "
@@ -154,6 +176,10 @@
realize
self updateList.
super realize
+!
+
+focusSequence
+ ^ Array with:enterField with:selectionList with:okButton with:abortButton
! !
!ListSelectionBox methodsFor:'queries'!
@@ -171,7 +197,7 @@
hWanted := ViewSpacing + labelField height +
ViewSpacing + enterField height +
ViewSpacing + selectionList height +
- ViewSpacing + buttonPanel height +
+ ViewSpacing + buttonPanel preferedExtent y +
ViewSpacing.
(hWanted < height) ifTrue:[
--- a/Label.st Mon Feb 06 01:52:01 1995 +0100
+++ b/Label.st Mon Feb 06 01:53:30 1995 +0100
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.13 1994-11-28 21:05:02 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.14 1995-02-06 00:52:30 claus Exp $
'!
!Label class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.13 1994-11-28 21:05:02 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.14 1995-02-06 00:52:30 claus Exp $
"
!
@@ -295,8 +295,14 @@
!
updateStyleCache
- DefaultForegroundColor := StyleSheet colorAt:'labelForegroundColor' default:Black.
+ DefaultForegroundColor := StyleSheet colorAt:'labelForegroundColor'.
+ DefaultForegroundColor isNil ifTrue:[
+ DefaultForegroundColor := StyleSheet colorAt:'foregroundColor' default:Black.
+ ].
DefaultBackgroundColor := StyleSheet colorAt:'labelBackgroundColor'.
+ DefaultBackgroundColor isNil ifTrue:[
+ DefaultForegroundColor := StyleSheet colorAt:'backgroundColor'.
+ ].
DefaultFont := StyleSheet fontAt:'labelFont'.
"
@@ -638,16 +644,21 @@
"sent whenever size is changed by someone else - recompute the
logos position within the View."
+ |prevPosition|
+
+ prevPosition := labelOriginX.
self computeLabelOrigin
+ shown ifTrue:[
+ labelOriginX ~~ prevPosition ifTrue:[
+ self redraw
+ ]
+ ]
! !
!Label methodsFor:'redrawing'!
-drawWith:fg and:bg
- "redraw my label with fg/bg - this generic method is also used by subclasses
- (especially Button) to redraw the logo in different colors."
-
- |x y cutOff mustClear|
+clearInsideWith:bg
+ |cutOff mustClear|
cutOff := margin * 2.
@@ -670,6 +681,15 @@
width:(width - cutOff)
height:(height - cutOff).
].
+!
+
+drawWith:fg and:bg
+ "redraw my label with fg/bg - this generic method is also used by subclasses
+ (especially Button) to redraw the logo in different colors."
+
+ |x y|
+
+ self clearInsideWith:bg.
logo notNil ifTrue:[
self paint:fg on:bg.
--- a/ListSelectionBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ListSelectionBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.6 1994-10-10 03:01:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.7 1995-02-06 00:52:32 claus Exp $
'!
!ListSelectionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.6 1994-10-10 03:01:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.7 1995-02-06 00:52:32 claus Exp $
"
!
@@ -51,7 +51,16 @@
this class implements boxes for selection from a list. It offers
both an ok- and abort-buttons. The ok-button, if pressed will
evaluate the okAction (see EnterBox>>action).
- typical use is:
+ see examples for typical uses.
+
+ Notice, for file selections there is a specialized FileSelectionBox,
+ which supports matchPatterns, changing directory etc.
+"
+!
+
+examples
+"
+ simple:
|box|
@@ -60,6 +69,17 @@
box list:#('foo' 'bar' 'baz').
box okAction:[:sel | Transcript showCr:'the selection was:' , sel].
box showAtPointer
+
+ with a default:
+
+ |box|
+
+ box := ListSelectionBox new.
+ box title:'select something:'.
+ box list:#('foo' 'bar' 'baz').
+ box okAction:[:sel | Transcript showCr:'the selection was:' , sel].
+ box initialText:'foo'.
+ box showAtPointer
"
! !
@@ -95,6 +115,8 @@
super initialize.
+ label := 'Select or enter'.
+
"need more space than an enterBox"
"self height:(height + (font height * 5)). "
@@ -154,6 +176,10 @@
realize
self updateList.
super realize
+!
+
+focusSequence
+ ^ Array with:enterField with:selectionList with:okButton with:abortButton
! !
!ListSelectionBox methodsFor:'queries'!
@@ -171,7 +197,7 @@
hWanted := ViewSpacing + labelField height +
ViewSpacing + enterField height +
ViewSpacing + selectionList height +
- ViewSpacing + buttonPanel height +
+ ViewSpacing + buttonPanel preferedExtent y +
ViewSpacing.
(hWanted < height) ifTrue:[
--- a/ListView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ListView.st Mon Feb 06 01:53:30 1995 +0100
@@ -25,7 +25,7 @@
normalFont boldFont italicFont
autoScrollBlock autoScrollDeltaT
searchPattern wordCheck
- includesNonStrings'
+ includesNonStrings widthOfWidestLine'
classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
DefaultFont'
poolDictionaries:''
@@ -36,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.14 1994-11-28 21:05:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.15 1995-02-06 00:52:34 claus Exp $
'!
!ListView class methodsFor:'documentation'!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.14 1994-11-28 21:05:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.15 1995-02-06 00:52:34 claus Exp $
"
!
@@ -106,6 +106,12 @@
italicFont <Font> font for italic characters
searchPattern <String> last pattern for searching
wordCheck <Block> rule used for check in word select
+
+ StyleSheet parameters:
+
+ textForegroundColor defaults to Black
+ textBackgroundColor defaults to White
+ textFont defaults to defaultFont
"
! !
@@ -308,7 +314,9 @@
firstLineShown := list size - nFullLinesShown + 1.
firstLineShown < 1 ifTrue:[firstLineShown := 1].
self originChanged:(oldFirst - 1) negated.
- self clear.
+ shown ifTrue:[
+ self clear.
+ ]
].
"/ end new
shown ifTrue:[
@@ -350,7 +358,9 @@
"
dont use scroll here to avoid the redraw
"
- self originChanged:(oldFirst - 1) negated.
+ oldFirst ~~ firstLineShown ifTrue:[
+ self originChanged:(oldFirst - 1) negated.
+ ].
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
@@ -450,6 +460,7 @@
"
is there a need to redraw ?
"
+ shown ifFalse:[^ self].
visLine := self listLineToVisibleLine:lineNr.
visLine notNil ifTrue:[
w := self widthForScrollBetween:lineNr and:(firstLineShown + nLinesShown).
@@ -980,6 +991,13 @@
].
(xRel <= 0) ifTrue:[^ 1].
(linePixelWidth <= xRel) ifTrue:[
+ fontWidth == 0 ifTrue:[
+ "
+ although this 'cannot happen',
+ it seems that X reports this width for some strange fonts ...
+ "
+ ^ lineString size
+ ].
^ lineString size + ((xRel - linePixelWidth) // fontWidth) + 1
].
runCol := lineString size // 2.
@@ -1393,6 +1411,14 @@
!ListView methodsFor:'scrolling'!
+viewOrigin
+ "return the viewOrigin; thats the coordinate of the contents
+ which is shown topLeft in the view
+ (i.e. the origin of the visible part of the contents)."
+
+ ^ viewOrigin
+!
+
gotoLine:aLineNumber
"position to line aLineNumber; this may be redefined
in subclasses (for example to move the cursor also)"
@@ -2260,5 +2286,8 @@
(key == #Ctrld) ifTrue:[^ self halfPageDown].
(key == #Ctrlu) ifTrue:[^ self halfPageUp].
+ (key == #ScrollUp) ifTrue:[^ self scrollUp].
+ (key == #ScrollDown) ifTrue:[^ self scrollDown].
+
super keyPress:key x:x y:y
! !
--- a/MenuView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/MenuView.st Mon Feb 06 01:53:30 1995 +0100
@@ -14,14 +14,14 @@
instanceVariableNames:'selectors args receiver enableFlags
disabledFgColor onOffFlags subMenus
subMenuShown superMenu checkColor
- lineLevel lineInset masterView'
+ lineLevel lineInset masterView hilightStyle'
classVariableNames:'DefaultFont DefaultCheckColor DefaultViewBackground
DefaultForegroundColor
DefaultBackgroundColor
DefaultDisabledForegroundColor
DefaultHilightForegroundColor
DefaultHilightBackgroundColor
- DefaultHilightLevel
+ DefaultHilightLevel DefaultHilightStyle
DefaultLineLevel
DefaultShadowColor DefaultLightColor'
poolDictionaries:''
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.14 1994-11-28 21:05:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.15 1995-02-06 00:52:41 claus Exp $
'!
!MenuView class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.14 1994-11-28 21:05:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.15 1995-02-06 00:52:41 claus Exp $
"
!
@@ -114,6 +114,7 @@
DefaultHilightForegroundColor := StyleSheet colorAt:'menuHilightForegroundColor'.
DefaultHilightBackgroundColor := StyleSheet colorAt:'menuHilightBackgroundColor'.
DefaultHilightLevel := StyleSheet at:'menuHilightLevel'.
+ DefaultHilightStyle := StyleSheet at:'menuHilightStyle'.
DefaultLineLevel := StyleSheet at:'menuSeparatingLineLevel'.
DefaultDisabledForegroundColor := StyleSheet colorAt:'menuDisabledForegroundColor' default:Color darkGrey.
DefaultCheckColor := StyleSheet colorAt:'menuCheckColor'.
@@ -209,7 +210,7 @@
receiver:nil
! !
-!MenuView methodsFor:'initialization'!
+!MenuView methodsFor:'initialize / release'!
initialize
super initialize.
@@ -267,6 +268,7 @@
] ifFalse:[
hilightLevel := 0.
].
+ hilightStyle := DefaultHilightStyle.
StyleSheet is3D ifTrue:[
"some 3D style menu - set hilight defaults to same"
@@ -325,7 +327,7 @@
(style == #motif) ifTrue:[
lineSpacing := (2 * hilightLevel)
].
- style == #openwin ifTrue:[
+ hilightStyle == #openwin ifTrue:[
"add some space for rounded-hilight area"
self leftMargin:10.
].
@@ -341,7 +343,10 @@
initEvents
super initEvents.
self enableLeaveEvents.
- self enableButtonMotionEvents
+ self enableButtonMotionEvents.
+ windowGroup notNil ifTrue:[
+ windowGroup sensor compressMotionEvents:true
+ ]
!
create
@@ -352,10 +357,27 @@
recreate
super recreate.
- style == #openwin ifTrue:[
+ hilightStyle == #openwin ifTrue:[
self leftMargin:10.
].
self recomputeSize
+!
+
+destroy
+ super destroy.
+
+ "
+ have to destroy the submenus manually here,
+ since they are no real subviews of myself
+ "
+ subMenus notNil ifTrue:[
+ subMenus do:[:m |
+ m notNil ifTrue:[
+ m destroy
+ ]
+ ].
+ subMenus := nil
+ ]
! !
!MenuView methodsFor:'accessing'!
@@ -407,6 +429,12 @@
self list:text
].
enableFlags := Array new:(list size) withAll:true.
+ onOffFlags := Array new:(list size).
+ text keysAndValuesDo:[:index :line |
+ (line includes:$\) ifTrue:[
+ onOffFlags at:index put:false
+ ].
+ ].
self recomputeSize
!
@@ -790,6 +818,24 @@
self recomputeSize
].
subMenus at:i put:aPopUpMenu
+!
+
+selection:index
+ |sel line|
+
+ sel := index.
+ sel notNil ifTrue:[
+ line := self listAt:index.
+ ((line = '-')
+ or:[(line = '=')
+ or:[line = '']]) ifTrue:[
+ "
+ not really selectable, but a separating line
+ "
+ sel := nil
+ ]
+ ].
+ super selection:sel
! !
!MenuView methodsFor:'private'!
@@ -817,7 +863,47 @@
]
!
+showSubmenu:index
+ "show subMenu at index"
+
+ |org mx my m|
+
+ m := subMenus at:index.
+ m isNil ifTrue:[^ self].
+
+ mx := width - 5.
+ my := self yOfVisibleLine:index.
+ org := device translatePoint:(mx @ my)
+ from:(self id)
+ to:(DisplayRootView new id).
+
+
+ windowGroup notNil ifTrue:[
+ windowGroup processExposeEvents
+ ].
+
+ m superMenu:self.
+
+ "
+ realize the submenu in MY windowgroup
+ "
+ windowGroup notNil ifTrue:[
+ m windowGroup:windowGroup.
+ windowGroup addTopView:m.
+ ].
+ m fixSize.
+ m origin:org.
+ m makeFullyVisible.
+ m realize.
+ device synchronizeOutput.
+
+ subMenuShown := m
+!
+
setSelectionForX:x y:y
+ "select whatever is under x/y coordinate - if there is
+ a subMenu, show it"
+
|newSelection org mx my|
(x < 0
@@ -849,37 +935,9 @@
self hideSubmenu.
].
- newSelection notNil ifTrue:[
+ selection notNil ifTrue:[
subMenus notNil ifTrue:[
- subMenuShown := subMenus at:newSelection.
- subMenuShown notNil ifTrue:[
- mx := width - 5.
- my := self yOfVisibleLine:newSelection.
- org := device translatePoint:(mx @ my)
- from:(self id)
- to:(DisplayRootView new id).
-
-
- windowGroup notNil ifTrue:[
- windowGroup processExposeEvents
- ].
- subMenuShown notNil ifTrue:[
- subMenuShown superMenu:self.
- "
- realize the submenu in MY windowgroup
- "
- windowGroup notNil ifTrue:[
- subMenuShown windowGroup:windowGroup.
- windowGroup addTopView:subMenuShown.
- ].
- subMenuShown fixSize.
- subMenuShown origin:org.
- subMenuShown makeFullyVisible.
- subMenuShown realize.
- device synchronizeOutput.
- ].
- ^ self
- ]
+ self showSubmenu:selection.
] ifFalse:[
subMenuShown := nil
]
@@ -894,6 +952,23 @@
super realize
! !
+!MenuView methodsFor:'selections'!
+
+isValidSelection:aNumber
+ "return true, if aNumber is ok for a selection lineNo"
+
+ |line|
+
+ (super isValidSelection:aNumber) ifFalse:[^ false].
+
+ line := self listAt:aNumber.
+
+ (line = '-') ifTrue:[^ false].
+ (line = '=') ifTrue:[^ false].
+ (line = '') ifTrue:[^ false].
+ ^ true.
+! !
+
!MenuView methodsFor:'redrawing'!
drawMarkInVisibleLine:visLineNr with:fg and:bg
@@ -960,13 +1035,13 @@
y2 "{ Class: SmallInteger }"
r2 radius topLeftColor botRightColor |
- style ~~ #openwin ifTrue:[
+ hilightStyle ~~ #openwin ifTrue:[
^ super drawVisibleLineSelected:visLineNr.
].
+
"
openwin draws selections in a menu as (edged) rounded rectangles
"
-
bg := hilightBgColor.
fg := hilightFgColor.
listLine := self visibleLineToListLine:visLineNr.
@@ -977,14 +1052,12 @@
y2 := y + fontHeight - 1.
r2 := font height.
radius := r2 // 2.
-
"
refill with normal bg, where arcs will be drawn below
"
self paint:bgColor.
self fillRectangleX:margin y:y width:radius height:fontHeight.
self fillRectangleX:width-radius-margin y:y width:radius height:fontHeight.
-
"
fill the arcs
"
@@ -1028,8 +1101,8 @@
self displayLineFromX:radius+2 y:y2 toX:width-radius-3 y:y2.
self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90+125 angle:55.
self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:125.
- ^ self
- ]
+ ].
+ ^ self
].
^ super drawVisibleLine:visLineNr with:fg and:bg
!
@@ -1237,6 +1310,21 @@
]
!
+keyPress:aKey x:x y:y
+ aKey == #Return ifTrue:[
+ selection notNil ifTrue:[
+ (subMenus notNil and:[(subMenus at:selection) notNil]) ifTrue:[
+ self showSubmenu:selection.
+ ] ifFalse:[
+ subMenuShown := nil.
+ self buttonRelease:1 x:x y:y.
+ ]
+ ].
+ ^ self
+ ].
+ super keyPress:aKey x:x y:y
+!
+
pointerLeave:state
subMenuShown notNil ifTrue:[
^ self
@@ -1251,7 +1339,7 @@
!
buttonRelease:button x:x y:y
- |theSelector isCheck|
+ |theSelector isCheck val|
subMenuShown notNil ifTrue:[
^ self
@@ -1262,65 +1350,80 @@
selection notNil ifTrue:[
(subMenus isNil or:[(subMenus at:selection) isNil]) ifTrue:[
self cursor:Cursor wait.
- superMenu notNil ifTrue:[
- superMenu showActive
- ].
- "
- either action-block or selectors-array-style
- "
- actionBlock notNil ifTrue:[
- Object abortSignal handle:[:ex |
- ex return
- ] do:[
- actionBlock value:(self selection)
- ]
- ] ifFalse:[
- selectors notNil ifTrue: [
- device activePointerGrab == self ifTrue:[
- device ungrabPointer.
- ].
- (selectors isKindOf:Symbol) ifFalse:[
- (selection notNil
- and:[selection <= selectors size]) ifTrue:[
- theSelector := selectors at:selection
- ]
- ] ifTrue:[
- theSelector := selectors
- ].
- theSelector notNil ifTrue:[
- isCheck := false.
- onOffFlags notNil ifTrue:[
- onOffFlags size >= selection ifTrue:[
- isCheck := (onOffFlags at:selection) notNil
+ [
+ superMenu notNil ifTrue:[
+ superMenu showActive
+ ].
+
+ val := selection.
+ args notNil ifTrue:[
+ val := args at:selection
+ ].
+
+ "
+ ST-80 style model notification
+ "
+ (model notNil and:[changeSymbol notNil]) ifTrue:[
+ model perform:changeSymbol with:val
+ ].
+
+ "
+ either action-block or selectors-array-style
+ "
+ actionBlock notNil ifTrue:[
+ Object abortSignal handle:[:ex |
+ ex return
+ ] do:[
+ actionBlock value:(self selection)
+ ]
+ ] ifFalse:[
+ selectors notNil ifTrue: [
+ device activePointerGrab == self ifTrue:[
+ device ungrabPointer.
+ ].
+ (selectors isKindOf:Symbol) ifFalse:[
+ (selection notNil
+ and:[selection <= selectors size]) ifTrue:[
+ theSelector := selectors at:selection
]
+ ] ifTrue:[
+ theSelector := selectors
].
- Object abortSignal handle:[:ex |
- ex return
- ] do:[
- isCheck ifTrue:[
- onOffFlags at:selection
- put:(onOffFlags at:selection) not.
- self redrawLine:selection.
- receiver perform:theSelector
- with:(onOffFlags at:selection)
- ] ifFalse:[
- args isNil ifTrue:[
+ theSelector notNil ifTrue:[
+ isCheck := false.
+ onOffFlags notNil ifTrue:[
+ onOffFlags size >= selection ifTrue:[
+ isCheck := (onOffFlags at:selection) notNil
+ ]
+ ].
+ Object abortSignal handle:[:ex |
+ ex return
+ ] do:[
+ isCheck ifTrue:[
+ onOffFlags at:selection
+ put:(onOffFlags at:selection) not.
+ self redrawLine:selection.
receiver perform:theSelector
+ with:(onOffFlags at:selection)
] ifFalse:[
- receiver perform:theSelector
- with:(args at:selection)
+ args isNil ifTrue:[
+ receiver perform:theSelector
+ ] ifFalse:[
+ receiver perform:theSelector with:val
+ ]
]
]
]
]
+ ].
+ ] valueNowOrOnUnwindDo:[
+ realized ifTrue:[
+ self cursor:Cursor hand.
+ ].
+ superMenu notNil ifTrue:[
+ superMenu showPassive
]
].
- realized ifTrue:[
- self cursor:Cursor hand.
- ].
- superMenu notNil ifTrue:[
- superMenu showPassive
- ].
].
]
]
--- a/ObjView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ObjView.st Mon Feb 06 01:53:30 1995 +0100
@@ -13,11 +13,11 @@
'From Smalltalk/X, Version:2.10.4 on 30-nov-1994 at 3:38:24 pm'!
View subclass:#ObjectView
- instanceVariableNames:'contents sorted lastButt lastPointer lastButtonTime pressAction
+ instanceVariableNames:'contents sorted lastButt pressAction
releaseAction shiftPressAction doublePressAction motionAction
keyPressAction selection gridShown gridPixmap scaleMetric
- dragObject leftHandCursor readCursor oldCursor movedObject
- moveStartPoint moveDelta buffer documentFormat canDragOutOfView
+ dragObject leftHandCursor oldCursor movedObject
+ moveStartPoint moveDelta documentFormat canDragOutOfView
rootMotion rootView aligning gridAlign'
classVariableNames:''
poolDictionaries:''
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.17 1994-12-21 19:19:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.18 1995-02-06 00:52:44 claus Exp $
"
!
@@ -57,8 +57,177 @@
this is an abstract class providing common mechanisms - actual instances are
DrawView, DirectoryView, LogicView or DocumentView.
+ Instance variables:
+
+ contents <Collection> the objects. The order in which
+ these are in that collection defines
+ their appearance in the z-plane:
+ an object located after another one
+ here will be drawn ABOVE the other.
+
+ sorted <Boolean> if set, redraw and picking methods
+ assume that the objects are sorted by
+ >= y-coordinates. These operations are
+ a bit faster then, since a binary search
+ can be done. (use with care).
+
+ lastButt <Point> last pointer press position
+ (internal)
+
+ pressAction <Block> action to perform when mouse pointer
+ is pressed. Can be set to something like
+ [self startCreate], [self startSelectOrMove]
+ etc.
+
+ releaseAction <Block> action to perform when mouse pointer is
+ released. Typically set in one of the
+ startXXX methods.
+
+ shiftPressAction <Block> like pressAction, if shift key is
+ pressed.
+
+ doublePressAction <Block> same for double-clicks
+
+ motionAction <Block> action to perform on mouse-pointer
+ motion.
+
+ keyPressAction <Block> action for keyboard events
+
+ selection <any> the current selection; either a single
+ object or a collection of objects.
+
+ gridShown <Boolean> internal
+
+ gridPixmap <Form> internal
+
+ scaleMetric <Symbol> either #mm or #inch; used to
+ decide how the grid is defined
+
+ dragObject internal
+
+ leftHandCursor cursor shown while dragging a rectangle
+
+ oldCursor saved original cursor while dragging a rectangle
+
+ movedObject internal
+ moveStartPoint internal
+ moveDelta internal
+
+ documentFormat <Symbol> defines the size and layout of the
+ document. Can be any of
+ #letter, #a4, #a3 etc.
+
+ canDragOutOfView <Boolean> if true, objects can be dragged out of the
+ view. If false, dragging is restricted to within
+ this view.
+
+ rootMotion internal
+ rootView internal
+
+ aligning <Boolean> if true, pointer positions are
+ aligned (snapped) to the point
+ specified in gridAlign
+
+ gridAlign <Point> if aligning is true, this point
+ defines the snapping. For example,
+ 12@12 defines snap to the nearest
+ 12-point grid.
+
written spring/summer 89 by claus
"
+!
+
+examples
+"
+ typically, ObjectViews are not used on their own, but instead
+ subclassed and thereby provide the common functionality for
+ views which show (possibly overlapping) objects.
+ The methods here provide all mechanisms to handle redraws, picking
+ (i.e. finding an object by position), gridding, moving objects with
+ minimum redraw etc.
+ Also, zooming and scrolling is handled.
+ All objects which respond to the DisplayObject protocol can be handled
+ by ObjectView - therefore, you can add almost any object and have it
+ displayed and handled here. (as an example, try to copy a LogicGate
+ from a LogicView and paste it into a DrawTool - it will work).
+
+ Reminder: ObjectViews are not to be used as below, but instead to be
+ subclassed. Therefore, the examples below are somewhat untypical.
+
+ simple example:
+
+ |v o|
+
+ v := ObjectView new.
+ v extent:200@200.
+
+ o := DrawRectangle new.
+ o origin:10@10 corner:100@100.
+ v add:o.
+
+ o := DrawText new.
+ o text:'hello there'; origin:50@50; foreground:Color red.
+ v add:o.
+
+ v open
+
+ add scrolling:
+
+ |v top o|
+
+ top := HVScrollableView for:ObjectView.
+ top extent:200@200.
+ v := top scrolledView.
+
+ o := DrawRectangle new.
+ o origin:10@10 corner:100@100.
+ v add:o.
+
+ o := DrawText new.
+ o text:'hello there'; origin:50@50; foreground:Color red.
+ v add:o.
+
+ top open
+
+ or, using miniscrollers:
+
+ |v top o|
+
+ top := HVScrollableView for:ObjectView
+ miniScrollerH:true miniScrollerV:true.
+ top extent:200@200.
+ v := top scrolledView.
+
+ o := DrawRectangle new.
+ o origin:10@10 corner:100@100.
+ v add:o.
+
+ o := DrawText new.
+ o text:'hello there'; origin:50@50; foreground:Color red.
+ v add:o.
+
+ top open
+
+ grid:
+
+ |v top o|
+
+ top := HVScrollableView for:ObjectView
+ miniScrollerH:true miniScrollerV:true.
+ top extent:200@200.
+ v := top scrolledView.
+ v showGrid.
+
+ o := DrawRectangle new.
+ o origin:10@10 corner:100@100.
+ v add:o.
+
+ o := DrawText new.
+ o text:'hello there'; origin:50@50; foreground:Color red.
+ v add:o.
+
+ top open
+"
! !
!ObjectView class methodsFor:'defaults'!
@@ -72,223 +241,9 @@
!ObjectView methodsFor:'scrolling'!
-viewOrigin
- transformation isNil ifTrue:[
- ^ 0@0
- ].
- ^ transformation translation negated
-!
-
-setViewOrigin:aPoint
- |p|
-
- p := aPoint negated.
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:p
- ] ifFalse:[
- transformation translation:p
- ].
-"/ clipRect notNil ifTrue:[
-"/ self computeInnerClip.
-"/ ].
-!
-
-scrollDown:nPixels
- "change origin to scroll down some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- hCont "{ Class:SmallInteger }"
- ih "{ Class:SmallInteger }"
- orgX orgY|
-
- hCont := self heightOfContents.
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated.
- ].
-
- count := nPixels.
- ih := self innerHeight.
-
- ((orgY + nPixels + ih) > hCont) ifTrue:[
- count := hCont - orgY - ih
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(orgX @ (orgY + count)).
-
- (count >= ih) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := height - m2 - count.
- w := self width.
- self catchExpose.
- self copyFrom:self x:margin y:(count + margin)
- toX:margin y:margin
- width:w
- height:h.
-
- self setInnerClip.
- self redrawDeviceX:margin y:(h + margin)
- width:(width - m2) height:count.
-
- self waitForExpose.
- ].
- self originChanged:(0 @ count).
-!
-
-scrollUp:nPixels
- "change origin to scroll up (towards the origin) by some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- orgX
- orgY "{ Class:SmallInteger }"|
-
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated
- ].
-
- count := nPixels.
- (count > orgY) ifTrue:[
- count := orgY
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(orgX @ (orgY - count)).
-
- (count >= self innerHeight) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2. "top & bottom margins"
- h := height - m2 - count.
- w := width.
- self catchExpose.
- self copyFrom:self x:margin y:margin
- toX:margin y:(count + margin)
- width:w height:h.
-
- self setInnerClip.
- self redrawDeviceX:margin y:margin
- width:(width - m2)
- height:count.
-
- self waitForExpose.
- ].
- self originChanged:(0 @ count negated).
-!
-
-scrollLeft:nPixels
- "change origin to scroll left some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- orgX orgY|
-
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated.
- ].
-
- count := nPixels.
- (count > orgX) ifTrue:[
- count := orgX
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(orgX - count) @ orgY.
-
- (count >= self innerWidth) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := (height - m2).
-
- self catchExpose.
- self copyFrom:self x:margin y:margin
- toX:(count + margin) y:margin
- width:(width - m2 - count)
- height:h.
-
- self setInnerClip.
- self redrawDeviceX:margin y:margin
- width:count height:(height - m2).
-
- self waitForExpose.
- ].
- self originChanged:(count negated @ 0).
-!
-
-scrollRight:nPixels
- "change origin to scroll right some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- wCont "{ Class:SmallInteger }"
- iw "{ Class:SmallInteger }"
- orgX orgY|
-
- wCont := self widthOfContents.
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated.
- ].
-
-
- count := nPixels.
- iw := self innerWidth.
-
- ((orgX + nPixels + iw) > wCont) ifTrue:[
- count := wCont - orgX - iw
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(orgX + count) @ orgY.
-
- (count >= iw) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := (height - m2).
-
- self catchExpose.
- self copyFrom:self x:(count + margin) y:margin
- toX:margin y:margin
- width:(width - m2 - count)
- height:h.
-
- self setInnerClip.
- self redrawDeviceX:(width - margin - count) y:margin
- width:count height:(height - m2).
-
- self waitForExpose.
- ].
- self originChanged:(count @ 0).
-!
-
verticalScrollStep
- "return the amount to scroll when stepping left/right."
+ "return the amount to scroll when stepping left/right.
+ Redefined to scroll by inches or centimeters."
scaleMetric == #inch ifTrue:[
^ (device verticalPixelPerInch * (1/2)) asInteger
@@ -297,7 +252,8 @@
!
horizontalScrollStep
- "return the amount to scroll when stepping left/right."
+ "return the amount to scroll when stepping left/right.
+ Redefined to scroll by inches or centimeters."
scaleMetric == #inch ifTrue:[
^ (device horizontalPixelPerInch * (1/2)) asInteger
@@ -307,6 +263,20 @@
!ObjectView methodsFor:'misc'!
+hitDelta
+ "when clicking an object, allow for hitDelta pixels around object.
+ We compensate for any scaling here, to get a constant physical
+ hitDelta (i.e. the value returned here is inverse scaled)."
+
+ |delta|
+
+ delta := self class hitDelta.
+ transformation notNil ifTrue:[
+ delta := delta / transformation scale x
+ ].
+ ^ delta
+!
+
objectsIntersecting:aRectangle do:aBlock
"do something to every object which intersects a rectangle"
@@ -429,16 +399,6 @@
^ newCollection
!
-setMoveActions
- motionAction := [:movePoint | self doObjectMove:movePoint].
- releaseAction := [self endObjectMove]
-!
-
-setRectangleDragActions
- motionAction := [:movePoint | self doRectangleDrag:movePoint].
- releaseAction := [self endRectangleDrag]
-!
-
objectsIn:aRectangle do:aBlock
"do something to every object which is completely in a rectangle"
@@ -479,11 +439,6 @@
]
!
-setLineDragActions
- motionAction := [:movePoint | self doLineDrag:movePoint].
- releaseAction := [self endLineDrag]
-!
-
objectsInVisible:aRectangle do:aBlock
"do something to every object which is completely in a
visible rectangle"
@@ -621,24 +576,15 @@
!ObjectView methodsFor:'event handling'!
redrawX:x y:y width:w height:h
- |innerX innerY innerW innerH redrawFrame |
+ |redrawFrame |
((contents size ~~ 0) or:[gridShown]) ifTrue:[
- innerX := x.
- innerY := y.
- innerW := w.
- innerH := h.
-
- redrawFrame := Rectangle left:innerX top:innerY
- width:innerW height:innerH.
+ redrawFrame := Rectangle left:x top:y
+ width:w height:h.
self redrawObjectsInVisible:redrawFrame
]
!
-redrawDeviceX:x y:y width:w height:h
-super redrawDeviceX:x y:y width:w height:h
-!
-
buttonPress:button x:x y:y
"user pressed left button"
@@ -749,24 +695,11 @@
!ObjectView methodsFor:'dragging object move'!
doObjectMove:aPoint
- "do an object move.
- moveStartPoint is the original click-point.
- moveDelta"
-
- |dragger offset d p|
-
- rootMotion ifTrue:[
- dragger := rootView.
- offset := 0@0 "self viewOrigin".
- ] ifFalse:[
- dragger := self.
- offset := 0@0.
- ].
-
- "
- when drawing in the root window, we have to use its coordinates
- this is kept in offset.
- "
+ "do an object move - this is called for every motion
+ when moving objects."
+
+ |d|
+
movedObject isNil ifTrue:[
movedObject := selection.
"
@@ -775,19 +708,15 @@
movedObject notNil ifTrue:[
moveDelta := 0@0.
- dragger xoring:[
- "tricky, the moved object may not currently be aligned.
- if so, simulate a frame move of the delta"
-
- aligning ifTrue:[
- d := movedObject origin
- - (self alignToGrid:(movedObject origin)).
-"/ d printNL.
- moveDelta := d negated.
- ].
-"/ moveDelta printNL.
- self showDragging:movedObject offset:moveDelta - offset.
- ]
+ "tricky, the moved object may not currently be aligned.
+ if so, simulate a frame move of the delta"
+
+ aligning ifTrue:[
+ d := movedObject origin
+ - (self alignToGrid:(movedObject origin)).
+ moveDelta := d negated.
+ ].
+ self invertDragObject:movedObject delta:moveDelta
]
].
movedObject notNil ifTrue:[
@@ -795,42 +724,42 @@
clear prev outline,
draw new outline
"
- dragger xoring:[
- self showDragging:movedObject offset:moveDelta - offset.
- moveDelta := aPoint - moveStartPoint.
- aligning ifTrue:[
- moveDelta := self alignToGrid:moveDelta
- ].
- self showDragging:movedObject offset:moveDelta - offset.
- ]
+ self invertDragObject:movedObject delta:moveDelta.
+
+ moveDelta := aPoint - moveStartPoint.
+ aligning ifTrue:[
+ moveDelta := self alignToGrid:moveDelta
+ ].
+ self invertDragObject:movedObject delta:moveDelta
]
!
endObjectMove
- "cleanup after object move - find the destination view and dispatch to
- one of the moveObjectXXX-methods. These can be redefined in subclasses."
-
- |dragger inMySelf offs2 rootPoint destinationPoint
+ "cleanup after object move - called when the object move ends.
+ Find the destination view and position and dispatch to
+ one of the moveObjectXXX-methods which should do the real move.
+ These can be redefined in subclasses."
+
+ |inMySelf rootPoint destinationPoint p
viewId destinationView destinationId lastViewId|
movedObject notNil ifTrue:[
- rootMotion ifTrue:[
- dragger := rootView.
- offs2 := 0@0 "self viewOrigin"
- ] ifFalse:[
- dragger := self.
- offs2 := 0@0
- ].
- dragger xoring:[
- self showDragging:movedObject offset:moveDelta - offs2
- ].
- dragger device synchronizeOutput.
+ self invertDragObject:movedObject delta:moveDelta.
"check if object is to be put into another view"
rootMotion ifTrue:[
- rootPoint := device translatePoint:lastButt
- from:(self id)
- to:(rootView id).
+ p := lastButt.
+ "
+ get device coordinates
+ "
+ transformation notNil ifTrue:[
+ p := transformation applyTo:p.
+ ].
+ "
+ translate to screen
+ "
+ rootPoint := p + (device translatePoint:0@0 from:(self id) to:(rootView id)).
+
"search view the drop is in"
viewId := rootView id.
[viewId notNil] whileTrue:[
@@ -845,6 +774,7 @@
] ifFalse:[
inMySelf := true
].
+
inMySelf ifTrue:[
"simple move"
self move:movedObject by:moveDelta
@@ -872,17 +802,91 @@
startObjectMove:something at:aPoint
"start an object move"
+ self startObjectMove:something at:aPoint inRoot:canDragOutOfView
+!
+
+startRootObjectMove:something at:aPoint
+ "start an object move, possibly crossing view boundaries"
+
+ self startObjectMove:something at:aPoint inRoot:true
+!
+
+startObjectMove:something at:aPoint inRoot:inRoot
+ "start an object move; if inRoot is true, view
+ boundaries may be crossed."
+
something notNil ifTrue:[
self select:something.
(self canMove:something) ifTrue:[
self setMoveActions.
moveStartPoint := aPoint.
- rootMotion := canDragOutOfView.
- "self doObjectMove:aPoint "
+ rootMotion := inRoot.
] ifFalse:[
self setDefaultActions
]
]
+!
+
+setMoveActions
+ "setup to drag an object. Call this (for example) from your buttonPress
+ method, to make the view start to drag some object.
+ See startObjectMove and startRootObjectMove."
+
+ motionAction := [:movePoint | self doObjectMove:movePoint].
+ releaseAction := [self endObjectMove]
+!
+
+invertDragObject:movedObject delta:moveDelta
+ "draw inverting for an object move"
+
+ |dragger offs p d scale oldTrans|
+
+ rootMotion ifTrue:[
+ p := movedObject origin + moveDelta.
+ dragger := rootView.
+ "
+ get device coordinates
+ "
+"/ 'logical ' print. p printNL.
+ transformation notNil ifTrue:[
+ scale := transformation scale.
+ p := transformation applyTo:p.
+"/ 'device ' print. p printNL.
+ ].
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+"/ 'offs' print. offs printNL.
+ p := p + offs.
+"/ 'screen ' print. p printNL.
+ "
+ p is where we want it ...
+ have to adust slightly, since showDragging shows the object
+ at its origin plus some offset; here we want it to be drawn
+ at absolute p.
+ To do so, we set the draggers translation to p and
+ draw the object scaled at 0@0 (by setting offset to its negative org)
+ "
+
+ oldTrans := dragger transformation.
+ dragger transformation:(WindowingTransformation
+ scale:scale
+ translation:p).
+ d := movedObject origin negated.
+
+ dragger xoring:[
+ self showDragging:movedObject offset:d.
+ ].
+
+ dragger transformation:oldTrans.
+ dragger device synchronizeOutput.
+ ] ifFalse:[
+ self xoring:[
+ self showDragging:movedObject offset:moveDelta.
+ ].
+ self device synchronizeOutput
+ ].
! !
!ObjectView methodsFor:'drawing'!
@@ -898,21 +902,17 @@
showDragging:something offset:anOffset
"show an object while dragging"
- |drawOffset top drawer|
+ |drawer|
rootMotion ifTrue:[
"drag in root-window"
- top := self topView.
- drawOffset := device translatePoint:anOffset
- from:(self id) to:(rootView id).
drawer := rootView
] ifFalse:[
- drawOffset := anOffset.
drawer := self
].
self forEach:something do:[:anObject |
- anObject drawDragIn:drawer offset:drawOffset
+ anObject drawDragIn:drawer offset:anOffset
]
!
@@ -936,9 +936,12 @@
clipRect notNil ifTrue:[
vis := vis intersect:clipRect
].
+
transformation notNil ifTrue:[
- vis := vis origin truncated
- corner:(vis corner + (1@1)) truncated.
+ transformation scale ~~ 1 ifTrue:[
+ vis := vis origin truncated
+ corner:(vis corner + (1@1)) truncated.
+ ]
].
self clippedTo:vis do:[
@@ -1114,11 +1117,7 @@
|h|
h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
-
- transformation isNil ifTrue:[
- ^ h rounded
- ].
- ^ (transformation applyScaleY:h) rounded
+ ^ h rounded
!
widthOfContents
@@ -1127,11 +1126,7 @@
|w|
w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
-
- transformation isNil ifTrue:[
- ^ w rounded
- ].
- ^ (transformation applyScaleX:w) rounded
+ ^ w rounded
!
heightOfContentsInMM
@@ -1279,7 +1274,7 @@
|hdelta|
- hdelta := self class hitDelta.
+ hdelta := self hitDelta.
contents reverseDo:[:object |
(object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
].
@@ -1359,7 +1354,7 @@
|hdelta|
- hdelta := self class hitDelta.
+ hdelta := self hitDelta.
contents reverseDo:[:object |
(object isHitBy:aPoint withDelta:hdelta) ifTrue:[
(aBlock value:object) ifTrue:[^ object]
@@ -1450,7 +1445,7 @@
!ObjectView methodsFor:'selections'!
unselect
- "unselect - hide selection; clear selection buffer"
+ "unselect - hide selection; clear selection"
self hideSelection.
selection := nil
@@ -1585,8 +1580,6 @@
!
initialize
- |pixPerMM|
-
super initialize.
viewBackground := White.
@@ -1601,12 +1594,103 @@
rootMotion := false.
self setInitialDocumentFormat.
- readCursor := Cursor read.
leftHandCursor := Cursor leftHand.
sorted := false.
aligning := false
! !
+!ObjectView methodsFor:'cut & paste '!
+
+deleteSelection
+ "delete the selection into the cut&paste buffer"
+
+ |tmp|
+
+ tmp := selection.
+ self unselect.
+ self remove:tmp.
+ self setSelection:tmp
+!
+
+pasteBuffer
+ "add the objects in the paste-buffer"
+
+ |sel|
+
+ sel := self getSelection.
+ (device getSelectionOwnerOf:(device atomIDOf:'PRIMARY')) == drawableId
+ ifTrue:[
+ "
+ a local selection - paste with some offset
+ "
+ sel size > 0 ifTrue:[
+ sel := sel collect:[:element |
+ element copy moveTo:(element origin + (8 @ 8))
+ ]
+ ] ifFalse:[
+ sel := sel copy moveTo:(sel origin + (8 @ 8))
+ ]
+ ].
+ self paste:sel
+!
+
+convertForPaste:anObject
+ "return a converted version of anObject to be pasted, or nil if
+ the object is not compatible with me.
+ Return nil here; concrete subclasses should try to convert.
+ Notice: anObject may be a collection of to-be-pasted objects."
+
+ "in concrete subclasses, you can use:"
+"
+ |s|
+
+ (anObject respondsTo:#asDisplayObject) ifTrue:[
+ ^ anObject asDisplayObject
+ ].
+ (anObject isString or:[anObject isMemberOf:Text]) ifTrue:[
+ ].
+ anObject size > 0 ifTrue:[
+ (anObject inject:true into:[:okSoFar :element |
+ okSoFar and:[element respondsTo:#asDisplayObject]
+ ]) ifFalse:[
+ self warn:'selection not convertable to DisplayObject'.
+ ^ nil
+ ].
+ ^ anObject collect:[:element | element asDisplayObject].
+ ].
+"
+ ^ nil.
+!
+
+paste:something
+ "add the objects in the cut&paste-buffer"
+
+ |s|
+
+ self unselect.
+ s := self convertForPaste:something .
+ s isNil ifTrue:[
+ self warn:'selection not convertable'.
+ ^ self
+ ].
+ self addSelected:s
+!
+
+copySelection
+ "copy the selection into the cut&paste-buffer"
+
+ |tmp|
+
+ tmp := OrderedCollection new.
+ self selectionDo:[:object |
+ tmp add:(object copy)
+ ].
+"/ self forEach:tmp do:[:anObject |
+"/ anObject moveTo:(anObject origin + (8 @ 8))
+"/ ].
+ self setSelection:tmp
+! !
+
!ObjectView methodsFor:'adding / removing'!
addWithoutRedraw:something
@@ -1626,33 +1710,6 @@
]
!
-deleteSelection
- "delete the selection"
-
- buffer := selection.
- self unselect.
- self remove:buffer.
-!
-
-pasteBuffer
- "add the objects in the paste-buffer"
-
- self unselect.
- self addSelected:buffer
-!
-
-copySelection
- "copy the selection into the paste-buffer"
-
- buffer := OrderedCollection new.
- self selectionDo:[:object |
- buffer add:(object copy)
- ].
- self forEach:buffer do:[:anObject |
- anObject moveTo:(anObject origin + (8 @ 8))
- ]
-!
-
addSelected:something
"add something, anObject or a collection of objects to the contents
and select it"
@@ -1665,6 +1722,18 @@
"remove something, anObject or a collection of objects from the contents
do redraw"
+ something size > (contents size / 4) ifTrue:[
+ "
+ better to remove first, then redraw rest
+ "
+ self forEach:something do:[:anObject |
+ self removeFromSelection:anObject.
+ contents remove:anObject.
+ ].
+ self redraw.
+ ^ self
+ ].
+
self forEach:something do:[:anObject |
self removeObject:anObject
]
@@ -2001,6 +2070,15 @@
!ObjectView methodsFor:'dragging rectangle'!
+setRectangleDragActions
+ "setup to drag a rectangle. Call this (for example) from your buttonPress
+ method, to make the view start the drag.
+ See startRectangleDrag:."
+
+ motionAction := [:movePoint | self doRectangleDrag:movePoint].
+ releaseAction := [self endRectangleDrag]
+!
+
endRectangleDrag
"cleanup after rectangle drag; select them"
@@ -2111,7 +2189,9 @@
!ObjectView methodsFor:'grid manipulation'!
newGrid
- "define a new grid"
+ "define a new grid - this is a private helper which has to be
+ called after any change in the grid. It (re)creates the gridPixmap,
+ clears the view and redraws all visible objects."
gridPixmap := nil.
shown ifTrue:[
@@ -2131,17 +2211,19 @@
gridParameters
"used by defineGrid, and in a separate method for
easier redefinition in subclasses.
- Returns the parameters in an array of 7 elements,
+ Returns the grid parameters in an array of 7 elements,
which control the appearance of the grid-pattern.
- elements:
+ the elements are:
bigStepH number of pixels horizontally between 2 major steps
bigStepV number of pixels vertically between 2 major steps
littleStepH number of pixels horizontally between 2 minor steps
littleStepV number of pixels vertically between 2 minor steps
- gridAlignH number of pixels for horizontal grid align
- gridAlignV number of pixels for vertical grid align
- docBounds true, if document boundary shouldbe shown
+ gridAlignH number of pixels for horizontal grid align (pointer snap)
+ gridAlignV number of pixels for vertical grid align (pointer snap)
+ docBounds true, if document boundary should be shown
+
+ if littleStepH/V are nil, only bigSteps are drawn.
"
|mmH mmV bigStepH bigStepV littleStepH littleStepV arr|
@@ -2158,6 +2240,11 @@
mmH := self horizontalPixelPerMillimeter.
mmV := self verticalPixelPerMillimeter.
+ "
+ metric grid: small steps every millimeter, big step every
+ centimeter. If the transformation is shrinking, turn off little
+ steps.
+ "
(scaleMetric == #mm) ifTrue:[
"dots every mm; lines every cm"
bigStepH := mmH * 10.0.
@@ -2168,14 +2255,21 @@
littleStepV := mmV
]
].
+ "
+ inch grid: small steps every 1/8th inch, big step every half inch
+ If the transformation is shrinking, change little steps to 1/th inch
+ or even turn them off completely.
+ "
(scaleMetric == #inch) ifTrue:[
"dots every eights inch; lines every half inch"
bigStepH := mmH * (25.4 / 2).
bigStepV := mmV * (25.4 / 2).
(transformation notNil
and:[transformation scale <= 0.5]) ifTrue:[
- littleStepH := mmH * (25.4 / 4).
- littleStepV := mmV * (25.4 / 4)
+ transformation scale > 0.2 ifTrue:[
+ littleStepH := mmH * (25.4 / 4).
+ littleStepV := mmV * (25.4 / 4)
+ ]
] ifFalse:[
littleStepH := mmH * (25.4 / 8).
littleStepV := mmV * (25.4 / 8)
@@ -2195,7 +2289,11 @@
!
defineGrid
- "define the grid pattern"
+ "define the grid pattern - this creates the gridPixmap, which is
+ used as viewBackground when a grid is to be shown.
+ The grid is specified by the value returned from gridParameters,
+ which can be redefined in subclasses. See the comment there on how
+ the numbers are interpreted."
|mmH mmV params showDocumentBoundary gridW gridH
bigStepH bigStepV littleStepH littleStepV hires|
@@ -2327,7 +2425,8 @@
!
showGrid
- "show the grid"
+ "show the grid. The grid is defined by the return value of
+ gridParameters, which can be redefined in concrete subclasses."
gridShown := true.
self newGrid
@@ -2350,8 +2449,6 @@
alignOn
"align points to grid"
- |params|
-
aligning := true.
self getAlignParameters
!
@@ -2364,8 +2461,17 @@
!ObjectView methodsFor:'dragging line'!
+setLineDragActions
+ "setup to drag a line. Call this (for example) from your buttonPress
+ method, to make the view start to drag a line.
+ See startLineDrag and startRootLineDrag."
+
+ motionAction := [:movePoint | self doLineDrag:movePoint].
+ releaseAction := [self endLineDrag]
+!
+
startLineDrag:startPoint
- "start a line drag"
+ "start a line drag within the view"
self setLineDragActions.
dragObject := Rectangle origin:startPoint corner:startPoint.
@@ -2388,16 +2494,6 @@
doLineDrag:aPoint
"do drag a line"
- |dragger top org|
-
- rootMotion ifTrue:[
- dragger := rootView.
- top := self topView.
- org := device translatePoint:0@0 from:(self id) to:(rootView id).
- ] ifFalse:[
- dragger := self.
- ].
-
self invertDragLine.
dragObject corner:aPoint.
self invertDragLine.
@@ -2408,31 +2504,35 @@
views and relative offsets, then dispatch to one of the endLineDrag methods.
These can be redefined in subclasses to allow connect between views."
- |dragger offs2 top org rootPoint viewId
+ |rootPoint viewId offs
lastViewId destinationId destinationView destinationPoint inMySelf|
- rootMotion ifTrue:[
- dragger := rootView.
- offs2 := 0@0 "self viewOrigin".
- top := self topView.
- org := device translatePoint:0@0 from:(self id) to:(rootView id).
- offs2 := offs2 - org
- ] ifFalse:[
- dragger := self.
- offs2 := 0@0.
- ].
-
- dragger xoring:[
- dragger displayLineFrom:dragObject origin-offs2
- to:dragObject corner-offs2
- ].
+ self invertDragLine.
+
self cursor:oldCursor.
"check if line drag is into another view"
rootMotion ifTrue:[
- rootPoint := device translatePoint:lastButt
- from:(self id)
- to:(rootView id).
+ rootPoint := lastButt.
+ "
+ get device coordinates
+ "
+ 'logical ' print. rootPoint printNL.
+ transformation notNil ifTrue:[
+ rootPoint := transformation applyTo:rootPoint.
+ 'device ' print. rootPoint printNL.
+ ].
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+ 'offs' print. offs printNL.
+ rootPoint := rootPoint + offs.
+ 'screen ' print. rootPoint printNL.
+
+"/ rootPoint := device translatePoint:lastButt
+"/ from:(self id)
+"/ to:(rootView id).
"search view the drop is in"
viewId := rootView id.
@@ -2454,10 +2554,10 @@
to:dragObject corner
] ifFalse:[
"into another one"
- destinationPoint := device translatePoint:rootPoint
- from:(rootView id)
- to:(destinationView id).
destinationView notNil ifTrue:[
+ destinationPoint := device translatePoint:rootPoint
+ from:(rootView id)
+ to:(destinationView id).
"
move into another smalltalk view
"
@@ -2473,7 +2573,6 @@
].
self setDefaultActions.
dragObject := nil
-
!
lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
@@ -2503,7 +2602,38 @@
Extracted for easier redefinition in subclasses
(different line width etc.)"
- self xoring:[self lineWidth:0. self displayLineFrom:dragObject origin to:dragObject corner].
+ |dragger offs p1 p2|
+
+ p1 := dragObject origin.
+ p2 := dragObject corner.
+ rootMotion ifTrue:[
+ dragger := rootView.
+ "
+ get device coordinates
+ "
+"/ 'logical ' print. p1 print. ' ' print. p2 printNL.
+ transformation notNil ifTrue:[
+ p1 := transformation applyTo:p1.
+ p2 := transformation applyTo:p2.
+"/ 'device ' print. p1 print. ' ' print. p2 printNL.
+ ].
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+"/ 'offs' print. offs printNL.
+ p1 := p1 + offs.
+ p2 := p2 + offs.
+"/ 'screen ' print. p1 print. ' ' print. p2 printNL.
+ ] ifFalse:[
+ dragger := self.
+ ].
+
+ dragger xoring:[
+ dragger lineWidth:0.
+ dragger displayLineFrom:p1 to:p2.
+ dragger device synchronizeOutput
+ ].
! !
!ObjectView methodsFor:'saving / restoring'!
@@ -2535,47 +2665,84 @@
]
!
+storeBinaryContentsOn:aStream
+ "store the contents in binary representation on aStream."
+
+ aStream binary.
+ self topView withCursor:Cursor write do:[
+ self forEach:contents do:[:theObject |
+ theObject storeBinaryOn:aStream.
+ ].
+ ]
+!
+
withoutRedrawFileInContentsFrom:aStream
- self fileInContentsFrom:aStream redraw:false
+ "remove all objects, load new contents from aStream without any redraw"
+
+ self fileInContentsFrom:aStream redraw:false new:true binary:false
!
fileInContentsFrom:aStream
"remove all objects, load new contents from aStream and redraw"
- self fileInContentsFrom:aStream redraw:true
-!
-
-fileInContentsFrom:aStream redraw:redraw new:new
- "if the new argument is true, remove all objects.
- Then load objects from aStream,
- finally, redraw if the redraw argument is true"
-
- |newObject chunk|
-
- self topView withCursor:Cursor read do:[
- self unselect.
- new ifTrue:[self removeAll].
- [aStream atEnd] whileFalse:[
- chunk := aStream nextChunk.
- chunk notNil ifTrue:[
- chunk isEmpty ifFalse:[
- newObject := Compiler evaluate:chunk.
- self initializeFileInObject:newObject.
- redraw ifFalse:[
- self addObjectWithoutRedraw:newObject
- ] ifTrue:[
- self addObject:newObject
- ]
- ]
- ]
- ].
- ]
+ self fileInContentsFrom:aStream redraw:true new:true binary:false
!
fileInContentsFrom:aStream redraw:redraw
"remove all objects, load new contents from aStream
and redraw if the redraw argument is true"
- self fileInContentsFrom:aStream redraw:redraw new:true
+ self fileInContentsFrom:aStream redraw:redraw new:true binary:false
+!
+
+fileInContentsFrom:aStream redraw:redraw new:new
+ "remove all objects, load new contents from aStream
+ and redraw if the redraw argument is true"
+
+ self fileInContentsFrom:aStream redraw:redraw new:new binary:false
+!
+
+fileInContentsFrom:aStream redraw:redraw new:new binary:binary
+ "if the new argument is true, remove all objects.
+ Then load objects from aStream. If redraw is false, no redraw
+ is done
+ (allows fileIn of multiple files doing a single redraw at the end)."
+
+ binary ifTrue:[
+ aStream binary
+ ].
+ self topView withCursor:(Cursor read) do:[
+ |newObject chunk individualRedraw|
+
+ self unselect.
+ individualRedraw := redraw.
+ new ifTrue:[
+ self removeAll.
+ individualRedraw := false.
+ ].
+ [aStream atEnd] whileFalse:[
+ binary ifTrue:[
+ newObject := Object readBinaryFrom:aStream
+ ] ifFalse:[
+ chunk := aStream nextChunk.
+ (chunk notNil and:[chunk isEmpty not]) ifTrue:[
+ newObject := Compiler evaluate:chunk.
+ ] ifFalse:[
+ newObject := nil
+ ]
+ ].
+ newObject notNil ifTrue:[
+ self initializeFileInObject:newObject.
+ individualRedraw ifFalse:[
+ self addObjectWithoutRedraw:newObject
+ ] ifTrue:[
+ self addObject:newObject
+ ]
+ ]
+ ].
+ (new and:[redraw]) ifTrue:[
+ self redraw
+ ]
+ ]
! !
--- a/ObjectView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ObjectView.st Mon Feb 06 01:53:30 1995 +0100
@@ -13,11 +13,11 @@
'From Smalltalk/X, Version:2.10.4 on 30-nov-1994 at 3:38:24 pm'!
View subclass:#ObjectView
- instanceVariableNames:'contents sorted lastButt lastPointer lastButtonTime pressAction
+ instanceVariableNames:'contents sorted lastButt pressAction
releaseAction shiftPressAction doublePressAction motionAction
keyPressAction selection gridShown gridPixmap scaleMetric
- dragObject leftHandCursor readCursor oldCursor movedObject
- moveStartPoint moveDelta buffer documentFormat canDragOutOfView
+ dragObject leftHandCursor oldCursor movedObject
+ moveStartPoint moveDelta documentFormat canDragOutOfView
rootMotion rootView aligning gridAlign'
classVariableNames:''
poolDictionaries:''
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.17 1994-12-21 19:19:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.18 1995-02-06 00:52:44 claus Exp $
"
!
@@ -57,8 +57,177 @@
this is an abstract class providing common mechanisms - actual instances are
DrawView, DirectoryView, LogicView or DocumentView.
+ Instance variables:
+
+ contents <Collection> the objects. The order in which
+ these are in that collection defines
+ their appearance in the z-plane:
+ an object located after another one
+ here will be drawn ABOVE the other.
+
+ sorted <Boolean> if set, redraw and picking methods
+ assume that the objects are sorted by
+ >= y-coordinates. These operations are
+ a bit faster then, since a binary search
+ can be done. (use with care).
+
+ lastButt <Point> last pointer press position
+ (internal)
+
+ pressAction <Block> action to perform when mouse pointer
+ is pressed. Can be set to something like
+ [self startCreate], [self startSelectOrMove]
+ etc.
+
+ releaseAction <Block> action to perform when mouse pointer is
+ released. Typically set in one of the
+ startXXX methods.
+
+ shiftPressAction <Block> like pressAction, if shift key is
+ pressed.
+
+ doublePressAction <Block> same for double-clicks
+
+ motionAction <Block> action to perform on mouse-pointer
+ motion.
+
+ keyPressAction <Block> action for keyboard events
+
+ selection <any> the current selection; either a single
+ object or a collection of objects.
+
+ gridShown <Boolean> internal
+
+ gridPixmap <Form> internal
+
+ scaleMetric <Symbol> either #mm or #inch; used to
+ decide how the grid is defined
+
+ dragObject internal
+
+ leftHandCursor cursor shown while dragging a rectangle
+
+ oldCursor saved original cursor while dragging a rectangle
+
+ movedObject internal
+ moveStartPoint internal
+ moveDelta internal
+
+ documentFormat <Symbol> defines the size and layout of the
+ document. Can be any of
+ #letter, #a4, #a3 etc.
+
+ canDragOutOfView <Boolean> if true, objects can be dragged out of the
+ view. If false, dragging is restricted to within
+ this view.
+
+ rootMotion internal
+ rootView internal
+
+ aligning <Boolean> if true, pointer positions are
+ aligned (snapped) to the point
+ specified in gridAlign
+
+ gridAlign <Point> if aligning is true, this point
+ defines the snapping. For example,
+ 12@12 defines snap to the nearest
+ 12-point grid.
+
written spring/summer 89 by claus
"
+!
+
+examples
+"
+ typically, ObjectViews are not used on their own, but instead
+ subclassed and thereby provide the common functionality for
+ views which show (possibly overlapping) objects.
+ The methods here provide all mechanisms to handle redraws, picking
+ (i.e. finding an object by position), gridding, moving objects with
+ minimum redraw etc.
+ Also, zooming and scrolling is handled.
+ All objects which respond to the DisplayObject protocol can be handled
+ by ObjectView - therefore, you can add almost any object and have it
+ displayed and handled here. (as an example, try to copy a LogicGate
+ from a LogicView and paste it into a DrawTool - it will work).
+
+ Reminder: ObjectViews are not to be used as below, but instead to be
+ subclassed. Therefore, the examples below are somewhat untypical.
+
+ simple example:
+
+ |v o|
+
+ v := ObjectView new.
+ v extent:200@200.
+
+ o := DrawRectangle new.
+ o origin:10@10 corner:100@100.
+ v add:o.
+
+ o := DrawText new.
+ o text:'hello there'; origin:50@50; foreground:Color red.
+ v add:o.
+
+ v open
+
+ add scrolling:
+
+ |v top o|
+
+ top := HVScrollableView for:ObjectView.
+ top extent:200@200.
+ v := top scrolledView.
+
+ o := DrawRectangle new.
+ o origin:10@10 corner:100@100.
+ v add:o.
+
+ o := DrawText new.
+ o text:'hello there'; origin:50@50; foreground:Color red.
+ v add:o.
+
+ top open
+
+ or, using miniscrollers:
+
+ |v top o|
+
+ top := HVScrollableView for:ObjectView
+ miniScrollerH:true miniScrollerV:true.
+ top extent:200@200.
+ v := top scrolledView.
+
+ o := DrawRectangle new.
+ o origin:10@10 corner:100@100.
+ v add:o.
+
+ o := DrawText new.
+ o text:'hello there'; origin:50@50; foreground:Color red.
+ v add:o.
+
+ top open
+
+ grid:
+
+ |v top o|
+
+ top := HVScrollableView for:ObjectView
+ miniScrollerH:true miniScrollerV:true.
+ top extent:200@200.
+ v := top scrolledView.
+ v showGrid.
+
+ o := DrawRectangle new.
+ o origin:10@10 corner:100@100.
+ v add:o.
+
+ o := DrawText new.
+ o text:'hello there'; origin:50@50; foreground:Color red.
+ v add:o.
+
+ top open
+"
! !
!ObjectView class methodsFor:'defaults'!
@@ -72,223 +241,9 @@
!ObjectView methodsFor:'scrolling'!
-viewOrigin
- transformation isNil ifTrue:[
- ^ 0@0
- ].
- ^ transformation translation negated
-!
-
-setViewOrigin:aPoint
- |p|
-
- p := aPoint negated.
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:p
- ] ifFalse:[
- transformation translation:p
- ].
-"/ clipRect notNil ifTrue:[
-"/ self computeInnerClip.
-"/ ].
-!
-
-scrollDown:nPixels
- "change origin to scroll down some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- hCont "{ Class:SmallInteger }"
- ih "{ Class:SmallInteger }"
- orgX orgY|
-
- hCont := self heightOfContents.
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated.
- ].
-
- count := nPixels.
- ih := self innerHeight.
-
- ((orgY + nPixels + ih) > hCont) ifTrue:[
- count := hCont - orgY - ih
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(orgX @ (orgY + count)).
-
- (count >= ih) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := height - m2 - count.
- w := self width.
- self catchExpose.
- self copyFrom:self x:margin y:(count + margin)
- toX:margin y:margin
- width:w
- height:h.
-
- self setInnerClip.
- self redrawDeviceX:margin y:(h + margin)
- width:(width - m2) height:count.
-
- self waitForExpose.
- ].
- self originChanged:(0 @ count).
-!
-
-scrollUp:nPixels
- "change origin to scroll up (towards the origin) by some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- orgX
- orgY "{ Class:SmallInteger }"|
-
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated
- ].
-
- count := nPixels.
- (count > orgY) ifTrue:[
- count := orgY
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(orgX @ (orgY - count)).
-
- (count >= self innerHeight) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2. "top & bottom margins"
- h := height - m2 - count.
- w := width.
- self catchExpose.
- self copyFrom:self x:margin y:margin
- toX:margin y:(count + margin)
- width:w height:h.
-
- self setInnerClip.
- self redrawDeviceX:margin y:margin
- width:(width - m2)
- height:count.
-
- self waitForExpose.
- ].
- self originChanged:(0 @ count negated).
-!
-
-scrollLeft:nPixels
- "change origin to scroll left some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- orgX orgY|
-
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated.
- ].
-
- count := nPixels.
- (count > orgX) ifTrue:[
- count := orgX
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(orgX - count) @ orgY.
-
- (count >= self innerWidth) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := (height - m2).
-
- self catchExpose.
- self copyFrom:self x:margin y:margin
- toX:(count + margin) y:margin
- width:(width - m2 - count)
- height:h.
-
- self setInnerClip.
- self redrawDeviceX:margin y:margin
- width:count height:(height - m2).
-
- self waitForExpose.
- ].
- self originChanged:(count negated @ 0).
-!
-
-scrollRight:nPixels
- "change origin to scroll right some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- wCont "{ Class:SmallInteger }"
- iw "{ Class:SmallInteger }"
- orgX orgY|
-
- wCont := self widthOfContents.
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated.
- ].
-
-
- count := nPixels.
- iw := self innerWidth.
-
- ((orgX + nPixels + iw) > wCont) ifTrue:[
- count := wCont - orgX - iw
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(orgX + count) @ orgY.
-
- (count >= iw) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := (height - m2).
-
- self catchExpose.
- self copyFrom:self x:(count + margin) y:margin
- toX:margin y:margin
- width:(width - m2 - count)
- height:h.
-
- self setInnerClip.
- self redrawDeviceX:(width - margin - count) y:margin
- width:count height:(height - m2).
-
- self waitForExpose.
- ].
- self originChanged:(count @ 0).
-!
-
verticalScrollStep
- "return the amount to scroll when stepping left/right."
+ "return the amount to scroll when stepping left/right.
+ Redefined to scroll by inches or centimeters."
scaleMetric == #inch ifTrue:[
^ (device verticalPixelPerInch * (1/2)) asInteger
@@ -297,7 +252,8 @@
!
horizontalScrollStep
- "return the amount to scroll when stepping left/right."
+ "return the amount to scroll when stepping left/right.
+ Redefined to scroll by inches or centimeters."
scaleMetric == #inch ifTrue:[
^ (device horizontalPixelPerInch * (1/2)) asInteger
@@ -307,6 +263,20 @@
!ObjectView methodsFor:'misc'!
+hitDelta
+ "when clicking an object, allow for hitDelta pixels around object.
+ We compensate for any scaling here, to get a constant physical
+ hitDelta (i.e. the value returned here is inverse scaled)."
+
+ |delta|
+
+ delta := self class hitDelta.
+ transformation notNil ifTrue:[
+ delta := delta / transformation scale x
+ ].
+ ^ delta
+!
+
objectsIntersecting:aRectangle do:aBlock
"do something to every object which intersects a rectangle"
@@ -429,16 +399,6 @@
^ newCollection
!
-setMoveActions
- motionAction := [:movePoint | self doObjectMove:movePoint].
- releaseAction := [self endObjectMove]
-!
-
-setRectangleDragActions
- motionAction := [:movePoint | self doRectangleDrag:movePoint].
- releaseAction := [self endRectangleDrag]
-!
-
objectsIn:aRectangle do:aBlock
"do something to every object which is completely in a rectangle"
@@ -479,11 +439,6 @@
]
!
-setLineDragActions
- motionAction := [:movePoint | self doLineDrag:movePoint].
- releaseAction := [self endLineDrag]
-!
-
objectsInVisible:aRectangle do:aBlock
"do something to every object which is completely in a
visible rectangle"
@@ -621,24 +576,15 @@
!ObjectView methodsFor:'event handling'!
redrawX:x y:y width:w height:h
- |innerX innerY innerW innerH redrawFrame |
+ |redrawFrame |
((contents size ~~ 0) or:[gridShown]) ifTrue:[
- innerX := x.
- innerY := y.
- innerW := w.
- innerH := h.
-
- redrawFrame := Rectangle left:innerX top:innerY
- width:innerW height:innerH.
+ redrawFrame := Rectangle left:x top:y
+ width:w height:h.
self redrawObjectsInVisible:redrawFrame
]
!
-redrawDeviceX:x y:y width:w height:h
-super redrawDeviceX:x y:y width:w height:h
-!
-
buttonPress:button x:x y:y
"user pressed left button"
@@ -749,24 +695,11 @@
!ObjectView methodsFor:'dragging object move'!
doObjectMove:aPoint
- "do an object move.
- moveStartPoint is the original click-point.
- moveDelta"
-
- |dragger offset d p|
-
- rootMotion ifTrue:[
- dragger := rootView.
- offset := 0@0 "self viewOrigin".
- ] ifFalse:[
- dragger := self.
- offset := 0@0.
- ].
-
- "
- when drawing in the root window, we have to use its coordinates
- this is kept in offset.
- "
+ "do an object move - this is called for every motion
+ when moving objects."
+
+ |d|
+
movedObject isNil ifTrue:[
movedObject := selection.
"
@@ -775,19 +708,15 @@
movedObject notNil ifTrue:[
moveDelta := 0@0.
- dragger xoring:[
- "tricky, the moved object may not currently be aligned.
- if so, simulate a frame move of the delta"
-
- aligning ifTrue:[
- d := movedObject origin
- - (self alignToGrid:(movedObject origin)).
-"/ d printNL.
- moveDelta := d negated.
- ].
-"/ moveDelta printNL.
- self showDragging:movedObject offset:moveDelta - offset.
- ]
+ "tricky, the moved object may not currently be aligned.
+ if so, simulate a frame move of the delta"
+
+ aligning ifTrue:[
+ d := movedObject origin
+ - (self alignToGrid:(movedObject origin)).
+ moveDelta := d negated.
+ ].
+ self invertDragObject:movedObject delta:moveDelta
]
].
movedObject notNil ifTrue:[
@@ -795,42 +724,42 @@
clear prev outline,
draw new outline
"
- dragger xoring:[
- self showDragging:movedObject offset:moveDelta - offset.
- moveDelta := aPoint - moveStartPoint.
- aligning ifTrue:[
- moveDelta := self alignToGrid:moveDelta
- ].
- self showDragging:movedObject offset:moveDelta - offset.
- ]
+ self invertDragObject:movedObject delta:moveDelta.
+
+ moveDelta := aPoint - moveStartPoint.
+ aligning ifTrue:[
+ moveDelta := self alignToGrid:moveDelta
+ ].
+ self invertDragObject:movedObject delta:moveDelta
]
!
endObjectMove
- "cleanup after object move - find the destination view and dispatch to
- one of the moveObjectXXX-methods. These can be redefined in subclasses."
-
- |dragger inMySelf offs2 rootPoint destinationPoint
+ "cleanup after object move - called when the object move ends.
+ Find the destination view and position and dispatch to
+ one of the moveObjectXXX-methods which should do the real move.
+ These can be redefined in subclasses."
+
+ |inMySelf rootPoint destinationPoint p
viewId destinationView destinationId lastViewId|
movedObject notNil ifTrue:[
- rootMotion ifTrue:[
- dragger := rootView.
- offs2 := 0@0 "self viewOrigin"
- ] ifFalse:[
- dragger := self.
- offs2 := 0@0
- ].
- dragger xoring:[
- self showDragging:movedObject offset:moveDelta - offs2
- ].
- dragger device synchronizeOutput.
+ self invertDragObject:movedObject delta:moveDelta.
"check if object is to be put into another view"
rootMotion ifTrue:[
- rootPoint := device translatePoint:lastButt
- from:(self id)
- to:(rootView id).
+ p := lastButt.
+ "
+ get device coordinates
+ "
+ transformation notNil ifTrue:[
+ p := transformation applyTo:p.
+ ].
+ "
+ translate to screen
+ "
+ rootPoint := p + (device translatePoint:0@0 from:(self id) to:(rootView id)).
+
"search view the drop is in"
viewId := rootView id.
[viewId notNil] whileTrue:[
@@ -845,6 +774,7 @@
] ifFalse:[
inMySelf := true
].
+
inMySelf ifTrue:[
"simple move"
self move:movedObject by:moveDelta
@@ -872,17 +802,91 @@
startObjectMove:something at:aPoint
"start an object move"
+ self startObjectMove:something at:aPoint inRoot:canDragOutOfView
+!
+
+startRootObjectMove:something at:aPoint
+ "start an object move, possibly crossing view boundaries"
+
+ self startObjectMove:something at:aPoint inRoot:true
+!
+
+startObjectMove:something at:aPoint inRoot:inRoot
+ "start an object move; if inRoot is true, view
+ boundaries may be crossed."
+
something notNil ifTrue:[
self select:something.
(self canMove:something) ifTrue:[
self setMoveActions.
moveStartPoint := aPoint.
- rootMotion := canDragOutOfView.
- "self doObjectMove:aPoint "
+ rootMotion := inRoot.
] ifFalse:[
self setDefaultActions
]
]
+!
+
+setMoveActions
+ "setup to drag an object. Call this (for example) from your buttonPress
+ method, to make the view start to drag some object.
+ See startObjectMove and startRootObjectMove."
+
+ motionAction := [:movePoint | self doObjectMove:movePoint].
+ releaseAction := [self endObjectMove]
+!
+
+invertDragObject:movedObject delta:moveDelta
+ "draw inverting for an object move"
+
+ |dragger offs p d scale oldTrans|
+
+ rootMotion ifTrue:[
+ p := movedObject origin + moveDelta.
+ dragger := rootView.
+ "
+ get device coordinates
+ "
+"/ 'logical ' print. p printNL.
+ transformation notNil ifTrue:[
+ scale := transformation scale.
+ p := transformation applyTo:p.
+"/ 'device ' print. p printNL.
+ ].
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+"/ 'offs' print. offs printNL.
+ p := p + offs.
+"/ 'screen ' print. p printNL.
+ "
+ p is where we want it ...
+ have to adust slightly, since showDragging shows the object
+ at its origin plus some offset; here we want it to be drawn
+ at absolute p.
+ To do so, we set the draggers translation to p and
+ draw the object scaled at 0@0 (by setting offset to its negative org)
+ "
+
+ oldTrans := dragger transformation.
+ dragger transformation:(WindowingTransformation
+ scale:scale
+ translation:p).
+ d := movedObject origin negated.
+
+ dragger xoring:[
+ self showDragging:movedObject offset:d.
+ ].
+
+ dragger transformation:oldTrans.
+ dragger device synchronizeOutput.
+ ] ifFalse:[
+ self xoring:[
+ self showDragging:movedObject offset:moveDelta.
+ ].
+ self device synchronizeOutput
+ ].
! !
!ObjectView methodsFor:'drawing'!
@@ -898,21 +902,17 @@
showDragging:something offset:anOffset
"show an object while dragging"
- |drawOffset top drawer|
+ |drawer|
rootMotion ifTrue:[
"drag in root-window"
- top := self topView.
- drawOffset := device translatePoint:anOffset
- from:(self id) to:(rootView id).
drawer := rootView
] ifFalse:[
- drawOffset := anOffset.
drawer := self
].
self forEach:something do:[:anObject |
- anObject drawDragIn:drawer offset:drawOffset
+ anObject drawDragIn:drawer offset:anOffset
]
!
@@ -936,9 +936,12 @@
clipRect notNil ifTrue:[
vis := vis intersect:clipRect
].
+
transformation notNil ifTrue:[
- vis := vis origin truncated
- corner:(vis corner + (1@1)) truncated.
+ transformation scale ~~ 1 ifTrue:[
+ vis := vis origin truncated
+ corner:(vis corner + (1@1)) truncated.
+ ]
].
self clippedTo:vis do:[
@@ -1114,11 +1117,7 @@
|h|
h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
-
- transformation isNil ifTrue:[
- ^ h rounded
- ].
- ^ (transformation applyScaleY:h) rounded
+ ^ h rounded
!
widthOfContents
@@ -1127,11 +1126,7 @@
|w|
w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
-
- transformation isNil ifTrue:[
- ^ w rounded
- ].
- ^ (transformation applyScaleX:w) rounded
+ ^ w rounded
!
heightOfContentsInMM
@@ -1279,7 +1274,7 @@
|hdelta|
- hdelta := self class hitDelta.
+ hdelta := self hitDelta.
contents reverseDo:[:object |
(object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
].
@@ -1359,7 +1354,7 @@
|hdelta|
- hdelta := self class hitDelta.
+ hdelta := self hitDelta.
contents reverseDo:[:object |
(object isHitBy:aPoint withDelta:hdelta) ifTrue:[
(aBlock value:object) ifTrue:[^ object]
@@ -1450,7 +1445,7 @@
!ObjectView methodsFor:'selections'!
unselect
- "unselect - hide selection; clear selection buffer"
+ "unselect - hide selection; clear selection"
self hideSelection.
selection := nil
@@ -1585,8 +1580,6 @@
!
initialize
- |pixPerMM|
-
super initialize.
viewBackground := White.
@@ -1601,12 +1594,103 @@
rootMotion := false.
self setInitialDocumentFormat.
- readCursor := Cursor read.
leftHandCursor := Cursor leftHand.
sorted := false.
aligning := false
! !
+!ObjectView methodsFor:'cut & paste '!
+
+deleteSelection
+ "delete the selection into the cut&paste buffer"
+
+ |tmp|
+
+ tmp := selection.
+ self unselect.
+ self remove:tmp.
+ self setSelection:tmp
+!
+
+pasteBuffer
+ "add the objects in the paste-buffer"
+
+ |sel|
+
+ sel := self getSelection.
+ (device getSelectionOwnerOf:(device atomIDOf:'PRIMARY')) == drawableId
+ ifTrue:[
+ "
+ a local selection - paste with some offset
+ "
+ sel size > 0 ifTrue:[
+ sel := sel collect:[:element |
+ element copy moveTo:(element origin + (8 @ 8))
+ ]
+ ] ifFalse:[
+ sel := sel copy moveTo:(sel origin + (8 @ 8))
+ ]
+ ].
+ self paste:sel
+!
+
+convertForPaste:anObject
+ "return a converted version of anObject to be pasted, or nil if
+ the object is not compatible with me.
+ Return nil here; concrete subclasses should try to convert.
+ Notice: anObject may be a collection of to-be-pasted objects."
+
+ "in concrete subclasses, you can use:"
+"
+ |s|
+
+ (anObject respondsTo:#asDisplayObject) ifTrue:[
+ ^ anObject asDisplayObject
+ ].
+ (anObject isString or:[anObject isMemberOf:Text]) ifTrue:[
+ ].
+ anObject size > 0 ifTrue:[
+ (anObject inject:true into:[:okSoFar :element |
+ okSoFar and:[element respondsTo:#asDisplayObject]
+ ]) ifFalse:[
+ self warn:'selection not convertable to DisplayObject'.
+ ^ nil
+ ].
+ ^ anObject collect:[:element | element asDisplayObject].
+ ].
+"
+ ^ nil.
+!
+
+paste:something
+ "add the objects in the cut&paste-buffer"
+
+ |s|
+
+ self unselect.
+ s := self convertForPaste:something .
+ s isNil ifTrue:[
+ self warn:'selection not convertable'.
+ ^ self
+ ].
+ self addSelected:s
+!
+
+copySelection
+ "copy the selection into the cut&paste-buffer"
+
+ |tmp|
+
+ tmp := OrderedCollection new.
+ self selectionDo:[:object |
+ tmp add:(object copy)
+ ].
+"/ self forEach:tmp do:[:anObject |
+"/ anObject moveTo:(anObject origin + (8 @ 8))
+"/ ].
+ self setSelection:tmp
+! !
+
!ObjectView methodsFor:'adding / removing'!
addWithoutRedraw:something
@@ -1626,33 +1710,6 @@
]
!
-deleteSelection
- "delete the selection"
-
- buffer := selection.
- self unselect.
- self remove:buffer.
-!
-
-pasteBuffer
- "add the objects in the paste-buffer"
-
- self unselect.
- self addSelected:buffer
-!
-
-copySelection
- "copy the selection into the paste-buffer"
-
- buffer := OrderedCollection new.
- self selectionDo:[:object |
- buffer add:(object copy)
- ].
- self forEach:buffer do:[:anObject |
- anObject moveTo:(anObject origin + (8 @ 8))
- ]
-!
-
addSelected:something
"add something, anObject or a collection of objects to the contents
and select it"
@@ -1665,6 +1722,18 @@
"remove something, anObject or a collection of objects from the contents
do redraw"
+ something size > (contents size / 4) ifTrue:[
+ "
+ better to remove first, then redraw rest
+ "
+ self forEach:something do:[:anObject |
+ self removeFromSelection:anObject.
+ contents remove:anObject.
+ ].
+ self redraw.
+ ^ self
+ ].
+
self forEach:something do:[:anObject |
self removeObject:anObject
]
@@ -2001,6 +2070,15 @@
!ObjectView methodsFor:'dragging rectangle'!
+setRectangleDragActions
+ "setup to drag a rectangle. Call this (for example) from your buttonPress
+ method, to make the view start the drag.
+ See startRectangleDrag:."
+
+ motionAction := [:movePoint | self doRectangleDrag:movePoint].
+ releaseAction := [self endRectangleDrag]
+!
+
endRectangleDrag
"cleanup after rectangle drag; select them"
@@ -2111,7 +2189,9 @@
!ObjectView methodsFor:'grid manipulation'!
newGrid
- "define a new grid"
+ "define a new grid - this is a private helper which has to be
+ called after any change in the grid. It (re)creates the gridPixmap,
+ clears the view and redraws all visible objects."
gridPixmap := nil.
shown ifTrue:[
@@ -2131,17 +2211,19 @@
gridParameters
"used by defineGrid, and in a separate method for
easier redefinition in subclasses.
- Returns the parameters in an array of 7 elements,
+ Returns the grid parameters in an array of 7 elements,
which control the appearance of the grid-pattern.
- elements:
+ the elements are:
bigStepH number of pixels horizontally between 2 major steps
bigStepV number of pixels vertically between 2 major steps
littleStepH number of pixels horizontally between 2 minor steps
littleStepV number of pixels vertically between 2 minor steps
- gridAlignH number of pixels for horizontal grid align
- gridAlignV number of pixels for vertical grid align
- docBounds true, if document boundary shouldbe shown
+ gridAlignH number of pixels for horizontal grid align (pointer snap)
+ gridAlignV number of pixels for vertical grid align (pointer snap)
+ docBounds true, if document boundary should be shown
+
+ if littleStepH/V are nil, only bigSteps are drawn.
"
|mmH mmV bigStepH bigStepV littleStepH littleStepV arr|
@@ -2158,6 +2240,11 @@
mmH := self horizontalPixelPerMillimeter.
mmV := self verticalPixelPerMillimeter.
+ "
+ metric grid: small steps every millimeter, big step every
+ centimeter. If the transformation is shrinking, turn off little
+ steps.
+ "
(scaleMetric == #mm) ifTrue:[
"dots every mm; lines every cm"
bigStepH := mmH * 10.0.
@@ -2168,14 +2255,21 @@
littleStepV := mmV
]
].
+ "
+ inch grid: small steps every 1/8th inch, big step every half inch
+ If the transformation is shrinking, change little steps to 1/th inch
+ or even turn them off completely.
+ "
(scaleMetric == #inch) ifTrue:[
"dots every eights inch; lines every half inch"
bigStepH := mmH * (25.4 / 2).
bigStepV := mmV * (25.4 / 2).
(transformation notNil
and:[transformation scale <= 0.5]) ifTrue:[
- littleStepH := mmH * (25.4 / 4).
- littleStepV := mmV * (25.4 / 4)
+ transformation scale > 0.2 ifTrue:[
+ littleStepH := mmH * (25.4 / 4).
+ littleStepV := mmV * (25.4 / 4)
+ ]
] ifFalse:[
littleStepH := mmH * (25.4 / 8).
littleStepV := mmV * (25.4 / 8)
@@ -2195,7 +2289,11 @@
!
defineGrid
- "define the grid pattern"
+ "define the grid pattern - this creates the gridPixmap, which is
+ used as viewBackground when a grid is to be shown.
+ The grid is specified by the value returned from gridParameters,
+ which can be redefined in subclasses. See the comment there on how
+ the numbers are interpreted."
|mmH mmV params showDocumentBoundary gridW gridH
bigStepH bigStepV littleStepH littleStepV hires|
@@ -2327,7 +2425,8 @@
!
showGrid
- "show the grid"
+ "show the grid. The grid is defined by the return value of
+ gridParameters, which can be redefined in concrete subclasses."
gridShown := true.
self newGrid
@@ -2350,8 +2449,6 @@
alignOn
"align points to grid"
- |params|
-
aligning := true.
self getAlignParameters
!
@@ -2364,8 +2461,17 @@
!ObjectView methodsFor:'dragging line'!
+setLineDragActions
+ "setup to drag a line. Call this (for example) from your buttonPress
+ method, to make the view start to drag a line.
+ See startLineDrag and startRootLineDrag."
+
+ motionAction := [:movePoint | self doLineDrag:movePoint].
+ releaseAction := [self endLineDrag]
+!
+
startLineDrag:startPoint
- "start a line drag"
+ "start a line drag within the view"
self setLineDragActions.
dragObject := Rectangle origin:startPoint corner:startPoint.
@@ -2388,16 +2494,6 @@
doLineDrag:aPoint
"do drag a line"
- |dragger top org|
-
- rootMotion ifTrue:[
- dragger := rootView.
- top := self topView.
- org := device translatePoint:0@0 from:(self id) to:(rootView id).
- ] ifFalse:[
- dragger := self.
- ].
-
self invertDragLine.
dragObject corner:aPoint.
self invertDragLine.
@@ -2408,31 +2504,35 @@
views and relative offsets, then dispatch to one of the endLineDrag methods.
These can be redefined in subclasses to allow connect between views."
- |dragger offs2 top org rootPoint viewId
+ |rootPoint viewId offs
lastViewId destinationId destinationView destinationPoint inMySelf|
- rootMotion ifTrue:[
- dragger := rootView.
- offs2 := 0@0 "self viewOrigin".
- top := self topView.
- org := device translatePoint:0@0 from:(self id) to:(rootView id).
- offs2 := offs2 - org
- ] ifFalse:[
- dragger := self.
- offs2 := 0@0.
- ].
-
- dragger xoring:[
- dragger displayLineFrom:dragObject origin-offs2
- to:dragObject corner-offs2
- ].
+ self invertDragLine.
+
self cursor:oldCursor.
"check if line drag is into another view"
rootMotion ifTrue:[
- rootPoint := device translatePoint:lastButt
- from:(self id)
- to:(rootView id).
+ rootPoint := lastButt.
+ "
+ get device coordinates
+ "
+ 'logical ' print. rootPoint printNL.
+ transformation notNil ifTrue:[
+ rootPoint := transformation applyTo:rootPoint.
+ 'device ' print. rootPoint printNL.
+ ].
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+ 'offs' print. offs printNL.
+ rootPoint := rootPoint + offs.
+ 'screen ' print. rootPoint printNL.
+
+"/ rootPoint := device translatePoint:lastButt
+"/ from:(self id)
+"/ to:(rootView id).
"search view the drop is in"
viewId := rootView id.
@@ -2454,10 +2554,10 @@
to:dragObject corner
] ifFalse:[
"into another one"
- destinationPoint := device translatePoint:rootPoint
- from:(rootView id)
- to:(destinationView id).
destinationView notNil ifTrue:[
+ destinationPoint := device translatePoint:rootPoint
+ from:(rootView id)
+ to:(destinationView id).
"
move into another smalltalk view
"
@@ -2473,7 +2573,6 @@
].
self setDefaultActions.
dragObject := nil
-
!
lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
@@ -2503,7 +2602,38 @@
Extracted for easier redefinition in subclasses
(different line width etc.)"
- self xoring:[self lineWidth:0. self displayLineFrom:dragObject origin to:dragObject corner].
+ |dragger offs p1 p2|
+
+ p1 := dragObject origin.
+ p2 := dragObject corner.
+ rootMotion ifTrue:[
+ dragger := rootView.
+ "
+ get device coordinates
+ "
+"/ 'logical ' print. p1 print. ' ' print. p2 printNL.
+ transformation notNil ifTrue:[
+ p1 := transformation applyTo:p1.
+ p2 := transformation applyTo:p2.
+"/ 'device ' print. p1 print. ' ' print. p2 printNL.
+ ].
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+"/ 'offs' print. offs printNL.
+ p1 := p1 + offs.
+ p2 := p2 + offs.
+"/ 'screen ' print. p1 print. ' ' print. p2 printNL.
+ ] ifFalse:[
+ dragger := self.
+ ].
+
+ dragger xoring:[
+ dragger lineWidth:0.
+ dragger displayLineFrom:p1 to:p2.
+ dragger device synchronizeOutput
+ ].
! !
!ObjectView methodsFor:'saving / restoring'!
@@ -2535,47 +2665,84 @@
]
!
+storeBinaryContentsOn:aStream
+ "store the contents in binary representation on aStream."
+
+ aStream binary.
+ self topView withCursor:Cursor write do:[
+ self forEach:contents do:[:theObject |
+ theObject storeBinaryOn:aStream.
+ ].
+ ]
+!
+
withoutRedrawFileInContentsFrom:aStream
- self fileInContentsFrom:aStream redraw:false
+ "remove all objects, load new contents from aStream without any redraw"
+
+ self fileInContentsFrom:aStream redraw:false new:true binary:false
!
fileInContentsFrom:aStream
"remove all objects, load new contents from aStream and redraw"
- self fileInContentsFrom:aStream redraw:true
-!
-
-fileInContentsFrom:aStream redraw:redraw new:new
- "if the new argument is true, remove all objects.
- Then load objects from aStream,
- finally, redraw if the redraw argument is true"
-
- |newObject chunk|
-
- self topView withCursor:Cursor read do:[
- self unselect.
- new ifTrue:[self removeAll].
- [aStream atEnd] whileFalse:[
- chunk := aStream nextChunk.
- chunk notNil ifTrue:[
- chunk isEmpty ifFalse:[
- newObject := Compiler evaluate:chunk.
- self initializeFileInObject:newObject.
- redraw ifFalse:[
- self addObjectWithoutRedraw:newObject
- ] ifTrue:[
- self addObject:newObject
- ]
- ]
- ]
- ].
- ]
+ self fileInContentsFrom:aStream redraw:true new:true binary:false
!
fileInContentsFrom:aStream redraw:redraw
"remove all objects, load new contents from aStream
and redraw if the redraw argument is true"
- self fileInContentsFrom:aStream redraw:redraw new:true
+ self fileInContentsFrom:aStream redraw:redraw new:true binary:false
+!
+
+fileInContentsFrom:aStream redraw:redraw new:new
+ "remove all objects, load new contents from aStream
+ and redraw if the redraw argument is true"
+
+ self fileInContentsFrom:aStream redraw:redraw new:new binary:false
+!
+
+fileInContentsFrom:aStream redraw:redraw new:new binary:binary
+ "if the new argument is true, remove all objects.
+ Then load objects from aStream. If redraw is false, no redraw
+ is done
+ (allows fileIn of multiple files doing a single redraw at the end)."
+
+ binary ifTrue:[
+ aStream binary
+ ].
+ self topView withCursor:(Cursor read) do:[
+ |newObject chunk individualRedraw|
+
+ self unselect.
+ individualRedraw := redraw.
+ new ifTrue:[
+ self removeAll.
+ individualRedraw := false.
+ ].
+ [aStream atEnd] whileFalse:[
+ binary ifTrue:[
+ newObject := Object readBinaryFrom:aStream
+ ] ifFalse:[
+ chunk := aStream nextChunk.
+ (chunk notNil and:[chunk isEmpty not]) ifTrue:[
+ newObject := Compiler evaluate:chunk.
+ ] ifFalse:[
+ newObject := nil
+ ]
+ ].
+ newObject notNil ifTrue:[
+ self initializeFileInObject:newObject.
+ individualRedraw ifFalse:[
+ self addObjectWithoutRedraw:newObject
+ ] ifTrue:[
+ self addObject:newObject
+ ]
+ ]
+ ].
+ (new and:[redraw]) ifTrue:[
+ self redraw
+ ]
+ ]
! !
--- a/OptBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/OptBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/OptBox.st,v 1.9 1994-11-17 14:38:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/OptBox.st,v 1.10 1995-02-06 00:52:53 claus Exp $
'!
!OptionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/OptBox.st,v 1.9 1994-11-17 14:38:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/OptBox.st,v 1.10 1995-02-06 00:52:53 claus Exp $
"
!
@@ -92,6 +92,18 @@
]
!
+formLabel
+ "return the label-view which displays a bitmap"
+
+ ^ formLabel
+!
+
+form:aFormOrImage
+ "set the image shown in the label-view"
+
+ formLabel form:aFormOrImage
+!
+
numberOfOptions:nOptions
"set the number of options"
@@ -142,7 +154,7 @@
!OptionBox methodsFor:'initializing'!
initialize
- |nButt|
+ |nButt buttonPanel|
super initialize.
@@ -155,15 +167,10 @@
textLabel borderWidth:0.
textLabel origin:((ViewSpacing + formLabel width + ViewSpacing) @ ViewSpacing).
-"
- buttonPanel := HorizontalPanelView in:self.
- buttonPanel origin:(0.0 @ 1.0)
- corner:(1.0 @ 1.0).
- buttonPanel leftInset:mm;
- rightInset:mm;
- topInset:(font height * 2 + mm + mm) negated;
- bottomInset:mm.
-"
+ buttonPanel := HorizontalPanelView origin:(0.0 @ 1.0) corner:(1.0 @ 1.0) in:self.
+ buttonPanel bottomInset:ViewSpacing;
+ topInset:(font height + ViewSpacing * 2) negated.
+ buttonPanel borderWidth:0; layout:#fitSpace.
nButt := buttons size.
@@ -181,15 +188,8 @@
action value
]
]
- in:self.
+ in:buttonPanel "self".
buttons at:index put:button.
- button origin:[( (index-1) * ((width-ViewSpacing) // nButt) + (ViewSpacing) )
- @
- (height - ViewSpacing - (buttons at:index) heightIncludingBorder)].
- button extent:[(width-ViewSpacing-ViewSpacing // nButt - ViewSpacing)
- @
- (buttons at:index) height
- ]
]
!
@@ -198,6 +198,10 @@
WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:Display
].
formLabel form:WarnBitmap
+!
+
+focusSequence
+ ^ buttons
! !
!OptionBox methodsFor:'queries'!
--- a/OptionBox.st Mon Feb 06 01:52:01 1995 +0100
+++ b/OptionBox.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/OptionBox.st,v 1.9 1994-11-17 14:38:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/OptionBox.st,v 1.10 1995-02-06 00:52:53 claus Exp $
'!
!OptionBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/OptionBox.st,v 1.9 1994-11-17 14:38:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/OptionBox.st,v 1.10 1995-02-06 00:52:53 claus Exp $
"
!
@@ -92,6 +92,18 @@
]
!
+formLabel
+ "return the label-view which displays a bitmap"
+
+ ^ formLabel
+!
+
+form:aFormOrImage
+ "set the image shown in the label-view"
+
+ formLabel form:aFormOrImage
+!
+
numberOfOptions:nOptions
"set the number of options"
@@ -142,7 +154,7 @@
!OptionBox methodsFor:'initializing'!
initialize
- |nButt|
+ |nButt buttonPanel|
super initialize.
@@ -155,15 +167,10 @@
textLabel borderWidth:0.
textLabel origin:((ViewSpacing + formLabel width + ViewSpacing) @ ViewSpacing).
-"
- buttonPanel := HorizontalPanelView in:self.
- buttonPanel origin:(0.0 @ 1.0)
- corner:(1.0 @ 1.0).
- buttonPanel leftInset:mm;
- rightInset:mm;
- topInset:(font height * 2 + mm + mm) negated;
- bottomInset:mm.
-"
+ buttonPanel := HorizontalPanelView origin:(0.0 @ 1.0) corner:(1.0 @ 1.0) in:self.
+ buttonPanel bottomInset:ViewSpacing;
+ topInset:(font height + ViewSpacing * 2) negated.
+ buttonPanel borderWidth:0; layout:#fitSpace.
nButt := buttons size.
@@ -181,15 +188,8 @@
action value
]
]
- in:self.
+ in:buttonPanel "self".
buttons at:index put:button.
- button origin:[( (index-1) * ((width-ViewSpacing) // nButt) + (ViewSpacing) )
- @
- (height - ViewSpacing - (buttons at:index) heightIncludingBorder)].
- button extent:[(width-ViewSpacing-ViewSpacing // nButt - ViewSpacing)
- @
- (buttons at:index) height
- ]
]
!
@@ -198,6 +198,10 @@
WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:Display
].
formLabel form:WarnBitmap
+!
+
+focusSequence
+ ^ buttons
! !
!OptionBox methodsFor:'queries'!
--- a/PopUpList.st Mon Feb 06 01:52:01 1995 +0100
+++ b/PopUpList.st Mon Feb 06 01:53:30 1995 +0100
@@ -11,7 +11,7 @@
"
Button subclass:#PopUpList
- instanceVariableNames:'menu menuAction'
+ instanceVariableNames:'menu menuAction values'
classVariableNames:''
poolDictionaries:''
category:'Views-Interactors'
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.5 1994-11-28 21:05:13 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.6 1995-02-06 00:53:02 claus Exp $
'!
!PopUpList class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.5 1994-11-28 21:05:13 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.6 1995-02-06 00:53:02 claus Exp $
"
!
@@ -61,7 +61,6 @@
|p|
p := PopUpList label:'healthy fruit'.
p list:#('apples' 'bananas' 'grape' 'lemon' 'margarithas').
-
p open
@@ -81,6 +80,27 @@
p list:#('apples' 'bananas' 'grape' 'lemon' '-' 'margarithas').
p selection:'apples'.
p open
+
+
+ with an action:
+
+ |p|
+ p := PopUpList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' '-' 'margarithas').
+ p selection:'apples'.
+ p action:[:what | Transcript showCr:'you selected: ' , what].
+ p open
+
+
+ with values different from the label strings:
+
+ |p|
+ p := PopUpList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' '-' 'margarithas').
+ p selection:'apples'.
+ p values:#(10 20 30 40 nil 50).
+ p action:[:what | Transcript show:'you selected: '; showCr:what].
+ p open
"
! !
@@ -89,13 +109,13 @@
drawWith:fgColor and:bgColor
|mmH mmV mW mH|
- pressed ifTrue:[
+ controller pressed ifTrue:[
super drawWith:enteredFgColor and:enteredBgColor
] ifFalse:[
super drawWith:fgColor and:bgColor.
].
- mmH := (device horizontalPixelPerMillimeter * 1) rounded.
- mmV := (device verticalPixelPerMillimeter * 1) rounded.
+ mmH := device horizontalPixelPerMillimeter rounded.
+ mmV := device verticalPixelPerMillimeter rounded.
mW := (device horizontalPixelPerMillimeter * 2.5) rounded.
mH := (device verticalPixelPerMillimeter * 1.5) rounded.
@@ -105,25 +125,28 @@
!PopUpList methodsFor:'event handling'!
-buttonPress:button x:x y:y
+popMenu
|org mv|
- ((button == 1) or:[button == #select]) ifTrue:[
- menu notNil ifTrue:[
- menu font:font.
-"
- menu width:self width + (margin * 2).
-"
- mv := menu menuView.
- mv width:(self width - (2 * menu margin) - (menu borderWidth*2)).
- mv level:0; borderWidth:0.
- mv fixSize.
- org := device translatePoint:0@0
- from:(self id)
- to:(DisplayRootView new id).
-
- menu showAt:org "resizing:false"
- ]
+ menu notNil ifTrue:[
+ self turnOff.
+ menu font:font.
+
+ "
+ adjust the menus width to my current width
+ "
+ mv := menu menuView.
+ mv width:(self width - (2 * menu margin) - (menu borderWidth*2)).
+ mv level:0; borderWidth:0.
+ mv fixSize.
+ "
+ the popupMenu wants Display coordinates in its showAt: method
+ "
+ org := device translatePoint:0@0
+ from:(self id)
+ to:(DisplayRootView new id).
+
+ menu showAt:org "resizing:false"
].
! !
@@ -131,12 +154,41 @@
initialize
super initialize.
- actionWhenPressed := true.
+ controller beTriggerOnDown.
+ controller action:[self popMenu].
self adjust:#left
! !
!PopUpList methodsFor:'accessing'!
+model:aModel
+ "set the model - this is forwarded to my menu.
+ The popuplist itself has no model"
+
+ menu model:aModel
+!
+
+model
+ "return the model - this is forwarded to my menu.
+ The popuplist itself has no model"
+
+ ^ menu model
+!
+
+change:aSymbol
+ "set the change symbol - this is forwarded to my menu.
+ The popuplist itself has no model"
+
+ menu change:aSymbol
+!
+
+changeSymbol
+ "return the change symbol - this is forwarded to my menu.
+ The popuplist itself has no model"
+
+ ^ menu changeSymbol
+!
+
action:aOneArgBlock
"set the action to be performed on selection changes;
the argument, aOneArgBlock will be evaluated with the
@@ -172,6 +224,22 @@
"
!
+values:aList
+ "set a value list - these are reported via the action or changeSymbol instead of
+ the labe strings."
+
+ values := aList.
+ menu args:(1 to:aList size).
+
+ "
+ |p|
+ p := PopUpList label:'fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margarithas').
+ p values:#(1 2 3 4 'mhmh - good').
+ p open
+ "
+!
+
selection:indexOrString
"set (force) a selection - usually done to set
an initial selection"
@@ -236,13 +304,22 @@
!PopUpList methodsFor:'user actions'!
select:anEntry
+ |value label|
+
"/ 'selected:' print. anEntry printNewline.
+ values isNil ifTrue:[
+ label := value := anEntry
+ ] ifFalse:[
+ label := menu labels at:anEntry.
+ value := values at:anEntry
+ ].
+
menuAction notNil ifTrue:[
- menuAction value:anEntry.
+ menuAction value:value.
].
self sizeFixed:true.
- self label:anEntry printString.
+ self label:label printString.
(model notNil and:[changeSymbol notNil]) ifTrue:[
- model perform:changeSymbol with:anEntry
+ model perform:changeSymbol with:value
].
! !
--- a/PopUpMenu.st Mon Feb 06 01:52:01 1995 +0100
+++ b/PopUpMenu.st Mon Feb 06 01:53:30 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.10 1994-11-28 21:05:15 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.11 1995-02-06 00:53:04 claus Exp $
'!
!PopUpMenu class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.10 1994-11-28 21:05:15 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.11 1995-02-06 00:53:04 claus Exp $
"
!
@@ -412,18 +412,8 @@
!
realize
-"/ windowGroup notNil ifTrue:[
-"/ windowGroup sensor compressMotionEvents:true
-"/ ].
-
menuView deselectWithoutRedraw.
-"/ self enableEnterLeaveEvents.
super realize.
-
-"/ menuView disableButtonMotionEvents.
-"/ menuView disableMotionEvents.
-"/ menuView disableButtonEvents.
-"/ menuView disableEnterLeaveEvents
! !
!PopUpMenu methodsFor:'private accessing'!
@@ -447,6 +437,22 @@
"return the superMenu"
menuView superMenu:aMenu
+!
+
+change:aSymbol
+ menuView change:aSymbol
+!
+
+changeSymbol
+ ^ menuView changeSymbol
+!
+
+model
+ ^ menuView model
+!
+
+model:aModel
+ menuView model:aModel
! !
!PopUpMenu methodsFor:'menuview messages'!
@@ -593,53 +599,17 @@
!PopUpMenu methodsFor:'activation'!
-showAt:aPoint resizing:aBoolean
- "realize the menu at aPoint"
-
- aBoolean ifTrue:[
- self fixSize.
- ].
- self origin:aPoint.
- self makeFullyVisible.
- self openModal:[true] "realize "
-!
-
-showAt:aPoint
- "realize the menu at aPoint"
-
- self showAt:aPoint resizing:true
-!
-
-showAtPointer
- "realize the menu at the current pointer position"
-
- self showAt:(device pointerPosition) resizing:true
-!
-
-show
- "realize the menu at its last position"
-
- self fixSize.
- self openModal:[true] "realize "
-!
-
hide
"hide the menu - if there are any pop-up-submenus, hide them also"
menuView hideSubmenu.
windowGroup notNil ifTrue:[
- windowGroup removeView:self.
windowGroup removeView:menuView.
- windowGroup := nil.
].
- self unrealize.
+ super hide.
menuView superMenu notNil ifTrue:[
menuView superMenu regainControl
].
-!
-
-regainControl
- device grabPointerInView:self
! !
!PopUpMenu methodsFor:'ST-80 activation'!
--- a/PullDMenu.st Mon Feb 06 01:52:01 1995 +0100
+++ b/PullDMenu.st Mon Feb 06 01:53:30 1995 +0100
@@ -24,7 +24,7 @@
DefaultHilightBackgroundColor
DefaultLevel DefaultHilightLevel
DefaultShadowColor DefaultLightColor
- DefaultEdgeStyle DefaultKeep'
+ DefaultEdgeStyle DefaultKeepMenu'
poolDictionaries:''
category:'Views-Menus'
!
@@ -33,7 +33,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.9 1994-11-28 21:05:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.10 1995-02-06 00:53:07 claus Exp $
'!
!PullDownMenu class methodsFor:'documentation'!
@@ -54,7 +54,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.9 1994-11-28 21:05:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.10 1995-02-06 00:53:07 claus Exp $
"
!
@@ -79,6 +79,38 @@
offLevel <Integer> level of entry-buttons when released
keepmenu <Boolean> if on, pulled menu stays on click,
till clicked again (motif & windows behavior)
+
+
+ StyleSheet values:
+
+ pullDownMenuViewBackground view background Color
+ default: menuViewBackground
+
+ pullDownMenuForegroundColor foreground drawing color
+ default: menuForegroundColor
+
+ pullDownMenuBackgroundColor background drawing color
+ default: menuBackgroundColor
+
+ pullDownMenuHilightForegroundColor active foreground drawing color
+ default: menuHilightForegroundColor
+
+ pullDownMenuHilightBackgroundColor active background drawing color
+ default: menuHilightBackgroundColor
+
+ pullDownMenuHilightLevel level (3D only) when active
+ default: menuHilightLevel
+
+ pullDownMenuEdgeStyle edge style (nil or #soft)
+
+ pullDownMenuKeepMenu if true, menu stays open until button
+ is pressed again (motif behavior)
+ if false, menu closes on release (default)
+
+ pullDownMenuLevel level (3D only)
+
+ pullDownMenuFont font
+ default: menuFont
"
! !
@@ -95,7 +127,11 @@
].
DefaultBackgroundColor := StyleSheet colorAt:'pullDownMenuBackgroundColor'.
DefaultBackgroundColor isNil ifTrue:[
- DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
+ DefaultViewBackground notNil ifTrue:[
+ DefaultBackgroundColor := DefaultViewBackground
+ ] ifFalse:[
+ DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
+ ]
].
DefaultHilightForegroundColor := StyleSheet colorAt:'pullDownMenuHilightForegroundColor'.
DefaultHilightForegroundColor isNil ifTrue:[
@@ -110,7 +146,7 @@
DefaultHilightLevel := StyleSheet at:'menuHilightLevel' default:0.
].
DefaultEdgeStyle := StyleSheet at:'pullDownMenuEdgeStyle'.
- DefaultKeepMenu := StyleSheet at:'pullDownMenuKeepMenu'.
+ DefaultKeepMenu := StyleSheet at:'pullDownMenuKeepMenu' default:false.
DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
DefaultFont := StyleSheet fontAt:'pullDownMenuFont'.
DefaultFont isNil ifTrue:[
@@ -126,7 +162,7 @@
^ self new labels:titleArray
! !
-!PullDownMenu methodsFor:'initialization'!
+!PullDownMenu methodsFor:'initialize / release'!
initialize
super initialize.
@@ -173,7 +209,7 @@
].
topMargin := 2.
- ((style == #iris) or:[style == #motif]) ifTrue:[
+ ((StyleSheet name == #iris) or:[StyleSheet name == #motif]) ifTrue:[
self level:2.
onLevel := 2.
offLevel := 0.
@@ -220,6 +256,20 @@
create
super create.
self setMenuOrigins
+!
+
+destroy
+ super destroy.
+ "
+ have to destroy the menus manually here,
+ since they are no real subviews of myself
+ "
+ menus notNil ifTrue:[
+ menus do:[:m |
+ m notNil ifTrue:[m destroy]
+ ].
+ menus := nil
+ ]
! !
!PullDownMenu methodsFor:'accessing'!
@@ -292,7 +342,8 @@
@
(height + aMenu borderWidth)).
aMenu hidden:true.
- menus at:index put:aMenu
+ menus at:index put:aMenu.
+ aMenu masterView:self.
!
at:aString putLabels:labels selectors:selectors args:args receiver:anObject
@@ -456,6 +507,13 @@
subMenu saveUnder:true.
subMenu raise show
]
+!
+
+regainControl
+ keepMenu ifTrue:[
+ device grabPointerInView:self.
+ self cursor:Cursor upRightArrow
+ ]
! !
!PullDownMenu methodsFor:'event handling'!
@@ -529,7 +587,7 @@
(titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
self pullMenu:titleIndex.
keepMenu ifTrue:[
- device grabPointerIn:self id.
+ device grabPointerInView:self.
self cursor:Cursor upRightArrow
]
] ifFalse:[
--- a/PullDownMenu.st Mon Feb 06 01:52:01 1995 +0100
+++ b/PullDownMenu.st Mon Feb 06 01:53:30 1995 +0100
@@ -24,7 +24,7 @@
DefaultHilightBackgroundColor
DefaultLevel DefaultHilightLevel
DefaultShadowColor DefaultLightColor
- DefaultEdgeStyle DefaultKeep'
+ DefaultEdgeStyle DefaultKeepMenu'
poolDictionaries:''
category:'Views-Menus'
!
@@ -33,7 +33,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.9 1994-11-28 21:05:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.10 1995-02-06 00:53:07 claus Exp $
'!
!PullDownMenu class methodsFor:'documentation'!
@@ -54,7 +54,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.9 1994-11-28 21:05:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.10 1995-02-06 00:53:07 claus Exp $
"
!
@@ -79,6 +79,38 @@
offLevel <Integer> level of entry-buttons when released
keepmenu <Boolean> if on, pulled menu stays on click,
till clicked again (motif & windows behavior)
+
+
+ StyleSheet values:
+
+ pullDownMenuViewBackground view background Color
+ default: menuViewBackground
+
+ pullDownMenuForegroundColor foreground drawing color
+ default: menuForegroundColor
+
+ pullDownMenuBackgroundColor background drawing color
+ default: menuBackgroundColor
+
+ pullDownMenuHilightForegroundColor active foreground drawing color
+ default: menuHilightForegroundColor
+
+ pullDownMenuHilightBackgroundColor active background drawing color
+ default: menuHilightBackgroundColor
+
+ pullDownMenuHilightLevel level (3D only) when active
+ default: menuHilightLevel
+
+ pullDownMenuEdgeStyle edge style (nil or #soft)
+
+ pullDownMenuKeepMenu if true, menu stays open until button
+ is pressed again (motif behavior)
+ if false, menu closes on release (default)
+
+ pullDownMenuLevel level (3D only)
+
+ pullDownMenuFont font
+ default: menuFont
"
! !
@@ -95,7 +127,11 @@
].
DefaultBackgroundColor := StyleSheet colorAt:'pullDownMenuBackgroundColor'.
DefaultBackgroundColor isNil ifTrue:[
- DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
+ DefaultViewBackground notNil ifTrue:[
+ DefaultBackgroundColor := DefaultViewBackground
+ ] ifFalse:[
+ DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
+ ]
].
DefaultHilightForegroundColor := StyleSheet colorAt:'pullDownMenuHilightForegroundColor'.
DefaultHilightForegroundColor isNil ifTrue:[
@@ -110,7 +146,7 @@
DefaultHilightLevel := StyleSheet at:'menuHilightLevel' default:0.
].
DefaultEdgeStyle := StyleSheet at:'pullDownMenuEdgeStyle'.
- DefaultKeepMenu := StyleSheet at:'pullDownMenuKeepMenu'.
+ DefaultKeepMenu := StyleSheet at:'pullDownMenuKeepMenu' default:false.
DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
DefaultFont := StyleSheet fontAt:'pullDownMenuFont'.
DefaultFont isNil ifTrue:[
@@ -126,7 +162,7 @@
^ self new labels:titleArray
! !
-!PullDownMenu methodsFor:'initialization'!
+!PullDownMenu methodsFor:'initialize / release'!
initialize
super initialize.
@@ -173,7 +209,7 @@
].
topMargin := 2.
- ((style == #iris) or:[style == #motif]) ifTrue:[
+ ((StyleSheet name == #iris) or:[StyleSheet name == #motif]) ifTrue:[
self level:2.
onLevel := 2.
offLevel := 0.
@@ -220,6 +256,20 @@
create
super create.
self setMenuOrigins
+!
+
+destroy
+ super destroy.
+ "
+ have to destroy the menus manually here,
+ since they are no real subviews of myself
+ "
+ menus notNil ifTrue:[
+ menus do:[:m |
+ m notNil ifTrue:[m destroy]
+ ].
+ menus := nil
+ ]
! !
!PullDownMenu methodsFor:'accessing'!
@@ -292,7 +342,8 @@
@
(height + aMenu borderWidth)).
aMenu hidden:true.
- menus at:index put:aMenu
+ menus at:index put:aMenu.
+ aMenu masterView:self.
!
at:aString putLabels:labels selectors:selectors args:args receiver:anObject
@@ -456,6 +507,13 @@
subMenu saveUnder:true.
subMenu raise show
]
+!
+
+regainControl
+ keepMenu ifTrue:[
+ device grabPointerInView:self.
+ self cursor:Cursor upRightArrow
+ ]
! !
!PullDownMenu methodsFor:'event handling'!
@@ -529,7 +587,7 @@
(titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
self pullMenu:titleIndex.
keepMenu ifTrue:[
- device grabPointerIn:self id.
+ device grabPointerInView:self.
self cursor:Cursor upRightArrow
]
] ifFalse:[
--- a/RButton.st Mon Feb 06 01:52:01 1995 +0100
+++ b/RButton.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.5 1994-10-10 03:02:48 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.6 1995-02-06 00:53:09 claus Exp $
'!
!RadioButton class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.5 1994-10-10 03:02:48 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.6 1995-02-06 00:53:09 claus Exp $
"
!
@@ -67,9 +67,9 @@
XXtoggle
"in addition to toggling, notify RadioButtonGroup"
- enabled ifTrue:[
+ controller enabled ifTrue:[
super toggle.
- pressed ifTrue:[
+ controller pressed ifTrue:[
self changed
]
]
@@ -81,7 +81,7 @@
"radiobuttons change only off-to-on; turning off is done by other
buttons"
- pressed ifFalse:[
+ controller pressed ifFalse:[
self toggle
]
! !
--- a/RadioButton.st Mon Feb 06 01:52:01 1995 +0100
+++ b/RadioButton.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.5 1994-10-10 03:02:48 claus Exp $
+$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.6 1995-02-06 00:53:09 claus Exp $
'!
!RadioButton class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.5 1994-10-10 03:02:48 claus Exp $
+$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.6 1995-02-06 00:53:09 claus Exp $
"
!
@@ -67,9 +67,9 @@
XXtoggle
"in addition to toggling, notify RadioButtonGroup"
- enabled ifTrue:[
+ controller enabled ifTrue:[
super toggle.
- pressed ifTrue:[
+ controller pressed ifTrue:[
self changed
]
]
@@ -81,7 +81,7 @@
"radiobuttons change only off-to-on; turning off is done by other
buttons"
- pressed ifFalse:[
+ controller pressed ifFalse:[
self toggle
]
! !
--- a/ScrView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ScrView.st Mon Feb 06 01:53:30 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.9 1994-11-21 16:45:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.10 1995-02-06 00:53:11 claus Exp $
'!
!ScrollableView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.9 1994-11-21 16:45:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.10 1995-02-06 00:53:11 claus Exp $
"
!
@@ -173,6 +173,15 @@
^ self for:aViewClass miniScrollerH:false miniScrollerV:false in:aView
!
+for:aViewClass miniScrollerH:miniH miniScrollerV:miniV
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars if the corresponding miniH/miniV
+ is false, miniscrollers if false."
+
+ ^ self for:aViewClass miniScrollerH:miniH miniScrollerV:miniV in:nil
+!
+
for:aViewClass miniScroller:mini in:aView
"return a new scrolling view scrolling an instance of aViewClass.
The subview is created here.
--- a/ScrollBar.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ScrollBar.st Mon Feb 06 01:53:30 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.9 1994-11-17 14:38:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.10 1995-02-06 00:53:13 claus Exp $
'!
!ScrollBar class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.9 1994-11-17 14:38:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.10 1995-02-06 00:53:13 claus Exp $
"
!
@@ -149,6 +149,11 @@
elementSpacing := DefaultElementSpacing
!
+reinitialize
+ super reinitialize.
+ self setElementPositions.
+!
+
createElements
button1 := ArrowButton upIn:self.
button2 := ArrowButton downIn:self.
@@ -203,7 +208,7 @@
"need fix - this is a kludge;
the if should not be needed ..."
- style == #mswindows ifTrue:[
+ StyleSheet name == #mswindows ifTrue:[
w := button1 width max:button2 width.
h := button1 height + button2 height + (Scroller defaultExtent y).
] ifFalse:[
@@ -223,7 +228,7 @@
].
h := upHeight + downHeight + (1 * 2) + (Scroller defaultExtent y).
w := upWidth max:downWidth.
- style ~~ #normal ifTrue:[
+ StyleSheet name ~~ #normal ifTrue:[
h := h + 4.
w := w + 4
].
@@ -401,11 +406,11 @@
].
thumbWidth := w.
- style == #next ifTrue:[
+ StyleSheet name == #next ifTrue:[
thumbWidth := thumbWidth - (thumb borderWidth * 2).
thumbHeight := thumbHeight - 1
].
- style == #motif ifTrue:[
+ StyleSheet name == #motif ifTrue:[
thumbHeight := thumbHeight - margin
].
@@ -440,7 +445,7 @@
].
"buttons around thumb"
-style == #motif ifTrue:[
+StyleSheet name == #motif ifTrue:[
sep2 := sep2 + 1
].
button1 origin:(bwn @ bwn).
--- a/ScrollableView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/ScrollableView.st Mon Feb 06 01:53:30 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.9 1994-11-21 16:45:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.10 1995-02-06 00:53:11 claus Exp $
'!
!ScrollableView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.9 1994-11-21 16:45:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.10 1995-02-06 00:53:11 claus Exp $
"
!
@@ -173,6 +173,15 @@
^ self for:aViewClass miniScrollerH:false miniScrollerV:false in:aView
!
+for:aViewClass miniScrollerH:miniH miniScrollerV:miniV
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars if the corresponding miniH/miniV
+ is false, miniscrollers if false."
+
+ ^ self for:aViewClass miniScrollerH:miniH miniScrollerV:miniV in:nil
+!
+
for:aViewClass miniScroller:mini in:aView
"return a new scrolling view scrolling an instance of aViewClass.
The subview is created here.
--- a/Scroller.st Mon Feb 06 01:52:01 1995 +0100
+++ b/Scroller.st Mon Feb 06 01:53:30 1995 +0100
@@ -43,7 +43,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.12 1994-11-28 21:05:18 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.13 1995-02-06 00:53:15 claus Exp $
'!
!Scroller class methodsFor:'documentation'!
@@ -64,7 +64,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.12 1994-11-28 21:05:18 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.13 1995-02-06 00:53:15 claus Exp $
"
!
@@ -474,8 +474,10 @@
left := thumbFrame left.
- (oldBot >= height) ifTrue:[
- "cannot copy - thumb was below end"
+ (self exposeEventPending
+ or:[oldBot >= height]) ifTrue:[
+ "cannot copy - thumb was below end or may be not abailable
+ for the copy"
self drawThumbBackgroundInX:left y:oldTop
width:tW height:(height - oldTop).
self drawThumb.
@@ -508,6 +510,8 @@
].
self waitForExpose
]
+ ] ifFalse:[
+ thumbFrame := nil
]
]
!
@@ -542,6 +546,8 @@
].
self drawThumb
]
+ ] ifFalse:[
+ thumbFrame := nil
]
]
!
@@ -587,6 +593,8 @@
].
self computeThumbFrame.
self drawThumb
+ ] ifFalse:[
+ thumbFrame := nil
]
]
]
@@ -604,9 +612,15 @@
contentsSize := 0
] ifFalse:[
moveDirection == #y ifTrue:[
- contentsSize := aView heightOfContents
+ contentsSize := aView heightOfContents.
+ aView transformation notNil ifTrue:[
+ contentsSize := aView transformation applyScaleY:contentsSize.
+ ].
] ifFalse:[
- contentsSize := aView widthOfContents
+ contentsSize := aView widthOfContents.
+ aView transformation notNil ifTrue:[
+ contentsSize := aView transformation applyScaleX:contentsSize.
+ ].
]
].
@@ -647,16 +661,25 @@
setThumbHeightFor:aView
"get contents and size info from aView and adjust thumb height"
- |percent totalHeight viewsSize|
+ |percent total viewsSize|
- totalHeight := (moveDirection == #y) ifTrue:[aView heightOfContents]
- ifFalse:[aView widthOfContents].
- (totalHeight = 0) ifTrue:[
+ (moveDirection == #y) ifTrue:[
+ total := aView heightOfContents.
+ aView transformation notNil ifTrue:[
+ total := aView transformation applyScaleY:total.
+ ].
+ ] ifFalse:[
+ total := aView widthOfContents.
+ aView transformation notNil ifTrue:[
+ total := aView transformation applyScaleX:total.
+ ].
+ ].
+ (total = 0) ifTrue:[
percent := 100
] ifFalse:[
viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
ifFalse:[aView innerWidth].
- percent := viewsSize * 100.0 / totalHeight
+ percent := viewsSize * 100.0 / total
].
self thumbHeight:percent
!
@@ -664,16 +687,25 @@
setThumbOriginFor:aView
"get contents and size info from aView and adjust thumb origin"
- |percent totalHeight contentsPosition|
+ |percent total contentsPosition|
- totalHeight := (moveDirection == #y) ifTrue:[aView heightOfContents]
- ifFalse:[aView widthOfContents].
- (totalHeight = 0) ifTrue:[
+ (moveDirection == #y) ifTrue:[
+ total := aView heightOfContents.
+ aView transformation notNil ifTrue:[
+ total := aView transformation applyScaleY:total.
+ ].
+ ] ifFalse:[
+ total := aView widthOfContents.
+ aView transformation notNil ifTrue:[
+ total := aView transformation applyScaleX:total.
+ ].
+ ].
+ (total = 0) ifTrue:[
percent := 100
] ifFalse:[
contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents]
ifFalse:[aView xOriginOfContents].
- percent := contentsPosition * 100.0 / totalHeight
+ percent := contentsPosition * 100.0 / total
].
self thumbOrigin:percent
!
@@ -682,7 +714,7 @@
"change the color of the thumb"
thumbColor := aColor on:device.
- (style ~~ #normal) ifTrue:[
+ (StyleSheet name ~~ #normal) ifTrue:[
thumbShadowColor := aColor darkened on:device.
thumbLightColor := aColor lightened on:device.
thumbHalfShadowColor := thumbShadowColor darkened on:device.
--- a/SelListV.st Mon Feb 06 01:52:01 1995 +0100
+++ b/SelListV.st Mon Feb 06 01:53:30 1995 +0100
@@ -37,7 +37,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.15 1994-11-28 21:05:20 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.16 1995-02-06 00:53:18 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -58,7 +58,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.15 1994-11-28 21:05:20 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.16 1995-02-06 00:53:18 claus Exp $
"
!
@@ -1000,7 +1000,14 @@
].
].
(self isValidSelection:next) ifFalse:[
- next := 1
+ next > list size ifTrue:[
+ next := 1.
+ ] ifFalse:[
+ [next <= list size
+ and:[(self isValidSelection:next) not]] whileTrue:[
+ next := next + 1
+ ].
+ ].
].
(self isValidSelection:next) ifFalse:[
next := nil
@@ -1024,7 +1031,14 @@
].
].
(self isValidSelection:prev) ifFalse:[
- prev := list size
+ prev < 1 ifTrue:[
+ prev := list size.
+ ] ifFalse:[
+ [prev >= 1
+ and:[(self isValidSelection:prev) not]] whileTrue:[
+ prev := prev - 1
+ ].
+ ].
].
(self isValidSelection:prev) ifFalse:[
prev := nil
@@ -1347,7 +1361,15 @@
].
(self line:listLine hasAttribute:#bold) ifTrue:[
font bold ifTrue:[
- newFont := font asItalic
+ "
+ mhmh - what can be done, if the font is already bold ?
+ "
+ newFont := font.
+ fgColor brightness > 0.5 ifTrue:[
+ fg := fgColor darkened darkened.
+ ] ifFalse:[
+ fg := fgColor lightened lightened
+ ].
] ifFalse:[
newFont := font asBold
].
--- a/SelectionInListView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/SelectionInListView.st Mon Feb 06 01:53:30 1995 +0100
@@ -37,7 +37,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.15 1994-11-28 21:05:20 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.16 1995-02-06 00:53:18 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -58,7 +58,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.15 1994-11-28 21:05:20 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.16 1995-02-06 00:53:18 claus Exp $
"
!
@@ -1000,7 +1000,14 @@
].
].
(self isValidSelection:next) ifFalse:[
- next := 1
+ next > list size ifTrue:[
+ next := 1.
+ ] ifFalse:[
+ [next <= list size
+ and:[(self isValidSelection:next) not]] whileTrue:[
+ next := next + 1
+ ].
+ ].
].
(self isValidSelection:next) ifFalse:[
next := nil
@@ -1024,7 +1031,14 @@
].
].
(self isValidSelection:prev) ifFalse:[
- prev := list size
+ prev < 1 ifTrue:[
+ prev := list size.
+ ] ifFalse:[
+ [prev >= 1
+ and:[(self isValidSelection:prev) not]] whileTrue:[
+ prev := prev - 1
+ ].
+ ].
].
(self isValidSelection:prev) ifFalse:[
prev := nil
@@ -1347,7 +1361,15 @@
].
(self line:listLine hasAttribute:#bold) ifTrue:[
font bold ifTrue:[
- newFont := font asItalic
+ "
+ mhmh - what can be done, if the font is already bold ?
+ "
+ newFont := font.
+ fgColor brightness > 0.5 ifTrue:[
+ fg := fgColor darkened darkened.
+ ] ifFalse:[
+ fg := fgColor lightened lightened
+ ].
] ifFalse:[
newFont := font asBold
].
--- a/TextColl.st Mon Feb 06 01:52:01 1995 +0100
+++ b/TextColl.st Mon Feb 06 01:53:30 1995 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.12 1994-11-17 14:38:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.13 1995-02-06 00:53:22 claus Exp $
'!
!TextCollector class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.12 1994-11-17 14:38:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.13 1995-02-06 00:53:22 claus Exp $
"
!
@@ -67,6 +67,14 @@
at the top.
You can set linelimit to nil (i.e. no limit), but you may need a lot
of memory then ...
+
+ StyleSheet paramters:
+
+ transcriptForegroundColor defaults to textForegroundColor
+ transcriptBackgroundColor' defaults to textBackgroundColor.
+
+ transcriptCursorForegroundColor
+ transcriptCursorBackgroundColor
"
! !
@@ -121,6 +129,7 @@
fg := StyleSheet colorAt:'transcriptForegroundColor' default:transcript foregroundColor.
bg := StyleSheet colorAt:'transcriptBackgroundColor' default:transcript backgroundColor.
transcript foregroundColor:fg backgroundColor:bg.
+ transcript viewBackground:bg.
cFg := StyleSheet colorAt:'transcriptCursorForegroundColor' default:bg.
cBg := StyleSheet colorAt:'transcriptCursorBackgroundColor' default:fg.
@@ -229,6 +238,13 @@
Processor removeTimedBlock:flushBlock.
flushPending ifFalse:[^ self].
+ access wouldBlock ifTrue:[
+ Processor activeProcessIsSystemProcess ifTrue:[
+ "/ Stderr nextPutAll:'Blocking in Transcript avoided: ' , aString.
+ ^ self
+ ]
+ ].
+
access critical:[
flushPending := false.
outstandingLines size ~~ 0 ifTrue:[
@@ -337,7 +353,12 @@
cr
"output a carriage return, finishing the current line"
- |wasBlocked|
+ access wouldBlock ifTrue:[
+ Processor activeProcessIsSystemProcess ifTrue:[
+ Stderr cr.
+ ^ self
+ ]
+ ].
collecting ifTrue:[
access critical:[
@@ -360,9 +381,15 @@
show:anObject
"insert the argument aString at current cursor position"
- |aString wasBlocked|
+ |aString|
aString := anObject printString.
+ access wouldBlock ifTrue:[
+ Processor activeProcessIsSystemProcess ifTrue:[
+ Stderr nextPutAll:'Blocking in Transcript avoided: ' , aString.
+ ^ self
+ ]
+ ].
collecting ifTrue:[
access critical:[
outstandingLine notNil ifTrue:[
--- a/TextCollector.st Mon Feb 06 01:52:01 1995 +0100
+++ b/TextCollector.st Mon Feb 06 01:53:30 1995 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.12 1994-11-17 14:38:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.13 1995-02-06 00:53:22 claus Exp $
'!
!TextCollector class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.12 1994-11-17 14:38:40 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.13 1995-02-06 00:53:22 claus Exp $
"
!
@@ -67,6 +67,14 @@
at the top.
You can set linelimit to nil (i.e. no limit), but you may need a lot
of memory then ...
+
+ StyleSheet paramters:
+
+ transcriptForegroundColor defaults to textForegroundColor
+ transcriptBackgroundColor' defaults to textBackgroundColor.
+
+ transcriptCursorForegroundColor
+ transcriptCursorBackgroundColor
"
! !
@@ -121,6 +129,7 @@
fg := StyleSheet colorAt:'transcriptForegroundColor' default:transcript foregroundColor.
bg := StyleSheet colorAt:'transcriptBackgroundColor' default:transcript backgroundColor.
transcript foregroundColor:fg backgroundColor:bg.
+ transcript viewBackground:bg.
cFg := StyleSheet colorAt:'transcriptCursorForegroundColor' default:bg.
cBg := StyleSheet colorAt:'transcriptCursorBackgroundColor' default:fg.
@@ -229,6 +238,13 @@
Processor removeTimedBlock:flushBlock.
flushPending ifFalse:[^ self].
+ access wouldBlock ifTrue:[
+ Processor activeProcessIsSystemProcess ifTrue:[
+ "/ Stderr nextPutAll:'Blocking in Transcript avoided: ' , aString.
+ ^ self
+ ]
+ ].
+
access critical:[
flushPending := false.
outstandingLines size ~~ 0 ifTrue:[
@@ -337,7 +353,12 @@
cr
"output a carriage return, finishing the current line"
- |wasBlocked|
+ access wouldBlock ifTrue:[
+ Processor activeProcessIsSystemProcess ifTrue:[
+ Stderr cr.
+ ^ self
+ ]
+ ].
collecting ifTrue:[
access critical:[
@@ -360,9 +381,15 @@
show:anObject
"insert the argument aString at current cursor position"
- |aString wasBlocked|
+ |aString|
aString := anObject printString.
+ access wouldBlock ifTrue:[
+ Processor activeProcessIsSystemProcess ifTrue:[
+ Stderr nextPutAll:'Blocking in Transcript avoided: ' , aString.
+ ^ self
+ ]
+ ].
collecting ifTrue:[
access critical:[
outstandingLine notNil ifTrue:[
--- a/TextView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/TextView.st Mon Feb 06 01:53:30 1995 +0100
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.13 1994-11-28 21:05:24 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.14 1995-02-06 00:53:24 claus Exp $
'!
!TextView class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.13 1994-11-28 21:05:24 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.14 1995-02-06 00:53:24 claus Exp $
"
!
@@ -82,6 +82,13 @@
searchBox <EnterBox2> box to enter searchpattern
lineNumberBox <EnterBox> box to enter linenumber
selectStyle <Symbol> how words are selected
+
+ StyleSheet parameters:
+
+ textViewBackground defaults to viewBackground
+ textSelectionForegroundColor defaults to textBackgroundColor
+ textSelectionBackgroundColor defaults to textForegroundColor
+ textViewFont defaults to textFont
"
! !
@@ -159,7 +166,7 @@
DefaultViewBackground := StyleSheet colorAt:'textViewBackground' default:White.
DefaultSelectionForegroundColor := StyleSheet colorAt:'textSelectionForegroundColor'.
DefaultSelectionBackgroundColor := StyleSheet colorAt:'textSelectionBackgroundColor'.
- DefaultFont := StyleSheet fontAt:'textFont'.
+ DefaultFont := StyleSheet fontAt:'textViewFont'.
! !
!TextView methodsFor:'initialize & release'!
@@ -534,25 +541,25 @@
text := self selection.
text notNil ifTrue:[
- Smalltalk at:#CopyBuffer put:text.
- self unselect
+ self unselect.
+ self setTextSelection:text
]
!
changeFont
"pop up a fontPanel to change font"
- MyFontPanel isNil ifTrue:[
- MyFontPanel := FontPanel new
- ].
- MyFontPanel action:[:family :face :style :size |
+ |panel|
+
+ panel := FontPanel new.
+ panel action:[:family :face :style :size |
self font:(Font family:family
face:face
style:style
size:size)
].
- MyFontPanel initialFont:font.
- MyFontPanel showAtPointer
+ panel initialFont:font.
+ panel showAtPointer
!
defaultForGotoLine
@@ -923,6 +930,7 @@
|savedCursor|
device beep.
+
"
uncomment if you want a CROSS cursor to be shown for a while ..
"
@@ -1169,6 +1177,10 @@
super redrawVisibleLine:visLine
from:1
to:(selectionStartCol - 1)
+ ] ifFalse:[
+ leftOffset == 0 ifTrue:[
+ self clearMarginOfVisible:visLine with:selectionBgColor.
+ ]
].
self drawVisibleLine:visLine from:selectionStartCol
with:selectionFgColor and:selectionBgColor.
--- a/Toggle.st Mon Feb 06 01:52:01 1995 +0100
+++ b/Toggle.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.10 1995-01-26 16:05:02 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.11 1995-02-06 00:53:28 claus Exp $
'!
!Toggle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.10 1995-01-26 16:05:02 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.11 1995-02-06 00:53:28 claus Exp $
"
!
@@ -217,11 +217,6 @@
!Toggle methodsFor:'initialization'!
-initialize
- super initialize.
- actionWhenPressed := true
-!
-
initStyle
super initStyle.
@@ -238,6 +233,10 @@
lampColor := StyleSheet at:#toggleLampColor default:Color yellow.
lampWidth := (device horizontalPixelPerMillimeter * 1.8) rounded.
lampHeight := (device verticalPixelPerMillimeter * 3.5) rounded.
+!
+
+defaultController
+ ^ ToggleController
! !
!Toggle methodsFor:'accessing'!
@@ -264,7 +263,7 @@
"change the color of the toggle-lamp"
lampColor := aColor.
- (shown and:[showLamp and:[pressed]]) ifTrue:[
+ (shown and:[showLamp and:[controller pressed]]) ifTrue:[
self redraw
]
! !
@@ -298,9 +297,10 @@
"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)"
- |newLevel|
+ |newLevel pressed|
- pressed := pressed not.
+ pressed := controller pressed not.
+ controller pressed:pressed.
pressed ifTrue:[
newLevel := onLevel.
] ifFalse:[
@@ -319,14 +319,14 @@
toggle
"toggle and perform the action"
- |action|
+ |action pressed|
- enabled ifTrue:[
+ controller enabled ifTrue:[
self toggleNoAction.
- pressed ifTrue:[
- action := pressActionBlock
+ (pressed := controller pressed) ifTrue:[
+ action := controller pressAction
] ifFalse:[
- action := releaseActionBlock
+ action := controller releaseAction
].
action notNil ifTrue:[action value].
model notNil ifTrue:[
@@ -337,30 +337,13 @@
]
! !
-!Toggle methodsFor:'event handling'!
-
-buttonPress:button x:x y:y
- ((button == 1) or:[button == #select]) ifTrue:[
- self toggle
- ] ifFalse:[
- ^ super buttonPress:button x:x y:y
- ].
-!
-
-buttonRelease:button x:x y:y
- ((button == 1) or:[button == #select]) ifFalse:[
- ^ super buttonRelease:button x:x y:y
- ].
- "ignore"
-! !
-
!Toggle methodsFor:'redrawing'!
drawWith:fg and:bg
"redraw myself with fg/bg. Use super to draw the label,
drawing of the lamp is done here."
- |x y|
+ |x y clr|
super drawWith:fg and:bg. "this draws the text"
@@ -368,11 +351,12 @@
x := hSpace + margin.
y := (height - lampHeight) // 2.
self drawEdgesForX:x y:y width:lampWidth height:lampHeight level:-1.
- pressed ifTrue:[
- self paint:lampColor.
+ controller pressed ifTrue:[
+ clr := lampColor.
] ifFalse:[
- self paint:bgColor.
+ clr := bgColor.
].
+ self paint:clr.
self fillRectangleX:x+2 y:y+2 width:lampWidth - 4 height:lampHeight - 4
]
! !
--- a/VPanelV.st Mon Feb 06 01:52:01 1995 +0100
+++ b/VPanelV.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.7 1994-11-21 16:45:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.8 1995-02-06 00:53:30 claus Exp $
'!
!VerticalPanelView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.7 1994-11-21 16:45:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.8 1995-02-06 00:53:30 claus Exp $
"
!
@@ -52,7 +52,10 @@
All real work is done in PanelView - except the layout computation is
redefined here.
- The layout is controlled by two instance variables.
+ The layout is controlled the instance variables:
+ horizontalLayout and verticalLayout
+ in addition to horizontalSpace and verticalSpace.
+
The vertical layout can be any of:
#top arrange elements at the top
@@ -61,7 +64,9 @@
#bottomSpace arrange elements at the bottom, start with spacing
#center arrange elements in the center
#spread spread elements evenly
+ #spreadSpace spread elements evenly with spacing at ends
#fit like spread, but resize elements for tight packing
+ #fitSpace like fit, with spacing
the horizontal layout can be:
@@ -71,16 +76,26 @@
#right place it at the right
#rightSpace place it at the right, offset by horizontalSpace
#fit resize elements horizontally to fit this panel
+ #fitSpace like fit, but add spacing
- The defaults is #centered for both directions.
+ The defaults is #center for both directions.
The layout is changed by the messages #verticalLayout: and #horizontalLayout:.
For backward compatibility (to times, where only vLayout existed), the simple
#layout: does the same as #verticalLayout:. 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.
"
!
examples
"
+ These examples demonstrate the effect of different layout
+ settings.
+ You should try more examples, combining spacing and different
+ verticalLayout:/horizontalLayout: combinations.
+
+
example: default layout (centered)
|v p b1 b2 b3|
@@ -110,6 +125,53 @@
v open
+ example: top-layout; horizontal fit
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: top-layout; horizontal fit with space
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: topSpace-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#topSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
example: bottom-layout
|v p b1 b2 b3|
@@ -125,6 +187,21 @@
v open
+ example: bottomSpace-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#bottomSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
example: spread-layout
|v p b1 b2 b3|
@@ -139,6 +216,68 @@
v extent:100 @ 300.
v open
+
+ example: spreadSpace-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#spreadSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: fit-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: fitSpace-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: fully fitSpace
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fitSpace.
+ p horizontalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
example: from top, each at left:
|v p b1 b2 b3|
@@ -154,6 +293,7 @@
v extent:100 @ 300.
v open
+
example: centered, right:
|v p b1 b2 b3|
@@ -169,8 +309,30 @@
v extent:100 @ 300.
v open
- you should try more examples, combining spacing and different
- verticalLayout:/horizontalLayout: combinations.
+
+ example: a panel in a panel
+
+ |v hp p b1 b2 b3|
+
+ v := StandardSystemView new.
+
+ hp := HorizontalPanelView in:v.
+ hp verticalLayout:#fit.
+ hp horizontalLayout:#fitSpace.
+ hp origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+
+ 1 to:3 do:[:i |
+ p := VerticalPanelView in:hp.
+ p borderWidth:0.
+ p verticalLayout:#fitSpace.
+ p horizontalLayout:#fit.
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ ].
+
+ v extent:300 @ 100.
+ v open
"
! !
@@ -288,7 +450,7 @@
sumOfHeights := sumOfHeights + (horizontalSpace * 2).
maxWidth := maxWidth + (horizontalSpace * 2).
].
- vLayout == #fit ifTrue:[
+ (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
sumOfHeights := maxHeight * subViews size.
borderWidth ~~ 0 ifTrue:[
sumOfHeights := sumOfHeights + (verticalSpace * 2).
@@ -300,7 +462,7 @@
((hLayout == #leftSpace) or:[hLayout == #rightSpace]) ifTrue:[
maxWidth := maxWidth + horizontalSpace
] ifFalse:[
- ((hLayout == #fit) or:[hLayout == #center]) ifTrue:[
+ ((hLayout == #fitSpace) or:[hLayout == #center]) ifTrue:[
maxWidth := maxWidth + (horizontalSpace * 2)
]
].
@@ -312,95 +474,108 @@
setChildPositions
"(re)compute position of every child"
- |ypos space sumOfHeights numChilds l hEach|
+ |ypos space sumOfHeights numChilds l hEach hInside|
subViews isNil ifTrue:[^ self].
space := verticalSpace.
numChilds := subViews size.
+ hInside := height - (margin * 2) + (borderWidth*2) - subViews last borderWidth.
- vLayout == #fit ifTrue:[
+ vLayout == #fitSpace ifTrue:[
"
adjust childs extents and set origins.
Be careful to avoid accumulation of rounding errors
"
- hEach := (height - (margin * 2) - (numChilds + 1 * space) + borderWidth) / numChilds.
+ hEach := (hInside - (numChilds + 1 * space)) / numChilds.
ypos := space + margin - borderWidth.
] ifFalse:[
-
- "
- compute net height needed
- "
- sumOfHeights := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child heightIncludingBorder].
-
- l := vLayout.
- ((l == #center) and:[numChilds == 1]) ifTrue:[
- l := #spread
- ].
-
- "
- compute position of topmost subview and space between them;
- if they do hardly fit, leave no space between them
- "
- (sumOfHeights >= (height - (margin * 2))) ifTrue:[
+ vLayout == #fit ifTrue:[
"
- if we have not enough space for all the elements,
- fill them tight, and show what can be shown (at least)
+ adjust childs extents and set origins.
+ Be careful to avoid accumulation of rounding errors
"
- ypos := 0.
- space := 0
+ hEach := (hInside - (numChilds - 1 * space)) / numChilds.
+ ypos := margin - borderWidth.
] ifFalse:[
- ((l == #bottom) or:[l == #bottomSpace]) ifTrue:[
- ypos := height - (space * numChilds) - sumOfHeights.
- "
- borderWidth == 0 ifTrue:[
- ypos := ypos + space
- ].
- "
- l == #bottomSpace ifTrue:[
- ypos > space ifTrue:[
- ypos := ypos - space
- ]
- ].
+ "
+ compute net height needed
+ "
+ sumOfHeights := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child heightIncludingBorder].
+
+ l := vLayout.
+ ((l == #center) and:[numChilds == 1]) ifTrue:[
+ l := #spread
+ ].
+ (l == #spread and:[numChilds == 1]) ifTrue:[
+ l := #spreadSpace
+ ].
- ypos < 0 ifTrue:[
- space := space min:(height - sumOfHeights) // (numChilds + 1).
- ypos := height - (space * numChilds) - sumOfHeights.
- ]
- ] ifFalse: [
- (l == #spread) ifTrue:[
- space := (height - sumOfHeights) // (numChilds + 1).
- ypos := space.
- (space == 0) ifTrue:[
- ypos := (height - sumOfHeights) // 2
+ "
+ compute position of topmost subview and space between them;
+ if they do hardly fit, leave no space between them
+ "
+ (sumOfHeights >= (height - (margin * 2))) ifTrue:[
+ "
+ if we have not enough space for all the elements,
+ fill them tight, and show what can be shown (at least)
+ "
+ ypos := 0.
+ space := 0
+ ] ifFalse:[
+ ((l == #bottom) or:[l == #bottomSpace]) ifTrue:[
+ ypos := height - (space * (numChilds - 1)) - sumOfHeights.
+ "
+ borderWidth == 0 ifTrue:[
+ ypos := ypos + space
+ ].
+ "
+ l == #bottomSpace ifTrue:[
+ ypos >= space ifTrue:[
+ ypos := ypos - space
+ ]
+ ].
+
+ ypos < 0 ifTrue:[
+ space := space min:(height - sumOfHeights) // (numChilds + 1).
+ ypos := height - (space * numChilds) - sumOfHeights.
]
] ifFalse: [
- ((l == #top) or:[l == #topSpace]) ifTrue:[
- "
- borderWidth == 0 ifTrue:[
- ypos := 0
- ] ifFalse:[
- ypos := verticalSpace
- ].
- "
- space := space min:(height - sumOfHeights) // (numChilds + 1).
- l == #topSpace ifTrue:[
- ypos := space.
+ (l == #spread) ifTrue:[
+ space := (height - sumOfHeights) // (numChilds - 1).
+ ypos := 0.
+ (space == 0) ifTrue:[
+ ypos := (height - sumOfHeights) // 2
+ ]
+ ] ifFalse: [
+ (l == #spreadSpace) ifTrue:[
+ space := (height - sumOfHeights) // (numChilds + 1).
+ ypos := space.
+ (space == 0) ifTrue:[
+ ypos := (height - sumOfHeights) // 2
+ ]
+ ] ifFalse: [
+ ((l == #top) or:[l == #topSpace]) ifTrue:[
+ space := space min:(height - sumOfHeights) // (numChilds + 1).
+ l == #topSpace ifTrue:[
+ ypos := space.
+ ] ifFalse:[
+ ypos := 0
+ ]
] ifFalse:[
- ypos := 0
+ "center"
+ ypos := (height - (sumOfHeights
+ + ((numChilds - 1) * space))) // 2.
+ ypos < 0 ifTrue:[
+ space := (height - sumOfHeights) // (numChilds + 1).
+ ypos := (height - (sumOfHeights
+ + ((numChilds - 1) * space))) // 2.
+ ]
]
- ] ifFalse:[
- "center"
- ypos := (height - (sumOfHeights
- + ((numChilds - 1) * space))) // 2.
- ypos < 0 ifTrue:[
- space := (height - sumOfHeights) // (numChilds + 1).
- ypos := (height - (sumOfHeights
- + ((numChilds - 1) * space))) // 2.
- ]
+ ]
]
]
- ]
+ ].
].
].
@@ -422,12 +597,17 @@
hLayout == #rightSpace ifTrue:[
xpos := width - horizontalSpace - child widthIncludingBorder.
] ifFalse:[
- hLayout == #fit ifTrue:[
+ hLayout == #fitSpace ifTrue:[
xpos := horizontalSpace.
child width:(width - (horizontalSpace + child borderWidth * 2))
] ifFalse:[
- "centered"
- xpos := (width - child widthIncludingBorder) // 2.
+ hLayout == #fit ifTrue:[
+ xpos := 0.
+ child width:(width - (child borderWidth * 2))
+ ] ifFalse:[
+ "centered"
+ xpos := (width - child widthIncludingBorder) // 2.
+ ]
]
]
]
@@ -435,11 +615,11 @@
].
(xpos < 0) ifTrue:[ xpos := 0 ].
- vLayout == #fit ifTrue:[
+ (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
child origin:(xpos @ ypos rounded)
corner:(xpos + (child width))
@ (ypos + hEach - (child borderWidth)) rounded.
- ypos := ypos + hEach + "(child borderWidth * 2) +" space
+ ypos := ypos + hEach + space
] ifFalse:[
child origin:(xpos@ypos).
ypos := ypos + (child heightIncludingBorder) + space
--- a/VerticalPanelView.st Mon Feb 06 01:52:01 1995 +0100
+++ b/VerticalPanelView.st Mon Feb 06 01:53:30 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.7 1994-11-21 16:45:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.8 1995-02-06 00:53:30 claus Exp $
'!
!VerticalPanelView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.7 1994-11-21 16:45:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.8 1995-02-06 00:53:30 claus Exp $
"
!
@@ -52,7 +52,10 @@
All real work is done in PanelView - except the layout computation is
redefined here.
- The layout is controlled by two instance variables.
+ The layout is controlled the instance variables:
+ horizontalLayout and verticalLayout
+ in addition to horizontalSpace and verticalSpace.
+
The vertical layout can be any of:
#top arrange elements at the top
@@ -61,7 +64,9 @@
#bottomSpace arrange elements at the bottom, start with spacing
#center arrange elements in the center
#spread spread elements evenly
+ #spreadSpace spread elements evenly with spacing at ends
#fit like spread, but resize elements for tight packing
+ #fitSpace like fit, with spacing
the horizontal layout can be:
@@ -71,16 +76,26 @@
#right place it at the right
#rightSpace place it at the right, offset by horizontalSpace
#fit resize elements horizontally to fit this panel
+ #fitSpace like fit, but add spacing
- The defaults is #centered for both directions.
+ The defaults is #center for both directions.
The layout is changed by the messages #verticalLayout: and #horizontalLayout:.
For backward compatibility (to times, where only vLayout existed), the simple
#layout: does the same as #verticalLayout:. 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.
"
!
examples
"
+ These examples demonstrate the effect of different layout
+ settings.
+ You should try more examples, combining spacing and different
+ verticalLayout:/horizontalLayout: combinations.
+
+
example: default layout (centered)
|v p b1 b2 b3|
@@ -110,6 +125,53 @@
v open
+ example: top-layout; horizontal fit
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: top-layout; horizontal fit with space
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#top.
+ p horizontalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: topSpace-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#topSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
example: bottom-layout
|v p b1 b2 b3|
@@ -125,6 +187,21 @@
v open
+ example: bottomSpace-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#bottomSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
example: spread-layout
|v p b1 b2 b3|
@@ -139,6 +216,68 @@
v extent:100 @ 300.
v open
+
+ example: spreadSpace-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#spreadSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: fit-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fit.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: fitSpace-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: fully fitSpace
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p verticalLayout:#fitSpace.
+ p horizontalLayout:#fitSpace.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
example: from top, each at left:
|v p b1 b2 b3|
@@ -154,6 +293,7 @@
v extent:100 @ 300.
v open
+
example: centered, right:
|v p b1 b2 b3|
@@ -169,8 +309,30 @@
v extent:100 @ 300.
v open
- you should try more examples, combining spacing and different
- verticalLayout:/horizontalLayout: combinations.
+
+ example: a panel in a panel
+
+ |v hp p b1 b2 b3|
+
+ v := StandardSystemView new.
+
+ hp := HorizontalPanelView in:v.
+ hp verticalLayout:#fit.
+ hp horizontalLayout:#fitSpace.
+ hp origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+
+ 1 to:3 do:[:i |
+ p := VerticalPanelView in:hp.
+ p borderWidth:0.
+ p verticalLayout:#fitSpace.
+ p horizontalLayout:#fit.
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ ].
+
+ v extent:300 @ 100.
+ v open
"
! !
@@ -288,7 +450,7 @@
sumOfHeights := sumOfHeights + (horizontalSpace * 2).
maxWidth := maxWidth + (horizontalSpace * 2).
].
- vLayout == #fit ifTrue:[
+ (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
sumOfHeights := maxHeight * subViews size.
borderWidth ~~ 0 ifTrue:[
sumOfHeights := sumOfHeights + (verticalSpace * 2).
@@ -300,7 +462,7 @@
((hLayout == #leftSpace) or:[hLayout == #rightSpace]) ifTrue:[
maxWidth := maxWidth + horizontalSpace
] ifFalse:[
- ((hLayout == #fit) or:[hLayout == #center]) ifTrue:[
+ ((hLayout == #fitSpace) or:[hLayout == #center]) ifTrue:[
maxWidth := maxWidth + (horizontalSpace * 2)
]
].
@@ -312,95 +474,108 @@
setChildPositions
"(re)compute position of every child"
- |ypos space sumOfHeights numChilds l hEach|
+ |ypos space sumOfHeights numChilds l hEach hInside|
subViews isNil ifTrue:[^ self].
space := verticalSpace.
numChilds := subViews size.
+ hInside := height - (margin * 2) + (borderWidth*2) - subViews last borderWidth.
- vLayout == #fit ifTrue:[
+ vLayout == #fitSpace ifTrue:[
"
adjust childs extents and set origins.
Be careful to avoid accumulation of rounding errors
"
- hEach := (height - (margin * 2) - (numChilds + 1 * space) + borderWidth) / numChilds.
+ hEach := (hInside - (numChilds + 1 * space)) / numChilds.
ypos := space + margin - borderWidth.
] ifFalse:[
-
- "
- compute net height needed
- "
- sumOfHeights := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child heightIncludingBorder].
-
- l := vLayout.
- ((l == #center) and:[numChilds == 1]) ifTrue:[
- l := #spread
- ].
-
- "
- compute position of topmost subview and space between them;
- if they do hardly fit, leave no space between them
- "
- (sumOfHeights >= (height - (margin * 2))) ifTrue:[
+ vLayout == #fit ifTrue:[
"
- if we have not enough space for all the elements,
- fill them tight, and show what can be shown (at least)
+ adjust childs extents and set origins.
+ Be careful to avoid accumulation of rounding errors
"
- ypos := 0.
- space := 0
+ hEach := (hInside - (numChilds - 1 * space)) / numChilds.
+ ypos := margin - borderWidth.
] ifFalse:[
- ((l == #bottom) or:[l == #bottomSpace]) ifTrue:[
- ypos := height - (space * numChilds) - sumOfHeights.
- "
- borderWidth == 0 ifTrue:[
- ypos := ypos + space
- ].
- "
- l == #bottomSpace ifTrue:[
- ypos > space ifTrue:[
- ypos := ypos - space
- ]
- ].
+ "
+ compute net height needed
+ "
+ sumOfHeights := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child heightIncludingBorder].
+
+ l := vLayout.
+ ((l == #center) and:[numChilds == 1]) ifTrue:[
+ l := #spread
+ ].
+ (l == #spread and:[numChilds == 1]) ifTrue:[
+ l := #spreadSpace
+ ].
- ypos < 0 ifTrue:[
- space := space min:(height - sumOfHeights) // (numChilds + 1).
- ypos := height - (space * numChilds) - sumOfHeights.
- ]
- ] ifFalse: [
- (l == #spread) ifTrue:[
- space := (height - sumOfHeights) // (numChilds + 1).
- ypos := space.
- (space == 0) ifTrue:[
- ypos := (height - sumOfHeights) // 2
+ "
+ compute position of topmost subview and space between them;
+ if they do hardly fit, leave no space between them
+ "
+ (sumOfHeights >= (height - (margin * 2))) ifTrue:[
+ "
+ if we have not enough space for all the elements,
+ fill them tight, and show what can be shown (at least)
+ "
+ ypos := 0.
+ space := 0
+ ] ifFalse:[
+ ((l == #bottom) or:[l == #bottomSpace]) ifTrue:[
+ ypos := height - (space * (numChilds - 1)) - sumOfHeights.
+ "
+ borderWidth == 0 ifTrue:[
+ ypos := ypos + space
+ ].
+ "
+ l == #bottomSpace ifTrue:[
+ ypos >= space ifTrue:[
+ ypos := ypos - space
+ ]
+ ].
+
+ ypos < 0 ifTrue:[
+ space := space min:(height - sumOfHeights) // (numChilds + 1).
+ ypos := height - (space * numChilds) - sumOfHeights.
]
] ifFalse: [
- ((l == #top) or:[l == #topSpace]) ifTrue:[
- "
- borderWidth == 0 ifTrue:[
- ypos := 0
- ] ifFalse:[
- ypos := verticalSpace
- ].
- "
- space := space min:(height - sumOfHeights) // (numChilds + 1).
- l == #topSpace ifTrue:[
- ypos := space.
+ (l == #spread) ifTrue:[
+ space := (height - sumOfHeights) // (numChilds - 1).
+ ypos := 0.
+ (space == 0) ifTrue:[
+ ypos := (height - sumOfHeights) // 2
+ ]
+ ] ifFalse: [
+ (l == #spreadSpace) ifTrue:[
+ space := (height - sumOfHeights) // (numChilds + 1).
+ ypos := space.
+ (space == 0) ifTrue:[
+ ypos := (height - sumOfHeights) // 2
+ ]
+ ] ifFalse: [
+ ((l == #top) or:[l == #topSpace]) ifTrue:[
+ space := space min:(height - sumOfHeights) // (numChilds + 1).
+ l == #topSpace ifTrue:[
+ ypos := space.
+ ] ifFalse:[
+ ypos := 0
+ ]
] ifFalse:[
- ypos := 0
+ "center"
+ ypos := (height - (sumOfHeights
+ + ((numChilds - 1) * space))) // 2.
+ ypos < 0 ifTrue:[
+ space := (height - sumOfHeights) // (numChilds + 1).
+ ypos := (height - (sumOfHeights
+ + ((numChilds - 1) * space))) // 2.
+ ]
]
- ] ifFalse:[
- "center"
- ypos := (height - (sumOfHeights
- + ((numChilds - 1) * space))) // 2.
- ypos < 0 ifTrue:[
- space := (height - sumOfHeights) // (numChilds + 1).
- ypos := (height - (sumOfHeights
- + ((numChilds - 1) * space))) // 2.
- ]
+ ]
]
]
- ]
+ ].
].
].
@@ -422,12 +597,17 @@
hLayout == #rightSpace ifTrue:[
xpos := width - horizontalSpace - child widthIncludingBorder.
] ifFalse:[
- hLayout == #fit ifTrue:[
+ hLayout == #fitSpace ifTrue:[
xpos := horizontalSpace.
child width:(width - (horizontalSpace + child borderWidth * 2))
] ifFalse:[
- "centered"
- xpos := (width - child widthIncludingBorder) // 2.
+ hLayout == #fit ifTrue:[
+ xpos := 0.
+ child width:(width - (child borderWidth * 2))
+ ] ifFalse:[
+ "centered"
+ xpos := (width - child widthIncludingBorder) // 2.
+ ]
]
]
]
@@ -435,11 +615,11 @@
].
(xpos < 0) ifTrue:[ xpos := 0 ].
- vLayout == #fit ifTrue:[
+ (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
child origin:(xpos @ ypos rounded)
corner:(xpos + (child width))
@ (ypos + hEach - (child borderWidth)) rounded.
- ypos := ypos + hEach + "(child borderWidth * 2) +" space
+ ypos := ypos + hEach + space
] ifFalse:[
child origin:(xpos@ypos).
ypos := ypos + (child heightIncludingBorder) + space