--- a/ArrButton.st Mon Oct 10 04:03:47 1994 +0100
+++ b/ArrButton.st Fri Oct 28 04:25:37 1994 +0100
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.6 1994-10-10 03:00:32 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.7 1994-10-28 03:24:39 claus Exp $
'!
!ArrowButton class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.6 1994-10-10 03:00:32 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.7 1994-10-28 03:24:39 claus Exp $
"
!
@@ -148,23 +148,15 @@
!ArrowButton class methodsFor:'defaults'!
updateStyleCache
- |nm|
-
DefaultArrowStyle := StyleSheet at:'arrowButtonStyle' default:StyleSheet name.
DefaultArrowStyle := DefaultArrowStyle asSymbol.
- DefaultBackgroundColor := StyleSheet at:'arrowButtonBackgroundColor'.
- DefaultForegroundColor := StyleSheet at:'arrowButtonForegroundColor'.
- DefaultActiveBackgroundColor := StyleSheet at:'arrowButtonActiveBackgroundColor'.
- DefaultActiveForegroundColor := StyleSheet at:'arrowButtonActiveForegroundColor'.
- DefaultEnteredBackgroundColor := StyleSheet at:'arrowButtonEnteredBackgroundColor'.
- DefaultEnteredForegroundColor := StyleSheet at:'arrowButtonEnteredForegroundColor'.
- DefaultBackgroundColor notNil ifTrue:[DefaultBackgroundColor := DefaultBackgroundColor on:Display].
- DefaultForegroundColor notNil ifTrue:[DefaultForegroundColor := DefaultForegroundColor on:Display].
- DefaultActiveBackgroundColor notNil ifTrue:[DefaultActiveBackgroundColor := DefaultActiveBackgroundColor on:Display].
- DefaultActiveForegroundColor notNil ifTrue:[DefaultActiveForegroundColor := DefaultActiveForegroundColor on:Display].
- DefaultEnteredBackgroundColor notNil ifTrue:[DefaultEnteredBackgroundColor := DefaultEnteredBackgroundColor on:Display].
- DefaultEnteredForegroundColor notNil ifTrue:[DefaultEnteredForegroundColor := DefaultEnteredForegroundColor on:Display].
+ DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.
+ DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.
+ DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.
+ DefaultActiveForegroundColor := StyleSheet colorAt:'arrowButtonActiveForegroundColor'.
+ DefaultEnteredBackgroundColor := StyleSheet colorAt:'arrowButtonEnteredBackgroundColor'.
+ DefaultEnteredForegroundColor := StyleSheet colorAt:'arrowButtonEnteredForegroundColor'.
DownArrowForm := nil.
UpArrowForm := nil.
@@ -175,6 +167,10 @@
DownArrowFormFile := StyleSheet at:'arrowButtonDownFormFile' default:'ScrollDn.xbm'.
LeftArrowFormFile := StyleSheet at:'arrowButtonLeftFormFile' default:'ScrollLt.xbm'.
RightArrowFormFile := StyleSheet at:'arrowButtonRightFormFile' default:'ScrollRt.xbm'.
+
+ "
+ self updateStyleCache
+ "
!
upArrowButtonForm:style on:aDevice
@@ -518,8 +514,12 @@
initStyle
super initStyle.
- DefaultBackgroundColor notNil ifTrue:[bgColor := DefaultBackgroundColor on:device].
- DefaultForegroundColor notNil ifTrue:[fgColor := DefaultForegroundColor on:device].
+ DefaultBackgroundColor notNil ifTrue:[
+ bgColor := DefaultBackgroundColor on:device
+ ].
+ DefaultForegroundColor notNil ifTrue:[
+ fgColor := DefaultForegroundColor on:device
+ ].
DefaultActiveForegroundColor notNil ifTrue:[
activeFgColor := DefaultActiveForegroundColor on:device
].
@@ -542,8 +542,6 @@
onLevel := 0.
offLevel := 0.
self level:0.
-"/ bgColor := viewBackground.
-"/ fgColor := viewBackground.
]
! !
@@ -552,7 +550,7 @@
drawWith:fg and:bg
"this is a q&d hack for motif ..."
- |topLeft botRight deep noColor allColor|
+ |topLeft botRight noColor allColor|
arrowStyle ~~ #motif ifTrue:[
^ super drawWith:fg and:bg.
@@ -562,7 +560,8 @@
the code below does a lot of bitmap drawing, but allows
to 3D-ify any logo (it draws it displaced by some pixels
to the upper left in one-color and displaced to the
- lower right in the other Color)
+ lower right in the other color). It should be rewritten to
+ cache the result for later drawing operations.
"
logo notNil ifTrue:[
shadowColor := shadowColor on:device.
--- a/ArrowButton.st Mon Oct 10 04:03:47 1994 +0100
+++ b/ArrowButton.st Fri Oct 28 04:25:37 1994 +0100
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.6 1994-10-10 03:00:32 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.7 1994-10-28 03:24:39 claus Exp $
'!
!ArrowButton class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.6 1994-10-10 03:00:32 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.7 1994-10-28 03:24:39 claus Exp $
"
!
@@ -148,23 +148,15 @@
!ArrowButton class methodsFor:'defaults'!
updateStyleCache
- |nm|
-
DefaultArrowStyle := StyleSheet at:'arrowButtonStyle' default:StyleSheet name.
DefaultArrowStyle := DefaultArrowStyle asSymbol.
- DefaultBackgroundColor := StyleSheet at:'arrowButtonBackgroundColor'.
- DefaultForegroundColor := StyleSheet at:'arrowButtonForegroundColor'.
- DefaultActiveBackgroundColor := StyleSheet at:'arrowButtonActiveBackgroundColor'.
- DefaultActiveForegroundColor := StyleSheet at:'arrowButtonActiveForegroundColor'.
- DefaultEnteredBackgroundColor := StyleSheet at:'arrowButtonEnteredBackgroundColor'.
- DefaultEnteredForegroundColor := StyleSheet at:'arrowButtonEnteredForegroundColor'.
- DefaultBackgroundColor notNil ifTrue:[DefaultBackgroundColor := DefaultBackgroundColor on:Display].
- DefaultForegroundColor notNil ifTrue:[DefaultForegroundColor := DefaultForegroundColor on:Display].
- DefaultActiveBackgroundColor notNil ifTrue:[DefaultActiveBackgroundColor := DefaultActiveBackgroundColor on:Display].
- DefaultActiveForegroundColor notNil ifTrue:[DefaultActiveForegroundColor := DefaultActiveForegroundColor on:Display].
- DefaultEnteredBackgroundColor notNil ifTrue:[DefaultEnteredBackgroundColor := DefaultEnteredBackgroundColor on:Display].
- DefaultEnteredForegroundColor notNil ifTrue:[DefaultEnteredForegroundColor := DefaultEnteredForegroundColor on:Display].
+ DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.
+ DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.
+ DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.
+ DefaultActiveForegroundColor := StyleSheet colorAt:'arrowButtonActiveForegroundColor'.
+ DefaultEnteredBackgroundColor := StyleSheet colorAt:'arrowButtonEnteredBackgroundColor'.
+ DefaultEnteredForegroundColor := StyleSheet colorAt:'arrowButtonEnteredForegroundColor'.
DownArrowForm := nil.
UpArrowForm := nil.
@@ -175,6 +167,10 @@
DownArrowFormFile := StyleSheet at:'arrowButtonDownFormFile' default:'ScrollDn.xbm'.
LeftArrowFormFile := StyleSheet at:'arrowButtonLeftFormFile' default:'ScrollLt.xbm'.
RightArrowFormFile := StyleSheet at:'arrowButtonRightFormFile' default:'ScrollRt.xbm'.
+
+ "
+ self updateStyleCache
+ "
!
upArrowButtonForm:style on:aDevice
@@ -518,8 +514,12 @@
initStyle
super initStyle.
- DefaultBackgroundColor notNil ifTrue:[bgColor := DefaultBackgroundColor on:device].
- DefaultForegroundColor notNil ifTrue:[fgColor := DefaultForegroundColor on:device].
+ DefaultBackgroundColor notNil ifTrue:[
+ bgColor := DefaultBackgroundColor on:device
+ ].
+ DefaultForegroundColor notNil ifTrue:[
+ fgColor := DefaultForegroundColor on:device
+ ].
DefaultActiveForegroundColor notNil ifTrue:[
activeFgColor := DefaultActiveForegroundColor on:device
].
@@ -542,8 +542,6 @@
onLevel := 0.
offLevel := 0.
self level:0.
-"/ bgColor := viewBackground.
-"/ fgColor := viewBackground.
]
! !
@@ -552,7 +550,7 @@
drawWith:fg and:bg
"this is a q&d hack for motif ..."
- |topLeft botRight deep noColor allColor|
+ |topLeft botRight noColor allColor|
arrowStyle ~~ #motif ifTrue:[
^ super drawWith:fg and:bg.
@@ -562,7 +560,8 @@
the code below does a lot of bitmap drawing, but allows
to 3D-ify any logo (it draws it displaced by some pixels
to the upper left in one-color and displaced to the
- lower right in the other Color)
+ lower right in the other color). It should be rewritten to
+ cache the result for later drawing operations.
"
logo notNil ifTrue:[
shadowColor := shadowColor on:device.
--- a/Button.st Mon Oct 10 04:03:47 1994 +0100
+++ b/Button.st Fri Oct 28 04:25:37 1994 +0100
@@ -40,7 +40,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.10 1994-10-10 03:00:38 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.11 1994-10-28 03:24:49 claus Exp $
'!
!Button class methodsFor:'documentation'!
@@ -61,7 +61,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.10 1994-10-10 03:00:38 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.11 1994-10-28 03:24:49 claus Exp $
"
!
@@ -134,29 +134,28 @@
!
updateStyleCache
+ |defaultLevel|
+
StyleSheet is3D ifTrue:[
- DefaultActiveLevel := StyleSheet at:'buttonActiveLevel' default:-1.
- DefaultPassiveLevel := StyleSheet at:'buttonPassiveLevel' default:1.
+ defaultLevel := 1.
] ifFalse:[
- DefaultActiveLevel := StyleSheet at:'buttonActiveLevel' default:0.
- DefaultPassiveLevel := StyleSheet at:'buttonPassiveLevel' default:0.
+ defaultLevel := 0
].
+ DefaultActiveLevel := StyleSheet at:'buttonActiveLevel' default:(defaultLevel negated).
+ DefaultPassiveLevel := StyleSheet at:'buttonPassiveLevel' default:defaultLevel.
+
DefaultSoftEdge := StyleSheet at:'buttonSoftEdge' default:false.
- DefaultFont := StyleSheet at:'buttonFont'.
- DefaultForegroundColor := StyleSheet at:'buttonForegroundColor'.
- DefaultBackgroundColor := StyleSheet at:'buttonBackgroundColor'.
- DefaultDisabledForegroundColor := StyleSheet at:'buttonDisabledForegroundColor' default:Color grey.
- DefaultDisabledBackgroundColor := StyleSheet at:'buttonDisabledBackgroundColor'.
- DefaultEnteredForegroundColor := StyleSheet at:'buttonEnteredForegroundColor'.
- DefaultEnteredBackgroundColor := StyleSheet at:'buttonEnteredBackgroundColor'.
- DefaultActiveForegroundColor := StyleSheet at:'buttonActiveForegroundColor'.
- DefaultActiveBackgroundColor := StyleSheet at:'buttonActiveBackgroundColor'.
+ DefaultFont := StyleSheet fontAt:'buttonFont'.
+ DefaultForegroundColor := StyleSheet colorAt:'buttonForegroundColor'.
+ DefaultBackgroundColor := StyleSheet colorAt:'buttonBackgroundColor'.
+ DefaultDisabledForegroundColor := StyleSheet colorAt:'buttonDisabledForegroundColor' default:Color grey.
+ DefaultDisabledBackgroundColor := StyleSheet colorAt:'buttonDisabledBackgroundColor'.
+ DefaultEnteredForegroundColor := StyleSheet colorAt:'buttonEnteredForegroundColor'.
+ DefaultEnteredBackgroundColor := StyleSheet colorAt:'buttonEnteredBackgroundColor'.
+ DefaultActiveForegroundColor := StyleSheet colorAt:'buttonActiveForegroundColor'.
+ DefaultActiveBackgroundColor := StyleSheet colorAt:'buttonActiveBackgroundColor'.
DefaultReturnButtonHasImage := StyleSheet at:'buttonReturnButtonHasImage' default:true.
DefaultReturnButtonHasBorder := StyleSheet at:'buttonReturnButtonHasBorder' default:false.
- DefaultFont := StyleSheet at:'buttonFont'.
- DefaultFont notNil ifTrue:[
- DefaultFont := DefaultFont on:Display
- ].
!
returnFormOn:aDevice
@@ -437,136 +436,6 @@
].
!
-XXinitStyle
- |hasGreyscales|
-
- super initStyle.
-
- onLevel := -1.
- offLevel := 1.
- softEdge := false.
-
- disabledFgColor := Color grey.
- enteredFgColor := fgColor.
- enteredBgColor := bgColor.
- activeFgColor := activeBgColor := nil.
- enteredFgColor := enteredBgColor := nil.
- halfShadowColor := shadowColor := nil.
-
- shadowColor := Black.
-
- hasGreyscales := device hasGreyscales.
-
- (style == #next) ifTrue:[
- softEdge := true.
- onLevel := 1.
- offLevel := 2.
- hasGreyscales ifTrue:[
- activeFgColor := Black.
- activeBgColor := White.
- enteredFgColor := fgColor.
- enteredBgColor := Color lightGrey.
- halfShadowColor := Color darkGrey.
- ]
- ] ifFalse:[
- (style == #openwin) ifTrue:[
- hasGreyscales ifTrue:[
- activeFgColor := Black.
- activeBgColor := Color grey
- ]
- ] ifFalse:[
- (style == #mswindows) ifTrue:[
- disabledFgColor := Color darkGrey.
- hasGreyscales ifTrue:[
- offLevel := 3.
- onLevel := -1.
- softEdge := true.
- fgColor := Black.
- bgColor := Color lightGrey "Grey".
- halfShadowColor := Color darkGrey.
- activeFgColor := fgColor.
- activeBgColor := bgColor
- ]
- ] ifFalse:[
- (style == #iris) ifTrue:[
- offLevel := 3.
- onLevel := -1.
- softEdge := true.
- halfShadowColor := Color darkGrey.
- disabledFgColor := Color darkGrey.
- enteredFgColor := fgColor.
- hasGreyscales ifTrue:[
- enteredBgColor := bgColor lightened "Color lightGrey".
- activeBgColor := enteredBgColor.
- activeFgColor := enteredFgColor.
- ] ifFalse:[
- enteredBgColor := Color veryLightGrey.
- activeBgColor := Black.
- activeFgColor := White.
- ].
- ] ifFalse:[
- style == #motif ifTrue:[
- offLevel := 2.
- onLevel := -2.
- hasGreyscales ifTrue:[
- activeFgColor := fgColor.
- activeBgColor := bgColor.
- lightColor := Color lightGrey
- ]
- ] ifFalse:[
- style == #st80 ifTrue:[
- hasGreyscales ifTrue:[
- activeFgColor := fgColor.
- activeBgColor := bgColor darkened.
- ] ifFalse:[
- activeFgColor := White.
- activeBgColor := Black
- ]
- ] ifFalse:[
- device hasColors ifTrue:[
- activeFgColor := Color yellow
- ] ifFalse:[
- activeFgColor := White
- ].
- hasGreyscales ifTrue:[
- activeBgColor := bgColor
- ] ifFalse:[
- activeBgColor := Black
- ]
- ]
- ]
- ]
- ]
- ]
- ].
-
- "default for mono-displays and non-3D"
- activeFgColor isNil ifTrue:[
- activeFgColor := bgColor.
- activeBgColor := fgColor
- ].
-"/ enteredFgColor isNil ifTrue:[
-"/ enteredFgColor := fgColor.
-"/ ].
-"/ enteredBgColor isNil ifTrue:[
-"/ enteredBgColor := bgColor.
-"/ ].
-
- self level:offLevel.
- margin := (onLevel abs) max:(offLevel abs).
-
- ((style ~~ #normal) and:[hasGreyscales]) ifTrue:[
- shadowForm := self class returnShadowFormOn:device.
- lightForm := self class returnLightFormOn:device.
- formColor := viewBackground.
- formShadowColor := shadowColor.
- formLightColor := lightColor
- ] ifFalse:[
- shadowForm := self class returnFormOn:device.
- formColor := Black
- ].
-!
-
initCursor
"set up a hand cursor"
--- a/ETxtView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/ETxtView.st Fri Oct 28 04:25:37 1994 +0100
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.15 1994-10-10 03:01:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.16 1994-10-28 03:24:52 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.15 1994-10-10 03:01:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.16 1994-10-28 03:24:52 claus Exp $
"
!
@@ -97,8 +97,8 @@
!EditTextView class methodsFor:'defaults'!
updateStyleCache
- DefaultCursorForegroundColor := StyleSheet at:'textCursorForegroundColor'.
- DefaultCursorBackgroundColor := StyleSheet at:'textCursorBackgroundColor'.
+ DefaultCursorForegroundColor := StyleSheet colorAt:'textCursorForegroundColor'.
+ DefaultCursorBackgroundColor := StyleSheet colorAt:'textCursorBackgroundColor'.
DefaultCursorType := StyleSheet at:'textCursorType' default:#block.
! !
@@ -1822,10 +1822,11 @@
cut
"cut selection into copybuffer"
- |line col history|
-
- lastString := self selection.
- lastString notNil ifTrue:[
+ |line col history sel|
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ lastString := sel.
line := selectionStartLine.
col := selectionStartCol.
undoAction := [self insertLines:lastString atLine:line col:col].
@@ -1851,6 +1852,11 @@
"
self deleteSelection.
lastReplacement := nil
+ ] ifFalse:[
+ "
+ a cut without selection will search&cut again
+ "
+ self again
]
!
@@ -2141,8 +2147,17 @@
searchBwd:pattern
"do the backward search"
+ |startLine startCol|
+
cursorLine isNil ifTrue:[^ self].
- self searchBackwardFor:pattern startingAtLine:(cursorLine min:list size) col:cursorCol
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ startLine := cursorLine min:list size.
+ startCol := cursorCol
+ ].
+ self searchBackwardFor:pattern startingAtLine:startLine col:startCol
ifFound:[:line :col |
self cursorLine:line col:col.
self selectFromLine:line col:col
--- a/EditField.st Mon Oct 10 04:03:47 1994 +0100
+++ b/EditField.st Fri Oct 28 04:25:37 1994 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.8 1994-10-10 03:01:12 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.9 1994-10-28 03:24:56 claus Exp $
'!
!EditField class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.8 1994-10-10 03:01:12 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.9 1994-10-28 03:24:56 claus Exp $
"
!
@@ -68,14 +68,14 @@
!
updateStyleCache
- DefaultForegroundColor := StyleSheet at:'editFieldForegroundColor' default:Black.
- DefaultBackgroundColor := StyleSheet at:'editFieldBackgroundColor' default:White.
- DefaultSelectionForegroundColor := StyleSheet at:'editFieldSelectionForegroundColor' default:DefaultBackgroundColor.
- DefaultSelectionBackgroundColor := StyleSheet at:'editFieldSelectionBackgroundColor' default:DefaultForegroundColor.
- DefaultFont := StyleSheet at:'editFieldFont' default:nil.
+ DefaultForegroundColor := StyleSheet colorAt:'editFieldForegroundColor' default:Black.
+ DefaultBackgroundColor := StyleSheet colorAt:'editFieldBackgroundColor' default:White.
+ DefaultSelectionForegroundColor := StyleSheet colorAt:'editFieldSelectionForegroundColor' default:DefaultBackgroundColor.
+ DefaultSelectionBackgroundColor := StyleSheet colorAt:'editFieldSelectionBackgroundColor' default:DefaultForegroundColor.
+ DefaultFont := StyleSheet fontAt:'editFieldFont' default:nil.
"
- EditField updateStyleCache
+ self updateStyleCache
"
! !
--- a/EditTextView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/EditTextView.st Fri Oct 28 04:25:37 1994 +0100
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.15 1994-10-10 03:01:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.16 1994-10-28 03:24:52 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.15 1994-10-10 03:01:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.16 1994-10-28 03:24:52 claus Exp $
"
!
@@ -97,8 +97,8 @@
!EditTextView class methodsFor:'defaults'!
updateStyleCache
- DefaultCursorForegroundColor := StyleSheet at:'textCursorForegroundColor'.
- DefaultCursorBackgroundColor := StyleSheet at:'textCursorBackgroundColor'.
+ DefaultCursorForegroundColor := StyleSheet colorAt:'textCursorForegroundColor'.
+ DefaultCursorBackgroundColor := StyleSheet colorAt:'textCursorBackgroundColor'.
DefaultCursorType := StyleSheet at:'textCursorType' default:#block.
! !
@@ -1822,10 +1822,11 @@
cut
"cut selection into copybuffer"
- |line col history|
-
- lastString := self selection.
- lastString notNil ifTrue:[
+ |line col history sel|
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ lastString := sel.
line := selectionStartLine.
col := selectionStartCol.
undoAction := [self insertLines:lastString atLine:line col:col].
@@ -1851,6 +1852,11 @@
"
self deleteSelection.
lastReplacement := nil
+ ] ifFalse:[
+ "
+ a cut without selection will search&cut again
+ "
+ self again
]
!
@@ -2141,8 +2147,17 @@
searchBwd:pattern
"do the backward search"
+ |startLine startCol|
+
cursorLine isNil ifTrue:[^ self].
- self searchBackwardFor:pattern startingAtLine:(cursorLine min:list size) col:cursorCol
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ startLine := cursorLine min:list size.
+ startCol := cursorCol
+ ].
+ self searchBackwardFor:pattern startingAtLine:startLine col:startCol
ifFound:[:line :col |
self cursorLine:line col:col.
self selectFromLine:line col:col
--- a/EnterBox.st Mon Oct 10 04:03:47 1994 +0100
+++ b/EnterBox.st Fri Oct 28 04:25:37 1994 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.10 1994-10-10 03:01:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.11 1994-10-28 03:25:00 claus Exp $
'!
!EnterBox class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.10 1994-10-10 03:01:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.11 1994-10-28 03:25:00 claus Exp $
"
!
@@ -99,8 +99,7 @@
|box string|
- box := EnterBox new.
- string := box request:'input some string:'.
+ box := EnterBox request:'input some string:'.
string isNil ifTrue:[
Transcript showCr:'no input'
] ifFalse:[
@@ -111,7 +110,7 @@
|string|
- string := EnterBox new request:'input some string:'.
+ string := EnterBox request:'input some string:'.
string isNil ifTrue:[
Transcript showCr:'no input'
] ifFalse:[
@@ -133,7 +132,15 @@
!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'!
@@ -250,6 +257,7 @@
from the mouse pointer. Value returned here makes
okButton appear under the cursor"
+ buttonPanel setChildPositionsIfChanged.
^ (okButton originRelativeTo:self) + (okButton extent // 2)
! !
@@ -275,7 +283,7 @@
!EnterBox methodsFor:'private'!
preferedExtent
- |wWanted hWanted wPanel vs2 nx ny min|
+ |wWanted hWanted wPanel vs2 min|
vs2 := ViewSpacing * 2.
wWanted := (labelField widthIncludingBorder max:enterField preferedExtent x) + vs2.
@@ -435,8 +443,6 @@
update:something with:someArgument from:changedObject
"sent if my enterbox thinks it needs more real-estate ..."
- |ext|
-
changedObject == enterField ifTrue:[
something == #preferedExtent ifTrue:[
self resize
--- a/EnterBox2.st Mon Oct 10 04:03:47 1994 +0100
+++ b/EnterBox2.st Fri Oct 28 04:25:37 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.7 1994-10-10 03:01:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.8 1994-10-28 03:24:58 claus Exp $
'!
!EnterBox2 class methodsFor:'documentation '!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.7 1994-10-10 03:01:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.8 1994-10-28 03:24:58 claus Exp $
"
!
@@ -51,6 +51,8 @@
An EnterBox2 is like an EnterBox but with 2 action buttons.
This is used (for example) in the search-boxes, where two ok-buttons
'find-previous' and 'find-next' are needed in addition to the abort button.
+ The protocol is like that of EnterBox, the additional buttons label
+ can be set with 'okText2:aString' and its action with 'action2:aBlock'.
"
! !
@@ -96,6 +98,7 @@
from the mouse pointer. Value returned here makes
okButton appear under the cursor"
+ buttonPanel setChildPositionsIfChanged.
^ (okButton2 originRelativeTo:self) + (okButton2 extent // 2)
! !
--- a/HScrBar.st Mon Oct 10 04:03:47 1994 +0100
+++ b/HScrBar.st Fri Oct 28 04:25:37 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.7 1994-10-10 03:01:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.8 1994-10-28 03:25:04 claus Exp $
'!
!HorizontalScrollBar class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.7 1994-10-10 03:01:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.8 1994-10-28 03:25:04 claus Exp $
"
!
@@ -57,6 +57,8 @@
!HorizontalScrollBar methodsFor:'initialization'!
createElements
+ "private: create my elements"
+
button1 := ArrowButton leftIn:self.
button1 name:'LeftButton'.
button2 := ArrowButton rightIn:self.
@@ -142,24 +144,34 @@
!HorizontalScrollBar methodsFor:'accessing'!
scrollLeftAction
+ "return the action which is performed on scroll-left"
+
^ button1 action
!
scrollLeftAction:aBlock
+ "set the action to be performed on scroll-left"
+
button1 action:aBlock
!
scrollRightAction
+ "return the action which is performed on scroll-right"
+
^ button2 action
!
scrollRightAction:aBlock
+ "set the action to be performed on scroll-right"
+
button2 action:aBlock
! !
!HorizontalScrollBar methodsFor:'events'!
sizeChanged:how
+ "handle changed size - reposition elements"
+
|leftWidth rightWidth thumbWidth leftAndRightWidth bwn sep2
thumbHeight h|
--- a/HorizontalScrollBar.st Mon Oct 10 04:03:47 1994 +0100
+++ b/HorizontalScrollBar.st Fri Oct 28 04:25:37 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.7 1994-10-10 03:01:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.8 1994-10-28 03:25:04 claus Exp $
'!
!HorizontalScrollBar class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.7 1994-10-10 03:01:42 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.8 1994-10-28 03:25:04 claus Exp $
"
!
@@ -57,6 +57,8 @@
!HorizontalScrollBar methodsFor:'initialization'!
createElements
+ "private: create my elements"
+
button1 := ArrowButton leftIn:self.
button1 name:'LeftButton'.
button2 := ArrowButton rightIn:self.
@@ -142,24 +144,34 @@
!HorizontalScrollBar methodsFor:'accessing'!
scrollLeftAction
+ "return the action which is performed on scroll-left"
+
^ button1 action
!
scrollLeftAction:aBlock
+ "set the action to be performed on scroll-left"
+
button1 action:aBlock
!
scrollRightAction
+ "return the action which is performed on scroll-right"
+
^ button2 action
!
scrollRightAction:aBlock
+ "set the action to be performed on scroll-right"
+
button2 action:aBlock
! !
!HorizontalScrollBar methodsFor:'events'!
sizeChanged:how
+ "handle changed size - reposition elements"
+
|leftWidth rightWidth thumbWidth leftAndRightWidth bwn sep2
thumbHeight h|
--- a/InfoBox.st Mon Oct 10 04:03:47 1994 +0100
+++ b/InfoBox.st Fri Oct 28 04:25:37 1994 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/InfoBox.st,v 1.7 1994-10-10 03:01:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/InfoBox.st,v 1.8 1994-10-28 03:25:02 claus Exp $
written Spring/Summer 89 by claus
'!
@@ -126,6 +126,19 @@
|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:'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
+
+ |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
@@ -133,7 +146,7 @@
|aBox|
aBox := InfoBox title:'start printing'.
aBox form:(Image fromFile:'bitmaps/ljet3.xpm').
- aBox formLabel level:-2.
+ aBox formLabel level:2.
aBox okText:'print'.
aBox showAtPointer
"
@@ -223,6 +236,7 @@
from the mouse pointer. Value returned here makes center of
okButton appear under the cursor"
+ buttonPanel setChildPositionsIfChanged.
^ (okButton originRelativeTo:self) + (okButton extent // 2)
! !
@@ -302,11 +316,18 @@
|w h extra|
- w := ViewSpacing + formLabel widthIncludingBorder + ViewSpacing + textLabel width + ViewSpacing.
+ formLabel resize.
+ textLabel resize.
+
+ w := margin +
+ ViewSpacing +
+ formLabel widthIncludingBorder +
+ ViewSpacing + textLabel width + ViewSpacing +
+ margin.
w := w max:(okButton preferedExtent x + (ViewSpacing * 2)).
h := ViewSpacing
+ ((formLabel heightIncludingBorder) max:(textLabel height))
- + ViewSpacing + ViewSpacing
+ + ViewSpacing + ViewSpacing + ViewSpacing + ViewSpacing
+ okButton heightIncludingBorder
+ ViewSpacing.
--- a/Label.st Mon Oct 10 04:03:47 1994 +0100
+++ b/Label.st Fri Oct 28 04:25:37 1994 +0100
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.9 1994-10-10 03:01:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.10 1994-10-28 03:25:05 claus Exp $
'!
!Label class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.9 1994-10-10 03:01:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.10 1994-10-28 03:25:05 claus Exp $
"
!
@@ -116,10 +116,13 @@
!
updateStyleCache
- DefaultForegroundColor := StyleSheet at:'labelForegroundColor' default:Black.
- DefaultBackgroundColor := StyleSheet at:'labelBackgroundColor'.
- DefaultFont := StyleSheet at:'labelFont'.
- DefaultFont notNil ifTrue:[DefaultFont := DefaultFont on:Display]
+ DefaultForegroundColor := StyleSheet colorAt:'labelForegroundColor' default:Black.
+ DefaultBackgroundColor := StyleSheet colorAt:'labelBackgroundColor'.
+ DefaultFont := StyleSheet fontAt:'labelFont'.
+
+ "
+ self updateStyleCache
+ "
! !
!Label class methodsFor:'instance creation'!
--- a/ListView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/ListView.st Fri Oct 28 04:25:37 1994 +0100
@@ -36,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.10 1994-10-10 03:02:06 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.11 1994-10-28 03:25:07 claus Exp $
'!
!ListView class methodsFor:'documentation'!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.10 1994-10-10 03:02:06 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.11 1994-10-28 03:25:07 claus Exp $
"
!
@@ -112,12 +112,9 @@
!ListView class methodsFor:'defaults'!
updateStyleCache
- DefaultForegroundColor := StyleSheet at:'textForegroundColor' default:Black.
- DefaultBackgroundColor := StyleSheet at:'textBackgroundColor' default:White.
- DefaultFont := StyleSheet at:'textFont'.
- DefaultFont notNil ifTrue:[
- DefaultFont := DefaultFont on:Display
- ]
+ DefaultForegroundColor := StyleSheet colorAt:'textForegroundColor' default:Black.
+ DefaultBackgroundColor := StyleSheet colorAt:'textBackgroundColor' default:White.
+ DefaultFont := StyleSheet fontAt:'textFont'.
!
tab4Positions
@@ -386,6 +383,13 @@
self checkForExistingLine:index.
list at:index put:aString.
+ includesNonStrings ifFalse:[
+ includesNonStrings := (aString notNil and:[aString isString not]).
+ ] ifTrue:[
+ (aString isNil or:[aString isString]) ifTrue:[
+ includesNonStrings := (list findFirst:[:l | l notNil and:[l isString not]]) ~~ 0.
+ ]
+ ].
shown ifTrue:[
self redrawLine:index
]
@@ -1144,7 +1148,7 @@
nTabs := line occurrencesOf:(Character tab).
nTabs == 0 ifTrue:[^ line].
- currentMax := 200.
+ currentMax := line size + (nTabs * 7).
tmpString := String new:currentMax.
dstIndex := 1.
line do:[:character |
@@ -1159,6 +1163,9 @@
dstIndex := dstIndex + 1
].
(dstIndex > currentMax) ifTrue:[
+ "
+ this cannot happen with <= 8 tabs
+ "
currentMax := currentMax + currentMax.
nString := String new:currentMax.
nString replaceFrom:1 to:(dstIndex - 1)
@@ -1171,7 +1178,11 @@
- no need to return value of ifTrue:/ifFalse above"
0
].
- ^ tmpString copyTo:(dstIndex - 1)
+ dstIndex := dstIndex - 1.
+ dstIndex == currentMax ifTrue:[
+ ^ tmpString
+ ].
+ ^ tmpString copyTo:dstIndex
!
withTabs:line
@@ -1985,6 +1996,22 @@
!ListView methodsFor:'redrawing'!
+flash
+ "show contents in reverse colors for a moment - to wakeup the user :-)"
+
+ |savFg savBg|
+
+ savFg := fgColor.
+ savBg := bgColor.
+ fgColor := savBg.
+ bgColor := savFg.
+ self redraw.
+ (Delay forSeconds:0.1) wait.
+ fgColor := savFg.
+ bgColor := savBg.
+ self redraw
+!
+
redrawVisibleLine:visLineNr col:col
"redraw single character at col index of visible line"
--- a/MenuView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/MenuView.st Fri Oct 28 04:25:37 1994 +0100
@@ -15,7 +15,7 @@
disabledFgColor onOffFlags subMenus
subMenuShown superMenu checkColor
lineLevel lineInset'
- classVariableNames:'DefaultFont DefaultCheckColor
+ classVariableNames:'DefaultFont DefaultCheckColor DefaultViewBackground
DefaultForegroundColor
DefaultBackgroundColor
DefaultDisabledForegroundColor
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.10 1994-10-10 03:02:14 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.11 1994-10-28 03:25:11 claus Exp $
'!
!MenuView class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.10 1994-10-10 03:02:14 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.11 1994-10-28 03:25:11 claus Exp $
"
!
@@ -97,45 +97,18 @@
!MenuView class methodsFor:'defaults'!
updateStyleCache
- DefaultForegroundColor := StyleSheet at:'menuForegroundColor'.
- DefaultBackgroundColor := StyleSheet at:'menuBackgroundColor'.
- DefaultShadowColor := StyleSheet at:'menuShadowColor'.
- DefaultLightColor := StyleSheet at:'menuLightColor'.
- DefaultHilightForegroundColor := StyleSheet at:'menuHilightForegroundColor'.
- DefaultHilightBackgroundColor := StyleSheet at:'menuHilightBackgroundColor'.
+ DefaultViewBackground := StyleSheet colorAt:'menuViewBackground'.
+ DefaultForegroundColor := StyleSheet colorAt:'menuForegroundColor'.
+ DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
+ DefaultShadowColor := StyleSheet colorAt:'menuShadowColor'.
+ DefaultLightColor := StyleSheet colorAt:'menuLightColor'.
+ DefaultHilightForegroundColor := StyleSheet colorAt:'menuHilightForegroundColor'.
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'menuHilightBackgroundColor'.
DefaultHilightLevel := StyleSheet at:'menuHilightLevel'.
DefaultLineLevel := StyleSheet at:'menuSeparatingLineLevel'.
- DefaultDisabledForegroundColor := StyleSheet at:'menuDisabledForegroundColor' default:Color darkGrey.
- DefaultCheckColor := StyleSheet at:'menuCheckColor'.
- DefaultFont := StyleSheet at:'menuFont'.
-
- DefaultShadowColor notNil ifTrue:[
- DefaultShadowColor := DefaultShadowColor on:Display
- ].
- DefaultLightColor notNil ifTrue:[
- DefaultLightColor := DefaultLightColor on:Display
- ].
- DefaultForegroundColor notNil ifTrue:[
- DefaultForegroundColor := DefaultForegroundColor on:Display
- ].
- DefaultBackgroundColor notNil ifTrue:[
- DefaultBackgroundColor := DefaultBackgroundColor on:Display
- ].
- DefaultHilightForegroundColor notNil ifTrue:[
- DefaultHilightForegroundColor := DefaultHilightForegroundColor on:Display
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- DefaultHilightBackgroundColor := DefaultHilightBackgroundColor on:Display
- ].
- DefaultDisabledForegroundColor notNil ifTrue:[
- DefaultDisabledForegroundColor := DefaultDisabledForegroundColor on:Display
- ].
- DefaultCheckColor notNil ifTrue:[
- DefaultCheckColor := DefaultCheckColor on:Display
- ].
- DefaultFont notNil ifTrue:[
- DefaultFont := DefaultFont on:Display
- ].
+ DefaultDisabledForegroundColor := StyleSheet colorAt:'menuDisabledForegroundColor' default:Color darkGrey.
+ DefaultCheckColor := StyleSheet colorAt:'menuCheckColor'.
+ DefaultFont := StyleSheet fontAt:'menuFont'.
! !
!MenuView class methodsFor:'instance creation'!
@@ -285,8 +258,9 @@
] ifFalse:[
hilightLevel := 0.
].
+
StyleSheet is3D ifTrue:[
- "some 3D style menu - hilight defaults to same"
+ "some 3D style menu - set hilight defaults to same"
DefaultHilightForegroundColor notNil ifTrue:[
hilightFgColor := DefaultHilightForegroundColor on:device
@@ -304,7 +278,7 @@
lineLevel := -1.
]
] ifFalse:[
- "some 2D style menu - hilight defaults to inverse"
+ "some 2D style menu - set hilight defaults to inverse"
DefaultHilightForegroundColor notNil ifTrue:[
hilightFgColor := DefaultHilightForegroundColor on:device
] ifFalse:[
@@ -326,10 +300,7 @@
the following has to be changed to
use the styleSheet too
"
- (style == #normal) ifTrue:[
-"/ lineLevel := 0
- ] ifFalse:[
-"/ lineLevel := -1.
+ (style ~~ #normal) ifTrue:[
"the inset on each side"
style == #motif ifTrue:[
lineInset := 0
@@ -339,34 +310,23 @@
].
(style == #iris) ifTrue:[
device hasGreyscales ifTrue:[
-"/ hilightFgColor := fgColor.
-"/ hilightBgColor := White "bgColor".
-"/ hilightLevel := 1 "2".
lineSpacing := 3
].
-"/ device hasColors ifTrue:[
-"/ checkColor := Color red.
-"/ ].
].
(style == #motif) ifTrue:[
-"/ hilightFgColor := fgColor.
-"/ hilightBgColor := bgColor.
-"/ hilightLevel := 2.
lineSpacing := (2 * hilightLevel)
].
style == #openwin ifTrue:[
"add some space for rounded-hilight area"
self leftMargin:10.
-"/ lineLevel := 1.
].
(style == #st80) ifTrue:[
- viewBackground := White.
-"/ fgColor := Black.
-"/ bgColor := White.
level := 0.
-"/ lineLevel := 0.
lineInset := 0
].
+ DefaultViewBackground notNil ifTrue:[
+ viewBackground := DefaultViewBackground on:device
+ ].
!
initEvents
@@ -517,7 +477,7 @@
] ifFalse:[
idx := list indexOf:aLabelOrSelectorOrNumber ifAbsent:[selectors indexOf:aLabelOrSelectorOrNumber].
].
- (idx between:1 and:list size) ifFalse:[
+ (idx between:0 and:list size) ifFalse:[
"add to end"
^ self addLabel:aLabel selector:aSelector
].
@@ -541,6 +501,49 @@
"
!
+addLabel:aLabel selector:aSelector before:aLabelOrSelectorOrNumber
+ "insert another label/selector pair at some place.
+ Being very friendly here, allowing label-string, selector or numeric
+ index for the argument aLabelOrSelectorOrNumber"
+
+ |idx|
+
+ list isNil ifTrue:[
+ ^ self addLabel:aLabel selector:aSelector
+ ].
+ "
+ be user friendly - allow both label or selector
+ to be passed
+ "
+ aLabelOrSelectorOrNumber isInteger ifTrue:[
+ idx := aLabelOrSelectorOrNumber
+ ] ifFalse:[
+ idx := list indexOf:aLabelOrSelectorOrNumber ifAbsent:[selectors indexOf:aLabelOrSelectorOrNumber].
+ ].
+ (idx between:1 and:list size) ifFalse:[
+ "add to end"
+ ^ self addLabel:aLabel selector:aSelector
+ ].
+
+ list := list asOrderedCollection add:aLabel beforeIndex:idx.
+ selectors := selectors asOrderedCollection add:aSelector beforeIndex:idx.
+ enableFlags := enableFlags asOrderedCollection add:true beforeIndex:idx.
+ subMenus notNil ifTrue:[
+ subMenus := subMenus asOrderedCollection add:nil beforeIndex:idx.
+ ].
+ args notNil ifTrue:[
+ args := args asOrderedCollection add:nil beforeIndex:idx.
+ ].
+ self recomputeSize
+
+ "
+ |v|
+ CodeView new realize.
+ v := CodeView new realize.
+ v middleButtonMenu menuView addLabel:'new entry' selector:#foo before:'paste'.
+ "
+!
+
remove:indexOrName
"remove the label at index"
@@ -821,19 +824,23 @@
"/ device ungrabPointer.
"/ ActiveGrab := nil
"/ ].
-windowGroup notNil ifTrue:[windowGroup processExposeEvents].
- subMenuShown superMenu:self.
-"/ subMenuShown showAt:org.
-"
- realize the submenu in MY windowgroup
-"
-subMenuShown windowGroup:windowGroup.
-subMenuShown windowGroup addTopView:subMenuShown.
-subMenuShown fixSize.
-subMenuShown origin:org.
-subMenuShown makeFullyVisible.
-subMenuShown realize.
-device synchronizeOutput.
+
+ windowGroup notNil ifTrue:[
+ windowGroup processExposeEvents
+ ].
+ subMenuShown notNil ifTrue:[
+ subMenuShown superMenu:self.
+ "
+ realize the submenu in MY windowgroup
+ "
+ subMenuShown windowGroup:windowGroup.
+ subMenuShown windowGroup addTopView:subMenuShown.
+ subMenuShown fixSize.
+ subMenuShown origin:org.
+ subMenuShown makeFullyVisible.
+ subMenuShown realize.
+ device synchronizeOutput.
+ ].
^ self
]
] ifFalse:[
@@ -1204,7 +1211,8 @@
ActiveGrab := nil.
].
(selectors isKindOf:Symbol) ifFalse:[
- selection <= (selectors size) ifTrue:[
+ (selection notNil
+ and:[selection <= selectors size]) ifTrue:[
theSelector := selectors at:selection
]
] ifTrue:[
--- a/ObjView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/ObjView.st Fri Oct 28 04:25:37 1994 +0100
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.9 1994-10-10 03:02:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.10 1994-10-28 03:25:14 claus Exp $
"
!
@@ -246,11 +246,12 @@
"redraw complete View"
shown "realized" ifTrue:[
- gridShown ifTrue:[
- self redrawGrid
- ] ifFalse:[
- self fill:viewBackground
- ].
+"/ gridShown ifTrue:[
+"/ self redrawGrid
+"/ ] ifFalse:[
+"/ self fill:viewBackground
+"/ ].
+self clear.
scaleShown ifTrue:[
self redrawScale
].
@@ -262,6 +263,7 @@
"redraw the grid"
gridPixmap notNil ifTrue:[
+ self clear.
self paint:Black on:White.
self displayOpaqueForm:gridPixmap x:viewOrigin x negated
y:viewOrigin y negated
@@ -417,12 +419,13 @@
visRect := visRect intersect:clipRect
].
self clippedTo:visRect do:[
- gridShown ifTrue:[
- self redrawGrid
- ] ifFalse:[
- self paint:viewBackground.
- self fillRectangle:visRect
- ].
+self clearRectangle:visRect.
+"/ gridShown ifTrue:[
+"/ self redrawGrid
+"/ ] ifFalse:[
+"/ self paint:viewBackground.
+"/ self fillRectangle:visRect
+"/ ].
self redrawObjectsIntersecting:aRectangle
]
]
@@ -441,12 +444,13 @@
].
self clippedTo:vis do:[
- gridShown ifTrue:[
- self redrawGrid
- ] ifFalse:[
- self paint:viewBackground.
- self fillRectangle:vis
- ].
+"/ gridShown ifTrue:[
+"/ self redrawGrid
+"/ ] ifFalse:[
+"/ self paint:viewBackground.
+"/ self fillRectangle:vis
+"/ ].
+self clearRectangle:vis.
self redrawObjectsIntersectingVisible:vis
]
]
@@ -852,32 +856,35 @@
intersects := oldFrame intersects:newFrame.
intersects ifFalse:[
gridShown ifFalse:[
- (objectsIntersectingOldFrame size == 1) ifTrue:[
- (objectsIntersectingNewFrame size == 1) ifTrue:[
- (oldFrame isContainedIn:self clipRect) ifTrue:[
- vx := viewOrigin x.
- vy := viewOrigin y.
- oldLeft := oldFrame left - vx.
- oldTop := oldFrame top - vy.
- newLeft := newFrame left - vx.
- newTop := newFrame top - vy.
- w := oldFrame width.
- h := oldFrame height.
- ((newLeft < width) and:[newTop < height]) ifTrue:[
- ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
- self copyFrom:self x:oldLeft y:oldTop
- toX:newLeft y:newTop
- width:w height:h.
- self waitForExpose
- ]
- ].
- ((oldLeft < width) and:[oldTop < height]) ifTrue:[
- ((oldLeft >= 0) and:[oldTop >= 0]) ifTrue:[
- self fillRectangleX:oldLeft y:oldTop width:w height:h
- with:viewBackground
- ]
- ].
- ^ self
+ transformation isNil ifTrue:[
+ (objectsIntersectingOldFrame size == 1) ifTrue:[
+ (objectsIntersectingNewFrame size == 1) ifTrue:[
+ (oldFrame isContainedIn:self clipRect) ifTrue:[
+ vx := viewOrigin x.
+ vy := viewOrigin y.
+ oldLeft := oldFrame left - vx.
+ oldTop := oldFrame top - vy.
+ newLeft := newFrame left - vx.
+ newTop := newFrame top - vy.
+ w := oldFrame width.
+ h := oldFrame height.
+ ((newLeft < width) and:[newTop < height]) ifTrue:[
+ ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
+ self copyFrom:self x:oldLeft y:oldTop
+ toX:newLeft y:newTop
+ width:w height:h.
+ self waitForExpose
+ ]
+ ].
+ ((oldLeft < width) and:[oldTop < height]) ifTrue:[
+ ((oldLeft >= 0) and:[oldTop >= 0]) ifTrue:[
+ self clearRectangleX:oldLeft y:oldTop width:w height:h.
+ "/ self fillRectangleX:oldLeft y:oldTop width:w height:h
+ "/ with:viewBackground
+ ]
+ ].
+ ^ self
+ ]
]
]
]
@@ -1470,6 +1477,23 @@
!ObjectView methodsFor:'view manipulation'!
+zoom:factor
+ factor isNil ifTrue:[
+ transformation := nil
+ ] ifFalse:[
+ transformation := WindowingTransformation scale:(1 / factor) translation:0.
+ ].
+ gridShown ifTrue:[
+ gridPixmap := nil.
+ self defineGrid.
+ viewBackground := gridPixmap
+ ].
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ]
+!
+
showScale
"show the scale"
@@ -1515,6 +1539,11 @@
mmV := self verticalPixelPerMillimeter.
hires := self horizontalPixelPerInch > 120.
+ transformation notNil ifTrue:[
+ mmH := mmH * transformation scale x.
+ mmV := mmV * transformation scale y
+ ].
+
(scaleMetric == #mm) ifTrue:[
"dots every mm; lines every cm"
bigStepH := mmH * 10.0.
@@ -1536,9 +1565,13 @@
gridW := (self widthOfContentsInMM * mmH + 1) asInteger.
gridH := (self heightOfContentsInMM * mmV + 1) asInteger.
- gridPixmap := Form width:gridW height:gridH depth:(device depth).
- gridPixmap fill:viewBackground.
- gridPixmap paint:Black.
+ gridPixmap := Form width:gridW height:gridH depth:1 ."/ (device depth).
+"/ gridPixmap fill:White.
+"/ gridPixmap paint:Black.
+gridPixmap colorMap:(Array with:Color white
+ with:Color black).
+gridPixmap clear.
+gridPixmap paint:(Color colorId:1).
"draw first row point-by-point"
yp := 0.0.
@@ -1604,11 +1637,13 @@
xp := xp + bigStepH
].
- "
- mark the right-end and bottom of the document
- "
- gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
- gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
+ false ifTrue:[
+ "
+ mark the right-end and bottom of the document
+ "
+ gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
+ gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
+ ].
self cursor:oldCursor
!
@@ -1618,8 +1653,9 @@
gridShown := true.
gridPixmap isNil ifTrue:[
- self defineGrid
+ self defineGrid.
].
+ self viewBackground:gridPixmap.
self redraw
!
@@ -1627,6 +1663,7 @@
"hide the grid"
gridShown := false.
+ self viewBackground:White.
self redraw
!
@@ -1743,9 +1780,12 @@
!
endLineDrag
- "cleanup after line drag; select them"
+ "cleanup after line drag; select them. Find the origin and destination
+ 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|
+ |dragger offs2 top org rootPoint viewId
+ lastViewId destinationId destinationView destinationPoint inMySelf|
rootMotion ifTrue:[
dragger := rootView.
@@ -1763,6 +1803,75 @@
to:dragObject corner-offs2
].
self cursor:oldCursor.
+
+ "check if line drag is into another view"
+ rootMotion ifTrue:[
+ rootPoint := device translatePoint:lastButt
+ from:(self id)
+ to:(rootView id).
+ "search view the drop is in"
+
+ viewId := rootView id.
+ [viewId notNil] whileTrue:[
+ destinationId := device viewIdFromPoint:rootPoint in:viewId.
+ lastViewId := viewId.
+ viewId := destinationId
+ ].
+ destinationView := device viewFromId:lastViewId.
+ destinationId := lastViewId.
+ inMySelf := (destinationView == self).
+ rootMotion := false
+ ] ifFalse:[
+ inMySelf := true
+ ].
+ inMySelf ifTrue:[
+ "a simple line within myself"
+ self lineDragFrom:dragObject origin
+ to:dragObject corner
+ ] ifFalse:[
+ "into another one"
+ destinationPoint := device translatePoint:rootPoint
+ from:(rootView id)
+ to:(destinationView id).
+ destinationView notNil ifTrue:[
+ "
+ move into another smalltalk view
+ "
+ self lineDragFrom:dragObject origin to:destinationPoint in:destinationView
+ ] ifFalse:[
+ "
+ not one of my views
+ "
+ self lineDragFrom:dragObject origin
+ to:destinationPoint
+ inAlienViewId:destinationId
+ ]
+ ].
+ self setDefaultActions.
+ dragObject := nil
+
+!
+
+lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
+ "this is called after a line-drag with rootmotion set
+ to true, IFF the endpoint is in an alien view
+ - should be redefined in subclasses"
+
+ self notify:'cannot connect object in alien view'
+!
+
+lineDragFrom:startPoint to:endPoint
+ "this is called after a line-drag. Nothing is done here.
+ - should be redefined in subclasses"
+
+ ^ self
+!
+
+lineDragFrom:startPoint to:endPoint in:destinationView
+ "this is called after a line-drag crossing view boundaries.
+ - should be redefined in subclasses"
+
+ ^ self notify:'dont know how to connect to external views'
!
selectMore:aPoint
@@ -1876,7 +1985,8 @@
!
endObjectMove
- "cleanup after object move - physically move the object now"
+ "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
viewId destinationView destinationId lastViewId|
--- a/ObjectView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/ObjectView.st Fri Oct 28 04:25:37 1994 +0100
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.9 1994-10-10 03:02:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.10 1994-10-28 03:25:14 claus Exp $
"
!
@@ -246,11 +246,12 @@
"redraw complete View"
shown "realized" ifTrue:[
- gridShown ifTrue:[
- self redrawGrid
- ] ifFalse:[
- self fill:viewBackground
- ].
+"/ gridShown ifTrue:[
+"/ self redrawGrid
+"/ ] ifFalse:[
+"/ self fill:viewBackground
+"/ ].
+self clear.
scaleShown ifTrue:[
self redrawScale
].
@@ -262,6 +263,7 @@
"redraw the grid"
gridPixmap notNil ifTrue:[
+ self clear.
self paint:Black on:White.
self displayOpaqueForm:gridPixmap x:viewOrigin x negated
y:viewOrigin y negated
@@ -417,12 +419,13 @@
visRect := visRect intersect:clipRect
].
self clippedTo:visRect do:[
- gridShown ifTrue:[
- self redrawGrid
- ] ifFalse:[
- self paint:viewBackground.
- self fillRectangle:visRect
- ].
+self clearRectangle:visRect.
+"/ gridShown ifTrue:[
+"/ self redrawGrid
+"/ ] ifFalse:[
+"/ self paint:viewBackground.
+"/ self fillRectangle:visRect
+"/ ].
self redrawObjectsIntersecting:aRectangle
]
]
@@ -441,12 +444,13 @@
].
self clippedTo:vis do:[
- gridShown ifTrue:[
- self redrawGrid
- ] ifFalse:[
- self paint:viewBackground.
- self fillRectangle:vis
- ].
+"/ gridShown ifTrue:[
+"/ self redrawGrid
+"/ ] ifFalse:[
+"/ self paint:viewBackground.
+"/ self fillRectangle:vis
+"/ ].
+self clearRectangle:vis.
self redrawObjectsIntersectingVisible:vis
]
]
@@ -852,32 +856,35 @@
intersects := oldFrame intersects:newFrame.
intersects ifFalse:[
gridShown ifFalse:[
- (objectsIntersectingOldFrame size == 1) ifTrue:[
- (objectsIntersectingNewFrame size == 1) ifTrue:[
- (oldFrame isContainedIn:self clipRect) ifTrue:[
- vx := viewOrigin x.
- vy := viewOrigin y.
- oldLeft := oldFrame left - vx.
- oldTop := oldFrame top - vy.
- newLeft := newFrame left - vx.
- newTop := newFrame top - vy.
- w := oldFrame width.
- h := oldFrame height.
- ((newLeft < width) and:[newTop < height]) ifTrue:[
- ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
- self copyFrom:self x:oldLeft y:oldTop
- toX:newLeft y:newTop
- width:w height:h.
- self waitForExpose
- ]
- ].
- ((oldLeft < width) and:[oldTop < height]) ifTrue:[
- ((oldLeft >= 0) and:[oldTop >= 0]) ifTrue:[
- self fillRectangleX:oldLeft y:oldTop width:w height:h
- with:viewBackground
- ]
- ].
- ^ self
+ transformation isNil ifTrue:[
+ (objectsIntersectingOldFrame size == 1) ifTrue:[
+ (objectsIntersectingNewFrame size == 1) ifTrue:[
+ (oldFrame isContainedIn:self clipRect) ifTrue:[
+ vx := viewOrigin x.
+ vy := viewOrigin y.
+ oldLeft := oldFrame left - vx.
+ oldTop := oldFrame top - vy.
+ newLeft := newFrame left - vx.
+ newTop := newFrame top - vy.
+ w := oldFrame width.
+ h := oldFrame height.
+ ((newLeft < width) and:[newTop < height]) ifTrue:[
+ ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
+ self copyFrom:self x:oldLeft y:oldTop
+ toX:newLeft y:newTop
+ width:w height:h.
+ self waitForExpose
+ ]
+ ].
+ ((oldLeft < width) and:[oldTop < height]) ifTrue:[
+ ((oldLeft >= 0) and:[oldTop >= 0]) ifTrue:[
+ self clearRectangleX:oldLeft y:oldTop width:w height:h.
+ "/ self fillRectangleX:oldLeft y:oldTop width:w height:h
+ "/ with:viewBackground
+ ]
+ ].
+ ^ self
+ ]
]
]
]
@@ -1470,6 +1477,23 @@
!ObjectView methodsFor:'view manipulation'!
+zoom:factor
+ factor isNil ifTrue:[
+ transformation := nil
+ ] ifFalse:[
+ transformation := WindowingTransformation scale:(1 / factor) translation:0.
+ ].
+ gridShown ifTrue:[
+ gridPixmap := nil.
+ self defineGrid.
+ viewBackground := gridPixmap
+ ].
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ]
+!
+
showScale
"show the scale"
@@ -1515,6 +1539,11 @@
mmV := self verticalPixelPerMillimeter.
hires := self horizontalPixelPerInch > 120.
+ transformation notNil ifTrue:[
+ mmH := mmH * transformation scale x.
+ mmV := mmV * transformation scale y
+ ].
+
(scaleMetric == #mm) ifTrue:[
"dots every mm; lines every cm"
bigStepH := mmH * 10.0.
@@ -1536,9 +1565,13 @@
gridW := (self widthOfContentsInMM * mmH + 1) asInteger.
gridH := (self heightOfContentsInMM * mmV + 1) asInteger.
- gridPixmap := Form width:gridW height:gridH depth:(device depth).
- gridPixmap fill:viewBackground.
- gridPixmap paint:Black.
+ gridPixmap := Form width:gridW height:gridH depth:1 ."/ (device depth).
+"/ gridPixmap fill:White.
+"/ gridPixmap paint:Black.
+gridPixmap colorMap:(Array with:Color white
+ with:Color black).
+gridPixmap clear.
+gridPixmap paint:(Color colorId:1).
"draw first row point-by-point"
yp := 0.0.
@@ -1604,11 +1637,13 @@
xp := xp + bigStepH
].
- "
- mark the right-end and bottom of the document
- "
- gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
- gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
+ false ifTrue:[
+ "
+ mark the right-end and bottom of the document
+ "
+ gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
+ gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
+ ].
self cursor:oldCursor
!
@@ -1618,8 +1653,9 @@
gridShown := true.
gridPixmap isNil ifTrue:[
- self defineGrid
+ self defineGrid.
].
+ self viewBackground:gridPixmap.
self redraw
!
@@ -1627,6 +1663,7 @@
"hide the grid"
gridShown := false.
+ self viewBackground:White.
self redraw
!
@@ -1743,9 +1780,12 @@
!
endLineDrag
- "cleanup after line drag; select them"
+ "cleanup after line drag; select them. Find the origin and destination
+ 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|
+ |dragger offs2 top org rootPoint viewId
+ lastViewId destinationId destinationView destinationPoint inMySelf|
rootMotion ifTrue:[
dragger := rootView.
@@ -1763,6 +1803,75 @@
to:dragObject corner-offs2
].
self cursor:oldCursor.
+
+ "check if line drag is into another view"
+ rootMotion ifTrue:[
+ rootPoint := device translatePoint:lastButt
+ from:(self id)
+ to:(rootView id).
+ "search view the drop is in"
+
+ viewId := rootView id.
+ [viewId notNil] whileTrue:[
+ destinationId := device viewIdFromPoint:rootPoint in:viewId.
+ lastViewId := viewId.
+ viewId := destinationId
+ ].
+ destinationView := device viewFromId:lastViewId.
+ destinationId := lastViewId.
+ inMySelf := (destinationView == self).
+ rootMotion := false
+ ] ifFalse:[
+ inMySelf := true
+ ].
+ inMySelf ifTrue:[
+ "a simple line within myself"
+ self lineDragFrom:dragObject origin
+ to:dragObject corner
+ ] ifFalse:[
+ "into another one"
+ destinationPoint := device translatePoint:rootPoint
+ from:(rootView id)
+ to:(destinationView id).
+ destinationView notNil ifTrue:[
+ "
+ move into another smalltalk view
+ "
+ self lineDragFrom:dragObject origin to:destinationPoint in:destinationView
+ ] ifFalse:[
+ "
+ not one of my views
+ "
+ self lineDragFrom:dragObject origin
+ to:destinationPoint
+ inAlienViewId:destinationId
+ ]
+ ].
+ self setDefaultActions.
+ dragObject := nil
+
+!
+
+lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
+ "this is called after a line-drag with rootmotion set
+ to true, IFF the endpoint is in an alien view
+ - should be redefined in subclasses"
+
+ self notify:'cannot connect object in alien view'
+!
+
+lineDragFrom:startPoint to:endPoint
+ "this is called after a line-drag. Nothing is done here.
+ - should be redefined in subclasses"
+
+ ^ self
+!
+
+lineDragFrom:startPoint to:endPoint in:destinationView
+ "this is called after a line-drag crossing view boundaries.
+ - should be redefined in subclasses"
+
+ ^ self notify:'dont know how to connect to external views'
!
selectMore:aPoint
@@ -1876,7 +1985,8 @@
!
endObjectMove
- "cleanup after object move - physically move the object now"
+ "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
viewId destinationView destinationId lastViewId|
--- a/PanelView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/PanelView.st Fri Oct 28 04:25:37 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -19,9 +19,9 @@
PanelView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.5 1994-08-07 13:23:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.6 1994-10-28 03:25:18 claus Exp $
'!
!PanelView class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.5 1994-08-07 13:23:05 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.6 1994-10-28 03:25:18 claus Exp $
"
!
@@ -55,6 +55,14 @@
If you dont like its layout, define a new subclass or use one of
the existing subclasses: HorizontalPanelView and VerticalPanelView.
+
+ PanelViews normally delay the actual positioning/sizing if their elements,
+ until actually displayed. This is useful, if more elements are to
+ be added, to avoid repeated configuration of the elements.
+
+ If you want to query for the relative position of an element BEFORE
+ the view is visible, you have to send #setChildPositionsIfChanged before
+ doing so (otherwise, you may get invalid origins from the subviews).
"
! !
@@ -71,9 +79,23 @@
realize
mustRearrange ifTrue:[
- self setChildPositions
+ self setChildPositions
].
super realize
+!
+
+setChildPositionsIfChanged
+ "set all of my child positions - this is usually delayed,
+ until the panel is actually shown (since we dont know, if more
+ elements are to be added) thus avoiding repositioning the elements
+ over and over. However, sometimes it is nescessary, to force positioning
+ the elements, for example, before querying the relative position of
+ an element."
+
+ mustRearrange ifTrue:[
+ self setChildPositions
+ ].
+
! !
!PanelView methodsFor:'accessing'!
@@ -110,8 +132,8 @@
it may be: #left / #top; #spread; #center or #right / #bottom"
(layout ~~ aSymbol) ifTrue:[
- layout := aSymbol.
- self layoutChanged
+ layout := aSymbol.
+ self layoutChanged
]
!
@@ -140,64 +162,64 @@
sizeChanged:how
super sizeChanged:how.
- self setChildPositions
+ self layoutChanged
! !
!PanelView methodsFor:'private'!
layoutChanged
shown ifTrue:[
- self setChildPositions
+ self setChildPositions
] ifFalse:[
- mustRearrange := true
+ mustRearrange := true
]
!
setChildPositions
"(re)compute position of every child"
- |first xpos ypos maxHeightInRow thisRow fixRow|
+ |first xpos ypos maxHeightInRow thisRow|
subViews notNil ifTrue:[
- xpos := horizontalSpace.
- ypos := verticalSpace.
+ xpos := horizontalSpace.
+ ypos := verticalSpace.
- maxHeightInRow := 0.
- first := true.
- thisRow := OrderedCollection new.
- subViews do:[:child |
- "go to next row, if this subview won't fit"
- first ifFalse: [
- (xpos + child widthIncludingBorder + horizontalSpace) > width
- ifTrue: [
- thisRow notEmpty ifTrue:[
- thisRow do:[:rowElement |
- rowElement heightIncludingBorder < maxHeightInRow ifTrue:[
- rowElement top:(rowElement top + (maxHeightInRow - rowElement heightIncludingBorder))
- ]
- ]
- ].
- ypos := ypos + verticalSpace + maxHeightInRow.
- xpos := horizontalSpace.
- maxHeightInRow := 0.
- thisRow := OrderedCollection new.
- ]
- ].
- thisRow add:child.
- child origin:(xpos@ypos).
- xpos := xpos + (child widthIncludingBorder) + horizontalSpace.
- (maxHeightInRow < (child heightIncludingBorder)) ifTrue:[
- maxHeightInRow := child heightIncludingBorder
- ].
- first := false
- ].
- thisRow notEmpty ifTrue:[
- thisRow do:[:rowElement |
- rowElement heightIncludingBorder < maxHeightInRow ifTrue:[
- rowElement top:(rowElement top + (maxHeightInRow - rowElement heightIncludingBorder))
- ]
- ]
- ].
+ maxHeightInRow := 0.
+ first := true.
+ thisRow := OrderedCollection new.
+ subViews do:[:child |
+ "go to next row, if this subview won't fit"
+ first ifFalse: [
+ (xpos + child widthIncludingBorder + horizontalSpace) > width
+ ifTrue: [
+ thisRow notEmpty ifTrue:[
+ thisRow do:[:rowElement |
+ rowElement heightIncludingBorder < maxHeightInRow ifTrue:[
+ rowElement top:(rowElement top + (maxHeightInRow - rowElement heightIncludingBorder))
+ ]
+ ]
+ ].
+ ypos := ypos + verticalSpace + maxHeightInRow.
+ xpos := horizontalSpace.
+ maxHeightInRow := 0.
+ thisRow := OrderedCollection new.
+ ]
+ ].
+ thisRow add:child.
+ child origin:(xpos@ypos).
+ xpos := xpos + (child widthIncludingBorder) + horizontalSpace.
+ (maxHeightInRow < (child heightIncludingBorder)) ifTrue:[
+ maxHeightInRow := child heightIncludingBorder
+ ].
+ first := false
+ ].
+ thisRow notEmpty ifTrue:[
+ thisRow do:[:rowElement |
+ rowElement heightIncludingBorder < maxHeightInRow ifTrue:[
+ rowElement top:(rowElement top + (maxHeightInRow - rowElement heightIncludingBorder))
+ ]
+ ]
+ ].
].
mustRearrange := false
! !
--- a/PullDMenu.st Mon Oct 10 04:03:47 1994 +0100
+++ b/PullDMenu.st Fri Oct 28 04:25:37 1994 +0100
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.6 1994-10-10 03:02:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.7 1994-10-28 03:25:19 claus Exp $
'!
!PullDownMenu class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.6 1994-10-10 03:02:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.7 1994-10-28 03:25:19 claus Exp $
"
!
@@ -84,35 +84,34 @@
!PullDownMenu class methodsFor:'defaults'!
updateStyleCache
- DefaultViewBackground := StyleSheet at:'pullDownMenuViewBackground'.
- DefaultForegroundColor := StyleSheet at:'pullDownMenuForegroundColor' default:Black.
- DefaultBackgroundColor := StyleSheet at:'pullDownMenuBackgroundColor'.
- DefaultHilightForegroundColor := StyleSheet at:'pullDownMenuHilightForegroundColor'.
- DefaultHilightBackgroundColor := StyleSheet at:'pullDownMenuHilightBackgroundColor'.
- DefaultHilightLevel := StyleSheet at:'pullDownMenuHilightLevel' default:-1.
- DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
- DefaultFont := StyleSheet at:'pullDownMenuFont'.
-
- DefaultForegroundColor notNil ifTrue:[
- DefaultForegroundColor := DefaultForegroundColor on:Display
+ DefaultViewBackground := StyleSheet colorAt:'pullDownMenuViewBackground'.
+ DefaultViewBackground isNil ifTrue:[
+ DefaultViewBackground := StyleSheet colorAt:'menuViewBackground'.
].
- DefaultBackgroundColor notNil ifTrue:[
- DefaultBackgroundColor := DefaultBackgroundColor on:Display
+ DefaultForegroundColor := StyleSheet colorAt:'pullDownMenuForegroundColor'.
+ DefaultForegroundColor isNil ifTrue:[
+ DefaultForegroundColor := StyleSheet colorAt:'menuForegroundColor'.
+ ].
+ DefaultBackgroundColor := StyleSheet colorAt:'pullDownMenuBackgroundColor'.
+ DefaultBackgroundColor isNil ifTrue:[
+ DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
].
- DefaultShadowColor notNil ifTrue:[
- DefaultShadowColor := DefaultShadowColor on:Display
+ DefaultHilightForegroundColor := StyleSheet colorAt:'pullDownMenuHilightForegroundColor'.
+ DefaultHilightForegroundColor isNil ifTrue:[
+ DefaultHilightForegroundColor := StyleSheet colorAt:'menuHilightForegroundColor'.
].
- DefaultLightColor notNil ifTrue:[
- DefaultLightColor := DefaultLightColor on:Display
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'pullDownMenuHilightBackgroundColor'.
+ DefaultHilightBackgroundColor isNil ifTrue:[
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'menuHilightBackgroundColor'.
].
- DefaultHilightForegroundColor notNil ifTrue:[
- DefaultHilightForegroundColor := DefaultHilightForegroundColor on:Display
+ DefaultHilightLevel := StyleSheet at:'pullDownMenuHilightLevel'.
+ DefaultHilightLevel isNil ifTrue:[
+ DefaultHilightLevel := StyleSheet at:'menuHilightLevel' default:0.
].
- DefaultHilightBackgroundColor notNil ifTrue:[
- DefaultHilightBackgroundColor := DefaultHilightBackgroundColor on:Display
- ].
- DefaultFont notNil ifTrue:[
- DefaultFont := DefaultFont on:Display
+ DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
+ DefaultFont := StyleSheet fontAt:'pullDownMenuFont'.
+ DefaultFont isNil ifTrue:[
+ DefaultFont := StyleSheet fontAt:'menuFont'.
].
! !
@@ -139,9 +138,12 @@
showSeparatingLines := false.
DefaultViewBackground notNil ifTrue:[
- viewBackground := DefaultViewBackground
+ viewBackground := DefaultViewBackground on:device
].
+ DefaultFont notNil ifTrue:[
+ font := DefaultFont on:device
+ ].
DefaultForegroundColor notNil ifTrue:[
fgColor := DefaultForegroundColor
] ifFalse:[
--- a/PullDownMenu.st Mon Oct 10 04:03:47 1994 +0100
+++ b/PullDownMenu.st Fri Oct 28 04:25:37 1994 +0100
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.6 1994-10-10 03:02:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.7 1994-10-28 03:25:19 claus Exp $
'!
!PullDownMenu class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.6 1994-10-10 03:02:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.7 1994-10-28 03:25:19 claus Exp $
"
!
@@ -84,35 +84,34 @@
!PullDownMenu class methodsFor:'defaults'!
updateStyleCache
- DefaultViewBackground := StyleSheet at:'pullDownMenuViewBackground'.
- DefaultForegroundColor := StyleSheet at:'pullDownMenuForegroundColor' default:Black.
- DefaultBackgroundColor := StyleSheet at:'pullDownMenuBackgroundColor'.
- DefaultHilightForegroundColor := StyleSheet at:'pullDownMenuHilightForegroundColor'.
- DefaultHilightBackgroundColor := StyleSheet at:'pullDownMenuHilightBackgroundColor'.
- DefaultHilightLevel := StyleSheet at:'pullDownMenuHilightLevel' default:-1.
- DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
- DefaultFont := StyleSheet at:'pullDownMenuFont'.
-
- DefaultForegroundColor notNil ifTrue:[
- DefaultForegroundColor := DefaultForegroundColor on:Display
+ DefaultViewBackground := StyleSheet colorAt:'pullDownMenuViewBackground'.
+ DefaultViewBackground isNil ifTrue:[
+ DefaultViewBackground := StyleSheet colorAt:'menuViewBackground'.
].
- DefaultBackgroundColor notNil ifTrue:[
- DefaultBackgroundColor := DefaultBackgroundColor on:Display
+ DefaultForegroundColor := StyleSheet colorAt:'pullDownMenuForegroundColor'.
+ DefaultForegroundColor isNil ifTrue:[
+ DefaultForegroundColor := StyleSheet colorAt:'menuForegroundColor'.
+ ].
+ DefaultBackgroundColor := StyleSheet colorAt:'pullDownMenuBackgroundColor'.
+ DefaultBackgroundColor isNil ifTrue:[
+ DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
].
- DefaultShadowColor notNil ifTrue:[
- DefaultShadowColor := DefaultShadowColor on:Display
+ DefaultHilightForegroundColor := StyleSheet colorAt:'pullDownMenuHilightForegroundColor'.
+ DefaultHilightForegroundColor isNil ifTrue:[
+ DefaultHilightForegroundColor := StyleSheet colorAt:'menuHilightForegroundColor'.
].
- DefaultLightColor notNil ifTrue:[
- DefaultLightColor := DefaultLightColor on:Display
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'pullDownMenuHilightBackgroundColor'.
+ DefaultHilightBackgroundColor isNil ifTrue:[
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'menuHilightBackgroundColor'.
].
- DefaultHilightForegroundColor notNil ifTrue:[
- DefaultHilightForegroundColor := DefaultHilightForegroundColor on:Display
+ DefaultHilightLevel := StyleSheet at:'pullDownMenuHilightLevel'.
+ DefaultHilightLevel isNil ifTrue:[
+ DefaultHilightLevel := StyleSheet at:'menuHilightLevel' default:0.
].
- DefaultHilightBackgroundColor notNil ifTrue:[
- DefaultHilightBackgroundColor := DefaultHilightBackgroundColor on:Display
- ].
- DefaultFont notNil ifTrue:[
- DefaultFont := DefaultFont on:Display
+ DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
+ DefaultFont := StyleSheet fontAt:'pullDownMenuFont'.
+ DefaultFont isNil ifTrue:[
+ DefaultFont := StyleSheet fontAt:'menuFont'.
].
! !
@@ -139,9 +138,12 @@
showSeparatingLines := false.
DefaultViewBackground notNil ifTrue:[
- viewBackground := DefaultViewBackground
+ viewBackground := DefaultViewBackground on:device
].
+ DefaultFont notNil ifTrue:[
+ font := DefaultFont on:device
+ ].
DefaultForegroundColor notNil ifTrue:[
fgColor := DefaultForegroundColor
] ifFalse:[
--- a/ScrollBar.st Mon Oct 10 04:03:47 1994 +0100
+++ b/ScrollBar.st Fri Oct 28 04:25:37 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.7 1994-10-10 03:02:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.8 1994-10-28 03:25:21 claus Exp $
'!
!ScrollBar class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.7 1994-10-10 03:02:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.8 1994-10-28 03:25:21 claus Exp $
"
!
@@ -88,7 +88,7 @@
initialize
"setup; create the 2 buttons and a scroller"
- |w h upForm downForm clr|
+ |clr|
super initialize.
@@ -101,7 +101,6 @@
button1 borderWidth:borderWidth.
DefaultScrollerBordered ifFalse:[
-"/ StyleSheet name ~= #next ifTrue:[
thumb borderWidth:borderWidth.
].
button2 borderWidth:borderWidth.
--- a/Scroller.st Mon Oct 10 04:03:47 1994 +0100
+++ b/Scroller.st Fri Oct 28 04:25:37 1994 +0100
@@ -37,7 +37,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.8 1994-10-10 03:02:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.9 1994-10-28 03:25:23 claus Exp $
'!
!Scroller class methodsFor:'documentation'!
@@ -58,7 +58,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.8 1994-10-10 03:02:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.9 1994-10-28 03:25:23 claus Exp $
"
!
@@ -116,9 +116,9 @@
!Scroller class methodsFor:'defaults'!
updateStyleCache
- DefaultViewBackground := StyleSheet at:'scrollerViewBackground'.
- DefaultThumbColor := StyleSheet at:'scrollerThumbColor'.
- DefaultThumbFrameColor := StyleSheet at:'scrollerThumbFrameColor'.
+ DefaultViewBackground := StyleSheet colorAt:'scrollerViewBackground'.
+ DefaultThumbColor := StyleSheet colorAt:'scrollerThumbColor'.
+ DefaultThumbFrameColor := StyleSheet colorAt:'scrollerThumbFrameColor'.
DefaultTallyMarks := StyleSheet at:'scrollerNTallyMarks' default:0.
DefaultTallyLevel := 0.
DefaultTallyMarks ~~ 0 ifTrue:[
@@ -130,16 +130,6 @@
DefaultInset := StyleSheet at:'scrollerThumbInset' default:0.
DefaultFixThumbHeight := StyleSheet at:'scrollerThumbFixHeight' default:false.
DefaultSoftEdge := StyleSheet at:'scrollerThumbSoftEdge' default:false.
-
- DefaultViewBackground notNil ifTrue:[
- DefaultViewBackground := DefaultViewBackground on:Display
- ].
- DefaultThumbColor notNil ifTrue:[
- DefaultThumbColor := DefaultThumbColor on:Display
- ].
- DefaultThumbFrameColor notNil ifTrue:[
- DefaultThumbFrameColor := DefaultThumbFrameColor on:Display
- ].
!
handleShadowFormOn:aDisplay
@@ -276,7 +266,7 @@
].
DefaultThumbFrameColor notNil ifTrue:[
- thumbFrameColor := DefaultThumbFrameColor on:device.
+ thumbFrameColor := DefaultThumbFrameColor on:device.
].
StyleSheet name = #next ifTrue:[
--- a/SelListV.st Mon Oct 10 04:03:47 1994 +0100
+++ b/SelListV.st Fri Oct 28 04:25:37 1994 +0100
@@ -36,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.11 1994-10-10 03:03:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.12 1994-10-28 03:25:26 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.11 1994-10-10 03:03:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.12 1994-10-28 03:25:26 claus Exp $
"
!
@@ -78,10 +78,12 @@
Also, to support ST-80 MVC-style use, the model (if nonNil) is notified
by the change mechanism (performs changeSymbol).
- Before actually changing the selection, a checkBlock (if non-nil) is evaluated
- and the select-operation is only done if this returns true. This allows
+ Before actually adding entries to the the selection, a checkBlock (if non-nil) is evaluated
+ passing the number of the entry whch is about to be selected as argument.
+ The select change operation is only done if this returns true. This allows
interception of select, for example to query the user if he/she wants to save
- the old contents before (see uses in SystemBrowser and FileBrowser).
+ the old contents before (see uses in SystemBrowser and FileBrowser), or to
+ disable individual entries.
It is also possible to select entries with the keyboard; use the cursor up/
down keys to select prev/next, Home- and End-keys to select first/last.
@@ -96,6 +98,12 @@
reselects (for example, the SystemBrowsers method-list updates the
source code in this case).
+ Currently, some limited form of line attributes are supported. These
+ are kept in the instance variable lineAttributes.
+ This may change (using mechanisms similar to MultiColListEntry), so
+ be prepared. (dont use attributes, if possible - use MultiColListEntry or
+ subclasses of it).
+
InstanceVariables:
selection <misc> the current selection. nil, a number or collection of numbers
@@ -141,40 +149,18 @@
!SelectionInListView class methodsFor:'defaults'!
updateStyleCache
- DefaultDisabledForegroundColor := StyleSheet at:'selectionDisabledForegroundColor'.
- DefaultHilightForegroundColor := StyleSheet at:'selectionHilightForegroundColor'.
- DefaultHilightBackgroundColor := StyleSheet at:'selectionHilightBackgroundColor'.
- DefaultHilightFrameColor := StyleSheet at:'selectionHilightFrameColor'.
+ DefaultDisabledForegroundColor := StyleSheet colorAt:'selectionDisabledForegroundColor'.
+ DefaultHilightForegroundColor := StyleSheet colorAt:'selectionHilightForegroundColor'.
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'selectionHilightBackgroundColor'.
+ DefaultHilightFrameColor := StyleSheet colorAt:'selectionHilightFrameColor'.
DefaultHilightLevel := StyleSheet at:'selectionHilightLevel' default:0.
DefaultRightArrowStyle := StyleSheet at:'selectionRightArrowStyle'.
DefaultRightArrowLevel := StyleSheet at:'selectionRightArrowLevel'.
- DefaultForegroundColor := StyleSheet at:'selectionForegroundColor'.
- DefaultBackgroundColor := StyleSheet at:'selectionBackgroundColor'.
- DefaultShadowColor := StyleSheet at:'selectionShadowColor'.
- DefaultLightColor := StyleSheet at:'selectionLightColor'.
- DefaultFont := StyleSheet at:'selectionFont'.
- DefaultFont notNil ifTrue:[
- DefaultFont := DefaultFont on:Display
- ].
-
- DefaultHilightForegroundColor notNil ifTrue:[
- DefaultHilightForegroundColor := DefaultHilightForegroundColor on:Display
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- DefaultHilightBackgroundColor := DefaultHilightBackgroundColor on:Display
- ].
- DefaultForegroundColor notNil ifTrue:[
- DefaultForegroundColor := DefaultForegroundColor on:Display
- ].
- DefaultBackgroundColor notNil ifTrue:[
- DefaultBackgroundColor := DefaultBackgroundColor on:Display
- ].
- DefaultShadowColor notNil ifTrue:[
- DefaultShadowColor := DefaultShadowColor on:Display
- ].
- DefaultLightColor notNil ifTrue:[
- DefaultLightColor := DefaultLightColor on:Display
- ].
+ DefaultForegroundColor := StyleSheet colorAt:'selectionForegroundColor'.
+ DefaultBackgroundColor := StyleSheet colorAt:'selectionBackgroundColor'.
+ DefaultShadowColor := StyleSheet colorAt:'selectionShadowColor'.
+ DefaultLightColor := StyleSheet colorAt:'selectionLightColor'.
+ DefaultFont := StyleSheet fontAt:'selectionFont'.
"
self updateStyleCache
@@ -542,9 +528,11 @@
^ nil
!
-attributeAt:index put:aSymbol
- "set a line attribute; currently attributes are:
- #halfIntensity
+attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
+ "set a line attribute;
+ currently supported are:
+ #halfIntensity
+ #disabled
"
(index > list size) ifFalse:[
@@ -555,13 +543,29 @@
listAttributes grow:index
]
].
- aSymbol == (listAttributes at:index) ifFalse:[
- listAttributes at:index put:aSymbol.
+ aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
+ listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
self redrawLine:index
]
]
!
+line:lineNr hasAttribute:aSymbol
+ "return true, if line nr has attribute, aSymbol;
+ currently suppoerted attributes are:
+ #halfIntensity
+ #disabled
+ "
+
+ |attr|
+
+ (lineNr > listAttributes size) ifTrue:[^ false].
+ attr := listAttributes at:lineNr.
+ attr isNil ifTrue:[^ false].
+ attr isSymbol ifTrue:[^ attr == aSymbol].
+ ^ (attr includes:aSymbol)
+!
+
removeIndexWithoutRedraw:lineNr
"delete line - no redraw;
return true, if something was really deleted.
@@ -668,6 +672,10 @@
^ 1
!
+hasSelection
+ ^ selection isNil
+!
+
selectionValue
"return the selection value i.e. the text in the selected line.
For multiple selections a collection containing the entries is returned."
@@ -790,8 +798,8 @@
self redrawElement:aNumber
!
-selectNext
- "select next line or first visible if there is currrently no selection.
+nextAfterSelection
+ "return the number of the next selectable entry after the selection.
Wrap at end."
|next|
@@ -805,14 +813,24 @@
next := selection + 1
].
].
- self selection:next.
- selection isNil ifTrue:[
- self selection:1
- ]
+ (self isValidSelection:next) ifFalse:[
+ next := 1
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next := nil
+ ].
+ ^ next
!
-selectPrevious
- "select previous line or previous visible if there is currently no selection.
+selectNext
+ "select next line or first visible if there is currrently no selection.
+ Wrap at end."
+
+ self selection:(self nextAfterSelection)
+!
+
+previousBeforeSelection
+ "return the number of the previous selectable entry before the selection.
Wrap at beginning."
|prev|
@@ -826,10 +844,20 @@
prev := selection - 1
].
].
- self selection:prev.
- selection isNil ifTrue:[
- self selection:(list size)
- ]
+ (self isValidSelection:prev) ifFalse:[
+ prev := list size
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev := nil
+ ].
+ ^ prev
+!
+
+selectPrevious
+ "select previous line or previous visible if there is currently no selection.
+ Wrap at beginning."
+
+ self selection:(self previouseBeforeSelection).
! !
!SelectionInListView methodsFor:'private'!
@@ -1127,7 +1155,7 @@
Must check, if any is in the selection and handle this case.
Otherwise draw using supers method."
- |listLine fg bg|
+ |listLine fg bg attr|
fg := fgColor.
bg := bgColor.
@@ -1136,8 +1164,16 @@
(self isInSelection:listLine) ifTrue:[
^ self drawVisibleLineSelected:visLineNr
].
- (self attributeAt:listLine) == #halfIntensity ifTrue:[
- fg := halfIntensityFgColor
+ attr := self attributeAt:listLine.
+ attr notNil ifTrue:[
+ (attr == #halfIntensity
+ or:[attr isSymbol not and:[attr includes:#halfIntensity]]) ifTrue:[
+ fg := halfIntensityFgColor
+ ].
+ (attr == #disbled
+ or:[attr isSymbol not and:[attr includes:#disabled]]) ifTrue:[
+ fg := halfIntensityFgColor
+ ]
].
].
^ self drawVisibleLine:visLineNr with:fg and:bg
@@ -1186,11 +1222,12 @@
"
let edge start at left, extending to the full width
XXX: widthOfContents should be cached in ListView
- (instead of recumputing all over)
+ (instead of recomputing all over)
"
wEdge := width-(2 * margin).
+includesNonStrings ifFalse:[
wEdge := wEdge max:(self widthOfContents).
-
+].
self drawEdgesForX:(margin - leftOffset) y:y
width:wEdge height:fontHeight
level:hilightLevel.
@@ -1249,26 +1286,29 @@
^ self
].
(key == #CursorUp) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self key:key select:[self selectPrevious] x:x y:y
+ index := self previousBeforeSelection.
+ (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
+ self key:key select:[self selection:index] x:x y:y
].
^ self
].
(key == #CursorDown) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self key:key select:[self selectNext] x:x y:y
+ index := self nextAfterSelection.
+ (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
+ self key:key select:[self selection:index] x:x y:y
].
^ self
].
(key == #Home) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
+ (selectConditionBlock isNil or:[selectConditionBlock value:1]) ifTrue:[
self key:key select:[self selection:1] x:x y:y
].
^ self
].
(key == #End) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self key:key select:[self selection:list size] x:x y:y
+ index := list size.
+ (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
+ self key:key select:[self selection:index] x:x y:y
].
^ self
].
@@ -1326,22 +1366,27 @@
((button == 1) or:[button == #select]) ifTrue:[
enabled ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- oldSelection := selection.
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue: [
- self selectWithoutScroll:listLineNr
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- actionBlock notNil ifTrue:[actionBlock value:selection].
- "the ST-80 way of doing things"
- model notNil ifTrue:[
- model perform:changeSymbol with:(self selectionValue)
- ]
- ].
- clickLine := listLineNr
- ]
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+ ].
+
+ oldSelection := selection.
+ listLineNr notNil ifTrue: [
+ self selectWithoutScroll:listLineNr
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ actionBlock notNil ifTrue:[actionBlock value:selection].
+ "the ST-80 way of doing things"
+ model notNil ifTrue:[
+ model perform:changeSymbol with:(self selectionValue)
+ ]
+ ].
+ clickLine := listLineNr
]
] ifFalse:[
super buttonPress:button x:x y:y
@@ -1353,29 +1398,33 @@
((button == 1) or:[button == #select]) ifTrue:[
enabled ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- oldSelection := selection copy.
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue: [
- multipleSelectOk ifTrue:[
- (self isInSelection:listLineNr) ifTrue:[
- self removeFromSelection:listLineNr
- ] ifFalse:[
- self addToSelection:listLineNr
- ]
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+ ].
+ oldSelection := selection copy.
+ listLineNr notNil ifTrue: [
+ multipleSelectOk ifTrue:[
+ (self isInSelection:listLineNr) ifTrue:[
+ self removeFromSelection:listLineNr
] ifFalse:[
- self selectWithoutScroll:listLineNr
+ self addToSelection:listLineNr
]
- ].
- (selection ~= oldSelection) ifTrue:[
- actionBlock notNil ifTrue:[actionBlock value:selection].
- "the ST-80 way of doing things"
- (model notNil and:[changeSymbol notNil]) ifTrue:[
- model perform:changeSymbol with:(self selectionValue)
- ]
- ].
- clickLine := listLineNr
- ]
+ ] ifFalse:[
+ self selectWithoutScroll:listLineNr
+ ]
+ ].
+ (selection ~= oldSelection) ifTrue:[
+ actionBlock notNil ifTrue:[actionBlock value:selection].
+ "the ST-80 way of doing things"
+ (model notNil and:[changeSymbol notNil]) ifTrue:[
+ model perform:changeSymbol with:(self selectionValue)
+ ]
+ ].
+ clickLine := listLineNr
]
] ifFalse:[
super buttonShiftPress:button x:x y:y
--- a/SelectionInListView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/SelectionInListView.st Fri Oct 28 04:25:37 1994 +0100
@@ -36,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.11 1994-10-10 03:03:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.12 1994-10-28 03:25:26 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.11 1994-10-10 03:03:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.12 1994-10-28 03:25:26 claus Exp $
"
!
@@ -78,10 +78,12 @@
Also, to support ST-80 MVC-style use, the model (if nonNil) is notified
by the change mechanism (performs changeSymbol).
- Before actually changing the selection, a checkBlock (if non-nil) is evaluated
- and the select-operation is only done if this returns true. This allows
+ Before actually adding entries to the the selection, a checkBlock (if non-nil) is evaluated
+ passing the number of the entry whch is about to be selected as argument.
+ The select change operation is only done if this returns true. This allows
interception of select, for example to query the user if he/she wants to save
- the old contents before (see uses in SystemBrowser and FileBrowser).
+ the old contents before (see uses in SystemBrowser and FileBrowser), or to
+ disable individual entries.
It is also possible to select entries with the keyboard; use the cursor up/
down keys to select prev/next, Home- and End-keys to select first/last.
@@ -96,6 +98,12 @@
reselects (for example, the SystemBrowsers method-list updates the
source code in this case).
+ Currently, some limited form of line attributes are supported. These
+ are kept in the instance variable lineAttributes.
+ This may change (using mechanisms similar to MultiColListEntry), so
+ be prepared. (dont use attributes, if possible - use MultiColListEntry or
+ subclasses of it).
+
InstanceVariables:
selection <misc> the current selection. nil, a number or collection of numbers
@@ -141,40 +149,18 @@
!SelectionInListView class methodsFor:'defaults'!
updateStyleCache
- DefaultDisabledForegroundColor := StyleSheet at:'selectionDisabledForegroundColor'.
- DefaultHilightForegroundColor := StyleSheet at:'selectionHilightForegroundColor'.
- DefaultHilightBackgroundColor := StyleSheet at:'selectionHilightBackgroundColor'.
- DefaultHilightFrameColor := StyleSheet at:'selectionHilightFrameColor'.
+ DefaultDisabledForegroundColor := StyleSheet colorAt:'selectionDisabledForegroundColor'.
+ DefaultHilightForegroundColor := StyleSheet colorAt:'selectionHilightForegroundColor'.
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'selectionHilightBackgroundColor'.
+ DefaultHilightFrameColor := StyleSheet colorAt:'selectionHilightFrameColor'.
DefaultHilightLevel := StyleSheet at:'selectionHilightLevel' default:0.
DefaultRightArrowStyle := StyleSheet at:'selectionRightArrowStyle'.
DefaultRightArrowLevel := StyleSheet at:'selectionRightArrowLevel'.
- DefaultForegroundColor := StyleSheet at:'selectionForegroundColor'.
- DefaultBackgroundColor := StyleSheet at:'selectionBackgroundColor'.
- DefaultShadowColor := StyleSheet at:'selectionShadowColor'.
- DefaultLightColor := StyleSheet at:'selectionLightColor'.
- DefaultFont := StyleSheet at:'selectionFont'.
- DefaultFont notNil ifTrue:[
- DefaultFont := DefaultFont on:Display
- ].
-
- DefaultHilightForegroundColor notNil ifTrue:[
- DefaultHilightForegroundColor := DefaultHilightForegroundColor on:Display
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- DefaultHilightBackgroundColor := DefaultHilightBackgroundColor on:Display
- ].
- DefaultForegroundColor notNil ifTrue:[
- DefaultForegroundColor := DefaultForegroundColor on:Display
- ].
- DefaultBackgroundColor notNil ifTrue:[
- DefaultBackgroundColor := DefaultBackgroundColor on:Display
- ].
- DefaultShadowColor notNil ifTrue:[
- DefaultShadowColor := DefaultShadowColor on:Display
- ].
- DefaultLightColor notNil ifTrue:[
- DefaultLightColor := DefaultLightColor on:Display
- ].
+ DefaultForegroundColor := StyleSheet colorAt:'selectionForegroundColor'.
+ DefaultBackgroundColor := StyleSheet colorAt:'selectionBackgroundColor'.
+ DefaultShadowColor := StyleSheet colorAt:'selectionShadowColor'.
+ DefaultLightColor := StyleSheet colorAt:'selectionLightColor'.
+ DefaultFont := StyleSheet fontAt:'selectionFont'.
"
self updateStyleCache
@@ -542,9 +528,11 @@
^ nil
!
-attributeAt:index put:aSymbol
- "set a line attribute; currently attributes are:
- #halfIntensity
+attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
+ "set a line attribute;
+ currently supported are:
+ #halfIntensity
+ #disabled
"
(index > list size) ifFalse:[
@@ -555,13 +543,29 @@
listAttributes grow:index
]
].
- aSymbol == (listAttributes at:index) ifFalse:[
- listAttributes at:index put:aSymbol.
+ aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
+ listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
self redrawLine:index
]
]
!
+line:lineNr hasAttribute:aSymbol
+ "return true, if line nr has attribute, aSymbol;
+ currently suppoerted attributes are:
+ #halfIntensity
+ #disabled
+ "
+
+ |attr|
+
+ (lineNr > listAttributes size) ifTrue:[^ false].
+ attr := listAttributes at:lineNr.
+ attr isNil ifTrue:[^ false].
+ attr isSymbol ifTrue:[^ attr == aSymbol].
+ ^ (attr includes:aSymbol)
+!
+
removeIndexWithoutRedraw:lineNr
"delete line - no redraw;
return true, if something was really deleted.
@@ -668,6 +672,10 @@
^ 1
!
+hasSelection
+ ^ selection isNil
+!
+
selectionValue
"return the selection value i.e. the text in the selected line.
For multiple selections a collection containing the entries is returned."
@@ -790,8 +798,8 @@
self redrawElement:aNumber
!
-selectNext
- "select next line or first visible if there is currrently no selection.
+nextAfterSelection
+ "return the number of the next selectable entry after the selection.
Wrap at end."
|next|
@@ -805,14 +813,24 @@
next := selection + 1
].
].
- self selection:next.
- selection isNil ifTrue:[
- self selection:1
- ]
+ (self isValidSelection:next) ifFalse:[
+ next := 1
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next := nil
+ ].
+ ^ next
!
-selectPrevious
- "select previous line or previous visible if there is currently no selection.
+selectNext
+ "select next line or first visible if there is currrently no selection.
+ Wrap at end."
+
+ self selection:(self nextAfterSelection)
+!
+
+previousBeforeSelection
+ "return the number of the previous selectable entry before the selection.
Wrap at beginning."
|prev|
@@ -826,10 +844,20 @@
prev := selection - 1
].
].
- self selection:prev.
- selection isNil ifTrue:[
- self selection:(list size)
- ]
+ (self isValidSelection:prev) ifFalse:[
+ prev := list size
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev := nil
+ ].
+ ^ prev
+!
+
+selectPrevious
+ "select previous line or previous visible if there is currently no selection.
+ Wrap at beginning."
+
+ self selection:(self previouseBeforeSelection).
! !
!SelectionInListView methodsFor:'private'!
@@ -1127,7 +1155,7 @@
Must check, if any is in the selection and handle this case.
Otherwise draw using supers method."
- |listLine fg bg|
+ |listLine fg bg attr|
fg := fgColor.
bg := bgColor.
@@ -1136,8 +1164,16 @@
(self isInSelection:listLine) ifTrue:[
^ self drawVisibleLineSelected:visLineNr
].
- (self attributeAt:listLine) == #halfIntensity ifTrue:[
- fg := halfIntensityFgColor
+ attr := self attributeAt:listLine.
+ attr notNil ifTrue:[
+ (attr == #halfIntensity
+ or:[attr isSymbol not and:[attr includes:#halfIntensity]]) ifTrue:[
+ fg := halfIntensityFgColor
+ ].
+ (attr == #disbled
+ or:[attr isSymbol not and:[attr includes:#disabled]]) ifTrue:[
+ fg := halfIntensityFgColor
+ ]
].
].
^ self drawVisibleLine:visLineNr with:fg and:bg
@@ -1186,11 +1222,12 @@
"
let edge start at left, extending to the full width
XXX: widthOfContents should be cached in ListView
- (instead of recumputing all over)
+ (instead of recomputing all over)
"
wEdge := width-(2 * margin).
+includesNonStrings ifFalse:[
wEdge := wEdge max:(self widthOfContents).
-
+].
self drawEdgesForX:(margin - leftOffset) y:y
width:wEdge height:fontHeight
level:hilightLevel.
@@ -1249,26 +1286,29 @@
^ self
].
(key == #CursorUp) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self key:key select:[self selectPrevious] x:x y:y
+ index := self previousBeforeSelection.
+ (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
+ self key:key select:[self selection:index] x:x y:y
].
^ self
].
(key == #CursorDown) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self key:key select:[self selectNext] x:x y:y
+ index := self nextAfterSelection.
+ (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
+ self key:key select:[self selection:index] x:x y:y
].
^ self
].
(key == #Home) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
+ (selectConditionBlock isNil or:[selectConditionBlock value:1]) ifTrue:[
self key:key select:[self selection:1] x:x y:y
].
^ self
].
(key == #End) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self key:key select:[self selection:list size] x:x y:y
+ index := list size.
+ (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
+ self key:key select:[self selection:index] x:x y:y
].
^ self
].
@@ -1326,22 +1366,27 @@
((button == 1) or:[button == #select]) ifTrue:[
enabled ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- oldSelection := selection.
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue: [
- self selectWithoutScroll:listLineNr
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- actionBlock notNil ifTrue:[actionBlock value:selection].
- "the ST-80 way of doing things"
- model notNil ifTrue:[
- model perform:changeSymbol with:(self selectionValue)
- ]
- ].
- clickLine := listLineNr
- ]
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+ ].
+
+ oldSelection := selection.
+ listLineNr notNil ifTrue: [
+ self selectWithoutScroll:listLineNr
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ actionBlock notNil ifTrue:[actionBlock value:selection].
+ "the ST-80 way of doing things"
+ model notNil ifTrue:[
+ model perform:changeSymbol with:(self selectionValue)
+ ]
+ ].
+ clickLine := listLineNr
]
] ifFalse:[
super buttonPress:button x:x y:y
@@ -1353,29 +1398,33 @@
((button == 1) or:[button == #select]) ifTrue:[
enabled ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- oldSelection := selection copy.
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue: [
- multipleSelectOk ifTrue:[
- (self isInSelection:listLineNr) ifTrue:[
- self removeFromSelection:listLineNr
- ] ifFalse:[
- self addToSelection:listLineNr
- ]
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+ ].
+ oldSelection := selection copy.
+ listLineNr notNil ifTrue: [
+ multipleSelectOk ifTrue:[
+ (self isInSelection:listLineNr) ifTrue:[
+ self removeFromSelection:listLineNr
] ifFalse:[
- self selectWithoutScroll:listLineNr
+ self addToSelection:listLineNr
]
- ].
- (selection ~= oldSelection) ifTrue:[
- actionBlock notNil ifTrue:[actionBlock value:selection].
- "the ST-80 way of doing things"
- (model notNil and:[changeSymbol notNil]) ifTrue:[
- model perform:changeSymbol with:(self selectionValue)
- ]
- ].
- clickLine := listLineNr
- ]
+ ] ifFalse:[
+ self selectWithoutScroll:listLineNr
+ ]
+ ].
+ (selection ~= oldSelection) ifTrue:[
+ actionBlock notNil ifTrue:[actionBlock value:selection].
+ "the ST-80 way of doing things"
+ (model notNil and:[changeSymbol notNil]) ifTrue:[
+ model perform:changeSymbol with:(self selectionValue)
+ ]
+ ].
+ clickLine := listLineNr
]
] ifFalse:[
super buttonShiftPress:button x:x y:y
--- a/TextColl.st Mon Oct 10 04:03:47 1994 +0100
+++ b/TextColl.st Fri Oct 28 04:25:37 1994 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.10 1994-10-10 03:03:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.11 1994-10-28 03:25:29 claus Exp $
'!
!TextCollector class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.10 1994-10-10 03:03:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.11 1994-10-28 03:25:29 claus Exp $
"
!
@@ -56,15 +56,16 @@
Its main use in the system is the Transcript, but it can also be used for
things like trace-windows etc.
- If collecting is turned on, a Textcollector will not immediately display
+ If collecting is turned on, a textcollector will not immediately display
entered text, but wait for some short time (timeDelay) and collect incoming
data - finally updating the whole chunk in one piece.
This helps slow display devices, which would otherwise scroll a lot.
(on fast displays this is less of a problem).
- The total number of lines kept is controlled by lineLimit, if more lines are
- entered at the bottom, the textcollector will forget lines at the top.
- Linelimit can also be set to nil (i.e. no limit), but you may need a lot
+ The total number of lines kept is controlled by lineLimit, if more lines
+ than this limit are added at the bottom, the textcollector will forget lines
+ at the top.
+ You can set linelimit to nil (i.e. no limit), but you may need a lot
of memory then ...
"
! !
@@ -77,6 +78,12 @@
^ 600
!
+defaultTranscriptSize
+ "the number of cols/lines by which the Transcript should come up"
+
+ ^ 70@11
+!
+
defaultTimeDelay
"the time in seconds to wait & collect by default"
@@ -86,30 +93,38 @@
!TextCollector class methodsFor:'instance creation'!
newTranscript
- |topView transcript f v fg bg cFg cBg|
+ |topView transcript f v fg bg cFg cBg lines cols|
topView := StandardSystemView label:'Transcript' minExtent:(100 @ 100).
topView icon:(Form fromFile:'SmalltalkX.xbm').
- v := ScrollableView for:self in:topView.
+ v := HVScrollableView for:self miniScrollerH:true miniScrollerV:false in:topView.
v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
transcript := v scrolledView.
"transcript partialLines:false."
f := transcript font.
- topView extent:(((f widthOf:'x') * 70) @ (f height * 10)).
+
+ "
+ should add the height of the frame & scrollbars to be exact ...
+ "
+ cols := self defaultTranscriptSize x.
+ lines := self defaultTranscriptSize y.
+ topView extent:(((f widthOf:'x') * cols) @ (f height * lines)).
Smalltalk at:#Transcript put:transcript.
- "fancy feature: whenever Transcript is closed, reset to StdError"
+ "
+ fancy feature: whenever Transcript is closed, reset to StdError
+ "
transcript destroyAction:[Smalltalk at:#Transcript put:Stderr].
- fg := StyleSheet at:'transcriptForegroundColor' default:transcript foregroundColor.
- bg := StyleSheet at:'transcriptBackgroundColor' default:transcript backgroundColor.
+ fg := StyleSheet colorAt:'transcriptForegroundColor' default:transcript foregroundColor.
+ bg := StyleSheet colorAt:'transcriptBackgroundColor' default:transcript backgroundColor.
transcript foregroundColor:fg backgroundColor:bg.
- cFg := StyleSheet at:'transcriptCursorForegroundColor' default:bg.
- cBg := StyleSheet at:'transcriptCursorBackgroundColor' default:fg.
+ cFg := StyleSheet colorAt:'transcriptCursorForegroundColor' default:bg.
+ cBg := StyleSheet colorAt:'transcriptCursorBackgroundColor' default:fg.
transcript cursorForegroundColor:cFg backgroundColor:cBg.
topView open.
--- a/TextCollector.st Mon Oct 10 04:03:47 1994 +0100
+++ b/TextCollector.st Fri Oct 28 04:25:37 1994 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.10 1994-10-10 03:03:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.11 1994-10-28 03:25:29 claus Exp $
'!
!TextCollector class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.10 1994-10-10 03:03:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.11 1994-10-28 03:25:29 claus Exp $
"
!
@@ -56,15 +56,16 @@
Its main use in the system is the Transcript, but it can also be used for
things like trace-windows etc.
- If collecting is turned on, a Textcollector will not immediately display
+ If collecting is turned on, a textcollector will not immediately display
entered text, but wait for some short time (timeDelay) and collect incoming
data - finally updating the whole chunk in one piece.
This helps slow display devices, which would otherwise scroll a lot.
(on fast displays this is less of a problem).
- The total number of lines kept is controlled by lineLimit, if more lines are
- entered at the bottom, the textcollector will forget lines at the top.
- Linelimit can also be set to nil (i.e. no limit), but you may need a lot
+ The total number of lines kept is controlled by lineLimit, if more lines
+ than this limit are added at the bottom, the textcollector will forget lines
+ at the top.
+ You can set linelimit to nil (i.e. no limit), but you may need a lot
of memory then ...
"
! !
@@ -77,6 +78,12 @@
^ 600
!
+defaultTranscriptSize
+ "the number of cols/lines by which the Transcript should come up"
+
+ ^ 70@11
+!
+
defaultTimeDelay
"the time in seconds to wait & collect by default"
@@ -86,30 +93,38 @@
!TextCollector class methodsFor:'instance creation'!
newTranscript
- |topView transcript f v fg bg cFg cBg|
+ |topView transcript f v fg bg cFg cBg lines cols|
topView := StandardSystemView label:'Transcript' minExtent:(100 @ 100).
topView icon:(Form fromFile:'SmalltalkX.xbm').
- v := ScrollableView for:self in:topView.
+ v := HVScrollableView for:self miniScrollerH:true miniScrollerV:false in:topView.
v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
transcript := v scrolledView.
"transcript partialLines:false."
f := transcript font.
- topView extent:(((f widthOf:'x') * 70) @ (f height * 10)).
+
+ "
+ should add the height of the frame & scrollbars to be exact ...
+ "
+ cols := self defaultTranscriptSize x.
+ lines := self defaultTranscriptSize y.
+ topView extent:(((f widthOf:'x') * cols) @ (f height * lines)).
Smalltalk at:#Transcript put:transcript.
- "fancy feature: whenever Transcript is closed, reset to StdError"
+ "
+ fancy feature: whenever Transcript is closed, reset to StdError
+ "
transcript destroyAction:[Smalltalk at:#Transcript put:Stderr].
- fg := StyleSheet at:'transcriptForegroundColor' default:transcript foregroundColor.
- bg := StyleSheet at:'transcriptBackgroundColor' default:transcript backgroundColor.
+ fg := StyleSheet colorAt:'transcriptForegroundColor' default:transcript foregroundColor.
+ bg := StyleSheet colorAt:'transcriptBackgroundColor' default:transcript backgroundColor.
transcript foregroundColor:fg backgroundColor:bg.
- cFg := StyleSheet at:'transcriptCursorForegroundColor' default:bg.
- cBg := StyleSheet at:'transcriptCursorBackgroundColor' default:fg.
+ cFg := StyleSheet colorAt:'transcriptCursorForegroundColor' default:bg.
+ cBg := StyleSheet colorAt:'transcriptCursorBackgroundColor' default:fg.
transcript cursorForegroundColor:cFg backgroundColor:cBg.
topView open.
--- a/TextView.st Mon Oct 10 04:03:47 1994 +0100
+++ b/TextView.st Fri Oct 28 04:25:37 1994 +0100
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.10 1994-10-10 03:03:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.11 1994-10-28 03:25:31 claus Exp $
'!
!TextView class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.10 1994-10-10 03:03:11 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.11 1994-10-28 03:25:31 claus Exp $
"
!
@@ -156,13 +156,10 @@
!TextView class methodsFor:'defaults'!
updateStyleCache
- DefaultViewBackground := StyleSheet at:'textViewBackground' default:White.
- DefaultSelectionForegroundColor := StyleSheet at:'textSelectionForegroundColor'.
- DefaultSelectionBackgroundColor := StyleSheet at:'textSelectionBackgroundColor'.
- DefaultFont := StyleSheet at:'textFont'.
- DefaultFont notNil ifTrue:[
- DefaultFont := DefaultFont on:Display
- ].
+ DefaultViewBackground := StyleSheet colorAt:'textViewBackground' default:White.
+ DefaultSelectionForegroundColor := StyleSheet colorAt:'textSelectionForegroundColor'.
+ DefaultSelectionBackgroundColor := StyleSheet colorAt:'textSelectionBackgroundColor'.
+ DefaultFont := StyleSheet fontAt:'textFont'.
! !
!TextView methodsFor:'initialize & release'!
@@ -731,7 +728,7 @@
"find word boundaries, evaluate the block argument with those.
A helper for nextWord and selectWord functions."
- |beginCol endCol endLine thisCharacter flag len|
+ |beginCol endCol endLine thisCharacter flag|
flag := #word.
beginCol := selectCol.
--- a/VarHPanel.st Mon Oct 10 04:03:47 1994 +0100
+++ b/VarHPanel.st Fri Oct 28 04:25:37 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.7 1994-10-10 03:03:20 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.8 1994-10-28 03:25:33 claus Exp $
'!
!VariableHorizontalPanel class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.7 1994-10-10 03:03:20 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.8 1994-10-28 03:25:33 claus Exp $
"
!
@@ -382,7 +382,15 @@
y:(hy - barWidth)
width:w
height:(barWidth + barWidth)
- level:2
+ level:2.
+
+ handleStyle == #iris ifTrue:[
+ self paint:Black.
+ self fillDeviceRectangleX:(x + m + 2)
+ y:(hy - barWidth + 2)
+ width:w - 4
+ height:(barWidth + barWidth - 4)
+ ]
] ifFalse:[
x := hx.
self drawHandleFormAtX:(x + m) y:hy
--- a/VarVPanel.st Mon Oct 10 04:03:47 1994 +0100
+++ b/VarVPanel.st Fri Oct 28 04:25:37 1994 +0100
@@ -16,7 +16,7 @@
shadowForm lightForm
showHandle handlePosition
handleColor handleStyle noColor
- trackLine'
+ trackLine redrawLocked'
classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor'
poolDictionaries:''
@@ -27,7 +27,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.8 1994-10-10 03:03:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.9 1994-10-28 03:25:35 claus Exp $
'!
!VariableVerticalPanel class methodsFor:'documentation'!
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.8 1994-10-10 03:03:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.9 1994-10-28 03:25:35 claus Exp $
"
!
@@ -133,7 +133,7 @@
DefaultHandlePosition := StyleSheet at:'variablePanelHandlePosition' default:#right.
DefaultTrackingLine := StyleSheet at:'variablePanelTrackingLine' default:false.
DefaultSeparatingLine := StyleSheet at:'variablePanelSeparatingLine' default:false.
- DefaultHandleColor := StyleSheet at:'variablePanelHandleColor' default:Black.
+ DefaultHandleColor := StyleSheet colorAt:'variablePanelHandleColor' default:Black.
! !
!VariableVerticalPanel methodsFor:'initializing'!
@@ -300,7 +300,7 @@
self displayForm:shadowForm x:hx y:hy.
self paint:lightColor.
self displayForm:lightForm x:hx y:hy.
- self paint viewBackground
+ self paint:viewBackground
!
drawHandleAtX:hx y:hy
@@ -341,7 +341,14 @@
y:(y + m)
width:(barWidth + barWidth)
height:h
- level:2
+ level:2.
+ handleStyle == #iris ifTrue:[
+ self paint:Black.
+ self fillDeviceRectangleX:(hx - barWidth + 2)
+ y:(y + m + 2)
+ width:(barWidth + barWidth - 4)
+ height:h - 4
+ ]
] ifFalse:[
y := hy.
self drawHandleFormAtX:hx y:(y + m)
@@ -396,7 +403,9 @@
redraw
"redraw the handles"
- self redrawHandlesFrom:1 to:(subViews size)
+ redrawLocked ~~ true ifTrue:[
+ self redrawHandlesFrom:1 to:(subViews size)
+ ]
! !
!VariableVerticalPanel methodsFor:'events'!
@@ -531,7 +540,9 @@
movedHandle := nil.
- self redrawHandlesFrom:aboveIndex to:belowIndex
+ redrawLocked := true.
+ self redrawHandlesFrom:aboveIndex to:belowIndex.
+ redrawLocked := false.
] ifFalse:[
super buttonRelease:button x:x y:y
]
--- a/VariableHorizontalPanel.st Mon Oct 10 04:03:47 1994 +0100
+++ b/VariableHorizontalPanel.st Fri Oct 28 04:25:37 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.7 1994-10-10 03:03:20 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.8 1994-10-28 03:25:33 claus Exp $
'!
!VariableHorizontalPanel class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.7 1994-10-10 03:03:20 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.8 1994-10-28 03:25:33 claus Exp $
"
!
@@ -382,7 +382,15 @@
y:(hy - barWidth)
width:w
height:(barWidth + barWidth)
- level:2
+ level:2.
+
+ handleStyle == #iris ifTrue:[
+ self paint:Black.
+ self fillDeviceRectangleX:(x + m + 2)
+ y:(hy - barWidth + 2)
+ width:w - 4
+ height:(barWidth + barWidth - 4)
+ ]
] ifFalse:[
x := hx.
self drawHandleFormAtX:(x + m) y:hy
--- a/VariableVerticalPanel.st Mon Oct 10 04:03:47 1994 +0100
+++ b/VariableVerticalPanel.st Fri Oct 28 04:25:37 1994 +0100
@@ -16,7 +16,7 @@
shadowForm lightForm
showHandle handlePosition
handleColor handleStyle noColor
- trackLine'
+ trackLine redrawLocked'
classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor'
poolDictionaries:''
@@ -27,7 +27,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.8 1994-10-10 03:03:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.9 1994-10-28 03:25:35 claus Exp $
'!
!VariableVerticalPanel class methodsFor:'documentation'!
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.8 1994-10-10 03:03:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.9 1994-10-28 03:25:35 claus Exp $
"
!
@@ -133,7 +133,7 @@
DefaultHandlePosition := StyleSheet at:'variablePanelHandlePosition' default:#right.
DefaultTrackingLine := StyleSheet at:'variablePanelTrackingLine' default:false.
DefaultSeparatingLine := StyleSheet at:'variablePanelSeparatingLine' default:false.
- DefaultHandleColor := StyleSheet at:'variablePanelHandleColor' default:Black.
+ DefaultHandleColor := StyleSheet colorAt:'variablePanelHandleColor' default:Black.
! !
!VariableVerticalPanel methodsFor:'initializing'!
@@ -300,7 +300,7 @@
self displayForm:shadowForm x:hx y:hy.
self paint:lightColor.
self displayForm:lightForm x:hx y:hy.
- self paint viewBackground
+ self paint:viewBackground
!
drawHandleAtX:hx y:hy
@@ -341,7 +341,14 @@
y:(y + m)
width:(barWidth + barWidth)
height:h
- level:2
+ level:2.
+ handleStyle == #iris ifTrue:[
+ self paint:Black.
+ self fillDeviceRectangleX:(hx - barWidth + 2)
+ y:(y + m + 2)
+ width:(barWidth + barWidth - 4)
+ height:h - 4
+ ]
] ifFalse:[
y := hy.
self drawHandleFormAtX:hx y:(y + m)
@@ -396,7 +403,9 @@
redraw
"redraw the handles"
- self redrawHandlesFrom:1 to:(subViews size)
+ redrawLocked ~~ true ifTrue:[
+ self redrawHandlesFrom:1 to:(subViews size)
+ ]
! !
!VariableVerticalPanel methodsFor:'events'!
@@ -531,7 +540,9 @@
movedHandle := nil.
- self redrawHandlesFrom:aboveIndex to:belowIndex
+ redrawLocked := true.
+ self redrawHandlesFrom:aboveIndex to:belowIndex.
+ redrawLocked := false.
] ifFalse:[
super buttonRelease:button x:x y:y
]
--- a/Workspace.st Mon Oct 10 04:03:47 1994 +0100
+++ b/Workspace.st Fri Oct 28 04:25:37 1994 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.11 1994-10-10 03:03:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.12 1994-10-28 03:25:37 claus Exp $
'!
!Workspace class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.11 1994-10-10 03:03:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.12 1994-10-28 03:25:37 claus Exp $
"
!
@@ -55,6 +55,8 @@
'doIt', 'printIt' and 'inspectIt' functions on the popup-menu.
The action to be performed on doIt is defined by a block,
which can be defined by the owner of this view.
+ (thus you can put a workspace into more complex widgets, and
+ control what should happen on 'doIt').
A useful default action is setup, which simply evaluates the
selection as a smalltalk expression. (but, a lisp or prolog
@@ -103,8 +105,8 @@
!Workspace class methodsFor:'defaults'!
updateStyleCache
- DefaultErrorForegroundColor := StyleSheet at:'codeErrorSelectionForegroundColor'.
- DefaultErrorBackgroundColor := StyleSheet at:'codeErrorSelectionBackgroundColor'.
+ DefaultErrorForegroundColor := StyleSheet colorAt:'codeErrorSelectionForegroundColor'.
+ DefaultErrorBackgroundColor := StyleSheet colorAt:'codeErrorSelectionBackgroundColor'.
! !
!Workspace methodsFor:'initialize / release'!
@@ -362,7 +364,7 @@
]
].
- windowGroup withCursor:Cursor execute do:[
+ self topView withCursor:Cursor execute do:[
Object abortSignal catch:[
[
value := doItAction value:code asString.
@@ -401,22 +403,29 @@
!Workspace methodsFor:'events'!
keyPress:key x:x y:y
+ |cmd commands|
+
(key == #DoIt) ifTrue:[^ self doIt].
(key == #InspectIt) ifTrue:[^ self inspectIt].
(key == #PrintIt) ifTrue:[^ self printIt].
"
- Cmd-Fn evaluates a key-sequence
-
+ Ctrl-Fn or Cmd-Fn evaluates a key-sequence
+ (I added Ctrl-Fn, because some windowmanagers already use cmd-fn)
see TextView>>keyPress:x:y:
"
- (#(F1 F2 F3 F4 F5 F6 F7 F8 F9) includes:key) ifTrue:[
- device metaDown ifTrue:[
- (Smalltalk at:#FunctionKeySequences) notNil ifTrue:[
- Parser evaluate:((Smalltalk at:#FunctionKeySequences) at:key) asString
- receiver:self
- notifying:nil.
- ^ self
+
+ (#(F1 F2 F3 F4 F5 F6 F7 F8 F9 f1 f2 f3 f4 f5 f6 f7 f8 f9) includes:key) ifTrue:[
+ (device metaDown or:[device controlDown]) ifTrue:[
+ commands := Smalltalk at:#FunctionKeySequences ifAbsent:[nil].
+ commands notNil ifTrue:[
+ cmd := commands at:key ifAbsent:[nil].
+ cmd notNil ifTrue:[
+ Parser evaluate:cmd asString
+ receiver:self
+ notifying:nil.
+ ^ self
+ ]
]
]
].
@@ -432,16 +441,19 @@
self setTab4
then, press shift-F2 to define the sequence;
- press cmd-F2 to execute it.
+ press cmd-F2 to execute it (some window managers have cmd-Fn redefined;
+ use Ctrl-Fn then).
voila: you have set 4-tabs.
to switch back, perform the same procedure with:
self setTab8
-
- if you like a browser to come up on the selection when pressing F3:
- select:
+ Within the expression, 'self' is bound to the view. Thus, you can do
+ all kinds of fancy things.
+ For example:
+ if you like a browser to come up on the selection when pressing F3:
+ select:
|sel|
sel := self selection asString withoutSeparators.
@@ -453,7 +465,7 @@
then, press shift-F3 to define the command.
press cmd-F3 to execute it (select some classname before).
- (notice: on the Indy, Cmd-F3 is already handled by the window manager)
+ (notice: on the Indy, Cmd-F3 is already used by the window manager)
if you like a file-include command on F4:
select:
@@ -470,6 +482,8 @@
]
this will paste the contents of the file at the current cusor position.
-
+ (select above expression, press Shift-F4,
+ then select any filename and press Cmd-F4)
+ try it here: /etc/passwd
"
! !