.
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
'From Smalltalk/X, Version:2.10.5 on 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
autoScrollBlock autoScrollDeltaT
searchPattern wordCheck
includesNonStrings widthOfWidestLine
listMsg
viewOrigin
menuHolder menuPerformer'
classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
DefaultFont DefaultTabPositions'
poolDictionaries:''
category:'Views-Text'
!
ListView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.26 1995-05-09 01:56:08 claus Exp $
'!
!ListView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.26 1995-05-09 01:56:08 claus Exp $
"
!
documentation
"
a View for (string-)lists.
This class can only passively display collections of strings-
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 ...
It can only scroll by full lines vertically (i.e. setting firstLineShown to ~~ 1)
which should be changed to have this behavior optionally for smooth scroll.
The text is internally kept in the list instance variable, and is supposed to consist
of a collection (Ordered- or StringCollection) of line entries.
Typically, individual entries are either strings or nil (for empty lines).
However, any object which supports the displayOn: and widthIn: protocol can be
used - see MultipleColumnListEntry as an example.
Therefore, ListView (and all subclasses) are prepared to handle non-string entries
(especially: attributed Text).
The internal version of the text has tabulators expanded to blanks - when text is exchanged
with an external medium (i.e. reading/writing files), these are expanded/compressed assuming
a tab-setting of 8. This is done independent of the users tab setting, which is used
while the text is edited. Thus, even if the tab setting is multiple of 4's, tabs are
written in multiples of 8 when the text is saved. Since this is the default on all ascii
terminals and printers, this assures that the text looks correctly indented when finally printed.
Due to historic reasons (ListView implemented scrolling before the general
scrolling code in View was added), this one does scrolling different from all other
views. The general scrolling code (in View) uses the transformation for transparent scrolling.
Here, the transformation is not used, instead it is done again, by keeping the firstLineShown
(i.e. vertical offset) and leftOffset (horizontal offset).
The most annoying consequence of this is, that scrolling is done by lines here,
while its done in pixels in the View class. Thus, be careful, when changing things
(better: dont touch it ;-)
This is being totally rewritten ... so dont depend on the internals; especially the scrolling
code will be totally removed here and the inherited functionality be used in the next version.
Instance variables:
list <aCollection> the text strings
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 area
(internal; updated on size changes)
nLinesShown <Number> the number of lines in visible area, incl. partial
(internal; updated on size changes)
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 (internal)
textStartTop <Number> margin + topMargin (internal)
innerWidth <Number> width - margins (internal)
tabPositions <aCollection> tab stops (cols)
fontHeight <Number> font height in pixels (internal)
fontAscent <Number> font ascent in pixels (internal)
fontIsFixed <Boolean> true if its a fixed font (internal)
fontWidth <Number> width of space (internal)
lineSpacing <Number> pixels between lines
searchPattern <String> last pattern for searching
wordCheck <Block> rule used for check for word boundaries in word select
(could be changed to allow for underscore and other
characters to be treated as alphaCharacters)
autoScrollBlock <Block> block installed as timeoutBlock when doing an
autoScroll (internal)
autoScrollDeltaT computed scroll time delta in seconds (internal)
includesNonStrings cached flag if any non-strings are in list
widthOfWidestLine cached width of widest line
listMsg if view has a model and listMsg is non-nil,
this is sent to the model to aquired a new contents
whenever a change of the aspect (aspectMsg) occurs.
viewOrigin the current origin
menuHolder who has a menu
(default: nil or model here, self in textViews)
menuPerformer who performs menu actions
(default: nil or model here, self in textViews)
StyleSheet parameters:
textForegroundColor defaults to Black
textBackgroundColor defaults to White
textFont defaults to defaultFont
textTabPositions defaults to #(1 9 17 25 ...)
"
! !
!ListView class methodsFor:'defaults'!
defaultTabPositions
^ 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)
!
tab8Positions
^ #(1 9 17 25 33 41 49 57 65 73 81 89 97 105 113 121 129 137 145)
! !
!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.
!
at:lineNr
"retrieve a line; return nil if beyond end-of-text.
this allows textViews to be used like collections in some places."
list isNil ifTrue:[^ nil].
(lineNr between:1 and:self size) ifFalse:[^ nil].
^ list at:lineNr
!
from:from to:to do:aBlock
"evaluate aBlock on all of my lines"
^ list from:from to:to do:aBlock.
!
setList:aCollection expandTabs:expandTabs
"set the contents (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 the user too much)"
|oldFirst|
(aCollection isNil and:[list isNil]) ifTrue:[
"no change"
^ self
].
list := aCollection.
list notNil ifTrue:[
expandTabs ifTrue:[
self expandTabs
] ifFalse:[
includesNonStrings := (list findFirst:[:l | l notNil and:[l isString not]]) ~~ 0.
]
].
self contentsChanged.
"/ new - reposition if too big
(firstLineShown + nFullLinesShown) > self size ifTrue:[
oldFirst := firstLineShown.
firstLineShown := self size - nFullLinesShown + 1.
firstLineShown < 1 ifTrue:[firstLineShown := 1].
self originChanged:(oldFirst - 1) negated.
shown ifTrue:[
self clear.
]
].
"/ end new
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
!
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"
self withoutRedrawAt:index put:aString.
shown ifTrue:[
self redrawLine:index
]
!
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)."
|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:something
"set the contents (either a string or a Collection of strings)
also scroll to top-left"
|l|
l := something.
l notNil ifTrue:[
l isString ifTrue:[
l := l asStringCollection
]
].
self list:l
!
list:aCollection
"set the contents (a collection of strings) and scroll to top-left"
|oldFirst oldLeft|
(aCollection isNil and:[list isNil]) ifTrue:[
"no change"
self scrollToTop.
self scrollToLeft.
^ self
].
list := aCollection.
list notNil ifTrue:[
self expandTabs
].
widthOfWidestLine := nil. "/ i.e. unknown
oldFirst := firstLineShown.
oldLeft := leftOffset.
firstLineShown := 1.
leftOffset := 0.
realized ifTrue:[
self contentsChanged.
"
dont use scroll here to avoid the redraw
"
oldFirst ~~ firstLineShown ifTrue:[
self originChanged:(oldFirst - 1) negated.
].
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
]
!
setList:aCollection
"set the contents (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)"
^ self setList:aCollection expandTabs:true
!
contents
"return the contents as a string"
list isNil ifTrue:[^ ''].
^ list 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
!
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.
includesNonStrings ifFalse:[
includesNonStrings := (aString notNil and:[aString isString not]).
].
shown ifTrue:[
self redrawFromLine:index.
self contentsChanged. "recompute scrollbars"
]
!
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.
!
listMessage
"return the listMsg selector;
if non-nil, this is the message sent to the model (if any) to aquire
a new text upon change of the aspect.
This defaults to the aspect-selector."
^ listMsg
!
listMessage:aSymbol
"ST-80 compatibility: set the listMsg selector;
if non-nil, this will be sent to the model (if any) to aquire a
new text upon change of the aspect.
This defaults to the aspect-selector."
listMsg := aSymbol.
!
menuHolder
"who has the menu - this defaults to model or nil here,
but self in textView & friends.
Can be changed with #menuHolder:"
menuHolder notNil ifTrue:[
^ menuHolder
].
^ super menuHolder
!
menuHolder:anObject
"change the one that provides the menu (via menuMsg)."
menuHolder := anObject
!
menuPerformer
"who does menu actions - this defaults to model or nil here,
but self in textView & friends.
Can be changed with #menuPerformer:"
menuPerformer notNil ifTrue:[
^ menuPerformer
].
^ super menuPerformer
!
menuPerformer:anObject
"change the one that does the menu actions."
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)"
|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"
list isNil ifTrue:[^ nil].
(lineNr between:1 and:self size) ifFalse:[^ nil].
^ self at:lineNr
!
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 // 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
!
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
!
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
!
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.
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
!
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
!
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
]
]
].
^ 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
! !
!ListView methodsFor:'drawing'!
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 yOfVisibleLine:startVisLineNr.
self paint:bg.
self fillRectangleX:margin y:y
width:(width - (margin * 2))
height:(endVisLineNr - startVisLineNr + 1) * fontHeight.
list isNil ifTrue:[^ self].
y := y + fontAscent.
listSize := self 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.
self 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 yOfVisibleLine: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)
]
!
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 inVisibleLine:visLineNr) - leftOffset.
y := self yOfVisibleLine:visLineNr.
self paint:bg.
(lineString notNil and:[lineString isString not]) ifTrue:[
self drawVisibleLine:visLineNr with:fg and:bg
] ifFalse:[
col > lineString size ifTrue:[
self fillRectangleX:x y:y width:(font width) 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 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
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)
]
]
]
!
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.
(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).
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)
]
]
]
! !
!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].
"
need device-font for query
"
font := font on:device.
^ numLines * fontHeight + textStartTop
+ (font descent) "makes it look better".
"/ + (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'!
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 }"
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.
h := nPixel + textStartTop.
self catchExpose.
self copyFrom:self x:margin y:h
toX:margin y:textStartTop
width:w height:(height - m2 - h).
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
]
!
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 + topMargin.
self catchExpose.
self copyFrom:self x:margin y:topMargin
toX:margin y:h
width:w height:(height - h - margin).
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"
|lineNr|
lineNr := (((self numberOfLines * 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|
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|
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|
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|
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 }"|
list notNil ifTrue:[
nLines := self size.
1 to:nLines do:[:index |
line := self at:index.
line notNil ifTrue:[
line isString ifFalse:[
newLine := line printString
] ifTrue:[
newLine := line
].
(newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
newLine := self withTabs:self class tab8Positions expand:newLine
].
(newLine ~~ line) ifTrue:[
self withoutRedrawAt:index put: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
!
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
].
^ 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
]
!
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
]
]
!
flash
"show contents in reverse colors for a moment - to wakeup the user :-)"
|savFg savBg|
savFg := fgColor.
savBg := bgColor.
fgColor := savBg.
bgColor := savFg.
self redraw.
(Delay forSeconds:0.1) wait.
fgColor := savFg.
bgColor := savBg.
self redraw
!
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) - (2 * 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
]
]
!
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:[
(font device == device) ifTrue:[
self getFontParameters.
self computeNumberOfLinesShown.
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
].
self contentsChanged
]
]
!
lineSpacing:pixles
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.
lineSpacing := 0.
fgColor := DefaultForegroundColor on:device.
bgColor := DefaultBackgroundColor on:device.
DefaultFont notNil ifTrue:[font := DefaultFont on:device]
!
initMargins
device width <= 800 ifTrue:[
"
some more pixels of real estate ...
"
leftMargin := topMargin := 1
] ifFalse:[
leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
].
textStartLeft := leftMargin + margin.
textStartTop := topMargin + margin.
innerWidth := width - textStartLeft - margin.
!
initialize
super initialize.
viewOrigin := 0@0.
self initMargins.
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.
!
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.
"
self initMargins.
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 notNil ifTrue:[
col := lineString findString:pattern startingAt:col ifAbsent:[0].
col ~~ 0 ifTrue:[
self cursor:savedCursor.
^ block1 value:lnr value:col.
]
].
col := 1
]
]
].
"not found"
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
! !
!ListView methodsFor:'event processing'!
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:[
includesNonStrings ifTrue:[
startLine to:stopLine do:[:i |
self redrawVisibleLine:i
]
] 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.
startCol > 0 ifTrue:[
endCol > 0 ifTrue:[
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.
startCol > 0 ifTrue:[
endCol > 0 ifTrue:[
startLine to:stopLine do:[:i |
self redrawVisibleLine:i from:startCol to:endCol
]
]
]
]
]
]
!
sizeChanged:how
"size changed - move origin up if possible"
|listSize newOrigin|
super sizeChanged:how.
self computeNumberOfLinesShown.
innerWidth := width - textStartLeft - margin.
shown ifFalse:[^ self].
list isNil ifTrue:[^ self].
listSize := self numberOfLines.
"
if we are behond the end, scroll up a bit
"
((firstLineShown + nFullLinesShown) > listSize) ifTrue:[
newOrigin := listSize - nFullLinesShown + 1.
newOrigin < 1 ifTrue:[
newOrigin := 1
].
self scrollToLine: newOrigin.
^ self
].
!
keyPress:key x:x y:y
"a key was pressed - handle page-keys here"
|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
! !