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