hg/stx-libwidg: comparison ListView.st

equal deleted inserted replaced

-:8dd71a2e79cd
+:4b9b70b2cc87
 tabPositions lineSpacing
 fontHeight fontAscent
 fontIsFixedWidth fontWidth
 normalFont boldFont italicFont
 autoScrollBlock autoScrollDeltaT
-searchPattern'
+searchPattern wordCheck'
 classVariableNames:''
 poolDictionaries:''
 category:'Views-Text'
 !
 ListView comment:'
 COPYRIGHT (c) 1989 by Claus Gittinger
 All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.7 1994-01-13 00:17:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.8 1994-08-07 13:22:46 claus Exp $
-written spring 89 by claus
 '!
 !ListView class methodsFor:'documentation'!
+copyright
+"
+COPYRIGHT (c) 1989 by Claus Gittinger
+All Rights Reserved
+This software is furnished under a license and may be used
+only in accordance with the terms of that license and with the
+inclusion of the above copyright notice.   This software may not
+be provided or otherwise made available to, or used by, any
+other person.  No title to or ownership of the software is
+hereby transferred.
+"
+!
+version
+"
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.8 1994-08-07 13:22:46 claus Exp $
+"
+!
 documentation
 "
-a simple View for lists - the elements must understand printString
+a View for (string-)lists.
-the list is changed - the elements are replaced by their printStrings
-(if this leads to problems - I will change it later)
+This class can only passively display collections of strings-
+selections, editing, cursors etc. must be done in subclasses.
-This class can only passively display -
+see SelectionInListView, TextView etc.
-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 ...
-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.
-Instance variables:
+This is being totally rewritten ... so dont depend on the internals.
-list            <aCollection>           the text strings
-attributes      <aCollection>           corresponding attributes
-firstLineShown  <Number>                the index of the 1st visible line (1 ..)
+Instance variables:
-leftOffset      <Number>                left offset for horizontal scroll
-nFullLinesShown <Number>                the number of unclipped lines in visible
+list            <aCollection>           the text strings
-nLinesShown     <Number>                the number of lines in visible
+attributes      <aCollection>           corresponding attributes (if any)
-fgColor         <Color>                 color to draw characters
+firstLineShown  <Number>                the index of the 1st visible line (1 ..)
-bgColor         <Color>                 the background
+leftOffset      <Number>                left offset for horizontal scroll
-partialLines    <Boolean>               allow last line to be partial displayed
-leftMargin      <Number>                margin at left in pixels
+nFullLinesShown <Number>                the number of unclipped lines in visible
-topMargin       <Number>                margin at top in pixels
+nLinesShown     <Number>                the number of lines in visible
-textStartLeft   <Number>                margin + leftMargin
+fgColor         <Color>                 color to draw characters
-textStartTop    <Number>                margin + topMargin
+bgColor         <Color>                 the background
-innerWidth      <Number>                width - margins
+partialLines    <Boolean>               allow last line to be partial displayed
-tabPositions    <aCollection>           tab stops (cols)
+leftMargin      <Number>                margin at left in pixels
-fontHeight      <Number>                font height in pixels
+topMargin       <Number>                margin at top in pixels
-fontAscent      <Number>                font ascent in pixels
+textStartLeft   <Number>                margin + leftMargin
-fontIsFixed     <Boolean>               true if its a fixed font
+textStartTop    <Number>                margin + topMargin
-fontWidth       <Number>                width of space
+innerWidth      <Number>                width - margins
-lineSpacing     <Number>                pixels between lines
+tabPositions    <aCollection>           tab stops (cols)
-normalFont      <Font>                  font for normal characters
+fontHeight      <Number>                font height in pixels
-boldFont        <Font>                  font for bold characters
+fontAscent      <Number>                font ascent in pixels
-italicFont      <Font>                  font for italic characters
+fontIsFixed     <Boolean>               true if its a fixed font
-searchPattern   <String>                last pattern for searching
+fontWidth       <Number>                width of space
+lineSpacing     <Number>                pixels between lines
+normalFont      <Font>                  font for normal characters
+boldFont        <Font>                  font for bold characters
+italicFont      <Font>                  font for italic characters
+searchPattern   <String>                last pattern for searching
+wordCheck       <Block>                 rule used for check in word select
 "
 ! !
 !ListView class methodsFor:'defaults'!
 ! !
 !ListView methodsFor:'initialization'!
 initialize
+leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
 super initialize.
 bitGravity := #NorthWest.
 list := nil.
 firstLineShown := 1.
+nFullLinesShown := 1. "just any value ..."
+nLinesShown := 1.     "just any value"
 leftOffset := 0.
 partialLines := true.
 tabPositions := self class defaultTabPositions.
-leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
 topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
 textStartLeft := leftMargin + margin.
 textStartTop := topMargin + margin.
-innerWidth := width - textStartLeft - margin.
+innerWidth := width - textStartLeft - (margin * 2).
-self getFontParameters
+self getFontParameters.
+wordCheck := [:char | char isNationalAlphaNumeric]
 !
 initStyle
 super initStyle.
-fgColor := Black.
-bgColor := White.
+fgColor := resources at:'FOREGROUND_COLOR' default:Black.
+bgColor := resources at:'BACKGROUND_COLOR' default:White.
 lineSpacing := 0.
-!
+"Transcript class classResources at:'FOREGROUND_COLOR' put:Color red.
-initEvents
+Transcript class classResources at:'BACKGROUND_COLOR' put:Color white"
-self enableKeyEvents
 !
 create
 super create.
 !ListView methodsFor:'accessing'!
 backgroundColor:aColor
 "set the background color"
-bgColor := aColor.
+bgColor ~~ aColor ifTrue:[
-shown ifTrue:[
+bgColor := aColor.
-self redraw
+shown ifTrue:[
+self redraw
+]
 ]
 !
 foregroundColor:aColor
 "set the foreground color"
-fgColor := aColor.
+fgColor ~~ aColor ifTrue:[
-shown ifTrue:[
+fgColor := aColor.
-self redraw
+shown ifTrue:[
+self redraw
+]
 ]
 !
 foregroundColor:color1 backgroundColor:color2
 "set both foreground and background colors"
-fgColor := color1.
+((fgColor ~~ color1) or:[bgColor ~~ color2]) ifTrue:[
-bgColor := color2.
+fgColor := color1.
-shown ifTrue:[
+bgColor := color2.
-self redraw
+shown ifTrue:[
+self redraw
+]
 ]
 !
 partialLines:aBoolean
 "allow/disallow display of a last partial line"
 ^ leftMargin
 !
 setList:aCollection
-"set the contents (a collection of strings) keep position unchanged"
+"set the contents (a collection of strings);
+dont change position (i.e. do not scroll).
+This can be used to update a self-changing list
+(for example: a file list being shown, without disturbing user too much)"
 (aCollection isNil and:[list isNil]) ifTrue:[
 "no change"
 ^ self
 ].
 self redrawFromVisibleLine:1 to:nLinesShown
 ]
 !
 list:aCollection
-"set the contents (a collection of strings) and scroll to top"
+"set the contents (a collection of strings) and scroll to top-left"
-|oldFirst|
+|oldFirst oldLeft|
 (aCollection isNil and:[list isNil]) ifTrue:[
 "no change"
 self scrollToTop.
+self scrollToLeft.
 ^ self
 ].
 list := aCollection.
 list notNil ifTrue:[
 self expandTabs
 ].
-self contentsChanged.
-"dont use scroll here to avoid the redraw"
 oldFirst := firstLineShown.
+oldLeft := leftOffset.
 firstLineShown := 1.
-self originChanged:(oldFirst - 1) negated.
+leftOffset := 0.
-shown ifTrue:[
+realized ifTrue:[
-self redrawFromVisibleLine:1 to:nLinesShown
+self contentsChanged.
+"
+dont use scroll here to avoid the redraw
+"
+self originChanged:(oldFirst - 1) negated.
+shown ifTrue:[
+self redrawFromVisibleLine:1 to:nLinesShown
+]
 ]
 !
 list
 "return the contents as a collection of strings"
 ^ list
 !
 setContents:something
 "set the contents (either a string or a Collection of strings)
-dont change position"
+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)."
 something isNil ifTrue:[
 self setList:nil
 ] ifFalse:[
 self setList:(something asText)
 ]
 !
 contents:something
 "set the contents (either a string or a Collection of strings)
-also scroll to top"
+also scroll to top-left"
 something isNil ifTrue:[
 self list:nil
 ] ifFalse:[
 self list:(something asText)
 "delete line - no redraw;
 return true, if something was really deleted"
 (list isNil or:[lineNr > list size]) ifTrue:[^ false].
 list removeIndex:lineNr.
+(attributes notNil and:[lineNr <= attributes size]) ifTrue:[attributes removeIndex:lineNr].
 lineNr < firstLineShown ifTrue:[
 firstLineShown := firstLineShown - 1
 ].
 self contentsChanged.
 ^ true
 "delete line"
 |visLine w
 srcY "{ Class: SmallInteger }" |
-w := self widthForScrollBetween:lineNr
-and:(firstLineShown + nLinesShown).
 (self removeIndexWithoutRedraw:lineNr) ifFalse:[^ self].
+"
+is there a need to redraw ?
+"
 visLine := self listLineToVisibleLine:lineNr.
 visLine notNil ifTrue:[
+w := self widthForScrollBetween:lineNr and:(firstLineShown + nLinesShown).
 srcY := topMargin + (visLine * fontHeight).
 self catchExpose.
 self copyFrom:self x:textStartLeft y:srcY
 toX:textStartLeft y:(srcY - fontHeight)
 width:w height:((nLinesShown - visLine) * fontHeight).
 "set the font"
 aFont isNil ifTrue:[
 ^ self error:'nil font'
 ].
-super font:aFont.
+font ~~ aFont ifTrue:[
-(font device == device) ifTrue:[
+super font:aFont.
-self getFontParameters.
+realized ifTrue:[
-self computeNumberOfLinesShown.
+(font device == device) ifTrue:[
-shown ifTrue:[
+self getFontParameters.
-self redrawFromVisibleLine:1 to:nLinesShown
+self computeNumberOfLinesShown.
-]
+shown ifTrue:[
-].
+self redrawFromVisibleLine:1 to:nLinesShown
-self contentsChanged
+]
+].
+self contentsChanged
+]
+]
 !
 level:aNumber
 "set the level - cought here to update text-position variables
-(which avoid many computations later)"
+(which avoids many computations later)"
 super level:aNumber.
 textStartLeft := leftMargin + margin.
 textStartTop := topMargin + margin.
 ^ firstLineShown
 !
 lastLineShown
-"return the index of the last (possibly partial)
+"return the index of the last (possibly partial) visible line"
-visible line"
 ^ firstLineShown + nLinesShown
 !
 numberOfLines
 !
 lengthOfLongestLine
 "return the length (in characters) of the longest line"
-|max      "{ Class: SmallInteger }"
+^ self lengthOfLongestLineBetween:1 and:list size
-thisLen  "{ Class: SmallInteger }" |
-max := 0.
-list notNil ifTrue:[
-list do:[:lineString |
-lineString notNil ifTrue:[
-thisLen := lineString size.
-(thisLen > max) ifTrue:[
-max := thisLen
-]
-]
-]
-].
-^ max
 !
 lengthOfLongestLineBetween:firstLine and:lastLine
 "return the length (in characters) of the longest line in a line-range"
 |max      "{ Class: SmallInteger }"
 thisLen  "{ Class: SmallInteger }"
 listSize "{ Class: SmallInteger }"
 first    "{ Class: SmallInteger }"
 last     "{ Class: SmallInteger }" |
+list isNil ifTrue:[^ 0].
 listSize := list size.
 max := 0.
 first := firstLine.
 last := lastLine.
 - used for scrollbar interface"
 | numLines |
 numLines := self numberOfLines.
-^ numLines * fontHeight + textStartTop.
+numLines == 0 ifTrue:[^ 0].
+"
-"it used to be that code - which is wrong"
+need device-font for query
-(nLinesShown == nFullLinesShown) ifTrue:[
+"
-^ numLines * fontHeight
+font := font on:device.
-].
+^ numLines * fontHeight + textStartTop
-"add one - otherwise we cannot make last line
++ (font descent) "makes it look better".
-fully visible since scrolling is done by full lines only"
+"/                            + (font descent * 2) "makes it look better".
-^ (numLines + 1) * fontHeight
+"/    "it used to be that code - which is wrong"
+"/    (nLinesShown == nFullLinesShown) ifTrue:[
+"/        ^ numLines * fontHeight
+"/    ].
+"/    "add one - otherwise we cannot make last line
+"/     fully visible since scrolling is done by full lines only"
+"/
+"/    ^ (numLines + 1) * fontHeight
 !
 widthOfContents
-"return the width of the contents in pixels"
+"return the width of the contents in pixels
+- used for scrollbar interface"
 |max|
+list isNil ifTrue:[^ 0].
 fontIsFixedWidth ifTrue:[
-^ self lengthOfLongestLine * fontWidth
+max := self lengthOfLongestLine * fontWidth
-].
+] ifFalse:[
 max := 0.
 list notNil ifTrue:[
 max := max max:(font widthOf:list)
 ].
-^ max
+].
+^ max + (leftMargin * 2)
 !
 yOriginOfContents
 "return the vertical origin of the contents in pixels
 - used for scrollbar interface"
 xOriginOfContents
 "return the horizontal origin of the contents in pixels
 - used for scrollbar interface"
-^leftOffset
+^ leftOffset
 !
 leftIndentOfLine:lineNr
 "return the number of spaces at the left in line, lineNr.
 returns 0 for empty lines."
 ]
 ]
 !
 widthOfWidestLineBetween:firstLine and:lastLine
-"return the width in pixels of the widest line in a range"
+"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 }"
 ].
 ^ max
 !
 widthForScrollBetween:firstLine and:lastLine
