--- a/ListView.st Sun Dec 10 17:53:46 1995 +0100
+++ b/ListView.st Mon Dec 11 17:52:55 1995 +0100
@@ -10,29 +10,18 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 10:59:34 am'!
-
View subclass:#ListView
- instanceVariableNames:'list
- firstLineShown leftOffset
- nFullLinesShown nLinesShown
- fgColor bgColor
- partialLines leftMargin topMargin
- textStartLeft textStartTop innerWidth
- tabPositions
- lineSpacing
- fontHeight fontAscent fontIsFixedWidth fontWidth
- autoScroll autoScrollBlock autoScrollDeltaT
- searchPattern wordCheck
- includesNonStrings widthOfWidestLine
- listMsg
- viewOrigin
- menuHolder menuPerformer
- listChannel'
- classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
- DefaultFont DefaultTabPositions'
- poolDictionaries:''
- category:'Views-Text'
+ instanceVariableNames:'list firstLineShown leftOffset nFullLinesShown nLinesShown
+ fgColor bgColor partialLines leftMargin topMargin textStartLeft
+ textStartTop innerWidth tabPositions lineSpacing fontHeight
+ fontAscent fontIsFixedWidth fontWidth autoScroll autoScrollBlock
+ autoScrollDeltaT searchPattern wordCheck includesNonStrings
+ widthOfWidestLine listMsg viewOrigin menuHolder menuPerformer
+ listChannel'
+ classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultFont
+ DefaultTabPositions'
+ poolDictionaries:''
+ category:'Views-Text'
!
!ListView class methodsFor:'documentation'!
@@ -51,10 +40,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.52 1995-12-05 14:06:01 cg Exp $'
-!
-
documentation
"
a View for (string-)lists.
@@ -161,14 +146,6 @@
^ self tab8Positions
!
-updateStyleCache
- DefaultForegroundColor := StyleSheet colorAt:'textForegroundColor' default:Black.
- DefaultBackgroundColor := StyleSheet colorAt:'textBackgroundColor' default:White.
- DefaultFont := StyleSheet fontAt:'textFont'.
- DefaultTabPositions := StyleSheet at:'textTabPositions'.
- DefaultTabPositions isNil ifTrue:[DefaultTabPositions := self defaultTabPositions].
-!
-
tab4Positions
^ #(1 5 9 13 17 21 25 29 33 37 41 45 49 53 57 61 65 69 73 77 81
85 89 93 97 101 105 109 113 114 121 125 129 133 137 141 145)
@@ -176,15 +153,174 @@
tab8Positions
^ #(1 9 17 25 33 41 49 57 65 73 81 89 97 105 113 121 129 137 145)
+!
+
+updateStyleCache
+ DefaultForegroundColor := StyleSheet colorAt:'textForegroundColor' default:Black.
+ DefaultBackgroundColor := StyleSheet colorAt:'textBackgroundColor' default:White.
+ DefaultFont := StyleSheet fontAt:'textFont'.
+ DefaultTabPositions := StyleSheet at:'textTabPositions'.
+ DefaultTabPositions isNil ifTrue:[DefaultTabPositions := self defaultTabPositions].
+! !
+
+!ListView methodsFor:'accessing'!
+
+backgroundColor
+ "return the background color"
+
+ ^ bgColor
+!
+
+backgroundColor:aColor
+ "set the background color"
+
+ bgColor ~~ aColor ifTrue:[
+ bgColor := aColor.
+ self viewBackground:bgColor.
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ]
+ ]
+!
+
+font:aFont
+ "set the font for all shown text.
+ Redraws everything."
+
+ aFont isNil ifTrue:[
+ ^ self error:'nil font'
+ ].
+ font ~~ aFont ifTrue:[
+ super font:aFont.
+ realized ifTrue:[
+ widthOfWidestLine := nil. "/ i.e. unknown
+ (font device == device) ifTrue:[
+ self getFontParameters.
+ self computeNumberOfLinesShown.
+ shown ifTrue:[
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
+ ].
+ self contentsChanged
+ ]
+ ]
+
+ "Modified: 24.11.1995 / 11:17:06 / cg"
+!
+
+foregroundColor
+ "return the foreground color"
+
+ ^ fgColor
+!
+
+foregroundColor:aColor
+ "set the foreground color"
+
+ fgColor ~~ aColor ifTrue:[
+ fgColor := aColor.
+ shown ifTrue:[
+ self redraw
+ ]
+ ]
+!
+
+foregroundColor:color1 backgroundColor:color2
+ "set both foreground and background colors"
+
+ ((fgColor ~~ color1) or:[bgColor ~~ color2]) ifTrue:[
+ fgColor := color1.
+ bgColor := color2.
+ shown ifTrue:[
+ self redraw
+ ]
+ ]
+!
+
+innerHeight
+ "return the number of pixels visible of the contents
+ - redefined since ListView adds another margin to start the text
+ somewhat to indented from the 3D border."
+
+ ^ height - (2 * margin) - topMargin
+!
+
+leftMargin
+ "return the margin to left of 1st col"
+
+ ^ leftMargin
+!
+
+leftMargin:aNumber
+ "set the margin between the left border and the 1st col"
+
+ leftMargin := aNumber.
+ textStartLeft := leftMargin + margin.
+ innerWidth := width - textStartLeft - margin
+!
+
+level:aNumber
+ "set the level - cought here to update text-position variables
+ (which avoids many computations later)"
+
+ super level:aNumber.
+
+ textStartLeft := leftMargin + margin.
+ textStartTop := topMargin + margin.
+ innerWidth := width - textStartLeft - margin
+!
+
+lineSpacing:pixles
+ "set the lineSpacing - thats an additional number of pixels,
+ by which lines are vertically separated."
+
+ lineSpacing := pixles.
+ self getFontParameters.
+!
+
+partialLines:aBoolean
+ "allow/disallow display of a last partial line"
+
+ partialLines := aBoolean.
+ self computeNumberOfLinesShown
+!
+
+topMargin:aNumber
+ "set the margin between the top border and the 1st line"
+
+ topMargin := aNumber.
+ textStartTop := topMargin + margin.
! !
!ListView methodsFor:'accessing-contents'!
-size
- "return the size (i.e. number of lines)
- this allows textViews to be used like collections in some places."
-
- ^ list size.
+add:aString
+ "add a line and redisplay"
+
+ list add:aString.
+ includesNonStrings ifFalse:[
+ includesNonStrings := (aString notNil and:[aString isString not]).
+ ].
+ shown ifTrue:[
+ self redrawLine:(self size).
+ self contentsChanged. "recompute scrollbars"
+ ]
+
+!
+
+add:aString beforeIndex:index
+ "add a line and redisplay"
+
+ list add:aString beforeIndex:index.
+ includesNonStrings ifFalse:[
+ includesNonStrings := (aString notNil and:[aString isString not]).
+ ].
+ shown ifTrue:[
+ self redrawFromLine:index.
+ self contentsChanged. "recompute scrollbars"
+ ]
+
!
at:lineNr
@@ -196,40 +332,6 @@
^ list at:lineNr
!
-from:from to:to do:aBlock
- "evaluate aBlock on all of my lines"
-
- ^ list from:from to:to do:aBlock.
-!
-
-withoutRedrawAt:index put:aString
- "change a line without redisplay"
-
- |w|
-
- 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.
- ]
- ].
- widthOfWidestLine notNil ifTrue:[
- aString isString ifTrue:[
- w := font widthOf:aString
- ] ifFalse:[
- w := aString widthIn:self
- ].
- w > widthOfWidestLine ifTrue:[
- widthOfWidestLine := w
- ] ifFalse:[
- widthOfWidestLine := nil "/ means: unknown
- ].
- ]
-!
-
at:index put:aString
"change a line and redisplay"
@@ -239,32 +341,11 @@
]
!
-list
- "return the contents as a collection of strings"
-
- ^ list
-!
-
-setContents:something
- "set the contents (either a string or a Collection of strings)
- dont change position (i.e. do not scroll).
- This can be used to update a self-changing list
- (for example: a file list being shown, without disturbing user too much).
- Compare with #contents:, which scrolls to top."
-
- |l oldSize|
-
- oldSize := self size.
- l := something.
- l notNil ifTrue:[
- l isString ifTrue:[
- l := l asStringCollection
- ]
- ].
- self setList:l.
- self size ~~ oldSize ifTrue:[
- self contentsChanged
- ]
+contents
+ "return the contents as a string"
+
+ list isNil ifTrue:[^ ''].
+ ^ list asStringCollection asString
!
contents:something
@@ -282,6 +363,24 @@
self list:l
!
+from:from to:to do:aBlock
+ "evaluate aBlock on all of my lines"
+
+ ^ list from:from to:to do:aBlock.
+!
+
+grow:n
+ "grow our list"
+
+ ^ list grow:n.
+!
+
+list
+ "return the contents as a collection of strings"
+
+ ^ list
+!
+
list:aCollection
"set the contents (a collection of strings or list entries)
and scroll to top-left"
@@ -331,6 +430,73 @@
"Modified: 30.8.1995 / 19:07:13 / claus"
!
+removeIndex:lineNr
+ "delete line, update view"
+
+ |visLine w
+ srcY "{ Class: SmallInteger }" |
+
+ (self removeIndexWithoutRedraw:lineNr) ifFalse:[^ self].
+ "
+ is there a need to redraw ?
+ "
+ shown ifFalse:[^ self].
+ visLine := self listLineToVisibleLine:lineNr.
+ visLine notNil ifTrue:[
+ w := self widthForScrollBetween:lineNr and:(firstLineShown + nLinesShown).
+ srcY := topMargin + (visLine * fontHeight).
+ self catchExpose.
+ self copyFrom:self x:textStartLeft y:srcY
+ toX:textStartLeft y:(srcY - fontHeight)
+ width:w height:((nLinesShown - visLine) * fontHeight).
+ self redrawVisibleLine:nFullLinesShown.
+ "
+ redraw last partial line - if any
+ "
+ (nFullLinesShown ~~ nLinesShown) ifTrue:[
+ self redrawVisibleLine:nLinesShown
+ ].
+ self waitForExpose
+ ]
+!
+
+removeIndexWithoutRedraw:lineNr
+ "delete a line, given its lineNr - no redraw;
+ return true, if something was really deleted (so sender knows,
+ if a redraw is needed)"
+
+ (list isNil or:[lineNr > self size]) ifTrue:[^ false].
+ list removeIndex:lineNr.
+
+ lineNr < firstLineShown ifTrue:[
+ firstLineShown := firstLineShown - 1
+ ].
+ self contentsChanged.
+ ^ true
+!
+
+setContents:something
+ "set the contents (either a string or a Collection of strings)
+ dont change position (i.e. do not scroll).
+ This can be used to update a self-changing list
+ (for example: a file list being shown, without disturbing user too much).
+ Compare with #contents:, which scrolls to top."
+
+ |l oldSize|
+
+ oldSize := self size.
+ l := something.
+ l notNil ifTrue:[
+ l isString ifTrue:[
+ l := l asStringCollection
+ ]
+ ].
+ self setList:l.
+ self size ~~ oldSize ifTrue:[
+ self contentsChanged
+ ]
+!
+
setList:aCollection
"set the contents (a collection of strings);
do not change position (i.e. do not scroll).
@@ -380,132 +546,48 @@
!
-contents
- "return the contents as a string"
-
- list isNil ifTrue:[^ ''].
- ^ list asStringCollection asString
-!
-
-removeIndexWithoutRedraw:lineNr
- "delete a line, given its lineNr - no redraw;
- return true, if something was really deleted (so sender knows,
- if a redraw is needed)"
-
- (list isNil or:[lineNr > self size]) ifTrue:[^ false].
- list removeIndex:lineNr.
-
- lineNr < firstLineShown ifTrue:[
- firstLineShown := firstLineShown - 1
- ].
- self contentsChanged.
- ^ true
+size
+ "return the size (i.e. number of lines)
+ this allows textViews to be used like collections in some places."
+
+ ^ list size.
!
-removeIndex:lineNr
- "delete line, update view"
-
- |visLine w
- srcY "{ Class: SmallInteger }" |
-
- (self removeIndexWithoutRedraw:lineNr) ifFalse:[^ self].
- "
- is there a need to redraw ?
- "
- shown ifFalse:[^ self].
- visLine := self listLineToVisibleLine:lineNr.
- visLine notNil ifTrue:[
- w := self widthForScrollBetween:lineNr and:(firstLineShown + nLinesShown).
- srcY := topMargin + (visLine * fontHeight).
- self catchExpose.
- self copyFrom:self x:textStartLeft y:srcY
- toX:textStartLeft y:(srcY - fontHeight)
- width:w height:((nLinesShown - visLine) * fontHeight).
- self redrawVisibleLine:nFullLinesShown.
- "
- redraw last partial line - if any
- "
- (nFullLinesShown ~~ nLinesShown) ifTrue:[
- self redrawVisibleLine:nLinesShown
- ].
- self waitForExpose
- ]
-!
-
-add:aString beforeIndex:index
- "add a line and redisplay"
-
- list add:aString beforeIndex:index.
+withoutRedrawAt:index put:aString
+ "change a line without redisplay"
+
+ |w|
+
+ 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 redrawFromLine:index.
- self contentsChanged. "recompute scrollbars"
+ widthOfWidestLine notNil ifTrue:[
+ aString isString ifTrue:[
+ w := font widthOf:aString
+ ] ifFalse:[
+ w := aString widthIn:self
+ ].
+ w > widthOfWidestLine ifTrue:[
+ widthOfWidestLine := w
+ ] ifFalse:[
+ widthOfWidestLine := nil "/ means: unknown
+ ].
]
-
-!
-
-grow:n
- "grow our list"
-
- ^ list grow:n.
-!
-
-add:aString
- "add a line and redisplay"
-
- list add:aString.
- includesNonStrings ifFalse:[
- includesNonStrings := (aString notNil and:[aString isString not]).
- ].
- shown ifTrue:[
- self redrawLine:(self size).
- self contentsChanged. "recompute scrollbars"
- ]
-
! !
!ListView methodsFor:'accessing-mvc'!
-on:aModel aspect:aspectSymbol
- "ST-80 compatibility"
-
- ^ self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:nil
-!
-
-on:aModel aspect:aspectSymbol change:changeSymbol
- "ST-80 compatibility"
-
- ^self on:aModel aspect:aspectSymbol change:changeSymbol list:aspectSymbol menu:nil
-!
-
-on:aModel aspect:aspectSymbol menu:menuSymbol
- "ST-80 compatibility"
-
- ^self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:menuSymbol
-!
-
-on:aModel aspect:aspectSymbol list:listSymbol menu:menuSymbol
- "ST-80 compatibility"
-
- ^ self on:aModel aspect:aspectSymbol change:nil list:listSymbol menu:menuSymbol
-!
-
-on:aModel aspect:aspectSymbol change:changeSymbol menu:menuSymbol
- "ST-80 compatibility"
-
- ^ self on:aModel aspect:aspectSymbol change:changeSymbol list:nil menu:menuSymbol
-!
-
-on:aModel aspect:aspectSymbol change:changeSymbol list:listSymbol menu:menuSymbol
- "ST-80 compatibility"
-
- aspectSymbol notNil ifTrue:[aspectMsg := aspectSymbol. listMsg := aspectSymbol].
- listSymbol notNil ifTrue:[listMsg := listSymbol].
- changeSymbol notNil ifTrue:[changeMsg := changeSymbol].
- menuMsg := menuSymbol.
- self model:aModel.
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#listMessage put:listMsg
!
listMessage
@@ -561,438 +643,56 @@
menuPerformer := anObject
!
-addModelInterfaceTo:aDictionary
- "see comment in View>>modelInterface"
-
- super addModelInterfaceTo:aDictionary.
- aDictionary at:#listMessage put:listMsg
-! !
-
-!ListView methodsFor:'private'!
-
-getListFromModel
- "ask my model (if any) for the text via the listMsg."
-
- |text|
-
- (model notNil
- and:[listMsg notNil]) ifTrue:[
- text := model perform:listMsg.
- text notNil ifTrue:[
- text := text asStringCollection.
- ].
- self list:text
- ].
-!
-
-visibleLineToListLine:visibleLineNr
- "given a visible line (1..) return linenr in list or nil
- (this one returns nil if the given visibleLineNr is one of the
- separators)"
-
- |listLineNr "{ Class: SmallInteger }"
- listsize "{ Class: SmallInteger }" |
-
- visibleLineNr isNil ifTrue:[^ nil].
- listLineNr := visibleLineNr + firstLineShown - 1.
- (listLineNr == 0) ifTrue:[^nil].
- listsize := self size.
- (listLineNr <= listsize) ifTrue:[^ listLineNr].
- ^ nil
-!
-
-visibleAt:visibleLineNr
- "return what is visible at line (numbers start at 1).
- This is used for redrawing; i.e. for non-string entries, this
- returns the original."
-
- |listLineNr listsize|
-
- listLineNr := visibleLineNr + firstLineShown - 1.
- (listLineNr == 0) ifTrue:[^ nil].
- (list notNil) ifTrue:[
- listsize := self size
- ] ifFalse:[
- listsize := 0
- ].
- (listLineNr <= listsize) ifTrue:[^ self at:listLineNr].
- ^ ''
-!
-
-listAt:lineNr
- "given a lineNumber, return the corresponding string
- This is used for accessing; i.e. for non-string entries, this
- returns the corresponding string."
-
- |l|
-
- list isNil ifTrue:[^ nil].
- (lineNr between:1 and:self size) ifFalse:[^ nil].
- l := self at:lineNr.
- l isNil ifTrue:[^ l].
- ^ l asString
-
- "Modified: 7.9.1995 / 15:54:59 / claus"
-!
-
-yOfVisibleLine:visLineNr
- "given a visible lineNr, return y-coordinate in view
- - works for fix-height fonts only"
-
- ^ ((visLineNr - 1) * fontHeight) + textStartTop
-!
-
-computeNumberOfLinesShown
- "recompute the number of visible lines"
-
- nFullLinesShown := self innerHeight + lineSpacing // fontHeight.
- nLinesShown := nFullLinesShown.
-
- partialLines ifTrue:[
- ((nLinesShown * fontHeight) == height) ifFalse:[
- nLinesShown := nLinesShown + 1
- ]
- ]
-!
-
-visibleLineOfY:y
- "given a y-coordinate, return lineNr
- - works for fix-height fonts only"
-
- ^ ((y - textStartTop) // fontHeight) + 1
+on:aModel aspect:aspectSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:nil
!
-checkForExistingLine:lineNr
- "check if a line for lineNr exists; if not, expand text"
-
- list isNil ifTrue: [
- list := StringCollection new:lineNr.
- self contentsChanged
- ] ifFalse: [
- lineNr > (list size) ifTrue:[
- self grow:lineNr.
- self contentsChanged
- ]
- ]
-!
-
-xOfCol:col inVisibleLine:visLineNr
- "given a visible line- and colNr, return x-coordinate in view"
-
- |line lineSize tcol|
-
- tcol := col - 1.
- fontIsFixedWidth ifTrue:[
- ^ (tcol * fontWidth) + textStartLeft
- ].
- line := self visibleAt:visLineNr.
- line notNil ifTrue:[
- lineSize := line size
- ] ifFalse:[
- lineSize := 0
- ].
- (lineSize == 0) ifTrue:[
- ^ (tcol * fontWidth) + textStartLeft
- ].
- (lineSize < col) ifTrue:[
- ^ (font widthOf:line)
- + (fontWidth * (tcol - lineSize))
- + textStartLeft
- ].
- ^ (font widthOf:line from:1 to:tcol) + textStartLeft
-!
-
-listLineToVisibleLine:listLineNr
- "given a list line (1..) return visible linenr or nil"
-
- |visibleLineNr "{ Class: SmallInteger }"|
-
- shown ifFalse:[^ nil].
- listLineNr isNil ifTrue:[^ nil].
- visibleLineNr := listLineNr + 1 - firstLineShown.
- (visibleLineNr between:1 and:nLinesShown) ifFalse:[^ nil].
- ^ visibleLineNr
+on:aModel aspect:aspectSymbol change:changeSymbol
+ "ST-80 compatibility"
+
+ ^self on:aModel aspect:aspectSymbol change:changeSymbol list:aspectSymbol menu:nil
!
-visibleLineToAbsoluteLine:visibleLineNr
- "given a visible line (1..) return absolut linenr"
-
- visibleLineNr isNil ifTrue:[^ nil].
- ^ visibleLineNr + firstLineShown - 1
-!
-
-widthForScrollBetween:firstLine and:lastLine
- "return the width in pixels for a scroll between firstLine and lastLine.
- - used to optimize scrolling, by limiting the scrolled area.
- Subclasses with selections or other additional visible stuff should redefine
- this method."
-
- |w|
-
- "for small width, its not worth searching for
- longest line ...
- "
- (width < 300) ifTrue:[^ innerWidth].
-
- "for large lists, search may take longer than scrolling full
- "
- self size > 2000 ifTrue:[^ innerWidth].
-
- "
- if there is a pattern-background, we have to scroll everything
- "
- (viewBackground isColor not
- or:[viewBackground colorId notNil]) ifTrue:[
- ^ width
- ].
-
- w := self widthOfWidestLineBetween:firstLine and:lastLine.
- (w > innerWidth) ifTrue:[^ innerWidth].
- ^ w
-!
-
-getFontParameters
- "get some info of the used font. They are cached since we use them often .."
-
- font := font on:device.
- fontHeight := font height + lineSpacing.
- fontAscent := font ascent.
- fontWidth := font width.
- fontIsFixedWidth := font isFixedWidth.
-!
-
-absoluteLineToVisibleLine:absLineNr
- "given an absolute line (1..) return visible linenr or nil"
-
- absLineNr isNil ifTrue:[^ nil].
- (absLineNr < firstLineShown) ifTrue:[^ nil].
- (absLineNr >= (firstLineShown + nLinesShown)) ifTrue:[^ nil].
- ^ absLineNr - firstLineShown + 1
+on:aModel aspect:aspectSymbol change:changeSymbol list:listSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ aspectSymbol notNil ifTrue:[aspectMsg := aspectSymbol. listMsg := aspectSymbol].
+ listSymbol notNil ifTrue:[listMsg := listSymbol].
+ changeSymbol notNil ifTrue:[changeMsg := changeSymbol].
+ menuMsg := menuSymbol.
+ self model:aModel.
!
-colOfX:x inVisibleLine:visLineNr
- "given a visible lineNr and x-coordinate, return colNr"
-
- |lineString linePixelWidth xRel runCol posLeft posRight done|
-
- xRel := x - textStartLeft + leftOffset.
- "
- for fix fonts, this is easy ...
- "
- fontIsFixedWidth ifTrue:[
- ^ (xRel // fontWidth) + 1
- ].
-
- "
- for variable fonts, more work is required ...
- "
- lineString := (self visibleAt:visLineNr) asString.
- lineString notNil ifTrue:[
- linePixelWidth := font widthOf:lineString
- ] ifFalse:[
- linePixelWidth := 0
- ].
- (xRel <= 0) ifTrue:[^ 1].
- (linePixelWidth <= xRel) ifTrue:[
- fontWidth == 0 ifTrue:[
- "
- although this 'cannot happen',
- it seems that X reports this width for some strange fonts ...
- "
- ^ lineString size
- ].
- ^ lineString size + ((xRel - linePixelWidth) // fontWidth) + 1
- ].
- runCol := lineString size // 2.
- (runCol == 0) ifTrue:[runCol := 1].
- posLeft := font widthOf:lineString from:1 to:(runCol - 1).
- posRight := font widthOf:lineString from:1 to:runCol.
- done := (posLeft <= xRel) and:[posRight > xRel].
- [done] whileFalse:[
- (posRight <= xRel) ifTrue:[
- runCol := runCol + 1.
- posLeft := posRight.
- posRight := font widthOf:lineString from:1 to:runCol
- ] ifFalse:[
- (posLeft > xRel) ifTrue:[
- runCol := runCol - 1.
- (runCol == 0) ifTrue:[^ 0].
- posRight := posLeft.
- posLeft := font widthOf:lineString from:1 to:(runCol - 1)
- ]
- ].
- done := (posLeft <= xRel) and:[posRight > xRel]
- ].
- ^ runCol
+on:aModel aspect:aspectSymbol change:changeSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:changeSymbol list:nil menu:menuSymbol
!
-convertRTF:aList
- "this is a q&d RTF to poor-text converter which removes any rich stuff.
- - a first shot 'til DocumentView is finished ..."
-
- |newList newLine charIndex inEscape char special|
-
- newList := StringCollection new:200.
- newList grow:0.
-
- newLine := ''.
- aList do:[:line |
- ((line size == 0) or:[line isBlank]) ifTrue:[
- newList add:newLine.
- newLine := ''
- ] ifFalse:[
- special := ((line at:1) == ${) or:[(line includes:$\)].
- special := special or:[(line at:1) == $}].
- special ifFalse:[
- newList add:(newLine , line)
- ] ifTrue:[
- charIndex := 1.
- [charIndex <= line size] whileTrue:[
- char := line at:charIndex.
- ((char == ${ ) or:[char == $} ]) ifTrue:[
- "left-brace: ignore rest of line"
- charIndex := line size + 1
- ] ifFalse:[
- (char == $\) ifTrue:[
- inEscape := true
- ] ifFalse:[
- inEscape ifTrue:[
- (char == Character space) ifTrue:[
- inEscape := false
- ]
- ] ifFalse:[
- newLine := newLine copyWith:char
- ]
- ].
- charIndex := charIndex + 1
- ]
- ]
- ]
- ]
- ].
- ^ newList
+on:aModel aspect:aspectSymbol list:listSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:nil list:listSymbol menu:menuSymbol
!
-listAt:lineNr from:startCol to:endCol
- "return substring from startCol to endCol of a line"
-
- |line stop lineLen|
-
- line := self listAt:lineNr.
- line isNil ifTrue:[^ nil].
- lineLen := line size.
- (startCol > lineLen) ifTrue:[^ nil].
- stop := endCol.
- (stop > lineLen) ifTrue:[stop := lineLen].
- ^ line copyFrom:startCol to:stop
-!
-
-widthOfLineString:entry
- "return the width of an entry"
-
- entry isNil ifTrue:[^ 0].
- entry isString ifTrue:[
- ^ font widthOf:entry
- ].
- ^ entry widthIn:self
-!
-
-widthOfWidestLineBetween:firstLine and:lastLine
- "return the width in pixels of the widest line in a range
- - used to optimize scrolling, by limiting the scrolled area"
-
- |max "{ Class: SmallInteger }"
- first "{ Class: SmallInteger }"
- last "{ Class: SmallInteger }"
- thisLen "{ Class: SmallInteger }"
- listSize "{ Class: SmallInteger }" |
-
- includesNonStrings ifTrue:[
- ^ width
- ].
-
- fontIsFixedWidth ifTrue:[
- ^ (self lengthOfLongestLineBetween:firstLine and:lastLine) * fontWidth
- ].
- listSize := self size.
- max := 0.
- first := firstLine.
- last := lastLine.
-
- (first > listSize) ifTrue:[^ max].
- (last > listSize) ifTrue:[
- last := listSize
- ].
-
- self from:first to:last do:[:line |
- line notNil ifTrue:[
- thisLen := font widthOf:line.
- (thisLen > max) ifTrue:[
- max := thisLen
- ]
- ]
+on:aModel aspect:aspectSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:menuSymbol
+! !
+
+!ListView methodsFor:'change and update '!
+
+update:something with:aParameter from:changedObject
+ changedObject == model ifTrue:[
+ (aspectMsg notNil
+ and:[something == aspectMsg]) ifTrue:[
+ ^ self getListFromModel.
+ ].
].
- ^ max
-!
-
-listAt:lineNr from:startCol
- "return right substring from startCol to end of a line"
-
- |line|
-
- line := self listAt:lineNr.
- line isNil ifTrue:[^ nil].
- (startCol > line size) ifTrue:[^ nil].
- ^ line copyFrom:startCol
-!
-
-lineOfCharacterPosition:charPos
- "given a character index within the contents-string,
- return the lineNumber where the character is
- - used to find line to hilight from Compilers error-position"
-
- |lineNr sum lastLine|
-
- lineNr := 1.
- sum := 0.
- lastLine := self size.
- [sum < charPos] whileTrue:[
- (lineNr > lastLine) ifTrue:[^ lineNr - 1].
- sum := sum + (self at:lineNr) size + 1.
- lineNr := lineNr + 1
- ].
- ^ lineNr - 1
-!
-
-characterPositionOfLine:lineNr col:col
- "given a line/col position, return the character index within the contents-string,
- - used with Compilers error-positioning"
-
- |lineString pos|
-
- self checkForExistingLine:lineNr.
- pos := 1.
- 1 to:(lineNr - 1) do:[:lnr |
- lineString := self at:lnr.
- lineString notNil ifTrue:[
- pos := pos + lineString size
- ].
- pos := pos + 1 "the return-character"
- ].
- ^ pos + col - 1
-
-!
-
-listAt:lineNr to:endCol
- "return left substring from start to endCol of a line"
-
- |line stop|
-
- line := self listAt:lineNr.
- line isNil ifTrue:[^ nil].
- stop := endCol.
- (stop > line size) ifTrue:[stop := line size].
- ^ line copyTo:stop
+ ^ super update:something with:aParameter from:changedObject
! !
!ListView methodsFor:'drawing'!
@@ -1009,8 +709,8 @@
y := self yOfVisibleLine:startVisLineNr.
self paint:bg.
self fillRectangleX:margin y:y-(lineSpacing//2)
- width:(width - (margin * 2))
- height:(endVisLineNr - startVisLineNr + 1) * fontHeight.
+ width:(width - (margin * 2))
+ height:(endVisLineNr - startVisLineNr + 1) * fontHeight.
list isNil ifTrue:[^ self].
y := y + fontAscent.
@@ -1019,28 +719,28 @@
startLine := startVisLineNr + firstLineShown - 1.
endLine := endVisLineNr + firstLineShown - 1.
(startLine == 0) ifTrue:[
- y := y + fontHeight.
- startLine := startLine + 1
+ y := y + fontHeight.
+ startLine := startLine + 1
].
(endLine > listSize) ifTrue:[
- e := listSize
+ e := listSize
] ifFalse:[
- e := endLine
+ e := endLine
].
(startLine <= e) ifTrue:[
- x := textStartLeft - leftOffset.
- self paint:fg.
- self from:startLine to:e do:[:line |
- line notNil ifTrue:[
- self displayString:line x:x y:y
- ].
- y := y + fontHeight
- ]
+ x := textStartLeft - leftOffset.
+ self paint:fg on:bg.
+ self from:startLine to:e do:[:line |
+ line notNil ifTrue:[
+ self displayOpaqueString:line x:x y:y
+ ].
+ y := y + fontHeight
+ ]
]
- "Modified: 22.11.1995 / 23:42:37 / cg"
+ "Modified: 11.12.1995 / 17:04:29 / cg"
!
drawLine:line atX:x inVisible:visLineNr with:fg and:bg
@@ -1053,14 +753,14 @@
y := self yOfVisibleLine:visLineNr.
self paint:bg.
self fillRectangleX:margin y:y - (lineSpacing//2)
- width:(width - (margin * 2))
- height:fontHeight.
+ width:(width - (margin * 2))
+ height:fontHeight.
line notNil ifTrue:[
- self paint:fg.
- self displayString:line x:x y:(y + fontAscent)
+ self paint:fg on:bg.
+ self displayOpaqueString:line x:x y:(y + fontAscent)
]
- "Modified: 22.11.1995 / 23:42:45 / cg"
+ "Modified: 11.12.1995 / 17:04:00 / cg"
!
drawLine:line inVisible:visLineNr with:fg and:bg
@@ -1069,12 +769,6 @@
self drawLine:line atX:(textStartLeft - leftOffset) inVisible:visLineNr with:fg and:bg
!
-drawVisibleLine:visLineNr with:fg and:bg
- "draw a visible line in fg/bg"
-
- self drawLine:(self visibleAt:visLineNr) atX:(textStartLeft - leftOffset) inVisible:visLineNr with:fg and:bg
-!
-
drawVisibleLine:visLineNr col:col with:fg and:bg
"draw single character at col index of visible line in fg/bg"
@@ -1106,1535 +800,124 @@
"Modified: 22.11.1995 / 23:42:27 / cg"
!
-drawVisibleLine:visLineNr from:startCol with:fg and:bg
- "draw right part of a visible line from startCol to end of line in fg/bg"
-
- |y x lineString index1 index2|
-
- (startCol < 1) ifTrue:[
- index1 := 1
- ] ifFalse:[
- index1 := startCol
- ].
- y := self yOfVisibleLine:visLineNr.
- x := (self xOfCol:index1 inVisibleLine:visLineNr) - leftOffset.
- self paint:bg.
- self fillRectangleX:x y:y - (lineSpacing // 2)
- width:(width + leftOffset - x)
- height:fontHeight.
-
- lineString := self visibleAt:visLineNr.
- lineString notNil ifTrue:[
- lineString isString ifFalse:[
- self drawVisibleLine:visLineNr with:fg and:bg.
- ] ifTrue:[
- index2 := lineString size.
- (index2 < index1) ifTrue:[^ self].
- (index1 <= index2) ifTrue:[
- self paint:fg.
- self displayString:lineString from:index1 to:index2 x:x y:(y + fontAscent)
- ]
- ]
- ]
-
- "Modified: 22.11.1995 / 23:43:37 / cg"
-!
-
drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
"draw part of a visible line in fg/bg"
|y yf x lineString len characterString|
(endCol >= startCol) ifTrue:[
- lineString := self visibleAt:visLineNr.
-
- (lineString notNil and:[lineString isString not]) ifTrue:[
- self drawVisibleLine:visLineNr with:fg and:bg.
- ] ifFalse:[
- x := (self xOfCol:startCol inVisibleLine:visLineNr) - leftOffset.
- y := (self yOfVisibleLine:visLineNr).
- yf := y - (lineSpacing // 2).
- len := lineString size.
- (startCol > len) ifTrue:[
- len := endCol - startCol + 1.
- self paint:bg.
- self fillRectangleX:x y:yf
- width:(fontWidth * len)
- height:fontHeight
- ] ifFalse:[
- (endCol > len) ifTrue:[
- characterString := String new:endCol.
- characterString replaceFrom:1 to:len with:lineString startingAt:1.
- lineString := characterString
- ].
- self paint:bg.
- self fillRectangleX:x y:yf width:(font widthOf:lineString from:startCol to:endCol)
- height:fontHeight.
- self paint:fg.
- self displayString:lineString from:startCol to:endCol x:x y:(y + fontAscent)
- ]
- ]
- ]
-
- "Modified: 22.11.1995 / 23:43:21 / cg"
-! !
-
-!ListView methodsFor:'queries'!
-
-numberOfLines
- "return the number of lines the text has"
-
- ^ self size
-!
-
-lengthOfLongestLine
- "return the length (in characters) of the longest line"
-
- ^ self lengthOfLongestLineBetween:1 and:self size
-!
-
-lengthOfLongestLineBetween:firstLine and:lastLine
- "return the length (in characters) of the longest line in a line-range"
-
- |max "{ Class: SmallInteger }"
- thisLen "{ Class: SmallInteger }"
- listSize "{ Class: SmallInteger }"
- first "{ Class: SmallInteger }"
- last "{ Class: SmallInteger }" |
-
- list isNil ifTrue:[^ 0].
-
- listSize := self size.
- max := 0.
- first := firstLine.
- last := lastLine.
-
- (first > listSize) ifTrue:[^ max].
- (last > listSize) ifTrue:[
- last := listSize
- ].
- self from:first to:last do:[:lineString |
- lineString notNil ifTrue:[
- thisLen := lineString size.
- (thisLen > max) ifTrue:[
- max := thisLen
- ]
- ]
- ].
- ^ max
-
-!
-
-widthOfContents
- "return the width of the contents in pixels
- - used for scrollbar interface"
-
- |max|
-
- list isNil ifTrue:[^ 0].
- widthOfWidestLine notNil ifTrue:[^ widthOfWidestLine + (leftMargin * 2)].
-
- includesNonStrings ifTrue:[
- max := list
- inject:0
- into:[:maxSoFar :entry |
- (
- entry isNil ifTrue:[
- 0
- ] ifFalse:[
- entry isString ifTrue:[
- font widthOf:entry
- ] ifFalse:[
- entry widthIn:self
- ]
- ]
- ) max:maxSoFar.
- ]
- ] ifFalse:[
- fontIsFixedWidth ifTrue:[
- max := self lengthOfLongestLine * fontWidth
- ] ifFalse:[
- max := 0.
- list notNil ifTrue:[
- max := max max:(font widthOf:list)
- ].
- ].
- ].
- widthOfWidestLine := max.
- ^ max + (leftMargin * 2)
-!
-
-yOriginOfContents
- "return the vertical origin of the contents in pixels
- - used for scrollbar interface"
-
- ^ (firstLineShown - 1) * fontHeight
-!
-
-heightOfContents
- "return the height of the contents in pixels
- - used for scrollbar interface"
-
- | numLines |
-
- numLines := self numberOfLines.
- numLines == 0 ifTrue:[^ 0].
-
- "/
- "/ kludge for last partial line
- "/
-"/ nFullLinesShown ~~ nLinesShown ifTrue:[
-"/ numLines := numLines + 1
-"/ ].
- "
- need device-font for query
- "
- font := font on:device.
- ^ numLines * fontHeight
-"/ + textStartTop
- - (lineSpacing // 2)
-"/ + (font descent)
-"/ + (font descent * 2) "makes it look better"
- .
-
-"/ "it used to be that code - which is wrong"
-"/ (nLinesShown == nFullLinesShown) ifTrue:[
-"/ ^ numLines * fontHeight
-"/ ].
-"/ "add one - otherwise we cannot make last line
-"/ fully visible since scrolling is done by full lines only"
-"/
-"/ ^ (numLines + 1) * fontHeight
-!
-
-xOriginOfContents
- "return the horizontal origin of the contents in pixels
- - used for scrollbar interface"
-
- ^ leftOffset
-!
-
-firstLineShown
- "return the index of the first (possibly partial) visible line"
-
- ^ firstLineShown
-!
-
-lastLineShown
- "return the index of the last (possibly partial) visible line"
-
- ^ firstLineShown + nLinesShown
-!
-
-leftIndentOfLine:lineNr
- "return the number of spaces at the left in line, lineNr.
- returns 0 for empty lines."
-
- |lineString index end|
-
- lineString := self listAt:lineNr.
- lineString notNil ifTrue:[
- index := 1.
- end := lineString size.
- [index <= end] whileTrue:[
- (lineString at:index) isSeparator ifFalse:[^ index - 1].
- index := index + 1
- ]
- ].
- ^ 0
-!
-
-lineIsVisible:line
- "is line visible?"
-
- (line >= firstLineShown and:[ line < (firstLineShown + nLinesShown) ]) ifTrue:[ ^ true ].
- ^ false.
-! !
-
-!ListView methodsFor:'scrolling'!
-
-makeVisible:someString
- "if nescessary, scroll to make the (first)
- line containing someString visible."
-
- |line index|
-
- index := self list indexOf:someString.
- index ~~ 0 ifTrue:[
- self makeLineVisible:index
- ]
-!
-
-makeLineVisible:aListLineNr
- "if aListLineNr is not visible, scroll to make it visible.
- Numbering starts with 1 for the very first line of the text."
-
- |bott|
-
- (aListLineNr isNil "or:[shown not]") ifTrue:[^ self].
-
- (aListLineNr >= firstLineShown) ifTrue:[
- (aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
- ^ self
- ]
- ].
- (aListLineNr < nFullLinesShown) ifTrue:[
- ^ self scrollToLine:1
- ].
- (nFullLinesShown < 3) ifTrue:[
- ^ self scrollToLine:aListLineNr
- ].
- bott := self numberOfLines - (nFullLinesShown - 1).
- (aListLineNr > bott) ifTrue:[
- ^ self scrollToLine:bott
- ].
- self scrollToLine:(aListLineNr - (nFullLinesShown // 2) + 1)
-!
-
-scrollDown:nLines
- "change origin to scroll down some lines"
-
- |w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- count "{ Class:SmallInteger }"
- y0 "{ Class:SmallInteger }"
- nPixel sz|
-
- count := nLines.
- sz := self size.
- (firstLineShown + nLines + nFullLinesShown > sz) ifTrue:[
- count := sz - firstLineShown - nFullLinesShown + 1
- ].
- count <= 0 ifTrue:[^ self].
-
- self originWillChange.
- nPixel := fontHeight * count.
-
- shown ifFalse:[
- firstLineShown := firstLineShown + count.
- viewOrigin := viewOrigin x @ (viewOrigin y + nPixel).
- ] ifTrue:[
- (count >= nLinesShown) ifTrue:[
- firstLineShown := firstLineShown + count.
- viewOrigin := viewOrigin x @ (viewOrigin y + nPixel).
- self redrawFromVisibleLine:1 to:nLinesShown.
- ] ifFalse:[
- m2 := margin * 2.
- w := self widthForScrollBetween:firstLineShown
- and:(firstLineShown + nLinesShown).
- w := w + leftMargin.
-
- y0 := textStartTop - (lineSpacing//2).
- h := nPixel + y0.
-
- self catchExpose.
- self copyFrom:self x:margin y:h
- toX:margin y:y0
- width:w height:(height - h + (lineSpacing//2)).
-
- firstLineShown := firstLineShown + count.
- viewOrigin := viewOrigin x @ (viewOrigin y + nPixel).
- self redrawFromVisibleLine:(nFullLinesShown - count + 1) to:nLinesShown.
- self waitForExpose.
- ].
- ].
- self originChanged:count.
-!
-
-scrollToLine:aLineNr
- "change origin to make aLineNr be the top line"
-
- aLineNr < firstLineShown ifTrue:[
- self scrollUp:(firstLineShown - aLineNr)
- ] ifFalse:[
- aLineNr > firstLineShown ifTrue:[
- self scrollDown:(aLineNr - firstLineShown)
- ]
- ]
-!
-
-scrollToTop
- "change origin to start of text"
-
- self scrollToLine:1
-!
-
-makeColVisible:aCol inLine:aLineNr
- "if column aCol is not visible, scroll horizontal to make it visible"
-
- |xWant xVis visLnr|
-
- (aCol isNil or:[shown not]) ifTrue:[^ self].
-
- visLnr := self absoluteLineToVisibleLine:aLineNr.
- visLnr isNil ifTrue:[^ self].
-
- xWant := self xOfCol:aCol inVisibleLine:visLnr.
- xVis := xWant - leftOffset.
-
- "
- dont scroll, if already visible
- (but scroll, if not in inner 20%..80% of visible area)
- "
-"/ ((xVis >= (width // 5)) and:[xVis <= (width * 4 // 5)]) ifTrue:[
-"/ ^ self
-"/ ].
-
- "
- no, the above does not look good, if you click / select at the
- far right - makes selecting so difficult ...
- "
- (xVis >= 0 and:[xVis < (width - font width)]) ifTrue:[^ self].
-
- self scrollHorizontalTo:(xWant - (width // 2)).
-!
-
-scrollDown
- "change origin to scroll down one line"
-
- self scrollDown:1
-!
-
-scrollToLeft
- "change origin to start (left) of text"
-
- leftOffset ~~ 0 ifTrue:[
- self scrollToCol:1
+ lineString := self visibleAt:visLineNr.
+
+ (lineString notNil and:[lineString isString not]) ifTrue:[
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ ] ifFalse:[
+ x := (self xOfCol:startCol inVisibleLine:visLineNr) - leftOffset.
+ y := (self yOfVisibleLine:visLineNr).
+ yf := y - (lineSpacing // 2).
+ len := lineString size.
+ (startCol > len) ifTrue:[
+ len := endCol - startCol + 1.
+ self paint:bg.
+ self fillRectangleX:x y:yf
+ width:(fontWidth * len)
+ height:fontHeight
+ ] ifFalse:[
+ (endCol > len) ifTrue:[
+ characterString := String new:endCol.
+ characterString replaceFrom:1 to:len with:lineString startingAt:1.
+ lineString := characterString
+ ].
+ self paint:bg.
+ self fillRectangleX:x y:yf width:(font widthOf:lineString from:startCol to:endCol)
+ height:fontHeight.
+ self paint:fg on:bg.
+ self displayOpaqueString:lineString from:startCol to:endCol x:x y:(y + fontAscent)
+ ]
+ ]
]
-!
-
-viewOrigin
- "return the viewOrigin; thats the coordinate of the contents
- which is shown topLeft in the view
- (i.e. the origin of the visible part of the contents)."
-
- ^ viewOrigin
-!
-
-gotoLine:aLineNumber
- "position to line aLineNumber; this may be redefined
- in subclasses (for example to move the cursor also)"
-
- ^ self scrollToLine:aLineNumber
-!
-
-scrollUp:nLines
- "change origin to scroll up some lines"
-
- |w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- count "{ Class:SmallInteger }"
- nPixel|
-
- count := nLines.
- count >= firstLineShown ifTrue:[
- count := firstLineShown - 1
- ].
- (count == 0) ifTrue:[^ self].
-
- self originWillChange.
- nPixel := fontHeight * count.
- shown ifFalse:[
- firstLineShown := firstLineShown - count.
- viewOrigin := viewOrigin x @ (viewOrigin y - nPixel).
- ] ifTrue:[
- (count >= nLinesShown) ifTrue:[
- firstLineShown := firstLineShown - count.
- viewOrigin := viewOrigin x @ (viewOrigin y - nPixel).
- self redrawFromVisibleLine:1 to:nLinesShown.
- ] ifFalse:[
- w := self widthForScrollBetween:firstLineShown
- and:(firstLineShown + nLinesShown).
- w := w + leftMargin.
- h := nPixel + margin.
- self catchExpose.
- self copyFrom:self x:margin y:margin
- toX:margin y:h
- width:w height:(height - h).
- firstLineShown := firstLineShown - count.
- viewOrigin := viewOrigin x @ (viewOrigin y - nPixel).
- self redrawFromVisibleLine:1 to:count.
- self waitForExpose.
- ].
- ].
- self originChanged:(count negated).
-!
-
-pageDown
- "change origin to display next page"
-
- |nLines|
-
- nLines := nFullLinesShown.
- (firstLineShown + nLines + nFullLinesShown > self size) ifTrue:[
- nLines := self size - firstLineShown - nFullLinesShown + 1
- ].
- nLines <= 0 ifTrue:[^ self].
-
- self originWillChange.
- firstLineShown := firstLineShown + nLines.
- self originChanged:nLines.
- self redrawFromVisibleLine:1 to:nLinesShown
-
-!
-
-scrollVerticalToPercent:percent
- "scroll to a position given in percent of total"
-
- |nL lineNr|
-
- nL := self numberOfLines.
- "/
- "/ kludge for last partial line
- "/
- nFullLinesShown ~~ nLinesShown ifTrue:[
- nL := nL + 1
- ].
- lineNr := (((nL * percent) asFloat / 100.0) + 0.5) asInteger + 1.
- self scrollToLine:lineNr
-!
-
-pageUp
- "change origin to display previous page"
-
- |oldOrg|
-
- (firstLineShown == 1) ifFalse:[
- self originWillChange.
- oldOrg := firstLineShown.
- firstLineShown := firstLineShown - nFullLinesShown.
- (firstLineShown < 1) ifTrue:[
- firstLineShown := 1
- ].
- self originChanged:(firstLineShown - oldOrg).
- self redrawFromVisibleLine:1 to:nLinesShown
- ]
-!
-
-halfPageDown
- "scroll down half a page"
-
- self scrollDown:(nFullLinesShown // 2)
-!
-
-halfPageUp
- "scroll up half a page"
-
- self scrollUp:(nFullLinesShown // 2)
-!
-
-scrollUp
- "change origin to scroll up one line"
-
- self scrollUp:1
-!
-
-scrollToBottom
- "change origin to show end of text"
-
- "scrolling to the end is not really correct (i.e. should scroll to list size - nFullLinesShown),
- but scrollDown: will adjust it ..."
-
- self scrollToLine:(self size)
-!
-
-scrollToCol:aColNr
- "change origin to make aColNr be the left col"
-
- |pxlOffset|
-
- aColNr == 1 ifTrue:[
- leftOffset ~~ 0 ifTrue:[
- self scrollLeft:leftOffset.
- ].
- ^ self
- ].
-
- pxlOffset := font width * (aColNr - 1).
-
- pxlOffset < leftOffset ifTrue:[
- self scrollLeft:(leftOffset - pxlOffset)
- ] ifFalse:[
- pxlOffset > leftOffset ifTrue:[
- self scrollRight:(pxlOffset - leftOffset)
- ]
- ]
-!
-
-stopAutoScroll
- "stop any auto-scroll"
-
- autoScrollBlock notNil ifTrue:[
- self compressMotionEvents:true.
- Processor removeTimedBlock:autoScrollBlock.
- autoScrollBlock := nil.
- autoScrollDeltaT := nil
- ].
-!
-
-scrollSelectUp
- "just a template - I do not know anything about selections"
-
- ^ self subclassResponsibility
-!
-
-scrollSelectDown
- "just a template - I do not know anything about selections"
-
- ^ self subclassResponsibility
-!
-
-startAutoScrollDown:yDistance
- "setup for auto-scroll down (when button-press-moving below view)
- - timeDelta for scroll is computed from distance"
-
- |deltaT mm|
-
- autoScroll ifFalse:[^ self].
-
- mm := yDistance // self verticalIntegerPixelPerMillimeter + 1.
- deltaT := 0.5 / mm.
-
- (deltaT = autoScrollDeltaT) ifFalse:[
- autoScrollDeltaT := deltaT.
- autoScrollBlock isNil ifTrue:[
- autoScrollBlock := [self scrollSelectDown].
- Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
- ]
- ]
-!
-
-startAutoScrollUp:yDistance
- "setup for auto-scroll up (when button-press-moving below view)
- - timeDelta for scroll is computed from distance"
-
- |deltaT mm|
-
- autoScroll ifFalse:[^ self].
-
- mm := yDistance negated // self verticalIntegerPixelPerMillimeter + 1.
- deltaT := 0.5 / mm.
-
- (deltaT = autoScrollDeltaT) ifFalse:[
- autoScrollDeltaT := deltaT.
- autoScrollBlock isNil ifTrue:[
- autoScrollBlock := [self scrollSelectUp].
- Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
- ]
- ]
-!
-
-startAutoScrollRight:xDistance
- "setup for auto-scroll down (when button-press-moving to the right of the view)
- - timeDelta for scroll is computed from distance"
-
- |deltaT mm|
-
- autoScroll ifFalse:[^ self].
-
- mm := xDistance // self horizontalIntegerPixelPerMillimeter + 1.
- deltaT := 0.5 / mm.
-
- (deltaT = autoScrollDeltaT) ifFalse:[
- autoScrollDeltaT := deltaT.
- autoScrollBlock isNil ifTrue:[
- autoScrollBlock := [self scrollSelectRight].
- Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
- ]
- ]
-!
-
-startAutoScrollLeft:xDistance
- "setup for auto-scroll up (when button-press-moving to the left of the view)
- - timeDelta for scroll is computed from distance"
-
- |deltaT mm|
-
- autoScroll ifFalse:[^ self].
-
- mm := xDistance negated // self horizontalIntegerPixelPerMillimeter + 1.
- deltaT := 0.5 / mm.
-
- (deltaT = autoScrollDeltaT) ifFalse:[
- autoScrollDeltaT := deltaT.
- autoScrollBlock isNil ifTrue:[
- autoScrollBlock := [self scrollSelectLeft].
- Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
- ]
- ]
-!
-
-scrollRight
- "scroll right by one character
- - question is how much is a good for variable fonts"
-
- self scrollRight:font width
-!
-
-scrollRight:nPixel
- "change origin to scroll right some cols"
-
- |wMax cnt|
-
-
- cnt := nPixel.
-
-"
- commenting out the block below allows scrolling to the right of
- the widest line
-"
-" "
- "
- the 10 below allows scrolling somewhat behind the end of the line
- "
- wMax := self widthOfContents + 10.
- (leftOffset + nPixel + width > wMax) ifTrue:[
- cnt := wMax - leftOffset - width
- ].
-" "
- cnt <= 0 ifTrue:[^ self].
- self originWillChange.
- leftOffset := leftOffset + cnt.
- viewOrigin := leftOffset @ viewOrigin y.
- self redrawFromVisibleLine:1 to:nLinesShown.
- self originChanged:(cnt @ 0)
-!
-
-scrollLeft
- "scroll left by one character
- - question is how much is a good for variable fonts"
-
- self scrollLeft:font width
-!
-
-scrollLeft:nPixel
- "change origin to scroll left some cols"
-
- |newLeftOffset|
-
- nPixel <= 0 ifTrue:[^ self].
-
- newLeftOffset := leftOffset - nPixel.
- newLeftOffset <= 0 ifTrue:[
- leftOffset == 0 ifTrue:[^ self].
- newLeftOffset := 0
- ].
-
- self originWillChange.
- leftOffset := newLeftOffset.
- viewOrigin := newLeftOffset @ viewOrigin y.
- self redrawFromVisibleLine:1 to:nLinesShown.
- self originChanged:(0 @ nPixel)
-!
-
-scrollHorizontalTo:aPixelOffset
- "change origin to make aPixelOffset be the left col"
-
- |orgX|
-
- orgX := leftOffset.
-
- (aPixelOffset < orgX) ifTrue:[
- self scrollLeft:(orgX - aPixelOffset)
- ] ifFalse:[
- (aPixelOffset > orgX) ifTrue:[
- self scrollRight:(aPixelOffset - orgX)
- ]
- ]
-! !
-
-!ListView methodsFor:'tabulators'!
-
-expandTabs
- "go through whole text expanding tabs into spaces.
- This is meant to be called for text being imported from a file.
- Therefore, 8-col tabs are assumed - independent of any private tab setting."
-
- |line newLine nLines "{ Class: SmallInteger }"|
-
- includesNonStrings := false.
- list notNil ifTrue:[
- nLines := self size.
- 1 to:nLines do:[:index |
- line := self at:index.
- line notNil ifTrue:[
- line isString ifTrue:[
- newLine := line withTabsExpanded.
- newLine ~~ line ifTrue:[
- self withoutRedrawAt:index put:newLine
- ].
- ] ifFalse:[
- includesNonStrings := true.
- ]
- ]
- ]
- ]
-
- "Modified: 30.8.1995 / 19:06:37 / claus"
+
+ "Modified: 11.12.1995 / 17:15:33 / cg"
!
-withTabs:tabulatorTable expand:line
- "expand tabs into spaces, return a new line string,
- or original line, if no tabs are included.
- good idea, to make this one a primitive, since it is called
- many times if a big text is read from a file."
-
- |tmpString nString nTabs
- currentMax "{ Class: SmallInteger }"
- dstIndex "{ Class: SmallInteger }"
- nextTab "{ Class: SmallInteger }" |
-
- "
- the code below tries to avoid creating too much garbage;
- therefore, the string is scanned first for the number of
- tabs to get a rough idea of the final strings size.
- (it could be done better, by computing the exact size
- required here ...)
- "
- line isNil ifTrue:[^ line].
- nTabs := line occurrencesOf:(Character tab).
- nTabs == 0 ifTrue:[^ line].
-
- currentMax := line size + (nTabs * 7).
- tmpString := String new:currentMax.
- dstIndex := 1.
- line do:[:character |
- (character == (Character tab)) ifTrue:[
- nextTab := self nextTabAfter:dstIndex in:tabulatorTable.
- [dstIndex < nextTab] whileTrue:[
- tmpString at:dstIndex put:(Character space).
- dstIndex := dstIndex + 1
- ]
- ] ifFalse:[
- tmpString at:dstIndex put:character.
- 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)
- with:tmpString startingAt:1.
- tmpString := nString.
- nString := nil
- ].
-
- "make stc-optimizer happy
- - no need to return value of ifTrue:/ifFalse above"
- 0
- ].
- dstIndex := dstIndex - 1.
- dstIndex == currentMax ifTrue:[
- ^ tmpString
- ].
- ^ tmpString copyTo:dstIndex
-!
-
-setTab4
- "set 4-character tab stops"
-
- tabPositions := self class tab4Positions.
-!
-
-setTab8
- "set 8-character tab stops"
-
- tabPositions := self class tab8Positions.
-!
-
-nextTabAfter:colNr in:tabPositions
- "return the next tab position after col.
- The second arg, tabPositions is a collection of tabStops."
-
- |col "{ Class: SmallInteger }"
- tabIndex "{ Class: SmallInteger }"
- thisTab "{ Class: SmallInteger }"
- nTabs "{ Class: SmallInteger }" |
-
- tabIndex := 1.
- col := colNr.
- thisTab := tabPositions at:tabIndex.
- nTabs := tabPositions size.
- [thisTab <= col] whileTrue:[
- (tabIndex == nTabs) ifTrue:[^ thisTab].
- tabIndex := tabIndex + 1.
- thisTab := tabPositions at:tabIndex
+drawVisibleLine:visLineNr from:startCol with:fg and:bg
+ "draw right part of a visible line from startCol to end of line in fg/bg"
+
+ |y x lineString index1 index2|
+
+ (startCol < 1) ifTrue:[
+ index1 := 1
+ ] ifFalse:[
+ index1 := startCol
].
- ^ thisTab
-!
-
-nextTabAfter:colNr
- "return the next tab position after col"
-
- ^ self nextTabAfter:colNr in:tabPositions
-!
-
-prevTabBefore:colNr
- "return the prev tab position before col"
-
- |col "{ Class: SmallInteger }"
- tabIndex "{ Class: SmallInteger }"
- thisTab "{ Class: SmallInteger }"
- nTabs "{ Class: SmallInteger }" |
-
- tabIndex := 1.
- col := colNr.
- thisTab := tabPositions at:tabIndex.
- nTabs := tabPositions size.
- [thisTab < col] whileTrue:[
- (tabIndex == nTabs) ifTrue:[^ thisTab].
- tabIndex := tabIndex + 1.
- thisTab := tabPositions at:tabIndex
- ].
- (tabIndex == 1) ifTrue:[
- ^ 1
- ].
- ^ tabPositions at:(tabIndex - 1)
-!
-
-withTabsExpanded:line
- "expand tabs into spaces, return a new line string,
- or original line, if no tabs are included.
- good idea, to make this one a primitive"
-
- ^ self withTabs:tabPositions expand:line
-!
-
-withTabs:line
- "Assuming an 8-character tab,
- compress multiple leading spaces to tabs, return a new line string
- or the original line, if no tabs where created.
- good idea, to make this one a primitive, since its called
- many times when a big text is saved to a file."
-
- |newLine eightSpaces nTabs|
-
- "
- the code below is a hack, producing many garbage strings for lines
- which compress multiple tabs ... needs rewrite: saving big files
- stresses the garbage collector a bit ...
- "
- line isNil ifTrue:[^ line].
- eightSpaces := ' '.
- (line startsWith:eightSpaces) ifFalse:[^ line].
-
- nTabs := 1.
- newLine := line copyFrom:9.
- [newLine startsWith:eightSpaces] whileTrue:[
- newLine := newLine copyFrom:9.
- nTabs := nTabs + 1.
- ].
- ^ (String new:nTabs withAll:Character tab) asString , newLine.
-! !
-
-!ListView methodsFor:'redrawing'!
-
-redrawLine:lineNr
- "redraw a list line"
-
- |visibleLine|
-
- visibleLine := self listLineToVisibleLine:lineNr.
- visibleLine notNil ifTrue:[
- self redrawVisibleLine:visibleLine
- ]
-!
-
-redrawVisibleLine:visLineNr col:col
- "redraw single character at col index of visible line"
-
- shown ifTrue:[
- self drawVisibleLine:visLineNr col:col with:fgColor and:bgColor
- ]
-!
-
-redrawFromVisibleLine:startVisLineNr to:endVisLineNr
- "redraw a visible line range"
-
- shown ifTrue:[
- self drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fgColor and:bgColor
+ y := self yOfVisibleLine:visLineNr.
+ x := (self xOfCol:index1 inVisibleLine:visLineNr) - leftOffset.
+ self paint:bg.
+ self fillRectangleX:x y:y - (lineSpacing // 2)
+ width:(width + leftOffset - x)
+ height:fontHeight.
+
+ lineString := self visibleAt:visLineNr.
+ lineString notNil ifTrue:[
+ lineString isString ifFalse:[
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ ] ifTrue:[
+ index2 := lineString size.
+ (index2 < index1) ifTrue:[^ self].
+ (index1 <= index2) ifTrue:[
+ self paint:fg on:bg.
+ self displayOpaqueString:lineString from:index1 to:index2 x:x y:(y + fontAscent)
+ ]
+ ]
]
-!
-
-redrawLine:lineNr from:startCol
- "redraw a list line from startCol to end of line"
-
- |visibleLine|
-
- visibleLine := self listLineToVisibleLine:lineNr.
- visibleLine notNil ifTrue:[
- self redrawVisibleLine:visibleLine from:startCol
- ]
-!
-
-redrawVisibleLine:visLineNr from:startCol
- "redraw right part of a visible line from startCol to end of line"
-
- shown ifTrue:[
- self drawVisibleLine:visLineNr from:startCol with:fgColor and:bgColor
- ]
-!
-
-redrawLine:lineNr col:col
- "redraw a single character"
-
- |visibleLine|
-
- visibleLine := self listLineToVisibleLine:lineNr.
- visibleLine notNil ifTrue:[
- self redrawVisibleLine:visibleLine col:col
- ]
-!
-
-redrawVisibleLine:visLineNr
- "redraw a visible line"
-
- shown ifTrue:[
- self drawVisibleLine:visLineNr with:fgColor and:bgColor
- ]
-!
-
-redrawLine:lineNr from:startCol to:endCol
- "redraw a list line from startCol to endCol"
-
- |visibleLine|
-
- visibleLine := self listLineToVisibleLine:lineNr.
- visibleLine notNil ifTrue:[
- self redrawVisibleLine:visibleLine from:startCol to:endCol
- ]
-!
-
-redrawVisibleLine:visLineNr from:startCol to:endCol
- "redraw part of a visible line"
-
- shown ifTrue:[
- self drawVisibleLine:visLineNr from:startCol to:endCol with:fgColor and:bgColor
- ]
-!
-
-redrawFromLine:lineNr
- "redraw starting at linrNr"
-
- |visibleLine first|
-
- shown ifTrue:[
- "if first line to redraw is above 1st visible line,
- start redraw at 1st visible line"
- (lineNr < firstLineShown) ifTrue:[
- first := firstLineShown
- ] ifFalse:[
- first := lineNr
- ].
- visibleLine := self listLineToVisibleLine:first.
- visibleLine notNil ifTrue:[
- self redrawFromVisibleLine:visibleLine to:nLinesShown
- ]
- ]
-!
-
-redrawInverted
- "show contents in reverse colors"
-
- |savFg savBg|
-
- savFg := fgColor.
- savBg := bgColor.
- fgColor := savBg.
- bgColor := savFg.
- self redraw.
- fgColor := savFg.
- bgColor := savBg.
-!
-
-flash
- "show contents in reverse colors for a moment - to wakeup the user :-)"
-
- self redrawInverted.
- (Delay forSeconds:0.1) wait.
- self redraw
-
- "
- Transcript flash
- Transcript redrawInverted
- Transcript redraw
- "
-!
-
-redrawFromLine:start to:end
- "redraw lines from start to end"
-
- |visibleFirst visibleLast first last lastLineShown|
-
- shown ifTrue:[
- lastLineShown := firstLineShown + nLinesShown - 1.
- (start <= lastLineShown) ifTrue:[
- (end >= firstLineShown) ifTrue:[
-
- "if first line to redraw is above 1st visible line,
- start redraw at 1st visible line"
-
- (start < firstLineShown) ifTrue:[
- first := firstLineShown
- ] ifFalse:[
- first := start
- ].
- (end > lastLineShown) ifTrue:[
- last := lastLineShown
- ] ifFalse:[
- last := end
- ].
- visibleFirst := self listLineToVisibleLine:first.
- visibleLast := self listLineToVisibleLine:last.
- self redrawFromVisibleLine:visibleFirst to:visibleLast
- ]
- ]
- ]
-!
-
-redraw
- "redraw complete view"
-
- shown ifTrue:[
- self redrawFromVisibleLine:1 to:nLinesShown
- ]
-! !
-
-!ListView methodsFor:'accessing'!
-
-level:aNumber
- "set the level - cought here to update text-position variables
- (which avoids many computations later)"
-
- super level:aNumber.
-
- textStartLeft := leftMargin + margin.
- textStartTop := topMargin + margin.
- innerWidth := width - textStartLeft - margin
-!
-
-innerHeight
- "return the number of pixels visible of the contents
- - redefined since ListView adds another margin to start the text
- somewhat to indented from the 3D border."
-
- ^ height - (2 * margin) - topMargin
-!
-
-backgroundColor
- "return the background color"
-
- ^ bgColor
-!
-
-foregroundColor
- "return the foreground color"
-
- ^ fgColor
-!
-
-backgroundColor:aColor
- "set the background color"
-
- bgColor ~~ aColor ifTrue:[
- bgColor := aColor.
- self viewBackground:bgColor.
- shown ifTrue:[
- self clear.
- self redraw
- ]
- ]
+
+ "Modified: 11.12.1995 / 17:15:55 / cg"
!
-foregroundColor:color1 backgroundColor:color2
- "set both foreground and background colors"
-
- ((fgColor ~~ color1) or:[bgColor ~~ color2]) ifTrue:[
- fgColor := color1.
- bgColor := color2.
- shown ifTrue:[
- self redraw
- ]
- ]
-!
-
-foregroundColor:aColor
- "set the foreground color"
-
- fgColor ~~ aColor ifTrue:[
- fgColor := aColor.
- shown ifTrue:[
- self redraw
- ]
- ]
-!
-
-partialLines:aBoolean
- "allow/disallow display of a last partial line"
-
- partialLines := aBoolean.
- self computeNumberOfLinesShown
-!
-
-leftMargin:aNumber
- "set the margin between the left border and the 1st col"
-
- leftMargin := aNumber.
- textStartLeft := leftMargin + margin.
- innerWidth := width - textStartLeft - margin
-!
-
-topMargin:aNumber
- "set the margin between the top border and the 1st line"
-
- topMargin := aNumber.
- textStartTop := topMargin + margin.
-!
-
-leftMargin
- "return the margin to left of 1st col"
-
- ^ leftMargin
-!
-
-font:aFont
- "set the font for all shown text.
- Redraws everything."
-
- aFont isNil ifTrue:[
- ^ self error:'nil font'
- ].
- font ~~ aFont ifTrue:[
- super font:aFont.
- realized ifTrue:[
- widthOfWidestLine := nil. "/ i.e. unknown
- (font device == device) ifTrue:[
- self getFontParameters.
- self computeNumberOfLinesShown.
- shown ifTrue:[
- self redrawFromVisibleLine:1 to:nLinesShown
- ]
- ].
- self contentsChanged
- ]
- ]
-
- "Modified: 24.11.1995 / 11:17:06 / cg"
-!
-
-lineSpacing:pixles
- "set the lineSpacing - thats an additional number of pixels,
- by which lines are vertically separated."
-
- lineSpacing := pixles.
- self getFontParameters.
-! !
-
-!ListView methodsFor:'initialization'!
-
-create
- super create.
-
- "I cache font parameters here - they are used so often ..."
- self getFontParameters.
- self computeNumberOfLinesShown.
- fgColor := fgColor on:device.
- bgColor := bgColor on:device
-!
-
-realize
- |sz|
-
- extentChanged ifTrue:[
- self computeNumberOfLinesShown.
- ].
- firstLineShown ~~ 1 ifTrue:[
- sz := self size.
- firstLineShown + nLinesShown > sz ifTrue:[
- self scrollToLine:sz - nLinesShown.
- ]
- ].
- super realize.
- self getListFromModel
-!
-
-initStyle
- super initStyle.
-
- self topMargin:(self verticalPixelPerMillimeter:0.5) rounded.
- self leftMargin:(self horizontalPixelPerMillimeter:0.5) rounded.
-
- lineSpacing := 0.
- fgColor := DefaultForegroundColor on:device.
- bgColor := DefaultBackgroundColor on:device.
- DefaultFont notNil ifTrue:[font := DefaultFont on:device]
-!
-
-initialize
- super initialize.
-
- viewOrigin := 0@0.
-
- textStartTop := topMargin + margin.
-
- bitGravity := #NorthWest.
- list := nil.
- firstLineShown := 1.
- nFullLinesShown := 1. "just any value ..."
- nLinesShown := 1. "just any value"
- leftOffset := 0.
- partialLines := true.
- tabPositions := DefaultTabPositions.
- self getFontParameters.
- wordCheck := [:char | char isNationalAlphaNumeric].
- includesNonStrings := false.
-
- autoScroll := true.
-!
-
-defaultControllerClass
- self class == ListView ifTrue:[^ ListViewController].
- ^ super defaultControllerClass
-!
-
-recreate
- "recreate after a snapin"
-
- super recreate.
-
- "
- recompute margins and font parameters
- - display may have different resolution/font sizes.
- "
- topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
- self leftMargin:(self horizontalPixelPerMillimeter:0.5) rounded.
- self getFontParameters
-! !
-
-!ListView methodsFor:'searching'!
-
-searchForwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 ifAbsent:block2
- "search for a pattern, if found evaluate block1 with row/col as arguments, if not
- found evaluate block2.
- Sorry, but pattern is no regular expression pattern (yet)"
-
- |lineString col savedCursor patternSize
- line1 "{Class: SmallInteger}"
- line2 "{Class: SmallInteger}"
- p realPattern|
-
- patternSize := pattern size.
- (list notNil and:[patternSize ~~ 0]) ifTrue:[
- savedCursor := cursor.
- self cursor:(Cursor questionMark).
-
- col := startCol + 1.
- line1 := startLine.
- line2 := list size.
-
- pattern includesMatchCharacters ifTrue:[
- p := ''.
- (pattern startsWith:$*) ifFalse:[
- p := p , '*'
- ].
- p := p , pattern.
- (pattern endsWith:$*) ifFalse:[
- p := p , '*'
- ].
- realPattern := pattern.
- (realPattern startsWith:$*) ifTrue:[
- realPattern := realPattern copyFrom:2
- ].
- line1 to:line2 do:[:lnr |
- lineString := list at:lnr.
- lineString notNil ifTrue:[
- "/ first a crude check ...
- (p match:lineString) ifTrue:[
- "/ ok, there it is; look at which position
- col := lineString findMatchString:realPattern startingAt:col ignoreCase:false ifAbsent:[0].
- col ~~ 0 ifTrue:[
- self cursor:savedCursor.
- ^ block1 value:lnr value:col.
- ]
- ].
- ].
- col := 1
- ]
- ] ifFalse:[
- line1 to:line2 do:[:lnr |
- lineString := list at:lnr.
- lineString isString ifTrue:[
- col := lineString findString:pattern startingAt:col ifAbsent:[0].
- col ~~ 0 ifTrue:[
- self cursor:savedCursor.
- ^ block1 value:lnr value:col.
- ]
- ].
- col := 1
- ]
- ]
- ].
- "not found"
-
- self cursor:savedCursor.
- ^ block2 value
-!
-
-findEndOfWordAtLine:selectLine col:selectCol
- "return the col of last character of the word at given line/col.
- If the character under the initial col is a space character, return
- the last col of the blank-block.
- Return 0 if we should wrap to next line (for spaces)"
-
- |endCol thisCharacter len|
-
- endCol := selectCol.
- endCol == 0 ifTrue:[endCol := 1].
- thisCharacter := self characterAtLine:selectLine col:endCol.
-
- "is this acharacter within a word ?"
- (wordCheck value:thisCharacter) ifTrue:[
- thisCharacter := self characterAtLine:selectLine col:endCol.
- [wordCheck value:thisCharacter] whileTrue:[
- endCol := endCol + 1.
- thisCharacter := self characterAtLine:selectLine col:endCol
- ].
- endCol := endCol - 1.
- ] ifFalse:[
- "nope - maybe its a space"
- thisCharacter == Character space ifTrue:[
- len := (self listAt:selectLine) size.
- endCol > len ifTrue:[
- "select rest to end"
- endCol := 0
- ] ifFalse:[
- thisCharacter := self characterAtLine:selectLine col:endCol.
- [endCol <= len and:[thisCharacter == Character space]] whileTrue:[
- endCol := endCol + 1.
- thisCharacter := self characterAtLine:selectLine col:endCol
- ].
- endCol := endCol - 1.
- ]
- ] ifFalse:[
- "select single character"
- ]
- ].
- ^ endCol.
-!
-
-findBeginOfWordAtLine:selectLine col:selectCol
- "return the col of first character of the word at given line/col.
- If the character under the initial col is a space character, return
- the first col of the blank-block."
-
- |beginCol thisCharacter|
-
- beginCol := selectCol.
- thisCharacter := self characterAtLine:selectLine col:beginCol.
-
- "is this acharacter within a word ?"
- (wordCheck value:thisCharacter) ifTrue:[
- [wordCheck value:thisCharacter] whileTrue:[
- beginCol := beginCol - 1.
- beginCol < 1 ifTrue:[
- thisCharacter := Character space
- ] ifFalse:[
- thisCharacter := self characterAtLine:selectLine col:beginCol
- ]
- ].
- beginCol := beginCol + 1.
- ] ifFalse:[
- "nope - maybe its a space"
- thisCharacter == Character space ifTrue:[
- [beginCol > 1 and:[thisCharacter == Character space]] whileTrue:[
- beginCol := beginCol - 1.
- thisCharacter := self characterAtLine:selectLine col:beginCol
- ].
- thisCharacter ~~ Character space ifTrue:[
- beginCol := beginCol + 1.
- ].
- ] ifFalse:[
- "select single character"
- ]
- ].
- ^ beginCol
-!
-
-searchBackwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 ifAbsent:block2
- "search for a pattern, if found evaluate block1 with row/col as arguments, if not
- found evaluate block2.
- Sorry, but pattern is no regular expression pattern (yet)"
-
- |lineString col cc found firstChar savedCursor patternSize
- line1 "{Class: SmallInteger}"|
-
- patternSize := pattern size.
- (list notNil and:[patternSize ~~ 0]) ifTrue:[
- savedCursor := cursor.
- self cursor:(Cursor questionMark).
-"/ searchPattern := pattern.
- col := startCol - 1.
- firstChar := pattern at:1.
- col > (list at:startLine) size ifTrue:[
- col := nil
- ].
- line1 := startLine.
- line1 to:1 by:-1 do:[:lnr |
- lineString := list at:lnr.
- lineString notNil ifTrue:[
- col isNil ifTrue:[col := lineString size - patternSize + 1].
- [(col > 0) and:[(lineString at:col) ~~ firstChar]] whileTrue:[
- col := col - 1
- ].
- [col > 0] whileTrue:[
- cc := col.
- found := true.
- 1 to:patternSize do:[:cnr |
- cc > lineString size ifTrue:[
- found := false
- ] ifFalse:[
- (pattern at:cnr) ~~ (lineString at:cc) ifTrue:[
- found := false
- ]
- ].
- cc := cc + 1
- ].
- found ifTrue:[
- self cursor:savedCursor.
- ^ block1 value:lnr value:col.
- ].
- col := col - 1.
- [(col > 0) and:[(lineString at:col) ~~ firstChar]] whileTrue:[
- col := col - 1
- ]
- ]
- ].
- col := nil
- ]
- ].
- "not found"
-
- self cursor:savedCursor.
- ^ block2 value
-! !
-
-!ListView methodsFor:'change and update '!
-
-update:something with:aParameter from:changedObject
- changedObject == model ifTrue:[
- (aspectMsg notNil
- and:[something == aspectMsg]) ifTrue:[
- ^ self getListFromModel.
- ].
- ].
- ^ super update:something with:aParameter from:changedObject
+drawVisibleLine:visLineNr with:fg and:bg
+ "draw a visible line in fg/bg"
+
+ self drawLine:(self visibleAt:visLineNr) atX:(textStartLeft - leftOffset) inVisible:visLineNr with:fg and:bg
! !
!ListView methodsFor:'event processing'!
+keyPress:key x:x y:y
+ "a key was pressed - handle page-keys here"
+
+ <resource: #keyboard (#PreviousPage #NextPage #HalfPageUp #HalfPageDown
+ #BeginOfText #EndOfText
+ #ScrollUp #ScrollDown )>
+ |sensor n|
+
+ (key == #PreviousPage) ifTrue: [^ self pageUp].
+ (key == #NextPage) ifTrue: [^ self pageDown].
+ (key == #HalfPageUp) ifTrue: [^ self halfPageUp].
+ (key == #HalfPageDown) ifTrue: [^ self halfPageDown].
+
+ (key == #BeginOfText) ifTrue:[^ self scrollToTop].
+ (key == #EndOfText) ifTrue:[^ self scrollToBottom].
+
+ sensor := self sensor.
+ (key == #ScrollUp) ifTrue:[
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#ScrollUp).
+ ].
+ ^ self scrollUp:n
+ ].
+ (key == #ScrollDown) ifTrue:[
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#ScrollDown).
+ ].
+ ^ self scrollDown:n
+ ].
+
+ super keyPress:key x:x y:y
+!
+
redrawX:x y:y width:w height:h
"a region must be redrawn"
@@ -2718,41 +1001,1749 @@
self scrollToLine: newOrigin.
^ self
].
+! !
+
+!ListView methodsFor:'initialization'!
+
+create
+ super create.
+
+ "I cache font parameters here - they are used so often ..."
+ self getFontParameters.
+ self computeNumberOfLinesShown.
+ fgColor := fgColor on:device.
+ bgColor := bgColor on:device
!
-keyPress:key x:x y:y
- "a key was pressed - handle page-keys here"
-
- <resource: #keyboard (#PreviousPage #NextPage #HalfPageUp #HalfPageDown
- #BeginOfText #EndOfText
- #ScrollUp #ScrollDown )>
- |sensor n|
-
- (key == #PreviousPage) ifTrue: [^ self pageUp].
- (key == #NextPage) ifTrue: [^ self pageDown].
- (key == #HalfPageUp) ifTrue: [^ self halfPageUp].
- (key == #HalfPageDown) ifTrue: [^ self halfPageDown].
-
- (key == #BeginOfText) ifTrue:[^ self scrollToTop].
- (key == #EndOfText) ifTrue:[^ self scrollToBottom].
-
- sensor := self sensor.
- (key == #ScrollUp) ifTrue:[
- sensor isNil ifTrue:[
- n := 1
+defaultControllerClass
+ self class == ListView ifTrue:[^ ListViewController].
+ ^ super defaultControllerClass
+!
+
+initStyle
+ super initStyle.
+
+ self topMargin:(self verticalPixelPerMillimeter:0.5) rounded.
+ self leftMargin:(self horizontalPixelPerMillimeter:0.5) rounded.
+
+ lineSpacing := 0.
+ fgColor := DefaultForegroundColor on:device.
+ bgColor := DefaultBackgroundColor on:device.
+ DefaultFont notNil ifTrue:[font := DefaultFont on:device]
+!
+
+initialize
+ super initialize.
+
+ viewOrigin := 0@0.
+
+ textStartTop := topMargin + margin.
+
+ bitGravity := #NorthWest.
+ list := nil.
+ firstLineShown := 1.
+ nFullLinesShown := 1. "just any value ..."
+ nLinesShown := 1. "just any value"
+ leftOffset := 0.
+ partialLines := true.
+ tabPositions := DefaultTabPositions.
+ self getFontParameters.
+ wordCheck := [:char | char isNationalAlphaNumeric].
+ includesNonStrings := false.
+
+ autoScroll := true.
+!
+
+realize
+ |sz|
+
+ extentChanged ifTrue:[
+ self computeNumberOfLinesShown.
+ ].
+ firstLineShown ~~ 1 ifTrue:[
+ sz := self size.
+ firstLineShown + nLinesShown > sz ifTrue:[
+ self scrollToLine:sz - nLinesShown.
+ ]
+ ].
+ super realize.
+ self getListFromModel
+!
+
+recreate
+ "recreate after a snapin"
+
+ super recreate.
+
+ "
+ recompute margins and font parameters
+ - display may have different resolution/font sizes.
+ "
+ topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
+ self leftMargin:(self horizontalPixelPerMillimeter:0.5) rounded.
+ self getFontParameters
+! !
+
+!ListView methodsFor:'private'!
+
+absoluteLineToVisibleLine:absLineNr
+ "given an absolute line (1..) return visible linenr or nil"
+
+ absLineNr isNil ifTrue:[^ nil].
+ (absLineNr < firstLineShown) ifTrue:[^ nil].
+ (absLineNr >= (firstLineShown + nLinesShown)) ifTrue:[^ nil].
+ ^ absLineNr - firstLineShown + 1
+!
+
+characterPositionOfLine:lineNr col:col
+ "given a line/col position, return the character index within the contents-string,
+ - used with Compilers error-positioning"
+
+ |lineString pos|
+
+ self checkForExistingLine:lineNr.
+ pos := 1.
+ 1 to:(lineNr - 1) do:[:lnr |
+ lineString := self at:lnr.
+ lineString notNil ifTrue:[
+ pos := pos + lineString size
+ ].
+ pos := pos + 1 "the return-character"
+ ].
+ ^ pos + col - 1
+
+!
+
+checkForExistingLine:lineNr
+ "check if a line for lineNr exists; if not, expand text"
+
+ list isNil ifTrue: [
+ list := StringCollection new:lineNr.
+ self contentsChanged
+ ] ifFalse: [
+ lineNr > (list size) ifTrue:[
+ self grow:lineNr.
+ self contentsChanged
+ ]
+ ]
+!
+
+colOfX:x inVisibleLine:visLineNr
+ "given a visible lineNr and x-coordinate, return colNr"
+
+ |lineString linePixelWidth xRel runCol posLeft posRight done|
+
+ xRel := x - textStartLeft + leftOffset.
+ "
+ for fix fonts, this is easy ...
+ "
+ fontIsFixedWidth ifTrue:[
+ ^ (xRel // fontWidth) + 1
+ ].
+
+ "
+ for variable fonts, more work is required ...
+ "
+ lineString := (self visibleAt:visLineNr) asString.
+ lineString notNil ifTrue:[
+ linePixelWidth := font widthOf:lineString
+ ] ifFalse:[
+ linePixelWidth := 0
+ ].
+ (xRel <= 0) ifTrue:[^ 1].
+ (linePixelWidth <= xRel) ifTrue:[
+ fontWidth == 0 ifTrue:[
+ "
+ although this 'cannot happen',
+ it seems that X reports this width for some strange fonts ...
+ "
+ ^ lineString size
+ ].
+ ^ lineString size + ((xRel - linePixelWidth) // fontWidth) + 1
+ ].
+ runCol := lineString size // 2.
+ (runCol == 0) ifTrue:[runCol := 1].
+ posLeft := font widthOf:lineString from:1 to:(runCol - 1).
+ posRight := font widthOf:lineString from:1 to:runCol.
+ done := (posLeft <= xRel) and:[posRight > xRel].
+ [done] whileFalse:[
+ (posRight <= xRel) ifTrue:[
+ runCol := runCol + 1.
+ posLeft := posRight.
+ posRight := font widthOf:lineString from:1 to:runCol
+ ] ifFalse:[
+ (posLeft > xRel) ifTrue:[
+ runCol := runCol - 1.
+ (runCol == 0) ifTrue:[^ 0].
+ posRight := posLeft.
+ posLeft := font widthOf:lineString from:1 to:(runCol - 1)
+ ]
+ ].
+ done := (posLeft <= xRel) and:[posRight > xRel]
+ ].
+ ^ runCol
+!
+
+computeNumberOfLinesShown
+ "recompute the number of visible lines"
+
+ nFullLinesShown := self innerHeight + lineSpacing // fontHeight.
+ nLinesShown := nFullLinesShown.
+
+ partialLines ifTrue:[
+ ((nLinesShown * fontHeight) == height) ifFalse:[
+ nLinesShown := nLinesShown + 1
+ ]
+ ]
+!
+
+convertRTF:aList
+ "this is a q&d RTF to poor-text converter which removes any rich stuff.
+ - a first shot 'til DocumentView is finished ..."
+
+ |newList newLine charIndex inEscape char special|
+
+ newList := StringCollection new:200.
+ newList grow:0.
+
+ newLine := ''.
+ aList do:[:line |
+ ((line size == 0) or:[line isBlank]) ifTrue:[
+ newList add:newLine.
+ newLine := ''
+ ] ifFalse:[
+ special := ((line at:1) == ${) or:[(line includes:$\)].
+ special := special or:[(line at:1) == $}].
+ special ifFalse:[
+ newList add:(newLine , line)
+ ] ifTrue:[
+ charIndex := 1.
+ [charIndex <= line size] whileTrue:[
+ char := line at:charIndex.
+ ((char == ${ ) or:[char == $} ]) ifTrue:[
+ "left-brace: ignore rest of line"
+ charIndex := line size + 1
+ ] ifFalse:[
+ (char == $\) ifTrue:[
+ inEscape := true
+ ] ifFalse:[
+ inEscape ifTrue:[
+ (char == Character space) ifTrue:[
+ inEscape := false
+ ]
+ ] ifFalse:[
+ newLine := newLine copyWith:char
+ ]
+ ].
+ charIndex := charIndex + 1
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ newList
+!
+
+getFontParameters
+ "get some info of the used font. They are cached since we use them often .."
+
+ font := font on:device.
+ fontHeight := font height + lineSpacing.
+ fontAscent := font ascent.
+ fontWidth := font width.
+ fontIsFixedWidth := font isFixedWidth.
+!
+
+getListFromModel
+ "ask my model (if any) for the text via the listMsg."
+
+ |text|
+
+ (model notNil
+ and:[listMsg notNil]) ifTrue:[
+ text := model perform:listMsg.
+ text notNil ifTrue:[
+ text := text asStringCollection.
+ ].
+ self list:text
+ ].
+!
+
+lineOfCharacterPosition:charPos
+ "given a character index within the contents-string,
+ return the lineNumber where the character is
+ - used to find line to hilight from Compilers error-position"
+
+ |lineNr sum lastLine|
+
+ lineNr := 1.
+ sum := 0.
+ lastLine := self size.
+ [sum < charPos] whileTrue:[
+ (lineNr > lastLine) ifTrue:[^ lineNr - 1].
+ sum := sum + (self at:lineNr) size + 1.
+ lineNr := lineNr + 1
+ ].
+ ^ lineNr - 1
+!
+
+listAt:lineNr
+ "given a lineNumber, return the corresponding string
+ This is used for accessing; i.e. for non-string entries, this
+ returns the corresponding string."
+
+ |l|
+
+ list isNil ifTrue:[^ nil].
+ (lineNr between:1 and:self size) ifFalse:[^ nil].
+ l := self at:lineNr.
+ l isNil ifTrue:[^ l].
+ ^ l asString
+
+ "Modified: 7.9.1995 / 15:54:59 / claus"
+!
+
+listAt:lineNr from:startCol
+ "return right substring from startCol to end of a line"
+
+ |line|
+
+ line := self listAt:lineNr.
+ line isNil ifTrue:[^ nil].
+ (startCol > line size) ifTrue:[^ nil].
+ ^ line copyFrom:startCol
+!
+
+listAt:lineNr from:startCol to:endCol
+ "return substring from startCol to endCol of a line"
+
+ |line stop lineLen|
+
+ line := self listAt:lineNr.
+ line isNil ifTrue:[^ nil].
+ lineLen := line size.
+ (startCol > lineLen) ifTrue:[^ nil].
+ stop := endCol.
+ (stop > lineLen) ifTrue:[stop := lineLen].
+ ^ line copyFrom:startCol to:stop
+!
+
+listAt:lineNr to:endCol
+ "return left substring from start to endCol of a line"
+
+ |line stop|
+
+ line := self listAt:lineNr.
+ line isNil ifTrue:[^ nil].
+ stop := endCol.
+ (stop > line size) ifTrue:[stop := line size].
+ ^ line copyTo:stop
+!
+
+listLineToVisibleLine:listLineNr
+ "given a list line (1..) return visible linenr or nil"
+
+ |visibleLineNr "{ Class: SmallInteger }"|
+
+ shown ifFalse:[^ nil].
+ listLineNr isNil ifTrue:[^ nil].
+ visibleLineNr := listLineNr + 1 - firstLineShown.
+ (visibleLineNr between:1 and:nLinesShown) ifFalse:[^ nil].
+ ^ visibleLineNr
+!
+
+visibleAt:visibleLineNr
+ "return what is visible at line (numbers start at 1).
+ This is used for redrawing; i.e. for non-string entries, this
+ returns the original."
+
+ |listLineNr listsize|
+
+ listLineNr := visibleLineNr + firstLineShown - 1.
+ (listLineNr == 0) ifTrue:[^ nil].
+ (list notNil) ifTrue:[
+ listsize := self size
+ ] ifFalse:[
+ listsize := 0
+ ].
+ (listLineNr <= listsize) ifTrue:[^ self at:listLineNr].
+ ^ ''
+!
+
+visibleLineOfY:y
+ "given a y-coordinate, return lineNr
+ - works for fix-height fonts only"
+
+ ^ ((y - textStartTop) // fontHeight) + 1
+!
+
+visibleLineToAbsoluteLine:visibleLineNr
+ "given a visible line (1..) return absolut linenr"
+
+ visibleLineNr isNil ifTrue:[^ nil].
+ ^ visibleLineNr + firstLineShown - 1
+!
+
+visibleLineToListLine:visibleLineNr
+ "given a visible line (1..) return linenr in list or nil
+ (this one returns nil if the given visibleLineNr is one of the
+ separators)"
+
+ |listLineNr "{ Class: SmallInteger }"
+ listsize "{ Class: SmallInteger }" |
+
+ visibleLineNr isNil ifTrue:[^ nil].
+ listLineNr := visibleLineNr + firstLineShown - 1.
+ (listLineNr == 0) ifTrue:[^nil].
+ listsize := self size.
+ (listLineNr <= listsize) ifTrue:[^ listLineNr].
+ ^ nil
+!
+
+widthForScrollBetween:firstLine and:lastLine
+ "return the width in pixels for a scroll between firstLine and lastLine.
+ - used to optimize scrolling, by limiting the scrolled area.
+ Subclasses with selections or other additional visible stuff should redefine
+ this method."
+
+ |w|
+
+ "for small width, its not worth searching for
+ longest line ...
+ "
+ (width < 300) ifTrue:[^ innerWidth].
+
+ "for large lists, search may take longer than scrolling full
+ "
+ self size > 2000 ifTrue:[^ innerWidth].
+
+ "
+ if there is a pattern-background, we have to scroll everything
+ "
+ (viewBackground isColor not
+ or:[viewBackground colorId notNil]) ifTrue:[
+ ^ width
+ ].
+
+ w := self widthOfWidestLineBetween:firstLine and:lastLine.
+ (w > innerWidth) ifTrue:[^ innerWidth].
+ ^ w
+!
+
+widthOfLineString:entry
+ "return the width of an entry"
+
+ entry isNil ifTrue:[^ 0].
+ entry isString ifTrue:[
+ ^ font widthOf:entry
+ ].
+ ^ entry widthIn:self
+!
+
+widthOfWidestLineBetween:firstLine and:lastLine
+ "return the width in pixels of the widest line in a range
+ - used to optimize scrolling, by limiting the scrolled area"
+
+ |max "{ Class: SmallInteger }"
+ first "{ Class: SmallInteger }"
+ last "{ Class: SmallInteger }"
+ thisLen "{ Class: SmallInteger }"
+ listSize "{ Class: SmallInteger }" |
+
+ includesNonStrings ifTrue:[
+ ^ width
+ ].
+
+ fontIsFixedWidth ifTrue:[
+ ^ (self lengthOfLongestLineBetween:firstLine and:lastLine) * fontWidth
+ ].
+ listSize := self size.
+ max := 0.
+ first := firstLine.
+ last := lastLine.
+
+ (first > listSize) ifTrue:[^ max].
+ (last > listSize) ifTrue:[
+ last := listSize
+ ].
+
+ self from:first to:last do:[:line |
+ line notNil ifTrue:[
+ thisLen := font widthOf:line.
+ (thisLen > max) ifTrue:[
+ max := thisLen
+ ]
+ ]
+ ].
+ ^ max
+!
+
+xOfCol:col inVisibleLine:visLineNr
+ "given a visible line- and colNr, return x-coordinate in view"
+
+ |line lineSize tcol|
+
+ tcol := col - 1.
+ fontIsFixedWidth ifTrue:[
+ ^ (tcol * fontWidth) + textStartLeft
+ ].
+ line := self visibleAt:visLineNr.
+ line notNil ifTrue:[
+ lineSize := line size
+ ] ifFalse:[
+ lineSize := 0
+ ].
+ (lineSize == 0) ifTrue:[
+ ^ (tcol * fontWidth) + textStartLeft
+ ].
+ (lineSize < col) ifTrue:[
+ ^ (font widthOf:line)
+ + (fontWidth * (tcol - lineSize))
+ + textStartLeft
+ ].
+ ^ (font widthOf:line from:1 to:tcol) + textStartLeft
+!
+
+yOfVisibleLine:visLineNr
+ "given a visible lineNr, return y-coordinate in view
+ - works for fix-height fonts only"
+
+ ^ ((visLineNr - 1) * fontHeight) + textStartTop
+! !
+
+!ListView methodsFor:'queries'!
+
+firstLineShown
+ "return the index of the first (possibly partial) visible line"
+
+ ^ firstLineShown
+!
+
+heightOfContents
+ "return the height of the contents in pixels
+ - used for scrollbar interface"
+
+ | numLines |
+
+ numLines := self numberOfLines.
+ numLines == 0 ifTrue:[^ 0].
+
+ "/
+ "/ kludge for last partial line
+ "/
+"/ nFullLinesShown ~~ nLinesShown ifTrue:[
+"/ numLines := numLines + 1
+"/ ].
+ "
+ need device-font for query
+ "
+ font := font on:device.
+ ^ numLines * fontHeight
+"/ + textStartTop
+ - (lineSpacing // 2)
+"/ + (font descent)
+"/ + (font descent * 2) "makes it look better"
+ .
+
+"/ "it used to be that code - which is wrong"
+"/ (nLinesShown == nFullLinesShown) ifTrue:[
+"/ ^ numLines * fontHeight
+"/ ].
+"/ "add one - otherwise we cannot make last line
+"/ fully visible since scrolling is done by full lines only"
+"/
+"/ ^ (numLines + 1) * fontHeight
+!
+
+lastLineShown
+ "return the index of the last (possibly partial) visible line"
+
+ ^ firstLineShown + nLinesShown
+!
+
+leftIndentOfLine:lineNr
+ "return the number of spaces at the left in line, lineNr.
+ returns 0 for empty lines."
+
+ |lineString index end|
+
+ lineString := self listAt:lineNr.
+ lineString notNil ifTrue:[
+ index := 1.
+ end := lineString size.
+ [index <= end] whileTrue:[
+ (lineString at:index) isSeparator ifFalse:[^ index - 1].
+ index := index + 1
+ ]
+ ].
+ ^ 0
+!
+
+lengthOfLongestLine
+ "return the length (in characters) of the longest line"
+
+ ^ self lengthOfLongestLineBetween:1 and:self size
+!
+
+lengthOfLongestLineBetween:firstLine and:lastLine
+ "return the length (in characters) of the longest line in a line-range"
+
+ |max "{ Class: SmallInteger }"
+ thisLen "{ Class: SmallInteger }"
+ listSize "{ Class: SmallInteger }"
+ first "{ Class: SmallInteger }"
+ last "{ Class: SmallInteger }" |
+
+ list isNil ifTrue:[^ 0].
+
+ listSize := self size.
+ max := 0.
+ first := firstLine.
+ last := lastLine.
+
+ (first > listSize) ifTrue:[^ max].
+ (last > listSize) ifTrue:[
+ last := listSize
+ ].
+ self from:first to:last do:[:lineString |
+ lineString notNil ifTrue:[
+ thisLen := lineString size.
+ (thisLen > max) ifTrue:[
+ max := thisLen
+ ]
+ ]
+ ].
+ ^ max
+
+!
+
+lineIsVisible:line
+ "is line visible?"
+
+ (line >= firstLineShown and:[ line < (firstLineShown + nLinesShown) ]) ifTrue:[ ^ true ].
+ ^ false.
+!
+
+numberOfLines
+ "return the number of lines the text has"
+
+ ^ self size
+!
+
+widthOfContents
+ "return the width of the contents in pixels
+ - used for scrollbar interface"
+
+ |max|
+
+ list isNil ifTrue:[^ 0].
+ widthOfWidestLine notNil ifTrue:[^ widthOfWidestLine + (leftMargin * 2)].
+
+ includesNonStrings ifTrue:[
+ max := list
+ inject:0
+ into:[:maxSoFar :entry |
+ (
+ entry isNil ifTrue:[
+ 0
+ ] ifFalse:[
+ entry isString ifTrue:[
+ font widthOf:entry
+ ] ifFalse:[
+ entry widthIn:self
+ ]
+ ]
+ ) max:maxSoFar.
+ ]
+ ] ifFalse:[
+ fontIsFixedWidth ifTrue:[
+ max := self lengthOfLongestLine * fontWidth
+ ] ifFalse:[
+ max := 0.
+ list notNil ifTrue:[
+ max := max max:(font widthOf:list)
+ ].
+ ].
+ ].
+ widthOfWidestLine := max.
+ ^ max + (leftMargin * 2)
+!
+
+xOriginOfContents
+ "return the horizontal origin of the contents in pixels
+ - used for scrollbar interface"
+
+ ^ leftOffset
+!
+
+yOriginOfContents
+ "return the vertical origin of the contents in pixels
+ - used for scrollbar interface"
+
+ ^ (firstLineShown - 1) * fontHeight
+! !
+
+!ListView methodsFor:'redrawing'!
+
+flash
+ "show contents in reverse colors for a moment - to wakeup the user :-)"
+
+ self redrawInverted.
+ (Delay forSeconds:0.1) wait.
+ self redraw
+
+ "
+ Transcript flash
+ Transcript redrawInverted
+ Transcript redraw
+ "
+!
+
+redraw
+ "redraw complete view"
+
+ shown ifTrue:[
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
+!
+
+redrawFromLine:lineNr
+ "redraw starting at linrNr"
+
+ |visibleLine first|
+
+ shown ifTrue:[
+ "if first line to redraw is above 1st visible line,
+ start redraw at 1st visible line"
+ (lineNr < firstLineShown) ifTrue:[
+ first := firstLineShown
] ifFalse:[
- n := 1 + (sensor compressKeyPressEventsWithKey:#ScrollUp).
+ first := lineNr
].
- ^ self scrollUp:n
+ visibleLine := self listLineToVisibleLine:first.
+ visibleLine notNil ifTrue:[
+ self redrawFromVisibleLine:visibleLine to:nLinesShown
+ ]
+ ]
+!
+
+redrawFromLine:start to:end
+ "redraw lines from start to end"
+
+ |visibleFirst visibleLast first last lastLineShown|
+
+ shown ifTrue:[
+ lastLineShown := firstLineShown + nLinesShown - 1.
+ (start <= lastLineShown) ifTrue:[
+ (end >= firstLineShown) ifTrue:[
+
+ "if first line to redraw is above 1st visible line,
+ start redraw at 1st visible line"
+
+ (start < firstLineShown) ifTrue:[
+ first := firstLineShown
+ ] ifFalse:[
+ first := start
+ ].
+ (end > lastLineShown) ifTrue:[
+ last := lastLineShown
+ ] ifFalse:[
+ last := end
+ ].
+ visibleFirst := self listLineToVisibleLine:first.
+ visibleLast := self listLineToVisibleLine:last.
+ self redrawFromVisibleLine:visibleFirst to:visibleLast
+ ]
+ ]
+ ]
+!
+
+redrawFromVisibleLine:startVisLineNr to:endVisLineNr
+ "redraw a visible line range"
+
+ shown ifTrue:[
+ self drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fgColor and:bgColor
+ ]
+!
+
+redrawInverted
+ "show contents in reverse colors"
+
+ |savFg savBg|
+
+ savFg := fgColor.
+ savBg := bgColor.
+ fgColor := savBg.
+ bgColor := savFg.
+ self redraw.
+ fgColor := savFg.
+ bgColor := savBg.
+!
+
+redrawLine:lineNr
+ "redraw a list line"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine
+ ]
+!
+
+redrawLine:lineNr col:col
+ "redraw a single character"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine col:col
+ ]
+!
+
+redrawLine:lineNr from:startCol
+ "redraw a list line from startCol to end of line"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine from:startCol
+ ]
+!
+
+redrawLine:lineNr from:startCol to:endCol
+ "redraw a list line from startCol to endCol"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine from:startCol to:endCol
+ ]
+!
+
+redrawVisibleLine:visLineNr
+ "redraw a visible line"
+
+ shown ifTrue:[
+ self drawVisibleLine:visLineNr with:fgColor and:bgColor
+ ]
+!
+
+redrawVisibleLine:visLineNr col:col
+ "redraw single character at col index of visible line"
+
+ shown ifTrue:[
+ self drawVisibleLine:visLineNr col:col with:fgColor and:bgColor
+ ]
+!
+
+redrawVisibleLine:visLineNr from:startCol
+ "redraw right part of a visible line from startCol to end of line"
+
+ shown ifTrue:[
+ self drawVisibleLine:visLineNr from:startCol with:fgColor and:bgColor
+ ]
+!
+
+redrawVisibleLine:visLineNr from:startCol to:endCol
+ "redraw part of a visible line"
+
+ shown ifTrue:[
+ self drawVisibleLine:visLineNr from:startCol to:endCol with:fgColor and:bgColor
+ ]
+! !
+
+!ListView methodsFor:'scrolling'!
+
+gotoLine:aLineNumber
+ "position to line aLineNumber; this may be redefined
+ in subclasses (for example to move the cursor also)"
+
+ ^ self scrollToLine:aLineNumber
+!
+
+halfPageDown
+ "scroll down half a page"
+
+ self scrollDown:(nFullLinesShown // 2)
+!
+
+halfPageUp
+ "scroll up half a page"
+
+ self scrollUp:(nFullLinesShown // 2)
+!
+
+makeColVisible:aCol inLine:aLineNr
+ "if column aCol is not visible, scroll horizontal to make it visible"
+
+ |xWant xVis visLnr|
+
+ (aCol isNil or:[shown not]) ifTrue:[^ self].
+
+ visLnr := self absoluteLineToVisibleLine:aLineNr.
+ visLnr isNil ifTrue:[^ self].
+
+ xWant := self xOfCol:aCol inVisibleLine:visLnr.
+ xVis := xWant - leftOffset.
+
+ "
+ dont scroll, if already visible
+ (but scroll, if not in inner 20%..80% of visible area)
+ "
+"/ ((xVis >= (width // 5)) and:[xVis <= (width * 4 // 5)]) ifTrue:[
+"/ ^ self
+"/ ].
+
+ "
+ no, the above does not look good, if you click / select at the
+ far right - makes selecting so difficult ...
+ "
+ (xVis >= 0 and:[xVis < (width - font width)]) ifTrue:[^ self].
+
+ self scrollHorizontalTo:(xWant - (width // 2)).
+!
+
+makeLineVisible:aListLineNr
+ "if aListLineNr is not visible, scroll to make it visible.
+ Numbering starts with 1 for the very first line of the text."
+
+ |bott|
+
+ (aListLineNr isNil "or:[shown not]") ifTrue:[^ self].
+
+ (aListLineNr >= firstLineShown) ifTrue:[
+ (aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
+ ^ self
+ ]
+ ].
+ (aListLineNr < nFullLinesShown) ifTrue:[
+ ^ self scrollToLine:1
+ ].
+ (nFullLinesShown < 3) ifTrue:[
+ ^ self scrollToLine:aListLineNr
+ ].
+ bott := self numberOfLines - (nFullLinesShown - 1).
+ (aListLineNr > bott) ifTrue:[
+ ^ self scrollToLine:bott
+ ].
+ self scrollToLine:(aListLineNr - (nFullLinesShown // 2) + 1)
+!
+
+makeVisible:someString
+ "if nescessary, scroll to make the (first)
+ line containing someString visible."
+
+ |line index|
+
+ index := self list indexOf:someString.
+ index ~~ 0 ifTrue:[
+ self makeLineVisible:index
+ ]
+!
+
+pageDown
+ "change origin to display next page"
+
+ |nLines|
+
+ nLines := nFullLinesShown.
+ (firstLineShown + nLines + nFullLinesShown > self size) ifTrue:[
+ nLines := self size - firstLineShown - nFullLinesShown + 1
].
- (key == #ScrollDown) ifTrue:[
- sensor isNil ifTrue:[
- n := 1
+ nLines <= 0 ifTrue:[^ self].
+
+ self originWillChange.
+ firstLineShown := firstLineShown + nLines.
+ self originChanged:nLines.
+ self redrawFromVisibleLine:1 to:nLinesShown
+
+!
+
+pageUp
+ "change origin to display previous page"
+
+ |oldOrg|
+
+ (firstLineShown == 1) ifFalse:[
+ self originWillChange.
+ oldOrg := firstLineShown.
+ firstLineShown := firstLineShown - nFullLinesShown.
+ (firstLineShown < 1) ifTrue:[
+ firstLineShown := 1
+ ].
+ self originChanged:(firstLineShown - oldOrg).
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
+!
+
+scrollDown
+ "change origin to scroll down one line"
+
+ self scrollDown:1
+!
+
+scrollDown:nLines
+ "change origin to scroll down some lines"
+
+ |w "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ m2 "{ Class:SmallInteger }"
+ count "{ Class:SmallInteger }"
+ y0 "{ Class:SmallInteger }"
+ nPixel sz|
+
+ count := nLines.
+ sz := self size.
+ (firstLineShown + nLines + nFullLinesShown > sz) ifTrue:[
+ count := sz - firstLineShown - nFullLinesShown + 1
+ ].
+ count <= 0 ifTrue:[^ self].
+
+ self originWillChange.
+ nPixel := fontHeight * count.
+
+ shown ifFalse:[
+ firstLineShown := firstLineShown + count.
+ viewOrigin := viewOrigin x @ (viewOrigin y + nPixel).
+ ] ifTrue:[
+ (count >= nLinesShown) ifTrue:[
+ firstLineShown := firstLineShown + count.
+ viewOrigin := viewOrigin x @ (viewOrigin y + nPixel).
+ self redrawFromVisibleLine:1 to:nLinesShown.
+ ] ifFalse:[
+ m2 := margin * 2.
+ w := self widthForScrollBetween:firstLineShown
+ and:(firstLineShown + nLinesShown).
+ w := w + leftMargin.
+
+ y0 := textStartTop - (lineSpacing//2).
+ h := nPixel + y0.
+
+ self catchExpose.
+ self copyFrom:self x:margin y:h
+ toX:margin y:y0
+ width:w height:(height - h + (lineSpacing//2)).
+
+ firstLineShown := firstLineShown + count.
+ viewOrigin := viewOrigin x @ (viewOrigin y + nPixel).
+ self redrawFromVisibleLine:(nFullLinesShown - count + 1) to:nLinesShown.
+ self waitForExpose.
+ ].
+ ].
+ self originChanged:count.
+!
+
+scrollHorizontalTo:aPixelOffset
+ "change origin to make aPixelOffset be the left col"
+
+ |orgX|
+
+ orgX := leftOffset.
+
+ (aPixelOffset < orgX) ifTrue:[
+ self scrollLeft:(orgX - aPixelOffset)
+ ] ifFalse:[
+ (aPixelOffset > orgX) ifTrue:[
+ self scrollRight:(aPixelOffset - orgX)
+ ]
+ ]
+!
+
+scrollLeft
+ "scroll left by one character
+ - question is how much is a good for variable fonts"
+
+ self scrollLeft:font width
+!
+
+scrollLeft:nPixel
+ "change origin to scroll left some cols"
+
+ |newLeftOffset|
+
+ nPixel <= 0 ifTrue:[^ self].
+
+ newLeftOffset := leftOffset - nPixel.
+ newLeftOffset <= 0 ifTrue:[
+ leftOffset == 0 ifTrue:[^ self].
+ newLeftOffset := 0
+ ].
+
+ self originWillChange.
+ leftOffset := newLeftOffset.
+ viewOrigin := newLeftOffset @ viewOrigin y.
+ self redrawFromVisibleLine:1 to:nLinesShown.
+ self originChanged:(0 @ nPixel)
+!
+
+scrollRight
+ "scroll right by one character
+ - question is how much is a good for variable fonts"
+
+ self scrollRight:font width
+!
+
+scrollRight:nPixel
+ "change origin to scroll right some cols"
+
+ |wMax cnt|
+
+
+ cnt := nPixel.
+
+"
+ commenting out the block below allows scrolling to the right of
+ the widest line
+"
+" "
+ "
+ the 10 below allows scrolling somewhat behind the end of the line
+ "
+ wMax := self widthOfContents + 10.
+ (leftOffset + nPixel + width > wMax) ifTrue:[
+ cnt := wMax - leftOffset - width
+ ].
+" "
+ cnt <= 0 ifTrue:[^ self].
+ self originWillChange.
+ leftOffset := leftOffset + cnt.
+ viewOrigin := leftOffset @ viewOrigin y.
+ self redrawFromVisibleLine:1 to:nLinesShown.
+ self originChanged:(cnt @ 0)
+!
+
+scrollSelectDown
+ "just a template - I do not know anything about selections"
+
+ ^ self subclassResponsibility
+!
+
+scrollSelectUp
+ "just a template - I do not know anything about selections"
+
+ ^ self subclassResponsibility
+!
+
+scrollToBottom
+ "change origin to show end of text"
+
+ "scrolling to the end is not really correct (i.e. should scroll to list size - nFullLinesShown),
+ but scrollDown: will adjust it ..."
+
+ self scrollToLine:(self size)
+!
+
+scrollToCol:aColNr
+ "change origin to make aColNr be the left col"
+
+ |pxlOffset|
+
+ aColNr == 1 ifTrue:[
+ leftOffset ~~ 0 ifTrue:[
+ self scrollLeft:leftOffset.
+ ].
+ ^ self
+ ].
+
+ pxlOffset := font width * (aColNr - 1).
+
+ pxlOffset < leftOffset ifTrue:[
+ self scrollLeft:(leftOffset - pxlOffset)
+ ] ifFalse:[
+ pxlOffset > leftOffset ifTrue:[
+ self scrollRight:(pxlOffset - leftOffset)
+ ]
+ ]
+!
+
+scrollToLeft
+ "change origin to start (left) of text"
+
+ leftOffset ~~ 0 ifTrue:[
+ self scrollToCol:1
+ ]
+!
+
+scrollToLine:aLineNr
+ "change origin to make aLineNr be the top line"
+
+ aLineNr < firstLineShown ifTrue:[
+ self scrollUp:(firstLineShown - aLineNr)
+ ] ifFalse:[
+ aLineNr > firstLineShown ifTrue:[
+ self scrollDown:(aLineNr - firstLineShown)
+ ]
+ ]
+!
+
+scrollToTop
+ "change origin to start of text"
+
+ self scrollToLine:1
+!
+
+scrollUp
+ "change origin to scroll up one line"
+
+ self scrollUp:1
+!
+
+scrollUp:nLines
+ "change origin to scroll up some lines"
+
+ |w "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ count "{ Class:SmallInteger }"
+ nPixel|
+
+ count := nLines.
+ count >= firstLineShown ifTrue:[
+ count := firstLineShown - 1
+ ].
+ (count == 0) ifTrue:[^ self].
+
+ self originWillChange.
+ nPixel := fontHeight * count.
+ shown ifFalse:[
+ firstLineShown := firstLineShown - count.
+ viewOrigin := viewOrigin x @ (viewOrigin y - nPixel).
+ ] ifTrue:[
+ (count >= nLinesShown) ifTrue:[
+ firstLineShown := firstLineShown - count.
+ viewOrigin := viewOrigin x @ (viewOrigin y - nPixel).
+ self redrawFromVisibleLine:1 to:nLinesShown.
] ifFalse:[
- n := 1 + (sensor compressKeyPressEventsWithKey:#ScrollDown).
+ w := self widthForScrollBetween:firstLineShown
+ and:(firstLineShown + nLinesShown).
+ w := w + leftMargin.
+ h := nPixel + margin.
+ self catchExpose.
+ self copyFrom:self x:margin y:margin
+ toX:margin y:h
+ width:w height:(height - h).
+ firstLineShown := firstLineShown - count.
+ viewOrigin := viewOrigin x @ (viewOrigin y - nPixel).
+ self redrawFromVisibleLine:1 to:count.
+ self waitForExpose.
].
- ^ self scrollDown:n
+ ].
+ self originChanged:(count negated).
+!
+
+scrollVerticalToPercent:percent
+ "scroll to a position given in percent of total"
+
+ |nL lineNr|
+
+ nL := self numberOfLines.
+ "/
+ "/ kludge for last partial line
+ "/
+ nFullLinesShown ~~ nLinesShown ifTrue:[
+ nL := nL + 1
+ ].
+ lineNr := (((nL * percent) asFloat / 100.0) + 0.5) asInteger + 1.
+ self scrollToLine:lineNr
+!
+
+startAutoScrollDown:yDistance
+ "setup for auto-scroll down (when button-press-moving below view)
+ - timeDelta for scroll is computed from distance"
+
+ |deltaT mm|
+
+ autoScroll ifFalse:[^ self].
+
+ mm := yDistance // self verticalIntegerPixelPerMillimeter + 1.
+ deltaT := 0.5 / mm.
+
+ (deltaT = autoScrollDeltaT) ifFalse:[
+ autoScrollDeltaT := deltaT.
+ autoScrollBlock isNil ifTrue:[
+ autoScrollBlock := [self scrollSelectDown].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
+ ]
+ ]
+!
+
+startAutoScrollLeft:xDistance
+ "setup for auto-scroll up (when button-press-moving to the left of the view)
+ - timeDelta for scroll is computed from distance"
+
+ |deltaT mm|
+
+ autoScroll ifFalse:[^ self].
+
+ mm := xDistance negated // self horizontalIntegerPixelPerMillimeter + 1.
+ deltaT := 0.5 / mm.
+
+ (deltaT = autoScrollDeltaT) ifFalse:[
+ autoScrollDeltaT := deltaT.
+ autoScrollBlock isNil ifTrue:[
+ autoScrollBlock := [self scrollSelectLeft].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
+ ]
+ ]
+!
+
+startAutoScrollRight:xDistance
+ "setup for auto-scroll down (when button-press-moving to the right of the view)
+ - timeDelta for scroll is computed from distance"
+
+ |deltaT mm|
+
+ autoScroll ifFalse:[^ self].
+
+ mm := xDistance // self horizontalIntegerPixelPerMillimeter + 1.
+ deltaT := 0.5 / mm.
+
+ (deltaT = autoScrollDeltaT) ifFalse:[
+ autoScrollDeltaT := deltaT.
+ autoScrollBlock isNil ifTrue:[
+ autoScrollBlock := [self scrollSelectRight].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
+ ]
+ ]
+!
+
+startAutoScrollUp:yDistance
+ "setup for auto-scroll up (when button-press-moving below view)
+ - timeDelta for scroll is computed from distance"
+
+ |deltaT mm|
+
+ autoScroll ifFalse:[^ self].
+
+ mm := yDistance negated // self verticalIntegerPixelPerMillimeter + 1.
+ deltaT := 0.5 / mm.
+
+ (deltaT = autoScrollDeltaT) ifFalse:[
+ autoScrollDeltaT := deltaT.
+ autoScrollBlock isNil ifTrue:[
+ autoScrollBlock := [self scrollSelectUp].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
+ ]
+ ]
+!
+
+stopAutoScroll
+ "stop any auto-scroll"
+
+ autoScrollBlock notNil ifTrue:[
+ self compressMotionEvents:true.
+ Processor removeTimedBlock:autoScrollBlock.
+ autoScrollBlock := nil.
+ autoScrollDeltaT := nil
+ ].
+!
+
+viewOrigin
+ "return the viewOrigin; thats the coordinate of the contents
+ which is shown topLeft in the view
+ (i.e. the origin of the visible part of the contents)."
+
+ ^ viewOrigin
+! !
+
+!ListView methodsFor:'searching'!
+
+findBeginOfWordAtLine:selectLine col:selectCol
+ "return the col of first character of the word at given line/col.
+ If the character under the initial col is a space character, return
+ the first col of the blank-block."
+
+ |beginCol thisCharacter|
+
+ beginCol := selectCol.
+ thisCharacter := self characterAtLine:selectLine col:beginCol.
+
+ "is this acharacter within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ [wordCheck value:thisCharacter] whileTrue:[
+ beginCol := beginCol - 1.
+ beginCol < 1 ifTrue:[
+ thisCharacter := Character space
+ ] ifFalse:[
+ thisCharacter := self characterAtLine:selectLine col:beginCol
+ ]
+ ].
+ beginCol := beginCol + 1.
+ ] ifFalse:[
+ "nope - maybe its a space"
+ thisCharacter == Character space ifTrue:[
+ [beginCol > 1 and:[thisCharacter == Character space]] whileTrue:[
+ beginCol := beginCol - 1.
+ thisCharacter := self characterAtLine:selectLine col:beginCol
+ ].
+ thisCharacter ~~ Character space ifTrue:[
+ beginCol := beginCol + 1.
+ ].
+ ] ifFalse:[
+ "select single character"
+ ]
+ ].
+ ^ beginCol
+!
+
+findEndOfWordAtLine:selectLine col:selectCol
+ "return the col of last character of the word at given line/col.
+ If the character under the initial col is a space character, return
+ the last col of the blank-block.
+ Return 0 if we should wrap to next line (for spaces)"
+
+ |endCol thisCharacter len|
+
+ endCol := selectCol.
+ endCol == 0 ifTrue:[endCol := 1].
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+
+ "is this acharacter within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+ [wordCheck value:thisCharacter] whileTrue:[
+ endCol := endCol + 1.
+ thisCharacter := self characterAtLine:selectLine col:endCol
+ ].
+ endCol := endCol - 1.
+ ] ifFalse:[
+ "nope - maybe its a space"
+ thisCharacter == Character space ifTrue:[
+ len := (self listAt:selectLine) size.
+ endCol > len ifTrue:[
+ "select rest to end"
+ endCol := 0
+ ] ifFalse:[
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+ [endCol <= len and:[thisCharacter == Character space]] whileTrue:[
+ endCol := endCol + 1.
+ thisCharacter := self characterAtLine:selectLine col:endCol
+ ].
+ endCol := endCol - 1.
+ ]
+ ] ifFalse:[
+ "select single character"
+ ]
].
-
- super keyPress:key x:x y:y
+ ^ endCol.
+!
+
+searchBackwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 ifAbsent:block2
+ "search for a pattern, if found evaluate block1 with row/col as arguments, if not
+ found evaluate block2.
+ Sorry, but pattern is no regular expression pattern (yet)"
+
+ |lineString col cc found firstChar savedCursor patternSize
+ line1 "{Class: SmallInteger}"|
+
+ patternSize := pattern size.
+ (list notNil and:[patternSize ~~ 0]) ifTrue:[
+ savedCursor := cursor.
+ self cursor:(Cursor questionMark).
+"/ searchPattern := pattern.
+ col := startCol - 1.
+ firstChar := pattern at:1.
+ col > (list at:startLine) size ifTrue:[
+ col := nil
+ ].
+ line1 := startLine.
+ line1 to:1 by:-1 do:[:lnr |
+ lineString := list at:lnr.
+ lineString notNil ifTrue:[
+ col isNil ifTrue:[col := lineString size - patternSize + 1].
+ [(col > 0) and:[(lineString at:col) ~~ firstChar]] whileTrue:[
+ col := col - 1
+ ].
+ [col > 0] whileTrue:[
+ cc := col.
+ found := true.
+ 1 to:patternSize do:[:cnr |
+ cc > lineString size ifTrue:[
+ found := false
+ ] ifFalse:[
+ (pattern at:cnr) ~~ (lineString at:cc) ifTrue:[
+ found := false
+ ]
+ ].
+ cc := cc + 1
+ ].
+ found ifTrue:[
+ self cursor:savedCursor.
+ ^ block1 value:lnr value:col.
+ ].
+ col := col - 1.
+ [(col > 0) and:[(lineString at:col) ~~ firstChar]] whileTrue:[
+ col := col - 1
+ ]
+ ]
+ ].
+ col := nil
+ ]
+ ].
+ "not found"
+
+ self cursor:savedCursor.
+ ^ block2 value
+!
+
+searchForwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 ifAbsent:block2
+ "search for a pattern, if found evaluate block1 with row/col as arguments, if not
+ found evaluate block2.
+ Sorry, but pattern is no regular expression pattern (yet)"
+
+ |lineString col savedCursor patternSize
+ line1 "{Class: SmallInteger}"
+ line2 "{Class: SmallInteger}"
+ p realPattern|
+
+ patternSize := pattern size.
+ (list notNil and:[patternSize ~~ 0]) ifTrue:[
+ savedCursor := cursor.
+ self cursor:(Cursor questionMark).
+
+ col := startCol + 1.
+ line1 := startLine.
+ line2 := list size.
+
+ pattern includesMatchCharacters ifTrue:[
+ p := ''.
+ (pattern startsWith:$*) ifFalse:[
+ p := p , '*'
+ ].
+ p := p , pattern.
+ (pattern endsWith:$*) ifFalse:[
+ p := p , '*'
+ ].
+ realPattern := pattern.
+ (realPattern startsWith:$*) ifTrue:[
+ realPattern := realPattern copyFrom:2
+ ].
+ line1 to:line2 do:[:lnr |
+ lineString := list at:lnr.
+ lineString notNil ifTrue:[
+ "/ first a crude check ...
+ (p match:lineString) ifTrue:[
+ "/ ok, there it is; look at which position
+ col := lineString findMatchString:realPattern startingAt:col ignoreCase:false ifAbsent:[0].
+ col ~~ 0 ifTrue:[
+ self cursor:savedCursor.
+ ^ block1 value:lnr value:col.
+ ]
+ ].
+ ].
+ col := 1
+ ]
+ ] ifFalse:[
+ line1 to:line2 do:[:lnr |
+ lineString := list at:lnr.
+ lineString isString ifTrue:[
+ col := lineString findString:pattern startingAt:col ifAbsent:[0].
+ col ~~ 0 ifTrue:[
+ self cursor:savedCursor.
+ ^ block1 value:lnr value:col.
+ ]
+ ].
+ col := 1
+ ]
+ ]
+ ].
+ "not found"
+
+ self cursor:savedCursor.
+ ^ block2 value
! !
+
+!ListView methodsFor:'tabulators'!
+
+expandTabs
+ "go through whole text expanding tabs into spaces.
+ This is meant to be called for text being imported from a file.
+ Therefore, 8-col tabs are assumed - independent of any private tab setting."
+
+ |line newLine nLines "{ Class: SmallInteger }"|
+
+ includesNonStrings := false.
+ list notNil ifTrue:[
+ nLines := self size.
+ 1 to:nLines do:[:index |
+ line := self at:index.
+ line notNil ifTrue:[
+ line isString ifTrue:[
+ newLine := line withTabsExpanded.
+ newLine ~~ line ifTrue:[
+ self withoutRedrawAt:index put:newLine
+ ].
+ ] ifFalse:[
+ includesNonStrings := true.
+ ]
+ ]
+ ]
+ ]
+
+ "Modified: 30.8.1995 / 19:06:37 / claus"
+!
+
+nextTabAfter:colNr
+ "return the next tab position after col"
+
+ ^ self nextTabAfter:colNr in:tabPositions
+!
+
+nextTabAfter:colNr in:tabPositions
+ "return the next tab position after col.
+ The second arg, tabPositions is a collection of tabStops."
+
+ |col "{ Class: SmallInteger }"
+ tabIndex "{ Class: SmallInteger }"
+ thisTab "{ Class: SmallInteger }"
+ nTabs "{ Class: SmallInteger }" |
+
+ tabIndex := 1.
+ col := colNr.
+ thisTab := tabPositions at:tabIndex.
+ nTabs := tabPositions size.
+ [thisTab <= col] whileTrue:[
+ (tabIndex == nTabs) ifTrue:[^ thisTab].
+ tabIndex := tabIndex + 1.
+ thisTab := tabPositions at:tabIndex
+ ].
+ ^ thisTab
+!
+
+prevTabBefore:colNr
+ "return the prev tab position before col"
+
+ |col "{ Class: SmallInteger }"
+ tabIndex "{ Class: SmallInteger }"
+ thisTab "{ Class: SmallInteger }"
+ nTabs "{ Class: SmallInteger }" |
+
+ tabIndex := 1.
+ col := colNr.
+ thisTab := tabPositions at:tabIndex.
+ nTabs := tabPositions size.
+ [thisTab < col] whileTrue:[
+ (tabIndex == nTabs) ifTrue:[^ thisTab].
+ tabIndex := tabIndex + 1.
+ thisTab := tabPositions at:tabIndex
+ ].
+ (tabIndex == 1) ifTrue:[
+ ^ 1
+ ].
+ ^ tabPositions at:(tabIndex - 1)
+!
+
+setTab4
+ "set 4-character tab stops"
+
+ tabPositions := self class tab4Positions.
+!
+
+setTab8
+ "set 8-character tab stops"
+
+ tabPositions := self class tab8Positions.
+!
+
+withTabs:line
+ "Assuming an 8-character tab,
+ compress multiple leading spaces to tabs, return a new line string
+ or the original line, if no tabs where created.
+ good idea, to make this one a primitive, since its called
+ many times when a big text is saved to a file."
+
+ |newLine eightSpaces nTabs|
+
+ "
+ the code below is a hack, producing many garbage strings for lines
+ which compress multiple tabs ... needs rewrite: saving big files
+ stresses the garbage collector a bit ...
+ "
+ line isNil ifTrue:[^ line].
+ eightSpaces := ' '.
+ (line startsWith:eightSpaces) ifFalse:[^ line].
+
+ nTabs := 1.
+ newLine := line copyFrom:9.
+ [newLine startsWith:eightSpaces] whileTrue:[
+ newLine := newLine copyFrom:9.
+ nTabs := nTabs + 1.
+ ].
+ ^ (String new:nTabs withAll:Character tab) asString , newLine.
+!
+
+withTabs:tabulatorTable expand:line
+ "expand tabs into spaces, return a new line string,
+ or original line, if no tabs are included.
+ good idea, to make this one a primitive, since it is called
+ many times if a big text is read from a file."
+
+ |tmpString nString nTabs
+ currentMax "{ Class: SmallInteger }"
+ dstIndex "{ Class: SmallInteger }"
+ nextTab "{ Class: SmallInteger }" |
+
+ "
+ the code below tries to avoid creating too much garbage;
+ therefore, the string is scanned first for the number of
+ tabs to get a rough idea of the final strings size.
+ (it could be done better, by computing the exact size
+ required here ...)
+ "
+ line isNil ifTrue:[^ line].
+ nTabs := line occurrencesOf:(Character tab).
+ nTabs == 0 ifTrue:[^ line].
+
+ currentMax := line size + (nTabs * 7).
+ tmpString := String new:currentMax.
+ dstIndex := 1.
+ line do:[:character |
+ (character == (Character tab)) ifTrue:[
+ nextTab := self nextTabAfter:dstIndex in:tabulatorTable.
+ [dstIndex < nextTab] whileTrue:[
+ tmpString at:dstIndex put:(Character space).
+ dstIndex := dstIndex + 1
+ ]
+ ] ifFalse:[
+ tmpString at:dstIndex put:character.
+ 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)
+ with:tmpString startingAt:1.
+ tmpString := nString.
+ nString := nil
+ ].
+
+ "make stc-optimizer happy
+ - no need to return value of ifTrue:/ifFalse above"
+ 0
+ ].
+ dstIndex := dstIndex - 1.
+ dstIndex == currentMax ifTrue:[
+ ^ tmpString
+ ].
+ ^ tmpString copyTo:dstIndex
+!
+
+withTabsExpanded:line
+ "expand tabs into spaces, return a new line string,
+ or original line, if no tabs are included.
+ good idea, to make this one a primitive"
+
+ ^ self withTabs:tabPositions expand:line
+! !
+
+!ListView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.53 1995-12-11 16:52:55 cg Exp $'
+! !