"
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.
"
"{ Package: 'stx:libwidg' }"
View subclass:#ListView
instanceVariableNames:'list firstLineShown leftOffset nFullLinesShown nLinesShown
fgColor bgColor partialLines leftMargin topMargin textStartLeft
textStartTop innerWidth tabPositions lineSpacing fontHeight
fontAscent fontIsFixedWidth fontWidth autoScroll autoScrollBlock
autoScrollDeltaT wordCheck includesNonStrings widthOfWidestLine
listMsg viewOrigin listChannel backgroundAlreadyClearedColor
scrollWhenUpdating'
classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultTabPositions
DefaultLeftMargin DefaultTopMargin'
poolDictionaries:''
category:'Views-Text'
!
!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.
"
!
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.
Notice:
ListView is one of the oldest widget classes in the current system and
definitely requires some rewrite:
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 ;-)
Also, all controller functionality is completely performed by the listView
(and subclasses) itself. It is still possible, to define and set a specialized
controller, though. I.e. if you like to change the input behavior, define
a corresponding controller class and intersect the keyXXX/buttonXXX messages
there.
This will be 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, a collection of lines.
Nils may be used for empty lines.
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
lastSearchPattern <String> last pattern for searching
(kept to provide a default for next search)
lastSearchIgnoredCase <Boolean> last search ignored case
(kept to provide a default for next search)
wordCheck <Block> rule used for check for word boundaries in word select
The default rule is to return true for alphaNumeric characters.
(can 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
backgroundAlreadyClearedColor internal; speedup by avoiding
multiple fills when drawing
internal lines
scrollWhenUpdating
<Symbol> defines how the view is scrolled if the
model changes its value by some outside activity
(i.e. not by user input).
Can be one of:
#keep / nil -> stay unchanged
#endOfText -> scroll to the end
#beginOfText -> scroll to the top
The default is #beginOfText (i.e. scroll to top).
[StyleSheet parameters:]
textForegroundColor defaults to Black
textBackgroundColor defaults to White
textFont defaults to defaultFont
textTabPositions defaults to #(1 9 17 25 ...)
[author:]
Claus Gittinger
[see also:]
TextView EditTextView
"
!
examples
"
ListViews alone are rarely used - its mostly an abstract superclass
for TextView, EditTextView and SelectionInListView.
anyway, here are a few examples:
basic simple setup:
[exBegin]
|top l|
top := StandardSystemView new.
top extent:100@200.
l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
l list:#('one' 'two' 'three').
top open
[exEnd]
specifying textMargins (these have NOTHING to do with the viewInset):
[exBegin]
|top l|
top := StandardSystemView new.
top extent:100@200.
l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
l list:#('one' 'two' 'three').
l topMargin:10.
l leftMargin:20.
top open
[exEnd]
globally set the fg/bg colors:
[exBegin]
|top l|
top := StandardSystemView new.
top extent:100@200.
l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
l list:#('one' 'two' 'three').
l foregroundColor:(Color white).
l backgroundColor:(Color blue).
top open
[exEnd]
non-string (text) entries:
[exBegin]
|top list l|
top := StandardSystemView new.
top extent:100@200.
l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
list := #('all' 'of' 'your' 'preferred' 'colors')
with:#(red green blue 'orange' cyan)
collect:[:s :clr |
Text string:s
emphasis:(Array with:#bold
with:(#color->(Color name:clr))) ].
l list:list.
top open
[exEnd]
generic non-string entries:
(notice: ColoredListEntry is obsoleted by Text)
[exBegin]
|top list l|
top := StandardSystemView new.
top extent:100@200.
l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
list := #('all' 'of' 'your' 'preferred' 'colors')
with:#(red green blue 'orange' cyan)
collect:[:s :clr | ColoredListEntry string:s color:(Color name:clr) ].
l list:list.
top open
[exEnd]
using a model (default listMessage is aspectMessage):
[exBegin]
|top model l theModelsText|
model := Plug new.
model respondTo:#modelsAspect
with:[ theModelsText ].
top := StandardSystemView new.
top extent:100@200.
l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
l model:model.
l aspect:#modelsAspect.
top open.
Delay waitForSeconds:3.
theModelsText := #('foo' 'bar' 'baz').
model changed:#modelsAspect.
[exEnd]
using a model with different aspects
for two listViews:
[exBegin]
|top model l1 l2 plainText|
plainText := #('').
model := Plug new.
model respondTo:#modelsUppercaseText
with:[ plainText asStringCollection
collect:[:l | l asUppercase]].
model respondTo:#modelsLowercaseText
with:[ plainText asStringCollection
collect:[:l | l asLowercase]].
top := StandardSystemView extent:200@200.
l1 := ListView origin:0.0 @ 0.0 corner:1.0 @ 0.5 in:top.
l1 model:model.
l1 aspect:#modelsAspect.
l1 listMessage:#modelsUppercaseText.
l2 := ListView origin:0.0 @ 0.5 corner:1.0 @ 1.0 in:top.
l2 model:model.
l2 aspect:#modelsAspect.
l2 listMessage:#modelsLowercaseText.
top open.
Delay waitForSeconds:3.
plainText := #('foo' 'bar' 'baz').
model changed:#modelsAspect.
[exEnd]
"
! !
!ListView class methodsFor:'defaults'!
defaultTabPositions
"return an array containing the default tab positions"
^ self tab8Positions
!
tab4Positions
"return an array containing tab positions for 4-col tabs"
^ #(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
"return an array containing tab positions for 8-col tabs"
^ #(1 9 17 25 33 41 49 57 65 73 81 89 97 105 113 121 129 137 145)
!
updateStyleCache
"extract values from the styleSheet and cache them in class variables"
<resource: #style (#'text.foregroundColor' #'text.backgroundColor'
#'text.tabPositions'
#'text.font')>
DefaultForegroundColor := StyleSheet colorAt:'text.foregroundColor' default:Black.
DefaultBackgroundColor := StyleSheet colorAt:'text.backgroundColor' default:White.
DefaultFont := StyleSheet fontAt:'text.font'.
DefaultTabPositions := StyleSheet at:'text.tabPositions'.
DefaultTabPositions isNil ifTrue:[DefaultTabPositions := self defaultTabPositions].
DefaultLeftMargin := 0.5.
DefaultTopMargin := 0.5.
"Modified: 20.10.1997 / 15:05:30 / cg"
! !
!ListView methodsFor:'accessing'!
backgroundColor
"return the background color"
^ bgColor
!
backgroundColor:aColor
"set the background color of the contents"
bgColor ~~ aColor ifTrue:[
bgColor := aColor.
self viewBackground:bgColor.
shown ifTrue:[
self invalidate "/ clear; redraw
]
]
"Modified: 3.5.1997 / 10:27:40 / cg"
!
font:aFont
"set the font for all shown text.
Redraws everything.
CAVEAT: with the addition of Text objects,
this method is going to be obsoleted by a textStyle
method, which allows specific control over
normalFont/boldFont/italicFont parameters."
aFont isNil ifTrue:[
^ self error:'nil font' mayProceed:true
].
font ~~ aFont ifTrue:[
super font:(aFont onDevice:device).
preferredExtent := nil.
widthOfWidestLine := nil. "/ i.e. unknown
self getFontParameters.
realized ifTrue:[
(font graphicsDevice == device) ifTrue:[
self getFontParameters.
self computeNumberOfLinesShown.
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
].
self contentsChanged
]
]
"Modified: 5.7.1996 / 17:55:34 / cg"
!
fontHeight:pixels
"set the lines height - thats the number of pixels,
by which lines are vertically separated."
fontHeight ~~ pixels ifTrue:[
fontHeight := pixels.
]
"Created: 17.4.1997 / 01:41:33 / cg"
!
foregroundColor
"return the foreground color"
^ fgColor
!
foregroundColor:aColor
"set the foreground color"
fgColor ~~ aColor ifTrue:[
fgColor := aColor.
shown ifTrue:[
self invalidate
]
]
"Modified: 29.5.1996 / 16:19:02 / cg"
!
foregroundColor:color1 backgroundColor:color2
"set both foreground and background colors"
((fgColor ~~ color1) or:[bgColor ~~ color2]) ifTrue:[
fgColor := color1.
bgColor := color2.
shown ifTrue:[
self invalidate
]
]
"Modified: 29.5.1996 / 16:19:05 / cg"
!
innerHeight
"return the number of pixels visible of the contents
- redefined since ListView adds another margin to start the text
somewhat to indented from the 3D border."
^ height - (2 * margin) - topMargin
!
innerHorizontalMargin
"return the margin between the left border and the 1st col"
^ leftMargin
"Created: 16.1.1996 / 19:28:23 / cg"
!
innerVerticalMargin
"return the margin between the top border and the 1st line"
^ topMargin
"Created: 16.1.1996 / 19:28:00 / cg"
!
leftMargin
"return the margin to left of 1st col"
^ leftMargin
!
leftMargin:aNumber
"set the margin between the left border and the 1st col"
leftMargin := aNumber.
textStartLeft := aNumber + margin.
innerWidth := width - aNumber - margin
"Modified: 28.2.1996 / 19:32:55 / cg"
!
level:aNumber
"set the 3D level - caught here to update text-position variables
(which avoids many computations later)"
|newMargin|
aNumber ~~ level ifTrue:[
newMargin := aNumber abs.
textStartLeft := leftMargin + newMargin.
textStartTop := topMargin + newMargin.
innerWidth := width - textStartLeft - newMargin.
super level:aNumber.
]
"Modified: 11.8.1997 / 02:59:15 / cg"
!
lineSpacing:pixels
"set the lineSpacing - thats an additional number of pixels,
by which lines are vertically separated."
lineSpacing ~~ pixels ifTrue:[
lineSpacing := pixels.
self getFontParameters.
]
"Modified: 22.5.1996 / 12:22:29 / cg"
!
partialLines:aBoolean
"allow/disallow display of a last partial line"
partialLines := aBoolean.
self computeNumberOfLinesShown
!
topMargin:aNumber
"set the margin between the top border and the 1st line"
topMargin := aNumber.
textStartTop := topMargin + margin.
!
wordCheckBlock:aBlock
"set the word-check block - this block is called with a character argument,
when the end/beginning of a word is searched.
It should return true, if the character belongs to the word.
The default block is set in #initialize, and returns true for alphanumeric
(national) characters.
Applications may change it to include underlines, dollars or other characters.
(a C/C++ editor would include underlines ...)"
wordCheck := aBlock.
"Modified: 22.5.1996 / 12:26:55 / cg"
! !
!ListView methodsFor:'accessing-behavior'!
scrollWhenUpdating:aSymbolOrNil
"define how to scroll, when I get a new text
(via the model or the #contents/#list)
Allowed arguments are:
#keep / nil -> no change
#endOfText -> scroll to the end
#beginOfText -> scroll to the top
The default is #beginOfText.
This may be useful for fields which get new values assigned from
the program (i.e. not from the user)"
scrollWhenUpdating := aSymbolOrNil
! !
!ListView methodsFor:'accessing-contents'!
add:aString
"add a line and redisplay"
|fontHeightBefore|
list add:aString.
includesNonStrings ifFalse:[
includesNonStrings := (aString notNil and:[aString isString not]).
includesNonStrings ifTrue:[
fontHeightBefore := fontHeight.
self getFontParameters.
fontHeightBefore ~~ fontHeight ifTrue:[
self invalidate
].
].
].
widthOfWidestLine notNil ifTrue:[
self recomputeWidthOfWidestLineFor:aString
].
shown ifTrue:[
self redrawLine:(self size).
].
self contentsChanged. "recompute scrollbars"
"Modified: 22.10.1996 / 23:18:47 / cg"
!
add:aString beforeIndex:index
"add a line and redisplay"
list isNil ifTrue:[list := OrderedCollection new].
list add:aString beforeIndex:index.
widthOfWidestLine notNil ifTrue:[
self recomputeWidthOfWidestLineFor:aString
].
includesNonStrings ifFalse:[
includesNonStrings := (aString notNil and:[aString isString not]).
"/ includesNonStrings ifTrue:[self getFontParameters].
].
shown ifTrue:[
self redrawFromLine:index.
].
self contentsChanged. "recompute scrollbars"
"Modified: 22.10.1996 / 23:18:53 / cg"
!
addAll:aCollectionOfLines beforeIndex:index
"add a line and redisplay"
list isNil ifTrue:[list := OrderedCollection new].
aCollectionOfLines do:[:eachLine |
list addAll:aCollectionOfLines beforeIndex:index.
].
widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
((index-1) <= self lastLineShown) ifTrue:[
self redrawFromLine:index-1.
].
self contentsChanged. "recompute scrollbars"
!
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
!
at:index put:aString
"change a line and redisplay"
|visibleLine y fontHeightBefore widthBefore|
fontHeightBefore := fontHeight.
widthBefore := widthOfWidestLine.
self withoutRedrawAt:index put:aString.
shown ifTrue:[
fontHeightBefore ~= fontHeight ifTrue:[
"/ must redraw everything
self invalidate.
^ self
].
self redrawLine:index.
"/ the code below is wrong - we really have to redraw everything, if the
"/ fontHeight changes (due to a labelAndIcon in the list).
"/ "/ this could have changed the font height;
"/ "/ must clear all below last line, if it became smaller
"/ fontHeightBefore > fontHeight ifTrue:[
"/ (self listLineIsVisible:(self size)) ifTrue:[
"/ self clearRectangle:(margin @ (self yOfVisibleLine:nLinesShown+1))
"/ corner:(width-margin) @ (height-margin).
"/ ].
"/ self redrawFromLine:index
"/ ] ifFalse:[
"/ self redrawLine:index
"/ ].
"/ asynchronous:
"/ visibleLine := self listLineToVisibleLine:index.
"/ visibleLine notNil ifTrue:[
"/ y := self yOfVisibleLine:visibleLine.
"/ self invalidate:((margin @ y) extent:(width@fontHeight))
"/ ].
widthBefore ~~ widthOfWidestLine ifTrue:[
self contentsChanged
]
]
"Modified: / 26.7.1998 / 13:36:33 / cg"
!
characterAtLine:lineNr col:colNr
"return the character at physical line/col.
The lineNr and colNr arguments start at 1, for the top-left cgaracter.
Return a space character if nothing is there
(i.e. behond the end of the line or below the last line)"
|line|
list notNil ifTrue:[
line := self listAt:lineNr.
line notNil ifTrue:[
(line size >= colNr) ifTrue:[
^ line at:colNr
]
]
].
^ Character space
"Created: 29.4.1996 / 12:11:00 / cg"
"Modified: 29.4.1996 / 12:12:41 / cg"
!
contents
"return the contents as a string"
list isNil ifTrue:[^ ''].
^ list asStringCollection asString
!
contents:something
"set the contents (either a String or a Collection of strings)
also scroll to top. See #setContents:, which does not scroll.
If the argument is a string, it is converted
to a collection of line-strings here."
|l|
l := something.
l notNil ifTrue:[
l isString ifTrue:[
l := l asStringCollection
]
].
self list:l
"Modified: 5.6.1997 / 11:11:54 / cg"
!
from:from to:to do:aBlock
"evaluate aBlock on some of my lines"
^ list from:from to:to do:aBlock.
"Modified: 18.5.1996 / 14:02:14 / cg"
!
grow:n
"grow our list"
^ list grow:n.
!
list
"return the contents as a collection of strings.
This returns the views internal list - modifying it may confuse
the listView."
^ list
"Modified: 5.6.1997 / 11:10:54 / cg"
!
list:aCollection
"set the contents (a collection of strings or list entries)
and scroll as specified in scrollWhenUpdating (default:top-left).
See also #setList:, which does not scroll.
Tabs are expanded (to spaces).
The passed list is scanned for nonStrings
(remembered to optimize later redraws)."
self list:aCollection expandTabs:true
"Modified: 5.6.1997 / 11:10:45 / cg"
!
list:aCollection expandTabs:expand
"set the contents (a collection of strings)
and scroll as specified in scrollWhenUpdating (default:top-left).
If expand is true, tabs are expanded (to spaces).
The passed list is scanned for nonStrings (remembered to optimize
later redraws)."
self list:aCollection expandTabs:expand scanForNonStrings:true
"Modified: 5.6.1997 / 11:09:44 / cg"
!
list:aCollection expandTabs:expand scanForNonStrings:scan
"set the contents (a collection of strings)
and scroll as specified in scrollWhenUpdating (default:top-left).
If expand is true, tabs are expanded (to spaces).
If scan is true, scan the passed list for nonStrings; otherwise,
assume that it does contain non-strings
(remembered to optimize later redraws)."
self
list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:true
"Modified: 5.6.1997 / 12:40:35 / cg"
!
list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:nonStrings
"set the contents (a collection of strings)
and scroll as specified in scrollWhenUpdating (default:top-left).
If expand is true, tabs are expanded (to spaces).
If scan is true, scan the passed list for nonStrings;
otherwise, take the information from the nonStrings arg.
(the nonStrings information is remembered to optimize later redraws & height computations)."
|oldFirst oldLeft nonStringsBefore fontHeightBefore
scrollToEnd scrollToTop|
scrollToTop := scrollWhenUpdating == #begin or:[scrollWhenUpdating == #beginOfText].
scrollToEnd := scrollWhenUpdating == #end or:[scrollWhenUpdating == #endOfText].
(aCollection isNil and:[list isNil]) ifTrue:[
"no contents change"
scrollToTop ifTrue:[
self scrollToTop.
self scrollToLeft.
] ifFalse:[
scrollToEnd ifTrue:[
self scrollToBottom.
]
].
^ self
].
list := aCollection.
nonStringsBefore := includesNonStrings.
fontHeightBefore := fontHeight.
includesNonStrings := false.
list notNil ifTrue:[
expand ifTrue:[
self expandTabs
] ifFalse:[
scan ifTrue:[
includesNonStrings := (list findFirst:[:e | e isString not]) ~~ 0.
] ifFalse:[
includesNonStrings := nonStrings
]
].
].
(includesNonStrings ~~ nonStringsBefore) ifTrue:[
self getFontParameters.
].
widthOfWidestLine := nil. "/ i.e. unknown
oldFirst := firstLineShown.
oldLeft := leftOffset.
(includesNonStrings ~~ nonStringsBefore) ifTrue:[
self computeNumberOfLinesShown.
].
scrollToTop ifTrue:[
firstLineShown := 1.
leftOffset := 0.
] ifFalse:[
scrollToEnd ifTrue:[
firstLineShown := (list size - nFullLinesShown + 1) max:1.
leftOffset := 0.
]
].
realized ifTrue:[
self contentsChanged.
"
dont use scroll here to avoid double redraw
"
viewOrigin := 0 @ 0.
transformation := nil.
oldFirst ~~ firstLineShown ifTrue:[
self originChanged:0 @ ((oldFirst - 1) * fontHeight negated).
].
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown.
fontHeightBefore > fontHeight ifTrue:[
(self listLineIsVisible:(self size)) ifTrue:[
"/ self clearRectangle:((margin @ (self yOfVisibleLine:nLinesShown+1))
"/ corner:(width-margin) @ (height-margin)).
].
]
]
]
"Modified: / 30.8.1995 / 19:07:13 / claus"
"Created: / 5.6.1997 / 12:40:06 / cg"
"Modified: / 26.7.1998 / 13:47:35 / cg"
!
removeFromIndex:startLineNr toIndex:endLineNr
"delete some lines"
|wasOn nLines needDraw|
list isNil ifTrue:[^ self].
list removeFromIndex:startLineNr toIndex:(endLineNr min:list size).
widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
((startLineNr <= self lastLineShown)
and:[endLineNr >= firstLineShown]) ifTrue:[
self redrawFromLine:startLineNr.
].
nLines := list size.
(firstLineShown >= nLines) ifTrue:[
self makeLineVisible:nLines
].
self contentsChanged.
!
removeIndex:lineNr
"delete a line, redraw the view"
|visLine w h x
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).
"/ x := textStartLeft.
"/ CLAUS fixes leftOver selection pixels
w := w + leftMargin.
x := margin.
srcY := topMargin + (visLine * fontHeight).
"/ h := ((nLinesShown - visLine) * fontHeight).
h := (height - margin - srcY).
h > 0 ifTrue:[
self catchExpose.
self
copyFrom:self
x:x y:srcY
toX:x y:(srcY - fontHeight)
width:w height:h
async:true.
].
self redrawVisibleLine:nFullLinesShown.
"
redraw last partial line - if any
"
(nFullLinesShown ~~ nLinesShown) ifTrue:[
self redrawVisibleLine:nLinesShown
].
h > 0 ifTrue:[
self waitForExpose
].
]
"Modified: / 27.2.1998 / 12:36:59 / cg"
!
removeIndexWithoutRedraw:lineNr
"delete a line, given its lineNr - no redraw;
return true, if something was really deleted (so sender knows,
if a redraw is needed)"
(list isNil or:[lineNr > self size]) ifTrue:[^ false].
list removeIndex:lineNr.
lineNr < firstLineShown ifTrue:[
firstLineShown := firstLineShown - 1
].
self contentsChanged.
^ true
!
setContents:something
"set the contents (either a string or a Collection of strings)
dont change position (i.e. do not scroll).
This can be used to update a self-changing list
(for example: a file list being shown, without disturbing user too much).
Compare with #contents:, which scrolls to top."
|l oldSize|
oldSize := self size.
l := something.
l notNil ifTrue:[
l isString ifTrue:[
l := l asStringCollection
]
].
self setList:l.
"Modified: 18.12.1995 / 22:20:43 / stefan"
!
setList:aCollection
"set the contents (a collection of strings);
do not 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
!
setList:aCollection expandTabs:expandTabs
"set the contents (a collection of strings);
do not 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)"
self setList:aCollection expandTabs:expandTabs redraw:true
"Modified: / 22.4.1998 / 11:12:24 / cg"
!
setList:aCollection expandTabs:expandTabs redraw:doRedraw
"set the contents (a collection of strings);
do not 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 nonStringsBefore linesShownBefore|
(aCollection isNil and:[list isNil]) ifTrue:[
"no change"
^ self
].
"/ list isNil ifTrue:[
"/ linesShownBefore := (1 to:nLinesShown) collect:[:i | ''].
"/ ] ifFalse:[
"/ linesShownBefore := (firstLineShown to:(firstLineShown+nLinesShown-1))
"/ collect:[:i | (self at:i) ? ''].
"/ ].
list := aCollection.
nonStringsBefore := includesNonStrings.
includesNonStrings := false.
list notNil ifTrue:[
expandTabs ifTrue:[
self expandTabs
] ifFalse:[
includesNonStrings := (list findFirst:[:e | e isString not]) ~~ 0.
].
].
(includesNonStrings ~~ nonStringsBefore) ifTrue:[
self getFontParameters.
self computeNumberOfLinesShown.
].
"/ new - reposition horizontally if too big
widthOfWidestLine := nil. "/ i.e. unknown
innerWidth >= self widthOfContents ifTrue:[
viewOrigin x:0.
leftOffset := 0.
].
self contentsChanged.
"/ new - reposition vertically if too big
(firstLineShown + nFullLinesShown) > self size ifTrue:[
oldFirst := firstLineShown.
firstLineShown := self size - nFullLinesShown + 1.
firstLineShown < 1 ifTrue:[firstLineShown := 1].
viewOrigin y:(firstLineShown - 1 * fontHeight).
self originChanged:0 @ ((oldFirst - 1) negated * fontHeight).
linesShownBefore := nil.
shown ifTrue:[
self clear.
]
].
"/ end new
(shown and:[doRedraw]) ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
"/ linesShownBefore isNil ifTrue:[
"/ self redrawFromVisibleLine:1 to:nLinesShown
"/ ] ifFalse:[
"/ 1 to:nLinesShown do:[:l |
"/ |oldLine newLine|
"/
"/ newLine := self visibleAt:l.
"/ newLine size == 0 ifTrue:[
"/ newLine := ''
"/ ].
"/ oldLine := linesShownBefore at:l ifAbsent:nil.
"/ oldLine size == 0 ifTrue:[
"/ oldLine := ''
"/ ].
"/ oldLine ~= newLine ifTrue:[
"/ self redrawVisibleLine:l
"/ ]
"/ ]
"/ ]
]
"Modified: / 18.12.1995 / 23:27:54 / stefan"
"Created: / 22.4.1998 / 11:11:51 / cg"
"Modified: / 26.7.1998 / 13:46:49 / cg"
!
size
"return the size (i.e. number of lines)
this allows textViews to be used like collections in some places."
^ list size.
!
stringAtLine:lineNr from:col1 to:col2
"return the substring starting at physical line/col1, up-to and
including col2.
The lineNr and colNr arguments start at 1, for the top-left character.
Fills the string with space characters at the right.
(i.e. behond the end of the line or below the last line)"
|line len s|
len := col2 - col1 + 1.
list notNil ifTrue:[
line := self listAt:lineNr.
line notNil ifTrue:[
(line size >= col1) ifTrue:[
s := line copyFrom:col1.
s size < len ifTrue:[
^ s paddedTo:len
].
^ s copyTo:len
]
]
].
^ String new:len withAll:Character space
"Created: 7.1.1997 / 19:58:43 / cg"
!
textFromLine:startLine col:startCol toLine:endLine col:endCol
"return some text as a collection of (line-)strings."
|text sz index last|
(startLine == endLine) ifTrue:[
"part of a line"
^ StringCollection with:(self listAt:startLine
from:startCol
to:endCol)
].
sz := endLine - startLine + 1.
text := StringCollection new:sz.
"get 1st and last (possibly) partial lines"
text at:1 put:(self listAt:startLine from:startCol).
endCol == 0 ifTrue:[
last := ''
] ifFalse:[
last := self listAt:endLine to:endCol.
].
text at:sz put:last.
"get bulk of text"
index := 2.
(startLine + 1) to:(endLine - 1) do:[:lineNr |
text at:index put:(self listAt:lineNr).
index := index + 1
].
^ text
"Created: / 22.2.2000 / 23:53:06 / cg"
!
withoutRedrawAt:index put:aString
"change a line without redisplay and WITHOUT any sizeChange notifications.
Somewhat dangerous, since scrollBars will not be informed about contents-changes.
Use only if multiple lines are to be changed, and a sizeChanged is invoked by some other
means at the end."
|didIncludeNonStrings oldLine|
self checkForExistingLine:index.
oldLine := self listAt:index.
list at:index put:aString.
oldLine ~= aString ifTrue:[
self textChanged
].
didIncludeNonStrings := includesNonStrings.
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.
]
].
includesNonStrings ~~ didIncludeNonStrings ifTrue:[
self getFontParameters.
self computeNumberOfLinesShown
].
widthOfWidestLine notNil ifTrue:[
self recomputeWidthOfWidestLineFor:aString
].
"Modified: / 26.7.1998 / 13:00:14 / cg"
!
xxxaddAll:aCollectionOfLines beforeIndex:index
"add a line and redisplay"
list isNil ifTrue:[list := OrderedCollection new].
aCollectionOfLines do:[:eachLine |
list addAll:aCollectionOfLines beforeIndex:index.
].
widthOfWidestLine := nil. "/ i.e. unknown
self textChanged.
((index-1) <= self lastLineShown) ifTrue:[
self redrawFromLine:index-1.
].
self contentsChanged. "recompute scrollbars"
! !
!ListView methodsFor:'accessing-mvc'!
addModelInterfaceTo:aDictionary
"see comment in View>>modelInterface"
super addModelInterfaceTo:aDictionary.
aDictionary at:#listMessage put:listMsg
!
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.
!
model:aModel
"define the receivers model, from which the text is
to be aquired via list- or aspect-messages, whenever its aspect
changes."
super model:aModel.
self getListFromModel
"Created: 31.12.1996 / 14:56:43 / stefan"
!
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 change:changeSymbol list:listSymbol menu:menuSymbol
"ST-80 compatibility"
aspectSymbol notNil ifTrue:[aspectMsg := aspectSymbol.
listMsg isNil ifTrue:[listMsg := aspectSymbol]].
listSymbol notNil ifTrue:[listMsg := listSymbol].
changeSymbol notNil ifTrue:[changeMsg := changeSymbol].
menuMsg := menuSymbol.
self model:aModel.
"Modified: 2.1.1997 / 16:11:16 / cg"
!
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 list:listSymbol menu:menuSymbol
"ST-80 compatibility"
^ self on:aModel aspect:aspectSymbol change:nil list:listSymbol menu:menuSymbol
!
on:aModel aspect:aspectSymbol menu:menuSymbol
"ST-80 compatibility"
^self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:menuSymbol
! !
!ListView methodsFor:'change & update'!
update:something with:aParameter from:changedObject
changedObject == model ifTrue:[
(aspectMsg notNil
and:[something == aspectMsg]) ifTrue:[
^ self getListFromModel.
].
something == #size ifTrue:[
^ self getListFromModelScroll:false.
]
].
^ super update:something with:aParameter from:changedObject
"Modified: 5.3.1997 / 16:14:01 / cg"
! !
!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 sH l|
y := self yOfVisibleLine:startVisLineNr.
sH := lineSpacing // 2.
backgroundAlreadyClearedColor == bg ifFalse:[
self paint:bg.
self fillRectangleX:margin
y:y-sH
width:(width - (margin * 2))
height:(endVisLineNr - startVisLineNr + 1) * fontHeight + (lineSpacing - sH).
].
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 on:bg.
self from:startLine to:e do:[:line |
line notNil ifTrue:[
"/ remove lines color emphasis, to enforce color.
"/ otherwise blue text is not visible if selection-bg is blue
l := self withoutColorEmphasis:line ifFg:fg andBg:bg.
self displayOpaqueString:l x:x y:y
].
y := y + fontHeight
]
]
"Modified: / 15.12.1999 / 23:19:39 / cg"
!
drawLine:line atX:x inVisible:visLineNr with:fg and:bg
"draw a given string at visible lines position with
given x position in fg/bg. Clears the whole line before drawing the string.
Low level entry; not meant for public use."
|y l|
y := self yOfVisibleLine:visLineNr.
backgroundAlreadyClearedColor == bg ifFalse:[
self paint:bg.
self fillRectangleX:margin y:y - (lineSpacing//2)
width:(width - (2 * margin))
height:fontHeight.
].
line notNil ifTrue:[
self paint:fg on:bg.
"/ remove lines color emphasis, to enforce color.
"/ otherwise blue text is not visible if selection-bg is blue.
"/ this is only done in EditTextViews and subClasses.
self suppressEmphasisInSelection ifFalse:[
l := line
] ifTrue:[
l := self withoutColorEmphasis:line ifFg:fg andBg:bg.
].
self displayOpaqueString:l x:x y:(y + fontAscent)
]
"Modified: / 15.12.1999 / 23:19:46 / cg"
!
drawLine:line fromX:x inVisible:visLineNr with:fg and:bg
"draw a given string at visible lines position with
given x position in fg/bg. Clears partial line before drawing the string.
Low level entry; not meant for public use."
|y l|
y := self yOfVisibleLine:visLineNr.
line notNil ifTrue:[
self paint:fg on:bg.
"/ remove lines color emphasis, to enforce color.
"/ otherwise blue text is not visible if selection-bg is blue
l := self withoutColorEmphasis:line ifFg:fg andBg:bg.
self displayOpaqueString:l x:x y:(y + fontAscent)
]
"Modified: / 15.12.1999 / 23:19:55 / cg"
!
drawLine:line inVisible:visLineNr with:fg and:bg
"draw a given string at visible lines position in fg/bg"
self drawLine:line atX:(textStartLeft - leftOffset) inVisible:visLineNr with:fg and:bg
!
drawVisibleLine:visLineNr col:col with:fg and:bg
"draw single character at col index of visible line in fg/bg"
|y yf x lineString characterString em w clr|
lineString := self visibleAt:visLineNr.
(lineString notNil and:[lineString isString not]) ifTrue:[
^ self drawVisibleLine:visLineNr with:fg and:bg
].
x := (self xOfCol:col inVisibleLine:visLineNr) - leftOffset.
y := self yOfVisibleLine:visLineNr.
self paint:bg.
yf := y - (lineSpacing // 2).
col > lineString size ifTrue:[
self fillRectangleX:x y:yf width:(font width) height:fontHeight.
self paint:fg
] ifFalse:[
characterString := lineString copyFrom:col to:col.
"/ remove lines color emphasis, to enforce color.
"/ otherwise blue text is not visible if selection-bg is blue
characterString := self withoutColorEmphasis:characterString ifFg:fg andBg:bg.
w := characterString widthOn:self.
self fillRectangleX:x y:yf
width:w
height:fontHeight.
self paint:fg.
self displayString:characterString x:x y:(y + fontAscent)
]
"Modified: / 15.12.1999 / 23:21:12 / cg"
!
drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
"draw part of a visible line in fg/bg"
|y yf x lineString len characterString w sCol eCol|
(endCol >= startCol) ifTrue:[
sCol := startCol max:1.
lineString := self visibleAt:visLineNr.
(lineString notNil and:[lineString isString not])
ifTrue:[
self drawVisibleLine:visLineNr with:fg and:bg.
] ifFalse:[
x := (self xOfCol:sCol inVisibleLine:visLineNr) - leftOffset.
y := (self yOfVisibleLine:visLineNr).
yf := y - (lineSpacing // 2).
len := lineString size.
(sCol > len) ifTrue:[
backgroundAlreadyClearedColor == bg ifFalse:[
len := endCol - sCol + 1.
self paint:bg.
self fillRectangleX:x y:yf
width:(fontWidth * len)
height:fontHeight
]
] ifFalse:[
eCol := endCol.
(endCol > len) ifTrue:[
backgroundAlreadyClearedColor == bg ifFalse:[
characterString := lineString species new:endCol.
characterString replaceFrom:1 to:len with:lineString startingAt:1.
lineString := characterString.
] ifTrue:[
eCol := len.
].
].
"/ remove any color emphasis, to enforce drawing in fg/bg
lineString := self withoutColorEmphasis:lineString ifFg:fg andBg:bg.
backgroundAlreadyClearedColor == bg ifFalse:[
(lineString isMemberOf:String) ifTrue:[
fontIsFixedWidth ifTrue:[
w := (eCol - sCol + 1) * fontWidth
] ifFalse:[
w := font widthOf:lineString from:sCol to:eCol
]
] ifFalse:[
w := (lineString copyFrom:sCol to:eCol) widthOn:self
].
self paint:bg.
self fillRectangleX:x y:yf
width:w
height:fontHeight.
].
self paint:fg on:bg.
self displayOpaqueString:lineString from:sCol to:eCol x:x y:(y + fontAscent)
]
]
]
"Modified: / 15.12.1999 / 23:21:43 / cg"
!
drawVisibleLine:visLineNr from:startCol with:fg and:bg
"draw right part of a visible line from startCol to end of line in fg/bg"
|y x lineString index1 index2|
(startCol < 1) ifTrue:[
index1 := 1
] ifFalse:[
index1 := startCol
].
y := self yOfVisibleLine:visLineNr.
x := (self xOfCol:index1 inVisibleLine:visLineNr) - leftOffset.
backgroundAlreadyClearedColor == bg ifFalse:[
self paint:bg.
self fillRectangleX:x y:y - (lineSpacing // 2)
width:(width + leftOffset - x)
height:fontHeight.
].
lineString := self visibleAt:visLineNr.
lineString notNil ifTrue:[
lineString isString ifFalse:[
self drawVisibleLine:visLineNr with:fg and:bg.
] ifTrue:[
lineString := self withoutColorEmphasis:lineString ifFg:fg andBg:bg.
index2 := lineString size.
(index2 < index1) ifTrue:[^ self].
(index1 <= index2) ifTrue:[
self paint:fg on:bg.
self displayOpaqueString:lineString from:index1 to:index2 x:x y:(y + fontAscent)
]
]
]
"Modified: / 15.12.1999 / 23:24:40 / cg"
!
drawVisibleLine:visLineNr with:fg and:bg
"draw a visible line in fg/bg"
self
drawLine:(self visibleAt:visLineNr)
atX:(textStartLeft - leftOffset)
inVisible:visLineNr
with:fg
and:bg
"Modified: 28.2.1996 / 19:30:23 / cg"
!
fillRectangleX:x y:y width:w height:h
"fill rectangle; checks whether the rectangle already is filled with
the current paint (#redrawX:y:w:h).
"
backgroundAlreadyClearedColor ~~ paint ifTrue:[
super fillRectangleX:x y:y width:w height:h
]
!
invalidateLine:line
"invalidate the area of a single line.
This arranges for that line to be redrawn asynchronously (later).
If multiple such invalidations arrive, those areas may be lumped
together for a block update.
The update takes place when the windowGroup process gets a chance to
process expose events."
|yTop visLineNr|
visLineNr := self listLineToVisibleLine:line.
visLineNr notNil ifTrue:[
yTop := self yOfVisibleLine:visLineNr.
yTop isNil ifTrue:[^ self]. "/ not visible
(yTop + fontHeight) < 0 ifTrue:[^ self]. "/ not visible
self
invalidateDeviceRectangle:(Rectangle
left:margin top:yTop
width:(width - (2 * margin)) height:fontHeight)
repairNow:false.
]
"Created: / 5.3.1998 / 01:24:19 / cg"
"Modified: / 5.3.1998 / 13:41:31 / cg"
! !
!ListView methodsFor:'event processing'!
contentsChanged
"contents changed - move origin up if possible"
|listSize newOrigin|
shown ifTrue:[
list notNil ifTrue:[
listSize := self numberOfLines.
listSize == 0 ifTrue:[
widthOfWidestLine := 0.
].
"
if we are beyond the end, scroll up a bit
"
((firstLineShown + nFullLinesShown) > listSize) ifTrue:[
newOrigin := listSize - nFullLinesShown + 1.
newOrigin < 1 ifTrue:[
newOrigin := 1
].
self scrollToLine: newOrigin.
].
].
].
^ super contentsChanged
"Modified: 18.11.1996 / 19:50:07 / stefan"
"Modified: 5.3.1997 / 15:50:46 / cg"
!
keyPress:key x:x y:y
"a key was pressed - handle page-keys here"
<resource: #keyboard (#PreviousPage #NextPage #HalfPageUp #HalfPageDown
#BeginOfText #EndOfText
#ScrollUp #ScrollDown )>
|sensor n|
(key == #PreviousPage) ifTrue: [^ self pageUp].
(key == #NextPage) ifTrue: [^ self pageDown].
(key == #HalfPageUp) ifTrue: [^ self halfPageUp].
(key == #HalfPageDown) ifTrue: [^ self halfPageDown].
(key == #BeginOfText) ifTrue:[^ self scrollToTop].
(key == #EndOfText) ifTrue:[^ self scrollToBottom].
sensor := self sensor.
(key == #ScrollUp) ifTrue:[
sensor isNil ifTrue:[
n := 1
] ifFalse:[
n := 1 + (sensor compressKeyPressEventsWithKey:#ScrollUp).
].
^ self scrollUp:n
].
(key == #ScrollDown) ifTrue:[
sensor isNil ifTrue:[
n := 1
] ifFalse:[
n := 1 + (sensor compressKeyPressEventsWithKey:#ScrollDown).
].
^ self scrollDown:n
].
super keyPress:key x:x y:y
!
redrawX:x y:y width:w height:h
"a region must be redrawn"
|startCol endCol line saveClip
startLine "{ Class:SmallInteger }"
stopLine "{ Class:SmallInteger }"
|
shown ifFalse:[^ self].
startLine := self visibleLineOfY:y.
stopLine := self visibleLineOfY:(y + h).
saveClip := clipRect.
self clippingRectangle:(Rectangle left:x top:y width:w height:h).
self paint:bgColor.
self fillRectangleX:x y:y width:w height:h.
backgroundAlreadyClearedColor := bgColor.
(includesNonStrings or:[w > (width // 4 * 3)]) ifTrue:[
"includes non strings or area is big enough redraw whole lines"
self redrawFromVisibleLine:startLine to:stopLine
] ifFalse:[
line := self visibleAt:startLine.
(fontIsFixedWidth and:[line isMemberOf:String]) 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 |
line := self visibleAt:i.
(line isMemberOf:String) ifTrue:[
self redrawVisibleLine:i from:startCol to:endCol
] ifFalse:[
self redrawVisibleLine:i
]
]
]
]
]
].
backgroundAlreadyClearedColor := nil.
self clippingRectangle:saveClip.
!
sizeChanged:how
"size changed - move origin up if possible"
|listSize newOrigin|
super sizeChanged:how.
self computeNumberOfLinesShown.
innerWidth := width - textStartLeft - margin.
"/ Makes trouble when fighting with SelListViews sizeCHanged-positioning ...
"/
"/ shown ifFalse:[^ self].
"/ list isNil ifTrue:[^ self].
"/
"/ listSize := self numberOfLines.
"/ "
"/ if we are beyond the end, scroll up a bit
"/ "
"/ ((firstLineShown + nFullLinesShown) >= listSize) ifTrue:[
"/ self scrollToBottom.
"/ ^ self
"/ ].
"Modified: / 18.11.1996 / 19:37:02 / stefan"
"Modified: / 27.1.1998 / 14:10:04 / cg"
! !
!ListView methodsFor:'initialization'!
create
super create.
"I cache font parameters here - they are used so often ..."
self getFontParameters.
self computeNumberOfLinesShown.
fgColor := fgColor onDevice:device.
bgColor := bgColor onDevice:device
!
defaultControllerClass
self class == ListView ifTrue:[^ ListViewController].
^ super defaultControllerClass
!
fetchDeviceResources
"fetch device colors, to avoid reallocation at redraw time"
super fetchDeviceResources.
fgColor notNil ifTrue:[fgColor := fgColor onDevice:device].
bgColor notNil ifTrue:[bgColor := bgColor onDevice:device].
"Created: 14.1.1997 / 00:12:12 / cg"
!
initStyle
"setup viewStyle specifics"
|n|
super initStyle.
"/ DefaultFont notNil ifTrue:[font := DefaultFont on:device]
n := DefaultTopMargin.
n isInteger ifFalse:[
n := (self verticalPixelPerMillimeter:n) rounded.
].
self topMargin:n.
n := DefaultLeftMargin.
n isInteger ifFalse:[
n := (self verticalPixelPerMillimeter:n) rounded.
].
self leftMargin:n.
lineSpacing := 0.
fgColor := DefaultForegroundColor.
bgColor := DefaultBackgroundColor.
!
initialize
super initialize.
viewOrigin := 0@0.
textStartTop := topMargin + margin.
bitGravity := #NorthWest.
list := nil.
firstLineShown := 1.
nFullLinesShown := 1. "just any value ..."
nLinesShown := 1. "just any value"
leftOffset := 0.
partialLines := true.
tabPositions := DefaultTabPositions.
includesNonStrings := false.
self getFontParameters.
wordCheck := [:char | char isNationalAlphaNumeric].
scrollWhenUpdating := #beginOfText.
autoScroll := true.
"Modified: 4.11.1996 / 23:28:17 / cg"
!
realize
|sz|
extentChanged ifTrue:[
self computeNumberOfLinesShown.
].
firstLineShown ~~ 1 ifTrue:[
sz := self size.
firstLineShown + nLinesShown > sz ifTrue:[
self scrollToLine:sz - nLinesShown.
]
].
super realize.
"/ old: fetch models value on realize;
"/ new: fetch value when model is assigned.
"/
"/ model notNil ifTrue:[
"/ self getListFromModel.
"/ ]
"Modified: 15.8.1996 / 13:08:56 / stefan"
"Modified: 28.2.1997 / 19:44:19 / cg"
!
recreate
"recreate after a snapin"
|n|
super recreate.
"
recompute margins and font parameters
- display may have different resolution/font sizes.
"
"/ topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
"/ self leftMargin:(self horizontalPixelPerMillimeter:0.5) rounded.
n := DefaultTopMargin.
n isInteger ifFalse:[
n := (self verticalPixelPerMillimeter:n) rounded.
].
self topMargin:n.
n := DefaultLeftMargin.
n isInteger ifFalse:[
n := (self verticalPixelPerMillimeter:n) rounded.
].
self leftMargin:n.
self getFontParameters
"Modified: / 26.9.1998 / 17:09:32 / cg"
! !
!ListView methodsFor:'private'!
absoluteLineToVisibleLine:absLineNr
"given an absolute line (1..) return visible linenr or nil"
absLineNr isNil ifTrue:[^ nil].
(absLineNr < firstLineShown) ifTrue:[^ nil].
(absLineNr >= (firstLineShown + nLinesShown)) ifTrue:[^ nil].
^ absLineNr - firstLineShown + 1
!
characterPositionOfLine:lineNr col:col
"given a line/col position, return the character index within the contents-string,
- used with Compilers error-positioning"
|lineString pos|
self checkForExistingLine:lineNr.
pos := 1.
1 to:(lineNr - 1) do:[:lnr |
lineString := self at:lnr.
lineString notNil ifTrue:[
pos := pos + lineString size
].
pos := pos + 1 "the return-character"
].
^ pos + col - 1
!
checkForExistingLine:lineNr
"check if a line for lineNr exists; if not, expand text"
list isNil ifTrue: [
list := StringCollection new:lineNr.
self contentsChanged
] ifFalse: [
lineNr > (list size) ifTrue:[
self grow:lineNr.
self contentsChanged
]
]
!
colOfCharacterPosition:charPos
"given a character index within the contents-string,
return the column number where the character is
- used to find line to hilight from Compilers error-position"
|line|
line := self lineOfCharacterPosition:charPos.
^ charPos - (self characterPositionOfLine:line col:1) + 1.
!
colOfX:x inVisibleLine:visLineNr
"given a visible lineNr and x-coordinate, return colNr"
|lineString linePixelWidth xRel runCol posLeft posRight done
hasEmphasis oPosRight oPosLeft|
xRel := x - textStartLeft + leftOffset.
(xRel <= 0) ifTrue:[^ 1].
lineString := self visibleAt:visLineNr.
"
for fix fonts, this is easy ...
"
(fontIsFixedWidth
and:[lineString isNil
or:[lineString hasChangeOfEmphasis not]]) ifTrue:[
^ (xRel // fontWidth) + 1
].
"
for variable fonts, more work is required ...
"
lineString notNil ifTrue:[
lineString := lineString asString.
(hasEmphasis := lineString hasChangeOfEmphasis) ifTrue:[
linePixelWidth := lineString widthOn:self
] ifFalse:[
lineString := lineString string.
linePixelWidth := font widthOf:lineString.
]
] ifFalse:[
linePixelWidth := 0
].
(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
].
"/ cannot simply count individual characters,
"/ since kerning or other non-linear effects may be involved ...
runCol := lineString size // 2.
(runCol == 0) ifTrue:[runCol := 1].
hasEmphasis ifTrue:[
posLeft := (lineString copyFrom:1 to:(runCol - 1)) widthOn:self.
posRight := (lineString copyFrom:1 to:runCol) widthOn:self.
] ifFalse:[
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:[
oPosRight := posRight.
oPosLeft := posLeft.
(posRight <= xRel) ifTrue:[
runCol := runCol + 1.
posLeft := posRight.
hasEmphasis ifTrue:[
posRight := (lineString copyFrom:1 to:runCol) widthOn:self.
] ifFalse:[
posRight := font widthOf:lineString from:1 to:runCol
]
] ifFalse:[
(posLeft > xRel) ifTrue:[
runCol := runCol - 1.
(runCol == 0) ifTrue:[^ 0].
posRight := posLeft.
hasEmphasis ifTrue:[
posLeft := (lineString copyFrom:1 to:(runCol - 1)) widthOn:self.
] ifFalse:[
posLeft := font widthOf:lineString from:1 to:(runCol - 1)
]
]
].
done := (posLeft <= xRel) and:[posRight > xRel].
"234567890123456789012345678901234567890"
((oPosRight == posRight) and:[oPosLeft == posLeft]) ifTrue:[
"/ paranoia: just in case there are unprintable characters
"/ (avoid endless loop if the binary search does not make progress)
done := true.
]
].
"/self paint:Color red.
"/self displayRectangleX:posLeft+textStartLeft-leftOffset y:(self yOfVisibleLine:visLineNr)
"/ width:(posRight-posLeft) height:fontHeight.
"/self paint:Color black.
^ runCol
"Modified: / 8.9.1998 / 21:18:42 / cg"
!
computeNumberOfLinesShown
"recompute the number of visible lines"
|innerHeight|
innerHeight := self innerHeight.
nFullLinesShown := (innerHeight + lineSpacing) // fontHeight.
nLinesShown := nFullLinesShown.
partialLines ifTrue:[
((nLinesShown * fontHeight) < innerHeight) ifTrue:[
nLinesShown := nLinesShown + 1
]
]
"Modified: 29.5.1996 / 14:48:43 / cg"
!
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|
self obsoleteMethodWarning.
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
"Modified: 18.5.1996 / 14:03:16 / cg"
!
getFontParameters
"get some info of the used font. They are cached since we use them often ..
The code below uses the fonts average height parameters - these
are not OK for some oversized national characters (such as A-dieresis).
Therefore, this method should be redefined in views which will be used
with national characters (i.e. editTextViews)."
|hMax|
font := font onDevice:device.
hMax := font height.
includesNonStrings == true ifTrue:[
"/
"/ find maximum height of lines
"/
hMax := list inject:hMax into:[:maxSoFar :thisLine |
thisLine isNil ifTrue:[
maxSoFar
] ifFalse:[
(thisLine isMemberOf:String) ifTrue:[
maxSoFar
] ifFalse:[
maxSoFar max:(thisLine heightOn:self)
]
]
].
].
fontHeight := hMax + lineSpacing.
fontAscent := font ascent. "/ maxAscent.
fontWidth := font width.
fontIsFixedWidth := font isFixedWidth.
"Modified: 3.7.1997 / 12:24:25 / cg"
!
getListFromModel
"ask my model (if any) for the text via the listMsg.
If there is no listMessage, try aspect for backward compatibility."
|text msg|
model notNil ifTrue:[
msg := listMsg.
msg isNil ifTrue:[
msg := aspectMsg
].
msg notNil ifTrue:[
text := model perform:msg.
text notNil ifTrue:[
text := text asStringCollection.
].
"/ SV: this does not work, if model uses (i.e. updates) the same stringCollection
"/ as the view!!
"/ text ~= list ifTrue:[
self list:text
"/ ].
].
].
"Modified: 26.4.1996 / 14:09:42 / cg"
"Modified: 19.2.1997 / 12:08:50 / stefan"
!
getListFromModelScroll:aBoolean
"ask my model (if any) for the text via the listMsg.
If there is no listMessage, try aspect for backward compatibility."
|text msg|
model notNil ifTrue:[
msg := listMsg.
msg isNil ifTrue:[
msg := aspectMsg
].
msg notNil ifTrue:[
text := model perform:msg.
text notNil ifTrue:[
text := text asStringCollection.
].
"/ SV: this does not work, if model uses (i.e. updates) the same stringCollection
"/ as the view!!
"/ text ~= list ifTrue:[
aBoolean ifTrue:[
self list:text
] ifFalse:[
self setList:text
]
"/ ].
].
].
"Modified: 19.2.1997 / 12:08:50 / stefan"
"Created: 5.3.1997 / 16:10:22 / cg"
"Modified: 5.3.1997 / 16:14:44 / cg"
!
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) and:[lineNr <= lastLine]] whileTrue:[
sum := sum + (self at:lineNr) size + 1.
lineNr := lineNr + 1
].
sum == charPos ifTrue:[
^ lineNr
].
^ lineNr - 1
"Modified: / 5.4.1998 / 17:19:28 / cg"
!
listAt:lineNr
"given a lineNumber, return the corresponding string
This is used for accessing; i.e. for non-string entries, this
returns the corresponding string."
|l|
list isNil ifTrue:[^ nil].
(lineNr between:1 and:self size) ifFalse:[^ nil].
l := self at:lineNr.
l isNil ifTrue:[^ l].
^ l asString
"Modified: 7.9.1995 / 15:54:59 / claus"
!
listAt:lineNr from:startCol
"return right substring from startCol to end of a line"
|line|
line := self listAt:lineNr.
line isNil ifTrue:[^ nil].
(startCol > line size) ifTrue:[^ nil].
^ line copyFrom:startCol
!
listAt:lineNr from:startCol to:endCol
"return substring from startCol to endCol of a line"
|line stop lineLen|
line := self listAt:lineNr.
line isNil ifTrue:[^ nil].
lineLen := line size.
(startCol > lineLen) ifTrue:[^ nil].
stop := endCol.
(stop > lineLen) ifTrue:[stop := lineLen].
^ line copyFrom:startCol to:stop
!
listAt:lineNr to:endCol
"return left substring from start to endCol of a line"
|line stop|
line := self listAt:lineNr.
line isNil ifTrue:[^ nil].
stop := endCol.
(stop > line size) ifTrue:[stop := line size].
^ line copyTo:stop
!
listLineIsVisible:listLineNr
"return true, if a particular line is visible"
|visibleLineNr "{ Class: SmallInteger }"|
shown ifFalse:[^ false].
listLineNr isNil ifTrue:[^ false].
visibleLineNr := listLineNr + 1 - firstLineShown.
^ (visibleLineNr between:1 and:nLinesShown)
"Created: / 26.7.1998 / 13:24:16 / cg"
!
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
!
recomputeWidthOfWidestLineFor:aString
|w|
widthOfWidestLine notNil ifTrue:[
aString isString ifTrue:[
w := font widthOf:aString
] ifFalse:[
w := aString widthOn:self
].
w > widthOfWidestLine ifTrue:[
widthOfWidestLine := w.
] ifFalse:[
widthOfWidestLine := nil "/ means: unknown
].
].
^ widthOfWidestLine
!
suppressEmphasisInSelection
"selection is shown with original emphasis"
^ false
!
textChanged
"ignored here"
!
visibleAt:visibleLineNr
"return what is visible at line (numbers start at 1).
This is used for redrawing; i.e. for non-string entries, this
returns the original."
|listLineNr listsize|
listLineNr := visibleLineNr + firstLineShown - 1.
(listLineNr == 0) ifTrue:[^ nil].
(list notNil) ifTrue:[
listsize := self size
] ifFalse:[
listsize := 0
].
(listLineNr <= listsize) ifTrue:[^ self at:listLineNr].
^ ''
!
visibleLineOfY:y
"given a y-coordinate, return lineNr
- works for fix-height fonts only"
^ (((y - textStartTop) // fontHeight) + 1) max:1
"Modified: / 13.2.1998 / 20:57:26 / stefan"
!
visibleLineToAbsoluteLine:visibleLineNr
"given a visible line (1..) return absolut linenr"
visibleLineNr isNil ifTrue:[^ nil].
^ visibleLineNr + firstLineShown - 1
!
visibleLineToListLine:visibleLineNr
"given a visible line (1..) return linenr in list or nil
(this one returns nil if the given visibleLineNr is one of the
separators)"
|listLineNr "{ Class: SmallInteger }"
listsize "{ Class: SmallInteger }" |
visibleLineNr isNil ifTrue:[^ nil].
listLineNr := visibleLineNr + firstLineShown - 1.
(listLineNr == 0) ifTrue:[^nil].
listsize := self size.
(listLineNr <= listsize) ifTrue:[^ listLineNr].
^ nil
!
widthForScrollBetween:firstLine and:lastLine
"return the width in pixels for a scroll between firstLine and lastLine.
- used to optimize scrolling, by limiting the scrolled area.
Subclasses with selections or other additional visible stuff should redefine
this method."
|w|
^ innerWidth
"/ "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 isDithered]) ifTrue:[
"/ ^ width
"/ ].
"/
"/ w := self widthOfWidestLineBetween:firstLine and:lastLine.
"/ (w > innerWidth) ifTrue:[^ innerWidth].
"/ ^ w
"Modified: 17.1.1997 / 17:44:12 / cg"
!
widthOfLineString:entry
"return the width of an entry"
entry isNil ifTrue:[^ 0].
entry isString ifTrue:[
^ font widthOf:entry
].
^ entry widthOn:self
"Modified: 12.5.1996 / 20:09:53 / cg"
!
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
!
withoutColorEmphasis:line
|l|
l := line.
"/ remove lines color emphasis, to enforce color.
"/ otherwise blue text is not visible if selection-bg is blue
(line notNil
and:[line isString
and:[line hasChangeOfEmphasis]]) ifTrue:[
l := line copyFrom:1 to:line size.
1 to:line size do:[:col |
|em clr|
em := (l emphasis) at:col.
em notNil ifTrue:[
clr := Text extractEmphasis:#color from:em.
clr notNil ifTrue:[
em := Text removeEmphasis:(#color->clr) from:em.
l emphasisAt:col put:em
]
].
].
].
^ l
"Modified: / 15.12.1999 / 23:17:30 / cg"
!
withoutColorEmphasis:line ifFg:fg andBg:bg
|l|
l := line.
"/ remove lines color emphasis, to enforce color.
"/ otherwise blue text is not visible if selection-bg is blue
(line notNil
and:[line isString
and:[line hasChangeOfEmphasis
and:[fg ~= fgColor or:[bg ~= bgColor]]]]) ifTrue:[
l := line copyFrom:1 to:line size.
1 to:line size do:[:col |
|em clr|
em := (l emphasis) at:col.
em notNil ifTrue:[
clr := Text extractEmphasis:#color from:em.
clr notNil ifTrue:[
em := Text removeEmphasis:(#color->clr) from:em.
l emphasisAt:col put:em
]
].
].
].
^ l
"Modified: / 15.12.1999 / 23:17:30 / cg"
"Created: / 15.12.1999 / 23:19:30 / cg"
!
xOfCol:col inVisibleLine:visLineNr
"given a visible line- and colNr, return the x-coordinate in view"
|line lineSize tcol lText|
col == 1 ifTrue:[
lText := 0
] ifFalse:[
tcol := col - 1.
line := self visibleAt:visLineNr.
(fontIsFixedWidth
and:[line isNil
or:[line isMemberOf:String]])
ifTrue:[
lText := (tcol * fontWidth)
] ifFalse:[
line notNil ifTrue:[
lineSize := line size
] ifFalse:[
lineSize := 0
].
(lineSize == 0) ifTrue:[
lText := (tcol * fontWidth)
] ifFalse:[
(lineSize < col) ifTrue:[
lText := (line widthOn:self) + (fontWidth * (tcol - lineSize))
] ifFalse:[
(line isMemberOf:String) ifTrue:[
lText := (font widthOf:line from:1 to:tcol)
] ifFalse:[
lText := ((line copyTo:tcol) widthOn:self).
]
]
]
]
].
^ lText + textStartLeft
"Modified: / 3.9.1998 / 21:56:33 / cg"
!
yOfLine:lineNr
"given a physical lineNr, return y-coordinate in view
- works for fix-height fonts only"
^ self yOfVisibleLine:(self listLineToVisibleLine:lineNr)
"Created: / 26.7.1998 / 13:23:16 / cg"
!
yOfVisibleLine:visLineNr
"given a visible lineNr, return y-coordinate in view
- works for fix-height fonts only"
^ ((visLineNr - 1) * fontHeight) + textStartTop
! !
!ListView methodsFor:'queries'!
currentLine
"the current line (for relative gotos);
since listViews have no cursor, the first shown line is returned here.
Redefined in editTextView, to return the cursors line."
^ firstLineShown
"Created: / 17.5.1998 / 20:07:36 / cg"
!
firstLineShown
"return the index of the first (possibly partial) visible line"
^ firstLineShown
!
heightForLines:numberOfLines
"return the height of the receiver, if numberOfLines are to be displayed"
"need a device font for query"
font := font onDevice:device.
^ numberOfLines * fontHeight + topMargin + font descent + (lineSpacing) + (margin * 2)
"Created: 27.1.1996 / 16:55:39 / cg"
!
heightOfContents
"return the height of the contents in pixels
- used for scrollbar interface"
| numLines |
numLines := self numberOfLines.
numLines == 0 ifTrue:[^ 0].
"/
"/ kludge for last partial line
"/
"/ nFullLinesShown ~~ nLinesShown ifTrue:[
"/ numLines := numLines + 1
"/ ].
"
need device-font for query
"
font := font onDevice:device.
^ numLines * fontHeight
"/ + textStartTop
- (lineSpacing // 2)
+ (font descent)
"/ + (font descent)
"/ + (font descent * 2) "makes it look better"
.
"/ "it used to be that code - which is wrong"
"/ (nLinesShown == nFullLinesShown) ifTrue:[
"/ ^ numLines * fontHeight
"/ ].
"/ "add one - otherwise we cannot make last line
"/ fully visible since scrolling is done by full lines only"
"/
"/ ^ (numLines + 1) * fontHeight
!
lastLineShown
"return the index of the last (possibly partial) visible line"
^ firstLineShown + nLinesShown
!
leftIndentOfLine:lineNr
"return the number of spaces at the left in line, lineNr.
returns 0 for empty lines."
|lineString indent|
lineString := self listAt:lineNr.
lineString notNil ifTrue:[
indent := lineString leftIndent.
indent == lineString size ifTrue:[^ 0].
^ indent.
].
^ 0
"Modified: 20.4.1996 / 19:30:38 / cg"
!
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
!
lineIsFullyVisible:line
"is line fully visible?"
(line >= firstLineShown
and:[ line < (firstLineShown + nFullLinesShown) ]) ifTrue:[ ^ true ].
^ false.
"Created: 26.4.1996 / 14:36:45 / cg"
!
lineIsVisible:line
"is line visible?"
(line >= firstLineShown and:[ line < (firstLineShown + nLinesShown) ]) ifTrue:[ ^ true ].
^ false.
!
numberOfLines
"return the number of lines the text has"
^ self size
!
preferredExtentForLines:numLines cols:numCols
^ (((font widthOf:'x') * numCols + margin + margin)
@
(fontHeight * numLines + margin + margin + font descent + lineSpacing + topMargin)).
"Modified: 26.5.1996 / 12:26:41 / cg"
!
widthOfContents
"return the width of the contents in pixels
- used for scrollbar interface"
|max f d lengthOfLongestString|
list isNil ifTrue:[^ 0].
widthOfWidestLine notNil ifTrue:[^ widthOfWidestLine + (leftMargin * 2)].
(d := device) isNil ifTrue:[
"/ mhmh - really dont know yet
d := Screen current
].
f := font := font onDevice:d.
includesNonStrings ifTrue:[
max := list
inject:0
into:[:maxSoFar :entry |
(
entry isNil ifTrue:[
0
] ifFalse:[
entry isString ifTrue:[
f widthOf:entry
] ifFalse:[
entry widthOn:self
]
]
) max:maxSoFar.
]
] ifFalse:[
fontIsFixedWidth ifTrue:[
max := lengthOfLongestString := 0.
list notNil ifTrue:[
list do:[:line |
line notNil ifTrue:[
(line isString and:[line hasChangeOfEmphasis not]) ifTrue:[
line size > lengthOfLongestString ifTrue:[
lengthOfLongestString := line size
].
] ifFalse:[
max := max max:(line widthOn:self)
]
]
].
max := max max:(lengthOfLongestString * fontWidth)
].
] ifFalse:[
false "fontIsFixedWidth" ifTrue:[
max := self lengthOfLongestLine * fontWidth
] ifFalse:[
max := 0.
list notNil ifTrue:[
list do:[:line |
line notNil ifTrue:[
max := max max:(line widthOn:self)
]
].
"/ max := max max:(f widthOf:list)
].
].
].
].
widthOfWidestLine := max.
^ max + (leftMargin * 2)
"Modified: / 24.9.1998 / 18:21:08 / cg"
!
widthOfLine:lineNr
"return the width of a line in pixels"
|line f d|
list isNil ifTrue:[^ 0].
lineNr > list size ifTrue:[^ 0].
line := list at:lineNr.
list isNil ifTrue:[^ 0].
(d := device) isNil ifTrue:[
"/ mhmh - really dont know yet
d := Screen current
].
f := font := font onDevice:d.
line isString ifTrue:[
^ f widthOf:line
].
^ line widthOn:self
"Created: / 10.11.1998 / 23:59:20 / cg"
"Modified: / 11.11.1998 / 15:25:07 / cg"
!
xOriginOfContents
"return the horizontal origin of the contents in pixels
- used for scrollbar interface"
^ leftOffset
!
yOriginOfContents
"return the vertical origin of the contents in pixels
- used for scrollbar interface"
^ (firstLineShown - 1) * fontHeight
! !
!ListView methodsFor:'redrawing'!
flash
"show contents in reverse colors for a moment - to wakeup the user :-)"
self redrawInverted.
Delay waitForSeconds:0.1.
self redraw
"
Transcript flash
Transcript redrawInverted
Transcript redraw
"
!
redraw
"redraw complete view"
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
!
redrawFromLine:lineNr
"redraw starting at linrNr"
|visibleLine first|
shown ifTrue:[
"if first line to redraw is above 1st visible line,
start redraw at 1st visible line"
(lineNr < firstLineShown) ifTrue:[
first := firstLineShown
] ifFalse:[
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
]
]
]
!
redrawFromVisibleLine:startVisLineNr to:endVisLineNr
"redraw a visible line range"
shown ifTrue:[
self drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fgColor and:bgColor
]
!
redrawInverted
"show contents in reverse colors"
|savFg savBg|
savFg := fgColor.
savBg := bgColor.
fgColor := savBg.
bgColor := savFg.
self redraw.
fgColor := savFg.
bgColor := savBg.
!
redrawLine:lineNr
"redraw a list line"
|visibleLine|
visibleLine := self listLineToVisibleLine:lineNr.
visibleLine notNil ifTrue:[
self redrawVisibleLine:visibleLine
]
!
redrawLine:lineNr col:col
"redraw a single character"
|visibleLine|
visibleLine := self listLineToVisibleLine:lineNr.
visibleLine notNil ifTrue:[
self redrawVisibleLine:visibleLine col:col
]
!
redrawLine:lineNr from:startCol
"redraw a list line from startCol to end of line"
|visibleLine|
visibleLine := self listLineToVisibleLine:lineNr.
visibleLine notNil ifTrue:[
self redrawVisibleLine:visibleLine from:startCol
]
!
redrawLine:lineNr from:startCol to:endCol
"redraw a list line from startCol to endCol"
|visibleLine|
visibleLine := self listLineToVisibleLine:lineNr.
visibleLine notNil ifTrue:[
self redrawVisibleLine:visibleLine from:startCol to:endCol
]
!
redrawVisibleLine:visLineNr
"redraw a visible line"
shown ifTrue:[
self drawVisibleLine:visLineNr with:fgColor and:bgColor
]
!
redrawVisibleLine:visLineNr col:col
"redraw single character at col index of visible line"
shown ifTrue:[
self drawVisibleLine:visLineNr col:col with:fgColor and:bgColor
]
!
redrawVisibleLine:visLineNr from:startCol
"redraw right part of a visible line from startCol to end of line"
shown ifTrue:[
self drawVisibleLine:visLineNr from:startCol with:fgColor and:bgColor
]
!
redrawVisibleLine:visLineNr from:startCol to:endCol
"redraw part of a visible line"
shown ifTrue:[
self drawVisibleLine:visLineNr from:startCol to:endCol with:fgColor and:bgColor
]
! !
!ListView methodsFor:'scrolling'!
gotoLine:aLineNumber
"position to line aLineNumber; this may be redefined
in subclasses (for example to move the cursor also)"
^ self scrollToLine:aLineNumber
!
halfPageDown
"scroll down half a page"
self scrollDown:(nFullLinesShown // 2)
!
halfPageUp
"scroll up half a page"
self scrollUp:(nFullLinesShown // 2)
!
horizontalScrollStep
"return the amount to scroll when stepping up/down.
Here, the scrolling unit is characters."
^ font width
"Created: / 21.5.1999 / 15:55:06 / cg"
!
makeColVisible:aCol inLine:aLineNr
"if column aCol is not visible, scroll horizontal to make it visible"
|xWant xVis visLnr|
(aCol isNil or:[shown not]) ifTrue:[^ self].
visLnr := self absoluteLineToVisibleLine:aLineNr.
visLnr isNil ifTrue:[^ self].
xWant := self xOfCol:aCol inVisibleLine:visLnr.
xVis := xWant - leftOffset.
"
dont scroll, if already visible
(but scroll, if not in inner 20%..80% of visible area)
"
"/ ((xVis >= (width // 5)) and:[xVis <= (width * 4 // 5)]) ifTrue:[
"/ ^ self
"/ ].
"
no, the above does not look good, if you click / select at the
far right - makes selecting so difficult ...
"
(xVis >= 0 and:[xVis < (width - font width)]) ifTrue:[^ self].
self scrollHorizontalTo:(xWant - (width // 2)).
!
makeLineVisible:aListLineNr
"if aListLineNr is not visible, scroll to make it visible.
Numbering starts with 1 for the very first line of the text."
|bott newTopLine|
(aListLineNr isNil "or:[shown not]") ifTrue:[^ self].
"/ Old code follows. It is no longer used, because:
"/ 1. we must maintain our viewOrigin (not maintained in this code!!)
"/ 2. we must inform our dependents about originChanges.
"/
"/ shown ifFalse:[
"/ firstLineShown := (aListLineNr - 1) max:1.
"/ firstLineShown > (list size - nFullLinesShown) ifTrue:[
"/ firstLineShown := list size - nFullLinesShown
"/ ].
"/ list size <= nFullLinesShown ifTrue:[
"/ firstLineShown := 1
"/ ].
"/ ^ self
"/ ].
(self needScrollToMakeLineVisible:aListLineNr) ifFalse:[
^ self
].
(aListLineNr < nFullLinesShown) ifTrue:[
"/ at the very top of the list - show from top
newTopLine := 1
] ifFalse:[
(nFullLinesShown < 3) ifTrue:[
"/ a small view - show from that line
newTopLine := aListLineNr
] ifFalse:[
bott := self numberOfLines - (nFullLinesShown - 1).
(aListLineNr > bott) ifTrue:[
"/ at the end of the list - show the bottom of the list
newTopLine := bott
] ifFalse:[
"/ somewhere else - place selected line into the middle of
"/ the view
newTopLine := (aListLineNr - (nFullLinesShown // 2) + 1)
]
]
].
self scrollToLine:newTopLine.
"Modified: / 18.12.1996 / 17:48:22 / stefan"
"Modified: / 7.8.1998 / 15:14:12 / cg"
!
makeVisible:someString
"if nescessary, scroll to make the (first)
line containing someString visible."
|index list|
(list := self list) notNil ifTrue:[
index := list indexOf:someString.
index ~~ 0 ifTrue:[
self makeLineVisible:index
]
]
"Modified: 9.9.1997 / 10:10:13 / cg"
!
needScrollToMakeLine:aListLineNr
"return true, if a scroll is needd to make a line visible.
Numbering starts with 1 for the very first line of the text."
(aListLineNr >= firstLineShown) ifTrue:[
(aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
^ false
]
].
^ true
"Created: / 7.8.1998 / 15:13:51 / cg"
"Modified: / 7.8.1998 / 15:14:44 / cg"
!
needScrollToMakeLineVisible:aListLineNr
"return true, if a scroll is needd to make a line visible.
Numbering starts with 1 for the very first line of the text."
(aListLineNr >= firstLineShown) ifTrue:[
(aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
^ false
]
].
^ true
"Created: / 7.8.1998 / 15:13:51 / cg"
"Modified: / 7.8.1998 / 15:14:44 / cg"
!
pageDown
"change origin to display next page"
self scrollTo:(viewOrigin + (0 @ height))
!
pageUp
"change origin to display previous page"
self scrollTo:(viewOrigin - (0 @ height))
!
scrollDown:nLines
"change origin to scroll down some lines (towards the bottom of the text)"
nLines ~~ 0 ifTrue:[
self scrollTo:(viewOrigin + (0 @ (fontHeight * nLines)))
redraw:true
]
"Modified: / 21.5.1999 / 15:59:52 / cg"
!
scrollDownPixels:pix
"change origin to scroll down some pixels
(towards the bottom of the text)
THIS WILL VANISH!!"
pix > 0 ifTrue:[
self scrollTo:(viewOrigin + (0 @ (pix abs))) redraw:true
]
!
scrollHorizontalTo:aPixelOffset
"change origin to make aPixelOffset be the left col"
|nPixel|
nPixel := aPixelOffset - leftOffset.
nPixel ~~ 0 ifTrue:[
self scrollTo:(viewOrigin + (nPixel @ 0)) redraw:true
]
"Modified: / 3.3.1999 / 22:55:20 / cg"
!
scrollLeft:nPixel
"change origin to scroll left some cols"
nPixel ~~ 0 ifTrue:[
self scrollTo:(viewOrigin - (nPixel @ 0)) redraw:true
]
"Modified: / 21.5.1999 / 15:59:16 / cg"
!
scrollRight:nPixel
"change origin to scroll right some cols"
nPixel ~~ 0 ifTrue:[
self scrollTo:(viewOrigin + (nPixel @ 0)) redraw:true
]
"Modified: / 21.5.1999 / 15:59:21 / cg"
!
scrollSelectDown
"just a template - I do not know anything about selections"
^ self subclassResponsibility
!
scrollSelectUp
"just a template - I do not know anything about selections"
^ self subclassResponsibility
!
scrollToBottom
"change origin to show end of text"
"scrolling to the end is not really correct (i.e. should scroll to list size - nFullLinesShown),
but scrollDown: will adjust it ..."
self scrollToLine:(self size)
!
scrollToCol:aColNr
"change origin to make aColNr be the left col"
|pxlOffset|
aColNr == 1 ifTrue:[
leftOffset ~~ 0 ifTrue:[
self scrollLeft:leftOffset.
].
^ self
].
pxlOffset := font width * (aColNr - 1).
pxlOffset < leftOffset ifTrue:[
self scrollLeft:(leftOffset - pxlOffset)
] ifFalse:[
pxlOffset > leftOffset ifTrue:[
self scrollRight:(pxlOffset - leftOffset)
]
]
!
scrollToLeft
"change origin to start (left) of text"
leftOffset ~~ 0 ifTrue:[
self scrollToCol:1
]
!
scrollToLine:aLineNr
"change origin to make aLineNr be the top line"
aLineNr < firstLineShown ifTrue:[
self scrollUp:(firstLineShown - aLineNr)
] ifFalse:[
aLineNr > firstLineShown ifTrue:[
self scrollDown:(aLineNr - firstLineShown)
]
]
!
scrollToPercent:percentOrigin
"scroll to a position given in percent of total"
"kludge - ListView thinks in lines"
self scrollHorizontalToPercent:percentOrigin x.
self scrollVerticalToPercent:percentOrigin y.
!
scrollToTop
"change origin to start of text"
self scrollToLine:1
!
scrollUp:nLines
"change origin to scroll up some lines (towards the top of the text)"
nLines ~~ 0 ifTrue:[
self scrollTo:(viewOrigin - (0 @ (fontHeight * nLines)))
redraw:true
]
"Modified: / 21.5.1999 / 15:59:45 / cg"
!
scrollUpPixels:pix
"change origin to scroll up some pixels
(towards the top of the text)
THIS WILL VANISH!!"
pix > 0 ifTrue:[
self scrollTo:(viewOrigin - (0 @ pix)) redraw:true
]
!
scrollVerticalToPercent:percent
"scroll to a position given in percent of total"
|nL lineNr|
nL := self numberOfLines.
"/
"/ kludge for last partial line
"/
nFullLinesShown ~~ nLinesShown ifTrue:[
nL := nL + 1
].
lineNr := (((nL * percent) asFloat / 100.0) + 0.5) asInteger + 1.
self scrollToLine:lineNr
!
startAutoScrollDown:yDistance
"setup for auto-scroll down (when button-press-moving below view)
- timeDelta for scroll is computed from distance"
|deltaT mm|
autoScroll ifFalse:[^ self].
mm := yDistance // self verticalIntegerPixelPerMillimeter + 1.
deltaT := 0.5 / mm.
(deltaT = autoScrollDeltaT) ifFalse:[
autoScrollDeltaT := deltaT.
autoScrollBlock isNil ifTrue:[
autoScrollBlock := [self scrollSelectDown].
Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
]
]
!
startAutoScrollLeft:xDistance
"setup for auto-scroll up (when button-press-moving to the left of the view)
- timeDelta for scroll is computed from distance"
|deltaT mm|
autoScroll ifFalse:[^ self].
mm := xDistance negated // self horizontalIntegerPixelPerMillimeter + 1.
deltaT := 0.5 / mm.
(deltaT = autoScrollDeltaT) ifFalse:[
autoScrollDeltaT := deltaT.
autoScrollBlock isNil ifTrue:[
autoScrollBlock := [self scrollSelectLeft].
Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
]
]
!
startAutoScrollRight:xDistance
"setup for auto-scroll down (when button-press-moving to the right of the view)
- timeDelta for scroll is computed from distance"
|deltaT mm|
autoScroll ifFalse:[^ self].
mm := xDistance // self horizontalIntegerPixelPerMillimeter + 1.
deltaT := 0.5 / mm.
(deltaT = autoScrollDeltaT) ifFalse:[
autoScrollDeltaT := deltaT.
autoScrollBlock isNil ifTrue:[
autoScrollBlock := [self scrollSelectRight].
Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
]
]
!
startAutoScrollUp:yDistance
"setup for auto-scroll up (when button-press-moving below view)
- timeDelta for scroll is computed from distance"
|deltaT mm|
autoScroll ifFalse:[^ self].
mm := yDistance negated // self verticalIntegerPixelPerMillimeter + 1.
deltaT := 0.5 / mm.
(deltaT = autoScrollDeltaT) ifFalse:[
autoScrollDeltaT := deltaT.
autoScrollBlock isNil ifTrue:[
autoScrollBlock := [self scrollSelectUp].
Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
]
]
!
stopAutoScroll
"stop any auto-scroll"
autoScrollBlock notNil ifTrue:[
self compressMotionEvents:true.
Processor removeTimedBlock:autoScrollBlock.
autoScrollBlock := nil.
autoScrollDeltaT := nil
].
!
verticalScrollStep
"return the amount to scroll when stepping up/down.
Here, the scrolling unit is lines."
^ 1
"Created: / 21.5.1999 / 14:00:12 / cg"
!
viewOrigin
"return the viewOrigin; thats the coordinate of the contents
which is shown topLeft in the view
(i.e. the origin of the visible part of the contents)."
^ viewOrigin
! !
!ListView methodsFor:'scrolling basic'!
scrollTo:anOrigin redraw:doRedraw
"change origin to have newOrigin be visible at the top-left.
The argument defines the integer device coordinates of the new top-left
point.
"
|dltOrg
noLn "{ Class:SmallInteger }"
max "{ Class:SmallInteger }"
tmp "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
x "{ Class:SmallInteger }"
delta newFirstLine newViewOrigin newLeftOffset
hBefore wBefore inv wg|
hBefore := height.
wBefore := width.
dltOrg := anOrigin - viewOrigin.
"/ compute valid horizontal offset x
(x := dltOrg x) ~~ 0 ifTrue:[
tmp := leftOffset + x.
x < 0 ifTrue:[ "/ scrolling left
tmp < 0 ifTrue:[x := 0 - leftOffset]
] ifFalse:[ "/ scrolling right
"/ allows scrolling to the right of widest line
max := self widthOfContents + 10.
tmp + width > max ifTrue:[
x := (max - leftOffset - width) max:0
]
]
].
"/ compute valid vertical offset measured in lines
(y := dltOrg y // fontHeight) ~~ 0 ifTrue:[
tmp := firstLineShown + y.
y < 0 ifTrue:[ "/ scrolling up
tmp < 1 ifTrue:[y := 1 - firstLineShown]
] ifFalse:[ "/ scrolling down
max := self size.
tmp + nFullLinesShown > max ifTrue:[
y := (max - firstLineShown - nFullLinesShown + 1) max:0
]
]
].
(x == 0 and:[y == 0]) ifTrue:[ "/ has viewOrigin changed ?
^ self
].
(noLn := y) ~~ 0 ifTrue:[
y := y * fontHeight
].
delta := (x @ y).
newFirstLine := firstLineShown + noLn.
newViewOrigin := viewOrigin + delta.
newLeftOffset := newViewOrigin x max:0.
(shown and:[doRedraw]) ifFalse:[
self originWillChange.
firstLineShown := newFirstLine.
viewOrigin := newViewOrigin.
leftOffset := newLeftOffset.
^ self originChanged:delta
].
"/ (self sensor notNil and: [self sensor hasExposeEventFor:self]) ifTrue:[ "/ outstanding expose events
"/ self invalidate. "/ redraw all
"/ self originWillChange.
"/ ^ self originChanged:(x @ y )
"/ ].
( (y ~~ 0 and:[x ~~ 0]) "/ both x and y changed
or:[(noLn abs) >= nLinesShown "/ at least one area is
or:[(x abs) > (width // 4 * 3)]] "/ big enough to redraw all
) ifTrue:[
self originWillChange.
firstLineShown := newFirstLine.
viewOrigin := newViewOrigin.
leftOffset := newLeftOffset.
self invalidate.
^ self originChanged:delta
].
"/ OLD:
"/ self repairDamage.
(wg := self windowGroup) notNil ifTrue:[
wg processRealExposeEventsFor:self.
].
self originWillChange.
"/ make certain, that all drawing is complete
"/ device sync.
self catchExpose.
x == 0 ifTrue:[
"/ scrolling vertical
y0 := textStartTop + (y abs).
h := hBefore - margin - y0.
w := wBefore - margin.
y > 0 ifTrue:[ "/ copy down
"/ kludge: if the selection highlighting draws into the textStartTop area,
"/ the copy below leaves some selection depris in the top area.
"/ Therefore, clear the top area.
"/ (should avoid this, in case we know there cannot be anything
"/ there - selection is nil or >= firstLineShown).
self clearDeviceRectangleX:margin y:margin width:width-margin-margin height:(textStartTop-margin).
"/ self invalidateDeviceRectangle:((margin@margin) corner:(width-margin@textStartTop)) repairNow:false.
self copyFrom:self
x:0 y:y0 toX:0 y:textStartTop
width:w height:h async:true.
y1 := h - 1.
y0 := y0 + 1.
] ifFalse:[ "/ copy up
self copyFrom:self
x:margin y:textStartTop toX:margin y:y0
width:w height:h async:true.
y1 := 0.
].
inv := (margin@y1) extent:(w@y0).
] ifFalse:[
"/ scrolling horizontal
x > 0 ifTrue:[ "/ scrolling right
y0 := margin + x.
y1 := wBefore - y0.
] ifFalse:[ "/ scrolling left
y0 := margin - x.
y1 := 0.
].
h := hBefore - margin - margin.
w := wBefore - margin - y0.
x > 0 ifTrue:[ "/ copy right
self copyFrom:self x:y0 y:margin toX:margin y:margin
width:w height:h async:true.
] ifFalse:[ "/ copy left
"/self copyFrom:self x:textStartLeft y:margin toX:y0 y:margin
self copyFrom:self x:margin y:margin toX:y0 y:margin
width:w height:h async:true.
].
inv := (y1@margin) extent:(y0@h).
].
firstLineShown := newFirstLine.
viewOrigin := newViewOrigin.
leftOffset := newLeftOffset.
self invalidateDeviceRectangle:inv repairNow:false.
self originChanged:delta.
self waitForExpose.
(wg := self windowGroup) notNil ifTrue:[
wg processRealExposeEventsFor:self.
].
"/ (hBefore ~= height or:[wBefore ~= width]) ifTrue:[
"/ self halt.
"/ ].
"Modified: / 11.8.1999 / 19:40:47 / cg"
! !
!ListView methodsFor:'searching'!
findBeginOfWordAtLine:selectLine col:selectCol
"return the col of first character of the word at given line/col.
If the character under the initial col is a space character, return
the first col of the blank-block."
|beginCol thisCharacter|
beginCol := selectCol.
thisCharacter := self characterAtLine:selectLine col:beginCol.
"is this acharacter within a word ?"
(wordCheck value:thisCharacter) ifTrue:[
[wordCheck value:thisCharacter] whileTrue:[
beginCol := beginCol - 1.
beginCol < 1 ifTrue:[
thisCharacter := Character space
] ifFalse:[
thisCharacter := self characterAtLine:selectLine col:beginCol
]
].
beginCol := beginCol + 1.
] ifFalse:[
"nope - maybe its a space"
thisCharacter == Character space ifTrue:[
[beginCol > 1 and:[thisCharacter == Character space]] whileTrue:[
beginCol := beginCol - 1.
thisCharacter := self characterAtLine:selectLine col:beginCol
].
thisCharacter ~~ Character space ifTrue:[
beginCol := beginCol + 1.
].
] ifFalse:[
"select single character"
]
].
^ beginCol
!
findEndOfWordAtLine:selectLine col:selectCol
"return the col of last character of the word at given line/col.
If the character under the initial col is a space character, return
the last col of the blank-block.
Return 0 if we should wrap to next line (for spaces)"
|endCol "{ Class: SmallInteger }"
len "{ Class: SmallInteger }"
thisCharacter|
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.
!
searchBackwardFor:pattern ignoreCase:ignCase 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
found firstChar1 firstChar2 c pc
col "{ Class: SmallInteger }"
cc "{ Class: SmallInteger }"
patternSize "{ Class: SmallInteger }"
line1 "{ Class: SmallInteger }"
lineSize "{ Class: SmallInteger }" |
patternSize := pattern size.
(list notNil and:[patternSize ~~ 0]) ifTrue:[
self withCursor:Cursor questionMark do:[
col := startCol - 1.
firstChar1 := pattern at:1.
ignCase ifTrue:[
firstChar1 := firstChar1 asLowercase.
firstChar2 := firstChar1 asUppercase.
] ifFalse:[
firstChar2 := firstChar1
].
col > (list at:startLine) size ifTrue:[
col := -999
].
line1 := startLine.
line1 to:1 by:-1 do:[:lnr |
lineString := list at:lnr.
lineString notNil ifTrue:[
lineSize := lineString size.
col == -999 ifTrue:[col := lineSize - patternSize + 1].
[(col > 0)
and:[(c := lineString at:col) ~= firstChar1
and:[c ~= firstChar2]]] whileTrue:[
col := col - 1
].
[col > 0] whileTrue:[
cc := col.
found := true.
1 to:patternSize do:[:cnr |
cc > lineSize ifTrue:[
found := false
] ifFalse:[
pc := pattern at:cnr.
c := lineString at:cc.
pc ~= c ifTrue:[
(ignCase not or:[pc asLowercase ~= c asLowercase]) ifTrue:[
found := false
]
]
].
cc := cc + 1
].
found ifTrue:[
^ block1 value:lnr value:col.
].
col := col - 1.
[(col > 0)
and:[(c := lineString at:col) ~= firstChar1
and:[c ~= firstChar2]]] whileTrue:[
col := col - 1
]
]
].
col := -999.
]
]
].
"not found"
^ block2 value
"Created: 13.9.1997 / 01:06:19 / cg"
"Modified: 5.10.1997 / 01:53:18 / cg"
!
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)"
^ self
searchBackwardFor:pattern
ignoreCase:false
startingAtLine:startLine col:startCol
ifFound:block1
ifAbsent:block2
"Modified: 13.9.1997 / 01:07:36 / cg"
!
searchForwardFor:pattern ignoreCase:ignCase 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."
|lineString col patternSize
line1 "{Class: SmallInteger}"
line2 "{Class: SmallInteger}"
p realPattern|
patternSize := pattern size.
(list notNil and:[patternSize ~~ 0]) ifTrue:[
self withCursor:Cursor questionMark do:[
col := startCol + 1.
line1 := startLine.
line2 := list size.
pattern includesUnescapedMatchCharacters ifTrue:[
p := pattern species new:0.
(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 ignoreCase:ignCase) ifTrue:[
"/ ok, there it is; look at which position
col := lineString
findMatchString:realPattern
startingAt:col
ignoreCase:ignCase
ifAbsent:0.
col ~~ 0 ifTrue:[
^ block1 value:lnr value:col.
]
].
].
col := 1
]
] ifFalse:[
p := pattern withoutMatchEscapes.
line1 to:line2 do:[:lnr |
lineString := list at:lnr.
lineString isString ifTrue:[
ignCase ifTrue:[
col := lineString
findMatchString:p
startingAt:col
ignoreCase:ignCase
ifAbsent:0.
] ifFalse:[
col := lineString
findString:p
startingAt:col
ifAbsent:0.
].
col ~~ 0 ifTrue:[
^ block1 value:lnr value:col.
]
].
col := 1
]
].
]
].
"not found"
^ block2 value
"Created: 13.9.1997 / 01:06:31 / cg"
"Modified: 13.9.1997 / 01:11:28 / cg"
!
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."
^ self
searchForwardFor:pattern
ignoreCase:false
startingAtLine:startLine col:startCol
ifFound:block1
ifAbsent:block2
"Modified: 13.9.1997 / 01:07:11 / cg"
! !
!ListView methodsFor:'tabulators'!
expandTabs
"go through whole text expanding tabs into spaces.
This is meant to be called for text being imported from a file.
Therefore, 8-col tabs are assumed - independent of any private tab setting."
|line newLine nLines "{ Class: SmallInteger }"|
includesNonStrings := false.
list notNil ifTrue:[
nLines := self size.
1 to:nLines do:[:index |
line := self at:index.
line notNil ifTrue:[
line isString ifTrue:[
newLine := line withTabsExpanded.
newLine ~~ line ifTrue:[
list at:index put:newLine
].
] ifFalse:[
includesNonStrings := true.
]
]
]
]
"Modified: 30.8.1995 / 19:06:37 / claus"
"Modified: 12.5.1996 / 12:48:03 / cg"
!
nextTabAfter:colNr
"return the next tab position after col"
^ self nextTabAfter:colNr in:tabPositions
!
nextTabAfter:colNr in:tabPositions
"return the next tab position after col.
The second arg, tabPositions is a collection of tabStops."
|col "{ Class: SmallInteger }"
tabIndex "{ Class: SmallInteger }"
thisTab "{ Class: SmallInteger }"
nTabs "{ Class: SmallInteger }" |
tabIndex := 1.
col := colNr.
thisTab := tabPositions at:tabIndex.
nTabs := tabPositions size.
[thisTab <= col] whileTrue:[
(tabIndex == nTabs) ifTrue:[^ thisTab].
tabIndex := tabIndex + 1.
thisTab := tabPositions at:tabIndex
].
^ thisTab
!
prevTabBefore:colNr
"return the prev tab position before col"
|col "{ Class: SmallInteger }"
tabIndex "{ Class: SmallInteger }"
thisTab "{ Class: SmallInteger }"
nTabs "{ Class: SmallInteger }" |
tabIndex := 1.
col := colNr.
thisTab := tabPositions at:tabIndex.
nTabs := tabPositions size.
[thisTab < col] whileTrue:[
(tabIndex == nTabs) ifTrue:[^ thisTab].
tabIndex := tabIndex + 1.
thisTab := tabPositions at:tabIndex
].
(tabIndex == 1) ifTrue:[
^ 1
].
^ tabPositions at:(tabIndex - 1)
!
setTab4
"set 4-character tab stops"
tabPositions := self class tab4Positions.
!
setTab8
"set 8-character tab stops"
tabPositions := self class tab8Positions.
!
withTabs:line
"Assuming an 8-character tab,
compress multiple leading spaces to tabs, return a new line string
or the original line, if no tabs where created.
good idea, to make this one a primitive, since its called
many times when a big text is saved to a file."
|newLine eightSpaces nTabs|
"
the code below is a hack, producing many garbage strings for lines
which compress multiple tabs ... needs rewrite: saving big files
stresses the garbage collector a bit ...
"
line isNil ifTrue:[^ line].
eightSpaces := ' '.
(line startsWith:eightSpaces) ifFalse:[^ line].
nTabs := 1.
newLine := line copyFrom:9.
[newLine startsWith:eightSpaces] whileTrue:[
newLine := newLine copyFrom:9.
nTabs := nTabs + 1.
].
^ (line species new:nTabs withAll:Character tab) asString , newLine.
"Modified: 23.2.1996 / 19:10:36 / cg"
!
withTabs:tabulatorTable expand:line
"expand tabs into spaces, return a new line string,
or original line, if no tabs are included.
good idea, to make this one a primitive, since it is called
many times if a big text is read from a file."
|tmpString nString nTabs
currentMax "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
nextTab "{ Class: SmallInteger }" |
"
the code below tries to avoid creating too much garbage;
therefore, the string is scanned first for the number of
tabs to get a rough idea of the final strings size.
(it could be done better, by computing the exact size
required here ...)
"
line isNil ifTrue:[^ line].
nTabs := line occurrencesOf:(Character tab).
nTabs == 0 ifTrue:[^ line].
currentMax := line size + (nTabs * 7).
tmpString := line species 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 := line species 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
"Modified: 23.2.1996 / 19:11:01 / cg"
!
withTabsExpanded:line
"expand tabs into spaces, return a new line string,
or original line, if no tabs are included.
good idea, to make this one a primitive"
^ self withTabs:tabPositions expand:line
! !
!ListView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.237 2000-08-30 13:11:24 stefan Exp $'
! !