-"return the width in pixels for a scroll between firstLine and lastLine"
+"return the width in pixels for a scroll between firstLine and lastLine.
+- used to optimize scrolling, by limiting the scrolled area.
+Subclasses with selections or other additional visible stuff should redefine
+this method."
 |w|
 "for small width, its not worth searching for
 longest line ..."
 (width < 300) ifTrue:[^ innerWidth].
-w := self widthOfWidestLineBetween:firstLine
+"for large lists, search is longer than scrolling full"
-and:lastLine.
+list size > 2000 ifTrue:[^ innerWidth].
+w := self widthOfWidestLineBetween:firstLine and:lastLine.
 (w > innerWidth) ifTrue:[^ innerWidth].
 ^ w
 !
 listAt:lineNr
 |line|
 line := self listAt:lineNr.
 line isNil ifTrue:[^ nil].
 (startCol > line size) ifTrue:[^ nil].
-^ line copyFrom:startCol to:(line size)
+^ line copyFrom:startCol
 !
 listAt:lineNr to:endCol
 "return left substring from start to endCol of a line"
 line := self listAt:lineNr.
 line isNil ifTrue:[^ nil].
 stop := endCol.
 (stop > line size) ifTrue:[stop := line size].
-^ line copyFrom:1 to:stop
+^ line copyTo:stop
 !
 listLineToVisibleLine:listLineNr
 "given a list line (1..) return visible linenr or nil"
 colOfX:x inVisibleLine:visLineNr
 "given a visible lineNr and x-coordinate, return colNr"
 |lineString linePixelWidth xRel runCol posLeft posRight done|
