"
COPYRIGHT (c) 1989-93 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
View subclass:#ListView
instanceVariableNames:'list
attributes
firstLineShown leftOffset
nFullLinesShown nLinesShown
fgColor bgColor
partialLines
leftMargin topMargin
textStartLeft textStartTop innerWidth
tabPositions lineSpacing
fontHeight fontAscent
fontIsFixedWidth fontWidth
normalFont boldFont italicFont
autoScrollBlock autoScrollDeltaT
searchPattern'
classVariableNames:'spaces'
poolDictionaries:''
category:'Views-Text'
!
ListView comment:'
COPYRIGHT (c) 1989-93 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.2 1993-10-13 01:02:48 claus Exp $
written spring 89 by claus
'!
!ListView class methodsFor:'documentation'!
documentation
"
a simple View for lists - the elements must understand printString
the list is changed - the elements are replaced by their printStrings
(if this leads to problems - I will change it later)
This class can only passively display -
selections, editing, cursors etc. must be done in subclasses.
see SelectionInListView, TextView etc.
This code currently handles only fixed-height fonts correctly -
should be rewritten in some places ...
Instance variables:
list <aCollection> the text strings
attributes <aCollection> corresponding attributes
firstLineShown <Number> the index of the 1st visible line (1 ..)
leftOffset <Number> left offset for horizontal scroll
nFullLinesShown <Number> the number of unclipped lines in visible
nLinesShown <Number> the number of lines in visible
fgColor <Color> color to draw characters
bgColor <Color> the background
partialLines <Boolean> allow last line to be partial displayed
leftMargin <Number> margin at left in pixels
topMargin <Number> margin at top in pixels
textStartLeft <Number> margin + leftMargin
textStartTop <Number> margin + topMargin
innerWidth <Number> width - margins
tabPositions <aCollection> tab stops (cols)
fontHeight <Number> font height in pixels
fontAscent <Number> font ascent in pixels
fontIsFixed <Boolean> true if its a fixed font
fontWidth <Number> width of space
lineSpacing <Number> pixels between lines
normalFont <Font> font for normal characters
boldFont <Font> font for bold characters
italicFont <Font> font for italic characters
searchPattern <String> last pattern for searching
"
! !
!ListView class methodsFor:'defaults'!
defaultTabPositions
^ #(1 9 17 25 33 41 49 57 65 73 81 89 97 105 113 121 129 137 145)
! !
!ListView methodsFor:'initialization'!
initialize
super initialize.
spaces isNil ifTrue:[
spaces := String new:100
].
bitGravity := #NorthWest.
list := nil.
firstLineShown := 1.
leftOffset := 0.
partialLines := true.
tabPositions := self class defaultTabPositions.
leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
textStartLeft := leftMargin + margin.
textStartTop := topMargin + margin.
innerWidth := width - textStartLeft - margin.
self getFontParameters
!
initStyle
super initStyle.
fgColor := Black.
bgColor := White.
lineSpacing := 0.
!
initEvents
self enableKeyEvents
!
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
!
recreate
"recreate after a snapin"
super recreate.
"recompute margins and font parameters
- display may have different resolution."
leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
textStartLeft := leftMargin + margin.
textStartTop := topMargin + margin.
innerWidth := width - textStartLeft - margin.
self getFontParameters
! !
!ListView methodsFor:'accessing'!
backgroundColor:aColor
"set the background color"
bgColor := aColor.
shown ifTrue:[
self redraw
]
!
foregroundColor:aColor
"set the foreground color"
fgColor := aColor.
shown ifTrue:[
self redraw
]
!
foregroundColor:color1 backgroundColor:color2
"set both foreground and background colors"
fgColor := color1.
bgColor := color2.
shown ifTrue:[
self redraw
]
!
partialLines:aBoolean
"allow/disallow display of a last partial line"
partialLines := aBoolean.
self computeNumberOfLinesShown
!
leftMargin:aNumber
"set the margin to left of 1st col"
leftMargin := aNumber.
textStartLeft := leftMargin + margin.
innerWidth := width - textStartLeft - margin
!
leftMargin
"return the margin to left of 1st col"
^ leftMargin
!
setList:aCollection
"set the contents (a collection of strings) keep position unchanged"
(aCollection isNil and:[list isNil]) ifTrue:[
"no change"
^ self
].
list := aCollection.
list notNil ifTrue:[
self expandTabs
].
self contentsChanged.
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
!
list:aCollection
"set the contents (a collection of strings) and scroll to top"
|oldFirst|
(aCollection isNil and:[list isNil]) ifTrue:[
"no change"
self scrollToTop.
^ self
].
list := aCollection.
list notNil ifTrue:[
self expandTabs
].
self contentsChanged.
"dont use scroll here to avoid the redraw"
oldFirst := firstLineShown.
firstLineShown := 1.
self originChanged:(oldFirst - 1) negated.
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
!
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"
something isNil ifTrue:[
self setList:nil
] ifFalse:[
self setList:(something asText)
]
!
contents:something
"set the contents (either a string or a Collection of strings)
also scroll to top"
something isNil ifTrue:[
self list:nil
] ifFalse:[
self list:(something asText)
]
!
contents
"return the contents as a string"
list isNil ifTrue:[^ ''].
^ list asString
!
at:index put:aString
"change a line and redisplay"
self checkForExistingLine:index.
list at:index put:aString.
shown ifTrue:[
self redrawLine:index
]
!
at:index
"retrieve a line; return nil if behond end-of-text"
^ self listAt:index
!
removeIndexWithoutRedraw:lineNr
"delete line - no redraw;
return true, if something was really deleted"
(list isNil or:[lineNr > list size]) ifTrue:[^ false].
list removeIndex:lineNr.
lineNr "<=" < firstLineShown ifTrue:[
firstLineShown := firstLineShown - 1
].
self contentsChanged.
^ true
!
removeIndex:lineNr
"delete line"
|visLine w
srcY "{ Class: SmallInteger }" |
w := self widthForScrollBetween:lineNr
and:(firstLineShown + nLinesShown).
(self removeIndexWithoutRedraw:lineNr) ifFalse:[^ self].
visLine := self listLineToVisibleLine:lineNr.
visLine notNil ifTrue:[
srcY := topMargin + (visLine * fontHeight).
self copyFrom:self x:textStartLeft y:srcY
toX:textStartLeft y:(srcY - fontHeight)
width:w height:((nLinesShown - visLine) * fontHeight).
self redrawVisibleLine:nFullLinesShown.
(nFullLinesShown ~~ nLinesShown) ifTrue:[
self redrawVisibleLine:nLinesShown
].
exposePending := true.
self waitForExpose
]
!
font:aFont
"set the font"
aFont isNil ifTrue:[
^ self error:'nil font'
].
super font:aFont.
(font device == device) ifTrue:[
self getFontParameters.
self computeNumberOfLinesShown.
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
].
self contentsChanged
!
level:aNumber
"set the level - cought here to update text-position variables
(which avoid many computations later)"
super level:aNumber.
textStartLeft := leftMargin + margin.
textStartTop := topMargin + margin.
" textStartLeft := leftMargin. "
innerWidth := width - textStartLeft - margin
!
innerHeight
"return the number of pixels visible of the contents
- redefined since ListView adds a margin"
^ height - (2 * margin) - (2 * topMargin)
! !
!ListView methodsFor:'queries'!
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
!
numberOfLines
"return the number of lines the text has"
^ list size
!
lengthOfLongestLine
"return the length (in characters) of the longest line"
|max "{ Class: SmallInteger }"
thisLen "{ Class: SmallInteger }" |
max := 0.
list notNil ifTrue:[
list do:[:lineString |
lineString notNil ifTrue:[
thisLen := lineString size.
(thisLen > max) ifTrue:[
max := thisLen
]
]
]
].
^ max
!
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 }" |
listSize := list size.
max := 0.
first := firstLine.
last := lastLine.
(first > listSize) ifTrue:[^ max].
(last > listSize) ifTrue:[
last := listSize
].
list from:first to:last do:[:lineString |
lineString notNil ifTrue:[
thisLen := lineString size.
(thisLen > max) ifTrue:[
max := thisLen
]
]
].
^ max
!
heightOfContents
"return the height of the contents in pixels
- used for scrollbar interface"
| numLines |
numLines := self numberOfLines.
^ numLines * fontHeight + textStartTop.
"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
!
widthOfContents
"return the width of the contents in pixels"
|max|
fontIsFixedWidth ifTrue:[
^ self lengthOfLongestLine * fontWidth
].
max := 0.
list notNil ifTrue:[
max := max max:(font widthOf:list)
].
^ max
!
yOriginOfContents
"return the vertical origin of the contents in pixels
- used for scrollbar interface"
^ (firstLineShown - 1) * fontHeight
!
xOriginOfContents
"return the horizontal origin of the contents in pixels
- used for scrollbar interface"
^leftOffset
!
leftIndentOfLine:lineNr
"return the number of spaces at the left in line, lineNr"
|lineString index end|
lineString := self listAt:lineNr.
lineString isNil ifTrue:[^ 0].
index := 1.
end := lineString size.
[index <= end] whileTrue:[
(lineString at:index) isSeparator ifFalse:[^ index - 1].
index := index + 1
].
^ 0
! !
!ListView methodsFor:'private'!
getFontParameters
"get some info of the used font. They are cached since we use them often .."
font := font on:device.
normalFont := font.
fontHeight := font height + lineSpacing.
fontAscent := font ascent.
fontWidth := font width.
fontIsFixedWidth := font isFixedWidth.
!
checkForExistingLine:lineNr
"check if a line for lineNr exists; if not, expand text"
list isNil ifTrue: [
list := Text new:lineNr.
self contentsChanged
] ifFalse: [
lineNr > (list size) ifTrue:[
list grow:lineNr.
self contentsChanged
]
]
!
getBoldFont
"get a bold-font corresponding to font"
font style notNil ifTrue:[
boldFont := Font family:(font family) face:'bold'
style:'roman' size:(font size)
].
boldFont isNil ifTrue:[
boldFont := font
]
!
getItalicFont
"get an italic-font corresponding to font"
font style notNil ifTrue:[
italicFont := Font family:(font family) face:'medium'
style:'oblique' size:(font size)
].
italicFont isNil ifTrue:[
italicFont := font
]
!
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 := Text 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
!
expandTabs
"go through whole text expanding tabs into spaces"
|line newLine nLines "{ Class: SmallInteger }"|
list notNil ifTrue:[
nLines := list size.
1 to:nLines do:[:index |
line := list at:index.
line notNil ifTrue:[
(line class == String) ifFalse:[
newLine := line printString
] ifTrue:[
newLine := line
].
(newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
newLine := self withTabsExpanded:newLine
].
(newLine ~~ line) ifTrue:[
list at:index put:newLine
]
]
]
]
!
nextTabAfter:colNr
"return the next tab position after 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
].
^ 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)
!
withTabsExpanded:line
"good idea, to make this one a primitive"
|tmpString nString
currentMax "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
nextTab "{ Class: SmallInteger }" |
currentMax := 200.
tmpString := String new:currentMax.
dstIndex := 1.
line do:[:character |
(character == (Character tab)) ifTrue:[
nextTab := self nextTabAfter:dstIndex.
[dstIndex < nextTab] whileTrue:[
tmpString at:dstIndex put:(Character space).
dstIndex := dstIndex + 1
]
] ifFalse:[
tmpString at:dstIndex put:character.
dstIndex := dstIndex + 1
].
(dstIndex > currentMax) ifTrue:[
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
].
^ tmpString copyFrom:1 to:(dstIndex - 1)
!
computeNumberOfLinesShown
"recompute the number of visible lines"
nFullLinesShown := self innerHeight // fontHeight.
nLinesShown := nFullLinesShown.
partialLines ifTrue:[
((nLinesShown * fontHeight) == height) ifFalse:[
nLinesShown := nLinesShown + 1
]
]
!
widthOfWidestLineBetween:firstLine and:lastLine
"return the width in pixels of the widest line in a range"
|max "{ Class: SmallInteger }"
first "{ Class: SmallInteger }"
last "{ Class: SmallInteger }"
thisLen "{ Class: SmallInteger }"
listSize "{ Class: SmallInteger }" |
fontIsFixedWidth ifTrue:[
^ (self lengthOfLongestLineBetween:firstLine and:lastLine) * fontWidth
].
listSize := list size.
max := 0.
first := firstLine.
last := lastLine.
(first > listSize) ifTrue:[^ max].
(last > listSize) ifTrue:[
last := listSize
].
list from:first to:last do:[:line |
line notNil ifTrue:[
thisLen := font widthOf:line.
(thisLen > max) ifTrue:[
max := thisLen
]
]
].
^ max
!
widthForScrollBetween:firstLine and:lastLine
"return the width in pixels for a scroll between firstLine and lastLine"
|w|
"for small width, its not worth searching for
longest line ..."
(width < 300) ifTrue:[^ innerWidth].
w := self widthOfWidestLineBetween:firstLine
and:lastLine.
(w > innerWidth) ifTrue:[^ innerWidth].
^ w
!
listAt:lineNr
"given a lineNumber, return the corresponding string"
list isNil ifTrue:[^ nil].
(lineNr between:1 and:list size) ifFalse:[^ nil].
^ list at:lineNr
!
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 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 to:(line size)
!
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 copyFrom:1 to: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
!
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 := list size.
(listLineNr <= listsize) ifTrue:[^ listLineNr].
^ nil
!
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
!
visibleLineToAbsoluteLine:visibleLineNr
"given a visible line (1..) return absolut linenr"
visibleLineNr isNil ifTrue:[^ nil].
^ visibleLineNr + firstLineShown - 1
!
yOfLine:visLineNr
"given a visible lineNr, return y-coordinate in view
- works for fix-height fonts only"
^ ((visLineNr - 1) * fontHeight) + textStartTop
!
xOfCol:col inLine: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
!
colOfX:x inVisibleLine:visLineNr
"given a visible lineNr and x-coordinate, return colNr"
|lineString linePixelWidth xRel runCol posLeft posRight done|
xRel := x - textStartLeft.
fontIsFixedWidth ifTrue:[
^ (xRel // fontWidth) + 1
].
lineString := self visibleAt:visLineNr.
lineString notNil ifTrue:[
linePixelWidth := font widthOf:lineString
] ifFalse:[
linePixelWidth := 0
].
(xRel <= 0) ifTrue:[^ 1].
(linePixelWidth <= xRel) ifTrue:[
^ 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
!
visibleLineOfY:y
"given a y-coordinate, return lineNr
- works for fix-height fonts only"
^ ((y - textStartTop) // fontHeight) + 1
!
visibleAttributeAt:visibleLineNr
"return the attributes of what is visible at line (numbers start at 1)"
|listLineNr listsize|
listLineNr := visibleLineNr + firstLineShown - 1.
(listLineNr == 0) ifTrue:[^ nil].
(attributes notNil) ifTrue:[
listsize := attributes size
] ifFalse:[
listsize := 0
].
(listLineNr <= listsize) ifTrue:[^ attributes at:listLineNr].
^ nil
!
visibleAt:visibleLineNr
"return what is visible at line (numbers start at 1)"
|listLineNr listsize|
listLineNr := visibleLineNr + firstLineShown - 1.
(listLineNr == 0) ifTrue:[^ nil].
(list notNil) ifTrue:[
listsize := list size
] ifFalse:[
listsize := 0
].
(listLineNr <= listsize) ifTrue:[^ list at:listLineNr].
^ ''
!
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 := list size.
[sum < charPos] whileTrue:[
(lineNr > lastLine) ifTrue:[^ lineNr - 1].
sum := sum + (list 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|
pos := 1.
1 to:(lineNr - 1) do:[:lnr |
lineString := list at:lnr.
lineString notNil ifTrue:[
pos := pos + lineString size
].
pos := pos + 1 "the return-character"
].
^ pos + col - 1
! !
!ListView methodsFor:'searching'!
setSearchPattern:aString
"set the searchpattern"
searchPattern := aString withoutSeparators
!
searchForwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 else:block2
"search for a pattern, if found evaluate block1 with row/col as arguments, if not
found evaluate block2"
|lineString col cc found firstChar savedCursor patternSize|
patternSize := pattern size.
patternSize ~~ 0 ifTrue:[
savedCursor := cursor.
self cursor:(Cursor questionMark).
searchPattern := pattern.
col := startCol + 1.
"
firstChar := pattern at:1.
"
startLine to:(list size) do:[:lnr |
lineString := list at:lnr.
lineString notNil ifTrue:[
col := lineString findString:pattern startingAt:col ifAbsent:[0].
col ~~ 0 ifTrue:[
self cursor:savedCursor.
^ block1 value:lnr value:col.
]
"
col := lineString indexOf:firstChar startingAt:col.
[col == 0] whileFalse:[
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 := lineString indexOf:firstChar startingAt:col
]
"
].
col := 1
]
].
"not found"
self cursor:savedCursor.
^ block2 value
!
searchBackwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 else:block2
"search for a pattern, if found evaluate block1 with row/col as arguments, if not
found evaluate block2"
|lineString col cc found firstChar savedCursor patternSize|
patternSize := pattern size.
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
].
startLine 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:'scrolling'!
gotoLine:aLineNumber
"position to line aLineNumber; this may be redefined
in subclasses (for example to move the cursor also)"
^ self scrollToLine:aLineNumber
!
pageDown
"change origin to display next page"
self originWillChange.
firstLineShown := firstLineShown + nFullLinesShown.
self originChanged:nFullLinesShown.
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
]
!
halfPageDown
"scroll down half a page"
self scrollDown:(nFullLinesShown // 2)
!
halfPageUp
"scroll up half a page"
self scrollUp:(nFullLinesShown // 2)
!
scrollDown:nLines
"change origin to scroll down some lines"
|w "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"
m2 "{ Class:SmallInteger }"
count "{ Class:SmallInteger }"|
count := nLines.
(firstLineShown + nLines + nFullLinesShown > list size) ifTrue:[
count := list size - firstLineShown - nFullLinesShown + 1
].
count <= 0 ifTrue:[^ self].
self originWillChange.
(count >= nLinesShown) ifTrue:[
firstLineShown := firstLineShown + count.
self redrawFromVisibleLine:1 to:nLinesShown.
self originChanged:(count negated)
] ifFalse:[
m2 := margin * 2.
w := self widthForScrollBetween:firstLineShown
and:(firstLineShown + nLinesShown).
w := w + leftMargin.
firstLineShown := firstLineShown + count.
h := (fontHeight * count) + textStartTop.
self copyFrom:self x:margin y:h
toX:margin y:textStartTop
width:w height:(height - m2 - h).
self redrawFromVisibleLine:(nFullLinesShown - count + 1)
to:nLinesShown.
self originChanged:(count negated).
exposePending := true.
self waitForExpose
]
!
scrollDown
"change origin to scroll down one line"
self scrollDown:1
!
scrollUp:nLines
"change origin to scroll up some lines"
|w "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"
count "{ Class:SmallInteger }"|
count := nLines.
count >= firstLineShown ifTrue:[
count := firstLineShown - 1
].
(count == 0) ifTrue:[^ self].
self originWillChange.
(count >= nLinesShown) ifTrue:[
firstLineShown := firstLineShown - count.
self redrawFromVisibleLine:1 to:nLinesShown.
self originChanged:(count negated)
] ifFalse:[
w := self widthForScrollBetween:firstLineShown
and:(firstLineShown + nLinesShown).
w := w + leftMargin.
firstLineShown := firstLineShown - count.
h := (fontHeight * count) + topMargin.
self copyFrom:self x:margin y:topMargin
toX:margin y:h
width:w height:(height - h - margin).
self redrawFromVisibleLine:1 to:count.
self originChanged:(count negated).
exposePending := true.
self waitForExpose
]
!
scrollUp
"change origin to scroll up one line"
self scrollUp:1
!
scrollToTop
"change origin to start of text"
self scrollToLine: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)
]
]
!
scrollVerticalToPercent:percent
"scroll to a position given in percent of total"
|lineNr|
lineNr := (((self numberOfLines * percent) asFloat / 100.0) + 0.5) asInteger + 1.
self scrollToLine:lineNr
!
makeLineVisible:aListLineNr
"if aListLineNr is not visible, scroll to make it visible"
|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)
!
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
!
startScrollDown:yDistance
"setup for auto-scroll down (when button-press-moving below view)
- timeDelta for scroll is computed from distance"
|deltaT mm|
mm := yDistance // self verticalIntegerPixelPerMillimeter + 1.
deltaT := 0.5 / mm.
(deltaT = autoScrollDeltaT) ifFalse:[
autoScrollDeltaT := deltaT.
autoScrollBlock isNil ifTrue:[
autoScrollBlock := [self scrollSelectDown].
device addTimedBlock:autoScrollBlock after:deltaT
]
]
!
startScrollUp:yDistance
"setup for auto-scroll up (when button-press-moving below view)
- timeDelta for scroll is computed from distance"
|deltaT mm|
mm := yDistance negated // self verticalIntegerPixelPerMillimeter + 1.
deltaT := 0.5 / mm.
(deltaT = autoScrollDeltaT) ifFalse:[
autoScrollDeltaT := deltaT.
autoScrollBlock isNil ifTrue:[
autoScrollBlock := [self scrollSelectUp].
device addTimedBlock:autoScrollBlock after:deltaT
]
]
!
stopAutoScroll
"stop any auto-scroll"
autoScrollBlock notNil ifTrue:[
device compressMotionEvents:true.
device removeTimedBlock:autoScrollBlock.
autoScrollBlock := nil.
autoScrollDeltaT := nil
].
! !
!ListView methodsFor:'drawing'!
drawVisibleLine:visLineNr col:col with:fg and:bg
"draw single character at col index of visible line in fg/bg"
|y x lineString characterString|
lineString := self visibleAt:visLineNr.
x := (self xOfCol:col inLine:visLineNr) - leftOffset.
y := self yOfLine:visLineNr.
self paint:bg.
(lineString isNil or:[col > lineString size]) ifTrue:[
self fillRectangleX:x y:y width:(font widthOf:' ')
height:fontHeight.
self paint:fg
] ifFalse:[
characterString := (lineString at:col) asString.
self fillRectangleX:x y:y width:(font widthOf:characterString)
height:fontHeight.
self paint:fg.
self displayString:characterString x:x y:(y + fontAscent)
]
!
drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
"draw part of a visible line in fg/bg"
|y x lineString len characterString|
(endCol >= startCol) ifTrue:[
lineString := self visibleAt:visLineNr.
x := (self xOfCol:startCol inLine:visLineNr) - leftOffset.
y := (self yOfLine:visLineNr).
len := lineString size.
(startCol > len) ifTrue:[
len := endCol - startCol + 1.
self paint:bg.
self fillRectangleX:x y:y
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:y 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)
]
]
!
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 yOfLine:visLineNr.
x := (self xOfCol:index1 inLine:visLineNr) - leftOffset.
self paint:bg.
self fillRectangleX:x y:y
width:(width + leftOffset - x)
height:fontHeight.
lineString := self visibleAt:visLineNr.
lineString notNil 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)
]
]
!
drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fg and:bg
"draw a visible line range in fg/bg"
|y "{ Class: SmallInteger }"
x "{ Class: SmallInteger }"
startLine "{ Class: SmallInteger }"
endLine "{ Class: SmallInteger }"
listSize e|
y := self yOfLine:startVisLineNr.
self paint:bg.
self fillRectangleX:margin y:y
width:(width - (margin * 2))
height:(endVisLineNr - startVisLineNr + 1) * fontHeight.
y := y + fontAscent.
listSize := list size.
startLine := startVisLineNr + firstLineShown - 1.
endLine := endVisLineNr + firstLineShown - 1.
(startLine == 0) ifTrue:[
y := y + fontHeight.
startLine := startLine + 1
].
(endLine > listSize) ifTrue:[
e := listSize
] ifFalse:[
e := endLine
].
(startLine <= e) ifTrue:[
x := textStartLeft - leftOffset.
self paint:fg.
list from:startLine to:e do:[:line |
line notNil ifTrue:[
self displayString:line x:x y:y
].
y := y + fontHeight
]
]
!
drawVisibleLine:visLineNr with:fg and:bg
"draw a visible line in fg/bg"
|y line|
y := self yOfLine:visLineNr.
line := self visibleAt:visLineNr.
self paint:bg.
self fillRectangleX:margin y:y
width:(width - (margin * 2))
height:fontHeight.
line notNil ifTrue:[
self paint:fg.
self displayString:line x:(textStartLeft - leftOffset) y:(y + fontAscent)
]
! !
!ListView methodsFor:'redrawing'!
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 to:endCol
"redraw part of a visible line"
shown ifTrue:[
self drawVisibleLine:visLineNr from:startCol to:endCol 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
]
!
redrawFromVisibleLine:startVisLineNr to:endVisLineNr
"redraw a visible line range"
shown ifTrue:[
self drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fgColor and:bgColor
]
!
redrawVisibleLine:visLineNr
"redraw a visible line"
shown ifTrue:[
self drawVisibleLine:visLineNr 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
]
!
redrawLine:lineNr
"redraw a list line"
|visibleLine|
visibleLine := self listLineToVisibleLine:lineNr.
visibleLine notNil ifTrue:[
self redrawVisibleLine:visibleLine
]
!
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
]
!
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
]
]
!
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:'event processing'!
sizeChanged:how
"size changed - move origin up if possible"
|listSize newOrigin|
self computeNumberOfLinesShown.
innerWidth := width - textStartLeft - margin.
shown ifTrue:[
list notNil ifTrue:[
listSize := self numberOfLines.
((firstLineShown + nFullLinesShown) > listSize) ifTrue:[
newOrigin := listSize - nFullLinesShown + 1.
newOrigin < 1 ifTrue:[
newOrigin := 1
].
self scrollToLine: newOrigin
]
]
]
!
redrawX:x y:y width:w height:h
"a region must be redrawn"
|startLine stopLine startCol endCol|
startLine := self visibleLineOfY:y.
stopLine := self visibleLineOfY:(y + h).
"if text-margin is affected"
x < textStartLeft ifTrue:[
self paint:bgColor.
self fillRectangleX:margin y:margin width:(textStartLeft - margin)
height:(height - margin - margin)
].
y < textStartTop ifTrue:[
self paint:bgColor.
self fillRectangleX:margin y:margin width:(width - margin - margin)
height:(textStartTop - margin)
].
(w > (width // 4 * 3)) ifTrue:[
"if area is big enough redraw whole lines"
self redrawFromVisibleLine:startLine to:stopLine
] ifFalse:[
fontIsFixedWidth ifFalse:[
"start/end col has to be computed for each line"
startLine to:stopLine do:[:i |
startCol := self colOfX:x inVisibleLine:i.
endCol := self colOfX:(x + w) inVisibleLine:i.
self redrawVisibleLine:i from:startCol to:endCol
]
] ifTrue:[
"start/end col is the same for all lines"
startCol := self colOfX:x inVisibleLine:startLine.
endCol := self colOfX:(x + w) inVisibleLine:startLine.
startLine to:stopLine do:[:i |
self redrawVisibleLine:i from:startCol to:endCol
]
]
]
!
keyPress:key x:x y:y
"a key was pressed - handle page-keys here"
(key == #Prior) ifTrue: [^ self pageUp].
(key == #Next) ifTrue: [^ self pageDown].
(key == #Ctrlb) ifTrue:[^ self pageUp].
(key == #Ctrlf) ifTrue:[^ self pageDown].
(key == #Ctrld) ifTrue:[^ self halfPageDown].
(key == #Ctrlu) ifTrue:[^ self halfPageUp].
super keyPress:key x:x y:y
! !