diff -r 53cbfeaa9c9a -r 3ee5ea99d0e2 ETxtView.st --- a/ETxtView.st Sun Apr 30 15:40:03 1995 +0200 +++ b/ETxtView.st Wed May 03 02:30:14 1995 +0200 @@ -14,12 +14,12 @@ TextView subclass:#EditTextView instanceVariableNames:'cursorLine cursorVisibleLine cursorCol cursorShown - prevCursorState readOnly modified fixedSize exceptionBlock - errorMessage cursorFgColor cursorBgColor cursorType undoAction - typeOfSelection lastString lastReplacement lastAction replacing - showMatchingParenthesis hasKeyboardFocus' + prevCursorState readOnly modified fixedSize exceptionBlock + errorMessage cursorFgColor cursorBgColor cursorType undoAction + typeOfSelection lastString lastReplacement lastAction replacing + showMatchingParenthesis hasKeyboardFocus' classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor - DefaultCursorType' + DefaultCursorType' poolDictionaries:'' category:'Views-Text' ! @@ -28,7 +28,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.23 1995-03-18 05:14:09 claus Exp $ +$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.24 1995-05-03 00:29:07 claus Exp $ '! !EditTextView class methodsFor:'documentation'! @@ -49,7 +49,7 @@ version " -$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.23 1995-03-18 05:14:09 claus Exp $ +$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.24 1995-05-03 00:29:07 claus Exp $ " ! @@ -117,52 +117,55 @@ |line lineSize newLine drawCharacterOnly| readOnly ifTrue: [ - exceptionBlock value:errorMessage. - ^ self + exceptionBlock value:errorMessage. + ^ self ]. aCharacter == (Character cr) ifTrue:[ - self splitLine:lineNr before:colNr. - ^ self + self splitLine:lineNr before:colNr. + ^ self ]. drawCharacterOnly := false. self checkForExistingLine:lineNr. line := list at:lineNr. lineSize := line size. (aCharacter == Character space) ifTrue:[ - (colNr > lineSize) ifTrue:[ - ^ self - ] + (colNr > lineSize) ifTrue:[ + ^ self + ] ]. (lineSize == 0) ifTrue: [ - newLine := String new:colNr. - drawCharacterOnly := true + newLine := String new:colNr. + drawCharacterOnly := true ] ifFalse: [ - (colNr > lineSize) ifTrue: [ - newLine := String new:colNr. - newLine replaceFrom:1 to:lineSize - with:line startingAt:1. - drawCharacterOnly := true - ] ifFalse: [ - newLine := String new:(lineSize + 1). - newLine replaceFrom:1 to:(colNr - 1) - with:line startingAt:1. - newLine replaceFrom:(colNr + 1) to:(lineSize + 1) - with:line startingAt:colNr - ] + (colNr > lineSize) ifTrue: [ + newLine := String new:colNr. + newLine replaceFrom:1 to:lineSize + with:line startingAt:1. + drawCharacterOnly := true + ] ifFalse: [ + newLine := String new:(lineSize + 1). + newLine replaceFrom:1 to:(colNr - 1) + with:line startingAt:1. + newLine replaceFrom:(colNr + 1) to:(lineSize + 1) + with:line startingAt:colNr + ] ]. newLine at:colNr put:aCharacter. aCharacter == (Character tab) ifTrue:[ - newLine := self withTabsExpanded:newLine. - drawCharacterOnly := false + newLine := self withTabsExpanded:newLine. + drawCharacterOnly := false ]. list at:lineNr put:newLine. + widthOfWidestLine notNil ifTrue:[ + widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line). + ]. self textChanged. shown ifTrue:[ - drawCharacterOnly ifTrue:[ - self redrawLine:lineNr col:colNr - ] ifFalse:[ - self redrawLine:lineNr from:colNr - ] + drawCharacterOnly ifTrue:[ + self redrawLine:lineNr col:colNr + ] ifFalse:[ + self redrawLine:lineNr from:colNr + ] ] ! @@ -173,46 +176,48 @@ aString isNil ifTrue:[^ self]. readOnly ifTrue: [ - exceptionBlock value:errorMessage. - ^ self + exceptionBlock value:errorMessage. + ^ self ]. strLen := aString size. self checkForExistingLine:lineNr. line := list at:lineNr. line notNil ifTrue:[ - lineSize := line size + lineSize := line size ] ifFalse:[ - lineSize := 0 + lineSize := 0 ]. ((colNr == 1) and:[lineSize == 0]) ifTrue: [ - newLine := aString + newLine := aString ] ifFalse:[ - (lineSize == 0) ifTrue: [ - newLine := String new:(colNr + strLen - 1) - ] ifFalse: [ - (colNr > lineSize) ifTrue: [ - newLine := String new:(colNr + strLen - 1). - newLine replaceFrom:1 to:lineSize - with:line startingAt:1 - ] ifFalse: [ - newLine := String new:(lineSize + strLen). - newLine replaceFrom:1 to:(colNr - 1) - with:line startingAt:1. - newLine replaceFrom:(colNr + strLen) to:(lineSize + strLen) - with:line startingAt:colNr - ] - ]. - newLine replaceFrom:colNr to:(colNr + strLen - 1) - with:aString startingAt:1 + (lineSize == 0) ifTrue: [ + newLine := String new:(colNr + strLen - 1) + ] ifFalse: [ + (colNr > lineSize) ifTrue: [ + newLine := String new:(colNr + strLen - 1). + newLine replaceFrom:1 to:lineSize + with:line startingAt:1 + ] ifFalse: [ + newLine := String new:(lineSize + strLen). + newLine replaceFrom:1 to:(colNr - 1) + with:line startingAt:1. + newLine replaceFrom:(colNr + strLen) to:(lineSize + strLen) + with:line startingAt:colNr + ] + ]. + newLine replaceFrom:colNr to:(colNr + strLen - 1) + with:aString startingAt:1 ]. (aString occurrencesOf:(Character tab)) == 0 ifFalse:[ - newLine := self withTabsExpanded:newLine + newLine := self withTabsExpanded:newLine ]. list at:lineNr put:newLine. + widthOfWidestLine notNil ifTrue:[ + widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:newLine). + ]. self textChanged. - ! splitLine:lineNr before:colNr @@ -223,45 +228,46 @@ srcY "{ Class: SmallInteger }" | list isNil ifFalse:[ - lineNr > (list size) ifFalse:[ - (colNr == 1) ifTrue:[ - self insertLine:nil before:lineNr. - ^ self - ]. - line := list at:lineNr. - line isNil ifFalse:[ - lineSize := line size. - (colNr <= lineSize) ifTrue:[ - rightRest := line copyFrom:colNr to:lineSize. - (colNr > 1) ifTrue:[ - leftRest := line copyTo:(colNr - 1) - ] - ] ifFalse:[ - leftRest := line - ] - ]. - leftRest notNil ifTrue:[ - leftRest isBlank ifTrue:[leftRest := nil] - ]. - list at:lineNr put:leftRest. - self withoutRedrawInsertLine:rightRest before:(lineNr + 1). - - 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 - 1) * fontHeight). - self redrawLine:lineNr. - self redrawLine:(lineNr + 1). - self waitForExpose - ]. - self textChanged. - ] + lineNr > (list size) ifFalse:[ + (colNr == 1) ifTrue:[ + self insertLine:nil before:lineNr. + ^ self + ]. + line := list at:lineNr. + line isNil ifFalse:[ + lineSize := line size. + (colNr <= lineSize) ifTrue:[ + rightRest := line copyFrom:colNr to:lineSize. + (colNr > 1) ifTrue:[ + leftRest := line copyTo:(colNr - 1) + ] + ] ifFalse:[ + leftRest := line + ] + ]. + leftRest notNil ifTrue:[ + leftRest isBlank ifTrue:[leftRest := nil] + ]. + list at:lineNr put:leftRest. + self withoutRedrawInsertLine:rightRest before:(lineNr + 1). + + 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 - 1) * fontHeight). + self redrawLine:lineNr. + self redrawLine:(lineNr + 1). + self waitForExpose + ]. + widthOfWidestLine := nil. "/ unknown + self textChanged. + ] ] ! @@ -314,42 +320,45 @@ dstY "{ Class: SmallInteger }" | readOnly ifTrue:[ - ^ self + ^ self ]. visLine := self listLineToVisibleLine:lineNr. (shown not or:[visLine isNil]) ifTrue:[ - self withoutRedrawInsertLines:someText - from:start to:end - before:lineNr. - self textChanged. - ^ self - ]. - - nLines := end - start + 1. - ((visLine + nLines) >= nLinesShown) ifTrue:[ - self withoutRedrawInsertLines:someText - from:start to:end - before:lineNr. - self redrawFromVisibleLine:visLine to:nLinesShown + self withoutRedrawInsertLines:someText + from:start to:end + before:lineNr. ] ifFalse:[ - w := self widthForScrollBetween:(lineNr + nLines) - and:(firstLineShown + nLines + nLinesShown). - srcY := topMargin + ((visLine - 1) * fontHeight). - dstY := srcY + (nLines * fontHeight). - " - stupid: must catchExpose before inserting new - stuff - since catchExpose may perform redraws - " - self catchExpose. - self withoutRedrawInsertLines:someText - from:start to:end - before:lineNr. - self copyFrom:self x:textStartLeft y:srcY - toX:textStartLeft y:dstY - width:w - height:(height - dstY). - self redrawFromVisibleLine:visLine to:(visLine + nLines - 1). - self waitForExpose + nLines := end - start + 1. + ((visLine + nLines) >= nLinesShown) ifTrue:[ + self withoutRedrawInsertLines:someText + from:start to:end + before:lineNr. + self redrawFromVisibleLine:visLine to:nLinesShown + ] ifFalse:[ + w := self widthForScrollBetween:(lineNr + nLines) + and:(firstLineShown + nLines + nLinesShown). + srcY := topMargin + ((visLine - 1) * fontHeight). + dstY := srcY + (nLines * fontHeight). + " + stupid: must catchExpose before inserting new + stuff - since catchExpose may perform redraws + " + self catchExpose. + self withoutRedrawInsertLines:someText + from:start to:end + before:lineNr. + self copyFrom:self x:textStartLeft y:srcY + toX:textStartLeft y:dstY + width:w + height:(height - dstY). + self redrawFromVisibleLine:visLine to:(visLine + nLines - 1). + self waitForExpose + ]. + ]. + widthOfWidestLine notNil ifTrue:[ + someText do:[:line | + widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line). + ] ]. self textChanged. ! @@ -361,23 +370,23 @@ |line lineSize| readOnly ifTrue: [ - exceptionBlock value:errorMessage. - ^ self + exceptionBlock value:errorMessage. + ^ self ]. list isNil ifTrue:[^ self]. (startLine == endLine) ifTrue:[ - "delete chars within a line" - self deleteCharsAtLine:startLine fromCol:startCol toCol:endCol. - ^ self + "delete chars within a line" + self deleteCharsAtLine:startLine fromCol:startCol toCol:endCol. + ^ self ]. ((startCol == 1) and:[endCol == 0]) ifTrue:[ - "delete full lines only" - endLine > startLine ifTrue:[ - self deleteFromLine:startLine toLine:(endLine - 1) - ]. - ^ self + "delete full lines only" + endLine > startLine ifTrue:[ + self deleteFromLine:startLine toLine:(endLine - 1) + ]. + ^ self ]. "delete right rest of 1st line" @@ -385,25 +394,26 @@ "delete the inner lines ..." endLine > (startLine + 1) ifTrue:[ - self deleteFromLine:(startLine + 1) toLine:(endLine - 1) + self deleteFromLine:(startLine + 1) toLine:(endLine - 1) ]. (endCol ~~ 0) ifTrue:[ - "delete the left rest of the last line" - self deleteCharsAtLine:(startLine + 1) toCol:endCol. - - "must add blanks, if startCal lies behond end of startLine" - line := list at:startLine. - lineSize := line size. - (startCol > lineSize) ifTrue:[ - line isNil ifTrue:[ - line := String new:(startCol - 1) - ] ifFalse:[ - line := line , (String new:(startCol - 1 - lineSize)) - ]. - list at:startLine put:line. - self textChanged. - ] + "delete the left rest of the last line" + self deleteCharsAtLine:(startLine + 1) toCol:endCol. + + "must add blanks, if startCal lies behond end of startLine" + line := list at:startLine. + lineSize := line size. + (startCol > lineSize) ifTrue:[ + line isNil ifTrue:[ + line := String new:(startCol - 1) + ] ifFalse:[ + line := line , (String new:(startCol - 1 - lineSize)) + ]. + list at:startLine put:line. + widthOfWidestLine := nil. "/ i.e. unknown + self textChanged. + ] ]. "merge the left rest of 1st line with right rest of last line into one" @@ -564,47 +574,6 @@ list replaceFrom:lineNr to:(lineNr + nLines - 1) with:newLines startingAt:start. ! -deleteCharsAtLine:lineNr fromCol:startCol toCol:endCol - "delete characters from startCol to endCol in line lineNr" - - |line lineSize newLine| - - readOnly ifTrue: [ - exceptionBlock value:errorMessage. - ^ self - ]. - list isNil ifTrue: [^self]. - (list size < lineNr) ifTrue: [^ self]. - - line := list at:lineNr. - line isNil ifTrue: [^self]. - lineSize := line size. - (startCol > lineSize) ifTrue: [^ self]. - (endCol == 0) ifTrue:[^ self]. - (endCol < startCol) ifTrue:[^ self]. - (startCol == endCol) ifTrue:[ - self deleteCharAtLine:lineNr col:startCol. - ^ self - ]. - (endCol >= lineSize) ifTrue:[ - self deleteCharsAtLine:lineNr fromCol:startCol. - ^ self - ]. - (startCol <= 1) ifTrue:[ - self deleteCharsAtLine:lineNr toCol:endCol. - ^ self - ]. - newLine := (line copyTo:(startCol - 1)) - , (line copyFrom:(endCol + 1) to:lineSize). - - newLine isBlank ifTrue:[ - newLine := nil - ]. - list at:lineNr put:newLine. - self textChanged. - self redrawLine:lineNr -! - insertStringWithoutCRs:aString atLine:lineNr col:colNr "insert aString (which has no crs) at lineNr/colNr" @@ -662,22 +631,6 @@ ] ! -deleteFromLine:startLineNr toLine:endLineNr - "delete some lines" - - readOnly ifTrue: [ - exceptionBlock value:errorMessage. - ^ self - ]. - list isNil ifTrue:[^ self]. - list removeFromIndex:startLineNr toIndex:endLineNr. - self textChanged. - self redrawFromLine:startLineNr. - (firstLineShown >= list size) ifTrue:[ - self makeLineVisible:(list size) - ] -! - insertLine:aString before:lineNr "insert the line aString before line lineNr" @@ -686,19 +639,22 @@ visLine := self listLineToVisibleLine:lineNr. (shown not or:[visLine isNil]) ifTrue:[ - self withoutRedrawInsertLine:aString before:lineNr. + self withoutRedrawInsertLine:aString before:lineNr. ] ifFalse:[ - w := self widthForScrollBetween:lineNr - and:(firstLineShown + nLinesShown). - dstY := topMargin + ((visLine ) * fontHeight). - self catchExpose. - self withoutRedrawInsertLine:aString before:lineNr. - self copyFrom:self x:textStartLeft y:(dstY - fontHeight) - toX:textStartLeft y:dstY - width:w - height:((nLinesShown - visLine "- 1") * fontHeight). - self redrawVisibleLine:visLine. - self waitForExpose. + w := self widthForScrollBetween:lineNr + and:(firstLineShown + nLinesShown). + dstY := topMargin + ((visLine ) * fontHeight). + self catchExpose. + self withoutRedrawInsertLine:aString before:lineNr. + self copyFrom:self x:textStartLeft y:(dstY - fontHeight) + toX:textStartLeft y:dstY + width:w + height:((nLinesShown - visLine "- 1") * fontHeight). + self redrawVisibleLine:visLine. + self waitForExpose. + ]. + widthOfWidestLine notNil ifTrue:[ + widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:aString). ]. self textChanged. ! @@ -742,14 +698,56 @@ toLine:cursorLine col:(cursorCol - 1) ! +deleteCharsAtLine:lineNr fromCol:startCol toCol:endCol + "delete characters from startCol to endCol in line lineNr" + + |line lineSize newLine| + + readOnly ifTrue: [ + exceptionBlock value:errorMessage. + ^ self + ]. + list isNil ifTrue: [^self]. + (list size < lineNr) ifTrue: [^ self]. + + line := list at:lineNr. + line isNil ifTrue: [^self]. + lineSize := line size. + (startCol > lineSize) ifTrue: [^ self]. + (endCol == 0) ifTrue:[^ self]. + (endCol < startCol) ifTrue:[^ self]. + (startCol == endCol) ifTrue:[ + self deleteCharAtLine:lineNr col:startCol. + ^ self + ]. + (endCol >= lineSize) ifTrue:[ + self deleteCharsAtLine:lineNr fromCol:startCol. + ^ self + ]. + (startCol <= 1) ifTrue:[ + self deleteCharsAtLine:lineNr toCol:endCol. + ^ self + ]. + newLine := (line copyTo:(startCol - 1)) + , (line copyFrom:(endCol + 1) to:lineSize). + + newLine isBlank ifTrue:[ + newLine := nil + ]. + list at:lineNr put:newLine. + widthOfWidestLine := nil. "/ i.e. unknown + self textChanged. + self redrawLine:lineNr +! + deleteCharAtLine:lineNr col:colNr "delete single character at colNr in line lineNr" - |line lineSize newLine drawCharacterOnly| + |line lineSize newLine drawCharacterOnly wasLargest| readOnly ifTrue: [ - exceptionBlock value:errorMessage. - ^ self + exceptionBlock value:errorMessage. + ^ self ]. list isNil ifTrue: [^self]. (list size < lineNr) ifTrue: [^ self]. @@ -759,29 +757,34 @@ lineSize := line size. (colNr > lineSize) ifTrue: [^ self]. + wasLargest := (self widthOfLineString:line) == widthOfWidestLine. + drawCharacterOnly := false. (colNr == lineSize) ifTrue:[ - newLine := line copyTo:(lineSize - 1). - fontIsFixedWidth ifTrue:[ - drawCharacterOnly := true - ] + newLine := line copyTo:(lineSize - 1). + fontIsFixedWidth ifTrue:[ + drawCharacterOnly := true + ] ] ifFalse:[ - newLine := String new:(lineSize - 1). - newLine replaceFrom:1 to:(colNr - 1) - with:line startingAt:1. - newLine replaceFrom:colNr to:(lineSize - 1) - with:line startingAt:(colNr + 1) + newLine := String new:(lineSize - 1). + newLine replaceFrom:1 to:(colNr - 1) + with:line startingAt:1. + newLine replaceFrom:colNr to:(lineSize - 1) + with:line startingAt:(colNr + 1) ]. newLine isBlank ifTrue:[ - newLine := nil + newLine := nil ]. list at:lineNr put:newLine. + wasLargest ifTrue:[ + widthOfWidestLine := nil. "/ i.e. unknown + ]. self textChanged. drawCharacterOnly ifTrue:[ - self redrawLine:lineNr col:colNr + self redrawLine:lineNr col:colNr ] ifFalse:[ - self redrawLine:lineNr from:colNr + self redrawLine:lineNr from:colNr ] ! @@ -794,25 +797,25 @@ lastLine := list size. finished := false. [finished] whileFalse:[ - (lastLine <= 1) ifTrue:[ - finished := true - ] ifFalse:[ - line := list at:lastLine. - line notNil ifTrue:[ - line isBlank ifTrue:[ - list at:lastLine put:nil. - line := nil - ] - ]. - line notNil ifTrue:[ - finished := true - ] ifFalse:[ - lastLine := lastLine - 1 - ] - ] + (lastLine <= 1) ifTrue:[ + finished := true + ] ifFalse:[ + line := list at:lastLine. + line notNil ifTrue:[ + line isBlank ifTrue:[ + list at:lastLine put:nil. + line := nil + ] + ]. + line notNil ifTrue:[ + finished := true + ] ifFalse:[ + lastLine := lastLine - 1 + ] + ] ]. (lastLine ~~ list size) ifTrue:[ - list grow:lastLine. + list grow:lastLine. "/ self textChanged ] ! @@ -823,8 +826,8 @@ |line lineSize newLine| readOnly ifTrue: [ - exceptionBlock value:errorMessage. - ^ self + exceptionBlock value:errorMessage. + ^ self ]. list isNil ifTrue: [^self]. (list size < lineNr) ifTrue: [^ self]. @@ -832,14 +835,15 @@ line isNil ifTrue: [^self]. lineSize := line size. (colNr >= lineSize) ifTrue:[ - newLine := nil + newLine := nil ] ifFalse:[ - newLine := line copyFrom:(colNr + 1) to:lineSize. - newLine isBlank ifTrue:[ - newLine := nil - ] + newLine := line copyFrom:(colNr + 1) to:lineSize. + newLine isBlank ifTrue:[ + newLine := nil + ] ]. list at:lineNr put:newLine. + widthOfWidestLine := nil. "/ i.e. unknown self textChanged. self redrawLine:lineNr ! @@ -882,16 +886,34 @@ ] ! +deleteFromLine:startLineNr toLine:endLineNr + "delete some lines" + + readOnly ifTrue: [ + exceptionBlock value:errorMessage. + ^ self + ]. + list isNil ifTrue:[^ self]. + list removeFromIndex:startLineNr toIndex:endLineNr. + widthOfWidestLine := nil. "/ i.e. unknown + self textChanged. + self redrawFromLine:startLineNr. + (firstLineShown >= list size) ifTrue:[ + self makeLineVisible:(list size) + ] +! + deleteLineWithoutRedraw:lineNr "delete line - no redraw; return true, if something was really deleted" readOnly ifTrue:[ - exceptionBlock value:errorMessage. - ^ false + exceptionBlock value:errorMessage. + ^ false ]. (list isNil or:[lineNr > list size]) ifTrue:[^ false]. list removeIndex:lineNr. + widthOfWidestLine := nil. "/ i.e. unknown self textChanged. ^ true ! @@ -903,16 +925,17 @@ |lastLine| readOnly ifTrue:[ - exceptionBlock value:errorMessage. - ^ false + exceptionBlock value:errorMessage. + ^ false ]. (list isNil or:[startLine > list size]) ifTrue:[^ false]. (endLine > list size) ifTrue:[ - lastLine := list size + lastLine := list size ] ifFalse:[ - lastLine := endLine + lastLine := endLine ]. list removeFromIndex:startLine toIndex:lastLine. + widthOfWidestLine := nil. "/ i.e. unknown self textChanged. ^ true ! @@ -956,8 +979,8 @@ |line newLine| readOnly ifTrue: [ - exceptionBlock value:errorMessage. - ^ self + exceptionBlock value:errorMessage. + ^ self ]. list isNil ifTrue: [^self]. (list size < lineNr) ifTrue: [^ self]. @@ -966,9 +989,10 @@ (colNr > line size) ifTrue: [^ self]. newLine := line copyTo:(colNr - 1). newLine isBlank ifTrue:[ - newLine := nil + newLine := nil ]. list at:lineNr put:newLine. + widthOfWidestLine := nil. "/ i.e. unknown self textChanged. self redrawLine:lineNr ! @@ -2198,8 +2222,8 @@ leftStart := 0. lnr := start. [(leftStart == 0) and:[lnr ~~ 1]] whileTrue:[ - lnr := lnr - 1. - leftStart := self leftIndentOfLine:lnr + lnr := lnr - 1. + leftStart := self leftIndentOfLine:lnr ]. (leftStart == 0) ifTrue:[^ self]. @@ -2207,30 +2231,34 @@ delta := leftStart - (self leftIndentOfLine:start). (delta == 0) ifTrue:[^ self]. (delta > 0) ifTrue:[ - spaces := String new:delta + spaces := String new:delta ]. start to:end do:[:lineNr | - line := self listAt:lineNr. - line notNil ifTrue:[ - line isBlank ifTrue:[ - list at:lineNr put:nil - ] ifFalse:[ - (delta > 0) ifTrue:[ - line := spaces , line - ] ifFalse:[ - "check if deletion is ok" - d := delta negated + 1. - - line size > d ifTrue:[ - (line copyTo:(d - 1)) withoutSeparators isEmpty ifTrue:[ - line := line copyFrom:d - ] - ] - ]. - list at:lineNr put:line. - self textChanged. - ] - ] + line := self listAt:lineNr. + line notNil ifTrue:[ + line isBlank ifTrue:[ + list at:lineNr put:nil + ] ifFalse:[ + (delta > 0) ifTrue:[ + line := spaces , line. + widthOfWidestLine notNil ifTrue:[ + widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line). + ] + ] ifFalse:[ + "check if deletion is ok" + d := delta negated + 1. + + line size > d ifTrue:[ + (line copyTo:(d - 1)) withoutSeparators isEmpty ifTrue:[ + line := line copyFrom:d + ] + ]. + widthOfWidestLine := nil + ]. + list at:lineNr put:line. + self textChanged. + ] + ] ]. self redrawFromLine:start to:end ! ! @@ -2527,7 +2555,18 @@ searchFwd:pattern ifAbsent:aBlock "do a forward search" - self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock + |startCol| + + "/ if there is no selection and the cursor is at the origin, + "/ assume its the first search and do not skip the very first match + startCol := cursorCol. + self hasSelection ifFalse:[ + (cursorLine == 1 and:[cursorCol == 1]) ifTrue:[ + startCol := 0 + ] + ]. + + self searchFwd:pattern startingAtLine:cursorLine col:startCol ifAbsent:aBlock ! searchBwd:pattern ifAbsent:aBlock