-xRel := x - textStartLeft.
+xRel := x - textStartLeft + leftOffset.
 fontIsFixedWidth ifTrue:[
 ^ (xRel // fontWidth) + 1
 ].
 lineString := self visibleAt:visLineNr.
 lineString notNil ifTrue:[
 ! !
 !ListView methodsFor:'tabulators'!
 setTab4
+"set 4-character tab stops"
 tabPositions := self class tab4Positions.
 !
 setTab8
+"set 8-character tab stops"
 tabPositions := self class tab8Positions.
 !
 expandTabs
 "go through whole text expanding tabs into spaces"
 list notNil ifTrue:[
 nLines := list size.
 1 to:nLines do:[:index |
 line := list at:index.
 line notNil ifTrue:[
-(line class == String) ifFalse:[
+line isString ifFalse:[
 newLine := line printString
 ] ifTrue:[
 newLine := line
 ].
 (newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
 ].
 ^ tabPositions at:(tabIndex - 1)
 !
 withTabsExpanded:line
-"good idea, to make this one a primitive"
+"expand tabs into spaces, return a new line string,
+or original line, if no tabs are included.
-|tmpString nString
+good idea, to make this one a primitive"
+|tmpString nString nTabs
 currentMax "{ Class: SmallInteger }"
 dstIndex   "{ Class: SmallInteger }"
 nextTab    "{ Class: SmallInteger }" |
+line isNil ifTrue:[^ line].
+nTabs := line occurrencesOf:(Character tab).
+nTabs == 0 ifTrue:[^ line].
 currentMax := 200.
 tmpString := String new:currentMax.
 dstIndex := 1.
 line do:[:character |
 "make stc-optimizer happy
 - no need to return value of ifTrue:/ifFalse above"
 0
 ].
-^ tmpString copyFrom:1 to:(dstIndex - 1)
+^ tmpString copyTo:(dstIndex - 1)
+!
+withTabs:line
+"Assuming an 8-character tab,
+compress multiple spaces to tabs, return a new line string
+or original line, if no tabs where created.
+good idea, to make this one a primitive"
+|newLine|
+line isNil ifTrue:[^ line].
+(line startsWith:'        ') ifFalse:[^ line].
+newLine := line copyFrom:9.
+[newLine startsWith:'        '] whileTrue:[
+newLine := Character tab asString , (newLine copyFrom:9)
+].
+^ newLine
 ! !
 !ListView methodsFor:'searching'!
 setSearchPattern:aString
 searchPattern := aString withoutSeparators
 !
 searchForwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 else:block2
 "search for a pattern, if found evaluate block1 with row/col as arguments, if not
-found evaluate block2"
+found evaluate block2.
+Sorry, but pattern is no regular expression pattern (yet)"
 |lineString col savedCursor patternSize|
 patternSize := pattern size.
 patternSize ~~ 0 ifTrue:[
 ^ block2 value
 !
 searchBackwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 else:block2
 "search for a pattern, if found evaluate block1 with row/col as arguments, if not
-found evaluate block2"
+found evaluate block2.
+Sorry, but pattern is no regular expression pattern (yet)"
 |lineString col cc found firstChar savedCursor patternSize|
 patternSize := pattern size.
 patternSize ~~ 0 ifTrue:[
 ].
 "not found"
 self cursor:savedCursor.
 ^ block2 value
+!
+findBeginOfWordAtLine:selectLine col:selectCol
+"return the col of first character of the word at given line/col.
+If the character under the initial col is a space character, return
+the first col of the blank-block."
+|beginCol thisCharacter|
+beginCol := selectCol.
+thisCharacter := self characterAtLine:selectLine col:beginCol.
+"is this acharacter within a word ?"
+(wordCheck value:thisCharacter) ifTrue:[
+[wordCheck value:thisCharacter] whileTrue:[
+beginCol := beginCol - 1.
+beginCol < 1 ifTrue:[
+thisCharacter := Character space
+] ifFalse:[
+thisCharacter := self characterAtLine:selectLine col:beginCol
+]
+].
+beginCol := beginCol + 1.
+] ifFalse:[
+"nope - maybe its a space"
+thisCharacter == Character space ifTrue:[
+[beginCol > 1 and:[thisCharacter == Character space]] whileTrue:[
+beginCol := beginCol - 1.
+thisCharacter := self characterAtLine:selectLine col:beginCol
+].
+thisCharacter ~~ Character space ifTrue:[
+beginCol := beginCol + 1.
+].
+] ifFalse:[
+"select single character"
+]
+].
+^ beginCol
+!
+findEndOfWordAtLine:selectLine col:selectCol
+"return the col of last character of the word at given line/col.
+If the character under the initial col is a space character, return
+the last col of the blank-block.
+Return 0 if we should wrap to next line (for spaces)"
+|endCol thisCharacter len|
+endCol := selectCol.
+endCol == 0 ifTrue:[endCol := 1].
+thisCharacter := self characterAtLine:selectLine col:endCol.
+"is this acharacter within a word ?"
+(wordCheck value:thisCharacter) ifTrue:[
+thisCharacter := self characterAtLine:selectLine col:endCol.
+[wordCheck value:thisCharacter] whileTrue:[
+endCol := endCol + 1.
+thisCharacter := self characterAtLine:selectLine col:endCol
+].
+endCol := endCol - 1.
+] ifFalse:[
+"nope - maybe its a space"
+thisCharacter == Character space ifTrue:[
+len := (self listAt:selectLine) size.
+endCol > len ifTrue:[
+"select rest to end"
+endCol := 0
+] ifFalse:[
+thisCharacter := self characterAtLine:selectLine col:endCol.
+[endCol <= len and:[thisCharacter == Character space]] whileTrue:[
+endCol := endCol + 1.
+thisCharacter := self characterAtLine:selectLine col:endCol
+].
+endCol := endCol - 1.
+]
+] ifFalse:[
+"select single character"
+]
+].
+^ endCol.
 ! !
 !ListView methodsFor:'scrolling'!
 gotoLine:aLineNumber
 !
 pageDown
 "change origin to display next page"
+|nLines|
+nLines := nFullLinesShown.
+(firstLineShown + nLines + nFullLinesShown > list size) ifTrue:[
+nLines := list size - firstLineShown - nFullLinesShown + 1
+].
+nLines <= 0 ifTrue:[^ self].
 self originWillChange.
-firstLineShown := firstLineShown + nFullLinesShown.
+firstLineShown := firstLineShown + nLines.
-self originChanged:nFullLinesShown.
+self originChanged:nLines.
 self redrawFromVisibleLine:1 to:nLinesShown
 !
 pageUp
 "change origin to display previous page"
 halfPageUp
 "scroll up half a page"
 self scrollUp:(nFullLinesShown // 2)
+!
+makeLineVisible:aListLineNr
+"if aListLineNr is not visible, scroll to make it visible.
+Numbering starts with 1 for the very first line of the text."
+|bott|
+(aListLineNr isNil "or:[shown not]") ifTrue:[^ self].
+(aListLineNr >= firstLineShown) ifTrue:[
+(aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
+^ self
+]
+].
+(aListLineNr < nFullLinesShown) ifTrue:[
+^ self scrollToLine:1
+].
+(nFullLinesShown < 3) ifTrue:[
+^ self scrollToLine:aListLineNr
+].
+bott := self numberOfLines - (nFullLinesShown - 1).
+(aListLineNr > bott) ifTrue:[
+^ self scrollToLine:bott
+].
+self scrollToLine:(aListLineNr - (nFullLinesShown // 2) + 1)
+!
+makeColVisible:aCol inLine:aLineNr
+"if column aCol is not visible, scroll horizontal to make it visible"
+|xWant xVis visLnr oldLeft|
+(aCol isNil or:[shown not]) ifTrue:[^ self].
+visLnr := self absoluteLineToVisibleLine:aLineNr.
+visLnr isNil ifTrue:[^ self].
+xWant := self xOfCol:aCol inLine:visLnr.
+"
+dont scroll, if already visible
+(but scroll, if not in inner 20%..80% of visible area)
+"
+xVis := xWant - leftOffset.
+((xVis >= (width // 5)) and:[xVis <= (width * 4 // 5)]) ifTrue:[
+^ self
+].
+oldLeft := leftOffset.
+self scrollHorizontalTo:(xWant - (width // 2)).
+self originChanged:((oldLeft - leftOffset) @ 0)
 !
 scrollDown:nLines
 "change origin to scroll down some lines"
 "change origin to start of text"
 self scrollToLine:1
 !
+scrollToBottom
+"change origin to show end of text"
+"scrolling to the end is not really correct (i.e. should scroll to list size - nFullLinesShown),
+but scrollDown: will adjust it ..."
+self scrollToLine:(list size)
+!
 scrollToLine:aLineNr
 "change origin to make aLineNr be the top line"
 aLineNr < firstLineShown ifTrue:[
 self scrollUp:(firstLineShown - aLineNr)
 self scrollDown:(aLineNr - firstLineShown)
 ]
 ]
 !
+scrollToLeft
+"change origin to start (left) of text"
+leftOffset ~~ 0 ifTrue:[
+self scrollToCol:1
+]
+!
+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)
+]
+]
+!
 scrollVerticalToPercent:percent
 "scroll to a position given in percent of total"
 |lineNr|
 lineNr := (((self numberOfLines * percent) asFloat / 100.0) + 0.5) asInteger + 1.
 self scrollToLine:lineNr
-!
-makeLineVisible:aListLineNr
-"if aListLineNr is not visible, scroll to make it visible"
-|bott|
-(aListLineNr isNil or:[shown not]) ifTrue:[^ self].
-(aListLineNr >= firstLineShown) ifTrue:[
-(aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
-^ self
-]
-].
-(aListLineNr < nFullLinesShown) ifTrue:[
-^ self scrollToLine:1
-].
-(nFullLinesShown < 3) ifTrue:[
-^ self scrollToLine:aListLineNr
-].
-bott := self numberOfLines - (nFullLinesShown - 1).
-(aListLineNr > bott) ifTrue:[
-^ self scrollToLine:bott
-].
-self scrollToLine:(aListLineNr - (nFullLinesShown // 2) + 1)
 !
 scrollSelectUp
 "just a template - I do not know anything about selections"
 (deltaT = autoScrollDeltaT) ifFalse:[
 autoScrollDeltaT := deltaT.
 autoScrollBlock isNil ifTrue:[
 autoScrollBlock := [self scrollSelectDown].
-Processor addTimedBlock:autoScrollBlock after:deltaT
+Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
 ]
 ]
 !
 startScrollUp:yDistance
 (deltaT = autoScrollDeltaT) ifFalse:[
 autoScrollDeltaT := deltaT.
 autoScrollBlock isNil ifTrue:[
 autoScrollBlock := [self scrollSelectUp].
-Processor addTimedBlock:autoScrollBlock after:deltaT
+Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
 ]
 ]
 !
 stopAutoScroll
 self compressMotionEvents:true.
 Processor removeTimedBlock:autoScrollBlock.
 autoScrollBlock := nil.
 autoScrollDeltaT := nil
 ].
+!
+scrollRight
+"scroll right by one character
+- question is how much is a good for variable fonts"
+self scrollRight:font width
+!
+scrollRight:nPixel
+"change origin to scroll right some cols"
+|wMax cnt|
+cnt := nPixel.
+"
+commenting out the block below allows scrolling to the right of
+the widest line
+"
+" "
+"
+the 10 below allows scrolling somewhat behind the end of the line
+"
+wMax := self widthOfContents + 10.
+(leftOffset + nPixel + width > wMax) ifTrue:[
+cnt := wMax - leftOffset - width
+].
+cnt <= 0 ifTrue:[^ self].
+" "
+self originWillChange.
+leftOffset:= leftOffset + cnt.
+self redrawFromVisibleLine:1 to:nLinesShown.
+self originChanged:(cnt @ 0)
+!
+scrollLeft
+"scroll left by one character
+- question is how much is a good for variable fonts"
+self scrollLeft:font width
+!
+scrollLeft:nPixel
+"change origin to scroll left some cols"
+|newLeftOffset|
+nPixel <= 0 ifTrue:[^ self].
+newLeftOffset := leftOffset - nPixel.
+newLeftOffset <= 0 ifTrue:[
+leftOffset == 0 ifTrue:[^ self].
+newLeftOffset := 0
+].
+self originWillChange.
+leftOffset := newLeftOffset.
+self redrawFromVisibleLine:1 to:nLinesShown.
+self originChanged:(0 @ nPixel)
+!
+scrollHorizontalTo:aPixelOffset
+"change origin to make aPixelOffset be the left col"
+|orgX|
+orgX := leftOffset.
+(aPixelOffset < orgX) ifTrue:[
+self scrollLeft:(orgX - aPixelOffset)
+] ifFalse:[
+(aPixelOffset > orgX) ifTrue:[
+self scrollRight:(aPixelOffset - orgX)
+]
+]
 ! !
 !ListView methodsFor:'drawing'!
 drawVisibleLine:visLineNr col:col with:fg and:bg
 y := self yOfLine:startVisLineNr.
 self paint:bg.
 self fillRectangleX:margin y:y
 width:(width - (margin * 2))
 height:(endVisLineNr - startVisLineNr + 1) * fontHeight.
+list isNil ifTrue:[^ self].
 y := y + fontAscent.
 listSize := list size.
 startLine := startVisLineNr + firstLineShown - 1.
 "start/end col has to be computed for each line"
 startLine to:stopLine do:[:i |
 startCol := self colOfX:x inVisibleLine:i.
 endCol := self colOfX:(x + w) inVisibleLine:i.
-self redrawVisibleLine:i from:startCol to:endCol
+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.
-startLine to:stopLine do:[:i |
+startCol > 0 ifTrue:[
-self redrawVisibleLine:i from:startCol to:endCol
+endCol > 0 ifTrue:[
+startLine to:stopLine do:[:i |
+self redrawVisibleLine:i from:startCol to:endCol
+]
+]
 ]
 ]
 ]
 !

changeset 38	4b9b70b2cc87
parent 24	966098a893f8
child 51	e895ac4cc7c8