--- a/ETxtView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/ETxtView.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,29 +10,25 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:12:00 am'!
+
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'
- classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
- DefaultCursorType'
- poolDictionaries:''
- category:'Views-Text'
+ instanceVariableNames:'cursorLine cursorVisibleLine cursorCol cursorShown
+ prevCursorState readOnly modified fixedSize exceptionBlock
+ errorMessage cursorFgColor cursorBgColor cursorType undoAction
+ typeOfSelection lastString lastReplacement lastAction replacing
+ showMatchingParenthesis hasKeyboardFocus'
+ classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
+ DefaultCursorType'
+ poolDictionaries:''
+ category:'Views-Text'
!
EditTextView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.22 1995-03-06 19:28:18 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.23 1995-03-18 05:14:09 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -53,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.22 1995-03-06 19:28:18 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.23 1995-03-18 05:14:09 claus Exp $
"
!
@@ -101,8 +97,1621 @@
DefaultCursorType := StyleSheet at:'textCursorType' default:#block.
! !
+!EditTextView methodsFor:'private'!
+
+textChanged
+ "triggered whenever text has been edited (not to confuse with
+ contentsChanged, which is triggered when the size has changed, and
+ is used to notify scrollers, other views etc.)"
+
+ super contentsChanged.
+ modified := true.
+ contentsWasSaved := false
+! !
+
+!EditTextView methodsFor:'editing'!
+
+insert:aCharacter atLine:lineNr col:colNr
+ "insert a single character at lineNr/colNr"
+
+ |line lineSize newLine drawCharacterOnly|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ aCharacter == (Character cr) ifTrue:[
+ 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
+ ]
+ ].
+ (lineSize == 0) ifTrue: [
+ 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
+ ]
+ ].
+ newLine at:colNr put:aCharacter.
+ aCharacter == (Character tab) ifTrue:[
+ newLine := self withTabsExpanded:newLine.
+ drawCharacterOnly := false
+ ].
+ list at:lineNr put:newLine.
+ self textChanged.
+ shown ifTrue:[
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
+ ]
+!
+
+withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr
+ "insert aString (which has no crs) at lineNr/colNr"
+
+ |strLen line lineSize newLine|
+
+ aString isNil ifTrue:[^ self].
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ strLen := aString size.
+ self checkForExistingLine:lineNr.
+ line := list at:lineNr.
+ line notNil ifTrue:[
+ lineSize := line size
+ ] ifFalse:[
+ lineSize := 0
+ ].
+ ((colNr == 1) and:[lineSize == 0]) ifTrue: [
+ 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
+ ].
+
+ (aString occurrencesOf:(Character tab)) == 0 ifFalse:[
+ newLine := self withTabsExpanded:newLine
+ ].
+
+ list at:lineNr put:newLine.
+ self textChanged.
+
+!
+
+splitLine:lineNr before:colNr
+ "split the line linNr before colNr; the right part (from colNr)
+ is cut off and inserted after lineNr; the view is redrawn"
+
+ |line lineSize leftRest rightRest visLine w
+ 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.
+ ]
+ ]
+!
+
+withoutRedrawInsertLine:aString before:lineNr
+ "insert the argument, aString before line lineNr; the string
+ becomes line nileNr; everything else is moved down; the view
+ is not redrawn"
+
+ |line|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ line := aString.
+ line notNil ifTrue:[
+ line isBlank ifTrue:[
+ line := nil
+ ] ifFalse:[
+ (line occurrencesOf:(Character tab)) == 0 ifFalse:[
+ line := self withTabsExpanded:line
+ ]
+ ]
+ ].
+ list isNil ifTrue: [
+ list := StringCollection new:lineNr
+ ] ifFalse: [
+ list grow:((list size + 1) max:lineNr)
+ ].
+
+ "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
+ overlapping copy - if it didn't, we had to use:"
+"
+ index := list size.
+ [index > lineNr] whileTrue: [
+ pIndex := index - 1.
+ list at:index put:(list at:pIndex).
+ index := pIndex
+ ].
+"
+ list replaceFrom:(lineNr + 1) to:(list size) with:list startingAt:lineNr.
+ list at:lineNr put:line.
+!
+
+insertLines:someText from:start to:end before:lineNr
+ "insert a bunch of lines before line lineNr"
+
+ |visLine w nLines "{ Class: SmallInteger }"
+ srcY "{ Class: SmallInteger }"
+ dstY "{ Class: SmallInteger }" |
+
+ readOnly ifTrue:[
+ ^ 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
+ ] 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
+ ].
+ self textChanged.
+!
+
+deleteFromLine:startLine col:startCol toLine:endLine col:endCol
+ "delete all text from startLine/startCol to endLine/endCol -
+ joining lines if nescessary"
+
+ |line lineSize|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ list isNil ifTrue:[^ self].
+
+ (startLine == endLine) ifTrue:[
+ "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 right rest of 1st line"
+ self deleteCharsAtLine:startLine fromCol:startCol.
+
+ "delete the inner lines ..."
+ endLine > (startLine + 1) ifTrue:[
+ 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.
+ ]
+ ].
+
+ "merge the left rest of 1st line with right rest of last line into one"
+ self mergeLine:startLine
+!
+
+insertStringAtCursor:aString
+ "insert the argument, aString at cursor position
+ handle cr's correctly. A nil argument is interpreted as an empty line."
+
+ |start " { Class: SmallInteger }"
+ stop " { Class: SmallInteger }"
+ end " { Class: SmallInteger }"
+ subString|
+
+ aString isNil ifTrue:[
+ "new:"
+ self insertCharAtCursor:(Character cr).
+ ^ self
+ ].
+ ((aString occurrencesOf:(Character cr)) == 0) ifTrue:[
+ ^ self insertStringWithoutCRsAtCursor:aString
+ ].
+
+ self insertLines:aString asStringCollection withCr:false.
+
+"/ start := 1.
+"/ end := aString size.
+"/ "insert the 1st line"
+"/ (cursorCol ~~ 1) ifTrue:[
+"/ stop := aString indexOf:(Character cr) startingAt:start.
+"/ stop == 0 ifTrue:[
+"/ stop := end + 1
+"/ ].
+"/ subString := aString copyFrom:start to:(stop - 1).
+"/ self insertStringWithoutCRsAtCursor:subString.
+"/ self insertCharAtCursor:(Character cr).
+"/ start := stop + 1
+"/ ].
+"/ "insert the block of full lines"
+"/
+"/ [start <= end] whileTrue:[
+"/ stop := aString indexOf:(Character cr) startingAt:start.
+"/ stop == 0 ifTrue:[
+"/ stop := end + 1
+"/ ].
+"/ subString := aString copyFrom:start to:(stop - 1).
+"/ self insertStringWithoutCRsAtCursor:subString.
+"/ (stop < end) ifTrue:[
+"/ self insertCharAtCursor:(Character cr)
+"/ ].
+"/ start := stop + 1
+"/ ]
+!
+
+insertLines:lines withCr:withCr
+ "insert a bunch of lines at cursor position. Cursor
+ is moved behind insertion.
+ If withCr is true, append cr after last line"
+
+ |start end nLines|
+
+ lines notNil ifTrue:[
+ nLines := lines size.
+ (nLines == 1) ifTrue:[
+ self insertStringAtCursor:(lines at:1).
+ withCr ifTrue:[
+ self insertCharAtCursor:(Character cr)
+ ]
+ ] ifFalse:[
+ (cursorCol ~~ 1) ifTrue:[
+ self insertStringAtCursor:(lines at:1).
+ self insertCharAtCursor:(Character cr).
+ start := 2
+ ] ifFalse:[
+ start := 1
+ ].
+ withCr ifTrue:[
+ end := nLines
+ ] ifFalse:[
+ end := nLines - 1
+ ].
+ (start < nLines) ifTrue:[
+ (end >= start) ifTrue:[
+ self withCursorOffDo:[
+ self insertLines:lines
+ from:start to:end
+ before:cursorLine.
+ cursorLine := cursorLine + (end - start + 1).
+ cursorVisibleLine := self absoluteLineToVisibleLine:
+ cursorLine
+ ]
+ ]
+ ].
+ withCr ifFalse:[
+ "last line without cr"
+ self insertStringAtCursor:(lines at:nLines)
+ ]
+ ]
+ ]
+!
+
+insertStringWithoutCRsAtCursor:aString
+ "insert a string (which has no crs) at cursor position
+ - advance cursor"
+
+ aString notNil ifTrue:[
+ self withCursorOffDo:[
+ self insertString:aString atLine:cursorLine col:cursorCol.
+ cursorCol := cursorCol + aString size
+ ]
+ ]
+!
+
+withoutRedrawInsertLines:lines from:start to:end before:lineNr
+ "insert a bunch of lines before line lineNr; the view
+ is not redrawn"
+
+ |newLine newLines nLines|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+
+ nLines := end - start + 1.
+ newLines := Array new:(lines size).
+ start to:end do:[:index |
+ newLine := lines at:index.
+ newLine notNil ifTrue:[
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ] ifFalse:[
+ (newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
+ newLine := self withTabsExpanded:newLine
+ ]
+ ]
+ ].
+ newLines at:index put:newLine
+ ].
+ list isNil ifTrue: [
+ list := StringCollection new:(lineNr + nLines + 1)
+ ] ifFalse: [
+ list grow:((list size + nLines) max:(lineNr + nLines - 1))
+ ].
+
+ "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
+ overlapping copy - if it didn't, we had to use:"
+"
+ index := list size.
+ [index > lineNr] whileTrue: [
+ pIndex := index - 1.
+ list at:index put:(list at:pIndex).
+ index := pIndex
+ ].
+"
+ list replaceFrom:(lineNr + nLines) to:(list size) with:list startingAt:lineNr.
+ 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"
+
+ self withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
+ shown ifTrue:[self redrawLine:lineNr from:colNr]
+!
+
+insertString:aString atLine:lineNr col:colNr
+ "insert the string, aString at line/col;
+ handle cr's correctly"
+
+ |start "{ Class: SmallInteger }"
+ stop "{ Class: SmallInteger }"
+ end "{ Class: SmallInteger }"
+ subString c
+ l "{ Class: SmallInteger }" |
+
+
+ aString isNil ifTrue:[^ self].
+ ((aString occurrencesOf:(Character cr)) == 0) ifTrue:[
+ ^ self insertStringWithoutCRs:aString atLine:lineNr col:colNr
+ ].
+ l := lineNr.
+ c := colNr.
+ start := 1.
+ end := aString size.
+ [start <= end] whileTrue:[
+ stop := aString indexOf:(Character cr) startingAt:start.
+ stop == 0 ifTrue:[
+ stop := end + 1
+ ].
+ subString := aString copyFrom:start to:(stop - 1).
+ self insertStringWithoutCRs:subString atLine:l col:c.
+ (stop < end) ifTrue:[
+ c := c + subString size.
+ self insert:(Character cr) atLine:l col:c.
+ l := l + 1.
+ c := 1
+ ].
+ start := stop + 1
+ ]
+!
+
+insertCharAtCursor:aCharacter
+ "insert a single character at cursor-position - advance cursor"
+
+ self withCursorOffDo:[
+ self insert:aCharacter atLine:cursorLine col:cursorCol.
+ aCharacter == (Character cr) ifTrue:[
+ self cursorReturn
+ ] ifFalse:[
+ cursorCol := cursorCol + 1
+ ].
+ self makeCursorVisible
+ ]
+!
+
+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"
+
+ |visLine w
+ dstY "{ Class: SmallInteger }" |
+
+ visLine := self listLineToVisibleLine:lineNr.
+ (shown not or:[visLine isNil]) ifTrue:[
+ 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.
+ ].
+ self textChanged.
+!
+
+mergeLine:lineNr
+ "merge line lineNr with line lineNr+1"
+
+ |leftPart rightPart bothParts nextLineNr|
+
+ list isNil ifFalse:[
+ nextLineNr := lineNr + 1.
+ (nextLineNr > list size) ifFalse:[
+ (list at:lineNr) isNil ifTrue:[
+ leftPart := ''
+ ] ifFalse:[
+ leftPart := list at:lineNr
+ ].
+ (list at:nextLineNr) isNil ifTrue:[
+ rightPart := ''
+ ] ifFalse:[
+ rightPart := list at:nextLineNr
+ ].
+ bothParts := leftPart , rightPart.
+ bothParts isBlank ifTrue:[bothParts := nil].
+ list at:lineNr put:bothParts.
+ self redrawLine:lineNr.
+ self deleteLine:nextLineNr
+ ]
+ ]
+!
+
+insertSelectedStringAtCursor:aString
+ "insert the argument, aString at cursor position and select it"
+
+ |startLine startCol|
+
+ startLine := cursorLine.
+ startCol := cursorCol.
+ self insertStringAtCursor:aString.
+ self selectFromLine:startLine col:startCol
+ toLine:cursorLine col:(cursorCol - 1)
+!
+
+deleteCharAtLine:lineNr col:colNr
+ "delete single character at colNr in line lineNr"
+
+ |line lineSize newLine drawCharacterOnly|
+
+ 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.
+ (colNr > lineSize) ifTrue: [^ self].
+
+ drawCharacterOnly := false.
+ (colNr == lineSize) ifTrue:[
+ 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 isBlank ifTrue:[
+ newLine := nil
+ ].
+ list at:lineNr put:newLine.
+ self textChanged.
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
+!
+
+removeTrailingBlankLines
+ "remove all blank lines at end of text"
+
+ |lastLine "{ Class: SmallInteger }"
+ line finished|
+
+ 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 ~~ list size) ifTrue:[
+ list grow:lastLine.
+"/ self textChanged
+ ]
+!
+
+deleteCharsAtLine:lineNr toCol:colNr
+ "delete characters from start up to colNr 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.
+ (colNr >= lineSize) ifTrue:[
+ newLine := nil
+ ] ifFalse:[
+ newLine := line copyFrom:(colNr + 1) to:lineSize.
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ]
+ ].
+ list at:lineNr put:newLine.
+ self textChanged.
+ self redrawLine:lineNr
+!
+
+insertTabAtCursor
+ "insert spaces to next tab"
+
+ self withCursorOffDo:[
+ |nextTab|
+
+ nextTab := self nextTabAfter:cursorCol.
+ self insertStringAtCursor:(String new:(nextTab - cursorCol)).
+ self makeCursorVisible.
+ ].
+!
+
+deleteSelection
+ "delete the selection"
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ selectionStartLine notNil ifTrue:[
+ self withCursorOffDo:[
+ |startLine startCol endLine endCol|
+
+ startLine := selectionStartLine.
+ startCol := selectionStartCol.
+ endLine := selectionEndLine.
+ endCol := selectionEndCol.
+ self unselectWithoutRedraw.
+ self deleteFromLine:startLine col:startCol
+ toLine:endLine col:endCol.
+ cursorCol := startCol.
+ cursorLine := startLine.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ self makeCursorVisible
+ ]
+ ]
+!
+
+deleteLineWithoutRedraw:lineNr
+ "delete line - no redraw;
+ return true, if something was really deleted"
+
+ readOnly ifTrue:[
+ exceptionBlock value:errorMessage.
+ ^ false
+ ].
+ (list isNil or:[lineNr > list size]) ifTrue:[^ false].
+ list removeIndex:lineNr.
+ self textChanged.
+ ^ true
+!
+
+deleteLinesWithoutRedrawFrom:startLine to:endLine
+ "delete lines - no redraw;
+ return true, if something was really deleted"
+
+ |lastLine|
+
+ readOnly ifTrue:[
+ exceptionBlock value:errorMessage.
+ ^ false
+ ].
+ (list isNil or:[startLine > list size]) ifTrue:[^ false].
+ (endLine > list size) ifTrue:[
+ lastLine := list size
+ ] ifFalse:[
+ lastLine := endLine
+ ].
+ list removeFromIndex:startLine toIndex:lastLine.
+ self textChanged.
+ ^ true
+!
+
+deleteLine:lineNr
+ "delete line"
+
+ |visLine w
+ srcY "{ Class: SmallInteger }" |
+
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ (self deleteLineWithoutRedraw:lineNr) ifFalse:[^ self].
+ shown ifFalse:[^ self].
+ visLine := self listLineToVisibleLine:lineNr.
+ visLine notNil ifTrue:[
+ srcY := margin + 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.
+ (nFullLinesShown ~~ nLinesShown) ifTrue:[
+ self redrawVisibleLine:nLinesShown
+ ].
+ self waitForExpose
+ ]
+!
+
+deleteCursorLine
+ "delete the line where the cursor sits"
+
+ self withCursorOffDo:[
+ self deleteLine:cursorLine
+ ]
+!
+
+deleteCharsAtLine:lineNr fromCol:colNr
+ "delete characters from colNr up to the end in line lineNr"
+
+ |line newLine|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ list isNil ifTrue: [^self].
+ (list size < lineNr) ifTrue: [^ self].
+ line := list at:lineNr.
+ line isNil ifTrue: [^self].
+ (colNr > line size) ifTrue: [^ self].
+ newLine := line copyTo:(colNr - 1).
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ].
+ list at:lineNr put:newLine.
+ self textChanged.
+ self redrawLine:lineNr
+!
+
+replaceSelectionBy:something
+ "delete the selection (if any) and insert something, a character or string;
+ leave cursor after insertion"
+
+ self replaceSelectionBy:something keepCursor:false
+!
+
+replaceSelectionBy:something keepCursor:keep
+ "delete the selection (if any) and insert something, a character or string;
+ leave cursor after insertion or leave it, depending on keep"
+
+ |sel l c|
+
+ l := cursorLine.
+ c := cursorCol.
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ lastString := sel.
+ self deleteSelection.
+ replacing := true.
+ lastReplacement := ''
+ ].
+ (something isMemberOf:Character) ifTrue:[
+ lastReplacement notNil ifTrue:[
+ (lastReplacement endsWith:Character space) ifTrue:[
+ lastReplacement := lastReplacement copyTo:(lastReplacement size - 1).
+ lastReplacement := lastReplacement copyWith:something.
+ lastReplacement := lastReplacement copyWith:Character space
+ ] ifFalse:[
+ lastReplacement := lastReplacement copyWith:something.
+ ]
+ ].
+ self insertCharAtCursor:something
+ ] ifFalse:[
+ lastReplacement := something.
+ self insertStringAtCursor:something
+ ].
+ keep ifTrue:[
+ self cursorLine:l col:c
+ ]
+!
+
+deleteCharBeforeCursor
+ "delete single character to the left of cursor and move cursor to left"
+
+ |oldSize lineNrAboveCursor|
+
+ (cursorCol == 1) ifFalse:[
+ self withCursorOffDo:[
+ cursorCol := cursorCol - 1.
+ self deleteCharAtLine:cursorLine col:cursorCol
+ ]
+ ] ifTrue:[
+ (cursorLine == 1) ifFalse:[
+ oldSize := 0.
+ lineNrAboveCursor := cursorLine - 1.
+ list notNil ifTrue:[
+ (list size >= lineNrAboveCursor) ifTrue:[
+ (list at:lineNrAboveCursor) notNil ifTrue:[
+ oldSize := (list at:lineNrAboveCursor) size
+ ]
+ ]
+ ].
+ self mergeLine:lineNrAboveCursor.
+ self withCursorOffDo:[
+ cursorLine := lineNrAboveCursor.
+ cursorCol := oldSize + 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine
+ ].
+ self makeCursorVisible
+ ]
+ ]
+!
+
+deleteCharAtCursor
+ "delete single character under cursor"
+
+ self withCursorOffDo:[
+ self deleteCharAtLine:cursorLine col:cursorCol
+ ]
+! !
+
+!EditTextView methodsFor:'redrawing'!
+
+redrawFromVisibleLine:startVisLine to:endVisLine
+ "redraw a visible line range"
+
+ super redrawFromVisibleLine:startVisLine to:endVisLine.
+ self redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
+!
+
+redrawCursorIfInVisibleLine:visLine
+ "redraw the cursor, if it sits in visible line"
+
+ cursorShown ifTrue:[
+ (visLine == cursorVisibleLine) ifTrue:[
+ self drawCursorCharacter
+ ]
+ ]
+!
+
+redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
+ "redraw the cursor, if it sits in a line range"
+
+ cursorShown ifTrue:[
+ cursorVisibleLine notNil ifTrue:[
+ (cursorVisibleLine between:startVisLine and:endVisLine) ifTrue:[
+ self drawCursorCharacter
+ ]
+ ]
+ ]
+!
+
+redrawVisibleLine:visLine from:startCol
+ "redraw a visible line from startCol to the end of line"
+
+ super redrawVisibleLine:visLine from:startCol.
+ self redrawCursorIfInVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine
+ "redraw a visible line"
+
+ super redrawVisibleLine:visLine.
+ self redrawCursorIfInVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine from:startCol to:endCol
+ "redraw a visible line from startCol to endCol"
+
+ super redrawVisibleLine:visLine from:startCol to:endCol.
+ self redrawCursorIfInVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine col:colNr
+ "redraw the single character in visibleline at colNr"
+
+ cursorShown ifTrue:[
+ (visLine == cursorVisibleLine) ifTrue:[
+ (colNr == cursorCol) ifTrue:[
+ self drawCursorCharacter.
+ ^ self
+ ]
+ ]
+ ].
+ super redrawVisibleLine:visLine col:colNr
+! !
+
+!EditTextView methodsFor:'scrolling'!
+
+originChanged:delta
+ "sent after scrolling - have to show the cursor if it was on before"
+
+ super originChanged:delta.
+ "
+ should we move the cursor with the scroll - or leave it ?
+ "
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ prevCursorState ifTrue:[
+ self showCursor
+ ]
+!
+
+originWillChange
+ "sent before scrolling - have to hide the cursor"
+
+ prevCursorState := cursorShown.
+ cursorShown ifTrue:[
+ self hideCursor
+ ]
+!
+
+pageUp
+ "page up - to keep cursor on same visible line, it has to be moved
+ within the real text "
+
+ |prevCursorLine|
+
+ prevCursorLine := cursorVisibleLine.
+ super pageUp.
+ self cursorVisibleLine:prevCursorLine col:cursorCol
+!
+
+pageDown
+ "page down - to keep cursor on same visible line, it has to be moved
+ within the real text "
+
+ |prevCursorLine|
+
+ prevCursorLine := cursorVisibleLine.
+ super pageDown.
+ self cursorVisibleLine:prevCursorLine col:cursorCol
+! !
+
+!EditTextView methodsFor:'cursor handling'!
+
+withCursorOffDo:aBlock
+ "evaluate aBlock with cursor off"
+
+ (shown not or:[cursorShown not]) ifTrue:[
+ ^ aBlock value
+ ].
+ self hideCursor.
+ aBlock valueNowOrOnUnwindDo:[
+ self showCursor
+ ]
+!
+
+drawCursor
+ "draw the cursor if shown and cursor is visible.
+ (but not, if there is a selection - to avoid confusion)"
+
+ shown ifTrue:[
+ cursorVisibleLine notNil ifTrue:[
+ self hasSelection ifFalse:[
+ self drawCursorCharacter
+ ]
+ ]
+ ]
+!
+
+drawCursorCharacter
+ "draw the cursor.
+ (i.e. the cursor if no selection)
+ - helper for many cursor methods"
+
+ hasKeyboardFocus ifTrue:[
+ self drawFocusCursor
+ ] ifFalse:[
+ self drawNoFocusCursor
+ ]
+!
+
+makeCursorVisible
+ "scroll to make cursor visible"
+
+ |line col|
+
+ cursorLine notNil ifTrue:[
+ line := cursorLine.
+ col := cursorCol.
+ "
+ if there is a selection, its better to
+ have its start being visible, instead of the end
+ "
+ (selectionStartLine notNil
+ and:[selectionEndLine notNil]) ifTrue:[
+
+"/ that was wrong
+"/ ((line == selectionEndLine)
+"/ and:[selectionEndCol notNil
+"/ and:[col == (selectionEndCol+1)]]) ifTrue:[
+
+ line := selectionStartLine.
+ col := selectionStartCol.
+ ].
+ self makeLineVisible:line.
+ self makeColVisible:col inLine:line
+ ]
+!
+
+undrawCursor
+ "undraw the cursor (i.e. redraw the character(s) under the cursor)"
+
+ cursorVisibleLine notNil ifTrue:[
+ ((cursorType == #caret) or:[cursorType == #solidCaret]) ifTrue:[
+ "caret-cursor touches 4 characters"
+ ((cursorCol > 1) and:[fontIsFixedWidth]) ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
+ super redrawVisibleLine:cursorVisibleLine+1 from:cursorCol-1 to:cursorCol.
+ ] ifFalse:[
+ "care for left margin"
+ super redrawVisibleLine:cursorVisibleLine.
+ super redrawVisibleLine:cursorVisibleLine+1.
+ ].
+ ^ self
+ ].
+ cursorType == #ibeam ifTrue:[
+ "ibeam-cursor touches 2 characters"
+ cursorCol > 1 ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
+ ] ifFalse:[
+ "care for left margin"
+ super redrawVisibleLine:cursorVisibleLine.
+ ].
+ ^ self
+ ].
+ "block is simple - just one character under cursor"
+ super redrawVisibleLine:cursorVisibleLine col:cursorCol
+ ]
+!
+
+drawCursor:cursorType with:fgColor and:bgColor
+ "draw a cursor; the argument cursorType specifies what type
+ of cursor should be drawn."
+
+ |x y w char|
+
+ self hasSelection ifTrue:[
+ "
+ hide cursor, if there is a selection
+ "
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+
+ cursorType == #block ifTrue:[
+ super drawVisibleLine:cursorVisibleLine
+ col:cursorCol
+ with:fgColor
+ and:bgColor.
+ ^ self
+ ].
+ x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
+ y := self yOfVisibleLine:cursorVisibleLine.
+
+ cursorType == #frame ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+
+ char := self characterUnderCursor asString.
+ self paint:bgColor.
+ self displayRectangleX:x y:y width:(font widthOf:char)
+ height:fontHeight.
+ ^ self
+ ].
+ cursorType == #ibeam ifTrue:[
+
+ self paint:bgColor.
+ self displayLineFromX:x-1 y:y toX:x-1 y:(y + fontHeight - 1).
+ self displayLineFromX:x y:y toX:x y:(y + fontHeight - 1).
+ ^ self
+ ].
+ cursorType == #caret ifTrue:[
+ y := y + fontHeight - 3.
+ w := fontWidth // 2.
+ self paint:bgColor.
+ self lineWidth:2.
+ self displayLineFromX:x-w y:y+w toX:x y:y.
+ self displayLineFromX:x y:y toX:x+w y:y+w.
+ ].
+ cursorType == #solidCaret ifTrue:[
+ y := y + fontHeight - 3.
+ w := fontWidth // 2.
+ self paint:bgColor.
+ self fillPolygon:(Array with:(x-w) @ (y+w)
+ with:(x @ y)
+ with:(x+w) @ (y+w))
+ ].
+!
+
+hideCursor
+ "make cursor invisible if currently visible; return true if cursor
+ was visible"
+
+ cursorShown ifTrue: [
+ self undrawCursor.
+ cursorShown := false.
+ ^ true
+ ].
+ ^ false
+!
+
+drawNoFocusCursor
+ "draw the cursor for the case when the view has no keyboard focus"
+
+ self hasSelection ifTrue:[
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+ cursorType ~~ #block ifTrue:[
+ "these dont show unfocussed"
+ ^ self drawFocusCursor
+ ].
+ self drawCursor:#frame with:cursorFgColor and:cursorBgColor
+!
+
+showCursor
+ "make cursor visible if currently invisible"
+
+ cursorShown ifFalse: [
+ self drawCursor.
+ cursorShown := true
+ ]
+!
+
+cursorHome
+ "scroll to top AND move cursor to first line of text"
+
+ self withCursorOffDo:[
+ self scrollToTop.
+ cursorCol := 1.
+ cursorVisibleLine := 1.
+ cursorLine := self visibleLineToAbsoluteLine:1.
+ self makeCursorVisible.
+ ]
+!
+
+drawFocusCursor
+ "draw the cursor when the focus is in the view."
+
+ self hasSelection ifTrue:[
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+ self drawCursor:cursorType with:cursorFgColor and:cursorBgColor.
+!
+
+cursorReturn
+ "move cursor to start of next line; scroll if at end of visible text"
+
+ self checkForExistingLine:(cursorLine + 1).
+ cursorVisibleLine notNil ifTrue:[
+ nFullLinesShown notNil ifTrue:[
+ (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown]
+ ]
+ ].
+ self withCursorOffDo:[
+ cursorCol := 1.
+ cursorLine := cursorLine + 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine
+ ].
+ self makeCursorVisible.
+!
+
+cursorUp
+ "move cursor up; scroll if at start of visible text"
+
+ (cursorLine == 1) ifFalse: [
+ cursorLine isNil ifTrue:[
+ cursorLine := firstLineShown + nFullLinesShown - 1.
+ ].
+"/ cursorVisibleLine notNil ifTrue:[
+ self withCursorOffDo:[
+ (cursorVisibleLine == 1) ifTrue:[self scrollUp].
+ cursorLine := cursorLine - 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ ].
+"/ ] ifFalse:[
+"/ self makeCursorVisible.
+"/ ]
+ ]
+!
+
+cursorToBottom
+ "move cursor to last line of text"
+
+ self withCursorOffDo:[
+ |newTop|
+
+ newTop := list size - nFullLinesShown.
+ (newTop < 1) ifTrue:[
+ newTop := 1
+ ].
+ self scrollToLine:newTop.
+ cursorCol := 1.
+ cursorLine := list size.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ self makeCursorVisible.
+ ]
+!
+
+cursorDown
+ "move cursor down; scroll if at end of visible text"
+
+ cursorVisibleLine notNil ifTrue:[
+ self withCursorOffDo:[
+ (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown].
+ cursorLine := cursorLine + 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine
+ ]
+ ] ifFalse:[
+ cursorLine isNil ifTrue:[
+ cursorLine := firstLineShown
+ ].
+ cursorLine := cursorLine + 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ self makeCursorVisible.
+ ].
+!
+
+cursorRight
+ "move cursor to right"
+
+ self withCursorOffDo:[cursorCol := cursorCol + 1].
+ self makeCursorVisible.
+!
+
+cursorLeft
+ "move cursor to left"
+
+ (cursorCol == 1) ifFalse: [
+ self withCursorOffDo:[cursorCol := cursorCol - 1]
+ ].
+ self makeCursorVisible.
+!
+
+cursorToEndOfLine
+ "move cursor to end of current line"
+
+ self withCursorOffDo:[
+ |line|
+
+ list isNil ifTrue:[
+ cursorCol := 1
+ ] ifFalse:[
+ line := list at:cursorLine.
+ cursorCol := line size + 1
+ ].
+ self makeCursorVisible.
+ ].
+!
+
+cursorToBeginOfLine
+ "move cursor to start of current line"
+
+ self withCursorOffDo:[
+ cursorCol := 1
+ ].
+ self makeCursorVisible.
+!
+
+cursorTab
+ "move cursor to next tabstop"
+
+ self withCursorOffDo:[
+ cursorCol := self nextTabAfter:cursorCol
+ ].
+ self makeCursorVisible.
+!
+
+cursorLine:line col:col
+ "this positions onto physical - not visible - line"
+
+ self withCursorOffDo:[
+ cursorLine := line.
+ cursorVisibleLine := self listLineToVisibleLine:line.
+ cursorCol := col.
+ (cursorCol < 1) ifTrue:[
+ cursorCol := 1
+ ]
+ ].
+ self makeCursorVisible.
+!
+
+cursorBacktab
+ "move cursor to prev tabstop"
+
+ self withCursorOffDo:[
+ cursorCol := self prevTabBefore:cursorCol
+ ].
+ self makeCursorVisible.
+!
+
+cursorToNextWord
+ "move the cursor to the beginning of the next word"
+
+ |col line searching|
+
+ (cursorLine > list size) ifTrue:[^ self].
+ self wordAtLine:cursorLine col:cursorCol do:[
+ :beginLine :beginCol :endLine :endCol :style |
+
+ line := endLine.
+ col := endCol + 1.
+ searching := true.
+ [searching
+ and:[(self characterAtLine:line col:col) isSeparator]] whileTrue:[
+ self wordAtLine:line col:col do:[
+ :beginLine :beginCol :endLine :endCol :style |
+
+ (line > list size) ifTrue:[
+ "break out"
+ searching := false
+ ] ifFalse:[
+ line := endLine.
+ col := endCol + 1.
+ ]
+ ]
+ ].
+ self cursorLine:line col:col
+ ]
+!
+
+cursorVisibleLine:visibleLineNr col:colNr
+ "put cursor to visibleline/col"
+
+ self withCursorOffDo:[
+ cursorLine := self visibleLineToAbsoluteLine:visibleLineNr.
+ cursorVisibleLine := visibleLineNr.
+ cursorCol := colNr.
+ (cursorCol < 1) ifTrue:[
+ cursorCol := 1
+ ]
+ ].
+ self makeCursorVisible.
+!
+
+cursorX:x y:y
+ "put cursor to position next to x/y coordinate in view"
+
+ |line col|
+
+ line := self visibleLineOfY:y.
+ col := self colOfX:x inVisibleLine:line.
+ self cursorVisibleLine:line col:col.
+!
+
+cursorToTop
+ "move cursor to absolute home"
+
+ self cursorLine:1 col:1
+!
+
+gotoLine:aLineNumber
+ "position cursor onto line, aLineNumber.
+ Make certain that this line is visible"
+
+ self makeLineVisible:aLineNumber.
+ self cursorLine:aLineNumber col:1
+! !
+
+!EditTextView methodsFor:'accessing'!
+
+characterUnderCursor
+ "return the character under the cursor - space if behond line.
+ For non-block cursors, this is the character immediately to the right
+ of the insertion-bar or caret."
+
+ ^ self characterAtLine:cursorLine col:cursorCol
+!
+
+list:something
+ "position cursor home when setting contents"
+
+ super list:something.
+ self cursorHome
+!
+
+cursorForegroundColor:color1 backgroundColor:color2
+ "set both cursor foreground and cursor background colors"
+
+ self hideCursor.
+ cursorFgColor := color1 on:device.
+ cursorBgColor := color2 on:device.
+ self showCursor
+!
+
+cursorLine
+ "return the cursors line (1..).
+ This is the absolute line; NOT the visible line"
+
+ ^ cursorLine
+!
+
+contents
+ "return the contents as a String"
+
+ list isNil ifTrue:[^ ''].
+ self removeTrailingBlankLines.
+ ^ list asStringWithCRs
+!
+
+cursorCol
+ "return the cursors col (1..).
+ This is the absolute col; NOT the visible col"
+
+ ^ cursorCol
+!
+
+readOnly
+ "make the text readonly"
+
+ readOnly := true
+!
+
+fixedSize
+ "make the texts size fixed (no lines may be added).
+ OBSOLETE: use readOnly"
+
+ readOnly ifFalse:[
+ readOnly := true.
+ middleButtonMenu disable:#cut.
+ middleButtonMenu disable:#paste.
+ middleButtonMenu disable:#replace.
+ middleButtonMenu disable:#indent
+ ]
+!
+
+exceptionBlock:aBlock
+ "define the action to be triggered when user tries to modify
+ readonly text"
+
+ exceptionBlock := aBlock
+!
+
+modified:aBoolean
+ "set the modified flag"
+
+ modified := aBoolean
+!
+
+modified
+ "return true if text was modified"
+
+ ^ modified
+!
+
+fromFile:aFileName
+ "take contents from a named file"
+
+ self contents:(aFileName asFilename readStream contents)
+! !
+
!EditTextView methodsFor:'initialization'!
+initEvents
+ "enable enter/leave events in addition"
+
+ super initEvents.
+ self enableEnterLeaveEvents
+!
+
+initStyle
+ "initialize style specific stuff"
+
+ super initStyle.
+ cursorFgColor := DefaultCursorForegroundColor.
+ cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
+ cursorBgColor := DefaultCursorBackgroundColor.
+ cursorBgColor isNil ifTrue:[cursorBgColor := fgColor].
+ cursorType := DefaultCursorType.
+!
+
+realize
+ "make the view visible"
+
+ super realize.
+ cursorFgColor := cursorFgColor on:device.
+ cursorBgColor := cursorBgColor on:device.
+!
+
initialize
"initialize a new EditTextView;
setup some instance variables"
@@ -123,24 +1732,6 @@
hasKeyboardFocus := false. "/ true.
!
-initStyle
- "initialize style specific stuff"
-
- super initStyle.
- cursorFgColor := DefaultCursorForegroundColor.
- cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
- cursorBgColor := DefaultCursorBackgroundColor.
- cursorBgColor isNil ifTrue:[cursorBgColor := fgColor].
- cursorType := DefaultCursorType.
-!
-
-initEvents
- "enable enter/leave events in addition"
-
- super initEvents.
- self enableEnterLeaveEvents
-!
-
editMenu
"return the views middleButtonMenu"
@@ -218,2194 +1809,25 @@
sub disable:#indent.
].
^ m.
-!
-
-realize
- "make the view visible"
-
- super realize.
- cursorFgColor := cursorFgColor on:device.
- cursorBgColor := cursorBgColor on:device.
-! !
-
-!EditTextView methodsFor:'accessing'!
-
-cursorForegroundColor:color1 backgroundColor:color2
- "set both cursor foreground and cursor background colors"
-
- self hideCursor.
- cursorFgColor := color1 on:device.
- cursorBgColor := color2 on:device.
- self showCursor
-!
-
-cursorLine
- "return the cursors line (1..).
- This is the absolute line; NOT the visible line"
-
- ^ cursorLine
-!
-
-cursorCol
- "return the cursors col (1..).
- This is the absolute col; NOT the visible col"
-
- ^ cursorCol
-!
-
-contents
- "return the contents as a String"
-
- list isNil ifTrue:[^ ''].
- self removeTrailingBlankLines.
- ^ list asStringWithCRs
-!
-
-list:something
- "position cursor home when setting contents"
-
- super list:something.
- self cursorHome
-!
-
-readOnly
- "make the text readonly"
-
- readOnly := true
-!
-
-fixedSize
- "make the texts size fixed (no lines may be added).
- OBSOLETE: use readOnly"
-
- readOnly ifFalse:[
- readOnly := true.
- middleButtonMenu disable:#cut.
- middleButtonMenu disable:#paste.
- middleButtonMenu disable:#replace.
- middleButtonMenu disable:#indent
- ]
-!
-
-exceptionBlock:aBlock
- "define the action to be triggered when user tries to modify
- readonly text"
-
- exceptionBlock := aBlock
-!
-
-fromFile:aFileName
- "take contents from a named file"
-
- self contents:(aFileName asFilename readStream contents)
-!
-
-modified:aBoolean
- "set the modified flag"
-
- modified := aBoolean
-!
-
-modified
- "return true if text was modified"
-
- ^ modified
-!
-
-characterUnderCursor
- "return the character under the cursor - space if behond line.
- For non-block cursors, this is the character immediately to the right
- of the insertion-bar or caret."
-
- ^ self characterAtLine:cursorLine col:cursorCol
-! !
-
-!EditTextView methodsFor:'private'!
-
-contentsChanged
- "triggered whenever text is changed"
-
- super contentsChanged.
- modified := true.
- contentsWasSaved := false
-! !
-
-!EditTextView methodsFor:'editing'!
-
-mergeLine:lineNr
- "merge line lineNr with line lineNr+1"
-
- |leftPart rightPart bothParts nextLineNr|
-
- list isNil ifFalse:[
- nextLineNr := lineNr + 1.
- (nextLineNr > list size) ifFalse:[
- (list at:lineNr) isNil ifTrue:[
- leftPart := ''
- ] ifFalse:[
- leftPart := list at:lineNr
- ].
- (list at:nextLineNr) isNil ifTrue:[
- rightPart := ''
- ] ifFalse:[
- rightPart := list at:nextLineNr
- ].
- bothParts := leftPart , rightPart.
- bothParts isBlank ifTrue:[bothParts := nil].
- list at:lineNr put:bothParts.
- self redrawLine:lineNr.
- self deleteLine:nextLineNr
- ]
- ]
-!
-
-splitLine:lineNr before:colNr
- "split the line linNr before colNr; the right part (from colNr)
- is cut off and inserted after lineNr; the view is redrawn"
-
- |line lineSize leftRest rightRest visLine w
- 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.
- modified := true.
- contentsWasSaved := false.
- 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 contentsChanged.
- ]
- ]
-!
-
-withoutRedrawInsertLine:aString before:lineNr
- "insert the argument, aString before line lineNr; the string
- becomes line nileNr; everything else is moved down; the view
- is not redrawn"
-
- |line|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- line := aString.
- line notNil ifTrue:[
- line isBlank ifTrue:[
- line := nil
- ] ifFalse:[
- (line occurrencesOf:(Character tab)) == 0 ifFalse:[
- line := self withTabsExpanded:line
- ]
- ]
- ].
- list isNil ifTrue: [
- list := StringCollection new:lineNr
- ] ifFalse: [
- list grow:((list size + 1) max:lineNr)
- ].
-
- "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
- overlapping copy - if it didn't, we had to use:"
-"
- index := list size.
- [index > lineNr] whileTrue: [
- pIndex := index - 1.
- list at:index put:(list at:pIndex).
- index := pIndex
- ].
-"
- list replaceFrom:(lineNr + 1) to:(list size) with:list startingAt:lineNr.
- list at:lineNr put:line.
-!
-
-insertLine:aString before:lineNr
- "insert the line aString before line lineNr"
-
- |visLine w
- dstY "{ Class: SmallInteger }" |
-
- visLine := self listLineToVisibleLine:lineNr.
- (shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLine:aString before:lineNr.
- self contentsChanged.
- ^ self
- ].
-
- 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.
- self contentsChanged.
-!
-
-insertLines:someText from:start to:end before:lineNr
- "insert a bunch of lines before line lineNr"
-
- |visLine w nLines "{ Class: SmallInteger }"
- srcY "{ Class: SmallInteger }"
- dstY "{ Class: SmallInteger }" |
-
- readOnly ifTrue:[
- ^ self
- ].
- visLine := self listLineToVisibleLine:lineNr.
- (shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- self contentsChanged.
- ^ self
- ].
-
- 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
- ].
- self contentsChanged.
-!
-
-insert:aCharacter atLine:lineNr col:colNr
- "insert a single character at lineNr/colNr"
-
- |line lineSize newLine drawCharacterOnly|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- aCharacter == (Character cr) ifTrue:[
- 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
- ]
- ].
- (lineSize == 0) ifTrue: [
- 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
- ]
- ].
- newLine at:colNr put:aCharacter.
- aCharacter == (Character tab) ifTrue:[
- newLine := self withTabsExpanded:newLine.
- drawCharacterOnly := false
- ].
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
- shown ifTrue:[
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
- ]
- ]
-!
-
-withoutRedrawInsertLines:lines from:start to:end before:lineNr
- "insert a bunch of lines before line lineNr; the view
- is not redrawn"
-
- |newLine newLines nLines|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
-
- nLines := end - start + 1.
- newLines := Array new:(lines size).
- start to:end do:[:index |
- newLine := lines at:index.
- newLine notNil ifTrue:[
- newLine isBlank ifTrue:[
- newLine := nil
- ] ifFalse:[
- (newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
- newLine := self withTabsExpanded:newLine
- ]
- ]
- ].
- newLines at:index put:newLine
- ].
- list isNil ifTrue: [
- list := StringCollection new:(lineNr + nLines + 1)
- ] ifFalse: [
- list grow:((list size + nLines) max:(lineNr + nLines - 1))
- ].
-
- "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
- overlapping copy - if it didn't, we had to use:"
-"
- index := list size.
- [index > lineNr] whileTrue: [
- pIndex := index - 1.
- list at:index put:(list at:pIndex).
- index := pIndex
- ].
-"
- list replaceFrom:(lineNr + nLines) to:(list size) with:list startingAt:lineNr.
- list replaceFrom:lineNr to:(lineNr + nLines - 1) with:newLines startingAt:start.
-!
-
-withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr
- "insert aString (which has no crs) at lineNr/colNr"
-
- |strLen line lineSize newLine|
-
- aString isNil ifTrue:[^ self].
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- strLen := aString size.
- self checkForExistingLine:lineNr.
- line := list at:lineNr.
- line notNil ifTrue:[
- lineSize := line size
- ] ifFalse:[
- lineSize := 0
- ].
- ((colNr == 1) and:[lineSize == 0]) ifTrue: [
- 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
- ].
-
- (aString occurrencesOf:(Character tab)) == 0 ifFalse:[
- newLine := self withTabsExpanded:newLine
- ].
-
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
-!
-
-insertStringWithoutCRs:aString atLine:lineNr col:colNr
- "insert aString (which has no crs) at lineNr/colNr"
-
- self withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
- shown ifTrue:[self redrawLine:lineNr from:colNr]
-!
-
-insertStringWithoutCRsAtCursor:aString
- "insert a string (which has no crs) at cursor position
- - advance cursor"
-
- aString notNil ifTrue:[
- self withCursorOffDo:[
- self insertString:aString atLine:cursorLine col:cursorCol.
- cursorCol := cursorCol + aString size
- ]
- ]
-!
-
-insertCharAtCursor:aCharacter
- "insert a single character at cursor-position - advance cursor"
-
- self withCursorOffDo:[
- self insert:aCharacter atLine:cursorLine col:cursorCol.
- aCharacter == (Character cr) ifTrue:[
- self cursorReturn
- ] ifFalse:[
- cursorCol := cursorCol + 1
- ].
- self makeCursorVisible
- ]
-!
-
-insertString:aString atLine:lineNr col:colNr
- "insert the string, aString at line/col;
- handle cr's correctly"
-
- |start "{ Class: SmallInteger }"
- stop "{ Class: SmallInteger }"
- end "{ Class: SmallInteger }"
- subString c
- l "{ Class: SmallInteger }" |
-
-
- aString isNil ifTrue:[^ self].
- ((aString occurrencesOf:(Character cr)) == 0) ifTrue:[
- ^ self insertStringWithoutCRs:aString atLine:lineNr col:colNr
- ].
- l := lineNr.
- c := colNr.
- start := 1.
- end := aString size.
- [start <= end] whileTrue:[
- stop := aString indexOf:(Character cr) startingAt:start.
- stop == 0 ifTrue:[
- stop := end + 1
- ].
- subString := aString copyFrom:start to:(stop - 1).
- self insertStringWithoutCRs:subString atLine:l col:c.
- (stop < end) ifTrue:[
- c := c + subString size.
- self insert:(Character cr) atLine:l col:c.
- l := l + 1.
- c := 1
- ].
- start := stop + 1
- ]
-!
-
-insertStringAtCursor:aString
- "insert the argument, aString at cursor position
- handle cr's correctly. A nil argument is interpreted as an empty line."
-
- |start " { Class: SmallInteger }"
- stop " { Class: SmallInteger }"
- end " { Class: SmallInteger }"
- subString|
-
- aString isNil ifTrue:[
- "new:"
- self insertCharAtCursor:(Character cr).
- ^ self
- ].
- ((aString occurrencesOf:(Character cr)) == 0) ifTrue:[
- ^ self insertStringWithoutCRsAtCursor:aString
- ].
-
- self insertLines:aString asStringCollection withCr:false.
-
-"/ start := 1.
-"/ end := aString size.
-"/ "insert the 1st line"
-"/ (cursorCol ~~ 1) ifTrue:[
-"/ stop := aString indexOf:(Character cr) startingAt:start.
-"/ stop == 0 ifTrue:[
-"/ stop := end + 1
-"/ ].
-"/ subString := aString copyFrom:start to:(stop - 1).
-"/ self insertStringWithoutCRsAtCursor:subString.
-"/ self insertCharAtCursor:(Character cr).
-"/ start := stop + 1
-"/ ].
-"/ "insert the block of full lines"
-"/
-"/ [start <= end] whileTrue:[
-"/ stop := aString indexOf:(Character cr) startingAt:start.
-"/ stop == 0 ifTrue:[
-"/ stop := end + 1
-"/ ].
-"/ subString := aString copyFrom:start to:(stop - 1).
-"/ self insertStringWithoutCRsAtCursor:subString.
-"/ (stop < end) ifTrue:[
-"/ self insertCharAtCursor:(Character cr)
-"/ ].
-"/ start := stop + 1
-"/ ]
-!
-
-insertSelectedStringAtCursor:aString
- "insert the argument, aString at cursor position and select it"
-
- |startLine startCol|
-
- startLine := cursorLine.
- startCol := cursorCol.
- self insertStringAtCursor:aString.
- self selectFromLine:startLine col:startCol
- toLine:cursorLine col:(cursorCol - 1)
-!
-
-insertLines:lines withCr:withCr
- "insert a bunch of lines at cursor position. Cursor
- is moved behind insertion.
- If withCr is true, append cr after last line"
-
- |start end nLines|
-
- lines notNil ifTrue:[
- nLines := lines size.
- (nLines == 1) ifTrue:[
- self insertStringAtCursor:(lines at:1).
- withCr ifTrue:[
- self insertCharAtCursor:(Character cr)
- ]
- ] ifFalse:[
- (cursorCol ~~ 1) ifTrue:[
- self insertStringAtCursor:(lines at:1).
- self insertCharAtCursor:(Character cr).
- start := 2
- ] ifFalse:[
- start := 1
- ].
- withCr ifTrue:[
- end := nLines
- ] ifFalse:[
- end := nLines - 1
- ].
- (start < nLines) ifTrue:[
- (end >= start) ifTrue:[
- self withCursorOffDo:[
- self insertLines:lines
- from:start to:end
- before:cursorLine.
- cursorLine := cursorLine + (end - start + 1).
- cursorVisibleLine := self absoluteLineToVisibleLine:
- cursorLine
- ]
- ]
- ].
- withCr ifFalse:[
- "last line without cr"
- self insertStringAtCursor:(lines at:nLines)
- ]
- ]
- ]
-!
-
-insertTabAtCursor
- "insert spaces to next tab"
-
- self withCursorOffDo:[
- |nextTab|
-
- nextTab := self nextTabAfter:cursorCol.
- self insertStringAtCursor:(String new:(nextTab - cursorCol)).
- self makeCursorVisible.
- ].
-!
-
-deleteFromLine:startLine col:startCol toLine:endLine col:endCol
- "delete all text from startLine/startCol to endLine/endCol -
- joining lines if nescessary"
-
- |line lineSize|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue:[^ self].
-
- (startLine == endLine) ifTrue:[
- "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 right rest of 1st line"
- self deleteCharsAtLine:startLine fromCol:startCol.
-
- "delete the inner lines ..."
- endLine > (startLine + 1) ifTrue:[
- 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.
- modified := true.
- contentsWasSaved := false.
- ]
- ].
-
- "merge the left rest of 1st line with right rest of last line into one"
- self mergeLine:startLine
-!
-
-deleteFromLine:startLineNr toLine:endLineNr
- "delete some lines"
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue:[^ self].
- list removeFromIndex:startLineNr toIndex:endLineNr.
- self contentsChanged.
- 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
- ].
- (list isNil or:[lineNr > list size]) ifTrue:[^ false].
- list removeIndex:lineNr.
- self contentsChanged.
- ^ true
-!
-
-deleteLinesWithoutRedrawFrom:startLine to:endLine
- "delete lines - no redraw;
- return true, if something was really deleted"
-
- |lastLine|
-
- readOnly ifTrue:[
- exceptionBlock value:errorMessage.
- ^ false
- ].
- (list isNil or:[startLine > list size]) ifTrue:[^ false].
- (endLine > list size) ifTrue:[
- lastLine := list size
- ] ifFalse:[
- lastLine := endLine
- ].
- list removeFromIndex:startLine toIndex:lastLine.
- self contentsChanged.
- ^ true
-!
-
-deleteLine:lineNr
- "delete line"
-
- |visLine w
- srcY "{ Class: SmallInteger }" |
-
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- (self deleteLineWithoutRedraw:lineNr) ifFalse:[^ self].
- shown ifFalse:[^ self].
- visLine := self listLineToVisibleLine:lineNr.
- visLine notNil ifTrue:[
- srcY := margin + 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.
- (nFullLinesShown ~~ nLinesShown) ifTrue:[
- self redrawVisibleLine:nLinesShown
- ].
- self waitForExpose
- ]
-!
-
-deleteCursorLine
- "delete the line where the cursor sits"
-
- self withCursorOffDo:[
- self deleteLine:cursorLine
- ]
-!
-
-removeTrailingBlankLines
- "remove all blank lines at end of text"
-
- |lastLine "{ Class: SmallInteger }"
- line finished|
-
- 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 ~~ list size) ifTrue:[
- list grow:lastLine.
- self contentsChanged
- ]
-!
-
-deleteCharsAtLine:lineNr toCol:colNr
- "delete characters from start up to colNr 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.
- (colNr >= lineSize) ifTrue:[
- newLine := nil
- ] ifFalse:[
- newLine := line copyFrom:(colNr + 1) to:lineSize.
- newLine isBlank ifTrue:[
- newLine := nil
- ]
- ].
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
- self redrawLine:lineNr
-!
-
-deleteCharsAtLine:lineNr fromCol:colNr
- "delete characters from colNr up to the end in line lineNr"
-
- |line newLine|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue: [^self].
- (list size < lineNr) ifTrue: [^ self].
- line := list at:lineNr.
- line isNil ifTrue: [^self].
- (colNr > line size) ifTrue: [^ self].
- newLine := line copyTo:(colNr - 1).
- newLine isBlank ifTrue:[
- newLine := nil
- ].
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
- self redrawLine:lineNr
-!
-
-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.
- modified := true.
- contentsWasSaved := false.
- self redrawLine:lineNr
-!
-
-deleteCharAtLine:lineNr col:colNr
- "delete single character at colNr in line lineNr"
-
- |line lineSize newLine drawCharacterOnly|
-
- 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.
- (colNr > lineSize) ifTrue: [^ self].
-
- drawCharacterOnly := false.
- (colNr == lineSize) ifTrue:[
- 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 isBlank ifTrue:[
- newLine := nil
- ].
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
- ]
-!
-
-deleteCharBeforeCursor
- "delete single character to the left of cursor and move cursor to left"
-
- |oldSize lineNrAboveCursor|
-
- (cursorCol == 1) ifFalse:[
- self withCursorOffDo:[
- cursorCol := cursorCol - 1.
- self deleteCharAtLine:cursorLine col:cursorCol
- ]
- ] ifTrue:[
- (cursorLine == 1) ifFalse:[
- oldSize := 0.
- lineNrAboveCursor := cursorLine - 1.
- list notNil ifTrue:[
- (list size >= lineNrAboveCursor) ifTrue:[
- (list at:lineNrAboveCursor) notNil ifTrue:[
- oldSize := (list at:lineNrAboveCursor) size
- ]
- ]
- ].
- self mergeLine:lineNrAboveCursor.
- self withCursorOffDo:[
- cursorLine := lineNrAboveCursor.
- cursorCol := oldSize + 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine
- ].
- self makeCursorVisible
- ]
- ]
-!
-
-deleteCharAtCursor
- "delete single character under cursor"
-
- self withCursorOffDo:[
- self deleteCharAtLine:cursorLine col:cursorCol
- ]
-!
-
-deleteSelection
- "delete the selection"
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- selectionStartLine notNil ifTrue:[
- self withCursorOffDo:[
- |startLine startCol endLine endCol|
-
- startLine := selectionStartLine.
- startCol := selectionStartCol.
- endLine := selectionEndLine.
- endCol := selectionEndCol.
- self unselectWithoutRedraw.
- self deleteFromLine:startLine col:startCol
- toLine:endLine col:endCol.
- cursorCol := startCol.
- cursorLine := startLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisible
- ]
- ]
-!
-
-replaceSelectionBy:something keepCursor:keep
- "delete the selection (if any) and insert something, a character or string;
- leave cursor after insertion or leave it, depending on keep"
-
- |sel l c|
-
- l := cursorLine.
- c := cursorCol.
-
- sel := self selection.
- sel notNil ifTrue:[
- lastString := sel.
- self deleteSelection.
- replacing := true.
- lastReplacement := ''
- ].
- (something isMemberOf:Character) ifTrue:[
- lastReplacement notNil ifTrue:[
- (lastReplacement endsWith:Character space) ifTrue:[
- lastReplacement := lastReplacement copyTo:(lastReplacement size - 1).
- lastReplacement := lastReplacement copyWith:something.
- lastReplacement := lastReplacement copyWith:Character space
- ] ifFalse:[
- lastReplacement := lastReplacement copyWith:something.
- ]
- ].
- self insertCharAtCursor:something
- ] ifFalse:[
- lastReplacement := something.
- self insertStringAtCursor:something
- ].
- keep ifTrue:[
- self cursorLine:l col:c
- ]
-!
-
-replaceSelectionBy:something
- "delete the selection (if any) and insert something, a character or string;
- leave cursor after insertion"
-
- self replaceSelectionBy:something keepCursor:false
-! !
-
-!EditTextView methodsFor:'formatting'!
-
-indent
- "indent selected line-range"
-
- |start end|
-
- selectionStartLine isNil ifTrue:[^ self].
- start := selectionStartLine.
- end := selectionEndLine.
- (selectionEndCol == 0) ifTrue:[
- end := end - 1
- ].
- self unselect.
- self indentFromLine:start toLine:end
-!
-
-indentFromLine:start toLine:end
- "indent a line-range - this is don by searching for the
- last non-empty line before start, and change the indent
- of the line based on that indent."
-
- |leftStart lnr delta d line spaces|
-
- "find a line to base indent on..."
- leftStart := 0.
- lnr := start.
- [(leftStart == 0) and:[lnr ~~ 1]] whileTrue:[
- lnr := lnr - 1.
- leftStart := self leftIndentOfLine:lnr
- ].
-
- (leftStart == 0) ifTrue:[^ self].
-
- delta := leftStart - (self leftIndentOfLine:start).
- (delta == 0) ifTrue:[^ self].
- (delta > 0) ifTrue:[
- 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.
- modified := true.
- contentsWasSaved := false.
- ]
- ]
- ].
- self redrawFromLine:start to:end
-! !
-
-!EditTextView methodsFor:'cursor handling'!
-
-makeCursorVisible
- "scroll to make cursor visible"
-
- |line col|
-
- cursorLine notNil ifTrue:[
- line := cursorLine.
- col := cursorCol.
- "
- if there is a selection, its better to
- have its start being visible, instead of the end
- "
- (selectionStartLine notNil
- and:[selectionEndLine notNil]) ifTrue:[
-
-"/ that was wrong
-"/ ((line == selectionEndLine)
-"/ and:[selectionEndCol notNil
-"/ and:[col == (selectionEndCol+1)]]) ifTrue:[
-
- line := selectionStartLine.
- col := selectionStartCol.
- ].
- self makeLineVisible:line.
- self makeColVisible:col inLine:line
- ]
-!
-
-drawCursor
- "draw the cursor if shown and cursor is visible.
- (but not, if there is a selection - to avoid confusion)"
-
- shown ifTrue:[
- cursorVisibleLine notNil ifTrue:[
- self hasSelection ifFalse:[
- self drawCursorCharacter
- ]
- ]
- ]
-!
-
-drawCursorCharacter
- "draw the cursor.
- (i.e. the cursor if no selection)
- - helper for many cursor methods"
-
- hasKeyboardFocus ifTrue:[
- self drawFocusCursor
- ] ifFalse:[
- self drawNoFocusCursor
- ]
-!
-
-drawCursor:cursorType with:fgColor and:bgColor
- "draw a cursor; the argument cursorType specifies what type
- of cursor should be drawn."
-
- |x y w char|
-
- self hasSelection ifTrue:[
- "
- hide cursor, if there is a selection
- "
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
-
- cursorType == #block ifTrue:[
- super drawVisibleLine:cursorVisibleLine
- col:cursorCol
- with:fgColor
- and:bgColor.
- ^ self
- ].
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := self yOfVisibleLine:cursorVisibleLine.
-
- cursorType == #frame ifTrue:[
- super redrawVisibleLine:cursorVisibleLine col:cursorCol.
-
- char := self characterUnderCursor asString.
- self paint:bgColor.
- self displayRectangleX:x y:y width:(font widthOf:char)
- height:fontHeight.
- ^ self
- ].
- cursorType == #ibeam ifTrue:[
-
- self paint:bgColor.
- self displayLineFromX:x-1 y:y toX:x-1 y:(y + fontHeight - 1).
- self displayLineFromX:x y:y toX:x y:(y + fontHeight - 1).
- ^ self
- ].
- cursorType == #caret ifTrue:[
- y := y + fontHeight - 3.
- w := fontWidth // 2.
- self paint:bgColor.
- self lineWidth:2.
- self displayLineFromX:x-w y:y+w toX:x y:y.
- self displayLineFromX:x y:y toX:x+w y:y+w.
- ].
- cursorType == #solidCaret ifTrue:[
- y := y + fontHeight - 3.
- w := fontWidth // 2.
- self paint:bgColor.
- self fillPolygon:(Array with:(x-w) @ (y+w)
- with:(x @ y)
- with:(x+w) @ (y+w))
- ].
-!
-
-drawFocusCursor
- "draw the cursor when the focus is in the view."
-
- self hasSelection ifTrue:[
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
- self drawCursor:cursorType with:cursorFgColor and:cursorBgColor.
-!
-
-drawNoFocusCursor
- "draw the cursor for the case when the view has no keyboard focus"
-
- self hasSelection ifTrue:[
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
- cursorType ~~ #block ifTrue:[
- "these dont show unfocussed"
- ^ self drawFocusCursor
- ].
- self drawCursor:#frame with:cursorFgColor and:cursorBgColor
-!
-
-undrawCursor
- "undraw the cursor (i.e. redraw the character(s) under the cursor)"
-
- cursorVisibleLine notNil ifTrue:[
- ((cursorType == #caret) or:[cursorType == #solidCaret]) ifTrue:[
- "caret-cursor touches 4 characters"
- ((cursorCol > 1) and:[fontIsFixedWidth]) ifTrue:[
- super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
- super redrawVisibleLine:cursorVisibleLine+1 from:cursorCol-1 to:cursorCol.
- ] ifFalse:[
- "care for left margin"
- super redrawVisibleLine:cursorVisibleLine.
- super redrawVisibleLine:cursorVisibleLine+1.
- ].
- ^ self
- ].
- cursorType == #ibeam ifTrue:[
- "ibeam-cursor touches 2 characters"
- cursorCol > 1 ifTrue:[
- super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
- ] ifFalse:[
- "care for left margin"
- super redrawVisibleLine:cursorVisibleLine.
- ].
- ^ self
- ].
- "block is simple - just one character under cursor"
- super redrawVisibleLine:cursorVisibleLine col:cursorCol
- ]
-!
-
-hideCursor
- "make cursor invisible if currently visible; return true if cursor
- was visible"
-
- cursorShown ifTrue: [
- self undrawCursor.
- cursorShown := false.
- ^ true
- ].
- ^ false
-!
-
-showCursor
- "make cursor visible if currently invisible"
-
- cursorShown ifFalse: [
- self drawCursor.
- cursorShown := true
- ]
-!
-
-withCursorOffDo:aBlock
- "evaluate aBlock with cursor off"
-
- (shown not or:[cursorShown not]) ifTrue:[
- ^ aBlock value
- ].
- self hideCursor.
- aBlock valueNowOrOnUnwindDo:[
- self showCursor
- ]
-!
-
-cursorHome
- "scroll to top AND move cursor to first line of text"
-
- self withCursorOffDo:[
- self scrollToTop.
- cursorCol := 1.
- cursorVisibleLine := 1.
- cursorLine := self visibleLineToAbsoluteLine:1.
- self makeCursorVisible.
- ]
-!
-
-cursorToBottom
- "move cursor to last line of text"
-
- self withCursorOffDo:[
- |newTop|
-
- newTop := list size - nFullLinesShown.
- (newTop < 1) ifTrue:[
- newTop := 1
- ].
- self scrollToLine:newTop.
- cursorCol := 1.
- cursorLine := list size.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisible.
- ]
-!
-
-cursorUp
- "move cursor up; scroll if at start of visible text"
-
- (cursorLine == 1) ifFalse: [
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown + nFullLinesShown - 1.
- ].
-"/ cursorVisibleLine notNil ifTrue:[
- self withCursorOffDo:[
- (cursorVisibleLine == 1) ifTrue:[self scrollUp].
- cursorLine := cursorLine - 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- ].
-"/ ] ifFalse:[
-"/ self makeCursorVisible.
-"/ ]
- ]
-!
-
-cursorDown
- "move cursor down; scroll if at end of visible text"
-
- cursorVisibleLine notNil ifTrue:[
- self withCursorOffDo:[
- (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown].
- cursorLine := cursorLine + 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine
- ]
- ] ifFalse:[
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown
- ].
- cursorLine := cursorLine + 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisible.
- ].
-!
-
-cursorLeft
- "move cursor to left"
-
- (cursorCol == 1) ifFalse: [
- self withCursorOffDo:[cursorCol := cursorCol - 1]
- ].
- self makeCursorVisible.
-!
-
-cursorRight
- "move cursor to right"
-
- self withCursorOffDo:[cursorCol := cursorCol + 1].
- self makeCursorVisible.
-!
-
-cursorToBeginOfLine
- "move cursor to start of current line"
-
- self withCursorOffDo:[
- cursorCol := 1
- ].
- self makeCursorVisible.
-!
-
-cursorToEndOfLine
- "move cursor to end of current line"
-
- self withCursorOffDo:[
- |line|
-
- list isNil ifTrue:[
- cursorCol := 1
- ] ifFalse:[
- line := list at:cursorLine.
- cursorCol := line size + 1
- ].
- self makeCursorVisible.
- ].
-!
-
-cursorTab
- "move cursor to next tabstop"
-
- self withCursorOffDo:[
- cursorCol := self nextTabAfter:cursorCol
- ].
- self makeCursorVisible.
-!
-
-cursorBacktab
- "move cursor to prev tabstop"
-
- self withCursorOffDo:[
- cursorCol := self prevTabBefore:cursorCol
- ].
- self makeCursorVisible.
-!
-
-cursorToNextWord
- "move the cursor to the beginning of the next word"
-
- |col line searching|
-
- (cursorLine > list size) ifTrue:[^ self].
- self wordAtLine:cursorLine col:cursorCol do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- line := endLine.
- col := endCol + 1.
- searching := true.
- [searching
- and:[(self characterAtLine:line col:col) isSeparator]] whileTrue:[
- self wordAtLine:line col:col do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- (line > list size) ifTrue:[
- "break out"
- searching := false
- ] ifFalse:[
- line := endLine.
- col := endCol + 1.
- ]
- ]
- ].
- self cursorLine:line col:col
- ]
-!
-
-cursorReturn
- "move cursor to start of next line; scroll if at end of visible text"
-
- self checkForExistingLine:(cursorLine + 1).
- cursorVisibleLine notNil ifTrue:[
- nFullLinesShown notNil ifTrue:[
- (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown]
- ]
- ].
- self withCursorOffDo:[
- cursorCol := 1.
- cursorLine := cursorLine + 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine
- ].
- self makeCursorVisible.
-!
-
-cursorVisibleLine:visibleLineNr col:colNr
- "put cursor to visibleline/col"
-
- self withCursorOffDo:[
- cursorLine := self visibleLineToAbsoluteLine:visibleLineNr.
- cursorVisibleLine := visibleLineNr.
- cursorCol := colNr.
- (cursorCol < 1) ifTrue:[
- cursorCol := 1
- ]
- ].
- self makeCursorVisible.
-!
-
-cursorX:x y:y
- "put cursor to position next to x/y coordinate in view"
-
- |line col|
-
- line := self visibleLineOfY:y.
- col := self colOfX:x inVisibleLine:line.
- self cursorVisibleLine:line col:col.
-!
-
-cursorLine:line col:col
- "this positions onto physical - not visible - line"
-
- self withCursorOffDo:[
- cursorLine := line.
- cursorVisibleLine := self listLineToVisibleLine:line.
- cursorCol := col.
- (cursorCol < 1) ifTrue:[
- cursorCol := 1
- ]
- ].
- self makeCursorVisible.
-!
-
-cursorToTop
- "move cursor to absolute home"
-
- self cursorLine:1 col:1
-!
-
-gotoLine:aLineNumber
- "position cursor onto line, aLineNumber.
- Make certain that this line is visible"
-
- self makeLineVisible:aLineNumber.
- self cursorLine:aLineNumber col:1
-! !
-
-!EditTextView methodsFor:'undo & again'!
-
-undo
- "currently not implemented"
-
- undoAction notNil ifTrue:[
- undoAction value
- ]
-!
-
-again
- "repeat the last action (which was a cut or replace).
- If current selection is not last string, search forward to
- next occurence of it before repeating the last operation."
-
- |s l c sel|
-
- lastString notNil ifTrue:[
- s := lastString asString.
- "remove final cr"
- s := s copyTo:(s size - 1).
-
- sel := self selection.
-
- "if we are already there (after a find), ommit search"
-
- (sel notNil and:[sel asString withoutSeparators = s]) ifTrue:[
- undoAction := [self insertLines:lastString atLine:cursorLine col:cursorCol].
- l := selectionStartLine "cursorLine".
- c := selectionStartCol "cursorCol".
- self deleteSelection.
- lastReplacement notNil ifTrue:[
- self insertLines:lastReplacement asStringCollection withCr:false.
- self selectFromLine:l col:c toLine:cursorLine col:(cursorCol - 1).
- ].
- ^ true
- ].
-
- self searchForwardFor:s startingAtLine:cursorLine col:cursorCol
- ifFound:
- [
- :line :col |
-
- self selectFromLine:line col:col
- toLine:line col:(col + s size - 1).
- self makeLineVisible:line.
- undoAction := [self insertLines:lastString atLine:line col:col].
-
- self deleteSelection.
- lastReplacement notNil ifTrue:[
- self insertLines:lastReplacement asStringCollection withCr:false.
- self selectFromLine:line col:col toLine:cursorLine col:(cursorCol - 1).
- ].
- ^ true
- ]
- ifAbsent:
- [
- self showNotFound.
- ^ false
- ]
- ]
-!
-
-multipleAgain
- "repeat the last action (which was a cut or replace) until search fails"
-
- [self again] whileTrue:[]
-! !
-
-!EditTextView methodsFor:'menu actions'!
-
-defaultForGotoLine
- "return a default value to show in the gotoLine box"
-
- cursorLine notNil ifTrue:[
- ^ cursorLine
- ].
- ^ super defaultForGotoLine
-!
-
-paste
- "paste copybuffer; if there is a selection, replace it.
- otherwise paste at cursor position. Replace is not done
- for originating by a paste, to allow multiple
- paste."
-
- |sel|
-
- ((self hasSelection == true) and:[typeOfSelection ~~ #paste]) ifTrue:[
- ^ self replace
- ].
- sel := self getTextSelection.
- sel notNil ifTrue:[
- self paste:sel.
- ]
-!
-
-replace
- "replace selection by copybuffer"
-
- |sel|
-
- sel := self getTextSelection.
- sel notNil ifTrue:[
- self replace:sel
- ]
-!
-
-cut
- "cut selection into copybuffer"
-
- |line col history sel|
-
- sel := self selection.
- sel notNil ifTrue:[
- lastString := sel.
- line := selectionStartLine.
- col := selectionStartCol.
- undoAction := [self insertLines:lastString atLine:line col:col].
-
- "
- remember in CopyBuffer
- "
- self setTextSelection:lastString.
-
- "
- append to DeleteHistory (if there is one)
- "
- history := Smalltalk at:#DeleteHistory.
- history notNil ifTrue:[
- history addAll:(lastString asStringCollection).
- history size > 1000 ifTrue:[
- history := history copyFrom:(history size - 1000)
- ].
- ].
-
- "
- now, delete it
- "
- self deleteSelection.
- lastReplacement := nil
- ] ifFalse:[
- "
- a cut without selection will search&cut again
- "
- self again
- ]
-!
-
-paste:someText
- "paste someText at cursor"
-
- |s startLine startCol|
-
- someText notNil ifTrue:[
- s := someText.
- s isString ifTrue:[
- s := s asStringCollection
- ] ifFalse:[
- (s isKindOf:StringCollection) ifFalse:[
- self warn:'selection not convertable to Text'.
- ^ self
- ]
- ].
- startLine := cursorLine.
- startCol := cursorCol.
- self insertLines:s asStringCollection withCr:false.
- self selectFromLine:startLine col:startCol
- toLine:cursorLine col:(cursorCol - 1).
- typeOfSelection := #paste.
- undoAction := [self cut].
- ]
-!
-
-replace:someText
- "replace selection by someText"
-
- |selected selectedString replacement replacementString
- cutOffSpace addSpace|
-
- selected := self selection.
- selected isNil ifTrue:[
- ^ self paste:someText
- ].
- self deleteSelection.
-
- "take care, if we replace a selection without space by a word selected
- with one - in this case we usually do not want the space.
- But, if we replace a word-selected selection by something without a
- space, we DO want the space added."
-
- cutOffSpace := false.
- addSpace := false.
-
- replacement := someText copy.
-
- selected size == 1 ifTrue:[
- selectedString := selected at:1.
- ].
- selectedString notNil ifTrue:[
- ((selectedString startsWith:' ') or:[selectedString endsWith:' ']) ifFalse:[
- "selection has no space"
-
- ((selectStyle == #wordleft) or:[selectStyle == #wordRight]) ifTrue:[
- cutOffSpace := true
- ]
- ] ifTrue:[
- addSpace := true
- ]
- ].
-
- replacement size == 1 ifTrue:[
- replacementString := replacement at:1.
- cutOffSpace ifTrue:[
- (replacementString startsWith:' ') ifTrue:[
- replacementString := replacementString withoutSpaces
- ].
- ] ifFalse:[
- selectStyle == #wordLeft ifTrue:[
- "want a space at left"
- (replacementString startsWith:' ') ifFalse:[
- replacementString := replacementString withoutSpaces.
- replacementString := ' ' , replacementString
- ]
- ].
- selectStyle == #wordRight ifTrue:[
- "want a space at right"
-
- (replacementString endsWith:' ') ifFalse:[
- replacementString := replacementString withoutSpaces.
- replacementString := replacementString , ' '
- ]
- ].
- ].
- replacement at:1 put: replacementString.
- self paste:replacement
- ] ifFalse:[
- self paste:someText.
- ].
- lastString := selectedString.
- lastReplacement := someText
-!
-
-showDeleted
- "open a readonly editor on all deleted text"
-
- |v|
-
- v := EditTextView openWith:(Smalltalk at:#ScratchBuffer).
- v readOnly.
- v topView label:'deleted text'.
-! !
-
-!EditTextView methodsFor:'selections'!
-
-unselect
- "forget and unhilight selection - must take care of cursor here"
-
- self withCursorOffDo:[
- super unselect
- ]
-!
-
-selectCursorLine
- "select cursorline up to cursor position"
-
- self selectFromLine:cursorLine col:1
- toLine:cursorLine col:cursorCol
-!
-
-selectWordUnderCursor
- "select the word under the cursor"
-
- self selectWordAtLine:cursorLine col:cursorCol
-!
-
-selectFromLine:startLine col:startCol toLine:endLine col:endCol
- "when a range is selected, position the cursor behind the selection
- for easier editing. Also typeOfSelection is nilled here."
-
- super selectFromLine:startLine col:startCol toLine:endLine col:endCol.
- self cursorLine:selectionEndLine col:(selectionEndCol + 1).
- typeOfSelection := nil
-!
-
-selectAll
- "select the whole text.
- redefined to send super selectFrom... since we dont want the
- cursor to be moved in this case."
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- super selectFromLine:1 col:1 toLine:(list size + 1) col:0.
- typeOfSelection := nil
- ]
-!
-
-selectFromBeginning
- "select the text from the beginning to the current cursor position."
-
- |col|
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- cursorCol == 0 ifTrue:[
- col := 0
- ] ifFalse:[
- col := cursorCol - 1
- ].
- super selectFromLine:1 col:1 toLine:cursorLine col:col.
- typeOfSelection := nil
- ]
-!
-
-selectUpToEnd
- "select the text from the current cursor position to the end."
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- super selectFromLine:cursorLine col:cursorCol toLine:(list size + 1) col:0.
- typeOfSelection := nil
- ]
-! !
-
-!EditTextView methodsFor:'scrolling'!
-
-originWillChange
- "sent before scrolling - have to hide the cursor"
-
- prevCursorState := cursorShown.
- cursorShown ifTrue:[
- self hideCursor
- ]
-!
-
-originChanged:delta
- "sent after scrolling - have to show the cursor if it was on before"
-
- super originChanged:delta.
- "
- should we move the cursor with the scroll - or leave it ?
- "
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- prevCursorState ifTrue:[
- self showCursor
- ]
-!
-
-pageUp
- "page up - to keep cursor on same visible line, it has to be moved
- within the real text "
-
- |prevCursorLine|
-
- prevCursorLine := cursorVisibleLine.
- super pageUp.
- self cursorVisibleLine:prevCursorLine col:cursorCol
-!
-
-pageDown
- "page down - to keep cursor on same visible line, it has to be moved
- within the real text "
-
- |prevCursorLine|
-
- prevCursorLine := cursorVisibleLine.
- super pageDown.
- self cursorVisibleLine:prevCursorLine col:cursorCol
-! !
-
-!EditTextView methodsFor:'searching'!
-
-setSearchPattern
- "set the searchpattern from the selection if there is one, and position
- cursor to start of pattern"
-
- |sel|
-
- "if last operation was a replcae, set pattern to last
- original string (for search after again)"
-
- (lastString notNil and:[lastReplacement notNil]) ifTrue:[
- searchPattern := lastString asString withoutSeparators.
- ^ self
- ].
-
- sel := self selection.
- sel notNil ifTrue:[
- self cursorLine:selectionStartLine col:selectionStartCol.
- searchPattern := sel asString withoutSeparators
- ]
-!
-
-searchFwd:pattern ifAbsent:aBlock
- "do a forward search"
-
- self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock
-!
-
-searchFwd:pattern startingAtLine:startLine col:startCol ifAbsent:aBlock
- "do a forward search"
-
- cursorLine isNil ifTrue:[^ self].
- self searchForwardFor:pattern startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self cursorLine:line col:col.
- self selectFromLine:line col:col
- toLine:line col:(col + pattern size - 1).
- self makeLineVisible:cursorLine
- ] ifAbsent:aBlock
-!
-
-searchBwd:pattern ifAbsent:aBlock
- "do a backward search"
-
- |startLine startCol|
-
- cursorLine isNil ifTrue:[^ self].
- selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- startCol := selectionStartCol
- ] ifFalse:[
- startLine := cursorLine min:list size.
- startCol := cursorCol
- ].
- self searchBackwardFor:pattern startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self cursorLine:line col:col.
- self selectFromLine:line col:col
- toLine:line col:(col + pattern size - 1).
- self makeLineVisible:cursorLine
- ] ifAbsent:aBlock
-!
-
-searchForMatchingParenthesisFromLine:startLine col:startCol
- ifFound:foundBlock
- ifNotFound:notFoundBlock
- onError:failBlock
-
- "search for a matching parenthesis, parChar is one of '$( $[ ${ $) $] $}'.
- Search for the corresponding character is done forward if its an opening,
- backwards if its a closing parenthesis.
- Performs foundBlock with line/col as argument if found, notFoundBlock if not.
- If there is a nesting error, performs failBlock."
-
- |i direction lineString line col parChar charSet ignoreSet closingChar
- ignoring delta endCol cc incSet decSet nesting maxLine|
-
- charSet := #( $( $) $[ $] ${ $} ).
- ignoreSet := #( $' $" ).
-
- parChar := self characterAtLine:startLine col:startCol.
- i := charSet indexOf:parChar.
- i == 0 ifTrue:[
- ^ failBlock value "not a parenthesis"
- ].
- direction := #( fwd bwd fwd bwd fwd bwd) at:i.
- closingChar := #( $) $( $] $[ $} ${ ) at:i.
-
- col := startCol.
- line := startLine.
- direction == #fwd ifTrue:[
- delta := 1.
- incSet := #( $( $[ ${ ).
- decSet := #( $) $] $} ).
- ] ifFalse:[
- delta := -1.
- incSet := #( $) $] $} ).
- decSet := #( $( $[ ${ ).
- ].
-
- nesting := 1.
- ignoring := false.
- lineString := list at:line.
- maxLine := list size.
-
- col := col + delta.
- [nesting ~~ 0] whileTrue:[
- lineString notNil ifTrue:[
- direction == #fwd ifTrue:[
- endCol := lineString size.
- ] ifFalse:[
- endCol := 1
- ].
- col to:endCol by:delta do:[:runCol |
- cc := lineString at:runCol.
-
- (ignoreSet includes:cc) ifTrue:[
- ignoring := ignoring not
- ].
- ignoring ifFalse:[
- (incSet includes:cc) ifTrue:[
- nesting := nesting + 1
- ] ifFalse:[
- (decSet includes:cc) ifTrue:[
- nesting := nesting - 1
- ]
- ]
- ].
- nesting == 0 ifTrue:[
- "check if legal"
-
- cc == closingChar ifFalse:[
- ^ failBlock value
- ].
- ^ foundBlock value:line value:runCol.
- ]
- ].
- ].
- line := line + delta.
- (line < 1 or:[line > maxLine]) ifTrue:[
- ^ failBlock value
- ].
- lineString := list at:line.
- direction == #fwd ifTrue:[
- col := 1
- ] ifFalse:[
- col := lineString size
- ]
- ].
-
- ^ notFoundBlock value
-!
-
-searchForMatchingParenthesis
- "search for a matching parenthesis starting at cursor position.
- Search for the corresponding character is done forward if its an opening,
- backwards if its a closing parenthesis.
- Positions the cursor if found, peeps if not"
-
- self searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
- ifFound:[:line :col | self cursorLine:line col:col]
- ifNotFound:[self showNotFound]
- onError:[device beep]
-!
-
-searchForAndSelectMatchingParenthesis
- "select characters enclosed by matching parenthesis if one is under cusor"
-
- self searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
- ifFound:[:line :col |
- self selectFromLine:cursorLine col:cursorCol
- toLine:line col:col
- ]
- ifNotFound:[self showNotFound]
- onError:[device beep]
-! !
-
-!EditTextView methodsFor:'redrawing'!
-
-redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
- "redraw the cursor, if it sits in a line range"
-
- cursorShown ifTrue:[
- cursorVisibleLine notNil ifTrue:[
- (cursorVisibleLine between:startVisLine and:endVisLine) ifTrue:[
- self drawCursorCharacter
- ]
- ]
- ]
-!
-
-redrawCursorIfInVisibleLine:visLine
- "redraw the cursor, if it sits in visible line"
-
- cursorShown ifTrue:[
- (visLine == cursorVisibleLine) ifTrue:[
- self drawCursorCharacter
- ]
- ]
-!
-
-redrawFromVisibleLine:startVisLine to:endVisLine
- "redraw a visible line range"
-
- super redrawFromVisibleLine:startVisLine to:endVisLine.
- self redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
-!
-
-redrawVisibleLine:visLine col:colNr
- "redraw the single character in visibleline at colNr"
-
- cursorShown ifTrue:[
- (visLine == cursorVisibleLine) ifTrue:[
- (colNr == cursorCol) ifTrue:[
- self drawCursorCharacter.
- ^ self
- ]
- ]
- ].
- super redrawVisibleLine:visLine col:colNr
-!
-
-redrawVisibleLine:visLine
- "redraw a visible line"
-
- super redrawVisibleLine:visLine.
- self redrawCursorIfInVisibleLine:visLine
-!
-
-redrawVisibleLine:visLine from:startCol
- "redraw a visible line from startCol to the end of line"
-
- super redrawVisibleLine:visLine from:startCol.
- self redrawCursorIfInVisibleLine:visLine
-!
-
-redrawVisibleLine:visLine from:startCol to:endCol
- "redraw a visible line from startCol to endCol"
-
- super redrawVisibleLine:visLine from:startCol to:endCol.
- self redrawCursorIfInVisibleLine:visLine
! !
!EditTextView methodsFor:'event processing'!
-sizeChanged:how
- "make certain, cursor is visible after the sizechange"
-
- |cv|
-
- cv := cursorVisibleLine.
- super sizeChanged:how.
- cv notNil ifTrue:[
- self makeLineVisible:cursorLine
- ]
+buttonRelease:button x:x y:y
+ "move the cursor to the click-position of previous button press"
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ typeOfSelection := nil.
+ selectionStartLine isNil ifTrue:[
+ clickCol notNil ifTrue:[
+ self cursorLine:clickLine col:clickCol
+ ]
+ ] ifFalse:[
+ lastString := nil. "new selection invalidates remembered string"
+ ].
+ self showCursor
+ ].
+ super buttonRelease:button x:x y:y
!
pointerEnter:state x:x y:y
@@ -2424,19 +1846,37 @@
super pointerLeave:state
!
+buttonPress:button x:x y:y
+ "hide the cursor when button is activated"
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ self hideCursor
+ ].
+ (button == #paste) ifTrue:[
+ self paste.
+ ^ self
+ ].
+ super buttonPress:button x:x y:y
+!
+
+sizeChanged:how
+ "make certain, cursor is visible after the sizechange"
+
+ |cv|
+
+ cv := cursorVisibleLine.
+ super sizeChanged:how.
+ cv notNil ifTrue:[
+ self makeLineVisible:cursorLine
+ ]
+!
+
showFocus
hasKeyboardFocus := true.
cursorShown ifTrue: [self drawCursor].
super showFocus
!
-showNoFocus
- hasKeyboardFocus := false.
- cursorShown ifTrue: [self drawCursor].
- super showNoFocus
-
-!
-
keyPress:key x:x y:y
"handle keyboard input"
@@ -2649,32 +2089,580 @@
super keyPress:key x:x y:y
!
-buttonPress:button x:x y:y
- "hide the cursor when button is activated"
-
- ((button == 1) or:[button == #select]) ifTrue:[
- self hideCursor
+showNoFocus
+ hasKeyboardFocus := false.
+ cursorShown ifTrue: [self drawCursor].
+ super showNoFocus
+
+! !
+
+!EditTextView methodsFor:'selections'!
+
+unselect
+ "forget and unhilight selection - must take care of cursor here"
+
+ self withCursorOffDo:[
+ super unselect
+ ]
+!
+
+selectFromLine:startLine col:startCol toLine:endLine col:endCol
+ "when a range is selected, position the cursor behind the selection
+ for easier editing. Also typeOfSelection is nilled here."
+
+ super selectFromLine:startLine col:startCol toLine:endLine col:endCol.
+ self cursorLine:selectionEndLine col:(selectionEndCol + 1).
+ typeOfSelection := nil
+!
+
+selectAll
+ "select the whole text.
+ redefined to send super selectFrom... since we dont want the
+ cursor to be moved in this case."
+
+ list isNil ifTrue:[
+ self unselect
+ ] ifFalse:[
+ super selectFromLine:1 col:1 toLine:(list size + 1) col:0.
+ typeOfSelection := nil
+ ]
+!
+
+selectCursorLine
+ "select cursorline up to cursor position"
+
+ self selectFromLine:cursorLine col:1
+ toLine:cursorLine col:cursorCol
+!
+
+selectWordUnderCursor
+ "select the word under the cursor"
+
+ self selectWordAtLine:cursorLine col:cursorCol
+!
+
+selectFromBeginning
+ "select the text from the beginning to the current cursor position."
+
+ |col|
+
+ list isNil ifTrue:[
+ self unselect
+ ] ifFalse:[
+ cursorCol == 0 ifTrue:[
+ col := 0
+ ] ifFalse:[
+ col := cursorCol - 1
+ ].
+ super selectFromLine:1 col:1 toLine:cursorLine col:col.
+ typeOfSelection := nil
+ ]
+!
+
+selectUpToEnd
+ "select the text from the current cursor position to the end."
+
+ list isNil ifTrue:[
+ self unselect
+ ] ifFalse:[
+ super selectFromLine:cursorLine col:cursorCol toLine:(list size + 1) col:0.
+ typeOfSelection := nil
+ ]
+! !
+
+!EditTextView methodsFor:'formatting'!
+
+indent
+ "indent selected line-range"
+
+ |start end|
+
+ selectionStartLine isNil ifTrue:[^ self].
+ start := selectionStartLine.
+ end := selectionEndLine.
+ (selectionEndCol == 0) ifTrue:[
+ end := end - 1
+ ].
+ self unselect.
+ self indentFromLine:start toLine:end
+!
+
+indentFromLine:start toLine:end
+ "indent a line-range - this is don by searching for the
+ last non-empty line before start, and change the indent
+ of the line based on that indent."
+
+ |leftStart lnr delta d line spaces|
+
+ "find a line to base indent on..."
+ leftStart := 0.
+ lnr := start.
+ [(leftStart == 0) and:[lnr ~~ 1]] whileTrue:[
+ lnr := lnr - 1.
+ leftStart := self leftIndentOfLine:lnr
+ ].
+
+ (leftStart == 0) ifTrue:[^ self].
+
+ delta := leftStart - (self leftIndentOfLine:start).
+ (delta == 0) ifTrue:[^ self].
+ (delta > 0) ifTrue:[
+ 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.
+ ]
+ ]
].
- (button == #paste) ifTrue:[
- self paste.
+ self redrawFromLine:start to:end
+! !
+
+!EditTextView methodsFor:'undo & again'!
+
+undo
+ "currently not implemented"
+
+ undoAction notNil ifTrue:[
+ undoAction value
+ ]
+!
+
+again
+ "repeat the last action (which was a cut or replace).
+ If current selection is not last string, search forward to
+ next occurence of it before repeating the last operation."
+
+ |s l c sel|
+
+ lastString notNil ifTrue:[
+ s := lastString asString.
+ "remove final cr"
+ s := s copyTo:(s size - 1).
+
+ sel := self selection.
+
+ "if we are already there (after a find), ommit search"
+
+ (sel notNil and:[sel asString withoutSeparators = s]) ifTrue:[
+ undoAction := [self insertLines:lastString atLine:cursorLine col:cursorCol].
+ l := selectionStartLine "cursorLine".
+ c := selectionStartCol "cursorCol".
+ self deleteSelection.
+ lastReplacement notNil ifTrue:[
+ self insertLines:lastReplacement asStringCollection withCr:false.
+ self selectFromLine:l col:c toLine:cursorLine col:(cursorCol - 1).
+ ].
+ ^ true
+ ].
+
+ self searchForwardFor:s startingAtLine:cursorLine col:cursorCol
+ ifFound:
+ [
+ :line :col |
+
+ self selectFromLine:line col:col
+ toLine:line col:(col + s size - 1).
+ self makeLineVisible:line.
+ undoAction := [self insertLines:lastString atLine:line col:col].
+
+ self deleteSelection.
+ lastReplacement notNil ifTrue:[
+ self insertLines:lastReplacement asStringCollection withCr:false.
+ self selectFromLine:line col:col toLine:cursorLine col:(cursorCol - 1).
+ ].
+ ^ true
+ ]
+ ifAbsent:
+ [
+ self showNotFound.
+ ^ false
+ ]
+ ]
+!
+
+multipleAgain
+ "repeat the last action (which was a cut or replace) until search fails"
+
+ [self again] whileTrue:[]
+! !
+
+!EditTextView methodsFor:'menu actions'!
+
+paste
+ "paste copybuffer; if there is a selection, replace it.
+ otherwise paste at cursor position. Replace is not done
+ for originating by a paste, to allow multiple
+ paste."
+
+ |sel|
+
+ ((self hasSelection == true) and:[typeOfSelection ~~ #paste]) ifTrue:[
+ ^ self replace
+ ].
+ sel := self getTextSelection.
+ sel notNil ifTrue:[
+ self paste:sel.
+ ]
+!
+
+cut
+ "cut selection into copybuffer"
+
+ |line col history sel|
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ lastString := sel.
+ line := selectionStartLine.
+ col := selectionStartCol.
+ undoAction := [self insertLines:lastString atLine:line col:col].
+
+ "
+ remember in CopyBuffer
+ "
+ self setTextSelection:lastString.
+
+ "
+ append to DeleteHistory (if there is one)
+ "
+ history := Smalltalk at:#DeleteHistory.
+ history notNil ifTrue:[
+ history addAll:(lastString asStringCollection).
+ history size > 1000 ifTrue:[
+ history := history copyFrom:(history size - 1000)
+ ].
+ ].
+
+ "
+ now, delete it
+ "
+ self deleteSelection.
+ lastReplacement := nil
+ ] ifFalse:[
+ "
+ a cut without selection will search&cut again
+ "
+ self again
+ ]
+!
+
+defaultForGotoLine
+ "return a default value to show in the gotoLine box"
+
+ cursorLine notNil ifTrue:[
+ ^ cursorLine
+ ].
+ ^ super defaultForGotoLine
+!
+
+replace
+ "replace selection by copybuffer"
+
+ |sel|
+
+ sel := self getTextSelection.
+ sel notNil ifTrue:[
+ self replace:sel
+ ]
+!
+
+paste:someText
+ "paste someText at cursor"
+
+ |s startLine startCol|
+
+ someText notNil ifTrue:[
+ s := someText.
+ s isString ifTrue:[
+ s := s asStringCollection
+ ] ifFalse:[
+ (s isKindOf:StringCollection) ifFalse:[
+ self warn:'selection not convertable to Text'.
+ ^ self
+ ]
+ ].
+ startLine := cursorLine.
+ startCol := cursorCol.
+ self insertLines:s asStringCollection withCr:false.
+ self selectFromLine:startLine col:startCol
+ toLine:cursorLine col:(cursorCol - 1).
+ typeOfSelection := #paste.
+ undoAction := [self cut].
+ ]
+!
+
+replace:someText
+ "replace selection by someText"
+
+ |selected selectedString replacement replacementString
+ cutOffSpace addSpace|
+
+ selected := self selection.
+ selected isNil ifTrue:[
+ ^ self paste:someText
+ ].
+ self deleteSelection.
+
+ "take care, if we replace a selection without space by a word selected
+ with one - in this case we usually do not want the space.
+ But, if we replace a word-selected selection by something without a
+ space, we DO want the space added."
+
+ cutOffSpace := false.
+ addSpace := false.
+
+ replacement := someText copy.
+
+ selected size == 1 ifTrue:[
+ selectedString := selected at:1.
+ ].
+ selectedString notNil ifTrue:[
+ ((selectedString startsWith:' ') or:[selectedString endsWith:' ']) ifFalse:[
+ "selection has no space"
+
+ ((selectStyle == #wordleft) or:[selectStyle == #wordRight]) ifTrue:[
+ cutOffSpace := true
+ ]
+ ] ifTrue:[
+ addSpace := true
+ ]
+ ].
+
+ replacement size == 1 ifTrue:[
+ replacementString := replacement at:1.
+ cutOffSpace ifTrue:[
+ (replacementString startsWith:' ') ifTrue:[
+ replacementString := replacementString withoutSpaces
+ ].
+ ] ifFalse:[
+ selectStyle == #wordLeft ifTrue:[
+ "want a space at left"
+ (replacementString startsWith:' ') ifFalse:[
+ replacementString := replacementString withoutSpaces.
+ replacementString := ' ' , replacementString
+ ]
+ ].
+ selectStyle == #wordRight ifTrue:[
+ "want a space at right"
+
+ (replacementString endsWith:' ') ifFalse:[
+ replacementString := replacementString withoutSpaces.
+ replacementString := replacementString , ' '
+ ]
+ ].
+ ].
+ replacement at:1 put: replacementString.
+ self paste:replacement
+ ] ifFalse:[
+ self paste:someText.
+ ].
+ lastString := selectedString.
+ lastReplacement := someText
+!
+
+showDeleted
+ "open a readonly editor on all deleted text"
+
+ |v|
+
+ v := EditTextView openWith:(Smalltalk at:#ScratchBuffer).
+ v readOnly.
+ v topView label:'deleted text'.
+! !
+
+!EditTextView methodsFor:'searching'!
+
+setSearchPattern
+ "set the searchpattern from the selection if there is one, and position
+ cursor to start of pattern"
+
+ |sel|
+
+ "if last operation was a replcae, set pattern to last
+ original string (for search after again)"
+
+ (lastString notNil and:[lastReplacement notNil]) ifTrue:[
+ searchPattern := lastString asString withoutSeparators.
^ self
].
- super buttonPress:button x:x y:y
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ self cursorLine:selectionStartLine col:selectionStartCol.
+ searchPattern := sel asString withoutSeparators
+ ]
+!
+
+searchFwd:pattern startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
+ cursorLine isNil ifTrue:[^ self].
+ self searchForwardFor:pattern startingAtLine:startLine col:startCol
+ ifFound:[:line :col |
+ self cursorLine:line col:col.
+ self selectFromLine:line col:col
+ toLine:line col:(col + pattern size - 1).
+ self makeLineVisible:cursorLine
+ ] ifAbsent:aBlock
+!
+
+searchFwd:pattern ifAbsent:aBlock
+ "do a forward search"
+
+ self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock
+!
+
+searchBwd:pattern ifAbsent:aBlock
+ "do a backward search"
+
+ |startLine startCol|
+
+ cursorLine isNil ifTrue:[^ self].
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ startLine := cursorLine min:list size.
+ startCol := cursorCol
+ ].
+ self searchBackwardFor:pattern startingAtLine:startLine col:startCol
+ ifFound:[:line :col |
+ self cursorLine:line col:col.
+ self selectFromLine:line col:col
+ toLine:line col:(col + pattern size - 1).
+ self makeLineVisible:cursorLine
+ ] ifAbsent:aBlock
!
-buttonRelease:button x:x y:y
- "move the cursor to the click-position of previous button press"
-
- ((button == 1) or:[button == #select]) ifTrue:[
- typeOfSelection := nil.
- selectionStartLine isNil ifTrue:[
- clickCol notNil ifTrue:[
- self cursorLine:clickLine col:clickCol
- ]
+searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+
+ "search for a matching parenthesis, parChar is one of '$( $[ ${ $) $] $}'.
+ Search for the corresponding character is done forward if its an opening,
+ backwards if its a closing parenthesis.
+ Performs foundBlock with line/col as argument if found, notFoundBlock if not.
+ If there is a nesting error, performs failBlock."
+
+ |i direction lineString line col parChar charSet ignoreSet closingChar
+ ignoring delta endCol cc incSet decSet nesting maxLine|
+
+ charSet := #( $( $) $[ $] ${ $} ).
+ ignoreSet := #( $' $" ).
+
+ parChar := self characterAtLine:startLine col:startCol.
+ i := charSet indexOf:parChar.
+ i == 0 ifTrue:[
+ ^ failBlock value "not a parenthesis"
+ ].
+ direction := #( fwd bwd fwd bwd fwd bwd) at:i.
+ closingChar := #( $) $( $] $[ $} ${ ) at:i.
+
+ col := startCol.
+ line := startLine.
+ direction == #fwd ifTrue:[
+ delta := 1.
+ incSet := #( $( $[ ${ ).
+ decSet := #( $) $] $} ).
+ ] ifFalse:[
+ delta := -1.
+ incSet := #( $) $] $} ).
+ decSet := #( $( $[ ${ ).
+ ].
+
+ nesting := 1.
+ ignoring := false.
+ lineString := list at:line.
+ maxLine := list size.
+
+ col := col + delta.
+ [nesting ~~ 0] whileTrue:[
+ lineString notNil ifTrue:[
+ direction == #fwd ifTrue:[
+ endCol := lineString size.
+ ] ifFalse:[
+ endCol := 1
+ ].
+ col to:endCol by:delta do:[:runCol |
+ cc := lineString at:runCol.
+
+ (ignoreSet includes:cc) ifTrue:[
+ ignoring := ignoring not
+ ].
+ ignoring ifFalse:[
+ (incSet includes:cc) ifTrue:[
+ nesting := nesting + 1
+ ] ifFalse:[
+ (decSet includes:cc) ifTrue:[
+ nesting := nesting - 1
+ ]
+ ]
+ ].
+ nesting == 0 ifTrue:[
+ "check if legal"
+
+ cc == closingChar ifFalse:[
+ ^ failBlock value
+ ].
+ ^ foundBlock value:line value:runCol.
+ ]
+ ].
+ ].
+ line := line + delta.
+ (line < 1 or:[line > maxLine]) ifTrue:[
+ ^ failBlock value
+ ].
+ lineString := list at:line.
+ direction == #fwd ifTrue:[
+ col := 1
] ifFalse:[
- lastString := nil. "new selection invalidates remembered string"
- ].
- self showCursor
+ col := lineString size
+ ]
].
- super buttonRelease:button x:x y:y
+
+ ^ notFoundBlock value
+!
+
+searchForMatchingParenthesis
+ "search for a matching parenthesis starting at cursor position.
+ Search for the corresponding character is done forward if its an opening,
+ backwards if its a closing parenthesis.
+ Positions the cursor if found, peeps if not"
+
+ self searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
+ ifFound:[:line :col | self cursorLine:line col:col]
+ ifNotFound:[self showNotFound]
+ onError:[device beep]
+!
+
+searchForAndSelectMatchingParenthesis
+ "select characters enclosed by matching parenthesis if one is under cusor"
+
+ self searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
+ ifFound:[:line :col |
+ self selectFromLine:cursorLine col:cursorCol
+ toLine:line col:col
+ ]
+ ifNotFound:[self showNotFound]
+ onError:[device beep]
! !
+
--- a/EditField.st Sat Mar 18 06:16:33 1995 +0100
+++ b/EditField.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,20 +10,22 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:15:37 am'!
+
EditTextView subclass:#EditField
- instanceVariableNames:'leaveAction enabled enableAction'
- classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
- DefaultSelectionForegroundColor DefaultSelectionBackgroundColor
- DefaultFont'
- poolDictionaries:''
- category:'Views-Text'
+ instanceVariableNames:'leaveAction enabled enableAction'
+ classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
+ DefaultSelectionForegroundColor DefaultSelectionBackgroundColor
+ DefaultFont'
+ poolDictionaries:''
+ category:'Views-Text'
!
EditField comment:'
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.13 1995-03-06 19:28:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.14 1995-03-18 05:14:20 claus Exp $
'!
!EditField class methodsFor:'documentation'!
@@ -44,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.13 1995-03-06 19:28:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.14 1995-03-18 05:14:20 claus Exp $
"
!
@@ -61,12 +63,6 @@
!EditField class methodsFor:'defaults'!
-defaultNumberOfLines
- "the number of lines in the field"
-
- ^ 1
-!
-
updateStyleCache
DefaultForegroundColor := StyleSheet colorAt:'editFieldForegroundColor' default:Black.
DefaultBackgroundColor := StyleSheet colorAt:'editFieldBackgroundColor' default:White.
@@ -77,6 +73,12 @@
"
self updateStyleCache
"
+!
+
+defaultNumberOfLines
+ "the number of lines in the field"
+
+ ^ 1
! !
!EditField methodsFor:'initialization'!
@@ -183,17 +185,6 @@
^ w @ self height
! !
-!EditField methodsFor:'editing'!
-
-paste:someText
- "redefined to force text to 1 line"
-
- super paste:someText.
- list size > 1 ifTrue:[
- self deleteFromLine:2 toLine:(list size)
- ]
-! !
-
!EditField methodsFor:'accessing'!
list:someText
@@ -234,6 +225,12 @@
]
!
+leaveAction:aBlock
+ "define an action to be evaluated when field is left by return key"
+
+ leaveAction := aBlock
+!
+
disable
"disable the field; hide cursor and ignore input"
@@ -249,12 +246,6 @@
enableAction := aBlock
!
-leaveAction:aBlock
- "define an action to be evaluated when field is left by return key"
-
- leaveAction := aBlock
-!
-
initialText:aString selected:aBoolean
"set the initialText and select it if aBoolean is true"
@@ -275,6 +266,17 @@
self initialText:aString selected:true
! !
+!EditField methodsFor:'editing'!
+
+paste:someText
+ "redefined to force text to 1 line"
+
+ super paste:someText.
+ list size > 1 ifTrue:[
+ self deleteFromLine:2 toLine:(list size)
+ ]
+! !
+
!EditField methodsFor:'cursor drawing'!
showCursor
@@ -307,13 +309,13 @@
return was pressed."
enabled ifTrue:[
- leaveAction notNil ifTrue:[
- leaveAction value:#Return
- ].
- "model-view behavior"
- (model notNil and:[aspectSymbol notNil]) ifTrue:[
- model perform:aspectSymbol with:(self contents).
- ].
+ leaveAction notNil ifTrue:[
+ leaveAction value:#Return
+ ].
+ "model-view behavior"
+ (model notNil and:[changeSymbol notNil]) ifTrue:[
+ model perform:changeSymbol with:(self contents).
+ ].
].
!
@@ -331,16 +333,6 @@
]
!
-canHandle:aKey
- "return true, if the receiver would like to handle aKey
- (usually from another view, when the receiver is part of
- a more complex dialog box).
- We do return true here, since the editfield will handle
- all keys."
-
- ^ true
-!
-
keyPress:key x:x y:y
"if keyHandler is defined, pass input; otherwise check for leave
keys"
@@ -348,20 +340,20 @@
|leave xCol newOffset oldWidth newWidth|
enabled ifFalse:[
- (keyboardHandler notNil
- and:[keyboardHandler canHandle:key]) ifTrue:[
- (keyboardHandler == self) ifTrue:[
- self error:'invalid keyhandler'.
- ^ self
- ].
- keyboardHandler keyPress:key x:x y:y
- ].
- ^ self
+ (keyboardHandler notNil
+ and:[keyboardHandler canHandle:key]) ifTrue:[
+ (keyboardHandler == self) ifTrue:[
+ self error:'invalid keyhandler'.
+ ^ self
+ ].
+ keyboardHandler keyPress:key x:x y:y
+ ].
+ ^ self
].
(key == #DeleteLine) ifTrue:[
- Smalltalk at:#CopyBuffer put:(self contents).
- self contents:''. ^ self
+ Smalltalk at:#CopyBuffer put:(self contents).
+ self contents:''. ^ self
].
leave := false.
@@ -371,8 +363,11 @@
((key == #CursorUp) or:[key == #Prior]) ifTrue:[leave := true].
leave ifTrue:[
- self accept.
- ^ self
+ self accept.
+ (superView canHandle:key) ifTrue:[
+ superView keyPress:key x:x y:y.
+ ].
+ ^ self
].
oldWidth := self widthOfContents.
@@ -384,11 +379,11 @@
"
xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
(xCol > (width * (5/6))) ifTrue:[
- self changed:#preferedExtent
+ self changed:#preferedExtent
] ifFalse:[
- newWidth < (width * (1/6)) ifTrue:[
- self changed:#preferedExtent
- ]
+ newWidth < (width * (1/6)) ifTrue:[
+ self changed:#preferedExtent
+ ]
].
"
@@ -397,17 +392,28 @@
"
xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
(xCol > (width * (5/6))) ifTrue:[
- newOffset := leftOffset + (width // 2).
+ newOffset := leftOffset + (width // 2).
] ifFalse:[
- (xCol < (width * (1/6))) ifTrue:[
- newOffset := 0 max: leftOffset - (width // 2).
- ] ifFalse:[
- newOffset := leftOffset
- ]
+ (xCol < (width * (1/6))) ifTrue:[
+ newOffset := 0 max: leftOffset - (width // 2).
+ ] ifFalse:[
+ newOffset := leftOffset
+ ]
].
newOffset ~~ leftOffset ifTrue:[
- leftOffset := newOffset.
- self clear.
- self redraw
+ leftOffset := newOffset.
+ self clear.
+ self redraw
]
+!
+
+canHandle:aKey
+ "return true, if the receiver would like to handle aKey
+ (usually from another view, when the receiver is part of
+ a more complex dialog box).
+ We do return true here, since the editfield will handle
+ all keys."
+
+ ^ true
! !
+
--- a/EditTextView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/EditTextView.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,29 +10,25 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:12:00 am'!
+
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'
- classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
- DefaultCursorType'
- poolDictionaries:''
- category:'Views-Text'
+ instanceVariableNames:'cursorLine cursorVisibleLine cursorCol cursorShown
+ prevCursorState readOnly modified fixedSize exceptionBlock
+ errorMessage cursorFgColor cursorBgColor cursorType undoAction
+ typeOfSelection lastString lastReplacement lastAction replacing
+ showMatchingParenthesis hasKeyboardFocus'
+ classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
+ DefaultCursorType'
+ poolDictionaries:''
+ category:'Views-Text'
!
EditTextView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.22 1995-03-06 19:28:18 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.23 1995-03-18 05:14:09 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -53,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.22 1995-03-06 19:28:18 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.23 1995-03-18 05:14:09 claus Exp $
"
!
@@ -101,8 +97,1621 @@
DefaultCursorType := StyleSheet at:'textCursorType' default:#block.
! !
+!EditTextView methodsFor:'private'!
+
+textChanged
+ "triggered whenever text has been edited (not to confuse with
+ contentsChanged, which is triggered when the size has changed, and
+ is used to notify scrollers, other views etc.)"
+
+ super contentsChanged.
+ modified := true.
+ contentsWasSaved := false
+! !
+
+!EditTextView methodsFor:'editing'!
+
+insert:aCharacter atLine:lineNr col:colNr
+ "insert a single character at lineNr/colNr"
+
+ |line lineSize newLine drawCharacterOnly|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ aCharacter == (Character cr) ifTrue:[
+ 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
+ ]
+ ].
+ (lineSize == 0) ifTrue: [
+ 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
+ ]
+ ].
+ newLine at:colNr put:aCharacter.
+ aCharacter == (Character tab) ifTrue:[
+ newLine := self withTabsExpanded:newLine.
+ drawCharacterOnly := false
+ ].
+ list at:lineNr put:newLine.
+ self textChanged.
+ shown ifTrue:[
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
+ ]
+!
+
+withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr
+ "insert aString (which has no crs) at lineNr/colNr"
+
+ |strLen line lineSize newLine|
+
+ aString isNil ifTrue:[^ self].
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ strLen := aString size.
+ self checkForExistingLine:lineNr.
+ line := list at:lineNr.
+ line notNil ifTrue:[
+ lineSize := line size
+ ] ifFalse:[
+ lineSize := 0
+ ].
+ ((colNr == 1) and:[lineSize == 0]) ifTrue: [
+ 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
+ ].
+
+ (aString occurrencesOf:(Character tab)) == 0 ifFalse:[
+ newLine := self withTabsExpanded:newLine
+ ].
+
+ list at:lineNr put:newLine.
+ self textChanged.
+
+!
+
+splitLine:lineNr before:colNr
+ "split the line linNr before colNr; the right part (from colNr)
+ is cut off and inserted after lineNr; the view is redrawn"
+
+ |line lineSize leftRest rightRest visLine w
+ 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.
+ ]
+ ]
+!
+
+withoutRedrawInsertLine:aString before:lineNr
+ "insert the argument, aString before line lineNr; the string
+ becomes line nileNr; everything else is moved down; the view
+ is not redrawn"
+
+ |line|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ line := aString.
+ line notNil ifTrue:[
+ line isBlank ifTrue:[
+ line := nil
+ ] ifFalse:[
+ (line occurrencesOf:(Character tab)) == 0 ifFalse:[
+ line := self withTabsExpanded:line
+ ]
+ ]
+ ].
+ list isNil ifTrue: [
+ list := StringCollection new:lineNr
+ ] ifFalse: [
+ list grow:((list size + 1) max:lineNr)
+ ].
+
+ "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
+ overlapping copy - if it didn't, we had to use:"
+"
+ index := list size.
+ [index > lineNr] whileTrue: [
+ pIndex := index - 1.
+ list at:index put:(list at:pIndex).
+ index := pIndex
+ ].
+"
+ list replaceFrom:(lineNr + 1) to:(list size) with:list startingAt:lineNr.
+ list at:lineNr put:line.
+!
+
+insertLines:someText from:start to:end before:lineNr
+ "insert a bunch of lines before line lineNr"
+
+ |visLine w nLines "{ Class: SmallInteger }"
+ srcY "{ Class: SmallInteger }"
+ dstY "{ Class: SmallInteger }" |
+
+ readOnly ifTrue:[
+ ^ 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
+ ] 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
+ ].
+ self textChanged.
+!
+
+deleteFromLine:startLine col:startCol toLine:endLine col:endCol
+ "delete all text from startLine/startCol to endLine/endCol -
+ joining lines if nescessary"
+
+ |line lineSize|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ list isNil ifTrue:[^ self].
+
+ (startLine == endLine) ifTrue:[
+ "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 right rest of 1st line"
+ self deleteCharsAtLine:startLine fromCol:startCol.
+
+ "delete the inner lines ..."
+ endLine > (startLine + 1) ifTrue:[
+ 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.
+ ]
+ ].
+
+ "merge the left rest of 1st line with right rest of last line into one"
+ self mergeLine:startLine
+!
+
+insertStringAtCursor:aString
+ "insert the argument, aString at cursor position
+ handle cr's correctly. A nil argument is interpreted as an empty line."
+
+ |start " { Class: SmallInteger }"
+ stop " { Class: SmallInteger }"
+ end " { Class: SmallInteger }"
+ subString|
+
+ aString isNil ifTrue:[
+ "new:"
+ self insertCharAtCursor:(Character cr).
+ ^ self
+ ].
+ ((aString occurrencesOf:(Character cr)) == 0) ifTrue:[
+ ^ self insertStringWithoutCRsAtCursor:aString
+ ].
+
+ self insertLines:aString asStringCollection withCr:false.
+
+"/ start := 1.
+"/ end := aString size.
+"/ "insert the 1st line"
+"/ (cursorCol ~~ 1) ifTrue:[
+"/ stop := aString indexOf:(Character cr) startingAt:start.
+"/ stop == 0 ifTrue:[
+"/ stop := end + 1
+"/ ].
+"/ subString := aString copyFrom:start to:(stop - 1).
+"/ self insertStringWithoutCRsAtCursor:subString.
+"/ self insertCharAtCursor:(Character cr).
+"/ start := stop + 1
+"/ ].
+"/ "insert the block of full lines"
+"/
+"/ [start <= end] whileTrue:[
+"/ stop := aString indexOf:(Character cr) startingAt:start.
+"/ stop == 0 ifTrue:[
+"/ stop := end + 1
+"/ ].
+"/ subString := aString copyFrom:start to:(stop - 1).
+"/ self insertStringWithoutCRsAtCursor:subString.
+"/ (stop < end) ifTrue:[
+"/ self insertCharAtCursor:(Character cr)
+"/ ].
+"/ start := stop + 1
+"/ ]
+!
+
+insertLines:lines withCr:withCr
+ "insert a bunch of lines at cursor position. Cursor
+ is moved behind insertion.
+ If withCr is true, append cr after last line"
+
+ |start end nLines|
+
+ lines notNil ifTrue:[
+ nLines := lines size.
+ (nLines == 1) ifTrue:[
+ self insertStringAtCursor:(lines at:1).
+ withCr ifTrue:[
+ self insertCharAtCursor:(Character cr)
+ ]
+ ] ifFalse:[
+ (cursorCol ~~ 1) ifTrue:[
+ self insertStringAtCursor:(lines at:1).
+ self insertCharAtCursor:(Character cr).
+ start := 2
+ ] ifFalse:[
+ start := 1
+ ].
+ withCr ifTrue:[
+ end := nLines
+ ] ifFalse:[
+ end := nLines - 1
+ ].
+ (start < nLines) ifTrue:[
+ (end >= start) ifTrue:[
+ self withCursorOffDo:[
+ self insertLines:lines
+ from:start to:end
+ before:cursorLine.
+ cursorLine := cursorLine + (end - start + 1).
+ cursorVisibleLine := self absoluteLineToVisibleLine:
+ cursorLine
+ ]
+ ]
+ ].
+ withCr ifFalse:[
+ "last line without cr"
+ self insertStringAtCursor:(lines at:nLines)
+ ]
+ ]
+ ]
+!
+
+insertStringWithoutCRsAtCursor:aString
+ "insert a string (which has no crs) at cursor position
+ - advance cursor"
+
+ aString notNil ifTrue:[
+ self withCursorOffDo:[
+ self insertString:aString atLine:cursorLine col:cursorCol.
+ cursorCol := cursorCol + aString size
+ ]
+ ]
+!
+
+withoutRedrawInsertLines:lines from:start to:end before:lineNr
+ "insert a bunch of lines before line lineNr; the view
+ is not redrawn"
+
+ |newLine newLines nLines|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+
+ nLines := end - start + 1.
+ newLines := Array new:(lines size).
+ start to:end do:[:index |
+ newLine := lines at:index.
+ newLine notNil ifTrue:[
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ] ifFalse:[
+ (newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
+ newLine := self withTabsExpanded:newLine
+ ]
+ ]
+ ].
+ newLines at:index put:newLine
+ ].
+ list isNil ifTrue: [
+ list := StringCollection new:(lineNr + nLines + 1)
+ ] ifFalse: [
+ list grow:((list size + nLines) max:(lineNr + nLines - 1))
+ ].
+
+ "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
+ overlapping copy - if it didn't, we had to use:"
+"
+ index := list size.
+ [index > lineNr] whileTrue: [
+ pIndex := index - 1.
+ list at:index put:(list at:pIndex).
+ index := pIndex
+ ].
+"
+ list replaceFrom:(lineNr + nLines) to:(list size) with:list startingAt:lineNr.
+ 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"
+
+ self withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
+ shown ifTrue:[self redrawLine:lineNr from:colNr]
+!
+
+insertString:aString atLine:lineNr col:colNr
+ "insert the string, aString at line/col;
+ handle cr's correctly"
+
+ |start "{ Class: SmallInteger }"
+ stop "{ Class: SmallInteger }"
+ end "{ Class: SmallInteger }"
+ subString c
+ l "{ Class: SmallInteger }" |
+
+
+ aString isNil ifTrue:[^ self].
+ ((aString occurrencesOf:(Character cr)) == 0) ifTrue:[
+ ^ self insertStringWithoutCRs:aString atLine:lineNr col:colNr
+ ].
+ l := lineNr.
+ c := colNr.
+ start := 1.
+ end := aString size.
+ [start <= end] whileTrue:[
+ stop := aString indexOf:(Character cr) startingAt:start.
+ stop == 0 ifTrue:[
+ stop := end + 1
+ ].
+ subString := aString copyFrom:start to:(stop - 1).
+ self insertStringWithoutCRs:subString atLine:l col:c.
+ (stop < end) ifTrue:[
+ c := c + subString size.
+ self insert:(Character cr) atLine:l col:c.
+ l := l + 1.
+ c := 1
+ ].
+ start := stop + 1
+ ]
+!
+
+insertCharAtCursor:aCharacter
+ "insert a single character at cursor-position - advance cursor"
+
+ self withCursorOffDo:[
+ self insert:aCharacter atLine:cursorLine col:cursorCol.
+ aCharacter == (Character cr) ifTrue:[
+ self cursorReturn
+ ] ifFalse:[
+ cursorCol := cursorCol + 1
+ ].
+ self makeCursorVisible
+ ]
+!
+
+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"
+
+ |visLine w
+ dstY "{ Class: SmallInteger }" |
+
+ visLine := self listLineToVisibleLine:lineNr.
+ (shown not or:[visLine isNil]) ifTrue:[
+ 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.
+ ].
+ self textChanged.
+!
+
+mergeLine:lineNr
+ "merge line lineNr with line lineNr+1"
+
+ |leftPart rightPart bothParts nextLineNr|
+
+ list isNil ifFalse:[
+ nextLineNr := lineNr + 1.
+ (nextLineNr > list size) ifFalse:[
+ (list at:lineNr) isNil ifTrue:[
+ leftPart := ''
+ ] ifFalse:[
+ leftPart := list at:lineNr
+ ].
+ (list at:nextLineNr) isNil ifTrue:[
+ rightPart := ''
+ ] ifFalse:[
+ rightPart := list at:nextLineNr
+ ].
+ bothParts := leftPart , rightPart.
+ bothParts isBlank ifTrue:[bothParts := nil].
+ list at:lineNr put:bothParts.
+ self redrawLine:lineNr.
+ self deleteLine:nextLineNr
+ ]
+ ]
+!
+
+insertSelectedStringAtCursor:aString
+ "insert the argument, aString at cursor position and select it"
+
+ |startLine startCol|
+
+ startLine := cursorLine.
+ startCol := cursorCol.
+ self insertStringAtCursor:aString.
+ self selectFromLine:startLine col:startCol
+ toLine:cursorLine col:(cursorCol - 1)
+!
+
+deleteCharAtLine:lineNr col:colNr
+ "delete single character at colNr in line lineNr"
+
+ |line lineSize newLine drawCharacterOnly|
+
+ 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.
+ (colNr > lineSize) ifTrue: [^ self].
+
+ drawCharacterOnly := false.
+ (colNr == lineSize) ifTrue:[
+ 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 isBlank ifTrue:[
+ newLine := nil
+ ].
+ list at:lineNr put:newLine.
+ self textChanged.
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
+!
+
+removeTrailingBlankLines
+ "remove all blank lines at end of text"
+
+ |lastLine "{ Class: SmallInteger }"
+ line finished|
+
+ 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 ~~ list size) ifTrue:[
+ list grow:lastLine.
+"/ self textChanged
+ ]
+!
+
+deleteCharsAtLine:lineNr toCol:colNr
+ "delete characters from start up to colNr 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.
+ (colNr >= lineSize) ifTrue:[
+ newLine := nil
+ ] ifFalse:[
+ newLine := line copyFrom:(colNr + 1) to:lineSize.
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ]
+ ].
+ list at:lineNr put:newLine.
+ self textChanged.
+ self redrawLine:lineNr
+!
+
+insertTabAtCursor
+ "insert spaces to next tab"
+
+ self withCursorOffDo:[
+ |nextTab|
+
+ nextTab := self nextTabAfter:cursorCol.
+ self insertStringAtCursor:(String new:(nextTab - cursorCol)).
+ self makeCursorVisible.
+ ].
+!
+
+deleteSelection
+ "delete the selection"
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ selectionStartLine notNil ifTrue:[
+ self withCursorOffDo:[
+ |startLine startCol endLine endCol|
+
+ startLine := selectionStartLine.
+ startCol := selectionStartCol.
+ endLine := selectionEndLine.
+ endCol := selectionEndCol.
+ self unselectWithoutRedraw.
+ self deleteFromLine:startLine col:startCol
+ toLine:endLine col:endCol.
+ cursorCol := startCol.
+ cursorLine := startLine.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ self makeCursorVisible
+ ]
+ ]
+!
+
+deleteLineWithoutRedraw:lineNr
+ "delete line - no redraw;
+ return true, if something was really deleted"
+
+ readOnly ifTrue:[
+ exceptionBlock value:errorMessage.
+ ^ false
+ ].
+ (list isNil or:[lineNr > list size]) ifTrue:[^ false].
+ list removeIndex:lineNr.
+ self textChanged.
+ ^ true
+!
+
+deleteLinesWithoutRedrawFrom:startLine to:endLine
+ "delete lines - no redraw;
+ return true, if something was really deleted"
+
+ |lastLine|
+
+ readOnly ifTrue:[
+ exceptionBlock value:errorMessage.
+ ^ false
+ ].
+ (list isNil or:[startLine > list size]) ifTrue:[^ false].
+ (endLine > list size) ifTrue:[
+ lastLine := list size
+ ] ifFalse:[
+ lastLine := endLine
+ ].
+ list removeFromIndex:startLine toIndex:lastLine.
+ self textChanged.
+ ^ true
+!
+
+deleteLine:lineNr
+ "delete line"
+
+ |visLine w
+ srcY "{ Class: SmallInteger }" |
+
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ (self deleteLineWithoutRedraw:lineNr) ifFalse:[^ self].
+ shown ifFalse:[^ self].
+ visLine := self listLineToVisibleLine:lineNr.
+ visLine notNil ifTrue:[
+ srcY := margin + 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.
+ (nFullLinesShown ~~ nLinesShown) ifTrue:[
+ self redrawVisibleLine:nLinesShown
+ ].
+ self waitForExpose
+ ]
+!
+
+deleteCursorLine
+ "delete the line where the cursor sits"
+
+ self withCursorOffDo:[
+ self deleteLine:cursorLine
+ ]
+!
+
+deleteCharsAtLine:lineNr fromCol:colNr
+ "delete characters from colNr up to the end in line lineNr"
+
+ |line newLine|
+
+ readOnly ifTrue: [
+ exceptionBlock value:errorMessage.
+ ^ self
+ ].
+ list isNil ifTrue: [^self].
+ (list size < lineNr) ifTrue: [^ self].
+ line := list at:lineNr.
+ line isNil ifTrue: [^self].
+ (colNr > line size) ifTrue: [^ self].
+ newLine := line copyTo:(colNr - 1).
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ].
+ list at:lineNr put:newLine.
+ self textChanged.
+ self redrawLine:lineNr
+!
+
+replaceSelectionBy:something
+ "delete the selection (if any) and insert something, a character or string;
+ leave cursor after insertion"
+
+ self replaceSelectionBy:something keepCursor:false
+!
+
+replaceSelectionBy:something keepCursor:keep
+ "delete the selection (if any) and insert something, a character or string;
+ leave cursor after insertion or leave it, depending on keep"
+
+ |sel l c|
+
+ l := cursorLine.
+ c := cursorCol.
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ lastString := sel.
+ self deleteSelection.
+ replacing := true.
+ lastReplacement := ''
+ ].
+ (something isMemberOf:Character) ifTrue:[
+ lastReplacement notNil ifTrue:[
+ (lastReplacement endsWith:Character space) ifTrue:[
+ lastReplacement := lastReplacement copyTo:(lastReplacement size - 1).
+ lastReplacement := lastReplacement copyWith:something.
+ lastReplacement := lastReplacement copyWith:Character space
+ ] ifFalse:[
+ lastReplacement := lastReplacement copyWith:something.
+ ]
+ ].
+ self insertCharAtCursor:something
+ ] ifFalse:[
+ lastReplacement := something.
+ self insertStringAtCursor:something
+ ].
+ keep ifTrue:[
+ self cursorLine:l col:c
+ ]
+!
+
+deleteCharBeforeCursor
+ "delete single character to the left of cursor and move cursor to left"
+
+ |oldSize lineNrAboveCursor|
+
+ (cursorCol == 1) ifFalse:[
+ self withCursorOffDo:[
+ cursorCol := cursorCol - 1.
+ self deleteCharAtLine:cursorLine col:cursorCol
+ ]
+ ] ifTrue:[
+ (cursorLine == 1) ifFalse:[
+ oldSize := 0.
+ lineNrAboveCursor := cursorLine - 1.
+ list notNil ifTrue:[
+ (list size >= lineNrAboveCursor) ifTrue:[
+ (list at:lineNrAboveCursor) notNil ifTrue:[
+ oldSize := (list at:lineNrAboveCursor) size
+ ]
+ ]
+ ].
+ self mergeLine:lineNrAboveCursor.
+ self withCursorOffDo:[
+ cursorLine := lineNrAboveCursor.
+ cursorCol := oldSize + 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine
+ ].
+ self makeCursorVisible
+ ]
+ ]
+!
+
+deleteCharAtCursor
+ "delete single character under cursor"
+
+ self withCursorOffDo:[
+ self deleteCharAtLine:cursorLine col:cursorCol
+ ]
+! !
+
+!EditTextView methodsFor:'redrawing'!
+
+redrawFromVisibleLine:startVisLine to:endVisLine
+ "redraw a visible line range"
+
+ super redrawFromVisibleLine:startVisLine to:endVisLine.
+ self redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
+!
+
+redrawCursorIfInVisibleLine:visLine
+ "redraw the cursor, if it sits in visible line"
+
+ cursorShown ifTrue:[
+ (visLine == cursorVisibleLine) ifTrue:[
+ self drawCursorCharacter
+ ]
+ ]
+!
+
+redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
+ "redraw the cursor, if it sits in a line range"
+
+ cursorShown ifTrue:[
+ cursorVisibleLine notNil ifTrue:[
+ (cursorVisibleLine between:startVisLine and:endVisLine) ifTrue:[
+ self drawCursorCharacter
+ ]
+ ]
+ ]
+!
+
+redrawVisibleLine:visLine from:startCol
+ "redraw a visible line from startCol to the end of line"
+
+ super redrawVisibleLine:visLine from:startCol.
+ self redrawCursorIfInVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine
+ "redraw a visible line"
+
+ super redrawVisibleLine:visLine.
+ self redrawCursorIfInVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine from:startCol to:endCol
+ "redraw a visible line from startCol to endCol"
+
+ super redrawVisibleLine:visLine from:startCol to:endCol.
+ self redrawCursorIfInVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine col:colNr
+ "redraw the single character in visibleline at colNr"
+
+ cursorShown ifTrue:[
+ (visLine == cursorVisibleLine) ifTrue:[
+ (colNr == cursorCol) ifTrue:[
+ self drawCursorCharacter.
+ ^ self
+ ]
+ ]
+ ].
+ super redrawVisibleLine:visLine col:colNr
+! !
+
+!EditTextView methodsFor:'scrolling'!
+
+originChanged:delta
+ "sent after scrolling - have to show the cursor if it was on before"
+
+ super originChanged:delta.
+ "
+ should we move the cursor with the scroll - or leave it ?
+ "
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ prevCursorState ifTrue:[
+ self showCursor
+ ]
+!
+
+originWillChange
+ "sent before scrolling - have to hide the cursor"
+
+ prevCursorState := cursorShown.
+ cursorShown ifTrue:[
+ self hideCursor
+ ]
+!
+
+pageUp
+ "page up - to keep cursor on same visible line, it has to be moved
+ within the real text "
+
+ |prevCursorLine|
+
+ prevCursorLine := cursorVisibleLine.
+ super pageUp.
+ self cursorVisibleLine:prevCursorLine col:cursorCol
+!
+
+pageDown
+ "page down - to keep cursor on same visible line, it has to be moved
+ within the real text "
+
+ |prevCursorLine|
+
+ prevCursorLine := cursorVisibleLine.
+ super pageDown.
+ self cursorVisibleLine:prevCursorLine col:cursorCol
+! !
+
+!EditTextView methodsFor:'cursor handling'!
+
+withCursorOffDo:aBlock
+ "evaluate aBlock with cursor off"
+
+ (shown not or:[cursorShown not]) ifTrue:[
+ ^ aBlock value
+ ].
+ self hideCursor.
+ aBlock valueNowOrOnUnwindDo:[
+ self showCursor
+ ]
+!
+
+drawCursor
+ "draw the cursor if shown and cursor is visible.
+ (but not, if there is a selection - to avoid confusion)"
+
+ shown ifTrue:[
+ cursorVisibleLine notNil ifTrue:[
+ self hasSelection ifFalse:[
+ self drawCursorCharacter
+ ]
+ ]
+ ]
+!
+
+drawCursorCharacter
+ "draw the cursor.
+ (i.e. the cursor if no selection)
+ - helper for many cursor methods"
+
+ hasKeyboardFocus ifTrue:[
+ self drawFocusCursor
+ ] ifFalse:[
+ self drawNoFocusCursor
+ ]
+!
+
+makeCursorVisible
+ "scroll to make cursor visible"
+
+ |line col|
+
+ cursorLine notNil ifTrue:[
+ line := cursorLine.
+ col := cursorCol.
+ "
+ if there is a selection, its better to
+ have its start being visible, instead of the end
+ "
+ (selectionStartLine notNil
+ and:[selectionEndLine notNil]) ifTrue:[
+
+"/ that was wrong
+"/ ((line == selectionEndLine)
+"/ and:[selectionEndCol notNil
+"/ and:[col == (selectionEndCol+1)]]) ifTrue:[
+
+ line := selectionStartLine.
+ col := selectionStartCol.
+ ].
+ self makeLineVisible:line.
+ self makeColVisible:col inLine:line
+ ]
+!
+
+undrawCursor
+ "undraw the cursor (i.e. redraw the character(s) under the cursor)"
+
+ cursorVisibleLine notNil ifTrue:[
+ ((cursorType == #caret) or:[cursorType == #solidCaret]) ifTrue:[
+ "caret-cursor touches 4 characters"
+ ((cursorCol > 1) and:[fontIsFixedWidth]) ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
+ super redrawVisibleLine:cursorVisibleLine+1 from:cursorCol-1 to:cursorCol.
+ ] ifFalse:[
+ "care for left margin"
+ super redrawVisibleLine:cursorVisibleLine.
+ super redrawVisibleLine:cursorVisibleLine+1.
+ ].
+ ^ self
+ ].
+ cursorType == #ibeam ifTrue:[
+ "ibeam-cursor touches 2 characters"
+ cursorCol > 1 ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
+ ] ifFalse:[
+ "care for left margin"
+ super redrawVisibleLine:cursorVisibleLine.
+ ].
+ ^ self
+ ].
+ "block is simple - just one character under cursor"
+ super redrawVisibleLine:cursorVisibleLine col:cursorCol
+ ]
+!
+
+drawCursor:cursorType with:fgColor and:bgColor
+ "draw a cursor; the argument cursorType specifies what type
+ of cursor should be drawn."
+
+ |x y w char|
+
+ self hasSelection ifTrue:[
+ "
+ hide cursor, if there is a selection
+ "
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+
+ cursorType == #block ifTrue:[
+ super drawVisibleLine:cursorVisibleLine
+ col:cursorCol
+ with:fgColor
+ and:bgColor.
+ ^ self
+ ].
+ x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
+ y := self yOfVisibleLine:cursorVisibleLine.
+
+ cursorType == #frame ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+
+ char := self characterUnderCursor asString.
+ self paint:bgColor.
+ self displayRectangleX:x y:y width:(font widthOf:char)
+ height:fontHeight.
+ ^ self
+ ].
+ cursorType == #ibeam ifTrue:[
+
+ self paint:bgColor.
+ self displayLineFromX:x-1 y:y toX:x-1 y:(y + fontHeight - 1).
+ self displayLineFromX:x y:y toX:x y:(y + fontHeight - 1).
+ ^ self
+ ].
+ cursorType == #caret ifTrue:[
+ y := y + fontHeight - 3.
+ w := fontWidth // 2.
+ self paint:bgColor.
+ self lineWidth:2.
+ self displayLineFromX:x-w y:y+w toX:x y:y.
+ self displayLineFromX:x y:y toX:x+w y:y+w.
+ ].
+ cursorType == #solidCaret ifTrue:[
+ y := y + fontHeight - 3.
+ w := fontWidth // 2.
+ self paint:bgColor.
+ self fillPolygon:(Array with:(x-w) @ (y+w)
+ with:(x @ y)
+ with:(x+w) @ (y+w))
+ ].
+!
+
+hideCursor
+ "make cursor invisible if currently visible; return true if cursor
+ was visible"
+
+ cursorShown ifTrue: [
+ self undrawCursor.
+ cursorShown := false.
+ ^ true
+ ].
+ ^ false
+!
+
+drawNoFocusCursor
+ "draw the cursor for the case when the view has no keyboard focus"
+
+ self hasSelection ifTrue:[
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+ cursorType ~~ #block ifTrue:[
+ "these dont show unfocussed"
+ ^ self drawFocusCursor
+ ].
+ self drawCursor:#frame with:cursorFgColor and:cursorBgColor
+!
+
+showCursor
+ "make cursor visible if currently invisible"
+
+ cursorShown ifFalse: [
+ self drawCursor.
+ cursorShown := true
+ ]
+!
+
+cursorHome
+ "scroll to top AND move cursor to first line of text"
+
+ self withCursorOffDo:[
+ self scrollToTop.
+ cursorCol := 1.
+ cursorVisibleLine := 1.
+ cursorLine := self visibleLineToAbsoluteLine:1.
+ self makeCursorVisible.
+ ]
+!
+
+drawFocusCursor
+ "draw the cursor when the focus is in the view."
+
+ self hasSelection ifTrue:[
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+ self drawCursor:cursorType with:cursorFgColor and:cursorBgColor.
+!
+
+cursorReturn
+ "move cursor to start of next line; scroll if at end of visible text"
+
+ self checkForExistingLine:(cursorLine + 1).
+ cursorVisibleLine notNil ifTrue:[
+ nFullLinesShown notNil ifTrue:[
+ (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown]
+ ]
+ ].
+ self withCursorOffDo:[
+ cursorCol := 1.
+ cursorLine := cursorLine + 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine
+ ].
+ self makeCursorVisible.
+!
+
+cursorUp
+ "move cursor up; scroll if at start of visible text"
+
+ (cursorLine == 1) ifFalse: [
+ cursorLine isNil ifTrue:[
+ cursorLine := firstLineShown + nFullLinesShown - 1.
+ ].
+"/ cursorVisibleLine notNil ifTrue:[
+ self withCursorOffDo:[
+ (cursorVisibleLine == 1) ifTrue:[self scrollUp].
+ cursorLine := cursorLine - 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ ].
+"/ ] ifFalse:[
+"/ self makeCursorVisible.
+"/ ]
+ ]
+!
+
+cursorToBottom
+ "move cursor to last line of text"
+
+ self withCursorOffDo:[
+ |newTop|
+
+ newTop := list size - nFullLinesShown.
+ (newTop < 1) ifTrue:[
+ newTop := 1
+ ].
+ self scrollToLine:newTop.
+ cursorCol := 1.
+ cursorLine := list size.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ self makeCursorVisible.
+ ]
+!
+
+cursorDown
+ "move cursor down; scroll if at end of visible text"
+
+ cursorVisibleLine notNil ifTrue:[
+ self withCursorOffDo:[
+ (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown].
+ cursorLine := cursorLine + 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine
+ ]
+ ] ifFalse:[
+ cursorLine isNil ifTrue:[
+ cursorLine := firstLineShown
+ ].
+ cursorLine := cursorLine + 1.
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+ self makeCursorVisible.
+ ].
+!
+
+cursorRight
+ "move cursor to right"
+
+ self withCursorOffDo:[cursorCol := cursorCol + 1].
+ self makeCursorVisible.
+!
+
+cursorLeft
+ "move cursor to left"
+
+ (cursorCol == 1) ifFalse: [
+ self withCursorOffDo:[cursorCol := cursorCol - 1]
+ ].
+ self makeCursorVisible.
+!
+
+cursorToEndOfLine
+ "move cursor to end of current line"
+
+ self withCursorOffDo:[
+ |line|
+
+ list isNil ifTrue:[
+ cursorCol := 1
+ ] ifFalse:[
+ line := list at:cursorLine.
+ cursorCol := line size + 1
+ ].
+ self makeCursorVisible.
+ ].
+!
+
+cursorToBeginOfLine
+ "move cursor to start of current line"
+
+ self withCursorOffDo:[
+ cursorCol := 1
+ ].
+ self makeCursorVisible.
+!
+
+cursorTab
+ "move cursor to next tabstop"
+
+ self withCursorOffDo:[
+ cursorCol := self nextTabAfter:cursorCol
+ ].
+ self makeCursorVisible.
+!
+
+cursorLine:line col:col
+ "this positions onto physical - not visible - line"
+
+ self withCursorOffDo:[
+ cursorLine := line.
+ cursorVisibleLine := self listLineToVisibleLine:line.
+ cursorCol := col.
+ (cursorCol < 1) ifTrue:[
+ cursorCol := 1
+ ]
+ ].
+ self makeCursorVisible.
+!
+
+cursorBacktab
+ "move cursor to prev tabstop"
+
+ self withCursorOffDo:[
+ cursorCol := self prevTabBefore:cursorCol
+ ].
+ self makeCursorVisible.
+!
+
+cursorToNextWord
+ "move the cursor to the beginning of the next word"
+
+ |col line searching|
+
+ (cursorLine > list size) ifTrue:[^ self].
+ self wordAtLine:cursorLine col:cursorCol do:[
+ :beginLine :beginCol :endLine :endCol :style |
+
+ line := endLine.
+ col := endCol + 1.
+ searching := true.
+ [searching
+ and:[(self characterAtLine:line col:col) isSeparator]] whileTrue:[
+ self wordAtLine:line col:col do:[
+ :beginLine :beginCol :endLine :endCol :style |
+
+ (line > list size) ifTrue:[
+ "break out"
+ searching := false
+ ] ifFalse:[
+ line := endLine.
+ col := endCol + 1.
+ ]
+ ]
+ ].
+ self cursorLine:line col:col
+ ]
+!
+
+cursorVisibleLine:visibleLineNr col:colNr
+ "put cursor to visibleline/col"
+
+ self withCursorOffDo:[
+ cursorLine := self visibleLineToAbsoluteLine:visibleLineNr.
+ cursorVisibleLine := visibleLineNr.
+ cursorCol := colNr.
+ (cursorCol < 1) ifTrue:[
+ cursorCol := 1
+ ]
+ ].
+ self makeCursorVisible.
+!
+
+cursorX:x y:y
+ "put cursor to position next to x/y coordinate in view"
+
+ |line col|
+
+ line := self visibleLineOfY:y.
+ col := self colOfX:x inVisibleLine:line.
+ self cursorVisibleLine:line col:col.
+!
+
+cursorToTop
+ "move cursor to absolute home"
+
+ self cursorLine:1 col:1
+!
+
+gotoLine:aLineNumber
+ "position cursor onto line, aLineNumber.
+ Make certain that this line is visible"
+
+ self makeLineVisible:aLineNumber.
+ self cursorLine:aLineNumber col:1
+! !
+
+!EditTextView methodsFor:'accessing'!
+
+characterUnderCursor
+ "return the character under the cursor - space if behond line.
+ For non-block cursors, this is the character immediately to the right
+ of the insertion-bar or caret."
+
+ ^ self characterAtLine:cursorLine col:cursorCol
+!
+
+list:something
+ "position cursor home when setting contents"
+
+ super list:something.
+ self cursorHome
+!
+
+cursorForegroundColor:color1 backgroundColor:color2
+ "set both cursor foreground and cursor background colors"
+
+ self hideCursor.
+ cursorFgColor := color1 on:device.
+ cursorBgColor := color2 on:device.
+ self showCursor
+!
+
+cursorLine
+ "return the cursors line (1..).
+ This is the absolute line; NOT the visible line"
+
+ ^ cursorLine
+!
+
+contents
+ "return the contents as a String"
+
+ list isNil ifTrue:[^ ''].
+ self removeTrailingBlankLines.
+ ^ list asStringWithCRs
+!
+
+cursorCol
+ "return the cursors col (1..).
+ This is the absolute col; NOT the visible col"
+
+ ^ cursorCol
+!
+
+readOnly
+ "make the text readonly"
+
+ readOnly := true
+!
+
+fixedSize
+ "make the texts size fixed (no lines may be added).
+ OBSOLETE: use readOnly"
+
+ readOnly ifFalse:[
+ readOnly := true.
+ middleButtonMenu disable:#cut.
+ middleButtonMenu disable:#paste.
+ middleButtonMenu disable:#replace.
+ middleButtonMenu disable:#indent
+ ]
+!
+
+exceptionBlock:aBlock
+ "define the action to be triggered when user tries to modify
+ readonly text"
+
+ exceptionBlock := aBlock
+!
+
+modified:aBoolean
+ "set the modified flag"
+
+ modified := aBoolean
+!
+
+modified
+ "return true if text was modified"
+
+ ^ modified
+!
+
+fromFile:aFileName
+ "take contents from a named file"
+
+ self contents:(aFileName asFilename readStream contents)
+! !
+
!EditTextView methodsFor:'initialization'!
+initEvents
+ "enable enter/leave events in addition"
+
+ super initEvents.
+ self enableEnterLeaveEvents
+!
+
+initStyle
+ "initialize style specific stuff"
+
+ super initStyle.
+ cursorFgColor := DefaultCursorForegroundColor.
+ cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
+ cursorBgColor := DefaultCursorBackgroundColor.
+ cursorBgColor isNil ifTrue:[cursorBgColor := fgColor].
+ cursorType := DefaultCursorType.
+!
+
+realize
+ "make the view visible"
+
+ super realize.
+ cursorFgColor := cursorFgColor on:device.
+ cursorBgColor := cursorBgColor on:device.
+!
+
initialize
"initialize a new EditTextView;
setup some instance variables"
@@ -123,24 +1732,6 @@
hasKeyboardFocus := false. "/ true.
!
-initStyle
- "initialize style specific stuff"
-
- super initStyle.
- cursorFgColor := DefaultCursorForegroundColor.
- cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
- cursorBgColor := DefaultCursorBackgroundColor.
- cursorBgColor isNil ifTrue:[cursorBgColor := fgColor].
- cursorType := DefaultCursorType.
-!
-
-initEvents
- "enable enter/leave events in addition"
-
- super initEvents.
- self enableEnterLeaveEvents
-!
-
editMenu
"return the views middleButtonMenu"
@@ -218,2194 +1809,25 @@
sub disable:#indent.
].
^ m.
-!
-
-realize
- "make the view visible"
-
- super realize.
- cursorFgColor := cursorFgColor on:device.
- cursorBgColor := cursorBgColor on:device.
-! !
-
-!EditTextView methodsFor:'accessing'!
-
-cursorForegroundColor:color1 backgroundColor:color2
- "set both cursor foreground and cursor background colors"
-
- self hideCursor.
- cursorFgColor := color1 on:device.
- cursorBgColor := color2 on:device.
- self showCursor
-!
-
-cursorLine
- "return the cursors line (1..).
- This is the absolute line; NOT the visible line"
-
- ^ cursorLine
-!
-
-cursorCol
- "return the cursors col (1..).
- This is the absolute col; NOT the visible col"
-
- ^ cursorCol
-!
-
-contents
- "return the contents as a String"
-
- list isNil ifTrue:[^ ''].
- self removeTrailingBlankLines.
- ^ list asStringWithCRs
-!
-
-list:something
- "position cursor home when setting contents"
-
- super list:something.
- self cursorHome
-!
-
-readOnly
- "make the text readonly"
-
- readOnly := true
-!
-
-fixedSize
- "make the texts size fixed (no lines may be added).
- OBSOLETE: use readOnly"
-
- readOnly ifFalse:[
- readOnly := true.
- middleButtonMenu disable:#cut.
- middleButtonMenu disable:#paste.
- middleButtonMenu disable:#replace.
- middleButtonMenu disable:#indent
- ]
-!
-
-exceptionBlock:aBlock
- "define the action to be triggered when user tries to modify
- readonly text"
-
- exceptionBlock := aBlock
-!
-
-fromFile:aFileName
- "take contents from a named file"
-
- self contents:(aFileName asFilename readStream contents)
-!
-
-modified:aBoolean
- "set the modified flag"
-
- modified := aBoolean
-!
-
-modified
- "return true if text was modified"
-
- ^ modified
-!
-
-characterUnderCursor
- "return the character under the cursor - space if behond line.
- For non-block cursors, this is the character immediately to the right
- of the insertion-bar or caret."
-
- ^ self characterAtLine:cursorLine col:cursorCol
-! !
-
-!EditTextView methodsFor:'private'!
-
-contentsChanged
- "triggered whenever text is changed"
-
- super contentsChanged.
- modified := true.
- contentsWasSaved := false
-! !
-
-!EditTextView methodsFor:'editing'!
-
-mergeLine:lineNr
- "merge line lineNr with line lineNr+1"
-
- |leftPart rightPart bothParts nextLineNr|
-
- list isNil ifFalse:[
- nextLineNr := lineNr + 1.
- (nextLineNr > list size) ifFalse:[
- (list at:lineNr) isNil ifTrue:[
- leftPart := ''
- ] ifFalse:[
- leftPart := list at:lineNr
- ].
- (list at:nextLineNr) isNil ifTrue:[
- rightPart := ''
- ] ifFalse:[
- rightPart := list at:nextLineNr
- ].
- bothParts := leftPart , rightPart.
- bothParts isBlank ifTrue:[bothParts := nil].
- list at:lineNr put:bothParts.
- self redrawLine:lineNr.
- self deleteLine:nextLineNr
- ]
- ]
-!
-
-splitLine:lineNr before:colNr
- "split the line linNr before colNr; the right part (from colNr)
- is cut off and inserted after lineNr; the view is redrawn"
-
- |line lineSize leftRest rightRest visLine w
- 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.
- modified := true.
- contentsWasSaved := false.
- 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 contentsChanged.
- ]
- ]
-!
-
-withoutRedrawInsertLine:aString before:lineNr
- "insert the argument, aString before line lineNr; the string
- becomes line nileNr; everything else is moved down; the view
- is not redrawn"
-
- |line|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- line := aString.
- line notNil ifTrue:[
- line isBlank ifTrue:[
- line := nil
- ] ifFalse:[
- (line occurrencesOf:(Character tab)) == 0 ifFalse:[
- line := self withTabsExpanded:line
- ]
- ]
- ].
- list isNil ifTrue: [
- list := StringCollection new:lineNr
- ] ifFalse: [
- list grow:((list size + 1) max:lineNr)
- ].
-
- "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
- overlapping copy - if it didn't, we had to use:"
-"
- index := list size.
- [index > lineNr] whileTrue: [
- pIndex := index - 1.
- list at:index put:(list at:pIndex).
- index := pIndex
- ].
-"
- list replaceFrom:(lineNr + 1) to:(list size) with:list startingAt:lineNr.
- list at:lineNr put:line.
-!
-
-insertLine:aString before:lineNr
- "insert the line aString before line lineNr"
-
- |visLine w
- dstY "{ Class: SmallInteger }" |
-
- visLine := self listLineToVisibleLine:lineNr.
- (shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLine:aString before:lineNr.
- self contentsChanged.
- ^ self
- ].
-
- 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.
- self contentsChanged.
-!
-
-insertLines:someText from:start to:end before:lineNr
- "insert a bunch of lines before line lineNr"
-
- |visLine w nLines "{ Class: SmallInteger }"
- srcY "{ Class: SmallInteger }"
- dstY "{ Class: SmallInteger }" |
-
- readOnly ifTrue:[
- ^ self
- ].
- visLine := self listLineToVisibleLine:lineNr.
- (shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLines:someText
- from:start to:end
- before:lineNr.
- self contentsChanged.
- ^ self
- ].
-
- 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
- ].
- self contentsChanged.
-!
-
-insert:aCharacter atLine:lineNr col:colNr
- "insert a single character at lineNr/colNr"
-
- |line lineSize newLine drawCharacterOnly|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- aCharacter == (Character cr) ifTrue:[
- 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
- ]
- ].
- (lineSize == 0) ifTrue: [
- 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
- ]
- ].
- newLine at:colNr put:aCharacter.
- aCharacter == (Character tab) ifTrue:[
- newLine := self withTabsExpanded:newLine.
- drawCharacterOnly := false
- ].
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
- shown ifTrue:[
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
- ]
- ]
-!
-
-withoutRedrawInsertLines:lines from:start to:end before:lineNr
- "insert a bunch of lines before line lineNr; the view
- is not redrawn"
-
- |newLine newLines nLines|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
-
- nLines := end - start + 1.
- newLines := Array new:(lines size).
- start to:end do:[:index |
- newLine := lines at:index.
- newLine notNil ifTrue:[
- newLine isBlank ifTrue:[
- newLine := nil
- ] ifFalse:[
- (newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
- newLine := self withTabsExpanded:newLine
- ]
- ]
- ].
- newLines at:index put:newLine
- ].
- list isNil ifTrue: [
- list := StringCollection new:(lineNr + nLines + 1)
- ] ifFalse: [
- list grow:((list size + nLines) max:(lineNr + nLines - 1))
- ].
-
- "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
- overlapping copy - if it didn't, we had to use:"
-"
- index := list size.
- [index > lineNr] whileTrue: [
- pIndex := index - 1.
- list at:index put:(list at:pIndex).
- index := pIndex
- ].
-"
- list replaceFrom:(lineNr + nLines) to:(list size) with:list startingAt:lineNr.
- list replaceFrom:lineNr to:(lineNr + nLines - 1) with:newLines startingAt:start.
-!
-
-withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr
- "insert aString (which has no crs) at lineNr/colNr"
-
- |strLen line lineSize newLine|
-
- aString isNil ifTrue:[^ self].
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- strLen := aString size.
- self checkForExistingLine:lineNr.
- line := list at:lineNr.
- line notNil ifTrue:[
- lineSize := line size
- ] ifFalse:[
- lineSize := 0
- ].
- ((colNr == 1) and:[lineSize == 0]) ifTrue: [
- 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
- ].
-
- (aString occurrencesOf:(Character tab)) == 0 ifFalse:[
- newLine := self withTabsExpanded:newLine
- ].
-
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
-!
-
-insertStringWithoutCRs:aString atLine:lineNr col:colNr
- "insert aString (which has no crs) at lineNr/colNr"
-
- self withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
- shown ifTrue:[self redrawLine:lineNr from:colNr]
-!
-
-insertStringWithoutCRsAtCursor:aString
- "insert a string (which has no crs) at cursor position
- - advance cursor"
-
- aString notNil ifTrue:[
- self withCursorOffDo:[
- self insertString:aString atLine:cursorLine col:cursorCol.
- cursorCol := cursorCol + aString size
- ]
- ]
-!
-
-insertCharAtCursor:aCharacter
- "insert a single character at cursor-position - advance cursor"
-
- self withCursorOffDo:[
- self insert:aCharacter atLine:cursorLine col:cursorCol.
- aCharacter == (Character cr) ifTrue:[
- self cursorReturn
- ] ifFalse:[
- cursorCol := cursorCol + 1
- ].
- self makeCursorVisible
- ]
-!
-
-insertString:aString atLine:lineNr col:colNr
- "insert the string, aString at line/col;
- handle cr's correctly"
-
- |start "{ Class: SmallInteger }"
- stop "{ Class: SmallInteger }"
- end "{ Class: SmallInteger }"
- subString c
- l "{ Class: SmallInteger }" |
-
-
- aString isNil ifTrue:[^ self].
- ((aString occurrencesOf:(Character cr)) == 0) ifTrue:[
- ^ self insertStringWithoutCRs:aString atLine:lineNr col:colNr
- ].
- l := lineNr.
- c := colNr.
- start := 1.
- end := aString size.
- [start <= end] whileTrue:[
- stop := aString indexOf:(Character cr) startingAt:start.
- stop == 0 ifTrue:[
- stop := end + 1
- ].
- subString := aString copyFrom:start to:(stop - 1).
- self insertStringWithoutCRs:subString atLine:l col:c.
- (stop < end) ifTrue:[
- c := c + subString size.
- self insert:(Character cr) atLine:l col:c.
- l := l + 1.
- c := 1
- ].
- start := stop + 1
- ]
-!
-
-insertStringAtCursor:aString
- "insert the argument, aString at cursor position
- handle cr's correctly. A nil argument is interpreted as an empty line."
-
- |start " { Class: SmallInteger }"
- stop " { Class: SmallInteger }"
- end " { Class: SmallInteger }"
- subString|
-
- aString isNil ifTrue:[
- "new:"
- self insertCharAtCursor:(Character cr).
- ^ self
- ].
- ((aString occurrencesOf:(Character cr)) == 0) ifTrue:[
- ^ self insertStringWithoutCRsAtCursor:aString
- ].
-
- self insertLines:aString asStringCollection withCr:false.
-
-"/ start := 1.
-"/ end := aString size.
-"/ "insert the 1st line"
-"/ (cursorCol ~~ 1) ifTrue:[
-"/ stop := aString indexOf:(Character cr) startingAt:start.
-"/ stop == 0 ifTrue:[
-"/ stop := end + 1
-"/ ].
-"/ subString := aString copyFrom:start to:(stop - 1).
-"/ self insertStringWithoutCRsAtCursor:subString.
-"/ self insertCharAtCursor:(Character cr).
-"/ start := stop + 1
-"/ ].
-"/ "insert the block of full lines"
-"/
-"/ [start <= end] whileTrue:[
-"/ stop := aString indexOf:(Character cr) startingAt:start.
-"/ stop == 0 ifTrue:[
-"/ stop := end + 1
-"/ ].
-"/ subString := aString copyFrom:start to:(stop - 1).
-"/ self insertStringWithoutCRsAtCursor:subString.
-"/ (stop < end) ifTrue:[
-"/ self insertCharAtCursor:(Character cr)
-"/ ].
-"/ start := stop + 1
-"/ ]
-!
-
-insertSelectedStringAtCursor:aString
- "insert the argument, aString at cursor position and select it"
-
- |startLine startCol|
-
- startLine := cursorLine.
- startCol := cursorCol.
- self insertStringAtCursor:aString.
- self selectFromLine:startLine col:startCol
- toLine:cursorLine col:(cursorCol - 1)
-!
-
-insertLines:lines withCr:withCr
- "insert a bunch of lines at cursor position. Cursor
- is moved behind insertion.
- If withCr is true, append cr after last line"
-
- |start end nLines|
-
- lines notNil ifTrue:[
- nLines := lines size.
- (nLines == 1) ifTrue:[
- self insertStringAtCursor:(lines at:1).
- withCr ifTrue:[
- self insertCharAtCursor:(Character cr)
- ]
- ] ifFalse:[
- (cursorCol ~~ 1) ifTrue:[
- self insertStringAtCursor:(lines at:1).
- self insertCharAtCursor:(Character cr).
- start := 2
- ] ifFalse:[
- start := 1
- ].
- withCr ifTrue:[
- end := nLines
- ] ifFalse:[
- end := nLines - 1
- ].
- (start < nLines) ifTrue:[
- (end >= start) ifTrue:[
- self withCursorOffDo:[
- self insertLines:lines
- from:start to:end
- before:cursorLine.
- cursorLine := cursorLine + (end - start + 1).
- cursorVisibleLine := self absoluteLineToVisibleLine:
- cursorLine
- ]
- ]
- ].
- withCr ifFalse:[
- "last line without cr"
- self insertStringAtCursor:(lines at:nLines)
- ]
- ]
- ]
-!
-
-insertTabAtCursor
- "insert spaces to next tab"
-
- self withCursorOffDo:[
- |nextTab|
-
- nextTab := self nextTabAfter:cursorCol.
- self insertStringAtCursor:(String new:(nextTab - cursorCol)).
- self makeCursorVisible.
- ].
-!
-
-deleteFromLine:startLine col:startCol toLine:endLine col:endCol
- "delete all text from startLine/startCol to endLine/endCol -
- joining lines if nescessary"
-
- |line lineSize|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue:[^ self].
-
- (startLine == endLine) ifTrue:[
- "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 right rest of 1st line"
- self deleteCharsAtLine:startLine fromCol:startCol.
-
- "delete the inner lines ..."
- endLine > (startLine + 1) ifTrue:[
- 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.
- modified := true.
- contentsWasSaved := false.
- ]
- ].
-
- "merge the left rest of 1st line with right rest of last line into one"
- self mergeLine:startLine
-!
-
-deleteFromLine:startLineNr toLine:endLineNr
- "delete some lines"
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue:[^ self].
- list removeFromIndex:startLineNr toIndex:endLineNr.
- self contentsChanged.
- 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
- ].
- (list isNil or:[lineNr > list size]) ifTrue:[^ false].
- list removeIndex:lineNr.
- self contentsChanged.
- ^ true
-!
-
-deleteLinesWithoutRedrawFrom:startLine to:endLine
- "delete lines - no redraw;
- return true, if something was really deleted"
-
- |lastLine|
-
- readOnly ifTrue:[
- exceptionBlock value:errorMessage.
- ^ false
- ].
- (list isNil or:[startLine > list size]) ifTrue:[^ false].
- (endLine > list size) ifTrue:[
- lastLine := list size
- ] ifFalse:[
- lastLine := endLine
- ].
- list removeFromIndex:startLine toIndex:lastLine.
- self contentsChanged.
- ^ true
-!
-
-deleteLine:lineNr
- "delete line"
-
- |visLine w
- srcY "{ Class: SmallInteger }" |
-
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- (self deleteLineWithoutRedraw:lineNr) ifFalse:[^ self].
- shown ifFalse:[^ self].
- visLine := self listLineToVisibleLine:lineNr.
- visLine notNil ifTrue:[
- srcY := margin + 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.
- (nFullLinesShown ~~ nLinesShown) ifTrue:[
- self redrawVisibleLine:nLinesShown
- ].
- self waitForExpose
- ]
-!
-
-deleteCursorLine
- "delete the line where the cursor sits"
-
- self withCursorOffDo:[
- self deleteLine:cursorLine
- ]
-!
-
-removeTrailingBlankLines
- "remove all blank lines at end of text"
-
- |lastLine "{ Class: SmallInteger }"
- line finished|
-
- 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 ~~ list size) ifTrue:[
- list grow:lastLine.
- self contentsChanged
- ]
-!
-
-deleteCharsAtLine:lineNr toCol:colNr
- "delete characters from start up to colNr 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.
- (colNr >= lineSize) ifTrue:[
- newLine := nil
- ] ifFalse:[
- newLine := line copyFrom:(colNr + 1) to:lineSize.
- newLine isBlank ifTrue:[
- newLine := nil
- ]
- ].
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
- self redrawLine:lineNr
-!
-
-deleteCharsAtLine:lineNr fromCol:colNr
- "delete characters from colNr up to the end in line lineNr"
-
- |line newLine|
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- list isNil ifTrue: [^self].
- (list size < lineNr) ifTrue: [^ self].
- line := list at:lineNr.
- line isNil ifTrue: [^self].
- (colNr > line size) ifTrue: [^ self].
- newLine := line copyTo:(colNr - 1).
- newLine isBlank ifTrue:[
- newLine := nil
- ].
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
- self redrawLine:lineNr
-!
-
-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.
- modified := true.
- contentsWasSaved := false.
- self redrawLine:lineNr
-!
-
-deleteCharAtLine:lineNr col:colNr
- "delete single character at colNr in line lineNr"
-
- |line lineSize newLine drawCharacterOnly|
-
- 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.
- (colNr > lineSize) ifTrue: [^ self].
-
- drawCharacterOnly := false.
- (colNr == lineSize) ifTrue:[
- 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 isBlank ifTrue:[
- newLine := nil
- ].
- list at:lineNr put:newLine.
- modified := true.
- contentsWasSaved := false.
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
- ]
-!
-
-deleteCharBeforeCursor
- "delete single character to the left of cursor and move cursor to left"
-
- |oldSize lineNrAboveCursor|
-
- (cursorCol == 1) ifFalse:[
- self withCursorOffDo:[
- cursorCol := cursorCol - 1.
- self deleteCharAtLine:cursorLine col:cursorCol
- ]
- ] ifTrue:[
- (cursorLine == 1) ifFalse:[
- oldSize := 0.
- lineNrAboveCursor := cursorLine - 1.
- list notNil ifTrue:[
- (list size >= lineNrAboveCursor) ifTrue:[
- (list at:lineNrAboveCursor) notNil ifTrue:[
- oldSize := (list at:lineNrAboveCursor) size
- ]
- ]
- ].
- self mergeLine:lineNrAboveCursor.
- self withCursorOffDo:[
- cursorLine := lineNrAboveCursor.
- cursorCol := oldSize + 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine
- ].
- self makeCursorVisible
- ]
- ]
-!
-
-deleteCharAtCursor
- "delete single character under cursor"
-
- self withCursorOffDo:[
- self deleteCharAtLine:cursorLine col:cursorCol
- ]
-!
-
-deleteSelection
- "delete the selection"
-
- readOnly ifTrue: [
- exceptionBlock value:errorMessage.
- ^ self
- ].
- selectionStartLine notNil ifTrue:[
- self withCursorOffDo:[
- |startLine startCol endLine endCol|
-
- startLine := selectionStartLine.
- startCol := selectionStartCol.
- endLine := selectionEndLine.
- endCol := selectionEndCol.
- self unselectWithoutRedraw.
- self deleteFromLine:startLine col:startCol
- toLine:endLine col:endCol.
- cursorCol := startCol.
- cursorLine := startLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisible
- ]
- ]
-!
-
-replaceSelectionBy:something keepCursor:keep
- "delete the selection (if any) and insert something, a character or string;
- leave cursor after insertion or leave it, depending on keep"
-
- |sel l c|
-
- l := cursorLine.
- c := cursorCol.
-
- sel := self selection.
- sel notNil ifTrue:[
- lastString := sel.
- self deleteSelection.
- replacing := true.
- lastReplacement := ''
- ].
- (something isMemberOf:Character) ifTrue:[
- lastReplacement notNil ifTrue:[
- (lastReplacement endsWith:Character space) ifTrue:[
- lastReplacement := lastReplacement copyTo:(lastReplacement size - 1).
- lastReplacement := lastReplacement copyWith:something.
- lastReplacement := lastReplacement copyWith:Character space
- ] ifFalse:[
- lastReplacement := lastReplacement copyWith:something.
- ]
- ].
- self insertCharAtCursor:something
- ] ifFalse:[
- lastReplacement := something.
- self insertStringAtCursor:something
- ].
- keep ifTrue:[
- self cursorLine:l col:c
- ]
-!
-
-replaceSelectionBy:something
- "delete the selection (if any) and insert something, a character or string;
- leave cursor after insertion"
-
- self replaceSelectionBy:something keepCursor:false
-! !
-
-!EditTextView methodsFor:'formatting'!
-
-indent
- "indent selected line-range"
-
- |start end|
-
- selectionStartLine isNil ifTrue:[^ self].
- start := selectionStartLine.
- end := selectionEndLine.
- (selectionEndCol == 0) ifTrue:[
- end := end - 1
- ].
- self unselect.
- self indentFromLine:start toLine:end
-!
-
-indentFromLine:start toLine:end
- "indent a line-range - this is don by searching for the
- last non-empty line before start, and change the indent
- of the line based on that indent."
-
- |leftStart lnr delta d line spaces|
-
- "find a line to base indent on..."
- leftStart := 0.
- lnr := start.
- [(leftStart == 0) and:[lnr ~~ 1]] whileTrue:[
- lnr := lnr - 1.
- leftStart := self leftIndentOfLine:lnr
- ].
-
- (leftStart == 0) ifTrue:[^ self].
-
- delta := leftStart - (self leftIndentOfLine:start).
- (delta == 0) ifTrue:[^ self].
- (delta > 0) ifTrue:[
- 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.
- modified := true.
- contentsWasSaved := false.
- ]
- ]
- ].
- self redrawFromLine:start to:end
-! !
-
-!EditTextView methodsFor:'cursor handling'!
-
-makeCursorVisible
- "scroll to make cursor visible"
-
- |line col|
-
- cursorLine notNil ifTrue:[
- line := cursorLine.
- col := cursorCol.
- "
- if there is a selection, its better to
- have its start being visible, instead of the end
- "
- (selectionStartLine notNil
- and:[selectionEndLine notNil]) ifTrue:[
-
-"/ that was wrong
-"/ ((line == selectionEndLine)
-"/ and:[selectionEndCol notNil
-"/ and:[col == (selectionEndCol+1)]]) ifTrue:[
-
- line := selectionStartLine.
- col := selectionStartCol.
- ].
- self makeLineVisible:line.
- self makeColVisible:col inLine:line
- ]
-!
-
-drawCursor
- "draw the cursor if shown and cursor is visible.
- (but not, if there is a selection - to avoid confusion)"
-
- shown ifTrue:[
- cursorVisibleLine notNil ifTrue:[
- self hasSelection ifFalse:[
- self drawCursorCharacter
- ]
- ]
- ]
-!
-
-drawCursorCharacter
- "draw the cursor.
- (i.e. the cursor if no selection)
- - helper for many cursor methods"
-
- hasKeyboardFocus ifTrue:[
- self drawFocusCursor
- ] ifFalse:[
- self drawNoFocusCursor
- ]
-!
-
-drawCursor:cursorType with:fgColor and:bgColor
- "draw a cursor; the argument cursorType specifies what type
- of cursor should be drawn."
-
- |x y w char|
-
- self hasSelection ifTrue:[
- "
- hide cursor, if there is a selection
- "
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
-
- cursorType == #block ifTrue:[
- super drawVisibleLine:cursorVisibleLine
- col:cursorCol
- with:fgColor
- and:bgColor.
- ^ self
- ].
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := self yOfVisibleLine:cursorVisibleLine.
-
- cursorType == #frame ifTrue:[
- super redrawVisibleLine:cursorVisibleLine col:cursorCol.
-
- char := self characterUnderCursor asString.
- self paint:bgColor.
- self displayRectangleX:x y:y width:(font widthOf:char)
- height:fontHeight.
- ^ self
- ].
- cursorType == #ibeam ifTrue:[
-
- self paint:bgColor.
- self displayLineFromX:x-1 y:y toX:x-1 y:(y + fontHeight - 1).
- self displayLineFromX:x y:y toX:x y:(y + fontHeight - 1).
- ^ self
- ].
- cursorType == #caret ifTrue:[
- y := y + fontHeight - 3.
- w := fontWidth // 2.
- self paint:bgColor.
- self lineWidth:2.
- self displayLineFromX:x-w y:y+w toX:x y:y.
- self displayLineFromX:x y:y toX:x+w y:y+w.
- ].
- cursorType == #solidCaret ifTrue:[
- y := y + fontHeight - 3.
- w := fontWidth // 2.
- self paint:bgColor.
- self fillPolygon:(Array with:(x-w) @ (y+w)
- with:(x @ y)
- with:(x+w) @ (y+w))
- ].
-!
-
-drawFocusCursor
- "draw the cursor when the focus is in the view."
-
- self hasSelection ifTrue:[
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
- self drawCursor:cursorType with:cursorFgColor and:cursorBgColor.
-!
-
-drawNoFocusCursor
- "draw the cursor for the case when the view has no keyboard focus"
-
- self hasSelection ifTrue:[
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
- cursorType ~~ #block ifTrue:[
- "these dont show unfocussed"
- ^ self drawFocusCursor
- ].
- self drawCursor:#frame with:cursorFgColor and:cursorBgColor
-!
-
-undrawCursor
- "undraw the cursor (i.e. redraw the character(s) under the cursor)"
-
- cursorVisibleLine notNil ifTrue:[
- ((cursorType == #caret) or:[cursorType == #solidCaret]) ifTrue:[
- "caret-cursor touches 4 characters"
- ((cursorCol > 1) and:[fontIsFixedWidth]) ifTrue:[
- super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
- super redrawVisibleLine:cursorVisibleLine+1 from:cursorCol-1 to:cursorCol.
- ] ifFalse:[
- "care for left margin"
- super redrawVisibleLine:cursorVisibleLine.
- super redrawVisibleLine:cursorVisibleLine+1.
- ].
- ^ self
- ].
- cursorType == #ibeam ifTrue:[
- "ibeam-cursor touches 2 characters"
- cursorCol > 1 ifTrue:[
- super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
- ] ifFalse:[
- "care for left margin"
- super redrawVisibleLine:cursorVisibleLine.
- ].
- ^ self
- ].
- "block is simple - just one character under cursor"
- super redrawVisibleLine:cursorVisibleLine col:cursorCol
- ]
-!
-
-hideCursor
- "make cursor invisible if currently visible; return true if cursor
- was visible"
-
- cursorShown ifTrue: [
- self undrawCursor.
- cursorShown := false.
- ^ true
- ].
- ^ false
-!
-
-showCursor
- "make cursor visible if currently invisible"
-
- cursorShown ifFalse: [
- self drawCursor.
- cursorShown := true
- ]
-!
-
-withCursorOffDo:aBlock
- "evaluate aBlock with cursor off"
-
- (shown not or:[cursorShown not]) ifTrue:[
- ^ aBlock value
- ].
- self hideCursor.
- aBlock valueNowOrOnUnwindDo:[
- self showCursor
- ]
-!
-
-cursorHome
- "scroll to top AND move cursor to first line of text"
-
- self withCursorOffDo:[
- self scrollToTop.
- cursorCol := 1.
- cursorVisibleLine := 1.
- cursorLine := self visibleLineToAbsoluteLine:1.
- self makeCursorVisible.
- ]
-!
-
-cursorToBottom
- "move cursor to last line of text"
-
- self withCursorOffDo:[
- |newTop|
-
- newTop := list size - nFullLinesShown.
- (newTop < 1) ifTrue:[
- newTop := 1
- ].
- self scrollToLine:newTop.
- cursorCol := 1.
- cursorLine := list size.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisible.
- ]
-!
-
-cursorUp
- "move cursor up; scroll if at start of visible text"
-
- (cursorLine == 1) ifFalse: [
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown + nFullLinesShown - 1.
- ].
-"/ cursorVisibleLine notNil ifTrue:[
- self withCursorOffDo:[
- (cursorVisibleLine == 1) ifTrue:[self scrollUp].
- cursorLine := cursorLine - 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- ].
-"/ ] ifFalse:[
-"/ self makeCursorVisible.
-"/ ]
- ]
-!
-
-cursorDown
- "move cursor down; scroll if at end of visible text"
-
- cursorVisibleLine notNil ifTrue:[
- self withCursorOffDo:[
- (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown].
- cursorLine := cursorLine + 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine
- ]
- ] ifFalse:[
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown
- ].
- cursorLine := cursorLine + 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisible.
- ].
-!
-
-cursorLeft
- "move cursor to left"
-
- (cursorCol == 1) ifFalse: [
- self withCursorOffDo:[cursorCol := cursorCol - 1]
- ].
- self makeCursorVisible.
-!
-
-cursorRight
- "move cursor to right"
-
- self withCursorOffDo:[cursorCol := cursorCol + 1].
- self makeCursorVisible.
-!
-
-cursorToBeginOfLine
- "move cursor to start of current line"
-
- self withCursorOffDo:[
- cursorCol := 1
- ].
- self makeCursorVisible.
-!
-
-cursorToEndOfLine
- "move cursor to end of current line"
-
- self withCursorOffDo:[
- |line|
-
- list isNil ifTrue:[
- cursorCol := 1
- ] ifFalse:[
- line := list at:cursorLine.
- cursorCol := line size + 1
- ].
- self makeCursorVisible.
- ].
-!
-
-cursorTab
- "move cursor to next tabstop"
-
- self withCursorOffDo:[
- cursorCol := self nextTabAfter:cursorCol
- ].
- self makeCursorVisible.
-!
-
-cursorBacktab
- "move cursor to prev tabstop"
-
- self withCursorOffDo:[
- cursorCol := self prevTabBefore:cursorCol
- ].
- self makeCursorVisible.
-!
-
-cursorToNextWord
- "move the cursor to the beginning of the next word"
-
- |col line searching|
-
- (cursorLine > list size) ifTrue:[^ self].
- self wordAtLine:cursorLine col:cursorCol do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- line := endLine.
- col := endCol + 1.
- searching := true.
- [searching
- and:[(self characterAtLine:line col:col) isSeparator]] whileTrue:[
- self wordAtLine:line col:col do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- (line > list size) ifTrue:[
- "break out"
- searching := false
- ] ifFalse:[
- line := endLine.
- col := endCol + 1.
- ]
- ]
- ].
- self cursorLine:line col:col
- ]
-!
-
-cursorReturn
- "move cursor to start of next line; scroll if at end of visible text"
-
- self checkForExistingLine:(cursorLine + 1).
- cursorVisibleLine notNil ifTrue:[
- nFullLinesShown notNil ifTrue:[
- (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown]
- ]
- ].
- self withCursorOffDo:[
- cursorCol := 1.
- cursorLine := cursorLine + 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine
- ].
- self makeCursorVisible.
-!
-
-cursorVisibleLine:visibleLineNr col:colNr
- "put cursor to visibleline/col"
-
- self withCursorOffDo:[
- cursorLine := self visibleLineToAbsoluteLine:visibleLineNr.
- cursorVisibleLine := visibleLineNr.
- cursorCol := colNr.
- (cursorCol < 1) ifTrue:[
- cursorCol := 1
- ]
- ].
- self makeCursorVisible.
-!
-
-cursorX:x y:y
- "put cursor to position next to x/y coordinate in view"
-
- |line col|
-
- line := self visibleLineOfY:y.
- col := self colOfX:x inVisibleLine:line.
- self cursorVisibleLine:line col:col.
-!
-
-cursorLine:line col:col
- "this positions onto physical - not visible - line"
-
- self withCursorOffDo:[
- cursorLine := line.
- cursorVisibleLine := self listLineToVisibleLine:line.
- cursorCol := col.
- (cursorCol < 1) ifTrue:[
- cursorCol := 1
- ]
- ].
- self makeCursorVisible.
-!
-
-cursorToTop
- "move cursor to absolute home"
-
- self cursorLine:1 col:1
-!
-
-gotoLine:aLineNumber
- "position cursor onto line, aLineNumber.
- Make certain that this line is visible"
-
- self makeLineVisible:aLineNumber.
- self cursorLine:aLineNumber col:1
-! !
-
-!EditTextView methodsFor:'undo & again'!
-
-undo
- "currently not implemented"
-
- undoAction notNil ifTrue:[
- undoAction value
- ]
-!
-
-again
- "repeat the last action (which was a cut or replace).
- If current selection is not last string, search forward to
- next occurence of it before repeating the last operation."
-
- |s l c sel|
-
- lastString notNil ifTrue:[
- s := lastString asString.
- "remove final cr"
- s := s copyTo:(s size - 1).
-
- sel := self selection.
-
- "if we are already there (after a find), ommit search"
-
- (sel notNil and:[sel asString withoutSeparators = s]) ifTrue:[
- undoAction := [self insertLines:lastString atLine:cursorLine col:cursorCol].
- l := selectionStartLine "cursorLine".
- c := selectionStartCol "cursorCol".
- self deleteSelection.
- lastReplacement notNil ifTrue:[
- self insertLines:lastReplacement asStringCollection withCr:false.
- self selectFromLine:l col:c toLine:cursorLine col:(cursorCol - 1).
- ].
- ^ true
- ].
-
- self searchForwardFor:s startingAtLine:cursorLine col:cursorCol
- ifFound:
- [
- :line :col |
-
- self selectFromLine:line col:col
- toLine:line col:(col + s size - 1).
- self makeLineVisible:line.
- undoAction := [self insertLines:lastString atLine:line col:col].
-
- self deleteSelection.
- lastReplacement notNil ifTrue:[
- self insertLines:lastReplacement asStringCollection withCr:false.
- self selectFromLine:line col:col toLine:cursorLine col:(cursorCol - 1).
- ].
- ^ true
- ]
- ifAbsent:
- [
- self showNotFound.
- ^ false
- ]
- ]
-!
-
-multipleAgain
- "repeat the last action (which was a cut or replace) until search fails"
-
- [self again] whileTrue:[]
-! !
-
-!EditTextView methodsFor:'menu actions'!
-
-defaultForGotoLine
- "return a default value to show in the gotoLine box"
-
- cursorLine notNil ifTrue:[
- ^ cursorLine
- ].
- ^ super defaultForGotoLine
-!
-
-paste
- "paste copybuffer; if there is a selection, replace it.
- otherwise paste at cursor position. Replace is not done
- for originating by a paste, to allow multiple
- paste."
-
- |sel|
-
- ((self hasSelection == true) and:[typeOfSelection ~~ #paste]) ifTrue:[
- ^ self replace
- ].
- sel := self getTextSelection.
- sel notNil ifTrue:[
- self paste:sel.
- ]
-!
-
-replace
- "replace selection by copybuffer"
-
- |sel|
-
- sel := self getTextSelection.
- sel notNil ifTrue:[
- self replace:sel
- ]
-!
-
-cut
- "cut selection into copybuffer"
-
- |line col history sel|
-
- sel := self selection.
- sel notNil ifTrue:[
- lastString := sel.
- line := selectionStartLine.
- col := selectionStartCol.
- undoAction := [self insertLines:lastString atLine:line col:col].
-
- "
- remember in CopyBuffer
- "
- self setTextSelection:lastString.
-
- "
- append to DeleteHistory (if there is one)
- "
- history := Smalltalk at:#DeleteHistory.
- history notNil ifTrue:[
- history addAll:(lastString asStringCollection).
- history size > 1000 ifTrue:[
- history := history copyFrom:(history size - 1000)
- ].
- ].
-
- "
- now, delete it
- "
- self deleteSelection.
- lastReplacement := nil
- ] ifFalse:[
- "
- a cut without selection will search&cut again
- "
- self again
- ]
-!
-
-paste:someText
- "paste someText at cursor"
-
- |s startLine startCol|
-
- someText notNil ifTrue:[
- s := someText.
- s isString ifTrue:[
- s := s asStringCollection
- ] ifFalse:[
- (s isKindOf:StringCollection) ifFalse:[
- self warn:'selection not convertable to Text'.
- ^ self
- ]
- ].
- startLine := cursorLine.
- startCol := cursorCol.
- self insertLines:s asStringCollection withCr:false.
- self selectFromLine:startLine col:startCol
- toLine:cursorLine col:(cursorCol - 1).
- typeOfSelection := #paste.
- undoAction := [self cut].
- ]
-!
-
-replace:someText
- "replace selection by someText"
-
- |selected selectedString replacement replacementString
- cutOffSpace addSpace|
-
- selected := self selection.
- selected isNil ifTrue:[
- ^ self paste:someText
- ].
- self deleteSelection.
-
- "take care, if we replace a selection without space by a word selected
- with one - in this case we usually do not want the space.
- But, if we replace a word-selected selection by something without a
- space, we DO want the space added."
-
- cutOffSpace := false.
- addSpace := false.
-
- replacement := someText copy.
-
- selected size == 1 ifTrue:[
- selectedString := selected at:1.
- ].
- selectedString notNil ifTrue:[
- ((selectedString startsWith:' ') or:[selectedString endsWith:' ']) ifFalse:[
- "selection has no space"
-
- ((selectStyle == #wordleft) or:[selectStyle == #wordRight]) ifTrue:[
- cutOffSpace := true
- ]
- ] ifTrue:[
- addSpace := true
- ]
- ].
-
- replacement size == 1 ifTrue:[
- replacementString := replacement at:1.
- cutOffSpace ifTrue:[
- (replacementString startsWith:' ') ifTrue:[
- replacementString := replacementString withoutSpaces
- ].
- ] ifFalse:[
- selectStyle == #wordLeft ifTrue:[
- "want a space at left"
- (replacementString startsWith:' ') ifFalse:[
- replacementString := replacementString withoutSpaces.
- replacementString := ' ' , replacementString
- ]
- ].
- selectStyle == #wordRight ifTrue:[
- "want a space at right"
-
- (replacementString endsWith:' ') ifFalse:[
- replacementString := replacementString withoutSpaces.
- replacementString := replacementString , ' '
- ]
- ].
- ].
- replacement at:1 put: replacementString.
- self paste:replacement
- ] ifFalse:[
- self paste:someText.
- ].
- lastString := selectedString.
- lastReplacement := someText
-!
-
-showDeleted
- "open a readonly editor on all deleted text"
-
- |v|
-
- v := EditTextView openWith:(Smalltalk at:#ScratchBuffer).
- v readOnly.
- v topView label:'deleted text'.
-! !
-
-!EditTextView methodsFor:'selections'!
-
-unselect
- "forget and unhilight selection - must take care of cursor here"
-
- self withCursorOffDo:[
- super unselect
- ]
-!
-
-selectCursorLine
- "select cursorline up to cursor position"
-
- self selectFromLine:cursorLine col:1
- toLine:cursorLine col:cursorCol
-!
-
-selectWordUnderCursor
- "select the word under the cursor"
-
- self selectWordAtLine:cursorLine col:cursorCol
-!
-
-selectFromLine:startLine col:startCol toLine:endLine col:endCol
- "when a range is selected, position the cursor behind the selection
- for easier editing. Also typeOfSelection is nilled here."
-
- super selectFromLine:startLine col:startCol toLine:endLine col:endCol.
- self cursorLine:selectionEndLine col:(selectionEndCol + 1).
- typeOfSelection := nil
-!
-
-selectAll
- "select the whole text.
- redefined to send super selectFrom... since we dont want the
- cursor to be moved in this case."
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- super selectFromLine:1 col:1 toLine:(list size + 1) col:0.
- typeOfSelection := nil
- ]
-!
-
-selectFromBeginning
- "select the text from the beginning to the current cursor position."
-
- |col|
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- cursorCol == 0 ifTrue:[
- col := 0
- ] ifFalse:[
- col := cursorCol - 1
- ].
- super selectFromLine:1 col:1 toLine:cursorLine col:col.
- typeOfSelection := nil
- ]
-!
-
-selectUpToEnd
- "select the text from the current cursor position to the end."
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- super selectFromLine:cursorLine col:cursorCol toLine:(list size + 1) col:0.
- typeOfSelection := nil
- ]
-! !
-
-!EditTextView methodsFor:'scrolling'!
-
-originWillChange
- "sent before scrolling - have to hide the cursor"
-
- prevCursorState := cursorShown.
- cursorShown ifTrue:[
- self hideCursor
- ]
-!
-
-originChanged:delta
- "sent after scrolling - have to show the cursor if it was on before"
-
- super originChanged:delta.
- "
- should we move the cursor with the scroll - or leave it ?
- "
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- prevCursorState ifTrue:[
- self showCursor
- ]
-!
-
-pageUp
- "page up - to keep cursor on same visible line, it has to be moved
- within the real text "
-
- |prevCursorLine|
-
- prevCursorLine := cursorVisibleLine.
- super pageUp.
- self cursorVisibleLine:prevCursorLine col:cursorCol
-!
-
-pageDown
- "page down - to keep cursor on same visible line, it has to be moved
- within the real text "
-
- |prevCursorLine|
-
- prevCursorLine := cursorVisibleLine.
- super pageDown.
- self cursorVisibleLine:prevCursorLine col:cursorCol
-! !
-
-!EditTextView methodsFor:'searching'!
-
-setSearchPattern
- "set the searchpattern from the selection if there is one, and position
- cursor to start of pattern"
-
- |sel|
-
- "if last operation was a replcae, set pattern to last
- original string (for search after again)"
-
- (lastString notNil and:[lastReplacement notNil]) ifTrue:[
- searchPattern := lastString asString withoutSeparators.
- ^ self
- ].
-
- sel := self selection.
- sel notNil ifTrue:[
- self cursorLine:selectionStartLine col:selectionStartCol.
- searchPattern := sel asString withoutSeparators
- ]
-!
-
-searchFwd:pattern ifAbsent:aBlock
- "do a forward search"
-
- self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock
-!
-
-searchFwd:pattern startingAtLine:startLine col:startCol ifAbsent:aBlock
- "do a forward search"
-
- cursorLine isNil ifTrue:[^ self].
- self searchForwardFor:pattern startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self cursorLine:line col:col.
- self selectFromLine:line col:col
- toLine:line col:(col + pattern size - 1).
- self makeLineVisible:cursorLine
- ] ifAbsent:aBlock
-!
-
-searchBwd:pattern ifAbsent:aBlock
- "do a backward search"
-
- |startLine startCol|
-
- cursorLine isNil ifTrue:[^ self].
- selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- startCol := selectionStartCol
- ] ifFalse:[
- startLine := cursorLine min:list size.
- startCol := cursorCol
- ].
- self searchBackwardFor:pattern startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self cursorLine:line col:col.
- self selectFromLine:line col:col
- toLine:line col:(col + pattern size - 1).
- self makeLineVisible:cursorLine
- ] ifAbsent:aBlock
-!
-
-searchForMatchingParenthesisFromLine:startLine col:startCol
- ifFound:foundBlock
- ifNotFound:notFoundBlock
- onError:failBlock
-
- "search for a matching parenthesis, parChar is one of '$( $[ ${ $) $] $}'.
- Search for the corresponding character is done forward if its an opening,
- backwards if its a closing parenthesis.
- Performs foundBlock with line/col as argument if found, notFoundBlock if not.
- If there is a nesting error, performs failBlock."
-
- |i direction lineString line col parChar charSet ignoreSet closingChar
- ignoring delta endCol cc incSet decSet nesting maxLine|
-
- charSet := #( $( $) $[ $] ${ $} ).
- ignoreSet := #( $' $" ).
-
- parChar := self characterAtLine:startLine col:startCol.
- i := charSet indexOf:parChar.
- i == 0 ifTrue:[
- ^ failBlock value "not a parenthesis"
- ].
- direction := #( fwd bwd fwd bwd fwd bwd) at:i.
- closingChar := #( $) $( $] $[ $} ${ ) at:i.
-
- col := startCol.
- line := startLine.
- direction == #fwd ifTrue:[
- delta := 1.
- incSet := #( $( $[ ${ ).
- decSet := #( $) $] $} ).
- ] ifFalse:[
- delta := -1.
- incSet := #( $) $] $} ).
- decSet := #( $( $[ ${ ).
- ].
-
- nesting := 1.
- ignoring := false.
- lineString := list at:line.
- maxLine := list size.
-
- col := col + delta.
- [nesting ~~ 0] whileTrue:[
- lineString notNil ifTrue:[
- direction == #fwd ifTrue:[
- endCol := lineString size.
- ] ifFalse:[
- endCol := 1
- ].
- col to:endCol by:delta do:[:runCol |
- cc := lineString at:runCol.
-
- (ignoreSet includes:cc) ifTrue:[
- ignoring := ignoring not
- ].
- ignoring ifFalse:[
- (incSet includes:cc) ifTrue:[
- nesting := nesting + 1
- ] ifFalse:[
- (decSet includes:cc) ifTrue:[
- nesting := nesting - 1
- ]
- ]
- ].
- nesting == 0 ifTrue:[
- "check if legal"
-
- cc == closingChar ifFalse:[
- ^ failBlock value
- ].
- ^ foundBlock value:line value:runCol.
- ]
- ].
- ].
- line := line + delta.
- (line < 1 or:[line > maxLine]) ifTrue:[
- ^ failBlock value
- ].
- lineString := list at:line.
- direction == #fwd ifTrue:[
- col := 1
- ] ifFalse:[
- col := lineString size
- ]
- ].
-
- ^ notFoundBlock value
-!
-
-searchForMatchingParenthesis
- "search for a matching parenthesis starting at cursor position.
- Search for the corresponding character is done forward if its an opening,
- backwards if its a closing parenthesis.
- Positions the cursor if found, peeps if not"
-
- self searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
- ifFound:[:line :col | self cursorLine:line col:col]
- ifNotFound:[self showNotFound]
- onError:[device beep]
-!
-
-searchForAndSelectMatchingParenthesis
- "select characters enclosed by matching parenthesis if one is under cusor"
-
- self searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
- ifFound:[:line :col |
- self selectFromLine:cursorLine col:cursorCol
- toLine:line col:col
- ]
- ifNotFound:[self showNotFound]
- onError:[device beep]
-! !
-
-!EditTextView methodsFor:'redrawing'!
-
-redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
- "redraw the cursor, if it sits in a line range"
-
- cursorShown ifTrue:[
- cursorVisibleLine notNil ifTrue:[
- (cursorVisibleLine between:startVisLine and:endVisLine) ifTrue:[
- self drawCursorCharacter
- ]
- ]
- ]
-!
-
-redrawCursorIfInVisibleLine:visLine
- "redraw the cursor, if it sits in visible line"
-
- cursorShown ifTrue:[
- (visLine == cursorVisibleLine) ifTrue:[
- self drawCursorCharacter
- ]
- ]
-!
-
-redrawFromVisibleLine:startVisLine to:endVisLine
- "redraw a visible line range"
-
- super redrawFromVisibleLine:startVisLine to:endVisLine.
- self redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
-!
-
-redrawVisibleLine:visLine col:colNr
- "redraw the single character in visibleline at colNr"
-
- cursorShown ifTrue:[
- (visLine == cursorVisibleLine) ifTrue:[
- (colNr == cursorCol) ifTrue:[
- self drawCursorCharacter.
- ^ self
- ]
- ]
- ].
- super redrawVisibleLine:visLine col:colNr
-!
-
-redrawVisibleLine:visLine
- "redraw a visible line"
-
- super redrawVisibleLine:visLine.
- self redrawCursorIfInVisibleLine:visLine
-!
-
-redrawVisibleLine:visLine from:startCol
- "redraw a visible line from startCol to the end of line"
-
- super redrawVisibleLine:visLine from:startCol.
- self redrawCursorIfInVisibleLine:visLine
-!
-
-redrawVisibleLine:visLine from:startCol to:endCol
- "redraw a visible line from startCol to endCol"
-
- super redrawVisibleLine:visLine from:startCol to:endCol.
- self redrawCursorIfInVisibleLine:visLine
! !
!EditTextView methodsFor:'event processing'!
-sizeChanged:how
- "make certain, cursor is visible after the sizechange"
-
- |cv|
-
- cv := cursorVisibleLine.
- super sizeChanged:how.
- cv notNil ifTrue:[
- self makeLineVisible:cursorLine
- ]
+buttonRelease:button x:x y:y
+ "move the cursor to the click-position of previous button press"
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ typeOfSelection := nil.
+ selectionStartLine isNil ifTrue:[
+ clickCol notNil ifTrue:[
+ self cursorLine:clickLine col:clickCol
+ ]
+ ] ifFalse:[
+ lastString := nil. "new selection invalidates remembered string"
+ ].
+ self showCursor
+ ].
+ super buttonRelease:button x:x y:y
!
pointerEnter:state x:x y:y
@@ -2424,19 +1846,37 @@
super pointerLeave:state
!
+buttonPress:button x:x y:y
+ "hide the cursor when button is activated"
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ self hideCursor
+ ].
+ (button == #paste) ifTrue:[
+ self paste.
+ ^ self
+ ].
+ super buttonPress:button x:x y:y
+!
+
+sizeChanged:how
+ "make certain, cursor is visible after the sizechange"
+
+ |cv|
+
+ cv := cursorVisibleLine.
+ super sizeChanged:how.
+ cv notNil ifTrue:[
+ self makeLineVisible:cursorLine
+ ]
+!
+
showFocus
hasKeyboardFocus := true.
cursorShown ifTrue: [self drawCursor].
super showFocus
!
-showNoFocus
- hasKeyboardFocus := false.
- cursorShown ifTrue: [self drawCursor].
- super showNoFocus
-
-!
-
keyPress:key x:x y:y
"handle keyboard input"
@@ -2649,32 +2089,580 @@
super keyPress:key x:x y:y
!
-buttonPress:button x:x y:y
- "hide the cursor when button is activated"
-
- ((button == 1) or:[button == #select]) ifTrue:[
- self hideCursor
+showNoFocus
+ hasKeyboardFocus := false.
+ cursorShown ifTrue: [self drawCursor].
+ super showNoFocus
+
+! !
+
+!EditTextView methodsFor:'selections'!
+
+unselect
+ "forget and unhilight selection - must take care of cursor here"
+
+ self withCursorOffDo:[
+ super unselect
+ ]
+!
+
+selectFromLine:startLine col:startCol toLine:endLine col:endCol
+ "when a range is selected, position the cursor behind the selection
+ for easier editing. Also typeOfSelection is nilled here."
+
+ super selectFromLine:startLine col:startCol toLine:endLine col:endCol.
+ self cursorLine:selectionEndLine col:(selectionEndCol + 1).
+ typeOfSelection := nil
+!
+
+selectAll
+ "select the whole text.
+ redefined to send super selectFrom... since we dont want the
+ cursor to be moved in this case."
+
+ list isNil ifTrue:[
+ self unselect
+ ] ifFalse:[
+ super selectFromLine:1 col:1 toLine:(list size + 1) col:0.
+ typeOfSelection := nil
+ ]
+!
+
+selectCursorLine
+ "select cursorline up to cursor position"
+
+ self selectFromLine:cursorLine col:1
+ toLine:cursorLine col:cursorCol
+!
+
+selectWordUnderCursor
+ "select the word under the cursor"
+
+ self selectWordAtLine:cursorLine col:cursorCol
+!
+
+selectFromBeginning
+ "select the text from the beginning to the current cursor position."
+
+ |col|
+
+ list isNil ifTrue:[
+ self unselect
+ ] ifFalse:[
+ cursorCol == 0 ifTrue:[
+ col := 0
+ ] ifFalse:[
+ col := cursorCol - 1
+ ].
+ super selectFromLine:1 col:1 toLine:cursorLine col:col.
+ typeOfSelection := nil
+ ]
+!
+
+selectUpToEnd
+ "select the text from the current cursor position to the end."
+
+ list isNil ifTrue:[
+ self unselect
+ ] ifFalse:[
+ super selectFromLine:cursorLine col:cursorCol toLine:(list size + 1) col:0.
+ typeOfSelection := nil
+ ]
+! !
+
+!EditTextView methodsFor:'formatting'!
+
+indent
+ "indent selected line-range"
+
+ |start end|
+
+ selectionStartLine isNil ifTrue:[^ self].
+ start := selectionStartLine.
+ end := selectionEndLine.
+ (selectionEndCol == 0) ifTrue:[
+ end := end - 1
+ ].
+ self unselect.
+ self indentFromLine:start toLine:end
+!
+
+indentFromLine:start toLine:end
+ "indent a line-range - this is don by searching for the
+ last non-empty line before start, and change the indent
+ of the line based on that indent."
+
+ |leftStart lnr delta d line spaces|
+
+ "find a line to base indent on..."
+ leftStart := 0.
+ lnr := start.
+ [(leftStart == 0) and:[lnr ~~ 1]] whileTrue:[
+ lnr := lnr - 1.
+ leftStart := self leftIndentOfLine:lnr
+ ].
+
+ (leftStart == 0) ifTrue:[^ self].
+
+ delta := leftStart - (self leftIndentOfLine:start).
+ (delta == 0) ifTrue:[^ self].
+ (delta > 0) ifTrue:[
+ 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.
+ ]
+ ]
].
- (button == #paste) ifTrue:[
- self paste.
+ self redrawFromLine:start to:end
+! !
+
+!EditTextView methodsFor:'undo & again'!
+
+undo
+ "currently not implemented"
+
+ undoAction notNil ifTrue:[
+ undoAction value
+ ]
+!
+
+again
+ "repeat the last action (which was a cut or replace).
+ If current selection is not last string, search forward to
+ next occurence of it before repeating the last operation."
+
+ |s l c sel|
+
+ lastString notNil ifTrue:[
+ s := lastString asString.
+ "remove final cr"
+ s := s copyTo:(s size - 1).
+
+ sel := self selection.
+
+ "if we are already there (after a find), ommit search"
+
+ (sel notNil and:[sel asString withoutSeparators = s]) ifTrue:[
+ undoAction := [self insertLines:lastString atLine:cursorLine col:cursorCol].
+ l := selectionStartLine "cursorLine".
+ c := selectionStartCol "cursorCol".
+ self deleteSelection.
+ lastReplacement notNil ifTrue:[
+ self insertLines:lastReplacement asStringCollection withCr:false.
+ self selectFromLine:l col:c toLine:cursorLine col:(cursorCol - 1).
+ ].
+ ^ true
+ ].
+
+ self searchForwardFor:s startingAtLine:cursorLine col:cursorCol
+ ifFound:
+ [
+ :line :col |
+
+ self selectFromLine:line col:col
+ toLine:line col:(col + s size - 1).
+ self makeLineVisible:line.
+ undoAction := [self insertLines:lastString atLine:line col:col].
+
+ self deleteSelection.
+ lastReplacement notNil ifTrue:[
+ self insertLines:lastReplacement asStringCollection withCr:false.
+ self selectFromLine:line col:col toLine:cursorLine col:(cursorCol - 1).
+ ].
+ ^ true
+ ]
+ ifAbsent:
+ [
+ self showNotFound.
+ ^ false
+ ]
+ ]
+!
+
+multipleAgain
+ "repeat the last action (which was a cut or replace) until search fails"
+
+ [self again] whileTrue:[]
+! !
+
+!EditTextView methodsFor:'menu actions'!
+
+paste
+ "paste copybuffer; if there is a selection, replace it.
+ otherwise paste at cursor position. Replace is not done
+ for originating by a paste, to allow multiple
+ paste."
+
+ |sel|
+
+ ((self hasSelection == true) and:[typeOfSelection ~~ #paste]) ifTrue:[
+ ^ self replace
+ ].
+ sel := self getTextSelection.
+ sel notNil ifTrue:[
+ self paste:sel.
+ ]
+!
+
+cut
+ "cut selection into copybuffer"
+
+ |line col history sel|
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ lastString := sel.
+ line := selectionStartLine.
+ col := selectionStartCol.
+ undoAction := [self insertLines:lastString atLine:line col:col].
+
+ "
+ remember in CopyBuffer
+ "
+ self setTextSelection:lastString.
+
+ "
+ append to DeleteHistory (if there is one)
+ "
+ history := Smalltalk at:#DeleteHistory.
+ history notNil ifTrue:[
+ history addAll:(lastString asStringCollection).
+ history size > 1000 ifTrue:[
+ history := history copyFrom:(history size - 1000)
+ ].
+ ].
+
+ "
+ now, delete it
+ "
+ self deleteSelection.
+ lastReplacement := nil
+ ] ifFalse:[
+ "
+ a cut without selection will search&cut again
+ "
+ self again
+ ]
+!
+
+defaultForGotoLine
+ "return a default value to show in the gotoLine box"
+
+ cursorLine notNil ifTrue:[
+ ^ cursorLine
+ ].
+ ^ super defaultForGotoLine
+!
+
+replace
+ "replace selection by copybuffer"
+
+ |sel|
+
+ sel := self getTextSelection.
+ sel notNil ifTrue:[
+ self replace:sel
+ ]
+!
+
+paste:someText
+ "paste someText at cursor"
+
+ |s startLine startCol|
+
+ someText notNil ifTrue:[
+ s := someText.
+ s isString ifTrue:[
+ s := s asStringCollection
+ ] ifFalse:[
+ (s isKindOf:StringCollection) ifFalse:[
+ self warn:'selection not convertable to Text'.
+ ^ self
+ ]
+ ].
+ startLine := cursorLine.
+ startCol := cursorCol.
+ self insertLines:s asStringCollection withCr:false.
+ self selectFromLine:startLine col:startCol
+ toLine:cursorLine col:(cursorCol - 1).
+ typeOfSelection := #paste.
+ undoAction := [self cut].
+ ]
+!
+
+replace:someText
+ "replace selection by someText"
+
+ |selected selectedString replacement replacementString
+ cutOffSpace addSpace|
+
+ selected := self selection.
+ selected isNil ifTrue:[
+ ^ self paste:someText
+ ].
+ self deleteSelection.
+
+ "take care, if we replace a selection without space by a word selected
+ with one - in this case we usually do not want the space.
+ But, if we replace a word-selected selection by something without a
+ space, we DO want the space added."
+
+ cutOffSpace := false.
+ addSpace := false.
+
+ replacement := someText copy.
+
+ selected size == 1 ifTrue:[
+ selectedString := selected at:1.
+ ].
+ selectedString notNil ifTrue:[
+ ((selectedString startsWith:' ') or:[selectedString endsWith:' ']) ifFalse:[
+ "selection has no space"
+
+ ((selectStyle == #wordleft) or:[selectStyle == #wordRight]) ifTrue:[
+ cutOffSpace := true
+ ]
+ ] ifTrue:[
+ addSpace := true
+ ]
+ ].
+
+ replacement size == 1 ifTrue:[
+ replacementString := replacement at:1.
+ cutOffSpace ifTrue:[
+ (replacementString startsWith:' ') ifTrue:[
+ replacementString := replacementString withoutSpaces
+ ].
+ ] ifFalse:[
+ selectStyle == #wordLeft ifTrue:[
+ "want a space at left"
+ (replacementString startsWith:' ') ifFalse:[
+ replacementString := replacementString withoutSpaces.
+ replacementString := ' ' , replacementString
+ ]
+ ].
+ selectStyle == #wordRight ifTrue:[
+ "want a space at right"
+
+ (replacementString endsWith:' ') ifFalse:[
+ replacementString := replacementString withoutSpaces.
+ replacementString := replacementString , ' '
+ ]
+ ].
+ ].
+ replacement at:1 put: replacementString.
+ self paste:replacement
+ ] ifFalse:[
+ self paste:someText.
+ ].
+ lastString := selectedString.
+ lastReplacement := someText
+!
+
+showDeleted
+ "open a readonly editor on all deleted text"
+
+ |v|
+
+ v := EditTextView openWith:(Smalltalk at:#ScratchBuffer).
+ v readOnly.
+ v topView label:'deleted text'.
+! !
+
+!EditTextView methodsFor:'searching'!
+
+setSearchPattern
+ "set the searchpattern from the selection if there is one, and position
+ cursor to start of pattern"
+
+ |sel|
+
+ "if last operation was a replcae, set pattern to last
+ original string (for search after again)"
+
+ (lastString notNil and:[lastReplacement notNil]) ifTrue:[
+ searchPattern := lastString asString withoutSeparators.
^ self
].
- super buttonPress:button x:x y:y
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ self cursorLine:selectionStartLine col:selectionStartCol.
+ searchPattern := sel asString withoutSeparators
+ ]
+!
+
+searchFwd:pattern startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
+ cursorLine isNil ifTrue:[^ self].
+ self searchForwardFor:pattern startingAtLine:startLine col:startCol
+ ifFound:[:line :col |
+ self cursorLine:line col:col.
+ self selectFromLine:line col:col
+ toLine:line col:(col + pattern size - 1).
+ self makeLineVisible:cursorLine
+ ] ifAbsent:aBlock
+!
+
+searchFwd:pattern ifAbsent:aBlock
+ "do a forward search"
+
+ self searchFwd:pattern startingAtLine:cursorLine col:cursorCol ifAbsent:aBlock
+!
+
+searchBwd:pattern ifAbsent:aBlock
+ "do a backward search"
+
+ |startLine startCol|
+
+ cursorLine isNil ifTrue:[^ self].
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ startLine := cursorLine min:list size.
+ startCol := cursorCol
+ ].
+ self searchBackwardFor:pattern startingAtLine:startLine col:startCol
+ ifFound:[:line :col |
+ self cursorLine:line col:col.
+ self selectFromLine:line col:col
+ toLine:line col:(col + pattern size - 1).
+ self makeLineVisible:cursorLine
+ ] ifAbsent:aBlock
!
-buttonRelease:button x:x y:y
- "move the cursor to the click-position of previous button press"
-
- ((button == 1) or:[button == #select]) ifTrue:[
- typeOfSelection := nil.
- selectionStartLine isNil ifTrue:[
- clickCol notNil ifTrue:[
- self cursorLine:clickLine col:clickCol
- ]
+searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+
+ "search for a matching parenthesis, parChar is one of '$( $[ ${ $) $] $}'.
+ Search for the corresponding character is done forward if its an opening,
+ backwards if its a closing parenthesis.
+ Performs foundBlock with line/col as argument if found, notFoundBlock if not.
+ If there is a nesting error, performs failBlock."
+
+ |i direction lineString line col parChar charSet ignoreSet closingChar
+ ignoring delta endCol cc incSet decSet nesting maxLine|
+
+ charSet := #( $( $) $[ $] ${ $} ).
+ ignoreSet := #( $' $" ).
+
+ parChar := self characterAtLine:startLine col:startCol.
+ i := charSet indexOf:parChar.
+ i == 0 ifTrue:[
+ ^ failBlock value "not a parenthesis"
+ ].
+ direction := #( fwd bwd fwd bwd fwd bwd) at:i.
+ closingChar := #( $) $( $] $[ $} ${ ) at:i.
+
+ col := startCol.
+ line := startLine.
+ direction == #fwd ifTrue:[
+ delta := 1.
+ incSet := #( $( $[ ${ ).
+ decSet := #( $) $] $} ).
+ ] ifFalse:[
+ delta := -1.
+ incSet := #( $) $] $} ).
+ decSet := #( $( $[ ${ ).
+ ].
+
+ nesting := 1.
+ ignoring := false.
+ lineString := list at:line.
+ maxLine := list size.
+
+ col := col + delta.
+ [nesting ~~ 0] whileTrue:[
+ lineString notNil ifTrue:[
+ direction == #fwd ifTrue:[
+ endCol := lineString size.
+ ] ifFalse:[
+ endCol := 1
+ ].
+ col to:endCol by:delta do:[:runCol |
+ cc := lineString at:runCol.
+
+ (ignoreSet includes:cc) ifTrue:[
+ ignoring := ignoring not
+ ].
+ ignoring ifFalse:[
+ (incSet includes:cc) ifTrue:[
+ nesting := nesting + 1
+ ] ifFalse:[
+ (decSet includes:cc) ifTrue:[
+ nesting := nesting - 1
+ ]
+ ]
+ ].
+ nesting == 0 ifTrue:[
+ "check if legal"
+
+ cc == closingChar ifFalse:[
+ ^ failBlock value
+ ].
+ ^ foundBlock value:line value:runCol.
+ ]
+ ].
+ ].
+ line := line + delta.
+ (line < 1 or:[line > maxLine]) ifTrue:[
+ ^ failBlock value
+ ].
+ lineString := list at:line.
+ direction == #fwd ifTrue:[
+ col := 1
] ifFalse:[
- lastString := nil. "new selection invalidates remembered string"
- ].
- self showCursor
+ col := lineString size
+ ]
].
- super buttonRelease:button x:x y:y
+
+ ^ notFoundBlock value
+!
+
+searchForMatchingParenthesis
+ "search for a matching parenthesis starting at cursor position.
+ Search for the corresponding character is done forward if its an opening,
+ backwards if its a closing parenthesis.
+ Positions the cursor if found, peeps if not"
+
+ self searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
+ ifFound:[:line :col | self cursorLine:line col:col]
+ ifNotFound:[self showNotFound]
+ onError:[device beep]
+!
+
+searchForAndSelectMatchingParenthesis
+ "select characters enclosed by matching parenthesis if one is under cusor"
+
+ self searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
+ ifFound:[:line :col |
+ self selectFromLine:cursorLine col:cursorCol
+ toLine:line col:col
+ ]
+ ifNotFound:[self showNotFound]
+ onError:[device beep]
! !
+
--- a/EnterBox.st Sat Mar 18 06:16:33 1995 +0100
+++ b/EnterBox.st Sat Mar 18 06:16:50 1995 +0100
@@ -37,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.17 1995-03-09 02:11:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.18 1995-03-18 05:14:29 claus Exp $
"
!
@@ -316,9 +316,11 @@
changedObject == enterField ifTrue:[
something == #preferedExtent ifTrue:[
- shown ifTrue:[self resize]
+ shown ifTrue:[self resize].
+ ^ self
]
- ]
+ ].
+ super update:something with:someArgument from:changedObject
! !
!EnterBox methodsFor:'queries'!
--- a/HVScrView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/HVScrView.st Sat Mar 18 06:16:50 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.9 1994-11-21 16:45:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.10 1995-03-18 05:14:47 claus Exp $
written jan 91 by claus
'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.9 1994-11-21 16:45:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.10 1995-03-18 05:14:47 claus Exp $
"
!
@@ -224,6 +224,19 @@
self setScrollActions
! !
+!HVScrollableView methodsFor:'queries'!
+
+preferedExtent
+ scrolledView notNil ifTrue:[
+ | pref |
+ pref := scrolledView preferedExtent.
+ ^ (pref x + scrollBar width + (innerMargin * 2))
+ @
+ (pref y + hScrollBar height + (innerMargin * 2)).
+ ].
+ ^ super preferedExtent.
+! !
+
!HVScrollableView methodsFor:'changes '!
update:something with:argument from:changedObject
--- a/HVScrollableView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/HVScrollableView.st Sat Mar 18 06:16:50 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/HVScrollableView.st,v 1.9 1994-11-21 16:45:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HVScrollableView.st,v 1.10 1995-03-18 05:14:47 claus Exp $
written jan 91 by claus
'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/HVScrollableView.st,v 1.9 1994-11-21 16:45:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HVScrollableView.st,v 1.10 1995-03-18 05:14:47 claus Exp $
"
!
@@ -224,6 +224,19 @@
self setScrollActions
! !
+!HVScrollableView methodsFor:'queries'!
+
+preferedExtent
+ scrolledView notNil ifTrue:[
+ | pref |
+ pref := scrolledView preferedExtent.
+ ^ (pref x + scrollBar width + (innerMargin * 2))
+ @
+ (pref y + hScrollBar height + (innerMargin * 2)).
+ ].
+ ^ super preferedExtent.
+! !
+
!HVScrollableView methodsFor:'changes '!
update:something with:argument from:changedObject
--- a/Label.st Sat Mar 18 06:16:33 1995 +0100
+++ b/Label.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,23 +10,21 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:13:27 am'!
+
View subclass:#Label
- instanceVariableNames:'logo
- labelWidth labelHeight
- labelOriginX labelOriginY
- adjust hSpace vSpace
- bgColor fgColor fixSize'
- classVariableNames:'DefaultFont
- DefaultForegroundColor DefaultBackgroundColor'
- poolDictionaries:''
- category:'Views-Layout'
+ instanceVariableNames:'logo labelWidth labelHeight labelOriginX labelOriginY adjust
+ hSpace vSpace bgColor fgColor fixSize'
+ classVariableNames:'DefaultFont DefaultForegroundColor DefaultBackgroundColor'
+ poolDictionaries:''
+ category:'Views-Layout'
!
Label comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.17 1995-03-06 19:28:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.18 1995-03-18 05:14:54 claus Exp $
'!
!Label class methodsFor:'documentation'!
@@ -47,7 +45,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.17 1995-03-06 19:28:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.18 1995-03-18 05:14:54 claus Exp $
"
!
@@ -286,6 +284,20 @@
"
! !
+!Label class methodsFor:'instance creation'!
+
+form:aForm
+ "return a new Label showing a form"
+
+ ^ (self on:Display) form:aForm
+!
+
+form:aForm in:aView
+ "return a new Label showing a form"
+
+ ^ (self in:aView) form:aForm
+! !
+
!Label class methodsFor:'defaults'!
defaultExtent
@@ -310,38 +322,146 @@
"
! !
-!Label class methodsFor:'instance creation'!
+!Label methodsFor:'event handling'!
+
+sizeChanged:how
+ "sent whenever size is changed by someone else - recompute the
+ logos position within the View."
+
+ |prevPosition|
+
+ super sizeChanged:how.
+ prevPosition := labelOriginX.
+ self computeLabelOrigin
+ shown ifTrue:[
+ labelOriginX ~~ prevPosition ifTrue:[
+ self redraw
+ ]
+ ]
+! !
+
+!Label methodsFor:'accessing'!
+
+foregroundColor:aColor
+ "set the foreground color"
+
+ fgColor := aColor on:device.
+ self redraw
+!
+
+foregroundColor
+ "return the foreground color"
+
+ ^ fgColor
+!
+
+label:aString
+ "set the label-string; adjust extent if not already realized"
+
+ (logo = aString) ifFalse:[
+ logo := aString.
+ self newLayout
+ ]
+!
+
+backgroundColor:aColor
+ "set the background color"
+
+ bgColor := aColor on:device.
+ self redraw
+!
+
+backgroundColor
+ "return the background color"
+
+ ^ bgColor
+!
+
+foregroundColor:fg backgroundColor:bg
+ "set the colors to be used for drawing"
+
+ fgColor := fg on:device.
+ bgColor := bg on:device.
+ self redraw
+!
form:aForm
- "return a new Label showing a form"
+ "set the labels form; adjust extent if not already realized"
+
+ (aForm notNil and:[aForm ~~ logo]) ifTrue:[
+ logo notNil ifTrue:[
+ logo isImageOrForm ifTrue:[
+ logo extent = aForm extent ifTrue:[
+ logo := aForm.
+ ^ self
+ ]
+ ]
+ ].
+ logo := aForm.
+ self newLayout
+ ]
+!
- ^ (self on:Display) form:aForm
+label
+ "return the labels string"
+
+ ^ logo
+!
+
+sizeFixed:aBoolean
+ "set/clear the fix-size attribute (will not change size on label-change)"
+
+ fixSize := aBoolean
+!
+
+sizeFixed
+ "return the fix-size attribute"
+
+ ^ fixSize
!
-form:aForm in:aView
- "return a new Label showing a form"
+labelWidth
+ "return the logos width in pixels"
+
+ ^ labelWidth
+!
+
+adjust:how
+ "set the adjust, how which must be one of
- ^ (self in:aView) form:aForm
+ #left -> left adjust logo
+ #right -> right adjust logo
+ #center -> center logo
+ #centerLeft -> center logo; if it does not fit, left adjust it
+ #centerRight -> center logo; if no fit, right adjust
+ "
+ (adjust ~~ how) ifTrue:[
+ adjust := how.
+ self newLayout
+ ]
+!
+
+font:aFont
+ "set the font - if I'm not realized, adjust my size"
+
+ (aFont ~~ font) ifTrue:[
+ super font:(aFont on:device).
+ self newLayout
+ ]
+!
+
+logo:something
+ "set the labels form or string"
+
+ logo isImageOrForm ifTrue:[
+ self form:something
+ ] ifFalse:[
+ self label:something
+ ]
! !
!Label methodsFor:'initialization'!
-initialize
- super initialize.
-
- font := font on:device.
- self height:(font height + font descent).
- adjust := #center.
- labelOriginX := 0.
- labelOriginY := 0.
- labelWidth := 0.
- labelHeight := 0.
- logo := nil.
- fixSize := false.
- hSpace := (self horizontalPixelPerMillimeter:0.5) rounded.
- vSpace := (self verticalPixelPerMillimeter:0.5) rounded
-!
-
initStyle
super initStyle.
@@ -364,6 +484,22 @@
bgColor := bgColor on:device.
!
+initialize
+ super initialize.
+
+ font := font on:device.
+ self height:(font height + font descent).
+ adjust := #center.
+ labelOriginX := 0.
+ labelOriginY := 0.
+ labelWidth := 0.
+ labelHeight := 0.
+ logo := nil.
+ fixSize := false.
+ hSpace := (self horizontalPixelPerMillimeter:0.5) rounded.
+ vSpace := (self verticalPixelPerMillimeter:0.5) rounded
+!
+
recreate
"after snapin, labels dimensions may have changed due to
different font parameters"
@@ -374,288 +510,6 @@
self computeLabelOrigin
! !
-!Label methodsFor:'accessing'!
-
-foregroundColor
- "return the foreground color"
-
- ^ fgColor
-!
-
-foregroundColor:aColor
- "set the foreground color"
-
- fgColor := aColor on:device.
- self redraw
-!
-
-backgroundColor
- "return the background color"
-
- ^ bgColor
-!
-
-backgroundColor:aColor
- "set the background color"
-
- bgColor := aColor on:device.
- self redraw
-!
-
-foregroundColor:fg backgroundColor:bg
- "set the colors to be used for drawing"
-
- fgColor := fg on:device.
- bgColor := bg on:device.
- self redraw
-!
-
-sizeFixed:aBoolean
- "set/clear the fix-size attribute (will not change size on label-change)"
-
- fixSize := aBoolean
-!
-
-sizeFixed
- "return the fix-size attribute"
-
- ^ fixSize
-!
-
-label:aString
- "set the label-string; adjust extent if not already realized"
-
- (logo = aString) ifFalse:[
- logo := aString.
- self newLayout
- ]
-!
-
-label
- "return the labels string"
-
- ^ logo
-!
-
-labelWidth
- "return the logos width in pixels"
-
- ^ labelWidth
-!
-
-font:aFont
- "set the font - if I'm not realized, adjust my size"
-
- (aFont ~~ font) ifTrue:[
- super font:(aFont on:device).
- self newLayout
- ]
-!
-
-adjust:how
- "set the adjust, how which must be one of
-
- #left -> left adjust logo
- #right -> right adjust logo
- #center -> center logo
- #centerLeft -> center logo; if it does not fit, left adjust it
- #centerRight -> center logo; if no fit, right adjust
- "
- (adjust ~~ how) ifTrue:[
- adjust := how.
- self newLayout
- ]
-!
-
-form:aForm
- "set the labels form; adjust extent if not already realized"
-
- (aForm notNil and:[aForm ~~ logo]) ifTrue:[
- logo notNil ifTrue:[
- logo isImageOrForm ifTrue:[
- logo extent = aForm extent ifTrue:[
- logo := aForm.
- ^ self
- ]
- ]
- ].
- logo := aForm.
- self newLayout
- ]
-!
-
-logo:something
- "set the labels form or string"
-
- logo isImageOrForm ifTrue:[
- self form:something
- ] ifFalse:[
- self label:something
- ]
-! !
-
-!Label methodsFor:'change & update'!
-
-update:something
- "the MVC way of changing the label ..."
-
- (aspectSymbol notNil
- and:[something == aspectSymbol]) ifTrue:[
- model notNil ifTrue:[
- self label:(model perform: aspectSymbol) printString.
- ].
- ^ self.
- ].
- super update:something
-! !
-
-!Label methodsFor:'queries'!
-
-preferedExtent
- "return my prefered extent - this is the minimum size I would like to have"
-
- |extra|
-
- logo notNil ifTrue:[
- extra := margin * 2.
- ^ (labelWidth + extra) @ (labelHeight + extra)
- ].
-
- ^ super preferedExtent
-! !
-
-!Label methodsFor:'private'!
-
-newLayout
- "recompute position/size after a change
- - helper for form:/font: etc."
-
- self computeLabelSize.
- fixSize ifFalse:[
- self resize
- ] ifTrue:[
- self computeLabelOrigin
- ].
- shown ifTrue:[
- self redraw
- ]
-!
-
-resize
- "resize myself to make text fit into myself.
- but only do so, if I have not been given a relative extent
- or an extend computation block."
-
- |extra|
-
- logo notNil ifTrue:[
- (relativeExtent isNil and:[extentRule isNil]) ifTrue:[
- (relativeCorner isNil and:[cornerRule isNil]) ifTrue:[
- extra := margin * 2.
- self extent:(labelWidth + extra) @ (labelHeight + extra)
- ].
- ].
- self computeLabelOrigin
- ]
-!
-
-computeLabelSize
- "compute the extent needed to hold the label; aForm or aString"
-
- |numberOfLines textHeight textWidth|
-
- logo isNil ifTrue:[^ self].
-
- logo isImageOrForm ifTrue:[
- labelWidth := logo width.
- labelHeight := logo height.
- ^ self
- ].
-
- "must be a String or collection of strings"
- logo isString ifTrue:[
- numberOfLines := 1 + (logo occurrencesOf:(Character cr)).
- (numberOfLines ~~ 1) ifTrue:[
- logo := logo asStringCollection
- ]
- ] ifFalse:[
- numberOfLines := logo size.
- (numberOfLines == 1) ifTrue:[
- logo := logo asString
- ]
- ].
-
- textHeight := font height * numberOfLines + font descent.
- textWidth := font widthOf:logo.
- labelWidth := textWidth + (hSpace * 2) .
- labelHeight := textHeight + (vSpace * 2)
-!
-
-computeLabelOrigin
- "(re)compute the origin of the label whenever label or font changes"
-
- |x y|
-
- labelHeight isNil ifTrue:[^ self].
-
- "if it does not fit, should we make the origin visible,
- or the center (for text, the center seems better. For images,
- I dont really know ehich is better ...
- The commented code below makes the origin visible
- "
-"/ (labelHeight < height) ifTrue:[
-"/ y := (height - labelHeight) // 2
-"/ ] ifFalse:[
-"/ y := 0
-"/ ].
-
- "always center vertically"
- y := (height - labelHeight) // 2.
-
- labelOriginY := y.
-
- (((adjust == #center)
- or:[adjust == #centerRight])
- or:[adjust == #centerLeft]) ifTrue:[
- " center text/form in button "
- x := (width - labelWidth) // 2.
- (width < labelWidth) ifTrue:[
- "no fit"
- (adjust == #centerLeft) ifTrue:[
- x := margin
- ] ifFalse:[
- (adjust == #centerRight) ifTrue:[
- x := width - labelWidth - margin
- ]
- ]
- ]
- ] ifFalse:[
- (adjust == #left) ifTrue:[
- x := margin
- ] ifFalse:[
- x := width - labelWidth - margin
- ]
- ].
- labelOriginX := x
-! !
-
-!Label methodsFor:'event handling'!
-
-sizeChanged:how
- "sent whenever size is changed by someone else - recompute the
- logos position within the View."
-
- |prevPosition|
-
- prevPosition := labelOriginX.
- self computeLabelOrigin
- shown ifTrue:[
- labelOriginX ~~ prevPosition ifTrue:[
- self redraw
- ]
- ]
-! !
-
!Label methodsFor:'redrawing'!
clearInsideWith:bg
@@ -721,3 +575,149 @@
self drawWith:fgColor and:bgColor
]
! !
+
+!Label methodsFor:'private'!
+
+newLayout
+ "recompute position/size after a change
+ - helper for form:/font: etc."
+
+ self computeLabelSize.
+ fixSize ifFalse:[
+ self resize
+ ] ifTrue:[
+ self computeLabelOrigin
+ ].
+ shown ifTrue:[
+ self redraw
+ ]
+!
+
+computeLabelOrigin
+ "(re)compute the origin of the label whenever label or font changes"
+
+ |x y|
+
+ labelHeight isNil ifTrue:[^ self].
+
+ "if it does not fit, should we make the origin visible,
+ or the center (for text, the center seems better. For images,
+ I dont really know ehich is better ...
+ The commented code below makes the origin visible
+ "
+"/ (labelHeight < height) ifTrue:[
+"/ y := (height - labelHeight) // 2
+"/ ] ifFalse:[
+"/ y := 0
+"/ ].
+
+ "always center vertically"
+ y := (height - labelHeight) // 2.
+
+ labelOriginY := y.
+
+ (((adjust == #center)
+ or:[adjust == #centerRight])
+ or:[adjust == #centerLeft]) ifTrue:[
+ " center text/form in button "
+ x := (width - labelWidth) // 2.
+ (width < labelWidth) ifTrue:[
+ "no fit"
+ (adjust == #centerLeft) ifTrue:[
+ x := margin
+ ] ifFalse:[
+ (adjust == #centerRight) ifTrue:[
+ x := width - labelWidth - margin
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ (adjust == #left) ifTrue:[
+ x := margin
+ ] ifFalse:[
+ x := width - labelWidth - margin
+ ]
+ ].
+ labelOriginX := x
+!
+
+computeLabelSize
+ "compute the extent needed to hold the label; aForm or aString"
+
+ |numberOfLines textHeight textWidth|
+
+ logo isNil ifTrue:[^ self].
+
+ logo isImageOrForm ifTrue:[
+ labelWidth := logo width.
+ labelHeight := logo height.
+ ^ self
+ ].
+
+ "must be a String or collection of strings"
+ logo isString ifTrue:[
+ numberOfLines := 1 + (logo occurrencesOf:(Character cr)).
+ (numberOfLines ~~ 1) ifTrue:[
+ logo := logo asStringCollection
+ ]
+ ] ifFalse:[
+ numberOfLines := logo size.
+ (numberOfLines == 1) ifTrue:[
+ logo := logo asString
+ ]
+ ].
+
+ textHeight := font height * numberOfLines + font descent.
+ textWidth := font widthOf:logo.
+ labelWidth := textWidth + (hSpace * 2) .
+ labelHeight := textHeight + (vSpace * 2)
+!
+
+resize
+ "resize myself to make text fit into myself.
+ but only do so, if I have not been given a relative extent
+ or an extend computation block."
+
+ |extra|
+
+ logo notNil ifTrue:[
+ (relativeExtent isNil and:[extentRule isNil]) ifTrue:[
+ (relativeCorner isNil and:[cornerRule isNil]) ifTrue:[
+ extra := margin * 2.
+ self extent:(labelWidth + extra) @ (labelHeight + extra)
+ ].
+ ].
+ self computeLabelOrigin
+ ]
+! !
+
+!Label methodsFor:'change & update'!
+
+update:something
+ "the MVC way of changing the label ..."
+
+ (aspectSymbol notNil
+ and:[something == aspectSymbol]) ifTrue:[
+ model notNil ifTrue:[
+ self label:(model perform: aspectSymbol) printString.
+ ].
+ ^ self.
+ ].
+ super update:something
+! !
+
+!Label methodsFor:'queries'!
+
+preferedExtent
+ "return my prefered extent - this is the minimum size I would like to have"
+
+ |extra|
+
+ logo notNil ifTrue:[
+ extra := margin * 2.
+ ^ (labelWidth + extra) @ (labelHeight + extra)
+ ].
+
+ ^ super preferedExtent
+! !
+
--- a/ListView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/ListView.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,34 +10,26 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 10:59:34 am'!
+
View subclass:#ListView
- instanceVariableNames:'list
- attributes
- firstLineShown leftOffset
- nFullLinesShown nLinesShown
- fgColor bgColor
- partialLines
- leftMargin topMargin
- textStartLeft textStartTop innerWidth
- tabPositions lineSpacing
- fontHeight fontAscent
- fontIsFixedWidth fontWidth
- normalFont boldFont italicFont
- autoScrollBlock autoScrollDeltaT
- searchPattern wordCheck
- includesNonStrings widthOfWidestLine
- printItems listSymbol'
- classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
- DefaultFont'
- poolDictionaries:''
- category:'Views-Text'
+ instanceVariableNames:'list attributes firstLineShown leftOffset nFullLinesShown
+ nLinesShown fgColor bgColor partialLines leftMargin topMargin
+ textStartLeft textStartTop innerWidth tabPositions lineSpacing
+ fontHeight fontAscent fontIsFixedWidth fontWidth normalFont
+ boldFont italicFont autoScrollBlock autoScrollDeltaT
+ searchPattern wordCheck includesNonStrings widthOfWidestLine
+ printItems listSymbol'
+ classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultFont'
+ poolDictionaries:''
+ category:'Views-Text'
!
ListView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.19 1995-02-27 10:39:19 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.20 1995-03-18 05:15:02 claus Exp $
'!
!ListView class methodsFor:'documentation'!
@@ -58,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.19 1995-02-27 10:39:19 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.20 1995-03-18 05:15:02 claus Exp $
"
!
@@ -118,6 +110,14 @@
!ListView class methodsFor:'defaults'!
+tab8Positions
+ ^ #(1 9 17 25 33 41 49 57 65 73 81 89 97 105 113 121 129 137 145)
+!
+
+defaultTabPositions
+ ^ self tab8Positions
+!
+
updateStyleCache
DefaultForegroundColor := StyleSheet colorAt:'textForegroundColor' default:Black.
DefaultBackgroundColor := StyleSheet colorAt:'textBackgroundColor' default:White.
@@ -127,163 +127,26 @@
tab4Positions
^ #(1 5 9 13 17 21 25 29 33 37 41 45 49 53 57 61 65 69 73 77 81
85 89 93 97 101 105 109 113 114 121 125 129 133 137 141 145)
-!
-
-tab8Positions
- ^ #(1 9 17 25 33 41 49 57 65 73 81 89 97 105 113 121 129 137 145)
-!
-
-defaultTabPositions
- ^ self tab8Positions
! !
-!ListView methodsFor:'initialization'!
-
-initialize
- device width <= 800 ifTrue:[
- "
- some more pixels of real estate ...
- "
- leftMargin := topMargin := 1
- ] ifFalse:[
- leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
- topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
- ].
-
- super initialize.
-
- bitGravity := #NorthWest.
- list := nil.
- firstLineShown := 1.
- nFullLinesShown := 1. "just any value ..."
- nLinesShown := 1. "just any value"
- leftOffset := 0.
- partialLines := true.
- tabPositions := self class defaultTabPositions.
- textStartLeft := leftMargin + margin.
- textStartTop := topMargin + margin.
- innerWidth := width - textStartLeft - (margin * 2).
- self getFontParameters.
- wordCheck := [:char | char isNationalAlphaNumeric].
- includesNonStrings := false
-!
-
-initStyle
- super initStyle.
-
- lineSpacing := 0.
- fgColor := DefaultForegroundColor on:device.
- bgColor := DefaultBackgroundColor on:device.
- DefaultFont notNil ifTrue:[font := DefaultFont on:device]
-!
-
-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
-!
-
-recreate
- "recreate after a snapin"
-
- super recreate.
-
- "recompute margins and font parameters
- - display may have different resolution."
-
- leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
- topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
- textStartLeft := leftMargin + margin.
- textStartTop := topMargin + margin.
- innerWidth := width - textStartLeft - margin.
- self getFontParameters
+!ListView methodsFor:'accessing-contents'!
+
+size
+ ^ list size.
!
-realize
- extentChanged ifTrue:[
- self computeNumberOfLinesShown.
- ].
- firstLineShown ~~ 1 ifTrue:[
- firstLineShown + nLinesShown > list size ifTrue:[
- self scrollToLine:list size - nLinesShown.
- ]
- ].
- super realize
-! !
-
-!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
- ]
- ]
-!
-
-foregroundColor
- "return the foreground color"
-
- ^ fgColor
+at:lineNr
+ "retrieve a line; return nil if beyond end-of-text"
+
+ list isNil ifTrue:[^ nil].
+ (lineNr between:1 and:self size) ifFalse:[^ nil].
+ ^ list at:lineNr
!
-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
- ]
- ]
-!
-
-partialLines:aBoolean
- "allow/disallow display of a last partial line"
-
- partialLines := aBoolean.
- self computeNumberOfLinesShown
-!
-
-leftMargin:aNumber
- "set the margin to left of 1st col"
-
- leftMargin := aNumber.
- textStartLeft := leftMargin + margin.
- innerWidth := width - textStartLeft - margin
-!
-
-leftMargin
- "return the margin to left of 1st col"
-
- ^ leftMargin
+from:from to:to do:aBlock
+ ^ list from:from to:to do:aBlock.
+
+
!
setList:aCollection expandTabs:expandTabs
@@ -310,9 +173,9 @@
self contentsChanged.
"/ new - reposition if too big
- (firstLineShown + nFullLinesShown) > list size ifTrue:[
+ (firstLineShown + nFullLinesShown) > self size ifTrue:[
oldFirst := firstLineShown.
- firstLineShown := list size - nFullLinesShown + 1.
+ firstLineShown := self size - nFullLinesShown + 1.
firstLineShown < 1 ifTrue:[firstLineShown := 1].
self originChanged:(oldFirst - 1) negated.
shown ifTrue:[
@@ -323,15 +186,72 @@
shown ifTrue:[
self redrawFromVisibleLine:1 to:nLinesShown
]
+
!
-setList:aCollection
- "set the contents (a collection of strings);
+withoutRedrawAt:index put:aString
+ "change a line and redisplay"
+
+ 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.
+ ]
+ ].
+!
+
+at:index put:aString
+ "change a line and redisplay"
+
+ self withoutRedrawAt:index put:aString.
+ shown ifTrue:[
+ self redrawLine:index
+ ]
+!
+
+list
+ "return the contents as a collection of strings"
+
+ ^ list
+!
+
+setContents:something
+ "set the contents (either a string or a Collection of strings)
dont change position (i.e. do not scroll).
This can be used to update a self-changing list
- (for example: a file list being shown, without disturbing user too much)"
-
- ^ self setList:aCollection expandTabs:true
+ (for example: a file list being shown, without disturbing user too much)."
+
+ |l oldSize|
+
+ oldSize := self size.
+ l := something.
+ l notNil ifTrue:[
+ l isString ifTrue:[
+ l := l asStringCollection
+ ]
+ ].
+ self setList:l.
+ self size ~~ oldSize ifTrue:[
+ self contentsChanged
+ ]
+!
+
+contents:something
+ "set the contents (either a string or a Collection of strings)
+ also scroll to top-left"
+
+ |l|
+
+ l := something.
+ l notNil ifTrue:[
+ l isString ifTrue:[
+ l := l asStringCollection
+ ]
+ ].
+ self list:l
!
list:aCollection
@@ -368,42 +288,13 @@
]
!
-list
- "return the contents as a collection of strings"
-
- ^ list
-!
-
-setContents:something
- "set the contents (either a string or a Collection of strings)
+setList:aCollection
+ "set the contents (a collection of strings);
dont change position (i.e. do not scroll).
This can be used to update a self-changing list
- (for example: a file list being shown, without disturbing user too much)."
-
- |l|
-
- l := something.
- l notNil ifTrue:[
- l isString ifTrue:[
- l := l asStringCollection
- ]
- ].
- self setList:l
-!
-
-contents:something
- "set the contents (either a string or a Collection of strings)
- also scroll to top-left"
-
- |l|
-
- l := something.
- l notNil ifTrue:[
- l isString ifTrue:[
- l := l asStringCollection
- ]
- ].
- self list:l
+ (for example: a file list being shown, without disturbing user too much)"
+
+ ^ self setList:aCollection expandTabs:true
!
contents
@@ -413,35 +304,12 @@
^ list asString
!
-at:index put:aString
- "change a line and redisplay"
-
- 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 redrawLine:index
- ]
-!
-
-at:index
- "retrieve a line; return nil if behond end-of-text"
-
- ^ self listAt:index
-!
-
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 > list size]) ifTrue:[^ false].
+ (list isNil or:[lineNr > self size]) ifTrue:[^ false].
list removeIndex:lineNr.
lineNr < firstLineShown ifTrue:[
@@ -481,201 +349,201 @@
]
!
-font:aFont
- "set the font for all shown text.
- Redraws everything."
-
- aFont isNil ifTrue:[
- ^ self error:'nil font'
+add:aString beforeIndex:index
+ "add a line and redisplay"
+
+ list add:aString beforeIndex:index.
+ includesNonStrings ifFalse:[
+ includesNonStrings := (aString notNil and:[aString isString not]).
+ ].
+ shown ifTrue:[
+ self redrawFromLine:index.
+ self contentsChanged. "recompute scrollbars"
+ ]
+
+!
+
+grow:n
+ "grow our list"
+ ^ list grow:n.
+
+
+!
+
+add:aString
+ "add a line and redisplay"
+
+ list add:aString.
+ includesNonStrings ifFalse:[
+ includesNonStrings := (aString notNil and:[aString isString not]).
].
- font ~~ aFont ifTrue:[
- super font:aFont.
- realized ifTrue:[
- (font device == device) ifTrue:[
- self getFontParameters.
- self computeNumberOfLinesShown.
- shown ifTrue:[
- self redrawFromVisibleLine:1 to:nLinesShown
- ]
- ].
+ shown ifTrue:[
+ self redrawLine:(self size).
+ self contentsChanged. "recompute scrollbars"
+ ]
+
+! !
+
+!ListView methodsFor:'private'!
+
+visibleLineToListLine:visibleLineNr
+ "given a visible line (1..) return linenr in list or nil
+ (this one returns nil if the given visibleLineNr is one of the
+ separators)"
+
+ |listLineNr "{ Class: SmallInteger }"
+ listsize "{ Class: SmallInteger }" |
+
+ visibleLineNr isNil ifTrue:[^ nil].
+ listLineNr := visibleLineNr + firstLineShown - 1.
+ (listLineNr == 0) ifTrue:[^nil].
+ listsize := self size.
+ (listLineNr <= listsize) ifTrue:[^ listLineNr].
+ ^ nil
+!
+
+visibleAt:visibleLineNr
+ "return what is visible at line (numbers start at 1)"
+
+ |listLineNr listsize|
+
+ listLineNr := visibleLineNr + firstLineShown - 1.
+ (listLineNr == 0) ifTrue:[^ nil].
+ (list notNil) ifTrue:[
+ listsize := self size
+ ] ifFalse:[
+ listsize := 0
+ ].
+ (listLineNr <= listsize) ifTrue:[^ self at:listLineNr].
+ ^ ''
+
+!
+
+listAt:lineNr
+ "given a lineNumber, return the corresponding string"
+
+ list isNil ifTrue:[^ nil].
+ (lineNr between:1 and:self size) ifFalse:[^ nil].
+ ^ self at:lineNr
+
+!
+
+yOfVisibleLine:visLineNr
+ "given a visible lineNr, return y-coordinate in view
+ - works for fix-height fonts only"
+
+ ^ ((visLineNr - 1) * fontHeight) + textStartTop
+!
+
+computeNumberOfLinesShown
+ "recompute the number of visible lines"
+
+ nFullLinesShown := self innerHeight // fontHeight.
+ nLinesShown := nFullLinesShown.
+
+ partialLines ifTrue:[
+ ((nLinesShown * fontHeight) == height) ifFalse:[
+ nLinesShown := nLinesShown + 1
+ ]
+ ]
+!
+
+visibleLineOfY:y
+ "given a y-coordinate, return lineNr
+ - works for fix-height fonts only"
+
+ ^ ((y - textStartTop) // fontHeight) + 1
+!
+
+checkForExistingLine:lineNr
+ "check if a line for lineNr exists; if not, expand text"
+
+ list isNil ifTrue: [
+ list := StringCollection new:lineNr.
+ self contentsChanged
+ ] ifFalse: [
+ lineNr > (list size) ifTrue:[
+ self grow:lineNr.
self contentsChanged
]
]
!
-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.
-" textStartLeft := leftMargin. "
- innerWidth := width - textStartLeft - margin
-!
-
-innerHeight
- "return the number of pixels visible of the contents
- - redefined since ListView adds a margin"
-
- ^ height - (2 * margin) - (2 * topMargin)
-! !
-
-!ListView methodsFor:'queries'!
-
-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
-!
-
-numberOfLines
- "return the number of lines the text has"
-
- ^ list size
+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
!
-lengthOfLongestLine
- "return the length (in characters) of the longest line"
-
- ^ self lengthOfLongestLineBetween:1 and:list size
+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
!
-lengthOfLongestLineBetween:firstLine and:lastLine
- "return the length (in characters) of the longest line in a line-range"
-
- |max "{ Class: SmallInteger }"
- thisLen "{ Class: SmallInteger }"
- listSize "{ Class: SmallInteger }"
- first "{ Class: SmallInteger }"
- last "{ Class: SmallInteger }" |
-
- list isNil ifTrue:[^ 0].
-
- listSize := list size.
- max := 0.
- first := firstLine.
- last := lastLine.
-
- (first > listSize) ifTrue:[^ max].
- (last > listSize) ifTrue:[
- last := listSize
- ].
- list from:first to:last do:[:lineString |
- lineString notNil ifTrue:[
- thisLen := lineString size.
- (thisLen > max) ifTrue:[
- max := thisLen
- ]
- ]
- ].
- ^ max
+visibleLineToAbsoluteLine:visibleLineNr
+ "given a visible line (1..) return absolut linenr"
+
+ visibleLineNr isNil ifTrue:[^ nil].
+ ^ visibleLineNr + firstLineShown - 1
!
-heightOfContents
- "return the height of the contents in pixels
- - used for scrollbar interface"
-
- | numLines |
-
- numLines := self numberOfLines.
- numLines == 0 ifTrue:[^ 0].
+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 ...
"
- need device-font for query
+ (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
"
- font := font on:device.
- ^ numLines * fontHeight + textStartTop
- + (font descent) "makes it look better".
-"/ + (font descent * 2) "makes it look better".
-
-"/ "it used to be that code - which is wrong"
-"/ (nLinesShown == nFullLinesShown) ifTrue:[
-"/ ^ numLines * fontHeight
-"/ ].
-"/ "add one - otherwise we cannot make last line
-"/ fully visible since scrolling is done by full lines only"
-"/
-"/ ^ (numLines + 1) * fontHeight
+ (viewBackground isColor not
+ or:[viewBackground colorId notNil]) ifTrue:[
+ ^ width
+ ].
+
+ w := self widthOfWidestLineBetween:firstLine and:lastLine.
+ (w > innerWidth) ifTrue:[^ innerWidth].
+ ^ w
!
-widthOfContents
- "return the width of the contents in pixels
- - used for scrollbar interface"
-
- |max|
-
- list isNil ifTrue:[^ 0].
-
- 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)
- ].
- ].
- ^ max + (leftMargin * 2)
- ]
-!
-
-yOriginOfContents
- "return the vertical origin of the contents in pixels
- - used for scrollbar interface"
-
- ^ (firstLineShown - 1) * fontHeight
-!
-
-xOriginOfContents
- "return the horizontal origin of the contents in pixels
- - used for scrollbar interface"
-
- ^ leftOffset
-!
-
-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
-! !
-
-!ListView methodsFor:'private'!
-
getFontParameters
"get some info of the used font. They are cached since we use them often .."
@@ -687,18 +555,62 @@
fontIsFixedWidth := font isFixedWidth.
!
-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:[
- list grow:lineNr.
- self contentsChanged
- ]
- ]
+absoluteLineToVisibleLine:absLineNr
+ "given an absolute line (1..) return visible linenr or nil"
+
+ absLineNr isNil ifTrue:[^ nil].
+ (absLineNr < firstLineShown) ifTrue:[^ nil].
+ (absLineNr >= (firstLineShown + nLinesShown)) ifTrue:[^ nil].
+ ^ absLineNr - firstLineShown + 1
+!
+
+colOfX:x inVisibleLine:visLineNr
+ "given a visible lineNr and x-coordinate, return colNr"
+
+ |lineString linePixelWidth xRel runCol posLeft posRight done|
+
+ xRel := x - textStartLeft + leftOffset.
+ fontIsFixedWidth ifTrue:[
+ ^ (xRel // fontWidth) + 1
+ ].
+ lineString := self visibleAt:visLineNr.
+ lineString notNil ifTrue:[
+ linePixelWidth := font widthOf:lineString
+ ] ifFalse:[
+ linePixelWidth := 0
+ ].
+ (xRel <= 0) ifTrue:[^ 1].
+ (linePixelWidth <= xRel) ifTrue:[
+ fontWidth == 0 ifTrue:[
+ "
+ although this 'cannot happen',
+ it seems that X reports this width for some strange fonts ...
+ "
+ ^ lineString size
+ ].
+ ^ lineString size + ((xRel - linePixelWidth) // fontWidth) + 1
+ ].
+ runCol := lineString size // 2.
+ (runCol == 0) ifTrue:[runCol := 1].
+ posLeft := font widthOf:lineString from:1 to:(runCol - 1).
+ posRight := font widthOf:lineString from:1 to:runCol.
+ done := (posLeft <= xRel) and:[posRight > xRel].
+ [done] whileFalse:[
+ (posRight <= xRel) ifTrue:[
+ runCol := runCol + 1.
+ posLeft := posRight.
+ posRight := font widthOf:lineString from:1 to:runCol
+ ] ifFalse:[
+ (posLeft > xRel) ifTrue:[
+ runCol := runCol - 1.
+ (runCol == 0) ifTrue:[^ 0].
+ posRight := posLeft.
+ posLeft := font widthOf:lineString from:1 to:(runCol - 1)
+ ]
+ ].
+ done := (posLeft <= xRel) and:[posRight > xRel]
+ ].
+ ^ runCol
!
getBoldFont
@@ -772,17 +684,18 @@
^ newList
!
-computeNumberOfLinesShown
- "recompute the number of visible lines"
-
- nFullLinesShown := self innerHeight // fontHeight.
- nLinesShown := nFullLinesShown.
-
- partialLines ifTrue:[
- ((nLinesShown * fontHeight) == height) ifFalse:[
- nLinesShown := nLinesShown + 1
- ]
- ]
+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
!
widthOfWidestLineBetween:firstLine and:lastLine
@@ -802,7 +715,7 @@
fontIsFixedWidth ifTrue:[
^ (self lengthOfLongestLineBetween:firstLine and:lastLine) * fontWidth
].
- listSize := list size.
+ listSize := self size.
max := 0.
first := firstLine.
last := lastLine.
@@ -812,7 +725,7 @@
last := listSize
].
- list from:first to:last do:[:line |
+ self from:first to:last do:[:line |
line notNil ifTrue:[
thisLen := font widthOf:line.
(thisLen > max) ifTrue:[
@@ -823,58 +736,6 @@
^ max
!
-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
- "
- list 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
-!
-
-listAt:lineNr
- "given a lineNumber, return the corresponding string"
-
- list isNil ifTrue:[^ nil].
- (lineNr between:1 and:list size) ifFalse:[^ nil].
- ^ list at:lineNr
-!
-
-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 from:startCol
"return right substring from startCol to end of a line"
@@ -886,167 +747,6 @@
^ line copyFrom:startCol
!
-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
-!
-
-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 := list size.
- (listLineNr <= listsize) ifTrue:[^ listLineNr].
- ^ nil
-!
-
-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
-!
-
-visibleLineToAbsoluteLine:visibleLineNr
- "given a visible line (1..) return absolut linenr"
-
- visibleLineNr isNil ifTrue:[^ nil].
- ^ visibleLineNr + firstLineShown - 1
-!
-
-yOfVisibleLine:visLineNr
- "given a visible lineNr, return y-coordinate in view
- - works for fix-height fonts only"
-
- ^ ((visLineNr - 1) * fontHeight) + textStartTop
-!
-
-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
-!
-
-colOfX:x inVisibleLine:visLineNr
- "given a visible lineNr and x-coordinate, return colNr"
-
- |lineString linePixelWidth xRel runCol posLeft posRight done|
-
- xRel := x - textStartLeft + leftOffset.
- fontIsFixedWidth ifTrue:[
- ^ (xRel // fontWidth) + 1
- ].
- lineString := self visibleAt:visLineNr.
- lineString notNil ifTrue:[
- linePixelWidth := font widthOf:lineString
- ] ifFalse:[
- linePixelWidth := 0
- ].
- (xRel <= 0) ifTrue:[^ 1].
- (linePixelWidth <= xRel) ifTrue:[
- fontWidth == 0 ifTrue:[
- "
- although this 'cannot happen',
- it seems that X reports this width for some strange fonts ...
- "
- ^ lineString size
- ].
- ^ lineString size + ((xRel - linePixelWidth) // fontWidth) + 1
- ].
- runCol := lineString size // 2.
- (runCol == 0) ifTrue:[runCol := 1].
- posLeft := font widthOf:lineString from:1 to:(runCol - 1).
- posRight := font widthOf:lineString from:1 to:runCol.
- done := (posLeft <= xRel) and:[posRight > xRel].
- [done] whileFalse:[
- (posRight <= xRel) ifTrue:[
- runCol := runCol + 1.
- posLeft := posRight.
- posRight := font widthOf:lineString from:1 to:runCol
- ] ifFalse:[
- (posLeft > xRel) ifTrue:[
- runCol := runCol - 1.
- (runCol == 0) ifTrue:[^ 0].
- posRight := posLeft.
- posLeft := font widthOf:lineString from:1 to:(runCol - 1)
- ]
- ].
- done := (posLeft <= xRel) and:[posRight > xRel]
- ].
- ^ runCol
-!
-
-visibleLineOfY:y
- "given a y-coordinate, return lineNr
- - works for fix-height fonts only"
-
- ^ ((y - textStartTop) // fontHeight) + 1
-!
-
-visibleAt:visibleLineNr
- "return what is visible at line (numbers start at 1)"
-
- |listLineNr listsize|
-
- listLineNr := visibleLineNr + firstLineShown - 1.
- (listLineNr == 0) ifTrue:[^ nil].
- (list notNil) ifTrue:[
- listsize := list size
- ] ifFalse:[
- listsize := 0
- ].
- (listLineNr <= listsize) ifTrue:[^ list at:listLineNr].
- ^ ''
-!
-
lineOfCharacterPosition:charPos
"given a character index within the contents-string,
return the lineNumber where the character is
@@ -1056,10 +756,10 @@
lineNr := 1.
sum := 0.
- lastLine := list size.
+ lastLine := self size.
[sum < charPos] whileTrue:[
(lineNr > lastLine) ifTrue:[^ lineNr - 1].
- sum := sum + (list at:lineNr) size + 1.
+ sum := sum + (self at:lineNr) size + 1.
lineNr := lineNr + 1
].
^ lineNr - 1
@@ -1074,422 +774,350 @@
self checkForExistingLine:lineNr.
pos := 1.
1 to:(lineNr - 1) do:[:lnr |
- lineString := list at:lnr.
+ lineString := self at:lnr.
lineString notNil ifTrue:[
pos := pos + lineString size
].
pos := pos + 1 "the return-character"
].
^ pos + col - 1
+
+!
+
+listAt:lineNr to:endCol
+ "return left substring from start to endCol of a line"
+
+ |line stop|
+
+ line := self listAt:lineNr.
+ line isNil ifTrue:[^ nil].
+ stop := endCol.
+ (stop > line size) ifTrue:[stop := line size].
+ ^ line copyTo:stop
! !
-!ListView methodsFor:'tabulators'!
-
-setTab4
- "set 4-character tab stops"
-
- tabPositions := self class tab4Positions.
-!
-
-setTab8
- "set 8-character tab stops"
-
- tabPositions := self class tab8Positions.
+!ListView methodsFor:'drawing'!
+
+drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fg and:bg
+ "draw a visible line range in fg/bg"
+
+ |y "{ Class: SmallInteger }"
+ x "{ Class: SmallInteger }"
+ startLine "{ Class: SmallInteger }"
+ endLine "{ Class: SmallInteger }"
+ listSize e|
+
+ y := self yOfVisibleLine:startVisLineNr.
+ self paint:bg.
+ self fillRectangleX:margin y:y
+ width:(width - (margin * 2))
+ height:(endVisLineNr - startVisLineNr + 1) * fontHeight.
+ list isNil ifTrue:[^ self].
+
+ y := y + fontAscent.
+ listSize := self size.
+
+ startLine := startVisLineNr + firstLineShown - 1.
+ endLine := endVisLineNr + firstLineShown - 1.
+ (startLine == 0) ifTrue:[
+ y := y + fontHeight.
+ startLine := startLine + 1
+ ].
+
+ (endLine > listSize) ifTrue:[
+ e := listSize
+ ] ifFalse:[
+ e := endLine
+ ].
+
+ (startLine <= e) ifTrue:[
+ x := textStartLeft - leftOffset.
+ self paint:fg.
+ self from:startLine to:e do:[:line |
+ line notNil ifTrue:[
+ self displayString:line x:x y:y
+ ].
+ y := y + fontHeight
+ ]
+ ]
+
!
-expandTabs
- "go through whole text expanding tabs into spaces.
- This is meant to be called for text being imported. Therefore,
- 8-col tabs are assumed - ignoring of any private tab setting."
-
- |line newLine nLines "{ Class: SmallInteger }"|
-
- list notNil ifTrue:[
- nLines := list size.
- 1 to:nLines do:[:index |
- line := list at:index.
- line notNil ifTrue:[
- line isString ifFalse:[
- newLine := line printString
- ] ifTrue:[
- newLine := line
- ].
- (newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
- newLine := self withTabs:self class tab8Positions expand:newLine
- ].
- (newLine ~~ line) ifTrue:[
- list at:index put:newLine
- ]
+drawVisibleLine:visLineNr with:fg and:bg
+ "draw a visible line in fg/bg"
+
+ |y line|
+
+ y := self yOfVisibleLine:visLineNr.
+ line := self visibleAt:visLineNr.
+ self paint:bg.
+ self fillRectangleX:margin y:y
+ width:(width - (margin * 2))
+ height:fontHeight.
+ line notNil ifTrue:[
+ self paint:fg.
+ self displayString:line x:(textStartLeft - leftOffset) y:(y + fontAscent)
+ ]
+!
+
+drawVisibleLine:visLineNr col:col with:fg and:bg
+ "draw single character at col index of visible line in fg/bg"
+
+ |y x lineString characterString|
+
+ lineString := self visibleAt:visLineNr.
+ x := (self xOfCol:col inVisibleLine:visLineNr) - leftOffset.
+ y := self yOfVisibleLine:visLineNr.
+
+ self paint:bg.
+
+ (lineString notNil and:[lineString isString not]) ifTrue:[
+ self drawVisibleLine:visLineNr with:fg and:bg
+ ] ifFalse:[
+ col > lineString size ifTrue:[
+ self fillRectangleX:x y:y width:(font width) height:fontHeight.
+ self paint:fg
+ ] ifFalse:[
+ characterString := (lineString at:col) asString.
+ self fillRectangleX:x y:y
+ width:(font widthOf:characterString)
+ height:fontHeight.
+ self paint:fg.
+ self displayString:characterString x:x y:(y + fontAscent)
+ ]
+ ]
+!
+
+drawVisibleLine:visLineNr from:startCol with:fg and:bg
+ "draw right part of a visible line from startCol to end of line in fg/bg"
+
+ |y x lineString index1 index2|
+
+ (startCol < 1) ifTrue:[
+ index1 := 1
+ ] ifFalse:[
+ index1 := startCol
+ ].
+ y := self yOfVisibleLine:visLineNr.
+ x := (self xOfCol:index1 inVisibleLine:visLineNr) - leftOffset.
+ self paint:bg.
+ self fillRectangleX:x y:y
+ width:(width + leftOffset - x)
+ height:fontHeight.
+
+ lineString := self visibleAt:visLineNr.
+ lineString notNil ifTrue:[
+ lineString isString ifFalse:[
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ ] ifTrue:[
+ index2 := lineString size.
+ (index2 < index1) ifTrue:[^ self].
+ (index1 <= index2) ifTrue:[
+ self paint:fg.
+ self displayString:lineString from:index1 to:index2 x:x y:(y + fontAscent)
]
]
]
!
-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)
-!
-
-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
+drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
+ "draw part of a visible line in fg/bg"
+
+ |y x lineString len characterString|
+
+ (endCol >= startCol) ifTrue:[
+ lineString := self visibleAt:visLineNr.
+
+ (lineString notNil and:[lineString isString not]) ifTrue:[
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ ] ifFalse:[
+ x := (self xOfCol:startCol inVisibleLine:visLineNr) - leftOffset.
+ y := (self yOfVisibleLine:visLineNr).
+ len := lineString size.
+ (startCol > len) ifTrue:[
+ len := endCol - startCol + 1.
+ self paint:bg.
+ self fillRectangleX:x y:y
+ width:(fontWidth * len)
+ height:fontHeight
+ ] ifFalse:[
+ (endCol > len) ifTrue:[
+ characterString := String new:endCol.
+ characterString replaceFrom:1 to:len with:lineString startingAt:1.
+ lineString := characterString
+ ].
+ self paint:bg.
+ self fillRectangleX:x y:y width:(font widthOf:lineString from:startCol to:endCol)
+ height:fontHeight.
+ self paint:fg.
+ self displayString:lineString from:startCol to:endCol x:x y:(y + fontAscent)
+ ]
+ ]
+ ]
+! !
+
+!ListView methodsFor:'queries'!
+
+numberOfLines
+ "return the number of lines the text has"
+
+ ^ self size
!
-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"
-
- |tmpString nString nTabs
- currentMax "{ Class: SmallInteger }"
- dstIndex "{ Class: SmallInteger }"
- nextTab "{ Class: SmallInteger }" |
-
- line isNil ifTrue:[^ line].
- nTabs := line occurrencesOf:(Character tab).
- nTabs == 0 ifTrue:[^ line].
-
- currentMax := 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
+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
].
- ^ tmpString copyTo:dstIndex
-!
-
-withTabs:line
- "Assuming an 8-character tab,
- compress multiple spaces to tabs, return a new line string
- or original line, if no tabs where created.
- good idea, to make this one a primitive"
-
- |newLine|
-
- line isNil ifTrue:[^ line].
- (line startsWith:' ') ifFalse:[^ line].
-
- newLine := line copyFrom:9.
- [newLine startsWith:' '] whileTrue:[
- newLine := Character tab asString , (newLine copyFrom:9)
- ].
- ^ newLine
-! !
-
-!ListView methodsFor:'searching'!
-
-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}"|
-
- patternSize := pattern size.
- (list notNil and:[patternSize ~~ 0]) ifTrue:[
- savedCursor := cursor.
- self cursor:(Cursor questionMark).
-"/ searchPattern := pattern.
- col := startCol + 1.
- line1 := startLine.
- line2 := list size.
- line1 to:line2 do:[:lnr |
- lineString := list at:lnr.
- lineString notNil ifTrue:[
- col := lineString findString:pattern startingAt:col ifAbsent:[0].
- col ~~ 0 ifTrue:[
- self cursor:savedCursor.
- ^ block1 value:lnr value:col.
- ]
- ].
- col := 1
+ self from:first to:last do:[:lineString |
+ lineString notNil ifTrue:[
+ thisLen := lineString size.
+ (thisLen > max) ifTrue:[
+ max := thisLen
+ ]
]
].
- "not found"
-
- self cursor:savedCursor.
- ^ block2 value
+ ^ max
+
!
-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
+widthOfContents
+ "return the width of the contents in pixels
+ - used for scrollbar interface"
+
+ |max|
+
+ list isNil ifTrue:[^ 0].
+
+ 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)
+ ].
].
- 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
+ ^ max + (leftMargin * 2)
+ ]
+!
+
+yOriginOfContents
+ "return the vertical origin of the contents in pixels
+ - used for scrollbar interface"
+
+ ^ (firstLineShown - 1) * fontHeight
+!
+
+heightOfContents
+ "return the height of the contents in pixels
+ - used for scrollbar interface"
+
+ | numLines |
+
+ numLines := self numberOfLines.
+ numLines == 0 ifTrue:[^ 0].
+ "
+ need device-font for query
+ "
+ font := font on:device.
+ ^ numLines * fontHeight + textStartTop
+ + (font descent) "makes it look better".
+"/ + (font descent * 2) "makes it look better".
+
+"/ "it used to be that code - which is wrong"
+"/ (nLinesShown == nFullLinesShown) ifTrue:[
+"/ ^ numLines * fontHeight
+"/ ].
+"/ "add one - otherwise we cannot make last line
+"/ fully visible since scrolling is done by full lines only"
+"/
+"/ ^ (numLines + 1) * fontHeight
+!
+
+xOriginOfContents
+ "return the horizontal origin of the contents in pixels
+ - used for scrollbar interface"
+
+ ^ leftOffset
+!
+
+firstLineShown
+ "return the index of the first (possibly partial) visible line"
+
+ ^ firstLineShown
+!
+
+lastLineShown
+ "return the index of the last (possibly partial) visible line"
+
+ ^ firstLineShown + nLinesShown
+!
+
+leftIndentOfLine:lineNr
+ "return the number of spaces at the left in line, lineNr.
+ returns 0 for empty lines."
+
+ |lineString index end|
+
+ lineString := self listAt:lineNr.
+ lineString notNil ifTrue:[
+ index := 1.
+ end := lineString size.
+ [index <= end] whileTrue:[
+ (lineString at:index) isSeparator ifFalse:[^ index - 1].
+ index := index + 1
]
].
- "not found"
-
- self cursor:savedCursor.
- ^ block2 value
+ ^ 0
!
-findBeginOfWordAtLine:selectLine col:selectCol
- "return the col of first character of the word at given line/col.
- If the character under the initial col is a space character, return
- the first col of the blank-block."
-
- |beginCol thisCharacter|
-
- beginCol := selectCol.
- thisCharacter := self characterAtLine:selectLine col:beginCol.
-
- "is this acharacter within a word ?"
- (wordCheck value:thisCharacter) ifTrue:[
- [wordCheck value:thisCharacter] whileTrue:[
- beginCol := beginCol - 1.
- beginCol < 1 ifTrue:[
- thisCharacter := Character space
- ] ifFalse:[
- thisCharacter := self characterAtLine:selectLine col:beginCol
- ]
- ].
- beginCol := beginCol + 1.
- ] ifFalse:[
- "nope - maybe its a space"
- thisCharacter == Character space ifTrue:[
- [beginCol > 1 and:[thisCharacter == Character space]] whileTrue:[
- beginCol := beginCol - 1.
- thisCharacter := self characterAtLine:selectLine col:beginCol
- ].
- thisCharacter ~~ Character space ifTrue:[
- beginCol := beginCol + 1.
- ].
- ] ifFalse:[
- "select single character"
- ]
- ].
- ^ beginCol
-!
-
-findEndOfWordAtLine:selectLine col:selectCol
- "return the col of last character of the word at given line/col.
- If the character under the initial col is a space character, return
- the last col of the blank-block.
- Return 0 if we should wrap to next line (for spaces)"
-
- |endCol thisCharacter len|
-
- endCol := selectCol.
- endCol == 0 ifTrue:[endCol := 1].
- thisCharacter := self characterAtLine:selectLine col:endCol.
-
- "is this acharacter within a word ?"
- (wordCheck value:thisCharacter) ifTrue:[
- thisCharacter := self characterAtLine:selectLine col:endCol.
- [wordCheck value:thisCharacter] whileTrue:[
- endCol := endCol + 1.
- thisCharacter := self characterAtLine:selectLine col:endCol
- ].
- endCol := endCol - 1.
- ] ifFalse:[
- "nope - maybe its a space"
- thisCharacter == Character space ifTrue:[
- len := (self listAt:selectLine) size.
- endCol > len ifTrue:[
- "select rest to end"
- endCol := 0
- ] ifFalse:[
- thisCharacter := self characterAtLine:selectLine col:endCol.
- [endCol <= len and:[thisCharacter == Character space]] whileTrue:[
- endCol := endCol + 1.
- thisCharacter := self characterAtLine:selectLine col:endCol
- ].
- endCol := endCol - 1.
- ]
- ] ifFalse:[
- "select single character"
- ]
- ].
- ^ endCol.
+lineIsVisible:line
+ "is line visible?"
+
+ (line >= firstLineShown and:[ line < (firstLineShown + nLinesShown) ]) ifTrue:[ ^ true ].
+ ^ false.
! !
!ListView methodsFor:'scrolling'!
-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
-!
-
-pageDown
- "change origin to display next page"
-
- |nLines|
-
- nLines := nFullLinesShown.
- (firstLineShown + nLines + nFullLinesShown > list size) ifTrue:[
- nLines := list size - firstLineShown - nFullLinesShown + 1
- ].
- nLines <= 0 ifTrue:[^ self].
-
- self originWillChange.
- firstLineShown := firstLineShown + 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
- ]
-!
-
-halfPageDown
- "scroll down half a page"
-
- self scrollDown:(nFullLinesShown // 2)
-!
-
-halfPageUp
- "scroll up half a page"
-
- self scrollUp:(nFullLinesShown // 2)
-!
-
makeLineVisible:aListLineNr
"if aListLineNr is not visible, scroll to make it visible.
Numbering starts with 1 for the very first line of the text."
@@ -1516,36 +1144,6 @@
self scrollToLine:(aListLineNr - (nFullLinesShown // 2) + 1)
!
-makeColVisible:aCol inLine:aLineNr
- "if column aCol is not visible, scroll horizontal to make it visible"
-
- |xWant xVis visLnr oldLeft|
-
- (aCol isNil or:[shown not]) ifTrue:[^ self].
-
- visLnr := self absoluteLineToVisibleLine:aLineNr.
- visLnr isNil ifTrue:[^ self].
-
- xWant := self xOfCol:aCol 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:nLines
"change origin to scroll down some lines"
@@ -1556,8 +1154,8 @@
nPixel|
count := nLines.
- (firstLineShown + nLines + nFullLinesShown > list size) ifTrue:[
- count := list size - firstLineShown - nFullLinesShown + 1
+ (firstLineShown + nLines + nFullLinesShown > self size) ifTrue:[
+ count := self size - firstLineShown - nFullLinesShown + 1
].
count <= 0 ifTrue:[^ self].
@@ -1594,12 +1192,83 @@
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 oldLeft|
+
+ (aCol isNil or:[shown not]) ifTrue:[^ self].
+
+ visLnr := self absoluteLineToVisibleLine:aLineNr.
+ visLnr isNil ifTrue:[^ self].
+
+ xWant := self xOfCol:aCol inVisibleLine:visLnr.
+ xVis := xWant - leftOffset.
+
+ "
+ dont scroll, if already visible
+ (but scroll, if not in inner 20%..80% of visible area)
+ "
+"/ ((xVis >= (width // 5)) and:[xVis <= (width * 4 // 5)]) ifTrue:[
+"/ ^ self
+"/ ].
+
+ "
+ no, the above does not look good, if you click / select at the
+ far right - makes selecting so difficult ...
+ "
+ (xVis >= 0 and:[xVis < (width - font width)]) ifTrue:[^ self].
+
+ self scrollHorizontalTo:(xWant - (width // 2)).
+!
+
scrollDown
"change origin to scroll down one line"
self scrollDown:1
!
+scrollToLeft
+ "change origin to start (left) of text"
+
+ leftOffset ~~ 0 ifTrue:[
+ self scrollToCol:1
+ ]
+!
+
+viewOrigin
+ "return the viewOrigin; thats the coordinate of the contents
+ which is shown topLeft in the view
+ (i.e. the origin of the visible part of the contents)."
+
+ ^ viewOrigin
+!
+
+gotoLine:aLineNumber
+ "position to line aLineNumber; this may be redefined
+ in subclasses (for example to move the cursor also)"
+
+ ^ self scrollToLine:aLineNumber
+!
+
scrollUp:nLines
"change origin to scroll up some lines"
@@ -1642,45 +1311,75 @@
self originChanged:(count negated).
!
+pageDown
+ "change origin to display next page"
+
+ |nLines|
+
+ nLines := nFullLinesShown.
+ (firstLineShown + nLines + nFullLinesShown > self size) ifTrue:[
+ nLines := self size - firstLineShown - nFullLinesShown + 1
+ ].
+ nLines <= 0 ifTrue:[^ self].
+
+ self originWillChange.
+ firstLineShown := firstLineShown + nLines.
+ self originChanged:nLines.
+ self redrawFromVisibleLine:1 to:nLinesShown
+
+!
+
+scrollVerticalToPercent:percent
+ "scroll to a position given in percent of total"
+
+ |lineNr|
+
+ lineNr := (((self numberOfLines * percent) asFloat / 100.0) + 0.5) asInteger + 1.
+ self scrollToLine:lineNr
+!
+
+pageUp
+ "change origin to display previous page"
+
+ |oldOrg|
+
+ (firstLineShown == 1) ifFalse:[
+ self originWillChange.
+ oldOrg := firstLineShown.
+ firstLineShown := firstLineShown - nFullLinesShown.
+ (firstLineShown < 1) ifTrue:[
+ firstLineShown := 1
+ ].
+ self originChanged:(firstLineShown - oldOrg).
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
+!
+
+halfPageDown
+ "scroll down half a page"
+
+ self scrollDown:(nFullLinesShown // 2)
+!
+
+halfPageUp
+ "scroll up half a page"
+
+ self scrollUp:(nFullLinesShown // 2)
+!
+
scrollUp
"change origin to scroll up one line"
self scrollUp:1
!
-scrollToTop
- "change origin to start of text"
-
- self scrollToLine:1
-!
-
scrollToBottom
"change origin to show end of text"
"scrolling to the end is not really correct (i.e. should scroll to list size - nFullLinesShown),
but scrollDown: will adjust it ..."
- self scrollToLine:(list size)
-!
-
-scrollToLine:aLineNr
- "change origin to make aLineNr be the top line"
-
- aLineNr < firstLineShown ifTrue:[
- self scrollUp:(firstLineShown - aLineNr)
- ] ifFalse:[
- aLineNr > firstLineShown ifTrue:[
- self scrollDown:(aLineNr - firstLineShown)
- ]
- ]
-!
-
-scrollToLeft
- "change origin to start (left) of text"
-
- leftOffset ~~ 0 ifTrue:[
- self scrollToCol:1
- ]
+ self scrollToLine:(self size)
!
scrollToCol:aColNr
@@ -1706,13 +1405,15 @@
]
!
-scrollVerticalToPercent:percent
- "scroll to a position given in percent of total"
-
- |lineNr|
-
- lineNr := (((self numberOfLines * percent) asFloat / 100.0) + 0.5) asInteger + 1.
- self scrollToLine:lineNr
+stopAutoScroll
+ "stop any auto-scroll"
+
+ autoScrollBlock notNil ifTrue:[
+ self compressMotionEvents:true.
+ Processor removeTimedBlock:autoScrollBlock.
+ autoScrollBlock := nil.
+ autoScrollDeltaT := nil
+ ].
!
scrollSelectUp
@@ -1799,17 +1500,6 @@
]
!
-stopAutoScroll
- "stop any auto-scroll"
-
- autoScrollBlock notNil ifTrue:[
- self compressMotionEvents:true.
- Processor removeTimedBlock:autoScrollBlock.
- autoScrollBlock := nil.
- autoScrollDeltaT := nil
- ].
-!
-
scrollRight
"scroll right by one character
- question is how much is a good for variable fonts"
@@ -1889,181 +1579,186 @@
]
! !
-!ListView methodsFor:'drawing'!
-
-drawVisibleLine:visLineNr col:col with:fg and:bg
- "draw single character at col index of visible line in fg/bg"
-
- |y x lineString characterString|
-
- lineString := self visibleAt:visLineNr.
- x := (self xOfCol:col inVisibleLine:visLineNr) - leftOffset.
- y := self yOfVisibleLine:visLineNr.
-
- self paint:bg.
-
- (lineString notNil and:[lineString isString not]) ifTrue:[
- self drawVisibleLine:visLineNr with:fg and:bg
- ] ifFalse:[
- col > lineString size ifTrue:[
- self fillRectangleX:x y:y width:(font width) height:fontHeight.
- self paint:fg
- ] ifFalse:[
- characterString := (lineString at:col) asString.
- self fillRectangleX:x y:y
- width:(font widthOf:characterString)
- height:fontHeight.
- self paint:fg.
- self displayString:characterString x:x y:(y + fontAscent)
- ]
- ]
-!
-
-drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
- "draw part of a visible line in fg/bg"
-
- |y x lineString len characterString|
-
- (endCol >= startCol) ifTrue:[
- lineString := self visibleAt:visLineNr.
-
- (lineString notNil and:[lineString isString not]) ifTrue:[
- self drawVisibleLine:visLineNr with:fg and:bg.
- ] ifFalse:[
- x := (self xOfCol:startCol inVisibleLine:visLineNr) - leftOffset.
- y := (self yOfVisibleLine:visLineNr).
- len := lineString size.
- (startCol > len) ifTrue:[
- len := endCol - startCol + 1.
- self paint:bg.
- self fillRectangleX:x y:y
- width:(fontWidth * len)
- height:fontHeight
- ] ifFalse:[
- (endCol > len) ifTrue:[
- characterString := String new:endCol.
- characterString replaceFrom:1 to:len with:lineString startingAt:1.
- lineString := characterString
+!ListView methodsFor:'tabulators'!
+
+expandTabs
+ "go through whole text expanding tabs into spaces.
+ This is meant to be called for text being imported. Therefore,
+ 8-col tabs are assumed - ignoring of any private tab setting."
+
+ |line newLine nLines "{ Class: SmallInteger }"|
+
+ list notNil ifTrue:[
+ nLines := self size.
+ 1 to:nLines do:[:index |
+ line := self at:index.
+ line notNil ifTrue:[
+ line isString ifFalse:[
+ newLine := line printString
+ ] ifTrue:[
+ newLine := line
].
- self paint:bg.
- self fillRectangleX:x y:y width:(font widthOf:lineString from:startCol to:endCol)
- height:fontHeight.
- self paint:fg.
- self displayString:lineString from:startCol to:endCol x:x y:(y + fontAscent)
+ (newLine occurrencesOf:(Character tab)) == 0 ifFalse:[
+ newLine := self withTabs:self class tab8Positions expand:newLine
+ ].
+ (newLine ~~ line) ifTrue:[
+ self withoutRedrawAt:index put:newLine
+ ]
]
]
]
!
-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
+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"
+
+ |tmpString nString nTabs
+ currentMax "{ Class: SmallInteger }"
+ dstIndex "{ Class: SmallInteger }"
+ nextTab "{ Class: SmallInteger }" |
+
+ line isNil ifTrue:[^ line].
+ nTabs := line occurrencesOf:(Character tab).
+ nTabs == 0 ifTrue:[^ line].
+
+ currentMax := 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
].
- y := self yOfVisibleLine:visLineNr.
- x := (self xOfCol:index1 inVisibleLine:visLineNr) - leftOffset.
- self paint:bg.
- self fillRectangleX:x y:y
- width:(width + leftOffset - x)
- height:fontHeight.
-
- lineString := self visibleAt:visLineNr.
- lineString notNil ifTrue:[
- lineString isString ifFalse:[
- self drawVisibleLine:visLineNr with:fg and:bg.
- ] ifTrue:[
- index2 := lineString size.
- (index2 < index1) ifTrue:[^ self].
- (index1 <= index2) ifTrue:[
- self paint:fg.
- self displayString:lineString from:index1 to:index2 x:x y:(y + fontAscent)
- ]
- ]
- ]
+ 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.
!
-drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fg and:bg
- "draw a visible line range in fg/bg"
-
- |y "{ Class: SmallInteger }"
- x "{ Class: SmallInteger }"
- startLine "{ Class: SmallInteger }"
- endLine "{ Class: SmallInteger }"
- listSize e|
-
- y := self yOfVisibleLine:startVisLineNr.
- self paint:bg.
- self fillRectangleX:margin y:y
- width:(width - (margin * 2))
- height:(endVisLineNr - startVisLineNr + 1) * fontHeight.
- list isNil ifTrue:[^ self].
-
- y := y + fontAscent.
- listSize := list size.
-
- startLine := startVisLineNr + firstLineShown - 1.
- endLine := endVisLineNr + firstLineShown - 1.
- (startLine == 0) ifTrue:[
- y := y + fontHeight.
- startLine := startLine + 1
+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
].
-
- (endLine > listSize) ifTrue:[
- e := listSize
- ] ifFalse:[
- e := endLine
+ ^ 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
].
-
- (startLine <= e) ifTrue:[
- x := textStartLeft - leftOffset.
- self paint:fg.
- list from:startLine to:e do:[:line |
- line notNil ifTrue:[
- self displayString:line x:x y:y
- ].
- y := y + fontHeight
- ]
- ]
+ (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
!
-drawVisibleLine:visLineNr with:fg and:bg
- "draw a visible line in fg/bg"
-
- |y line|
-
- y := self yOfVisibleLine:visLineNr.
- line := self visibleAt:visLineNr.
- self paint:bg.
- self fillRectangleX:margin y:y
- width:(width - (margin * 2))
- height:fontHeight.
- line notNil ifTrue:[
- self paint:fg.
- self displayString:line x:(textStartLeft - leftOffset) y:(y + fontAscent)
- ]
+withTabs:line
+ "Assuming an 8-character tab,
+ compress multiple spaces to tabs, return a new line string
+ or original line, if no tabs where created.
+ good idea, to make this one a primitive"
+
+ |newLine|
+
+ line isNil ifTrue:[^ line].
+ (line startsWith:' ') ifFalse:[^ line].
+
+ newLine := line copyFrom:9.
+ [newLine startsWith:' '] whileTrue:[
+ newLine := Character tab asString , (newLine copyFrom:9)
+ ].
+ ^ newLine
! !
!ListView methodsFor:'redrawing'!
-flash
- "show contents in reverse colors for a moment - to wakeup the user :-)"
-
- |savFg savBg|
-
- savFg := fgColor.
- savBg := bgColor.
- fgColor := savBg.
- bgColor := savFg.
- self redraw.
- (Delay forSeconds:0.1) wait.
- fgColor := savFg.
- bgColor := savBg.
- self redraw
+redrawLine:lineNr
+ "redraw a list line"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine
+ ]
!
redrawVisibleLine:visLineNr col:col
@@ -2074,22 +1769,6 @@
]
!
-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
- ]
-!
-
-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
- ]
-!
-
redrawFromVisibleLine:startVisLineNr to:endVisLineNr
"redraw a visible line range"
@@ -2098,11 +1777,22 @@
]
!
-redrawVisibleLine:visLineNr
- "redraw a visible line"
+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 with:fgColor and:bgColor
+ self drawVisibleLine:visLineNr from:startCol with:fgColor and:bgColor
]
!
@@ -2117,25 +1807,11 @@
]
!
-redrawLine:lineNr
- "redraw a list line"
-
- |visibleLine|
-
- visibleLine := self listLineToVisibleLine:lineNr.
- visibleLine notNil ifTrue:[
- self redrawVisibleLine:visibleLine
- ]
-!
-
-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
+ "redraw a visible line"
+
+ shown ifTrue:[
+ self drawVisibleLine:visLineNr with:fgColor and:bgColor
]
!
@@ -2150,6 +1826,14 @@
]
!
+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"
@@ -2170,6 +1854,22 @@
]
!
+flash
+ "show contents in reverse colors for a moment - to wakeup the user :-)"
+
+ |savFg savBg|
+
+ savFg := fgColor.
+ savBg := bgColor.
+ fgColor := savBg.
+ bgColor := savFg.
+ self redraw.
+ (Delay forSeconds:0.1) wait.
+ fgColor := savFg.
+ bgColor := savBg.
+ self redraw
+!
+
redrawFromLine:start to:end
"redraw lines from start to end"
@@ -2209,33 +1909,401 @@
]
! !
-!ListView methodsFor:'event processing'!
-
-sizeChanged:how
- "size changed - move origin up if possible"
-
- |listSize newOrigin|
-
+!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.
+" textStartLeft := leftMargin. "
+ innerWidth := width - textStartLeft - margin
+!
+
+innerHeight
+ "return the number of pixels visible of the contents
+ - redefined since ListView adds a margin"
+
+ ^ height - (2 * margin) - (2 * topMargin)
+!
+
+backgroundColor
+ "return the background color"
+
+ ^ bgColor
+!
+
+foregroundColor
+ "return the foreground color"
+
+ ^ fgColor
+!
+
+backgroundColor:aColor
+ "set the background color"
+
+ bgColor ~~ aColor ifTrue:[
+ bgColor := aColor.
+ self viewBackground:bgColor.
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ]
+ ]
+!
+
+foregroundColor:color1 backgroundColor:color2
+ "set both foreground and background colors"
+
+ ((fgColor ~~ color1) or:[bgColor ~~ color2]) ifTrue:[
+ fgColor := color1.
+ bgColor := color2.
+ shown ifTrue:[
+ self redraw
+ ]
+ ]
+!
+
+foregroundColor:aColor
+ "set the foreground color"
+
+ fgColor ~~ aColor ifTrue:[
+ fgColor := aColor.
+ shown ifTrue:[
+ self redraw
+ ]
+ ]
+!
+
+partialLines:aBoolean
+ "allow/disallow display of a last partial line"
+
+ partialLines := aBoolean.
+ self computeNumberOfLinesShown
+!
+
+leftMargin:aNumber
+ "set the margin to left of 1st col"
+
+ leftMargin := aNumber.
+ textStartLeft := leftMargin + margin.
+ innerWidth := width - textStartLeft - margin
+!
+
+leftMargin
+ "return the margin to left of 1st col"
+
+ ^ leftMargin
+!
+
+font:aFont
+ "set the font for all shown text.
+ Redraws everything."
+
+ aFont isNil ifTrue:[
+ ^ self error:'nil font'
+ ].
+ font ~~ aFont ifTrue:[
+ super font:aFont.
+ realized ifTrue:[
+ (font device == device) ifTrue:[
+ self getFontParameters.
+ self computeNumberOfLinesShown.
+ shown ifTrue:[
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
+ ].
+ self contentsChanged
+ ]
+ ]
+!
+
+lineSpacing:pixles
+ lineSpacing := pixles.
+ self getFontParameters.
+
+
+! !
+
+!ListView methodsFor:'initialization'!
+
+create
+ super create.
+
+ "I cache font parameters here - they are used so often ..."
+ self getFontParameters.
self computeNumberOfLinesShown.
-
+ fgColor := fgColor on:device.
+ bgColor := bgColor on:device
+!
+
+realize
+ extentChanged ifTrue:[
+ self computeNumberOfLinesShown.
+ ].
+ firstLineShown ~~ 1 ifTrue:[
+ firstLineShown + nLinesShown > self size ifTrue:[
+ self scrollToLine:self size - nLinesShown.
+ ]
+ ].
+ super realize
+!
+
+initStyle
+ super initStyle.
+
+ lineSpacing := 0.
+ fgColor := DefaultForegroundColor on:device.
+ bgColor := DefaultBackgroundColor on:device.
+ DefaultFont notNil ifTrue:[font := DefaultFont on:device]
+!
+
+initialize
+ device width <= 800 ifTrue:[
+ "
+ some more pixels of real estate ...
+ "
+ leftMargin := topMargin := 1
+ ] ifFalse:[
+ leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
+ topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
+ ].
+
+ super initialize.
+
+ bitGravity := #NorthWest.
+ list := nil.
+ firstLineShown := 1.
+ nFullLinesShown := 1. "just any value ..."
+ nLinesShown := 1. "just any value"
+ leftOffset := 0.
+ partialLines := true.
+ tabPositions := self class defaultTabPositions.
+ textStartLeft := leftMargin + margin.
+ textStartTop := topMargin + margin.
+ innerWidth := width - textStartLeft - (margin * 2).
+ self getFontParameters.
+ wordCheck := [:char | char isNationalAlphaNumeric].
+ includesNonStrings := false
+!
+
+recreate
+ "recreate after a snapin"
+
+ super recreate.
+
+ "recompute margins and font parameters
+ - display may have different resolution."
+
+ leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
+ topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
+ textStartLeft := leftMargin + margin.
+ textStartTop := topMargin + margin.
innerWidth := width - textStartLeft - margin.
- shown ifFalse:[^ self].
- list isNil ifTrue:[^ self].
-
- listSize := self numberOfLines.
- "
- if we are behond the end, scroll up a bit
- "
- ((firstLineShown + nFullLinesShown) > listSize) ifTrue:[
- newOrigin := listSize - nFullLinesShown + 1.
- newOrigin < 1 ifTrue:[
- newOrigin := 1
+ self 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}"|
+
+ patternSize := pattern size.
+ (list notNil and:[patternSize ~~ 0]) ifTrue:[
+ savedCursor := cursor.
+ self cursor:(Cursor questionMark).
+"/ searchPattern := pattern.
+ col := startCol + 1.
+ line1 := startLine.
+ line2 := list size.
+ line1 to:line2 do:[:lnr |
+ lineString := list at:lnr.
+ lineString notNil ifTrue:[
+ col := lineString findString:pattern startingAt:col ifAbsent:[0].
+ col ~~ 0 ifTrue:[
+ self cursor:savedCursor.
+ ^ block1 value:lnr value:col.
+ ]
+ ].
+ col := 1
+ ]
+ ].
+ "not found"
+
+ self cursor:savedCursor.
+ ^ block2 value
+!
+
+findEndOfWordAtLine:selectLine col:selectCol
+ "return the col of last character of the word at given line/col.
+ If the character under the initial col is a space character, return
+ the last col of the blank-block.
+ Return 0 if we should wrap to next line (for spaces)"
+
+ |endCol thisCharacter len|
+
+ endCol := selectCol.
+ endCol == 0 ifTrue:[endCol := 1].
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+
+ "is this acharacter within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+ [wordCheck value:thisCharacter] whileTrue:[
+ endCol := endCol + 1.
+ thisCharacter := self characterAtLine:selectLine col:endCol
].
- self scrollToLine: newOrigin.
- ^ self
+ 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
+ |newList|
+
+ changedObject == model ifTrue:[
+ (aspectSymbol notNil
+ and:[something == aspectSymbol]) ifTrue:[
+ newList := (model perform:aspectSymbol).
+ newList notNil ifTrue:[
+ newList := newList asStringCollection.
+ ].
+ (newList = list) ifFalse:[
+ self list:newList
+ ].
+ ^ self
+ ].
+ ].
+ ^ super update:something with:aParameter from:changedObject
+! !
+
+!ListView methodsFor:'event processing'!
+
redrawX:x y:y width:w height:h
"a region must be redrawn"
@@ -2293,6 +2361,32 @@
]
!
+sizeChanged:how
+ "size changed - move origin up if possible"
+
+ |listSize newOrigin|
+
+ super sizeChanged:how.
+ self computeNumberOfLinesShown.
+
+ innerWidth := width - textStartLeft - margin.
+ shown ifFalse:[^ self].
+ list isNil ifTrue:[^ self].
+
+ listSize := self numberOfLines.
+ "
+ if we are behond the end, scroll up a bit
+ "
+ ((firstLineShown + nFullLinesShown) > listSize) ifTrue:[
+ newOrigin := listSize - nFullLinesShown + 1.
+ newOrigin < 1 ifTrue:[
+ newOrigin := 1
+ ].
+ self scrollToLine: newOrigin.
+ ^ self
+ ].
+!
+
keyPress:key x:x y:y
"a key was pressed - handle page-keys here"
@@ -2309,3 +2403,4 @@
super keyPress:key x:x y:y
! !
+
--- a/Make.proto Sat Mar 18 06:16:33 1995 +0100
+++ b/Make.proto Sat Mar 18 06:16:50 1995 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libwidg/Make.proto,v 1.14 1995-03-06 21:06:09 claus Exp $
+# $Header: /cvs/stx/stx/libwidg/Make.proto,v 1.15 1995-03-18 05:16:50 claus Exp $
#
# -------------- no need to change anything below ----------
@@ -72,7 +72,9 @@
FSaveBox.$(O) \
ButtonC.$(O) \
ToggleC.$(O) \
- VarVPanelC.$(O) \
+ RButtC.$(O) \
+ VarPanelC.$(O) \
+ VarVPanelC.$(O) \
VarHPanelC.$(O)
obsolete: Notifier.$(O) \
@@ -211,5 +213,7 @@
ButtonC.$(O): ButtonC.st $(CONTROLLER)
ToggleC.$(O): ToggleC.st $(I)/ButtonC.H $(CONTROLLER)
-VarVPanelC.$(O): VarVPanelC.st $(CONTROLLER)
-VarHPanelC.$(O): VarHPanelC.st $(I)/VarVPanelC.H $(CONTROLLER)
+RButtC.$(O): RButtC.st $(I)/ToggleC.H $(I)/ButtonC.H $(CONTROLLER)
+VarPanelC.$(O): VarPanelC.st $(CONTROLLER)
+VarVPanelC.$(O): VarVPanelC.st $(I)/VarPanelC.H $(CONTROLLER)
+VarHPanelC.$(O): VarHPanelC.st $(I)/VarPanelC.H $(CONTROLLER)
--- a/MenuView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/MenuView.st Sat Mar 18 06:16:50 1995 +0100
@@ -32,7 +32,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.19 1995-03-06 19:29:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.20 1995-03-18 05:15:12 claus Exp $
'!
!MenuView class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.19 1995-03-06 19:29:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.20 1995-03-18 05:15:12 claus Exp $
"
!
@@ -422,11 +422,15 @@
labels:text
"set the labels to the argument, text"
+ |l|
+
(text isString) ifTrue:[
- self list:(text asStringCollection)
+ l := text asStringCollection
] ifFalse:[
- self list:text
+ l := text
].
+"/ self list:l
+ self setList:l expandTabs:false.
enableFlags := Array new:(list size) withAll:true.
onOffFlags := Array new:(list size).
text keysAndValuesDo:[:index :line |
@@ -748,7 +752,14 @@
receiver:anObject
"set the receiver of the message"
- receiver := anObject
+ receiver := anObject.
+ subMenus notNil ifTrue:[
+ subMenus do:[:aMenu |
+ aMenu notNil ifTrue:[
+ aMenu receiver:anObject
+ ]
+ ]
+ ]
!
labels:text selectors:selArray args:argArray receiver:anObject
--- a/ObjView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/ObjView.st Sat Mar 18 06:16:50 1995 +0100
@@ -18,7 +18,7 @@
keyPressAction selection gridShown gridPixmap scaleMetric
dragObject leftHandCursor oldCursor movedObject
moveStartPoint moveDelta documentFormat canDragOutOfView
- rootMotion rootView aligning gridAlign'
+ rootMotion rootView aligning gridAlign aligningMove'
classVariableNames:''
poolDictionaries:''
category:'Views-Basic'
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.22 1995-03-09 03:22:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.23 1995-03-18 05:15:22 claus Exp $
"
!
@@ -517,21 +517,18 @@
rectangleForScroll
"find the area occupied by visible objects"
- |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
-
- viewOrigin := 0@0. "/self viewOrigin.
- orgX := 0 . "/viewOrigin x.
- orgY := 0 . "/viewOrigin y.
+ |left right top bottom frame oLeft oRight oTop oBottom|
+
left := 9999.
right := 0.
top := 9999.
bottom := 0.
self visibleObjectsDo:[:anObject |
frame := anObject frame.
- oLeft := frame left - orgX.
- oRight := frame right - orgX.
- oTop := frame top - orgY.
- oBottom := frame bottom - orgY.
+ oLeft := frame left.
+ oRight := frame right.
+ oTop := frame top.
+ oBottom := frame bottom.
(oLeft < left) ifTrue:[left := oLeft].
(oRight > right) ifTrue:[right := oRight].
(oTop < top) ifTrue:[top := oTop].
@@ -685,7 +682,7 @@
"tricky, the moved object may not currently be aligned.
if so, simulate a frame move of the delta"
- aligning ifTrue:[
+ aligningMove ifTrue:[
org := movedObject origin.
d := org - (self alignToGrid:(org)).
moveDelta := d negated.
@@ -695,7 +692,7 @@
].
movedObject notNil ifTrue:[
d := aPoint - moveStartPoint.
- aligning ifTrue:[
+ aligningMove ifTrue:[
org := movedObject origin.
nOrg := org + d.
d := (self alignToGrid:(nOrg)) - org.
@@ -918,10 +915,10 @@
].
transformation notNil ifTrue:[
- transformation scale ~~ 1 ifTrue:[
+"/ transformation scale ~~ 1 ifTrue:[
vis := vis origin truncated
corner:(vis corner + (1@1)) truncated.
- ]
+"/ ]
].
self clippedTo:vis do:[
@@ -943,29 +940,21 @@
redrawObjectsOn:aGC
"redraw all objects on a graphic context"
- |vFrame org viewOrigin|
+ |vFrame|
(aGC == self) ifTrue:[
shown ifFalse:[^ self].
- viewOrigin := 0@0. "/self viewOrigin.
- org := viewOrigin.
- vFrame := Rectangle origin:org
- corner:(viewOrigin + (width @ height)).
+ vFrame := Rectangle origin:0@0 corner:(width @ height).
transformation notNil ifTrue:[
vFrame := transformation applyInverseTo:vFrame.
].
self redrawObjectsIntersecting:vFrame
] ifFalse:[
- "loop over pages"
-
-"
- org := 0 @ 0.
- vFrame := Rectangle origin:org
- corner:(org + (width @ height)).
-
- self redrawObjectsIntersecting:vFrame
-"
+ "should loop over pages"
+
+ vFrame := Rectangle origin:(0@0) corner:(width @ height).
+
self objectsIntersecting:vFrame do:[:theObject |
theObject drawIn:aGC
]
@@ -1003,10 +992,10 @@
shown ifTrue:[
visRect := Rectangle origin:(aRectangle origin)
extent:(aRectangle extent).
- transformation notNil ifTrue:[
+"/ transformation notNil ifTrue:[
visRect := visRect origin truncated
corner:(visRect corner + (1@1)) truncated.
- ].
+"/ ].
clipRect notNil ifTrue:[
visRect := visRect intersect:clipRect
].
@@ -1789,7 +1778,7 @@
|oldOrigin oldFrame newFrame
objectsIntersectingOldFrame objectsIntersectingNewFrame
wasObscured isObscured intersects
- vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin viewOrigin|
+ oldLeft oldTop w h newLeft newTop griddedNewOrigin|
anObject isNil ifTrue:[^ self].
anObject canBeMoved ifFalse:[^ self].
@@ -1811,7 +1800,6 @@
"if no other object intersects both frames we can do a copy:"
- viewOrigin := 0@0 "self viewOrigin".
intersects := oldFrame intersects:newFrame.
intersects ifFalse:[
gridShown ifFalse:[
@@ -1819,12 +1807,10 @@
(objectsIntersectingOldFrame size == 1) ifTrue:[
(objectsIntersectingNewFrame size == 1) ifTrue:[
(oldFrame isContainedIn:self clipRect) ifTrue:[
- vx := viewOrigin x.
- vy := viewOrigin y.
- oldLeft := oldFrame left - vx.
- oldTop := oldFrame top - vy.
- newLeft := newFrame left - vx.
- newTop := newFrame top - vy.
+ oldLeft := oldFrame left.
+ oldTop := oldFrame top.
+ newLeft := newFrame left.
+ newTop := newFrame top.
w := oldFrame width.
h := oldFrame height.
((newLeft < width) and:[newTop < height]) ifTrue:[
@@ -2061,7 +2047,7 @@
self invertDragRectangle.
self cursor:oldCursor.
- self selectAllIn:(dragObject "+ self viewOrigin")
+ self selectAllIn:dragObject
!
invertDragRectangle
@@ -2725,4 +2711,3 @@
]
]
! !
-
--- a/ObjectView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/ObjectView.st Sat Mar 18 06:16:50 1995 +0100
@@ -18,7 +18,7 @@
keyPressAction selection gridShown gridPixmap scaleMetric
dragObject leftHandCursor oldCursor movedObject
moveStartPoint moveDelta documentFormat canDragOutOfView
- rootMotion rootView aligning gridAlign'
+ rootMotion rootView aligning gridAlign aligningMove'
classVariableNames:''
poolDictionaries:''
category:'Views-Basic'
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.22 1995-03-09 03:22:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.23 1995-03-18 05:15:22 claus Exp $
"
!
@@ -517,21 +517,18 @@
rectangleForScroll
"find the area occupied by visible objects"
- |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
-
- viewOrigin := 0@0. "/self viewOrigin.
- orgX := 0 . "/viewOrigin x.
- orgY := 0 . "/viewOrigin y.
+ |left right top bottom frame oLeft oRight oTop oBottom|
+
left := 9999.
right := 0.
top := 9999.
bottom := 0.
self visibleObjectsDo:[:anObject |
frame := anObject frame.
- oLeft := frame left - orgX.
- oRight := frame right - orgX.
- oTop := frame top - orgY.
- oBottom := frame bottom - orgY.
+ oLeft := frame left.
+ oRight := frame right.
+ oTop := frame top.
+ oBottom := frame bottom.
(oLeft < left) ifTrue:[left := oLeft].
(oRight > right) ifTrue:[right := oRight].
(oTop < top) ifTrue:[top := oTop].
@@ -685,7 +682,7 @@
"tricky, the moved object may not currently be aligned.
if so, simulate a frame move of the delta"
- aligning ifTrue:[
+ aligningMove ifTrue:[
org := movedObject origin.
d := org - (self alignToGrid:(org)).
moveDelta := d negated.
@@ -695,7 +692,7 @@
].
movedObject notNil ifTrue:[
d := aPoint - moveStartPoint.
- aligning ifTrue:[
+ aligningMove ifTrue:[
org := movedObject origin.
nOrg := org + d.
d := (self alignToGrid:(nOrg)) - org.
@@ -918,10 +915,10 @@
].
transformation notNil ifTrue:[
- transformation scale ~~ 1 ifTrue:[
+"/ transformation scale ~~ 1 ifTrue:[
vis := vis origin truncated
corner:(vis corner + (1@1)) truncated.
- ]
+"/ ]
].
self clippedTo:vis do:[
@@ -943,29 +940,21 @@
redrawObjectsOn:aGC
"redraw all objects on a graphic context"
- |vFrame org viewOrigin|
+ |vFrame|
(aGC == self) ifTrue:[
shown ifFalse:[^ self].
- viewOrigin := 0@0. "/self viewOrigin.
- org := viewOrigin.
- vFrame := Rectangle origin:org
- corner:(viewOrigin + (width @ height)).
+ vFrame := Rectangle origin:0@0 corner:(width @ height).
transformation notNil ifTrue:[
vFrame := transformation applyInverseTo:vFrame.
].
self redrawObjectsIntersecting:vFrame
] ifFalse:[
- "loop over pages"
-
-"
- org := 0 @ 0.
- vFrame := Rectangle origin:org
- corner:(org + (width @ height)).
-
- self redrawObjectsIntersecting:vFrame
-"
+ "should loop over pages"
+
+ vFrame := Rectangle origin:(0@0) corner:(width @ height).
+
self objectsIntersecting:vFrame do:[:theObject |
theObject drawIn:aGC
]
@@ -1003,10 +992,10 @@
shown ifTrue:[
visRect := Rectangle origin:(aRectangle origin)
extent:(aRectangle extent).
- transformation notNil ifTrue:[
+"/ transformation notNil ifTrue:[
visRect := visRect origin truncated
corner:(visRect corner + (1@1)) truncated.
- ].
+"/ ].
clipRect notNil ifTrue:[
visRect := visRect intersect:clipRect
].
@@ -1789,7 +1778,7 @@
|oldOrigin oldFrame newFrame
objectsIntersectingOldFrame objectsIntersectingNewFrame
wasObscured isObscured intersects
- vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin viewOrigin|
+ oldLeft oldTop w h newLeft newTop griddedNewOrigin|
anObject isNil ifTrue:[^ self].
anObject canBeMoved ifFalse:[^ self].
@@ -1811,7 +1800,6 @@
"if no other object intersects both frames we can do a copy:"
- viewOrigin := 0@0 "self viewOrigin".
intersects := oldFrame intersects:newFrame.
intersects ifFalse:[
gridShown ifFalse:[
@@ -1819,12 +1807,10 @@
(objectsIntersectingOldFrame size == 1) ifTrue:[
(objectsIntersectingNewFrame size == 1) ifTrue:[
(oldFrame isContainedIn:self clipRect) ifTrue:[
- vx := viewOrigin x.
- vy := viewOrigin y.
- oldLeft := oldFrame left - vx.
- oldTop := oldFrame top - vy.
- newLeft := newFrame left - vx.
- newTop := newFrame top - vy.
+ oldLeft := oldFrame left.
+ oldTop := oldFrame top.
+ newLeft := newFrame left.
+ newTop := newFrame top.
w := oldFrame width.
h := oldFrame height.
((newLeft < width) and:[newTop < height]) ifTrue:[
@@ -2061,7 +2047,7 @@
self invertDragRectangle.
self cursor:oldCursor.
- self selectAllIn:(dragObject "+ self viewOrigin")
+ self selectAllIn:dragObject
!
invertDragRectangle
@@ -2725,4 +2711,3 @@
]
]
! !
-
--- a/PopUpList.st Sat Mar 18 06:16:33 1995 +0100
+++ b/PopUpList.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,6 +10,8 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:16:49 am'!
+
Button subclass:#PopUpList
instanceVariableNames:'menu menuAction values'
classVariableNames:''
@@ -21,7 +23,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.7 1995-02-27 10:40:30 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.8 1995-03-18 05:15:33 claus Exp $
'!
!PopUpList class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.7 1995-02-27 10:40:30 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.8 1995-03-18 05:15:33 claus Exp $
"
!
@@ -161,6 +163,15 @@
!PopUpList methodsFor:'accessing'!
+contents
+ ^ self label
+!
+
+contents:con
+ ^ self selection:con
+
+!
+
model:aModel
"set the model - this is forwarded to my menu.
The popuplist itself has no model"
@@ -247,20 +258,20 @@
|index|
index := menu labels indexOf:indexOrString.
- index == 0 ifTrue:[
- indexOrString isNumber ifTrue:[
- index := indexOrString
- ] ifFalse:[
- ^ self
- ]
- ].
+ index == 0 ifTrue:[^ self].
self label:(menu labels at:index)
"
|p|
p := PopUpList label:'what fruit ?'.
p list:#('apples' 'bananas' 'grape' 'lemon' 'margarithas').
- p selection:'apples'.
+ p selection:'grape'.
+ p open
+
+ |p|
+ p := PopUpList label:'what fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margarithas').
+ p selection:'blabla'.
p open
"
! !
@@ -321,3 +332,4 @@
self label:label printString.
self sendChangeMessageWith:value
! !
+
--- a/PopUpMenu.st Sat Mar 18 06:16:33 1995 +0100
+++ b/PopUpMenu.st Sat Mar 18 06:16:50 1995 +0100
@@ -12,7 +12,8 @@
PopUpView subclass:#PopUpMenu
instanceVariableNames:'menuView lastSelection memorize hideOnLeave
- actionLabels actionLines actionValues'
+ actionLabels actionLines actionValues
+ hideOnRelease defaultHideOnRelease'
classVariableNames:''
poolDictionaries:''
category:'Views-Menus'
@@ -22,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.14 1995-02-28 21:52:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.15 1995-03-18 05:15:37 claus Exp $
'!
!PopUpMenu class methodsFor:'documentation'!
@@ -43,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.14 1995-02-28 21:52:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.15 1995-03-18 05:15:37 claus Exp $
"
!
@@ -376,15 +377,7 @@
memorize := true.
hideOnLeave := false.
-"/ style == #iris ifTrue:[
-"/ borderWidth := 1
-"/ ].
-"/ (style == #st80) ifTrue:[
-"/ borderWidth := 1.
-"/ level := 0.
-"/ margin := 0.
-"/ shadowView := nil
-"/ ].
+ defaultHideOnRelease := StyleSheet at:#popupHideOnRelease default:true.
!
initEvents
@@ -412,6 +405,7 @@
realize
menuView deselectWithoutRedraw.
super realize.
+ hideOnRelease := defaultHideOnRelease.
! !
!PopUpMenu methodsFor:'private accessing'!
@@ -595,7 +589,7 @@
in:self)
! !
-!PopUpMenu methodsFor:'activation'!
+!PopUpMenu methodsFor:'deactivation'!
hide
"hide the menu - if there are any pop-up-submenus, hide them also"
@@ -690,6 +684,7 @@
((x >= 0) and:[x < width]) ifTrue:[
((y >= 0) and:[y < height]) ifTrue:[
+ hideOnRelease := true.
menuView buttonMotion:button x:x y:y.
^ self
]
@@ -729,7 +724,32 @@
"/ ]
!
+buttonPress:button x:x y:y
+ hideOnRelease ifTrue:[
+ self hide.
+"
+ menuView buttonRelease:button x:x y:y.
+"
+ menuView superMenu notNil ifTrue:[
+ menuView superMenu submenuTriggered
+ ].
+ menuView buttonRelease:button x:x y:y.
+ ] ifFalse:[
+ hideOnRelease := true.
+ ((x >= 0) and:[x < width]) ifTrue:[
+ ((y >= 0) and:[y < height]) ifTrue:[
+ menuView buttonPress:button x:x y:y.
+ ^ self
+ ]
+ ].
+ ].
+!
+
buttonRelease:button x:x y:y
+ hideOnRelease ifFalse:[
+ ^ self
+ ].
+
self hide.
"
menuView buttonRelease:button x:x y:y.
--- a/RButtGrp.st Sat Mar 18 06:16:33 1995 +0100
+++ b/RButtGrp.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,6 +10,8 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:06:48 am'!
+
OrderedCollection subclass:#RadioButtonGroup
instanceVariableNames:''
classVariableNames:''
@@ -21,7 +23,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/RButtGrp.st,v 1.8 1995-02-16 03:12:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/RButtGrp.st,v 1.9 1995-03-18 05:15:46 claus Exp $
'!
!RadioButtonGroup class methodsFor:'documentation '!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/RButtGrp.st,v 1.8 1995-02-16 03:12:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/RButtGrp.st,v 1.9 1995-03-18 05:15:46 claus Exp $
"
!
@@ -69,8 +71,9 @@
add:aRadioButton
super add:aRadioButton.
- aRadioButton addDependent:self.
- aRadioButton group:self
+ aRadioButton model:self; change:#elementChanged:from:.
+"/ aRadioButton addDependent:self.
+ (aRadioButton respondsTo:#group) ifTrue:[aRadioButton group:self]
! !
!RadioButtonGroup methodsFor:'update'!
@@ -80,19 +83,39 @@
"a RadioButton in this group has changed - notify the others"
- "in case we have a toggle in the group,
- and it has been turned off - turn it on again
- "
- changedButton isOn ifFalse:[
- changedButton toggleNoAction.
- ^ self
- ].
+"/ "in case we have a toggle in the group,
+"/ and it has been turned off - turn it on again
+"/ "
+"/ changedButton isOn ifFalse:[
+"/ changedButton toggleNoAction.
+"/ ^ self
+"/ ].
+ self do:[:aButton |
+ (aButton == changedButton) ifFalse:[
+ aButton isOn ifTrue:[
+ aButton turnOff
+ ]
+ ]
+ ]
+!
+
+elementChanged:aToggle
self do:[:aButton |
- (aButton == changedButton) ifFalse:[
- aButton isOn ifTrue:[
- aButton turnOff
- ]
- ]
+ (aButton == aToggle) ifFalse:[
+ aButton isOn ifTrue:[
+ aButton turnOff
+ ]
+ ]
]
+!
+elementChanged:newValue from:aToggle
+ self do:[:aButton |
+ (aButton == aToggle) ifFalse:[
+ aButton isOn ifTrue:[
+ aButton turnOff
+ ]
+ ]
+ ]
! !
+
--- a/RButton.st Sat Mar 18 06:16:33 1995 +0100
+++ b/RButton.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,18 +10,20 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:09:35 am'!
+
Toggle subclass:#RadioButton
- instanceVariableNames:'group'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Interactors'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
!
RadioButton comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.7 1995-02-16 03:12:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.8 1995-03-18 05:15:51 claus Exp $
'!
!RadioButton class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.7 1995-02-16 03:12:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.8 1995-03-18 05:15:51 claus Exp $
"
!
@@ -57,15 +59,17 @@
examples
"
+ example1: one on
+
|top panel b group|
top := StandardSystemView new.
top extent:200@200.
panel := HorizontalPanelView
- origin:0.0@0.0
- corner:1.0@1.0
- in:top.
+ origin:0.0@0.0
+ corner:1.0@1.0
+ in:top.
group := RadioButtonGroup new.
@@ -79,37 +83,38 @@
group add:b.
top open
+
+
+ example2: zero or one on
+
+ |top panel b group|
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ panel := HorizontalPanelView
+ origin:0.0@0.0
+ corner:1.0@1.0
+ in:top.
+
+ group := RadioButtonGroup new.
+
+ b := Toggle label:'am' in:panel.
+ group add:b.
+
+ b := Toggle label:'fm' in:panel.
+ group add:b.
+
+ b := Toggle label:'off' in:panel.
+ group add:b.
+
+ top open
"
! !
-!RadioButton methodsFor:'destroying'!
+!RadioButton methodsFor:'initialization'!
-destroy
- self release.
- super destroy
+defaultControllerClass
+ ^ RadioButtonController
! !
-!RadioButton methodsFor:'accessing '!
-
-group
- "return the radioButtonGroup in which I am"
-
- ^ group
-!
-
-group:aButtonGroup
- "set the radioButtonGroup in which I am"
-
- group := aButtonGroup
-! !
-
-!RadioButton methodsFor:'events'!
-
-buttonPress:button x:x y:y
- "radiobuttons change only off-to-on; turning off is done by other
- buttons"
-
- controller pressed ifFalse:[
- self toggle
- ]
-! !
--- a/RadioButton.st Sat Mar 18 06:16:33 1995 +0100
+++ b/RadioButton.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,18 +10,20 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:09:35 am'!
+
Toggle subclass:#RadioButton
- instanceVariableNames:'group'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Interactors'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
!
RadioButton comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.7 1995-02-16 03:12:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.8 1995-03-18 05:15:51 claus Exp $
'!
!RadioButton class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.7 1995-02-16 03:12:59 claus Exp $
+$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.8 1995-03-18 05:15:51 claus Exp $
"
!
@@ -57,15 +59,17 @@
examples
"
+ example1: one on
+
|top panel b group|
top := StandardSystemView new.
top extent:200@200.
panel := HorizontalPanelView
- origin:0.0@0.0
- corner:1.0@1.0
- in:top.
+ origin:0.0@0.0
+ corner:1.0@1.0
+ in:top.
group := RadioButtonGroup new.
@@ -79,37 +83,38 @@
group add:b.
top open
+
+
+ example2: zero or one on
+
+ |top panel b group|
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ panel := HorizontalPanelView
+ origin:0.0@0.0
+ corner:1.0@1.0
+ in:top.
+
+ group := RadioButtonGroup new.
+
+ b := Toggle label:'am' in:panel.
+ group add:b.
+
+ b := Toggle label:'fm' in:panel.
+ group add:b.
+
+ b := Toggle label:'off' in:panel.
+ group add:b.
+
+ top open
"
! !
-!RadioButton methodsFor:'destroying'!
+!RadioButton methodsFor:'initialization'!
-destroy
- self release.
- super destroy
+defaultControllerClass
+ ^ RadioButtonController
! !
-!RadioButton methodsFor:'accessing '!
-
-group
- "return the radioButtonGroup in which I am"
-
- ^ group
-!
-
-group:aButtonGroup
- "set the radioButtonGroup in which I am"
-
- group := aButtonGroup
-! !
-
-!RadioButton methodsFor:'events'!
-
-buttonPress:button x:x y:y
- "radiobuttons change only off-to-on; turning off is done by other
- buttons"
-
- controller pressed ifFalse:[
- self toggle
- ]
-! !
--- a/RadioButtonGroup.st Sat Mar 18 06:16:33 1995 +0100
+++ b/RadioButtonGroup.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,6 +10,8 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:06:48 am'!
+
OrderedCollection subclass:#RadioButtonGroup
instanceVariableNames:''
classVariableNames:''
@@ -21,7 +23,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/RadioButtonGroup.st,v 1.8 1995-02-16 03:12:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/RadioButtonGroup.st,v 1.9 1995-03-18 05:15:46 claus Exp $
'!
!RadioButtonGroup class methodsFor:'documentation '!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/RadioButtonGroup.st,v 1.8 1995-02-16 03:12:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/RadioButtonGroup.st,v 1.9 1995-03-18 05:15:46 claus Exp $
"
!
@@ -69,8 +71,9 @@
add:aRadioButton
super add:aRadioButton.
- aRadioButton addDependent:self.
- aRadioButton group:self
+ aRadioButton model:self; change:#elementChanged:from:.
+"/ aRadioButton addDependent:self.
+ (aRadioButton respondsTo:#group) ifTrue:[aRadioButton group:self]
! !
!RadioButtonGroup methodsFor:'update'!
@@ -80,19 +83,39 @@
"a RadioButton in this group has changed - notify the others"
- "in case we have a toggle in the group,
- and it has been turned off - turn it on again
- "
- changedButton isOn ifFalse:[
- changedButton toggleNoAction.
- ^ self
- ].
+"/ "in case we have a toggle in the group,
+"/ and it has been turned off - turn it on again
+"/ "
+"/ changedButton isOn ifFalse:[
+"/ changedButton toggleNoAction.
+"/ ^ self
+"/ ].
+ self do:[:aButton |
+ (aButton == changedButton) ifFalse:[
+ aButton isOn ifTrue:[
+ aButton turnOff
+ ]
+ ]
+ ]
+!
+
+elementChanged:aToggle
self do:[:aButton |
- (aButton == changedButton) ifFalse:[
- aButton isOn ifTrue:[
- aButton turnOff
- ]
- ]
+ (aButton == aToggle) ifFalse:[
+ aButton isOn ifTrue:[
+ aButton turnOff
+ ]
+ ]
]
+!
+elementChanged:newValue from:aToggle
+ self do:[:aButton |
+ (aButton == aToggle) ifFalse:[
+ aButton isOn ifTrue:[
+ aButton turnOff
+ ]
+ ]
+ ]
! !
+
--- a/ScrView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/ScrView.st Sat Mar 18 06:16:50 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.11 1995-02-22 03:38:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.12 1995-03-18 05:15:55 claus Exp $
'!
!ScrollableView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.11 1995-02-22 03:38:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.12 1995-03-18 05:15:55 claus Exp $
"
!
@@ -372,6 +372,17 @@
]
! !
+!ScrollableView methodsFor:'queries'!
+
+preferedExtent
+ scrolledView notNil ifTrue:[
+ | pref |
+ pref := scrolledView preferedExtent.
+ ^ (pref x + scrollBar width + (innerMargin * 2)) @ pref y.
+ ].
+ ^ super preferedExtent.
+! !
+
!ScrollableView methodsFor:'private'!
setScrollActions
--- a/ScrollableView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/ScrollableView.st Sat Mar 18 06:16:50 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.11 1995-02-22 03:38:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.12 1995-03-18 05:15:55 claus Exp $
'!
!ScrollableView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.11 1995-02-22 03:38:03 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.12 1995-03-18 05:15:55 claus Exp $
"
!
@@ -372,6 +372,17 @@
]
! !
+!ScrollableView methodsFor:'queries'!
+
+preferedExtent
+ scrolledView notNil ifTrue:[
+ | pref |
+ pref := scrolledView preferedExtent.
+ ^ (pref x + scrollBar width + (innerMargin * 2)) @ pref y.
+ ].
+ ^ super preferedExtent.
+! !
+
!ScrollableView methodsFor:'private'!
setScrollActions
--- a/Scroller.st Sat Mar 18 06:16:33 1995 +0100
+++ b/Scroller.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,40 +10,34 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:18:14 am'!
+
View subclass:#Scroller
- instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor
- scrollAction moveDirection
- thumbFrame thumbLevel
- scrolling pressOffset
- synchronousOperation
- shadowForm lightForm inset
- thumbShadowColor thumbLightColor
- thumbEdgeStyle
- thumbHalfShadowColor thumbHalfLightColor
- thumbFrameSizeDifference
- tallyLevel tallyMarks
- fixThumbHeight frameBeforeMove
- ghostColor ghostFrameColor ghostLevel'
- classVariableNames: 'HandleShadowForm HandleLightForm
- DefaultViewBackground
- DefaultShadowColor DefaultLightColor DefaultThumbColor
- DefaultThumbShadowColor DefaultThumbLightColor
- DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
- DefaultHalfShadowColor DefaultHalfLightColor
- DefaultTallyMarks DefaultTallyLevel
- DefaultLevel DefaultBorderWidth DefaultThumbLevel
- DefaultInset DefaultThumbFrameColor
- DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
- DefaultFixThumbHeight DefaultEdgeStyle'
- poolDictionaries:''
- category:'Views-Interactors'
+ instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor scrollAction
+ moveDirection thumbFrame thumbLevel scrolling pressOffset
+ synchronousOperation shadowForm lightForm inset thumbShadowColor
+ thumbLightColor thumbEdgeStyle thumbHalfShadowColor
+ thumbHalfLightColor thumbFrameSizeDifference tallyLevel
+ tallyMarks fixThumbHeight frameBeforeMove ghostColor
+ ghostFrameColor ghostLevel'
+ classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground
+ DefaultShadowColor DefaultLightColor DefaultThumbColor
+ DefaultThumbShadowColor DefaultThumbLightColor
+ DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
+ DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks
+ DefaultTallyLevel DefaultLevel DefaultBorderWidth
+ DefaultThumbLevel DefaultInset DefaultThumbFrameColor
+ DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
+ DefaultFixThumbHeight DefaultEdgeStyle'
+ poolDictionaries:''
+ category:'Views-Interactors'
!
Scroller comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.16 1995-03-09 03:29:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.17 1995-03-18 05:16:01 claus Exp $
'!
!Scroller class methodsFor:'documentation'!
@@ -64,7 +58,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.16 1995-03-09 03:29:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.17 1995-03-18 05:16:01 claus Exp $
"
!
@@ -230,680 +224,8 @@
^ f
! !
-!Scroller methodsFor:'initialization'!
-
-initialize
- "initialize - setup instvars from defaults"
-
- super initialize.
- self computeInitialExtent.
- moveDirection := #y.
-
- scrolling := false.
- synchronousOperation := true.
-
- thumbOrigin := 0.
- thumbHeight := 100.
- thumbFrameSizeDifference := 0.
-
-"/ inset := 1.
-
-"/ self computeThumbFrame
-!
-
-computeInitialExtent
- ^ self
-!
-
-initStyle
- "initialize style dep. stuff"
-
- super initStyle.
-
- DefaultViewBackground notNil ifTrue:[
- viewBackground := DefaultViewBackground on:device.
- ].
- DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor on:device.
- ].
- DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor on:device.
- ].
-
- tallyMarks := DefaultTallyMarks.
- tallyLevel := DefaultTallyLevel.
- DefaultLevel ~~ level ifTrue:[
- self level:DefaultLevel.
- ].
- DefaultBorderWidth ~~ borderWidth ifTrue:[
- self borderWidth:DefaultBorderWidth.
- ].
- thumbLevel := DefaultThumbLevel.
- inset := DefaultInset.
- fixThumbHeight := DefaultFixThumbHeight.
- thumbEdgeStyle := DefaultEdgeStyle.
-
- DefaultGhostColor notNil ifTrue:[
- ghostColor := DefaultGhostColor on:device.
- ].
- DefaultGhostFrameColor notNil ifTrue:[
- ghostFrameColor := DefaultGhostFrameColor on:device.
- ].
- ghostLevel := DefaultGhostLevel.
-
- DefaultThumbFrameColor notNil ifTrue:[
- thumbFrameColor := DefaultThumbFrameColor on:device.
- ].
- DefaultThumbShadowColor notNil ifTrue:[
- thumbShadowColor := DefaultThumbShadowColor
- ] ifFalse:[
- thumbShadowColor := shadowColor.
- ].
- DefaultThumbLightColor notNil ifTrue:[
- thumbLightColor := DefaultThumbLightColor
- ] ifFalse:[
- thumbLightColor := lightColor.
- ].
-
- thumbEdgeStyle notNil ifTrue:[
- DefaultThumbHalfShadowColor notNil ifTrue:[
- thumbHalfShadowColor := DefaultThumbHalfShadowColor
- ].
- DefaultThumbHalfLightColor notNil ifTrue:[
- thumbHalfLightColor := DefaultThumbHalfLightColor
- ].
- ].
-
- device hasGreyscales ifFalse:[
- thumbEdgeStyle notNil ifTrue:[
- thumbHalfShadowColor := Color darkGrey.
- thumbHalfLightColor := White
- ].
-
- thumbShadowColor := Black.
-"/ thumbLightColor := White.
-
- StyleSheet name = #motif ifTrue:[
- DefaultThumbColor isNil ifTrue:[
- thumbColor := White .
- ].
- ]
- ].
-
- DefaultThumbColor notNil ifTrue:[
- thumbColor := DefaultThumbColor on:device
- ] ifFalse:[
- thumbColor := White.
- StyleSheet name ~= #normal ifTrue:[
- device hasGreyscales ifFalse:[
- thumbColor := Color grey
- ].
- ].
- ].
-
- thumbColor := thumbColor on:device.
- thumbShadowColor notNil ifTrue:[
- thumbShadowColor := thumbShadowColor on:device.
- ].
- thumbLightColor notNil ifTrue:[
- thumbLightColor := thumbLightColor on:device.
- ].
- thumbHalfShadowColor notNil ifTrue:[
- thumbHalfShadowColor := thumbHalfShadowColor on:device.
- ].
- thumbHalfLightColor notNil ifTrue:[
- thumbHalfLightColor := thumbHalfLightColor on:device.
- ].
- thumbEdgeStyle notNil ifTrue:[
- thumbHalfShadowColor isNil ifTrue:[
- thumbHalfShadowColor := thumbShadowColor lightened on:device
- ]
- ].
-
- StyleSheet name = #next ifTrue:[
- shadowForm := self class handleShadowFormOn:device.
- lightForm := self class handleLightFormOn:device
- ] ifFalse:[
- shadowForm := lightForm := nil
- ].
-
- drawableId notNil ifTrue:[
- self computeThumbFrame
- ]
-!
-
-initCursor
- "set the cursor - a hand"
-
- cursor := Cursor hand
-! !
-
-!Scroller methodsFor:'accessing'!
-
-is3D
- StyleSheet name = #mswindows ifTrue:[^ true].
- ^ super is3D
-!
-
-asynchronousOperation
- "set scroll-mode to be asynchronous - scroll action is performed after
- scrolling, when mouse-button is finally released"
-
- synchronousOperation := false
-!
-
-synchronousOperation
- "set scroll-mode to be synchronous - scroll action is performed for
- every movement of thumb"
-
- synchronousOperation := true
-!
-
-scrollAction:aBlock
- "set the scroll action, aBlock which is evaluated when scrolled"
-
- scrollAction := aBlock
-!
-
-scrollAction
- "answer the scroll action block"
-
- ^ scrollAction
-!
-
-scrollDownAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-!
-
-scrollUpAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-!
-
-thumbOrigin
- "answer the thumbs origin (in percent)"
-
- ^ thumbOrigin
-!
-
-thumbOrigin:newOrigin
- "set the thumbs origin (in percent)"
-
- |realNewOrigin oldFrame oldTop oldBot thumbTop thumbBot
- tH "{ Class: SmallInteger }"
- tW delta left|
-
- ((newOrigin + thumbHeight) > 100) ifTrue:[
- realNewOrigin := 100 - thumbHeight
- ] ifFalse: [
- realNewOrigin := newOrigin
- ].
- (realNewOrigin > 100) ifTrue:[
- realNewOrigin := 100
- ] ifFalse: [
- (realNewOrigin < 0) ifTrue:[
- realNewOrigin := 0
- ]
- ].
- ((realNewOrigin ~= thumbOrigin) or:[thumbFrame isNil]) ifTrue:[
- thumbOrigin := realNewOrigin.
-
- shown ifTrue:[
- oldFrame := thumbFrame.
- self computeThumbFrame.
- (thumbHeight = 100) ifTrue:[^ self].
-
- (thumbFrame ~~ oldFrame) ifTrue:[
- oldFrame isNil ifTrue:[
- self drawThumb.
- ^ self
- ].
- tH := thumbFrame height.
- tW := thumbFrame width.
- oldTop := oldFrame top.
- oldBot := oldTop + tH.
-
- thumbTop := thumbFrame top.
- thumbBot := thumbTop + tH.
-
- left := thumbFrame left.
-
- (self exposeEventPending
- or:[oldBot >= height]) ifTrue:[
- "cannot copy - thumb was below end or may be not available
- for the copy"
- self drawThumbBackgroundInX:left y:oldTop
- width:tW height:(height - oldTop).
- self drawThumb.
- ^ self
- ].
-
- self catchExpose.
- self copyFrom:self x:left y:oldTop
- toX:left y:thumbTop
- width:tW height:tH.
-
- oldTop > thumbTop ifTrue:[
- delta := oldTop - thumbTop.
- oldTop > thumbBot ifTrue:[
- self drawThumbBackgroundInX:left y:oldTop
- width:tW height:(tH + 1)
- ] ifFalse:[
- self drawThumbBackgroundInX:left y:thumbBot
- width:tW height:delta
- ]
- ] ifFalse:[
- delta := thumbTop - oldTop.
- oldBot < thumbTop ifTrue:[
- self drawThumbBackgroundInX:left y:oldTop
- width:tW height:(tH + 1)
- ] ifFalse:[
- self drawThumbBackgroundInX:left y:oldTop
- width:tW height:delta
- ]
- ].
- self waitForExpose
- ]
- ] ifFalse:[
- thumbFrame := nil
- ]
- ]
-!
-
-thumbHeight
- "answer the thumbs height (in percent)"
-
- ^ thumbHeight
-!
-
-thumbHeight:newHeight
- "set the thumbs height (in percent)"
-
- |realNewHeight oldFrame|
-
- (newHeight > 100) ifTrue:[
- realNewHeight := 100
- ] ifFalse:[
- realNewHeight := newHeight
- ].
- ((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
- thumbHeight := realNewHeight.
- shown ifTrue:[
- oldFrame := thumbFrame.
- self computeThumbFrame.
- (fixThumbHeight or:[oldFrame ~~ thumbFrame]) ifTrue:[
- oldFrame notNil ifTrue:[
- self drawThumbBackgroundInX:(oldFrame left)
- y:(oldFrame top)
- width:(oldFrame width)
- height:(oldFrame height).
- ].
- self drawThumb
- ]
- ] ifFalse:[
- thumbFrame := nil
- ]
- ]
-!
-
-thumbOrigin:newOrigin thumbHeight:newHeight
- "set both thumbs height and origin (in percent)"
-
- |realNewOrigin realNewHeight old new changed|
-
- (newHeight > 100) ifTrue:[
- realNewHeight := 100
- ] ifFalse:[
- realNewHeight := newHeight
- ].
- ((newOrigin + realNewHeight) > 100) ifTrue:[
- realNewOrigin := 100 - realNewHeight
- ] ifFalse: [
- realNewOrigin := newOrigin
- ].
- (realNewOrigin < 0) ifTrue: [
- realNewOrigin := 0
- ].
-
- changed := (realNewHeight ~= thumbHeight) or:[realNewOrigin ~= thumbOrigin].
- (changed or:[thumbFrame isNil]) ifTrue:[
- old := self absFromPercent:thumbOrigin.
- new := self absFromPercent:realNewOrigin.
- changed := old ~~ new.
- changed ifFalse:[
- old := self absFromPercent:thumbHeight.
- new := self absFromPercent:realNewHeight.
- changed := (old ~~ new)
- ].
- (changed or:[thumbFrame isNil]) ifTrue:[
- thumbOrigin := realNewOrigin.
- thumbHeight := realNewHeight.
- shown ifTrue:[
- thumbFrame notNil ifTrue:[
- self drawThumbBackgroundInX:(thumbFrame left)
- y:(thumbFrame top)
- width:(thumbFrame width)
- height:(thumbFrame height).
- ].
- self computeThumbFrame.
- self drawThumb
- ] ifFalse:[
- thumbFrame := nil
- ]
- ]
- ]
-!
-
-setThumbFor:aView
- "get contents and size info from aView and adjust thumb"
-
- |percentSize percentOrigin contentsSize contentsPosition viewsSize|
-
- "
- get the content's size
- "
- aView isNil ifTrue:[
- contentsSize := 0
- ] ifFalse:[
- moveDirection == #y ifTrue:[
- contentsSize := aView heightOfContents.
- aView transformation notNil ifTrue:[
- contentsSize := aView transformation applyScaleY:contentsSize.
- ].
- ] ifFalse:[
- contentsSize := aView widthOfContents.
- aView transformation notNil ifTrue:[
- contentsSize := aView transformation applyScaleX:contentsSize.
- ].
- ]
- ].
-
- (contentsSize = 0) ifTrue:[
- percentSize := 100.
- percentOrigin := 100
- ] ifFalse:[
- (moveDirection == #y) ifTrue:[
- viewsSize := aView innerHeight.
- contentsPosition := aView yOriginOfContents.
- ] ifFalse:[
- viewsSize := aView innerWidth.
- contentsPosition := aView xOriginOfContents
- ].
-
- percentSize := viewsSize * 100.0 / contentsSize.
- percentOrigin := contentsPosition * 100.0 / contentsSize.
- percentOrigin + percentSize > 100.0 ifTrue:[
- "actually showing stuff below contents of view"
-"
- contentsSize := contentsPosition + aView innerHeight.
- percentSize := viewsSize * 100.0 / contentsSize.
- percentOrigin := contentsPosition * 100.0 / contentsSize
-"
- ]
- ].
- (percentSize = thumbHeight) ifTrue:[
- self thumbOrigin:percentOrigin
- ] ifFalse:[
- (percentOrigin = thumbOrigin) ifTrue:[
- self thumbHeight:percentSize
- ] ifFalse:[
- self thumbOrigin:percentOrigin thumbHeight:percentSize
- ]
- ]
-!
-
-setThumbHeightFor:aView
- "get contents and size info from aView and adjust thumb height"
-
- |percent total viewsSize|
-
- (moveDirection == #y) ifTrue:[
- total := aView heightOfContents.
- aView transformation notNil ifTrue:[
- total := aView transformation applyScaleY:total.
- ].
- ] ifFalse:[
- total := aView widthOfContents.
- aView transformation notNil ifTrue:[
- total := aView transformation applyScaleX:total.
- ].
- ].
- (total = 0) ifTrue:[
- percent := 100
- ] ifFalse:[
- viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
- ifFalse:[aView innerWidth].
- percent := viewsSize * 100.0 / total
- ].
- self thumbHeight:percent
-!
-
-setThumbOriginFor:aView
- "get contents and size info from aView and adjust thumb origin"
-
- |percent total contentsPosition|
-
- (moveDirection == #y) ifTrue:[
- total := aView heightOfContents.
- aView transformation notNil ifTrue:[
- total := aView transformation applyScaleY:total.
- ].
- ] ifFalse:[
- total := aView widthOfContents.
- aView transformation notNil ifTrue:[
- total := aView transformation applyScaleX:total.
- ].
- ].
- (total = 0) ifTrue:[
- percent := 100
- ] ifFalse:[
- contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents]
- ifFalse:[aView xOriginOfContents].
- percent := contentsPosition * 100.0 / total
- ].
- self thumbOrigin:percent
-!
-
-thumbColor:aColor
- "change the color of the thumb"
-
- thumbColor := aColor on:device.
- (StyleSheet name ~~ #normal) ifTrue:[
- thumbShadowColor := aColor darkened on:device.
- thumbLightColor := aColor lightened on:device.
- thumbHalfShadowColor := thumbShadowColor darkened on:device.
- thumbHalfLightColor := thumbLightColor lightened on:device.
- ].
- shown ifTrue:[
- self redraw
- ]
-!
-
-thumbColor
- "return the thumbs color"
-
- ^ thumbColor
-!
-
-thumbFrame
- "return the area used by the thumbFrame (in device coordinates).
- Allows access to the thumbs physical screen position, for
- example to position a label below (see Slider-Examples)"
-
- thumbFrame isNil ifTrue:[ self computeThumbFrame].
- ^ thumbFrame
-! !
-
-!Scroller methodsFor:'private'!
-
-absFromPercent:percent
- "given a percentage, compute number of pixels"
-
- |fullSize|
-
- (moveDirection == #y) ifTrue:[
- fullSize := height
- ] ifFalse:[
- fullSize := width
- ].
-"/ ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
-"/ 20-apr-94
- ^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
-!
-
-percentFromAbs:absValue
- "given a number of pixels, compute percentage"
-
- |fullSize val|
-
- (moveDirection == #y) ifTrue:[
- fullSize := height
- ] ifFalse:[
- fullSize := width
- ].
-
- val := absValue / (fullSize - thumbFrameSizeDifference - (margin * 2)) * 100.
- val < 0 ifTrue:[^ 0].
- val > 100 ifTrue:[^ 100].
- ^ val
-!
-
-computeThumbFrame
- "compute the thumbs frame (a rectangle) whenever thumb is moved,
- changed height or the scrollers size has changed.
- We take care, that the thumb will not become too small (i.e.
- invisible or uncatchable).
- Also, for mswindows style, its height/width is constant."
-
- |newPos1 newPos2 newSize1 newSize2 nh nw ny nx
- computedSize minSz sz1 sz2|
-
- "compute position & size"
- newPos1 := (self absFromPercent:thumbOrigin) + margin.
- newSize1 := computedSize := self absFromPercent:thumbHeight.
- (moveDirection == #y) ifTrue:[
- sz1 := height.
- sz2 := width
- ] ifFalse:[
- sz1 := width.
- sz2 := height
- ].
-
- "
- do we have to adjust the computed size ?
- "
- newPos2 := margin + inset.
- newSize2 := sz2 - (2 * newPos2).
-"/ (style ~~ #normal) ifTrue:[
- thumbLevel ~~ 0 ifTrue:[
- "
- do not make thumb too small (for handle & to be catchable)
- "
- minSz := 10 + (2 * thumbLevel)
- ] ifFalse:[
- "
- do not make thumb too small (uncatchable)
- "
- minSz := 4
- ].
-
- (newSize1 < minSz) ifTrue:[
- newSize1 := minSz.
- thumbFrameSizeDifference := newSize1 - computedSize
- ] ifFalse:[
- thumbFrameSizeDifference := 0.
- ].
-
- fixThumbHeight ifTrue:[
- "have a fix-size thumb (i.e. mswindows style)"
-
- newSize1 := sz2 - (2 * inset). "make it square"
- thumbFrameSizeDifference := newSize1 - computedSize.
- ].
-
- "
- oops - if height does not relect real visibible area, we have to adjust the origin
- "
- (thumbFrameSizeDifference == 0) ifFalse:[
- newPos1 := (self absFromPercent:thumbOrigin) + margin.
-"/ newPos1 := ((thumbOrigin * (sz1 - thumbFrameSizeDifference - (margin * 2))) / 100) rounded + margin
- ].
-
- (moveDirection == #y) ifTrue:[
- ny := newPos1.
- nx := newPos2.
- nh := newSize1.
- nw := newSize2.
- ny + nh + margin > height ifTrue:[
- ny := height - margin - nh
- ]
- ] ifFalse:[
- nx := newPos1.
- ny := newPos2.
- nw := newSize1.
- nh := newSize2.
- nx + nw + margin > width ifTrue:[
- nx := width - margin - nw
- ]
- ].
-
- "
- do not create new Rectangle if its the same anyway
- "
- thumbFrame notNil ifTrue:[
- (ny == thumbFrame top) ifTrue:[
- (nx == thumbFrame left) ifTrue:[
- (nh == thumbFrame height) ifTrue:[
- (nw == thumbFrame width) ifTrue:[ ^ self]
- ]
- ]
- ]
- ].
- thumbFrame := Rectangle left:nx top:ny width:nw height:nh
-! !
-
!Scroller methodsFor:'drawing'!
-drawHandleFormAtX:x y:y
- thumbShadowColor := thumbShadowColor on:device.
- thumbLightColor := thumbLightColor on:device.
-
- self paint:thumbShadowColor.
- self displayForm:shadowForm x:x y:y.
- self paint:thumbLightColor.
- self displayForm:lightForm x:x y:y.
-!
-
-drawThumbBackgroundInX:x y:y width:w height:h
- "draw part of the thumbs background; defined as a separate
- method, to allow drawing of arbitrary patterns under thumb
- (see ColorSlider)."
-
- shown ifTrue:[
- self clearRectangleX:x y:y width:w height:h.
- frameBeforeMove notNil ifTrue:[
- self clippedTo:(Rectangle left:x top:y width:w height:h) do:[
- |gX gY gW gH|
-
- gX := frameBeforeMove left.
- gY := frameBeforeMove top.
- gW := frameBeforeMove width.
- gH := frameBeforeMove height.
-
- self fillRectangle:frameBeforeMove with:ghostColor.
- (ghostLevel ~~ 0) ifTrue:[
- self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel
- ].
- ghostFrameColor notNil ifTrue:[
- self paint:ghostFrameColor.
- self displayRectangleX:gX y:gY width:gW height:gH
- ]
- ]
- ]
- ]
-!
-
drawThumb
"draw the thumb"
@@ -1033,38 +355,678 @@
]
]
]
+!
+
+drawThumbBackgroundInX:x y:y width:w height:h
+ "draw part of the thumbs background; defined as a separate
+ method, to allow drawing of arbitrary patterns under thumb
+ (see ColorSlider)."
+
+ shown ifTrue:[
+ self clearRectangleX:x y:y width:w height:h.
+ frameBeforeMove notNil ifTrue:[
+ self clippedTo:(Rectangle left:x top:y width:w height:h) do:[
+ |gX gY gW gH|
+
+ gX := frameBeforeMove left.
+ gY := frameBeforeMove top.
+ gW := frameBeforeMove width.
+ gH := frameBeforeMove height.
+
+ self fillRectangle:frameBeforeMove with:ghostColor.
+ (ghostLevel ~~ 0) ifTrue:[
+ self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel
+ ].
+ ghostFrameColor notNil ifTrue:[
+ self paint:ghostFrameColor.
+ self displayRectangleX:gX y:gY width:gW height:gH
+ ]
+ ]
+ ]
+ ]
+!
+
+drawHandleFormAtX:x y:y
+ thumbShadowColor := thumbShadowColor on:device.
+ thumbLightColor := thumbLightColor on:device.
+
+ self paint:thumbShadowColor.
+ self displayForm:shadowForm x:x y:y.
+ self paint:thumbLightColor.
+ self displayForm:lightForm x:x y:y.
! !
-!Scroller methodsFor:'forced scroll'!
+!Scroller methodsFor:'accessing'!
+
+thumbOrigin:newOrigin
+ "set the thumbs origin (in percent)"
+
+ |realNewOrigin oldFrame oldTop oldBot thumbTop thumbBot
+ tH "{ Class: SmallInteger }"
+ tW delta left|
+
+ ((newOrigin + thumbHeight) > 100) ifTrue:[
+ realNewOrigin := 100 - thumbHeight
+ ] ifFalse: [
+ realNewOrigin := newOrigin
+ ].
+ (realNewOrigin > 100) ifTrue:[
+ realNewOrigin := 100
+ ] ifFalse: [
+ (realNewOrigin < 0) ifTrue:[
+ realNewOrigin := 0
+ ]
+ ].
+ ((realNewOrigin ~= thumbOrigin) or:[thumbFrame isNil]) ifTrue:[
+ thumbOrigin := realNewOrigin.
+
+ shown ifTrue:[
+ oldFrame := thumbFrame.
+ self computeThumbFrame.
+ (thumbHeight = 100) ifTrue:[^ self].
+
+ (thumbFrame ~~ oldFrame) ifTrue:[
+ oldFrame isNil ifTrue:[
+ self drawThumb.
+ ^ self
+ ].
+ tH := thumbFrame height.
+ tW := thumbFrame width.
+ oldTop := oldFrame top.
+ oldBot := oldTop + tH.
+
+ thumbTop := thumbFrame top.
+ thumbBot := thumbTop + tH.
+
+ left := thumbFrame left.
+
+ (self exposeEventPending
+ or:[oldBot >= height]) ifTrue:[
+ "cannot copy - thumb was below end or may be not available
+ for the copy"
+ self drawThumbBackgroundInX:left y:oldTop
+ width:tW height:(height - oldTop).
+ self drawThumb.
+ ^ self
+ ].
+
+ self catchExpose.
+ self copyFrom:self x:left y:oldTop
+ toX:left y:thumbTop
+ width:tW height:tH.
+
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ self drawThumbBackgroundInX:left y:oldTop
+ width:tW height:(tH + 1)
+ ] ifFalse:[
+ self drawThumbBackgroundInX:left y:thumbBot
+ width:tW height:delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ self drawThumbBackgroundInX:left y:oldTop
+ width:tW height:(tH + 1)
+ ] ifFalse:[
+ self drawThumbBackgroundInX:left y:oldTop
+ width:tW height:delta
+ ]
+ ].
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
+!
+
+thumbHeight:newHeight
+ "set the thumbs height (in percent)"
+
+ |realNewHeight oldFrame|
+
+ (newHeight > 100) ifTrue:[
+ realNewHeight := 100
+ ] ifFalse:[
+ realNewHeight := newHeight
+ ].
+ ((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
+ thumbHeight := realNewHeight.
+ shown ifTrue:[
+ oldFrame := thumbFrame.
+ self computeThumbFrame.
+ (fixThumbHeight or:[oldFrame ~~ thumbFrame]) ifTrue:[
+ oldFrame notNil ifTrue:[
+ self drawThumbBackgroundInX:(oldFrame left)
+ y:(oldFrame top)
+ width:(oldFrame width)
+ height:(oldFrame height).
+ ].
+ self drawThumb
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
+!
+
+setThumbFor:aView
+ "get contents and size info from aView and adjust thumb"
+
+ |percentSize percentOrigin contentsSize contentsPosition viewsSize|
+
+ "
+ get the content's size
+ "
+ aView isNil ifTrue:[
+ contentsSize := 0
+ ] ifFalse:[
+ moveDirection == #y ifTrue:[
+ contentsSize := aView heightOfContents.
+ aView transformation notNil ifTrue:[
+ contentsSize := aView transformation applyScaleY:contentsSize.
+ ].
+ ] ifFalse:[
+ contentsSize := aView widthOfContents.
+ aView transformation notNil ifTrue:[
+ contentsSize := aView transformation applyScaleX:contentsSize.
+ ].
+ ]
+ ].
-pageUp
- "page up/left"
+ (contentsSize = 0) ifTrue:[
+ percentSize := 100.
+ percentOrigin := 100
+ ] ifFalse:[
+ (moveDirection == #y) ifTrue:[
+ viewsSize := aView innerHeight.
+ contentsPosition := aView yOriginOfContents.
+ ] ifFalse:[
+ viewsSize := aView innerWidth.
+ contentsPosition := aView xOriginOfContents
+ ].
+
+ percentSize := viewsSize * 100.0 / contentsSize.
+ percentOrigin := contentsPosition * 100.0 / contentsSize.
+ percentOrigin + percentSize > 100.0 ifTrue:[
+ "actually showing stuff below contents of view"
+"
+ contentsSize := contentsPosition + aView innerHeight.
+ percentSize := viewsSize * 100.0 / contentsSize.
+ percentOrigin := contentsPosition * 100.0 / contentsSize
+"
+ ]
+ ].
+ (percentSize = thumbHeight) ifTrue:[
+ self thumbOrigin:percentOrigin
+ ] ifFalse:[
+ (percentOrigin = thumbOrigin) ifTrue:[
+ self thumbHeight:percentSize
+ ] ifFalse:[
+ self thumbOrigin:percentOrigin thumbHeight:percentSize
+ ]
+ ]
+!
+
+thumbOrigin:newOrigin thumbHeight:newHeight
+ "set both thumbs height and origin (in percent)"
+
+ |realNewOrigin realNewHeight old new changed|
+
+ (newHeight > 100) ifTrue:[
+ realNewHeight := 100
+ ] ifFalse:[
+ realNewHeight := newHeight
+ ].
+ ((newOrigin + realNewHeight) > 100) ifTrue:[
+ realNewOrigin := 100 - realNewHeight
+ ] ifFalse: [
+ realNewOrigin := newOrigin
+ ].
+ (realNewOrigin < 0) ifTrue: [
+ realNewOrigin := 0
+ ].
- self thumbOrigin:(thumbOrigin - thumbHeight).
- self tellOthers
+ changed := (realNewHeight ~= thumbHeight) or:[realNewOrigin ~= thumbOrigin].
+ (changed or:[thumbFrame isNil]) ifTrue:[
+ old := self absFromPercent:thumbOrigin.
+ new := self absFromPercent:realNewOrigin.
+ changed := old ~~ new.
+ changed ifFalse:[
+ old := self absFromPercent:thumbHeight.
+ new := self absFromPercent:realNewHeight.
+ changed := (old ~~ new)
+ ].
+ (changed or:[thumbFrame isNil]) ifTrue:[
+ thumbOrigin := realNewOrigin.
+ thumbHeight := realNewHeight.
+ shown ifTrue:[
+ thumbFrame notNil ifTrue:[
+ self drawThumbBackgroundInX:(thumbFrame left)
+ y:(thumbFrame top)
+ width:(thumbFrame width)
+ height:(thumbFrame height).
+ ].
+ self computeThumbFrame.
+ self drawThumb
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
+ ]
+!
+
+setThumbOriginFor:aView
+ "get contents and size info from aView and adjust thumb origin"
+
+ |percent total contentsPosition|
+
+ (moveDirection == #y) ifTrue:[
+ total := aView heightOfContents.
+ aView transformation notNil ifTrue:[
+ total := aView transformation applyScaleY:total.
+ ].
+ ] ifFalse:[
+ total := aView widthOfContents.
+ aView transformation notNil ifTrue:[
+ total := aView transformation applyScaleX:total.
+ ].
+ ].
+ (total = 0) ifTrue:[
+ percent := 100
+ ] ifFalse:[
+ contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents]
+ ifFalse:[aView xOriginOfContents].
+ percent := contentsPosition * 100.0 / total
+ ].
+ self thumbOrigin:percent
+!
+
+is3D
+ StyleSheet name = #mswindows ifTrue:[^ true].
+ ^ super is3D
+!
+
+scrollAction:aBlock
+ "set the scroll action, aBlock which is evaluated when scrolled"
+
+ scrollAction := aBlock
+!
+
+asynchronousOperation
+ "set scroll-mode to be asynchronous - scroll action is performed after
+ scrolling, when mouse-button is finally released"
+
+ synchronousOperation := false
+!
+
+synchronousOperation
+ "set scroll-mode to be synchronous - scroll action is performed for
+ every movement of thumb"
+
+ synchronousOperation := true
+!
+
+scrollAction
+ "answer the scroll action block"
+
+ ^ scrollAction
+!
+
+scrollDownAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
+!
+
+scrollUpAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
+!
+
+thumbOrigin
+ "answer the thumbs origin (in percent)"
+
+ ^ thumbOrigin
!
-pageDown
- "page down/right"
+thumbHeight
+ "answer the thumbs height (in percent)"
+
+ ^ thumbHeight
+!
+
+setThumbHeightFor:aView
+ "get contents and size info from aView and adjust thumb height"
+
+ |percent total viewsSize|
- self thumbOrigin:(thumbOrigin + thumbHeight).
- self tellOthers
+ (moveDirection == #y) ifTrue:[
+ total := aView heightOfContents.
+ aView transformation notNil ifTrue:[
+ total := aView transformation applyScaleY:total.
+ ].
+ ] ifFalse:[
+ total := aView widthOfContents.
+ aView transformation notNil ifTrue:[
+ total := aView transformation applyScaleX:total.
+ ].
+ ].
+ (total = 0) ifTrue:[
+ percent := 100
+ ] ifFalse:[
+ viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
+ ifFalse:[aView innerWidth].
+ percent := viewsSize * 100.0 / total
+ ].
+ self thumbHeight:percent
+!
+
+thumbColor:aColor
+ "change the color of the thumb"
+
+ thumbColor := aColor on:device.
+ (StyleSheet name ~~ #normal) ifTrue:[
+ thumbShadowColor := aColor darkened on:device.
+ thumbLightColor := aColor lightened on:device.
+ thumbHalfShadowColor := thumbShadowColor darkened on:device.
+ thumbHalfLightColor := thumbLightColor lightened on:device.
+ ].
+ shown ifTrue:[
+ self redraw
+ ]
+!
+
+thumbColor
+ "return the thumbs color"
+
+ ^ thumbColor
+!
+
+thumbFrame
+ "return the area used by the thumbFrame (in device coordinates).
+ Allows access to the thumbs physical screen position, for
+ example to position a label below (see Slider-Examples)"
+
+ thumbFrame isNil ifTrue:[ self computeThumbFrame].
+ ^ thumbFrame
! !
-!Scroller methodsFor:'forwarding changed origin'!
+!Scroller methodsFor:'private'!
+
+computeThumbFrame
+ "compute the thumbs frame (a rectangle) whenever thumb is moved,
+ changed height or the scrollers size has changed.
+ We take care, that the thumb will not become too small (i.e.
+ invisible or uncatchable).
+ Also, for mswindows style, its height/width is constant."
+
+ |newPos1 newPos2 newSize1 newSize2 nh nw ny nx
+ computedSize minSz sz1 sz2|
+
+ "compute position & size"
+ newPos1 := (self absFromPercent:thumbOrigin) + margin.
+ newSize1 := computedSize := self absFromPercent:thumbHeight.
+ (moveDirection == #y) ifTrue:[
+ sz1 := height.
+ sz2 := width
+ ] ifFalse:[
+ sz1 := width.
+ sz2 := height
+ ].
+
+ "
+ do we have to adjust the computed size ?
+ "
+ newPos2 := margin + inset.
+ newSize2 := sz2 - (2 * newPos2).
+"/ (style ~~ #normal) ifTrue:[
+ thumbLevel ~~ 0 ifTrue:[
+ "
+ do not make thumb too small (for handle & to be catchable)
+ "
+ minSz := 10 + (2 * thumbLevel)
+ ] ifFalse:[
+ "
+ do not make thumb too small (uncatchable)
+ "
+ minSz := 4
+ ].
-tellOthers
+ (newSize1 < minSz) ifTrue:[
+ newSize1 := minSz.
+ thumbFrameSizeDifference := newSize1 - computedSize
+ ] ifFalse:[
+ thumbFrameSizeDifference := 0.
+ ].
+
+ fixThumbHeight ifTrue:[
+ "have a fix-size thumb (i.e. mswindows style)"
+
+ newSize1 := sz2 - (2 * inset). "make it square"
+ thumbFrameSizeDifference := newSize1 - computedSize.
+ ].
+
+ "
+ oops - if height does not relect real visibible area, we have to adjust the origin
"
- the ST/X way of notifying scrolls
+ (thumbFrameSizeDifference == 0) ifFalse:[
+ newPos1 := (self absFromPercent:thumbOrigin) + margin.
+"/ newPos1 := ((thumbOrigin * (sz1 - thumbFrameSizeDifference - (margin * 2))) / 100) rounded + margin
+ ].
+
+ (moveDirection == #y) ifTrue:[
+ ny := newPos1.
+ nx := newPos2.
+ nh := newSize1.
+ nw := newSize2.
+ ny + nh + margin > height ifTrue:[
+ ny := height - margin - nh
+ ]
+ ] ifFalse:[
+ nx := newPos1.
+ ny := newPos2.
+ nw := newSize1.
+ nh := newSize2.
+ nx + nw + margin > width ifTrue:[
+ nx := width - margin - nw
+ ]
+ ].
+
+ "
+ do not create new Rectangle if its the same anyway
"
- scrollAction notNil ifTrue:[
- scrollAction value:thumbOrigin
+ thumbFrame notNil ifTrue:[
+ (ny == thumbFrame top) ifTrue:[
+ (nx == thumbFrame left) ifTrue:[
+ (nh == thumbFrame height) ifTrue:[
+ (nw == thumbFrame width) ifTrue:[ ^ self]
+ ]
+ ]
+ ]
+ ].
+ thumbFrame := Rectangle left:nx top:ny width:nw height:nh
+!
+
+absFromPercent:percent
+ "given a percentage, compute number of pixels"
+
+ |fullSize|
+
+ (moveDirection == #y) ifTrue:[
+ fullSize := height
+ ] ifFalse:[
+ fullSize := width
+ ].
+"/ ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
+"/ 20-apr-94
+ ^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
+!
+
+percentFromAbs:absValue
+ "given a number of pixels, compute percentage"
+
+ |fullSize val|
+
+ (moveDirection == #y) ifTrue:[
+ fullSize := height
+ ] ifFalse:[
+ fullSize := width
+ ].
+
+ val := absValue / (fullSize - thumbFrameSizeDifference - (margin * 2)) * 100.
+ val < 0 ifTrue:[^ 0].
+ val > 100 ifTrue:[^ 100].
+ ^ val
+! !
+
+!Scroller methodsFor:'initialization'!
+
+initialize
+ "initialize - setup instvars from defaults"
+
+ super initialize.
+ self computeInitialExtent.
+ moveDirection := #y.
+
+ scrolling := false.
+ synchronousOperation := true.
+
+ thumbOrigin := 0.
+ thumbHeight := 100.
+ thumbFrameSizeDifference := 0.
+
+"/ inset := 1.
+
+"/ self computeThumbFrame
+!
+
+initStyle
+ "initialize style dep. stuff"
+
+ super initStyle.
+
+ DefaultViewBackground notNil ifTrue:[
+ viewBackground := DefaultViewBackground on:device.
+ ].
+ DefaultShadowColor notNil ifTrue:[
+ shadowColor := DefaultShadowColor on:device.
+ ].
+ DefaultLightColor notNil ifTrue:[
+ lightColor := DefaultLightColor on:device.
+ ].
+
+ tallyMarks := DefaultTallyMarks.
+ tallyLevel := DefaultTallyLevel.
+ DefaultLevel ~~ level ifTrue:[
+ self level:DefaultLevel.
+ ].
+ DefaultBorderWidth ~~ borderWidth ifTrue:[
+ self borderWidth:DefaultBorderWidth.
].
- "
- the ST-80 way of notifying scrolls
- "
- self sendChangeMessageWith:thumbOrigin.
- self changed:#scrollerPosition.
+ thumbLevel := DefaultThumbLevel.
+ inset := DefaultInset.
+ fixThumbHeight := DefaultFixThumbHeight.
+ thumbEdgeStyle := DefaultEdgeStyle.
+
+ DefaultGhostColor notNil ifTrue:[
+ ghostColor := DefaultGhostColor on:device.
+ ].
+ DefaultGhostFrameColor notNil ifTrue:[
+ ghostFrameColor := DefaultGhostFrameColor on:device.
+ ].
+ ghostLevel := DefaultGhostLevel.
+
+ DefaultThumbFrameColor notNil ifTrue:[
+ thumbFrameColor := DefaultThumbFrameColor on:device.
+ ].
+ DefaultThumbShadowColor notNil ifTrue:[
+ thumbShadowColor := DefaultThumbShadowColor
+ ] ifFalse:[
+ thumbShadowColor := shadowColor.
+ ].
+ DefaultThumbLightColor notNil ifTrue:[
+ thumbLightColor := DefaultThumbLightColor
+ ] ifFalse:[
+ thumbLightColor := lightColor.
+ ].
+
+ thumbEdgeStyle notNil ifTrue:[
+ DefaultThumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := DefaultThumbHalfShadowColor
+ ].
+ DefaultThumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := DefaultThumbHalfLightColor
+ ].
+ ].
+
+ device hasGreyscales ifFalse:[
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor := Color darkGrey.
+ thumbHalfLightColor := White
+ ].
+
+ thumbShadowColor := Black.
+"/ thumbLightColor := White.
+
+ StyleSheet name = #motif ifTrue:[
+ DefaultThumbColor isNil ifTrue:[
+ thumbColor := White .
+ ].
+ ]
+ ].
+
+ DefaultThumbColor notNil ifTrue:[
+ thumbColor := DefaultThumbColor on:device
+ ] ifFalse:[
+ thumbColor := White.
+ StyleSheet name ~= #normal ifTrue:[
+ device hasGreyscales ifFalse:[
+ thumbColor := Color grey
+ ].
+ ].
+ ].
+
+ thumbColor := thumbColor on:device.
+ thumbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ StyleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+!
+
+computeInitialExtent
+ ^ self
+!
+
+initCursor
+ "set the cursor - a hand"
+
+ cursor := Cursor hand
! !
!Scroller methodsFor:'event handling'!
@@ -1083,22 +1045,29 @@
]
!
-redraw
- "redraw"
+buttonRelease:button x:x y:y
+ "mouse-button was released - if scroll-mode is asynchronous, the scroll
+ action is now performed"
+
+ |rect|
- shown ifTrue:[
- thumbFrame isNil ifTrue:[self computeThumbFrame].
- self drawThumbBackgroundInX:0 y:0 width:width height:height.
- self drawThumb
- ]
-!
+ scrolling ifTrue:[
+ frameBeforeMove notNil ifTrue:[
+ rect := frameBeforeMove.
+ frameBeforeMove := nil.
+ self drawThumbBackgroundInX:rect left
+ y:rect top
+ width:rect width
+ height:rect height.
+ (rect intersects:thumbFrame) ifTrue:[
+ self drawThumb
+ ]
+ ].
-sizeChanged:how
- "size of scroller changed - recompute thumbs frame and redraw it"
-
- shown ifTrue:[
- self computeThumbFrame.
- self redraw
+ scrolling := false.
+ synchronousOperation ifFalse: [
+ self tellOthers.
+ ]
]
!
@@ -1132,40 +1101,13 @@
]
!
-buttonMultiPress:button x:x y:y
- ^ self buttonPress:button x:x y:y
-!
-
-buttonShiftPress:button x:x y:y
- "mouse-click with shift - jump to position"
-
- |pos curr limit org|
+sizeChanged:how
+ "size of scroller changed - recompute thumbs frame and redraw it"
- (moveDirection == #y) ifTrue:[
- curr := y.
- limit := height.
- org := thumbFrame top
- ] ifFalse:[
- curr := x.
- limit := width.
- org := thumbFrame left
- ].
-
- (curr < 0) ifTrue:[ "check against limits"
- pos := 0
- ] ifFalse:[
- (curr > limit) ifTrue:[
- pos := limit
- ] ifFalse:[
- pos := curr
- ]
- ].
-
- self thumbOrigin:(self percentFromAbs:pos).
- self tellOthers.
-
- pressOffset := curr - org.
- scrolling := true
+ shown ifTrue:[
+ self computeThumbFrame.
+ self redraw
+ ]
!
buttonMotion:button x:x y:y
@@ -1208,28 +1150,88 @@
]
!
-buttonRelease:button x:x y:y
- "mouse-button was released - if scroll-mode is asynchronous, the scroll
- action is now performed"
+redraw
+ "redraw"
+
+ shown ifTrue:[
+ thumbFrame isNil ifTrue:[self computeThumbFrame].
+ self drawThumbBackgroundInX:0 y:0 width:width height:height.
+ self drawThumb
+ ]
+!
+
+buttonShiftPress:button x:x y:y
+ "mouse-click with shift - jump to position"
+
+ |pos curr limit1 limit2 org|
- |rect|
+ (moveDirection == #y) ifTrue:[
+ curr := y.
+ limit1 := height.
+ limit2 := thumbFrame top
+ ] ifFalse:[
+ curr := x.
+ limit1 := width.
+ limit2 := thumbFrame left
+ ].
+
+ (curr < 0) ifTrue:[ "check against limits"
+ pos := 0
+ ] ifFalse:[
+ (curr > limit1) ifTrue:[
+ pos := limit1
+ ] ifFalse:[
+ pos := curr
+ ]
+ ].
+
+ frameBeforeMove := thumbFrame insetBy:1@1.
+
+ self thumbOrigin:(self percentFromAbs:pos).
+ self tellOthers.
- scrolling ifTrue:[
- frameBeforeMove notNil ifTrue:[
- rect := frameBeforeMove.
- frameBeforeMove := nil.
- self drawThumbBackgroundInX:rect left
- y:rect top
- width:rect width
- height:rect height.
- (rect intersects:thumbFrame) ifTrue:[
- self drawThumb
- ]
- ].
+ (moveDirection == #y) ifTrue:[
+ limit2 := thumbFrame top
+ ] ifFalse:[
+ limit2 := thumbFrame left
+ ].
+ pressOffset := curr - limit2.
+ scrolling := true
+!
+
+buttonMultiPress:button x:x y:y
+ ^ self buttonPress:button x:x y:y
+! !
+
+!Scroller methodsFor:'forwarding changed origin'!
- scrolling := false.
- synchronousOperation ifFalse: [
- self tellOthers.
- ]
- ]
+tellOthers
+ "
+ the ST/X way of notifying scrolls
+ "
+ scrollAction notNil ifTrue:[
+ scrollAction value:thumbOrigin
+ ].
+ "
+ the ST-80 way of notifying scrolls
+ "
+ self sendChangeMessageWith:thumbOrigin.
+ self changed:#scrollerPosition.
! !
+
+!Scroller methodsFor:'forced scroll'!
+
+pageUp
+ "page up/left"
+
+ self thumbOrigin:(thumbOrigin - thumbHeight).
+ self tellOthers
+!
+
+pageDown
+ "page down/right"
+
+ self thumbOrigin:(thumbOrigin + thumbHeight).
+ self tellOthers
+! !
+
--- a/SelListV.st Sat Mar 18 06:16:33 1995 +0100
+++ b/SelListV.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,35 +10,32 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:01:02 am'!
+
ListView subclass:#SelectionInListView
- instanceVariableNames:'selection actionBlock enabled
- hilightFgColor hilightBgColor
- halfIntensityFgColor
- doubleClickActionBlock
- selectConditionBlock
- listAttributes multipleSelectOk clickLine
- initialSelectionSymbol
- oneItem useIndex
- hilightLevel hilightFrameColor ignoreReselect
- arrowLevel smallArrow keyActionStyle toggleSelect
- strikeOut iSearchString'
+ instanceVariableNames:'selection actionBlock enabled hilightFgColor hilightBgColor
+ halfIntensityFgColor doubleClickActionBlock selectConditionBlock
+ listAttributes multipleSelectOk clickLine initialSelectionSymbol
+ oneItem useIndex hilightLevel hilightFrameColor ignoreReselect
+ arrowLevel smallArrow keyActionStyle toggleSelect strikeOut
+ iSearchString items'
classVariableNames:'RightArrowShadowForm RightArrowLightForm RightArrowForm
SmallRightArrowShadowForm SmallRightArrowLightForm
DefaultForegroundColor DefaultBackgroundColor
DefaultHilightForegroundColor DefaultHilightBackgroundColor
DefaultHilightFrameColor DefaultHilightLevel DefaultFont
DefaultRightArrowStyle DefaultRightArrowLevel
- DefaultDisabledForegroundColor
- DefaultShadowColor DefaultLightColor'
- poolDictionaries:''
- category:'Views-Text'
+ DefaultDisabledForegroundColor DefaultShadowColor
+ DefaultLightColor'
+ poolDictionaries:''
+ category:'Views-Text'
!
SelectionInListView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.24 1995-03-06 19:29:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.25 1995-03-18 05:16:09 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -59,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.24 1995-03-06 19:29:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.25 1995-03-18 05:16:09 claus Exp $
"
!
@@ -163,25 +160,74 @@
"
! !
+!SelectionInListView class methodsFor:'instance creation'!
+
+on:aModel printItems:print oneItem:one aspect:aspect change:change
+ list:list menu:menu initialSelection:initial useIndex:useIndex
+
+ "for ST-80 compatibility"
+
+ ^ (self new) on:aModel
+ printItems:print
+ oneItem:one
+ aspect:aspect
+ change:change
+ list:list
+ menu:menu
+ initialSelection:initial
+ useIndex:useIndex
+!
+
+on:aModel printItems:print oneItem:one aspect:aspect
+ change:change list:list menu:menu initialSelection:initial
+
+ "for ST-80 compatibility"
+
+ ^ self on:aModel
+ printItems:print
+ oneItem:one
+ aspect:aspect
+ change:change
+ list:list
+ menu:menu
+ initialSelection:initial
+ useIndex:false
+! !
+
!SelectionInListView class methodsFor:'defaults'!
-updateStyleCache
- DefaultDisabledForegroundColor := StyleSheet colorAt:'selectionDisabledForegroundColor'.
- DefaultHilightForegroundColor := StyleSheet colorAt:'selectionHilightForegroundColor'.
- DefaultHilightBackgroundColor := StyleSheet colorAt:'selectionHilightBackgroundColor'.
- DefaultHilightFrameColor := StyleSheet colorAt:'selectionHilightFrameColor'.
- DefaultHilightLevel := StyleSheet at:'selectionHilightLevel' default:0.
- DefaultRightArrowStyle := StyleSheet at:'selectionRightArrowStyle'.
- DefaultRightArrowLevel := StyleSheet at:'selectionRightArrowLevel'.
- DefaultForegroundColor := StyleSheet colorAt:'selectionForegroundColor'.
- DefaultBackgroundColor := StyleSheet colorAt:'selectionBackgroundColor'.
- DefaultShadowColor := StyleSheet colorAt:'selectionShadowColor'.
- DefaultLightColor := StyleSheet colorAt:'selectionLightColor'.
- DefaultFont := StyleSheet fontAt:'selectionFont'.
+rightArrowShadowFormOn:aDevice
+ "return the form used for the right arrow light pixels (3D only)"
+
+ |f|
- "
- self updateStyleCache
- "
+ ((aDevice == Display) and:[RightArrowShadowForm notNil]) ifTrue:[
+ ^ RightArrowShadowForm
+ ].
+ f := Form fromFile:'RightArrowShadow.xbm' resolution:100 on:aDevice.
+ f isNil ifTrue:[
+ f := Form width:16 height:16 fromArray:#[2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00010000
+ 2r00000000 2r00100000
+ 2r00000000 2r01000000
+ 2r00000000 2r10000000
+ 2r00000001 2r00000000
+ 2r00000010 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000]
+ on:aDevice
+ ].
+ (aDevice == Display) ifTrue:[
+ RightArrowShadowForm := f
+ ].
+ ^ f
!
rightArrowLightFormOn:aDevice
@@ -218,38 +264,23 @@
^ f
!
-rightArrowShadowFormOn:aDevice
- "return the form used for the right arrow light pixels (3D only)"
-
- |f|
+updateStyleCache
+ DefaultDisabledForegroundColor := StyleSheet colorAt:'selectionDisabledForegroundColor'.
+ DefaultHilightForegroundColor := StyleSheet colorAt:'selectionHilightForegroundColor'.
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'selectionHilightBackgroundColor'.
+ DefaultHilightFrameColor := StyleSheet colorAt:'selectionHilightFrameColor'.
+ DefaultHilightLevel := StyleSheet at:'selectionHilightLevel' default:0.
+ DefaultRightArrowStyle := StyleSheet at:'selectionRightArrowStyle'.
+ DefaultRightArrowLevel := StyleSheet at:'selectionRightArrowLevel'.
+ DefaultForegroundColor := StyleSheet colorAt:'selectionForegroundColor'.
+ DefaultBackgroundColor := StyleSheet colorAt:'selectionBackgroundColor'.
+ DefaultShadowColor := StyleSheet colorAt:'selectionShadowColor'.
+ DefaultLightColor := StyleSheet colorAt:'selectionLightColor'.
+ DefaultFont := StyleSheet fontAt:'selectionFont'.
- ((aDevice == Display) and:[RightArrowShadowForm notNil]) ifTrue:[
- ^ RightArrowShadowForm
- ].
- f := Form fromFile:'RightArrowShadow.xbm' resolution:100 on:aDevice.
- f isNil ifTrue:[
- f := Form width:16 height:16 fromArray:#[2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00010000
- 2r00000000 2r00100000
- 2r00000000 2r01000000
- 2r00000000 2r10000000
- 2r00000001 2r00000000
- 2r00000010 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000]
- on:aDevice
- ].
- (aDevice == Display) ifTrue:[
- RightArrowShadowForm := f
- ].
- ^ f
+ "
+ self updateStyleCache
+ "
!
rightArrowFormOn:aDevice
@@ -340,1020 +371,14 @@
^ f
! !
-!SelectionInListView class methodsFor:'instance creation'!
-
-on:aModel printItems:print oneItem:one aspect:aspect change:change
- list:list menu:menu initialSelection:initial useIndex:useIndex
-
- "for ST-80 compatibility"
-
- ^ (self new) on:aModel
- printItems:print
- oneItem:one
- aspect:aspect
- change:change
- list:list
- menu:menu
- initialSelection:initial
- useIndex:useIndex
-!
-
-on:aModel printItems:print oneItem:one aspect:aspect
- change:change list:list menu:menu initialSelection:initial
-
- "for ST-80 compatibility"
-
- ^ self on:aModel
- printItems:print
- oneItem:one
- aspect:aspect
- change:change
- list:list
- menu:menu
- initialSelection:initial
- useIndex:false
-! !
-
-!SelectionInListView methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- fontHeight := font height + lineSpacing.
- enabled := true.
- multipleSelectOk := false.
- ignoreReselect := true.
- toggleSelect := false.
- strikeOut := false.
- keyActionStyle := #select.
-!
-
-initStyle
- |nm|
-
- super initStyle.
-
- DefaultFont notNil ifTrue:[
- font := DefaultFont on:device
- ].
-
- bgColor := viewBackground.
- hilightFrameColor := nil.
- hilightLevel := 0.
- arrowLevel := 1.
- smallArrow := false.
-
- device hasGreyscales ifTrue:[
- "
- must get rid of these hard codings
- "
- nm := StyleSheet name asSymbol.
- (nm == #next) ifTrue:[
- hilightFgColor := fgColor.
- hilightBgColor := White.
- hilightFrameColor := fgColor
- ] ifFalse:[
- (nm == #motif) ifTrue:[
- fgColor := White.
- bgColor := Grey.
- viewBackground := bgColor.
- hilightFgColor := bgColor "fgColor" "White".
- hilightBgColor := fgColor "bgColor lightened" "darkened".
- ] ifFalse:[
- (nm == #openwin) ifTrue:[
- hilightFgColor := fgColor.
- hilightBgColor := Color grey.
- smallArrow := true.
- ]
- ]
- ]
- ].
-
- hilightFgColor isNil ifTrue:[
- hilightFgColor := bgColor.
- ].
- hilightBgColor isNil ifTrue:[
- hilightBgColor := fgColor.
- ].
- DefaultForegroundColor notNil ifTrue:[
- fgColor := DefaultForegroundColor
- ].
- DefaultBackgroundColor notNil ifTrue:[
- bgColor := viewBackground := DefaultBackgroundColor
- ].
- DefaultHilightForegroundColor notNil ifTrue:[
- hilightFgColor := DefaultHilightForegroundColor
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- hilightBgColor := DefaultHilightBackgroundColor
- ].
- DefaultHilightFrameColor notNil ifTrue:[
- hilightFrameColor := DefaultHilightFrameColor
- ].
- DefaultHilightLevel notNil ifTrue:[
- hilightLevel := DefaultHilightLevel
- ].
- DefaultRightArrowLevel notNil ifTrue:[
- arrowLevel := DefaultRightArrowLevel
- ].
-
- DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor on:device
- ].
- DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor on:device
- ].
-
- (hilightLevel abs > 0) ifTrue:[
- lineSpacing := 3
- ] ifFalse:[
- lineSpacing := 2
- ].
-
- hilightFgColor isNil ifTrue:[
- hilightFgColor := bgColor.
- hilightBgColor := fgColor
- ].
-
- DefaultDisabledForegroundColor notNil ifTrue:[
- halfIntensityFgColor := DefaultDisabledForegroundColor
- ] ifFalse:[
- halfIntensityFgColor := Color darkGrey.
- ].
-
- fgColor := fgColor on:device.
- bgColor := bgColor on:device.
- halfIntensityFgColor := halfIntensityFgColor on:device.
- hilightFrameColor notNil ifTrue:[hilightFrameColor := hilightFrameColor on:device].
- hilightFgColor := hilightFgColor on:device.
- hilightBgColor := hilightBgColor on:device.
-!
-
-initCursor
- "set the cursor - a hand"
-
- cursor := Cursor hand
-!
-
-realize
- super realize.
- selection notNil ifTrue:[
- self makeLineVisible:selection
- ]
-! !
-
-!SelectionInListView methodsFor:'accessing'!
-
-keyActionStyle:aSymbol
- "defines how the view should respond to alpha-keys pressed.
- Possible values are:
- #select -> will select next entry starting with that
- character and perform the click-action
-
- #selectAndDoubleclick -> will select next & perform double-click action
-
- #pass -> will pass key to superclass (i.e. no special treatment)
-
- nil -> will ignore key
-
- the default (set in #initialize) is #select
- "
-
- keyActionStyle := aSymbol
-!
-
-contents:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- selection := nil.
- listAttributes := nil.
- super contents:aCollection.
-!
-
-setList:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- selection := nil.
- listAttributes := nil.
- super setList:aCollection.
-!
-
-list:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- "somewhat of a kludge: if selection is first line,
- we have to remove the highlight frame by hand here"
-
- (shown and:[hilightLevel ~~ 0]) ifTrue:[
- selection == firstLineShown ifTrue:[
- self paint:bgColor.
- self fillRectangleX:margin y:margin
- width:(width - (margin * 2))
- height:(hilightLevel abs).
- ].
- ].
-
- selection := nil.
- listAttributes := nil.
- super list:aCollection.
-!
-
-setAttributes:aList
- "set the attribute list.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- listAttributes := aList
-!
-
-attributeAt:index
- "return the line attribute of list line index.
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- listAttributes isNil ifFalse:[
- (index > listAttributes size) ifFalse:[
- ^ listAttributes at:index
- ]
- ].
- ^ nil
-!
-
-attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
- "set a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- (index > list size) ifFalse:[
- listAttributes isNil ifTrue:[
- listAttributes := (OrderedCollection new:index) grow:index
- ] ifFalse:[
- (index > listAttributes size) ifTrue:[
- listAttributes grow:index
- ]
- ].
- aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
- listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
- self redrawLine:index
- ]
- ]
-!
-
-attributeAt:index add:aSymbolOrCollectionOfSymbols
- "add to a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[
- current := Set new.
- ] ifFalse:[
- current isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
- current := Set with:current
- ]
- ].
-
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current add:aSymbolOrCollectionOfSymbols
- ] ifFalse:[
- (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
- current addAll:aSymbolOrCollectionOfSymbols
- ].
- self attributeAt:index put:current
-!
-
-attributeAt:index remove:aSymbolOrCollectionOfSymbols
- "remove a line attribute;
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[^ self].
- current isSymbol ifTrue:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
- ] ifFalse:[
- (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
- current := nil
- ]
- ]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
- ]
- ].
- self attributeAt:index put:current
-!
-
-line:lineNr hasAttribute:aSymbol
- "return true, if line nr has attribute, aSymbol;
- currently supported attributes are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |attr|
-
- (lineNr > listAttributes size) ifTrue:[^ false].
- attr := listAttributes at:lineNr.
- attr isNil ifTrue:[^ false].
- attr isSymbol ifTrue:[^ attr == aSymbol].
- ^ (attr includes:aSymbol)
-!
-
-removeIndexWithoutRedraw:lineNr
- "delete line - no redraw;
- return true, if something was really deleted.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndexWithoutRedraw:lineNr
-!
-
-removeIndex:lineNr
- "delete line - with redraw.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndex:lineNr
-!
-
-action:aBlock
- "set the action block to be performed on select"
-
- actionBlock := aBlock
-!
-
-doubleClickAction:aBlock
- "set the double click action block to be performed on select"
-
- doubleClickActionBlock := aBlock
-!
-
-on:aModel printItems:print oneItem:one aspect:aspect change:change
- list:list menu:menu initialSelection:initial useIndex:use
-
- "ST-80 compatibility"
-
- aspectSymbol := aspect.
- changeSymbol := change.
- listSymbol := list.
- menuSymbol := menu.
- initialSelectionSymbol := initial.
- printItems := print.
- oneItem := one.
- useIndex := use.
- model := aModel.
-
- listSymbol notNil ifTrue:[
- self list:(aModel perform:listSymbol) asStringCollection
- ].
- model addDependent:self
-! !
-
-!SelectionInListView methodsFor:'selections'!
-
-toggleSelect:aBoolean
- "turn on/off toggle select"
-
- toggleSelect := aBoolean.
-!
-
-strikeOut:aBoolean
- "turn on/off strikeOut mode"
-
- strikeOut := aBoolean.
-!
-
-multipleSelectOk:aBoolean
- "allow/disallow multiple selections"
-
- multipleSelectOk := aBoolean.
- aBoolean ifTrue:[
- self enableButtonMotionEvents
- ] ifFalse:[
- self disableButtonMotionEvents
- ]
-!
-
-ignoreReselect:aBoolean
- "set/clear the ignoreReselect flag -
- if set, a click on an already selected entry is ignored.
- Otherwise the notification is done, even if no
- change in the selection occurs.
- (for example, in browser to update a method)"
-
- ignoreReselect := aBoolean
-!
-
-enable
- "enable selections"
-
- enabled := true
-!
-
-disable
- "disable selections"
-
- enabled := false
-!
-
-selectConditionBlock:aBlock
- "set the conditionBlock; this block is evaluated before a selection
- change is performed; the change will not be done, if the evaluation
- returns false. For example, this allows confirmation queries in
- the SystemBrowser"
-
- selectConditionBlock := aBlock
-!
-
-numberOfSelections
- "return the number of selected entries"
-
- |sz|
-
- selection isNil ifTrue:[^ 0].
- sz := selection size.
- sz > 0 ifTrue:[^ sz].
- ^ 1
-!
-
-isInSelection:aNumber
- "return true, if line, aNumber is in the selection"
-
- selection isNil ifTrue:[^ false].
- selection isCollection ifTrue:[
- ^ (selection includes:aNumber)
- ].
- ^ (aNumber == selection)
-!
-
-valueIsInSelection:someString
- "return true, if someString is in the selection"
-
- |sel|
-
- selection isNil ifTrue:[^ false].
- sel := self selectionValue.
- self numberOfSelections > 1 ifTrue:[
- ^ (sel includes:someString)
- ].
- ^ (someString = sel)
-!
-
-hasSelection
- "return true, if the view has a selection"
-
- ^ selection notNil
-!
-
-selectionValue
- "return the selection value i.e. the text in the selected line.
- For multiple selections a collection containing the entries is returned."
-
- selection isNil ifTrue:[^ nil].
- selection isCollection ifTrue:[
- ^ selection collect:[:nr | list at:nr]
- ].
- ^ list at:selection
-!
-
-selection
- "return the selection line nr or collection of line numbers"
-
- ^ selection
-!
-
-deselect
- "deselect"
-
- self selection:nil
-!
-
-deselectWithoutRedraw
- "deselect - no redraw"
-
- selection := nil
-!
-
-selectElementWithoutScroll:anObject
- "select the element with same printString as the argument, anObject.
- Do not scroll."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
- ]
-!
-
-selectElement:anObject
- "select the element with same printString as the argument, anObject.
- Scroll to make the new selection visible."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selection:lineNo]
- ]
-!
-
-selectWithoutScroll:aNumberOrNil
- "select line, aNumber or deselect if argument is nil"
-
- |prevSelection newSelection|
-
- newSelection := aNumberOrNil.
- newSelection notNil ifTrue:[
- (self isValidSelection:newSelection) ifFalse:[
- newSelection := nil
- ]
- ].
-
- (newSelection == selection) ifTrue: [^ self].
-
- selection notNil ifTrue: [
- prevSelection := selection.
- selection := nil.
- prevSelection isCollection ifTrue:[
- prevSelection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:prevSelection
- ]
- ].
- selection := newSelection.
- selection notNil ifTrue:[
- self redrawElement:selection
- ]
-!
-
-selection:aNumberOrNil
- "select line, aNumber or deselect if argument is nil;
- scroll to make the selected line visible"
-
- self selectWithoutScroll:aNumberOrNil.
- selection notNil ifTrue:[
-"/ shown ifTrue:[
- self makeLineVisible:selection
-"/ ]
- ]
-!
-
-selectAll
- "select all entries."
-
- selection := OrderedCollection withAll:(1 to:list size).
- shown ifTrue:[self redraw]
-!
-
-addElementToSelection:anObject
- "add the element with the same printstring as the argument, anObject
- to the selection. The entry is searched by comparing printStrings.
- No scrolling is done. Returns true, if ok, false if no such entry
- was found."
-
- |lineNo str|
-
- str := anObject printString.
- lineNo := list findFirst:[:entry | str = entry printString].
- lineNo ~~ 0 ifTrue:[
- self addToSelection:lineNo.
- ^ true
- ].
- ^ false
-!
-
-addToSelection:aNumber
- "add entry, aNumber to the selection. No scrolling is done."
-
- (self isValidSelection:aNumber) ifFalse:[^ self].
-
- selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifTrue:[^ self].
- selection add:aNumber
- ] ifFalse:[
- (aNumber == selection) ifTrue:[^ self].
- selection := OrderedCollection with:selection with:aNumber
- ].
- self redrawElement:aNumber
-!
-
-removeFromSelection:aNumber
- "remove entry, aNumber from the selection."
-
- selection isNil ifTrue:[^ self].
-
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifFalse:[^ self].
- selection remove:aNumber.
- selection size == 1 ifTrue:[
- selection := selection first
- ] ifFalse:[
- selection size == 0 ifTrue:[
- selection := nil
- ]
- ]
- ] ifFalse:[
- (aNumber == selection) ifFalse:[^ self].
- selection := nil
- ].
- self redrawElement:aNumber
-!
-
-toggleSelection:aNumber
- "toggle selection-state of entry, aNumber"
-
- (self isInSelection:aNumber) ifTrue:[
- self removeFromSelection:aNumber
- ] ifFalse:[
- self addToSelection:aNumber
- ]
-!
-
-nextAfterSelection
- "return the number of the next selectable entry after the selection.
- Wrap at end."
-
- |next|
-
- selection isNil ifTrue:[
- next := firstLineShown
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- next := selection max + 1
- ] ifFalse:[
- next := selection + 1
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next > list size ifTrue:[
- next := 1.
- ] ifFalse:[
- [next <= list size
- and:[(self isValidSelection:next) not]] whileTrue:[
- next := next + 1
- ].
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next := nil
- ].
- ^ next
-!
-
-previousBeforeSelection
- "return the number of the previous selectable entry before the selection.
- Wrap at beginning."
-
- |prev|
-
- selection isNil ifTrue:[
- prev := firstLineShown - 1
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- prev := selection min - 1
- ] ifFalse:[
- prev := selection - 1
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev < 1 ifTrue:[
- prev := list size.
- ] ifFalse:[
- [prev >= 1
- and:[(self isValidSelection:prev) not]] whileTrue:[
- prev := prev - 1
- ].
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev := nil
- ].
- ^ prev
-!
-
-selectNext
- "select next line or first visible if there is currrently no selection.
- Wrap at end."
-
- self selection:(self nextAfterSelection)
-!
-
-selectPrevious
- "select previous line or previous visible if there is currently no selection.
- Wrap at beginning."
-
- self selection:(self previouseBeforeSelection).
-!
-
-selectionDo:aBlock
- "perform aBlock for each nr in the selection.
- For single selection, it is called once for the items nr.
- For multiple selections, it is called for each."
-
- |sz|
-
- selection isNil ifTrue:[^ self].
- sz := selection size.
- sz > 0 ifTrue:[
- selection do:aBlock
- ] ifFalse:[
- aBlock value:selection
- ].
-! !
-
-!SelectionInListView methodsFor:'private'!
-
-checkRemovingSelection:lineNr
- "when a line is removed, we have to adjust selection"
-
- |newSelection|
-
- selection notNil ifTrue:[
- (selection size > 0) ifTrue:[
- newSelection := OrderedCollection new.
- selection do:[:sel |
- sel < lineNr ifTrue:[
- newSelection add:sel
- ] ifFalse:[
- sel > lineNr ifTrue:[
- newSelection add:(sel - 1)
- ]
- "otherwise remove it from the selection"
- ]
- ].
- newSelection size == 1 ifTrue:[
- selection := newSelection first
- ] ifFalse:[
- newSelection size == 0 ifTrue:[
- selection := nil
- ] ifFalse:[
- selection := newSelection
- ]
- ]
- ] ifFalse:[
- selection == lineNr ifTrue:[
- selection := nil
- ] ifFalse:[
- selection > lineNr ifTrue:[
- selection := selection - 1
- ]
- ]
- ]
- ]
-!
-
-isValidSelection:aNumber
- "return true, if aNumber is ok for a selection lineNo"
-
- aNumber isNil ifTrue:[^ false].
- ^ (aNumber between:1 and:list size)
-!
-
-positionToSelectionX:x y:y
- "given a click position, return the selection lineNo"
-
- |visibleLine|
-
- (x between:0 and:width) ifTrue:[
- (y between:0 and:height) ifTrue:[
- visibleLine := self visibleLineOfY:y.
- ^ self visibleLineToListLine:visibleLine
- ]
- ].
- ^ nil
-!
-
-widthForScrollBetween:start and:end
- "has to be redefined since WHOLE line is inverted/modified sometimes"
-
- | anySelectionInRange |
-
- selection notNil ifTrue:[
- selection isCollection ifTrue:[
- anySelectionInRange := false.
- selection do:[:s |
- (s between:start and:end) ifTrue:[
- anySelectionInRange := true
- ]
- ]
- ] ifFalse:[
- anySelectionInRange := selection between:start and:end
- ]
- ] ifFalse:[
- anySelectionInRange := false
- ].
-
- anySelectionInRange ifTrue:[
- ^ width
-"
- self is3D ifFalse:[
- ^ width
- ].
- ( #(next openwin) includes:style) ifTrue:[
- ^ width
- ].
- viewBackground = background ifFalse:[
- ^ width
- ]
-"
- ].
- ^ super widthForScrollBetween:start and:end
-!
-
-visibleLineNeedsSpecialCare:visLineNr
- |listLine|
-
- listLine := self visibleLineToListLine:visLineNr.
- listLine isNil ifTrue:[^ false].
- (self isInSelection:listLine) ifTrue:[^ true].
- listAttributes notNil ifTrue:[
- (listLine <= listAttributes size) ifTrue:[
- ^ (listAttributes at:listLine) notNil
- ]
- ].
- ^ false
-!
-
-scrollSelectDown
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollDown.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-scrollSelectUp
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollUp.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-! !
-
!SelectionInListView methodsFor:'redrawing'!
-drawRightArrowInVisibleLine:visLineNr
- "draw a right arrow (for submenus).
- This method is not used here, but provided for subclasses such
- as menus or file-lists."
-
- |y x form form2 topLeftColor botRightColor t|
-
- x := width - 16.
- y := (self yOfVisibleLine:visLineNr).
-
- device depth == 1 ifTrue:[
- form := self class rightArrowFormOn:device.
- y := y + ((font height - form height) // 2).
- self foreground:Black.
- self displayForm:form x:x y:y.
- ] ifFalse:[
- smallArrow ifTrue:[
- form := self class smallRightArrowLightFormOn:device.
- form2 := self class smallRightArrowShadowFormOn:device.
- ] ifFalse:[
- form := self class rightArrowLightFormOn:device.
- form2 := self class rightArrowShadowFormOn:device.
- ].
- y := y + ((font height - form height) // 2).
-
- topLeftColor := lightColor.
- botRightColor := shadowColor.
-
- "openwin arrow stays down"
- style ~~ #openwin ifTrue:[
- (self isInSelection:(self visibleLineToListLine:visLineNr)) ifTrue:[
- t := topLeftColor.
- topLeftColor := botRightColor.
- botRightColor := t.
- ]
- ].
- arrowLevel < 0 ifTrue:[
- t := topLeftColor.
- topLeftColor := botRightColor.
- botRightColor := t.
- ].
-
-"/ self foreground:topLeftColor.
-self paint:topLeftColor.
- self displayForm:form x:x y:y.
-"/ self foreground:botRightColor.
-self paint:botRightColor.
- self displayForm:form2 x:x y:y.
- ]
-!
-
redrawElement:aNumber
"redraw an individual element"
^ self redrawLine:aNumber
!
-redrawVisibleLine:visLineNr col:colNr
- "redraw a single character.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr col:colNr
-!
-
-redrawVisibleLine:visLineNr from:startCol
- "redraw from a col to the right end.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr from:startCol
-!
-
-redrawVisibleLine:visLineNr from:startCol to:endCol
- "redraw from a startCol to endCol.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr from:startCol to:endCol
-!
-
-redrawFromVisibleLine:startVisLineNr to:endVisLineNr
- "redraw a range of lines.
- Must check, if any is in the selection and handle this case.
- Otherwise draw it en-bloque using supers method."
-
- |special sel
- selNo "{ Class: SmallInteger }" |
-
- ((selection isCollection) or:[listAttributes notNil]) ifTrue:[
- startVisLineNr to:endVisLineNr do:[:visLine |
- self redrawVisibleLine:visLine
- ].
- ^ self
- ].
-
-"XXX only if -1/+1"
-"/ hilightLevel ~~ 0 ifTrue:[
-"/ self paint:bgColor.
-"/ self fillRectangleX:0 y:(self yOfVisibleLine:startVisLineNr)-1 width:width height:1
-"/ ].
- special := true.
- selection isNil ifTrue:[
- special := false
- ] ifFalse:[
- sel := self listLineToVisibleLine:selection.
- sel isNil ifTrue:[
- special := false
- ] ifFalse:[
- special := (sel between:startVisLineNr and:endVisLineNr)
- ]
- ].
- special ifFalse:[
- ^ super redrawFromVisibleLine:startVisLineNr
- to:endVisLineNr
- ].
-
- selNo := sel.
- selNo > startVisLineNr ifTrue:[
- super redrawFromVisibleLine:startVisLineNr to:(selNo - 1)
- ].
- self redrawVisibleLine:selNo.
- selNo < endVisLineNr ifTrue:[
- super redrawFromVisibleLine:(selNo + 1) to:endVisLineNr
- ]
-!
-
redrawVisibleLine:visLineNr
"redraw a single line.
Must check, if any is in the selection and handle this case.
@@ -1466,17 +491,1133 @@
]
].
^ super drawVisibleLine:visLineNr with:fg and:bg
+!
+
+redrawFromVisibleLine:startVisLineNr to:endVisLineNr
+ "redraw a range of lines.
+ Must check, if any is in the selection and handle this case.
+ Otherwise draw it en-bloque using supers method."
+
+ |special sel
+ selNo "{ Class: SmallInteger }" |
+
+ ((selection isCollection) or:[listAttributes notNil]) ifTrue:[
+ startVisLineNr to:endVisLineNr do:[:visLine |
+ self redrawVisibleLine:visLine
+ ].
+ ^ self
+ ].
+
+"XXX only if -1/+1"
+"/ hilightLevel ~~ 0 ifTrue:[
+"/ self paint:bgColor.
+"/ self fillRectangleX:0 y:(self yOfVisibleLine:startVisLineNr)-1 width:width height:1
+"/ ].
+ special := true.
+ selection isNil ifTrue:[
+ special := false
+ ] ifFalse:[
+ sel := self listLineToVisibleLine:selection.
+ sel isNil ifTrue:[
+ special := false
+ ] ifFalse:[
+ special := (sel between:startVisLineNr and:endVisLineNr)
+ ]
+ ].
+ special ifFalse:[
+ ^ super redrawFromVisibleLine:startVisLineNr
+ to:endVisLineNr
+ ].
+
+ selNo := sel.
+ selNo > startVisLineNr ifTrue:[
+ super redrawFromVisibleLine:startVisLineNr to:(selNo - 1)
+ ].
+ self redrawVisibleLine:selNo.
+ selNo < endVisLineNr ifTrue:[
+ super redrawFromVisibleLine:(selNo + 1) to:endVisLineNr
+ ]
+!
+
+drawRightArrowInVisibleLine:visLineNr
+ "draw a right arrow (for submenus).
+ This method is not used here, but provided for subclasses such
+ as menus or file-lists."
+
+ |y x form form2 topLeftColor botRightColor t|
+
+ x := width - 16.
+ y := (self yOfVisibleLine:visLineNr).
+
+ device depth == 1 ifTrue:[
+ form := self class rightArrowFormOn:device.
+ y := y + ((font height - form height) // 2).
+ self foreground:Black.
+ self displayForm:form x:x y:y.
+ ] ifFalse:[
+ smallArrow ifTrue:[
+ form := self class smallRightArrowLightFormOn:device.
+ form2 := self class smallRightArrowShadowFormOn:device.
+ ] ifFalse:[
+ form := self class rightArrowLightFormOn:device.
+ form2 := self class rightArrowShadowFormOn:device.
+ ].
+ y := y + ((font height - form height) // 2).
+
+ topLeftColor := lightColor.
+ botRightColor := shadowColor.
+
+ "openwin arrow stays down"
+ style ~~ #openwin ifTrue:[
+ (self isInSelection:(self visibleLineToListLine:visLineNr)) ifTrue:[
+ t := topLeftColor.
+ topLeftColor := botRightColor.
+ botRightColor := t.
+ ]
+ ].
+ arrowLevel < 0 ifTrue:[
+ t := topLeftColor.
+ topLeftColor := botRightColor.
+ botRightColor := t.
+ ].
+
+"/ self foreground:topLeftColor.
+self paint:topLeftColor.
+ self displayForm:form x:x y:y.
+"/ self foreground:botRightColor.
+self paint:botRightColor.
+ self displayForm:form2 x:x y:y.
+ ]
+!
+
+redrawVisibleLine:visLineNr col:colNr
+ "redraw a single character.
+ Must check, if its in the selection and handle this case."
+
+ (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
+ ^ self redrawVisibleLine:visLineNr
+ ].
+ super redrawVisibleLine:visLineNr col:colNr
+!
+
+redrawVisibleLine:visLineNr from:startCol to:endCol
+ "redraw from a startCol to endCol.
+ Must check, if its in the selection and handle this case."
+
+ (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
+ ^ self redrawVisibleLine:visLineNr
+ ].
+ super redrawVisibleLine:visLineNr from:startCol to:endCol
+!
+
+redrawVisibleLine:visLineNr from:startCol
+ "redraw from a col to the right end.
+ Must check, if its in the selection and handle this case."
+
+ (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
+ ^ self redrawVisibleLine:visLineNr
+ ].
+ super redrawVisibleLine:visLineNr from:startCol
+! !
+
+!SelectionInListView methodsFor:'selections'!
+
+selectWithoutScroll:aNumberOrNil
+ "select line, aNumber or deselect if argument is nil"
+
+ |prevSelection newSelection|
+
+ newSelection := aNumberOrNil.
+ newSelection notNil ifTrue:[
+ (self isValidSelection:newSelection) ifFalse:[
+ newSelection := nil
+ ]
+ ].
+
+ (newSelection == selection) ifTrue: [^ self].
+
+ selection notNil ifTrue: [
+ prevSelection := selection.
+ selection := nil.
+ (prevSelection isCollection) ifTrue:[
+ prevSelection do:[:line |
+ self redrawElement:line
+ ]
+ ] ifFalse:[
+ self redrawElement:prevSelection
+ ]
+ ].
+ selection := newSelection.
+ (selection isCollection) ifTrue:[
+ selection do:[:line |
+ self redrawElement:line
+ ]
+ ] ifFalse:[
+ self redrawElement:selection
+ ]
+
+!
+
+selection:aNumberOrNil
+ "select line, aNumber or deselect if argument is nil;
+ scroll to make the selected line visible"
+
+ self selectWithoutScroll:aNumberOrNil.
+ selection notNil ifTrue:[
+"/ shown ifTrue:[
+ (selection isCollection) ifTrue:[
+ self makeLineVisible:selection first.
+ ] ifFalse:[
+ self makeLineVisible:selection
+ ].
+"/ ]
+ ]
+
+!
+
+isInSelection:aNumber
+ "return true, if line, aNumber is in the selection"
+
+ selection isNil ifTrue:[^ false].
+ selection isCollection ifTrue:[
+ ^ (selection includes:aNumber)
+ ].
+ ^ (aNumber == selection)
+!
+
+toggleSelect:aBoolean
+ "turn on/off toggle select"
+
+ toggleSelect := aBoolean.
+!
+
+multipleSelectOk:aBoolean
+ "allow/disallow multiple selections"
+
+ multipleSelectOk := aBoolean.
+ aBoolean ifTrue:[
+ self enableButtonMotionEvents
+ ] ifFalse:[
+ self disableButtonMotionEvents
+ ]
+!
+
+selectConditionBlock:aBlock
+ "set the conditionBlock; this block is evaluated before a selection
+ change is performed; the change will not be done, if the evaluation
+ returns false. For example, this allows confirmation queries in
+ the SystemBrowser"
+
+ selectConditionBlock := aBlock
+!
+
+strikeOut:aBoolean
+ "turn on/off strikeOut mode"
+
+ strikeOut := aBoolean.
+!
+
+selection
+ "return the selection line nr or collection of line numbers"
+
+ ^ selection
+!
+
+ignoreReselect:aBoolean
+ "set/clear the ignoreReselect flag -
+ if set, a click on an already selected entry is ignored.
+ Otherwise the notification is done, even if no
+ change in the selection occurs.
+ (for example, in browser to update a method)"
+
+ ignoreReselect := aBoolean
+!
+
+enable
+ "enable selections"
+
+ enabled := true
+!
+
+disable
+ "disable selections"
+
+ enabled := false
+!
+
+selectionValue
+ "return the selection value i.e. the text in the selected line.
+ For multiple selections a collection containing the entries is returned."
+
+ selection isNil ifTrue:[^ nil].
+ (selection isCollection) ifTrue:[
+ ^ selection collect:[:nr | self at:nr]
+ ].
+ ^ self at:selection
+
+!
+
+numberOfSelections
+ "return the number of selected entries"
+
+ |sz|
+
+ selection isNil ifTrue:[^ 0].
+ sz := selection size.
+ sz > 0 ifTrue:[^ sz].
+ ^ 1
+!
+
+hasSelection
+ "return true, if the view has a selection"
+
+ ^ selection notNil
+!
+
+deselectWithoutRedraw
+ "deselect - no redraw"
+
+ selection := nil
+!
+
+deselect
+ "deselect"
+
+ self selection:nil
+!
+
+selectElement:anObject
+ "select the element with same printString as the argument, anObject.
+ Scroll to make the new selection visible."
+
+ |lineNo|
+
+ list notNil ifTrue:[
+ lineNo := list indexOf:(anObject printString) ifAbsent:[].
+ lineNo notNil ifTrue:[self selection:lineNo]
+ ]
+!
+
+valueIsInSelection:someString
+ "return true, if someString is in the selection"
+
+ |sel|
+
+ selection isNil ifTrue:[^ false].
+ sel := self selectionValue.
+ self numberOfSelections > 1 ifTrue:[
+ ^ (sel includes:someString)
+ ].
+ ^ (someString = sel)
+!
+
+selectElementWithoutScroll:anObject
+ "select the element with same printString as the argument, anObject.
+ Do not scroll."
+
+ |lineNo|
+
+ list notNil ifTrue:[
+ lineNo := list indexOf:(anObject printString) ifAbsent:[].
+ lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
+ ]
+!
+
+selectAll
+ "select all entries."
+
+ selection := OrderedCollection withAll:(1 to:self size).
+ shown ifTrue:[self redraw].
+ self selectionChanged.
+
+!
+
+addElementToSelection:anObject
+ "add the element with the same printstring as the argument, anObject
+ to the selection. The entry is searched by comparing printStrings.
+ No scrolling is done. Returns true, if ok, false if no such entry
+ was found."
+
+ |lineNo str|
+
+ str := anObject printString.
+ lineNo := list findFirst:[:entry | str = entry printString].
+ lineNo ~~ 0 ifTrue:[
+ self addToSelection:lineNo.
+ ^ true
+ ].
+ ^ false
+!
+
+addToSelection:aNumber
+ "add entry, aNumber to the selection. No scrolling is done."
+
+ (self isValidSelection:aNumber) ifFalse:[^ self].
+
+ selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
+ selection isCollection ifTrue:[
+ (selection includes:aNumber) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection add:aNumber
+ ] ifFalse:[
+ (aNumber == selection) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection := OrderedCollection with:selection with:aNumber
+ ].
+ self redrawElement:aNumber
+!
+
+removeFromSelection:aNumber
+ "remove entry, aNumber from the selection."
+
+ selection isNil ifTrue:[^ self].
+
+ selection isCollection ifTrue:[
+ (selection includes:aNumber) ifFalse:[^ self].
+ selection remove:aNumber.
+ selection size == 1 ifTrue:[
+ selection := selection first
+ ] ifFalse:[
+ selection size == 0 ifTrue:[
+ selection := nil
+ ]
+ ]
+ ] ifFalse:[
+ (aNumber == selection) ifFalse:[^ self].
+ selection := nil
+ ].
+ self redrawElement:aNumber
+!
+
+nextAfterSelection
+ "return the number of the next selectable entry after the selection.
+ Wrap at end."
+
+ |next|
+
+ selection isNil ifTrue:[
+ next := firstLineShown
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ next := selection max + 1
+ ] ifFalse:[
+ next := selection + 1
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next > self size ifTrue:[
+ next := 1.
+ ] ifFalse:[
+ [next <= self size
+ and:[(self isValidSelection:next) not]] whileTrue:[
+ next := next + 1
+ ].
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next := nil
+ ].
+ ^ next
+
+
+!
+
+previousBeforeSelection
+ "return the number of the previous selectable entry before the selection.
+ Wrap at beginning."
+
+ |prev|
+
+ selection isNil ifTrue:[
+ prev := firstLineShown - 1
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ prev := selection min - 1
+ ] ifFalse:[
+ prev := selection - 1
+ ].
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev < 1 ifTrue:[
+ prev := self size.
+ ] ifFalse:[
+ [prev >= 1
+ and:[(self isValidSelection:prev) not]] whileTrue:[
+ prev := prev - 1
+ ].
+ ].
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev := nil
+ ].
+ ^ prev
+
+!
+
+toggleSelection:aNumber
+ "toggle selection-state of entry, aNumber"
+
+ (self isInSelection:aNumber) ifTrue:[
+ self removeFromSelection:aNumber
+ ] ifFalse:[
+ self addToSelection:aNumber
+ ]
+!
+
+selectNext
+ "select next line or first visible if there is currrently no selection.
+ Wrap at end."
+
+ self selection:(self nextAfterSelection)
+!
+
+selectPrevious
+ "select previous line or previous visible if there is currently no selection.
+ Wrap at beginning."
+
+ self selection:(self previouseBeforeSelection).
+!
+
+selectionDo:aBlock
+ "perform aBlock for each nr in the selection.
+ For single selection, it is called once for the items nr.
+ For multiple selections, it is called for each."
+
+ |sz|
+
+ selection isNil ifTrue:[^ self].
+ sz := selection size.
+ sz > 0 ifTrue:[
+ selection do:aBlock
+ ] ifFalse:[
+ aBlock value:selection
+ ].
+!
+
+selectionChanged
+ "selection has changed. Call actionblock if defined"
+
+ |arg|
+
+ useIndex == false ifTrue:[
+ printItems ifFalse:[
+ arg := self selectionValue
+ ] ifTrue:[
+ arg := items at:selection
+ ]
+ ] ifFalse:[
+ "true or nil - strange"
+ arg := selection
+ ].
+ "
+ the ST/X way of doing things - perform actionBlock
+ "
+ actionBlock notNil ifTrue:[actionBlock value:arg].
+ "
+ the ST-80 way of doing things - notify model via changeSymbol
+ "
+ self sendChangeMessageWith:arg
+!
+
+selectionAsCollection
+ "return the selection as a collection of line numbers"
+
+ selection size = 0 ifTrue:[
+ selection isNil ifTrue:[^ #()].
+ ^ (OrderedCollection new) add:selection; yourself.
+ ] ifFalse:[
+ ^ selection
+ ].
+! !
+
+!SelectionInListView methodsFor:'accessing'!
+
+line:lineNr hasAttribute:aSymbol
+ "return true, if line nr has attribute, aSymbol;
+ currently supported attributes are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |attr|
+
+ (lineNr > listAttributes size) ifTrue:[^ false].
+ attr := listAttributes at:lineNr.
+ attr isNil ifTrue:[^ false].
+ attr isSymbol ifTrue:[^ attr == aSymbol].
+ ^ (attr includes:aSymbol)
+!
+
+contents:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes."
+
+ selection := nil.
+ listAttributes := nil.
+ super contents:aCollection.
+!
+
+attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
+ "set a lines attribute(s);
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ (index > self size) ifFalse:[
+ listAttributes isNil ifTrue:[
+ listAttributes := (OrderedCollection new:index) grow:index
+ ] ifFalse:[
+ (index > listAttributes size) ifTrue:[
+ listAttributes grow:index
+ ]
+ ].
+ aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
+ listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
+ self redrawLine:index
+ ]
+ ]
+
+!
+
+setList:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes.
+ No redraw is done - the caller should make sure to redraw afterwards
+ (or use this only before the view is visible)."
+
+ selection := nil.
+ listAttributes := nil.
+ super setList:aCollection.
+!
+
+list:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes."
+
+ "somewhat of a kludge: if selection is first line,
+ we have to remove the highlight frame by hand here"
+
+ (shown and:[hilightLevel ~~ 0]) ifTrue:[
+ selection == firstLineShown ifTrue:[
+ self paint:bgColor.
+ self fillRectangleX:margin y:margin
+ width:(width - (margin * 2))
+ height:(hilightLevel abs).
+ ].
+ ].
+
+ selection := nil.
+ listAttributes := nil.
+ super list:aCollection.
+!
+
+setAttributes:aList
+ "set the attribute list.
+ No redraw is done - the caller should make sure to redraw afterwards
+ (or use this only before the view is visible)."
+
+ listAttributes := aList
+!
+
+keyActionStyle:aSymbol
+ "defines how the view should respond to alpha-keys pressed.
+ Possible values are:
+ #select -> will select next entry starting with that
+ character and perform the click-action
+
+ #selectAndDoubleclick -> will select next & perform double-click action
+
+ #pass -> will pass key to superclass (i.e. no special treatment)
+
+ nil -> will ignore key
+
+ the default (set in #initialize) is #select
+ "
+
+ keyActionStyle := aSymbol
+!
+
+attributeAt:index
+ "return the line attribute of list line index.
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ listAttributes isNil ifFalse:[
+ (index > listAttributes size) ifFalse:[
+ ^ listAttributes at:index
+ ]
+ ].
+ ^ nil
+!
+
+action:aBlock
+ "set the action block to be performed on select"
+
+ actionBlock := aBlock
+!
+
+attributeAt:index add:aSymbolOrCollectionOfSymbols
+ "add to a lines attribute(s);
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |current|
+
+ current := self attributeAt:index.
+ current isNil ifTrue:[
+ current := Set new.
+ ] ifFalse:[
+ current isSymbol ifTrue:[
+ current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
+ current := Set with:current
+ ]
+ ].
+
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current := current add:aSymbolOrCollectionOfSymbols
+ ] ifFalse:[
+ (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
+ current addAll:aSymbolOrCollectionOfSymbols
+ ].
+ self attributeAt:index put:current
+!
+
+doubleClickAction:aBlock
+ "set the double click action block to be performed on select"
+
+ doubleClickActionBlock := aBlock
+!
+
+attributeAt:index remove:aSymbolOrCollectionOfSymbols
+ "remove a line attribute;
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |current|
+
+ current := self attributeAt:index.
+ current isNil ifTrue:[^ self].
+ current isSymbol ifTrue:[
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
+ ] ifFalse:[
+ (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
+ current := nil
+ ]
+ ]
+ ] ifFalse:[
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
+ ] ifFalse:[
+ aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
+ ]
+ ].
+ self attributeAt:index put:current
+!
+
+removeIndexWithoutRedraw:lineNr
+ "delete line - no redraw;
+ return true, if something was really deleted.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndexWithoutRedraw:lineNr
+!
+
+removeIndex:lineNr
+ "delete line - with redraw.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndex:lineNr
+!
+
+add:aValue beforeIndex:index
+ "must recompute our current selections"
+
+ selection notNil ifTrue:[
+ selection size = 0 ifTrue:[
+ selection >= index ifTrue:[
+ selection := selection + 1.
+ ].
+ ] ifFalse:[
+ selection := selection collect:[ :sel |
+ sel >= index ifTrue:[
+ sel + 1
+ ] ifFalse:[
+ sel
+ ]
+ ].
+ ].
+ ].
+ ^ super add:aValue beforeIndex:index.
+! !
+
+!SelectionInListView methodsFor:'accessing-mvc'!
+
+on:aModel printItems:print oneItem:one aspect:aspect change:change
+ list:list menu:menu initialSelection:initial useIndex:use
+
+ "ST-80 compatibility"
+
+ aspectSymbol := aspect.
+ changeSymbol := change.
+ listSymbol := list.
+ menuSymbol := menu.
+ initialSelectionSymbol := initial.
+ printItems := print.
+ oneItem := one.
+ useIndex := use.
+ self model:aModel.
+
+ listSymbol notNil ifTrue:[
+ self getListFromModel
+ ].
+! !
+
+!SelectionInListView methodsFor:'private'!
+
+isValidSelection:aNumber
+ "return true, if aNumber is ok for a selection lineNo"
+
+ aNumber isNil ifTrue:[^ false].
+ (aNumber isCollection) ifTrue:[
+ (multipleSelectOk or:[aNumber size = 1]) ifFalse:[^ false].
+ aNumber do:[ :line |
+ (line between:1 and:self size) ifFalse:[^ false].
+ ].
+ ^ true.
+ ] ifFalse:[
+ ^ (aNumber between:1 and:self size).
+ ].
+
+!
+
+widthForScrollBetween:start and:end
+ "has to be redefined since WHOLE line is inverted/modified sometimes"
+
+ | anySelectionInRange |
+
+ selection notNil ifTrue:[
+ selection isCollection ifTrue:[
+ anySelectionInRange := false.
+ selection do:[:s |
+ (s between:start and:end) ifTrue:[
+ anySelectionInRange := true
+ ]
+ ]
+ ] ifFalse:[
+ anySelectionInRange := selection between:start and:end
+ ]
+ ] ifFalse:[
+ anySelectionInRange := false
+ ].
+
+ anySelectionInRange ifTrue:[
+ ^ width
+"
+ self is3D ifFalse:[
+ ^ width
+ ].
+ ( #(next openwin) includes:style) ifTrue:[
+ ^ width
+ ].
+ viewBackground = background ifFalse:[
+ ^ width
+ ]
+"
+ ].
+ ^ super widthForScrollBetween:start and:end
+!
+
+positionToSelectionX:x y:y
+ "given a click position, return the selection lineNo"
+
+ |visibleLine|
+
+ (x between:0 and:width) ifTrue:[
+ (y between:0 and:height) ifTrue:[
+ visibleLine := self visibleLineOfY:y.
+ ^ self visibleLineToListLine:visibleLine
+ ]
+ ].
+ ^ nil
+!
+
+visibleLineNeedsSpecialCare:visLineNr
+ |listLine|
+
+ listLine := self visibleLineToListLine:visLineNr.
+ listLine isNil ifTrue:[^ false].
+ (self isInSelection:listLine) ifTrue:[^ true].
+ listAttributes notNil ifTrue:[
+ (listLine <= listAttributes size) ifTrue:[
+ ^ (listAttributes at:listLine) notNil
+ ]
+ ].
+ ^ false
+!
+
+checkRemovingSelection:lineNr
+ "when a line is removed, we have to adjust selection"
+
+ |newSelection|
+
+ selection notNil ifTrue:[
+ (selection size > 0) ifTrue:[
+ newSelection := OrderedCollection new.
+ selection do:[:sel |
+ sel < lineNr ifTrue:[
+ newSelection add:sel
+ ] ifFalse:[
+ sel > lineNr ifTrue:[
+ newSelection add:(sel - 1)
+ ]
+ "otherwise remove it from the selection"
+ ]
+ ].
+ newSelection size == 1 ifTrue:[
+ selection := newSelection first
+ ] ifFalse:[
+ newSelection size == 0 ifTrue:[
+ selection := nil
+ ] ifFalse:[
+ selection := newSelection
+ ]
+ ]
+ ] ifFalse:[
+ selection == lineNr ifTrue:[
+ selection := nil
+ ] ifFalse:[
+ selection > lineNr ifTrue:[
+ selection := selection - 1
+ ]
+ ]
+ ]
+ ]
+!
+
+scrollSelectDown
+ "auto scroll action; scroll and reinstall timed-block"
+
+ self scrollDown.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+scrollSelectUp
+ "auto scroll action; scroll and reinstall timed-block"
+
+ self scrollUp.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+getListFromModel
+ |text|
+
+ listSymbol notNil ifTrue:[
+ items := model perform:listSymbol.
+ items notNil ifTrue:[
+ printItems ifTrue:[
+ text := items collect:[:element | element printString]
+ ] ifFalse:[
+ text := items
+ ].
+ text notNil ifTrue:[
+ text := text asStringCollection.
+ ]
+ ].
+ self list:text
+ ].
+! !
+
+!SelectionInListView methodsFor:'initialization'!
+
+initCursor
+ "set the cursor - a hand"
+
+ cursor := Cursor hand
+!
+
+realize
+ super realize.
+ selection notNil ifTrue:[
+ self makeLineVisible:selection
+ ]
+!
+
+initialize
+ super initialize.
+
+ fontHeight := font height + lineSpacing.
+ enabled := true.
+ multipleSelectOk := false.
+ ignoreReselect := true.
+ toggleSelect := false.
+ strikeOut := false.
+ keyActionStyle := #select.
+!
+
+initStyle
+ |nm|
+
+ super initStyle.
+
+ DefaultFont notNil ifTrue:[
+ font := DefaultFont on:device
+ ].
+
+ bgColor := viewBackground.
+ hilightFrameColor := nil.
+ hilightLevel := 0.
+ arrowLevel := 1.
+ smallArrow := false.
+
+ device hasGreyscales ifTrue:[
+ "
+ must get rid of these hard codings
+ "
+ nm := StyleSheet name asSymbol.
+ (nm == #next) ifTrue:[
+ hilightFgColor := fgColor.
+ hilightBgColor := White.
+ hilightFrameColor := fgColor
+ ] ifFalse:[
+ (nm == #motif) ifTrue:[
+ fgColor := White.
+ bgColor := Grey.
+ viewBackground := bgColor.
+ hilightFgColor := bgColor "fgColor" "White".
+ hilightBgColor := fgColor "bgColor lightened" "darkened".
+ ] ifFalse:[
+ (nm == #openwin) ifTrue:[
+ hilightFgColor := fgColor.
+ hilightBgColor := Color grey.
+ smallArrow := true.
+ ]
+ ]
+ ]
+ ].
+
+ hilightFgColor isNil ifTrue:[
+ hilightFgColor := bgColor.
+ ].
+ hilightBgColor isNil ifTrue:[
+ hilightBgColor := fgColor.
+ ].
+ DefaultForegroundColor notNil ifTrue:[
+ fgColor := DefaultForegroundColor
+ ].
+ DefaultBackgroundColor notNil ifTrue:[
+ bgColor := viewBackground := DefaultBackgroundColor
+ ].
+ DefaultHilightForegroundColor notNil ifTrue:[
+ hilightFgColor := DefaultHilightForegroundColor
+ ].
+ DefaultHilightBackgroundColor notNil ifTrue:[
+ hilightBgColor := DefaultHilightBackgroundColor
+ ].
+ DefaultHilightFrameColor notNil ifTrue:[
+ hilightFrameColor := DefaultHilightFrameColor
+ ].
+ DefaultHilightLevel notNil ifTrue:[
+ hilightLevel := DefaultHilightLevel
+ ].
+ DefaultRightArrowLevel notNil ifTrue:[
+ arrowLevel := DefaultRightArrowLevel
+ ].
+
+ DefaultShadowColor notNil ifTrue:[
+ shadowColor := DefaultShadowColor on:device
+ ].
+ DefaultLightColor notNil ifTrue:[
+ lightColor := DefaultLightColor on:device
+ ].
+
+ (hilightLevel abs > 0) ifTrue:[
+ lineSpacing := 3
+ ] ifFalse:[
+ lineSpacing := 2
+ ].
+
+ hilightFgColor isNil ifTrue:[
+ hilightFgColor := bgColor.
+ hilightBgColor := fgColor
+ ].
+
+ DefaultDisabledForegroundColor notNil ifTrue:[
+ halfIntensityFgColor := DefaultDisabledForegroundColor
+ ] ifFalse:[
+ halfIntensityFgColor := Color darkGrey.
+ ].
+
+ fgColor := fgColor on:device.
+ bgColor := bgColor on:device.
+ halfIntensityFgColor := halfIntensityFgColor on:device.
+ hilightFrameColor notNil ifTrue:[hilightFrameColor := hilightFrameColor on:device].
+ hilightFgColor := hilightFgColor on:device.
+ hilightBgColor := hilightBgColor on:device.
! !
!SelectionInListView methodsFor:'event handling'!
+buttonPress:button x:x y:y
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ enabled ifTrue:[
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (toggleSelect
+ and:[self isInSelection:listLineNr]) ifTrue:[
+ oldSelection := selection copy.
+ self removeFromSelection:listLineNr
+ ] ifFalse:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+
+ (toggleSelect and:[multipleSelectOk]) ifTrue:[
+ oldSelection := selection copy.
+ self addToSelection:listLineNr
+ ] ifFalse:[
+ oldSelection := selection copy.
+ self selectWithoutScroll:listLineNr.
+ ].
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ self selectionChanged.
+ ].
+ clickLine := listLineNr
+ ].
+ ]
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+!
+
sizeChanged:how
"if there is a selection, make certain, its visible
after the sizechange"
|first wasAtEnd|
- wasAtEnd := (firstLineShown + nFullLinesShown) >= list size.
+ wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
super sizeChanged:how.
@@ -1501,6 +1642,14 @@
]
]
]
+
+
+!
+
+buttonRelease:button x:x y:y
+ "stop any autoscroll"
+
+ self stopAutoScroll
!
key:key select:selectAction x:x y:y
@@ -1511,7 +1660,7 @@
^ super keyPress:key x:x y:y
].
selectAction value.
- actionBlock notNil ifTrue:[actionBlock value:selection].
+ self selectionChanged.
keyActionStyle == #selectAndDoubleClick ifTrue:[
doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
]
@@ -1549,7 +1698,7 @@
^ self
].
(key == #End) ifTrue:[
- index := list size.
+ index := self size.
(selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
self key:key select:[self selection:index] x:x y:y
].
@@ -1567,7 +1716,7 @@
alphabetic keys: search for next entry
starting with keys character. If shift is pressed, search backward
"
- (list size > 0
+ (self size > 0
and:[key isCharacter
and:[key isLetter]]) ifTrue:[
keyActionStyle isNil ifTrue:[^ self].
@@ -1590,10 +1739,10 @@
startSearch := selection - 1
]
] ifFalse:[
- startSearch := list size
+ startSearch := self size
].
startSearch < 1 ifTrue:[
- startSearch := list size.
+ startSearch := self size.
].
] ifFalse:[
selection notNil ifTrue:[
@@ -1605,22 +1754,22 @@
] ifFalse:[
startSearch := 1
].
- startSearch > list size ifTrue:[
+ startSearch > self size ifTrue:[
startSearch := 1.
].
].
index := startSearch.
[true] whileTrue:[
- (((list at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
+ (((self at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
index = selection ifTrue:[^ self].
^ self key:key select:[self selection:index] x:x y:y
].
backSearch ifTrue:[
index := index - 1.
- index < 1 ifTrue:[index := list size]
+ index < 1 ifTrue:[index := self size]
] ifFalse:[
index := index + 1.
- index > list size ifTrue:[index := 1].
+ index > self size ifTrue:[index := 1].
].
index == startSearch ifTrue:[
^ self
@@ -1629,54 +1778,18 @@
].
].
^ super keyPress:key x:x y:y
+
!
-buttonPress:button x:x y:y
- |oldSelection listLineNr arg|
-
+buttonMultiPress:button x:x y:y
((button == 1) or:[button == #select]) ifTrue:[
- enabled ifTrue:[
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (toggleSelect
- and:[self isInSelection:listLineNr]) ifTrue:[
- oldSelection := selection copy.
- self removeFromSelection:listLineNr
- ] ifFalse:[
- (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
-
- (toggleSelect and:[multipleSelectOk]) ifTrue:[
- oldSelection := selection copy.
- self addToSelection:listLineNr
- ] ifFalse:[
- oldSelection := selection copy.
- self selectWithoutScroll:listLineNr.
- ].
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- "
- the ST/X way of doing things - perform actionBlock
- "
- actionBlock notNil ifTrue:[actionBlock value:selection].
- "
- the ST-80 way of doing things - notify model via changeSymbol
- "
- useIndex == true ifTrue:[
- arg := selection
- ] ifFalse:[
- arg := self selectionValue
- ].
- self sendChangeMessageWith:arg
- ].
- clickLine := listLineNr
- ].
+ doubleClickActionBlock isNil ifTrue:[
+ self buttonPress:button x:x y:y
+ ] ifFalse:[
+ doubleClickActionBlock value:selection
]
] ifFalse:[
- super buttonPress:button x:x y:y
+ super buttonMultiPress:button x:x y:y
]
!
@@ -1708,19 +1821,7 @@
]
].
(selection ~= oldSelection) ifTrue:[
- "
- the ST/X way of doing things
- "
- actionBlock notNil ifTrue:[actionBlock value:selection].
- "
- the ST-80 way of doing things
- "
- useIndex == true ifTrue:[
- arg := selection
- ] ifFalse:[
- arg := self selectionValue
- ].
- self sendChangeMessageWith:arg
+ self selectionChanged.
].
clickLine := listLineNr
]
@@ -1729,22 +1830,21 @@
]
!
-buttonMultiPress:button x:x y:y
- ((button == 1) or:[button == #select]) ifTrue:[
- doubleClickActionBlock isNil ifTrue:[
- self buttonPress:button x:x y:y
- ] ifFalse:[
- doubleClickActionBlock value:selection
- ]
- ] ifFalse:[
- super buttonMultiPress:button x:x y:y
- ]
-!
+update:something with:aParameter from:changedObject
+ |newList|
-buttonRelease:button x:x y:y
- "stop any autoscroll"
-
- self stopAutoScroll
+ changedObject == model ifTrue:[
+ (aspectSymbol notNil
+ and:[something == aspectSymbol]) ifTrue:[
+ self getListFromModel
+ ].
+ (initialSelectionSymbol notNil
+ and:[something == initialSelectionSymbol]) ifTrue:[
+ self selectElement:(model perform:initialSelectionSymbol).
+ ].
+ ^ self
+ ].
+ ^ super update:something with:aParameter from:changedObject
!
buttonMotion:buttonMask x:x y:y
@@ -1795,33 +1895,12 @@
].
((selection ~= oldSelection)
or:[selection size ~~ oldSelCount]) ifTrue:[
- actionBlock notNil ifTrue:[actionBlock value:selection]
+ self selectionChanged.
]
] ifFalse:[
self selectWithoutScroll:movedLine
].
clickLine := movedLine
-!
-update:something with:aParameter from:changedObject
- |newList|
-
- changedObject == model ifTrue:[
- (initialSelectionSymbol notNil
- and:[something == initialSelectionSymbol]) ifTrue:[
- self selectElement:(model perform:initialSelectionSymbol).
- ^ self
- ].
- (aspectSymbol notNil
- and:[something == aspectSymbol]) ifTrue:[
- newList := (model perform:listSymbol) asStringCollection.
- (newList = list) ifFalse:[
- self list:newList
- ].
- ^ self
- ].
- ^ self
- ].
- ^ super update:something with:aParameter from:changedObject
! !
--- a/SelectionInListView.st Sat Mar 18 06:16:33 1995 +0100
+++ b/SelectionInListView.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,35 +10,32 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:01:02 am'!
+
ListView subclass:#SelectionInListView
- instanceVariableNames:'selection actionBlock enabled
- hilightFgColor hilightBgColor
- halfIntensityFgColor
- doubleClickActionBlock
- selectConditionBlock
- listAttributes multipleSelectOk clickLine
- initialSelectionSymbol
- oneItem useIndex
- hilightLevel hilightFrameColor ignoreReselect
- arrowLevel smallArrow keyActionStyle toggleSelect
- strikeOut iSearchString'
+ instanceVariableNames:'selection actionBlock enabled hilightFgColor hilightBgColor
+ halfIntensityFgColor doubleClickActionBlock selectConditionBlock
+ listAttributes multipleSelectOk clickLine initialSelectionSymbol
+ oneItem useIndex hilightLevel hilightFrameColor ignoreReselect
+ arrowLevel smallArrow keyActionStyle toggleSelect strikeOut
+ iSearchString items'
classVariableNames:'RightArrowShadowForm RightArrowLightForm RightArrowForm
SmallRightArrowShadowForm SmallRightArrowLightForm
DefaultForegroundColor DefaultBackgroundColor
DefaultHilightForegroundColor DefaultHilightBackgroundColor
DefaultHilightFrameColor DefaultHilightLevel DefaultFont
DefaultRightArrowStyle DefaultRightArrowLevel
- DefaultDisabledForegroundColor
- DefaultShadowColor DefaultLightColor'
- poolDictionaries:''
- category:'Views-Text'
+ DefaultDisabledForegroundColor DefaultShadowColor
+ DefaultLightColor'
+ poolDictionaries:''
+ category:'Views-Text'
!
SelectionInListView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.24 1995-03-06 19:29:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.25 1995-03-18 05:16:09 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -59,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.24 1995-03-06 19:29:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.25 1995-03-18 05:16:09 claus Exp $
"
!
@@ -163,25 +160,74 @@
"
! !
+!SelectionInListView class methodsFor:'instance creation'!
+
+on:aModel printItems:print oneItem:one aspect:aspect change:change
+ list:list menu:menu initialSelection:initial useIndex:useIndex
+
+ "for ST-80 compatibility"
+
+ ^ (self new) on:aModel
+ printItems:print
+ oneItem:one
+ aspect:aspect
+ change:change
+ list:list
+ menu:menu
+ initialSelection:initial
+ useIndex:useIndex
+!
+
+on:aModel printItems:print oneItem:one aspect:aspect
+ change:change list:list menu:menu initialSelection:initial
+
+ "for ST-80 compatibility"
+
+ ^ self on:aModel
+ printItems:print
+ oneItem:one
+ aspect:aspect
+ change:change
+ list:list
+ menu:menu
+ initialSelection:initial
+ useIndex:false
+! !
+
!SelectionInListView class methodsFor:'defaults'!
-updateStyleCache
- DefaultDisabledForegroundColor := StyleSheet colorAt:'selectionDisabledForegroundColor'.
- DefaultHilightForegroundColor := StyleSheet colorAt:'selectionHilightForegroundColor'.
- DefaultHilightBackgroundColor := StyleSheet colorAt:'selectionHilightBackgroundColor'.
- DefaultHilightFrameColor := StyleSheet colorAt:'selectionHilightFrameColor'.
- DefaultHilightLevel := StyleSheet at:'selectionHilightLevel' default:0.
- DefaultRightArrowStyle := StyleSheet at:'selectionRightArrowStyle'.
- DefaultRightArrowLevel := StyleSheet at:'selectionRightArrowLevel'.
- DefaultForegroundColor := StyleSheet colorAt:'selectionForegroundColor'.
- DefaultBackgroundColor := StyleSheet colorAt:'selectionBackgroundColor'.
- DefaultShadowColor := StyleSheet colorAt:'selectionShadowColor'.
- DefaultLightColor := StyleSheet colorAt:'selectionLightColor'.
- DefaultFont := StyleSheet fontAt:'selectionFont'.
+rightArrowShadowFormOn:aDevice
+ "return the form used for the right arrow light pixels (3D only)"
+
+ |f|
- "
- self updateStyleCache
- "
+ ((aDevice == Display) and:[RightArrowShadowForm notNil]) ifTrue:[
+ ^ RightArrowShadowForm
+ ].
+ f := Form fromFile:'RightArrowShadow.xbm' resolution:100 on:aDevice.
+ f isNil ifTrue:[
+ f := Form width:16 height:16 fromArray:#[2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00010000
+ 2r00000000 2r00100000
+ 2r00000000 2r01000000
+ 2r00000000 2r10000000
+ 2r00000001 2r00000000
+ 2r00000010 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000]
+ on:aDevice
+ ].
+ (aDevice == Display) ifTrue:[
+ RightArrowShadowForm := f
+ ].
+ ^ f
!
rightArrowLightFormOn:aDevice
@@ -218,38 +264,23 @@
^ f
!
-rightArrowShadowFormOn:aDevice
- "return the form used for the right arrow light pixels (3D only)"
-
- |f|
+updateStyleCache
+ DefaultDisabledForegroundColor := StyleSheet colorAt:'selectionDisabledForegroundColor'.
+ DefaultHilightForegroundColor := StyleSheet colorAt:'selectionHilightForegroundColor'.
+ DefaultHilightBackgroundColor := StyleSheet colorAt:'selectionHilightBackgroundColor'.
+ DefaultHilightFrameColor := StyleSheet colorAt:'selectionHilightFrameColor'.
+ DefaultHilightLevel := StyleSheet at:'selectionHilightLevel' default:0.
+ DefaultRightArrowStyle := StyleSheet at:'selectionRightArrowStyle'.
+ DefaultRightArrowLevel := StyleSheet at:'selectionRightArrowLevel'.
+ DefaultForegroundColor := StyleSheet colorAt:'selectionForegroundColor'.
+ DefaultBackgroundColor := StyleSheet colorAt:'selectionBackgroundColor'.
+ DefaultShadowColor := StyleSheet colorAt:'selectionShadowColor'.
+ DefaultLightColor := StyleSheet colorAt:'selectionLightColor'.
+ DefaultFont := StyleSheet fontAt:'selectionFont'.
- ((aDevice == Display) and:[RightArrowShadowForm notNil]) ifTrue:[
- ^ RightArrowShadowForm
- ].
- f := Form fromFile:'RightArrowShadow.xbm' resolution:100 on:aDevice.
- f isNil ifTrue:[
- f := Form width:16 height:16 fromArray:#[2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00010000
- 2r00000000 2r00100000
- 2r00000000 2r01000000
- 2r00000000 2r10000000
- 2r00000001 2r00000000
- 2r00000010 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000]
- on:aDevice
- ].
- (aDevice == Display) ifTrue:[
- RightArrowShadowForm := f
- ].
- ^ f
+ "
+ self updateStyleCache
+ "
!
rightArrowFormOn:aDevice
@@ -340,1020 +371,14 @@
^ f
! !
-!SelectionInListView class methodsFor:'instance creation'!
-
-on:aModel printItems:print oneItem:one aspect:aspect change:change
- list:list menu:menu initialSelection:initial useIndex:useIndex
-
- "for ST-80 compatibility"
-
- ^ (self new) on:aModel
- printItems:print
- oneItem:one
- aspect:aspect
- change:change
- list:list
- menu:menu
- initialSelection:initial
- useIndex:useIndex
-!
-
-on:aModel printItems:print oneItem:one aspect:aspect
- change:change list:list menu:menu initialSelection:initial
-
- "for ST-80 compatibility"
-
- ^ self on:aModel
- printItems:print
- oneItem:one
- aspect:aspect
- change:change
- list:list
- menu:menu
- initialSelection:initial
- useIndex:false
-! !
-
-!SelectionInListView methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- fontHeight := font height + lineSpacing.
- enabled := true.
- multipleSelectOk := false.
- ignoreReselect := true.
- toggleSelect := false.
- strikeOut := false.
- keyActionStyle := #select.
-!
-
-initStyle
- |nm|
-
- super initStyle.
-
- DefaultFont notNil ifTrue:[
- font := DefaultFont on:device
- ].
-
- bgColor := viewBackground.
- hilightFrameColor := nil.
- hilightLevel := 0.
- arrowLevel := 1.
- smallArrow := false.
-
- device hasGreyscales ifTrue:[
- "
- must get rid of these hard codings
- "
- nm := StyleSheet name asSymbol.
- (nm == #next) ifTrue:[
- hilightFgColor := fgColor.
- hilightBgColor := White.
- hilightFrameColor := fgColor
- ] ifFalse:[
- (nm == #motif) ifTrue:[
- fgColor := White.
- bgColor := Grey.
- viewBackground := bgColor.
- hilightFgColor := bgColor "fgColor" "White".
- hilightBgColor := fgColor "bgColor lightened" "darkened".
- ] ifFalse:[
- (nm == #openwin) ifTrue:[
- hilightFgColor := fgColor.
- hilightBgColor := Color grey.
- smallArrow := true.
- ]
- ]
- ]
- ].
-
- hilightFgColor isNil ifTrue:[
- hilightFgColor := bgColor.
- ].
- hilightBgColor isNil ifTrue:[
- hilightBgColor := fgColor.
- ].
- DefaultForegroundColor notNil ifTrue:[
- fgColor := DefaultForegroundColor
- ].
- DefaultBackgroundColor notNil ifTrue:[
- bgColor := viewBackground := DefaultBackgroundColor
- ].
- DefaultHilightForegroundColor notNil ifTrue:[
- hilightFgColor := DefaultHilightForegroundColor
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- hilightBgColor := DefaultHilightBackgroundColor
- ].
- DefaultHilightFrameColor notNil ifTrue:[
- hilightFrameColor := DefaultHilightFrameColor
- ].
- DefaultHilightLevel notNil ifTrue:[
- hilightLevel := DefaultHilightLevel
- ].
- DefaultRightArrowLevel notNil ifTrue:[
- arrowLevel := DefaultRightArrowLevel
- ].
-
- DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor on:device
- ].
- DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor on:device
- ].
-
- (hilightLevel abs > 0) ifTrue:[
- lineSpacing := 3
- ] ifFalse:[
- lineSpacing := 2
- ].
-
- hilightFgColor isNil ifTrue:[
- hilightFgColor := bgColor.
- hilightBgColor := fgColor
- ].
-
- DefaultDisabledForegroundColor notNil ifTrue:[
- halfIntensityFgColor := DefaultDisabledForegroundColor
- ] ifFalse:[
- halfIntensityFgColor := Color darkGrey.
- ].
-
- fgColor := fgColor on:device.
- bgColor := bgColor on:device.
- halfIntensityFgColor := halfIntensityFgColor on:device.
- hilightFrameColor notNil ifTrue:[hilightFrameColor := hilightFrameColor on:device].
- hilightFgColor := hilightFgColor on:device.
- hilightBgColor := hilightBgColor on:device.
-!
-
-initCursor
- "set the cursor - a hand"
-
- cursor := Cursor hand
-!
-
-realize
- super realize.
- selection notNil ifTrue:[
- self makeLineVisible:selection
- ]
-! !
-
-!SelectionInListView methodsFor:'accessing'!
-
-keyActionStyle:aSymbol
- "defines how the view should respond to alpha-keys pressed.
- Possible values are:
- #select -> will select next entry starting with that
- character and perform the click-action
-
- #selectAndDoubleclick -> will select next & perform double-click action
-
- #pass -> will pass key to superclass (i.e. no special treatment)
-
- nil -> will ignore key
-
- the default (set in #initialize) is #select
- "
-
- keyActionStyle := aSymbol
-!
-
-contents:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- selection := nil.
- listAttributes := nil.
- super contents:aCollection.
-!
-
-setList:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- selection := nil.
- listAttributes := nil.
- super setList:aCollection.
-!
-
-list:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- "somewhat of a kludge: if selection is first line,
- we have to remove the highlight frame by hand here"
-
- (shown and:[hilightLevel ~~ 0]) ifTrue:[
- selection == firstLineShown ifTrue:[
- self paint:bgColor.
- self fillRectangleX:margin y:margin
- width:(width - (margin * 2))
- height:(hilightLevel abs).
- ].
- ].
-
- selection := nil.
- listAttributes := nil.
- super list:aCollection.
-!
-
-setAttributes:aList
- "set the attribute list.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- listAttributes := aList
-!
-
-attributeAt:index
- "return the line attribute of list line index.
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- listAttributes isNil ifFalse:[
- (index > listAttributes size) ifFalse:[
- ^ listAttributes at:index
- ]
- ].
- ^ nil
-!
-
-attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
- "set a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- (index > list size) ifFalse:[
- listAttributes isNil ifTrue:[
- listAttributes := (OrderedCollection new:index) grow:index
- ] ifFalse:[
- (index > listAttributes size) ifTrue:[
- listAttributes grow:index
- ]
- ].
- aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
- listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
- self redrawLine:index
- ]
- ]
-!
-
-attributeAt:index add:aSymbolOrCollectionOfSymbols
- "add to a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[
- current := Set new.
- ] ifFalse:[
- current isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
- current := Set with:current
- ]
- ].
-
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current add:aSymbolOrCollectionOfSymbols
- ] ifFalse:[
- (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
- current addAll:aSymbolOrCollectionOfSymbols
- ].
- self attributeAt:index put:current
-!
-
-attributeAt:index remove:aSymbolOrCollectionOfSymbols
- "remove a line attribute;
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[^ self].
- current isSymbol ifTrue:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
- ] ifFalse:[
- (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
- current := nil
- ]
- ]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
- ]
- ].
- self attributeAt:index put:current
-!
-
-line:lineNr hasAttribute:aSymbol
- "return true, if line nr has attribute, aSymbol;
- currently supported attributes are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |attr|
-
- (lineNr > listAttributes size) ifTrue:[^ false].
- attr := listAttributes at:lineNr.
- attr isNil ifTrue:[^ false].
- attr isSymbol ifTrue:[^ attr == aSymbol].
- ^ (attr includes:aSymbol)
-!
-
-removeIndexWithoutRedraw:lineNr
- "delete line - no redraw;
- return true, if something was really deleted.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndexWithoutRedraw:lineNr
-!
-
-removeIndex:lineNr
- "delete line - with redraw.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndex:lineNr
-!
-
-action:aBlock
- "set the action block to be performed on select"
-
- actionBlock := aBlock
-!
-
-doubleClickAction:aBlock
- "set the double click action block to be performed on select"
-
- doubleClickActionBlock := aBlock
-!
-
-on:aModel printItems:print oneItem:one aspect:aspect change:change
- list:list menu:menu initialSelection:initial useIndex:use
-
- "ST-80 compatibility"
-
- aspectSymbol := aspect.
- changeSymbol := change.
- listSymbol := list.
- menuSymbol := menu.
- initialSelectionSymbol := initial.
- printItems := print.
- oneItem := one.
- useIndex := use.
- model := aModel.
-
- listSymbol notNil ifTrue:[
- self list:(aModel perform:listSymbol) asStringCollection
- ].
- model addDependent:self
-! !
-
-!SelectionInListView methodsFor:'selections'!
-
-toggleSelect:aBoolean
- "turn on/off toggle select"
-
- toggleSelect := aBoolean.
-!
-
-strikeOut:aBoolean
- "turn on/off strikeOut mode"
-
- strikeOut := aBoolean.
-!
-
-multipleSelectOk:aBoolean
- "allow/disallow multiple selections"
-
- multipleSelectOk := aBoolean.
- aBoolean ifTrue:[
- self enableButtonMotionEvents
- ] ifFalse:[
- self disableButtonMotionEvents
- ]
-!
-
-ignoreReselect:aBoolean
- "set/clear the ignoreReselect flag -
- if set, a click on an already selected entry is ignored.
- Otherwise the notification is done, even if no
- change in the selection occurs.
- (for example, in browser to update a method)"
-
- ignoreReselect := aBoolean
-!
-
-enable
- "enable selections"
-
- enabled := true
-!
-
-disable
- "disable selections"
-
- enabled := false
-!
-
-selectConditionBlock:aBlock
- "set the conditionBlock; this block is evaluated before a selection
- change is performed; the change will not be done, if the evaluation
- returns false. For example, this allows confirmation queries in
- the SystemBrowser"
-
- selectConditionBlock := aBlock
-!
-
-numberOfSelections
- "return the number of selected entries"
-
- |sz|
-
- selection isNil ifTrue:[^ 0].
- sz := selection size.
- sz > 0 ifTrue:[^ sz].
- ^ 1
-!
-
-isInSelection:aNumber
- "return true, if line, aNumber is in the selection"
-
- selection isNil ifTrue:[^ false].
- selection isCollection ifTrue:[
- ^ (selection includes:aNumber)
- ].
- ^ (aNumber == selection)
-!
-
-valueIsInSelection:someString
- "return true, if someString is in the selection"
-
- |sel|
-
- selection isNil ifTrue:[^ false].
- sel := self selectionValue.
- self numberOfSelections > 1 ifTrue:[
- ^ (sel includes:someString)
- ].
- ^ (someString = sel)
-!
-
-hasSelection
- "return true, if the view has a selection"
-
- ^ selection notNil
-!
-
-selectionValue
- "return the selection value i.e. the text in the selected line.
- For multiple selections a collection containing the entries is returned."
-
- selection isNil ifTrue:[^ nil].
- selection isCollection ifTrue:[
- ^ selection collect:[:nr | list at:nr]
- ].
- ^ list at:selection
-!
-
-selection
- "return the selection line nr or collection of line numbers"
-
- ^ selection
-!
-
-deselect
- "deselect"
-
- self selection:nil
-!
-
-deselectWithoutRedraw
- "deselect - no redraw"
-
- selection := nil
-!
-
-selectElementWithoutScroll:anObject
- "select the element with same printString as the argument, anObject.
- Do not scroll."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
- ]
-!
-
-selectElement:anObject
- "select the element with same printString as the argument, anObject.
- Scroll to make the new selection visible."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selection:lineNo]
- ]
-!
-
-selectWithoutScroll:aNumberOrNil
- "select line, aNumber or deselect if argument is nil"
-
- |prevSelection newSelection|
-
- newSelection := aNumberOrNil.
- newSelection notNil ifTrue:[
- (self isValidSelection:newSelection) ifFalse:[
- newSelection := nil
- ]
- ].
-
- (newSelection == selection) ifTrue: [^ self].
-
- selection notNil ifTrue: [
- prevSelection := selection.
- selection := nil.
- prevSelection isCollection ifTrue:[
- prevSelection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:prevSelection
- ]
- ].
- selection := newSelection.
- selection notNil ifTrue:[
- self redrawElement:selection
- ]
-!
-
-selection:aNumberOrNil
- "select line, aNumber or deselect if argument is nil;
- scroll to make the selected line visible"
-
- self selectWithoutScroll:aNumberOrNil.
- selection notNil ifTrue:[
-"/ shown ifTrue:[
- self makeLineVisible:selection
-"/ ]
- ]
-!
-
-selectAll
- "select all entries."
-
- selection := OrderedCollection withAll:(1 to:list size).
- shown ifTrue:[self redraw]
-!
-
-addElementToSelection:anObject
- "add the element with the same printstring as the argument, anObject
- to the selection. The entry is searched by comparing printStrings.
- No scrolling is done. Returns true, if ok, false if no such entry
- was found."
-
- |lineNo str|
-
- str := anObject printString.
- lineNo := list findFirst:[:entry | str = entry printString].
- lineNo ~~ 0 ifTrue:[
- self addToSelection:lineNo.
- ^ true
- ].
- ^ false
-!
-
-addToSelection:aNumber
- "add entry, aNumber to the selection. No scrolling is done."
-
- (self isValidSelection:aNumber) ifFalse:[^ self].
-
- selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifTrue:[^ self].
- selection add:aNumber
- ] ifFalse:[
- (aNumber == selection) ifTrue:[^ self].
- selection := OrderedCollection with:selection with:aNumber
- ].
- self redrawElement:aNumber
-!
-
-removeFromSelection:aNumber
- "remove entry, aNumber from the selection."
-
- selection isNil ifTrue:[^ self].
-
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifFalse:[^ self].
- selection remove:aNumber.
- selection size == 1 ifTrue:[
- selection := selection first
- ] ifFalse:[
- selection size == 0 ifTrue:[
- selection := nil
- ]
- ]
- ] ifFalse:[
- (aNumber == selection) ifFalse:[^ self].
- selection := nil
- ].
- self redrawElement:aNumber
-!
-
-toggleSelection:aNumber
- "toggle selection-state of entry, aNumber"
-
- (self isInSelection:aNumber) ifTrue:[
- self removeFromSelection:aNumber
- ] ifFalse:[
- self addToSelection:aNumber
- ]
-!
-
-nextAfterSelection
- "return the number of the next selectable entry after the selection.
- Wrap at end."
-
- |next|
-
- selection isNil ifTrue:[
- next := firstLineShown
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- next := selection max + 1
- ] ifFalse:[
- next := selection + 1
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next > list size ifTrue:[
- next := 1.
- ] ifFalse:[
- [next <= list size
- and:[(self isValidSelection:next) not]] whileTrue:[
- next := next + 1
- ].
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next := nil
- ].
- ^ next
-!
-
-previousBeforeSelection
- "return the number of the previous selectable entry before the selection.
- Wrap at beginning."
-
- |prev|
-
- selection isNil ifTrue:[
- prev := firstLineShown - 1
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- prev := selection min - 1
- ] ifFalse:[
- prev := selection - 1
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev < 1 ifTrue:[
- prev := list size.
- ] ifFalse:[
- [prev >= 1
- and:[(self isValidSelection:prev) not]] whileTrue:[
- prev := prev - 1
- ].
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev := nil
- ].
- ^ prev
-!
-
-selectNext
- "select next line or first visible if there is currrently no selection.
- Wrap at end."
-
- self selection:(self nextAfterSelection)
-!
-
-selectPrevious
- "select previous line or previous visible if there is currently no selection.
- Wrap at beginning."
-
- self selection:(self previouseBeforeSelection).
-!
-
-selectionDo:aBlock
- "perform aBlock for each nr in the selection.
- For single selection, it is called once for the items nr.
- For multiple selections, it is called for each."
-
- |sz|
-
- selection isNil ifTrue:[^ self].
- sz := selection size.
- sz > 0 ifTrue:[
- selection do:aBlock
- ] ifFalse:[
- aBlock value:selection
- ].
-! !
-
-!SelectionInListView methodsFor:'private'!
-
-checkRemovingSelection:lineNr
- "when a line is removed, we have to adjust selection"
-
- |newSelection|
-
- selection notNil ifTrue:[
- (selection size > 0) ifTrue:[
- newSelection := OrderedCollection new.
- selection do:[:sel |
- sel < lineNr ifTrue:[
- newSelection add:sel
- ] ifFalse:[
- sel > lineNr ifTrue:[
- newSelection add:(sel - 1)
- ]
- "otherwise remove it from the selection"
- ]
- ].
- newSelection size == 1 ifTrue:[
- selection := newSelection first
- ] ifFalse:[
- newSelection size == 0 ifTrue:[
- selection := nil
- ] ifFalse:[
- selection := newSelection
- ]
- ]
- ] ifFalse:[
- selection == lineNr ifTrue:[
- selection := nil
- ] ifFalse:[
- selection > lineNr ifTrue:[
- selection := selection - 1
- ]
- ]
- ]
- ]
-!
-
-isValidSelection:aNumber
- "return true, if aNumber is ok for a selection lineNo"
-
- aNumber isNil ifTrue:[^ false].
- ^ (aNumber between:1 and:list size)
-!
-
-positionToSelectionX:x y:y
- "given a click position, return the selection lineNo"
-
- |visibleLine|
-
- (x between:0 and:width) ifTrue:[
- (y between:0 and:height) ifTrue:[
- visibleLine := self visibleLineOfY:y.
- ^ self visibleLineToListLine:visibleLine
- ]
- ].
- ^ nil
-!
-
-widthForScrollBetween:start and:end
- "has to be redefined since WHOLE line is inverted/modified sometimes"
-
- | anySelectionInRange |
-
- selection notNil ifTrue:[
- selection isCollection ifTrue:[
- anySelectionInRange := false.
- selection do:[:s |
- (s between:start and:end) ifTrue:[
- anySelectionInRange := true
- ]
- ]
- ] ifFalse:[
- anySelectionInRange := selection between:start and:end
- ]
- ] ifFalse:[
- anySelectionInRange := false
- ].
-
- anySelectionInRange ifTrue:[
- ^ width
-"
- self is3D ifFalse:[
- ^ width
- ].
- ( #(next openwin) includes:style) ifTrue:[
- ^ width
- ].
- viewBackground = background ifFalse:[
- ^ width
- ]
-"
- ].
- ^ super widthForScrollBetween:start and:end
-!
-
-visibleLineNeedsSpecialCare:visLineNr
- |listLine|
-
- listLine := self visibleLineToListLine:visLineNr.
- listLine isNil ifTrue:[^ false].
- (self isInSelection:listLine) ifTrue:[^ true].
- listAttributes notNil ifTrue:[
- (listLine <= listAttributes size) ifTrue:[
- ^ (listAttributes at:listLine) notNil
- ]
- ].
- ^ false
-!
-
-scrollSelectDown
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollDown.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-scrollSelectUp
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollUp.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-! !
-
!SelectionInListView methodsFor:'redrawing'!
-drawRightArrowInVisibleLine:visLineNr
- "draw a right arrow (for submenus).
- This method is not used here, but provided for subclasses such
- as menus or file-lists."
-
- |y x form form2 topLeftColor botRightColor t|
-
- x := width - 16.
- y := (self yOfVisibleLine:visLineNr).
-
- device depth == 1 ifTrue:[
- form := self class rightArrowFormOn:device.
- y := y + ((font height - form height) // 2).
- self foreground:Black.
- self displayForm:form x:x y:y.
- ] ifFalse:[
- smallArrow ifTrue:[
- form := self class smallRightArrowLightFormOn:device.
- form2 := self class smallRightArrowShadowFormOn:device.
- ] ifFalse:[
- form := self class rightArrowLightFormOn:device.
- form2 := self class rightArrowShadowFormOn:device.
- ].
- y := y + ((font height - form height) // 2).
-
- topLeftColor := lightColor.
- botRightColor := shadowColor.
-
- "openwin arrow stays down"
- style ~~ #openwin ifTrue:[
- (self isInSelection:(self visibleLineToListLine:visLineNr)) ifTrue:[
- t := topLeftColor.
- topLeftColor := botRightColor.
- botRightColor := t.
- ]
- ].
- arrowLevel < 0 ifTrue:[
- t := topLeftColor.
- topLeftColor := botRightColor.
- botRightColor := t.
- ].
-
-"/ self foreground:topLeftColor.
-self paint:topLeftColor.
- self displayForm:form x:x y:y.
-"/ self foreground:botRightColor.
-self paint:botRightColor.
- self displayForm:form2 x:x y:y.
- ]
-!
-
redrawElement:aNumber
"redraw an individual element"
^ self redrawLine:aNumber
!
-redrawVisibleLine:visLineNr col:colNr
- "redraw a single character.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr col:colNr
-!
-
-redrawVisibleLine:visLineNr from:startCol
- "redraw from a col to the right end.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr from:startCol
-!
-
-redrawVisibleLine:visLineNr from:startCol to:endCol
- "redraw from a startCol to endCol.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr from:startCol to:endCol
-!
-
-redrawFromVisibleLine:startVisLineNr to:endVisLineNr
- "redraw a range of lines.
- Must check, if any is in the selection and handle this case.
- Otherwise draw it en-bloque using supers method."
-
- |special sel
- selNo "{ Class: SmallInteger }" |
-
- ((selection isCollection) or:[listAttributes notNil]) ifTrue:[
- startVisLineNr to:endVisLineNr do:[:visLine |
- self redrawVisibleLine:visLine
- ].
- ^ self
- ].
-
-"XXX only if -1/+1"
-"/ hilightLevel ~~ 0 ifTrue:[
-"/ self paint:bgColor.
-"/ self fillRectangleX:0 y:(self yOfVisibleLine:startVisLineNr)-1 width:width height:1
-"/ ].
- special := true.
- selection isNil ifTrue:[
- special := false
- ] ifFalse:[
- sel := self listLineToVisibleLine:selection.
- sel isNil ifTrue:[
- special := false
- ] ifFalse:[
- special := (sel between:startVisLineNr and:endVisLineNr)
- ]
- ].
- special ifFalse:[
- ^ super redrawFromVisibleLine:startVisLineNr
- to:endVisLineNr
- ].
-
- selNo := sel.
- selNo > startVisLineNr ifTrue:[
- super redrawFromVisibleLine:startVisLineNr to:(selNo - 1)
- ].
- self redrawVisibleLine:selNo.
- selNo < endVisLineNr ifTrue:[
- super redrawFromVisibleLine:(selNo + 1) to:endVisLineNr
- ]
-!
-
redrawVisibleLine:visLineNr
"redraw a single line.
Must check, if any is in the selection and handle this case.
@@ -1466,17 +491,1133 @@
]
].
^ super drawVisibleLine:visLineNr with:fg and:bg
+!
+
+redrawFromVisibleLine:startVisLineNr to:endVisLineNr
+ "redraw a range of lines.
+ Must check, if any is in the selection and handle this case.
+ Otherwise draw it en-bloque using supers method."
+
+ |special sel
+ selNo "{ Class: SmallInteger }" |
+
+ ((selection isCollection) or:[listAttributes notNil]) ifTrue:[
+ startVisLineNr to:endVisLineNr do:[:visLine |
+ self redrawVisibleLine:visLine
+ ].
+ ^ self
+ ].
+
+"XXX only if -1/+1"
+"/ hilightLevel ~~ 0 ifTrue:[
+"/ self paint:bgColor.
+"/ self fillRectangleX:0 y:(self yOfVisibleLine:startVisLineNr)-1 width:width height:1
+"/ ].
+ special := true.
+ selection isNil ifTrue:[
+ special := false
+ ] ifFalse:[
+ sel := self listLineToVisibleLine:selection.
+ sel isNil ifTrue:[
+ special := false
+ ] ifFalse:[
+ special := (sel between:startVisLineNr and:endVisLineNr)
+ ]
+ ].
+ special ifFalse:[
+ ^ super redrawFromVisibleLine:startVisLineNr
+ to:endVisLineNr
+ ].
+
+ selNo := sel.
+ selNo > startVisLineNr ifTrue:[
+ super redrawFromVisibleLine:startVisLineNr to:(selNo - 1)
+ ].
+ self redrawVisibleLine:selNo.
+ selNo < endVisLineNr ifTrue:[
+ super redrawFromVisibleLine:(selNo + 1) to:endVisLineNr
+ ]
+!
+
+drawRightArrowInVisibleLine:visLineNr
+ "draw a right arrow (for submenus).
+ This method is not used here, but provided for subclasses such
+ as menus or file-lists."
+
+ |y x form form2 topLeftColor botRightColor t|
+
+ x := width - 16.
+ y := (self yOfVisibleLine:visLineNr).
+
+ device depth == 1 ifTrue:[
+ form := self class rightArrowFormOn:device.
+ y := y + ((font height - form height) // 2).
+ self foreground:Black.
+ self displayForm:form x:x y:y.
+ ] ifFalse:[
+ smallArrow ifTrue:[
+ form := self class smallRightArrowLightFormOn:device.
+ form2 := self class smallRightArrowShadowFormOn:device.
+ ] ifFalse:[
+ form := self class rightArrowLightFormOn:device.
+ form2 := self class rightArrowShadowFormOn:device.
+ ].
+ y := y + ((font height - form height) // 2).
+
+ topLeftColor := lightColor.
+ botRightColor := shadowColor.
+
+ "openwin arrow stays down"
+ style ~~ #openwin ifTrue:[
+ (self isInSelection:(self visibleLineToListLine:visLineNr)) ifTrue:[
+ t := topLeftColor.
+ topLeftColor := botRightColor.
+ botRightColor := t.
+ ]
+ ].
+ arrowLevel < 0 ifTrue:[
+ t := topLeftColor.
+ topLeftColor := botRightColor.
+ botRightColor := t.
+ ].
+
+"/ self foreground:topLeftColor.
+self paint:topLeftColor.
+ self displayForm:form x:x y:y.
+"/ self foreground:botRightColor.
+self paint:botRightColor.
+ self displayForm:form2 x:x y:y.
+ ]
+!
+
+redrawVisibleLine:visLineNr col:colNr
+ "redraw a single character.
+ Must check, if its in the selection and handle this case."
+
+ (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
+ ^ self redrawVisibleLine:visLineNr
+ ].
+ super redrawVisibleLine:visLineNr col:colNr
+!
+
+redrawVisibleLine:visLineNr from:startCol to:endCol
+ "redraw from a startCol to endCol.
+ Must check, if its in the selection and handle this case."
+
+ (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
+ ^ self redrawVisibleLine:visLineNr
+ ].
+ super redrawVisibleLine:visLineNr from:startCol to:endCol
+!
+
+redrawVisibleLine:visLineNr from:startCol
+ "redraw from a col to the right end.
+ Must check, if its in the selection and handle this case."
+
+ (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
+ ^ self redrawVisibleLine:visLineNr
+ ].
+ super redrawVisibleLine:visLineNr from:startCol
+! !
+
+!SelectionInListView methodsFor:'selections'!
+
+selectWithoutScroll:aNumberOrNil
+ "select line, aNumber or deselect if argument is nil"
+
+ |prevSelection newSelection|
+
+ newSelection := aNumberOrNil.
+ newSelection notNil ifTrue:[
+ (self isValidSelection:newSelection) ifFalse:[
+ newSelection := nil
+ ]
+ ].
+
+ (newSelection == selection) ifTrue: [^ self].
+
+ selection notNil ifTrue: [
+ prevSelection := selection.
+ selection := nil.
+ (prevSelection isCollection) ifTrue:[
+ prevSelection do:[:line |
+ self redrawElement:line
+ ]
+ ] ifFalse:[
+ self redrawElement:prevSelection
+ ]
+ ].
+ selection := newSelection.
+ (selection isCollection) ifTrue:[
+ selection do:[:line |
+ self redrawElement:line
+ ]
+ ] ifFalse:[
+ self redrawElement:selection
+ ]
+
+!
+
+selection:aNumberOrNil
+ "select line, aNumber or deselect if argument is nil;
+ scroll to make the selected line visible"
+
+ self selectWithoutScroll:aNumberOrNil.
+ selection notNil ifTrue:[
+"/ shown ifTrue:[
+ (selection isCollection) ifTrue:[
+ self makeLineVisible:selection first.
+ ] ifFalse:[
+ self makeLineVisible:selection
+ ].
+"/ ]
+ ]
+
+!
+
+isInSelection:aNumber
+ "return true, if line, aNumber is in the selection"
+
+ selection isNil ifTrue:[^ false].
+ selection isCollection ifTrue:[
+ ^ (selection includes:aNumber)
+ ].
+ ^ (aNumber == selection)
+!
+
+toggleSelect:aBoolean
+ "turn on/off toggle select"
+
+ toggleSelect := aBoolean.
+!
+
+multipleSelectOk:aBoolean
+ "allow/disallow multiple selections"
+
+ multipleSelectOk := aBoolean.
+ aBoolean ifTrue:[
+ self enableButtonMotionEvents
+ ] ifFalse:[
+ self disableButtonMotionEvents
+ ]
+!
+
+selectConditionBlock:aBlock
+ "set the conditionBlock; this block is evaluated before a selection
+ change is performed; the change will not be done, if the evaluation
+ returns false. For example, this allows confirmation queries in
+ the SystemBrowser"
+
+ selectConditionBlock := aBlock
+!
+
+strikeOut:aBoolean
+ "turn on/off strikeOut mode"
+
+ strikeOut := aBoolean.
+!
+
+selection
+ "return the selection line nr or collection of line numbers"
+
+ ^ selection
+!
+
+ignoreReselect:aBoolean
+ "set/clear the ignoreReselect flag -
+ if set, a click on an already selected entry is ignored.
+ Otherwise the notification is done, even if no
+ change in the selection occurs.
+ (for example, in browser to update a method)"
+
+ ignoreReselect := aBoolean
+!
+
+enable
+ "enable selections"
+
+ enabled := true
+!
+
+disable
+ "disable selections"
+
+ enabled := false
+!
+
+selectionValue
+ "return the selection value i.e. the text in the selected line.
+ For multiple selections a collection containing the entries is returned."
+
+ selection isNil ifTrue:[^ nil].
+ (selection isCollection) ifTrue:[
+ ^ selection collect:[:nr | self at:nr]
+ ].
+ ^ self at:selection
+
+!
+
+numberOfSelections
+ "return the number of selected entries"
+
+ |sz|
+
+ selection isNil ifTrue:[^ 0].
+ sz := selection size.
+ sz > 0 ifTrue:[^ sz].
+ ^ 1
+!
+
+hasSelection
+ "return true, if the view has a selection"
+
+ ^ selection notNil
+!
+
+deselectWithoutRedraw
+ "deselect - no redraw"
+
+ selection := nil
+!
+
+deselect
+ "deselect"
+
+ self selection:nil
+!
+
+selectElement:anObject
+ "select the element with same printString as the argument, anObject.
+ Scroll to make the new selection visible."
+
+ |lineNo|
+
+ list notNil ifTrue:[
+ lineNo := list indexOf:(anObject printString) ifAbsent:[].
+ lineNo notNil ifTrue:[self selection:lineNo]
+ ]
+!
+
+valueIsInSelection:someString
+ "return true, if someString is in the selection"
+
+ |sel|
+
+ selection isNil ifTrue:[^ false].
+ sel := self selectionValue.
+ self numberOfSelections > 1 ifTrue:[
+ ^ (sel includes:someString)
+ ].
+ ^ (someString = sel)
+!
+
+selectElementWithoutScroll:anObject
+ "select the element with same printString as the argument, anObject.
+ Do not scroll."
+
+ |lineNo|
+
+ list notNil ifTrue:[
+ lineNo := list indexOf:(anObject printString) ifAbsent:[].
+ lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
+ ]
+!
+
+selectAll
+ "select all entries."
+
+ selection := OrderedCollection withAll:(1 to:self size).
+ shown ifTrue:[self redraw].
+ self selectionChanged.
+
+!
+
+addElementToSelection:anObject
+ "add the element with the same printstring as the argument, anObject
+ to the selection. The entry is searched by comparing printStrings.
+ No scrolling is done. Returns true, if ok, false if no such entry
+ was found."
+
+ |lineNo str|
+
+ str := anObject printString.
+ lineNo := list findFirst:[:entry | str = entry printString].
+ lineNo ~~ 0 ifTrue:[
+ self addToSelection:lineNo.
+ ^ true
+ ].
+ ^ false
+!
+
+addToSelection:aNumber
+ "add entry, aNumber to the selection. No scrolling is done."
+
+ (self isValidSelection:aNumber) ifFalse:[^ self].
+
+ selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
+ selection isCollection ifTrue:[
+ (selection includes:aNumber) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection add:aNumber
+ ] ifFalse:[
+ (aNumber == selection) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection := OrderedCollection with:selection with:aNumber
+ ].
+ self redrawElement:aNumber
+!
+
+removeFromSelection:aNumber
+ "remove entry, aNumber from the selection."
+
+ selection isNil ifTrue:[^ self].
+
+ selection isCollection ifTrue:[
+ (selection includes:aNumber) ifFalse:[^ self].
+ selection remove:aNumber.
+ selection size == 1 ifTrue:[
+ selection := selection first
+ ] ifFalse:[
+ selection size == 0 ifTrue:[
+ selection := nil
+ ]
+ ]
+ ] ifFalse:[
+ (aNumber == selection) ifFalse:[^ self].
+ selection := nil
+ ].
+ self redrawElement:aNumber
+!
+
+nextAfterSelection
+ "return the number of the next selectable entry after the selection.
+ Wrap at end."
+
+ |next|
+
+ selection isNil ifTrue:[
+ next := firstLineShown
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ next := selection max + 1
+ ] ifFalse:[
+ next := selection + 1
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next > self size ifTrue:[
+ next := 1.
+ ] ifFalse:[
+ [next <= self size
+ and:[(self isValidSelection:next) not]] whileTrue:[
+ next := next + 1
+ ].
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next := nil
+ ].
+ ^ next
+
+
+!
+
+previousBeforeSelection
+ "return the number of the previous selectable entry before the selection.
+ Wrap at beginning."
+
+ |prev|
+
+ selection isNil ifTrue:[
+ prev := firstLineShown - 1
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ prev := selection min - 1
+ ] ifFalse:[
+ prev := selection - 1
+ ].
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev < 1 ifTrue:[
+ prev := self size.
+ ] ifFalse:[
+ [prev >= 1
+ and:[(self isValidSelection:prev) not]] whileTrue:[
+ prev := prev - 1
+ ].
+ ].
+ ].
+ (self isValidSelection:prev) ifFalse:[
+ prev := nil
+ ].
+ ^ prev
+
+!
+
+toggleSelection:aNumber
+ "toggle selection-state of entry, aNumber"
+
+ (self isInSelection:aNumber) ifTrue:[
+ self removeFromSelection:aNumber
+ ] ifFalse:[
+ self addToSelection:aNumber
+ ]
+!
+
+selectNext
+ "select next line or first visible if there is currrently no selection.
+ Wrap at end."
+
+ self selection:(self nextAfterSelection)
+!
+
+selectPrevious
+ "select previous line or previous visible if there is currently no selection.
+ Wrap at beginning."
+
+ self selection:(self previouseBeforeSelection).
+!
+
+selectionDo:aBlock
+ "perform aBlock for each nr in the selection.
+ For single selection, it is called once for the items nr.
+ For multiple selections, it is called for each."
+
+ |sz|
+
+ selection isNil ifTrue:[^ self].
+ sz := selection size.
+ sz > 0 ifTrue:[
+ selection do:aBlock
+ ] ifFalse:[
+ aBlock value:selection
+ ].
+!
+
+selectionChanged
+ "selection has changed. Call actionblock if defined"
+
+ |arg|
+
+ useIndex == false ifTrue:[
+ printItems ifFalse:[
+ arg := self selectionValue
+ ] ifTrue:[
+ arg := items at:selection
+ ]
+ ] ifFalse:[
+ "true or nil - strange"
+ arg := selection
+ ].
+ "
+ the ST/X way of doing things - perform actionBlock
+ "
+ actionBlock notNil ifTrue:[actionBlock value:arg].
+ "
+ the ST-80 way of doing things - notify model via changeSymbol
+ "
+ self sendChangeMessageWith:arg
+!
+
+selectionAsCollection
+ "return the selection as a collection of line numbers"
+
+ selection size = 0 ifTrue:[
+ selection isNil ifTrue:[^ #()].
+ ^ (OrderedCollection new) add:selection; yourself.
+ ] ifFalse:[
+ ^ selection
+ ].
+! !
+
+!SelectionInListView methodsFor:'accessing'!
+
+line:lineNr hasAttribute:aSymbol
+ "return true, if line nr has attribute, aSymbol;
+ currently supported attributes are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |attr|
+
+ (lineNr > listAttributes size) ifTrue:[^ false].
+ attr := listAttributes at:lineNr.
+ attr isNil ifTrue:[^ false].
+ attr isSymbol ifTrue:[^ attr == aSymbol].
+ ^ (attr includes:aSymbol)
+!
+
+contents:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes."
+
+ selection := nil.
+ listAttributes := nil.
+ super contents:aCollection.
+!
+
+attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
+ "set a lines attribute(s);
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ (index > self size) ifFalse:[
+ listAttributes isNil ifTrue:[
+ listAttributes := (OrderedCollection new:index) grow:index
+ ] ifFalse:[
+ (index > listAttributes size) ifTrue:[
+ listAttributes grow:index
+ ]
+ ].
+ aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
+ listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
+ self redrawLine:index
+ ]
+ ]
+
+!
+
+setList:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes.
+ No redraw is done - the caller should make sure to redraw afterwards
+ (or use this only before the view is visible)."
+
+ selection := nil.
+ listAttributes := nil.
+ super setList:aCollection.
+!
+
+list:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes."
+
+ "somewhat of a kludge: if selection is first line,
+ we have to remove the highlight frame by hand here"
+
+ (shown and:[hilightLevel ~~ 0]) ifTrue:[
+ selection == firstLineShown ifTrue:[
+ self paint:bgColor.
+ self fillRectangleX:margin y:margin
+ width:(width - (margin * 2))
+ height:(hilightLevel abs).
+ ].
+ ].
+
+ selection := nil.
+ listAttributes := nil.
+ super list:aCollection.
+!
+
+setAttributes:aList
+ "set the attribute list.
+ No redraw is done - the caller should make sure to redraw afterwards
+ (or use this only before the view is visible)."
+
+ listAttributes := aList
+!
+
+keyActionStyle:aSymbol
+ "defines how the view should respond to alpha-keys pressed.
+ Possible values are:
+ #select -> will select next entry starting with that
+ character and perform the click-action
+
+ #selectAndDoubleclick -> will select next & perform double-click action
+
+ #pass -> will pass key to superclass (i.e. no special treatment)
+
+ nil -> will ignore key
+
+ the default (set in #initialize) is #select
+ "
+
+ keyActionStyle := aSymbol
+!
+
+attributeAt:index
+ "return the line attribute of list line index.
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ listAttributes isNil ifFalse:[
+ (index > listAttributes size) ifFalse:[
+ ^ listAttributes at:index
+ ]
+ ].
+ ^ nil
+!
+
+action:aBlock
+ "set the action block to be performed on select"
+
+ actionBlock := aBlock
+!
+
+attributeAt:index add:aSymbolOrCollectionOfSymbols
+ "add to a lines attribute(s);
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |current|
+
+ current := self attributeAt:index.
+ current isNil ifTrue:[
+ current := Set new.
+ ] ifFalse:[
+ current isSymbol ifTrue:[
+ current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
+ current := Set with:current
+ ]
+ ].
+
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current := current add:aSymbolOrCollectionOfSymbols
+ ] ifFalse:[
+ (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
+ current addAll:aSymbolOrCollectionOfSymbols
+ ].
+ self attributeAt:index put:current
+!
+
+doubleClickAction:aBlock
+ "set the double click action block to be performed on select"
+
+ doubleClickActionBlock := aBlock
+!
+
+attributeAt:index remove:aSymbolOrCollectionOfSymbols
+ "remove a line attribute;
+ currently supported are:
+ #halfIntensity
+ #disabled
+ #bold
+ "
+
+ |current|
+
+ current := self attributeAt:index.
+ current isNil ifTrue:[^ self].
+ current isSymbol ifTrue:[
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
+ ] ifFalse:[
+ (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
+ current := nil
+ ]
+ ]
+ ] ifFalse:[
+ aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
+ current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
+ ] ifFalse:[
+ aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
+ ]
+ ].
+ self attributeAt:index put:current
+!
+
+removeIndexWithoutRedraw:lineNr
+ "delete line - no redraw;
+ return true, if something was really deleted.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndexWithoutRedraw:lineNr
+!
+
+removeIndex:lineNr
+ "delete line - with redraw.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndex:lineNr
+!
+
+add:aValue beforeIndex:index
+ "must recompute our current selections"
+
+ selection notNil ifTrue:[
+ selection size = 0 ifTrue:[
+ selection >= index ifTrue:[
+ selection := selection + 1.
+ ].
+ ] ifFalse:[
+ selection := selection collect:[ :sel |
+ sel >= index ifTrue:[
+ sel + 1
+ ] ifFalse:[
+ sel
+ ]
+ ].
+ ].
+ ].
+ ^ super add:aValue beforeIndex:index.
+! !
+
+!SelectionInListView methodsFor:'accessing-mvc'!
+
+on:aModel printItems:print oneItem:one aspect:aspect change:change
+ list:list menu:menu initialSelection:initial useIndex:use
+
+ "ST-80 compatibility"
+
+ aspectSymbol := aspect.
+ changeSymbol := change.
+ listSymbol := list.
+ menuSymbol := menu.
+ initialSelectionSymbol := initial.
+ printItems := print.
+ oneItem := one.
+ useIndex := use.
+ self model:aModel.
+
+ listSymbol notNil ifTrue:[
+ self getListFromModel
+ ].
+! !
+
+!SelectionInListView methodsFor:'private'!
+
+isValidSelection:aNumber
+ "return true, if aNumber is ok for a selection lineNo"
+
+ aNumber isNil ifTrue:[^ false].
+ (aNumber isCollection) ifTrue:[
+ (multipleSelectOk or:[aNumber size = 1]) ifFalse:[^ false].
+ aNumber do:[ :line |
+ (line between:1 and:self size) ifFalse:[^ false].
+ ].
+ ^ true.
+ ] ifFalse:[
+ ^ (aNumber between:1 and:self size).
+ ].
+
+!
+
+widthForScrollBetween:start and:end
+ "has to be redefined since WHOLE line is inverted/modified sometimes"
+
+ | anySelectionInRange |
+
+ selection notNil ifTrue:[
+ selection isCollection ifTrue:[
+ anySelectionInRange := false.
+ selection do:[:s |
+ (s between:start and:end) ifTrue:[
+ anySelectionInRange := true
+ ]
+ ]
+ ] ifFalse:[
+ anySelectionInRange := selection between:start and:end
+ ]
+ ] ifFalse:[
+ anySelectionInRange := false
+ ].
+
+ anySelectionInRange ifTrue:[
+ ^ width
+"
+ self is3D ifFalse:[
+ ^ width
+ ].
+ ( #(next openwin) includes:style) ifTrue:[
+ ^ width
+ ].
+ viewBackground = background ifFalse:[
+ ^ width
+ ]
+"
+ ].
+ ^ super widthForScrollBetween:start and:end
+!
+
+positionToSelectionX:x y:y
+ "given a click position, return the selection lineNo"
+
+ |visibleLine|
+
+ (x between:0 and:width) ifTrue:[
+ (y between:0 and:height) ifTrue:[
+ visibleLine := self visibleLineOfY:y.
+ ^ self visibleLineToListLine:visibleLine
+ ]
+ ].
+ ^ nil
+!
+
+visibleLineNeedsSpecialCare:visLineNr
+ |listLine|
+
+ listLine := self visibleLineToListLine:visLineNr.
+ listLine isNil ifTrue:[^ false].
+ (self isInSelection:listLine) ifTrue:[^ true].
+ listAttributes notNil ifTrue:[
+ (listLine <= listAttributes size) ifTrue:[
+ ^ (listAttributes at:listLine) notNil
+ ]
+ ].
+ ^ false
+!
+
+checkRemovingSelection:lineNr
+ "when a line is removed, we have to adjust selection"
+
+ |newSelection|
+
+ selection notNil ifTrue:[
+ (selection size > 0) ifTrue:[
+ newSelection := OrderedCollection new.
+ selection do:[:sel |
+ sel < lineNr ifTrue:[
+ newSelection add:sel
+ ] ifFalse:[
+ sel > lineNr ifTrue:[
+ newSelection add:(sel - 1)
+ ]
+ "otherwise remove it from the selection"
+ ]
+ ].
+ newSelection size == 1 ifTrue:[
+ selection := newSelection first
+ ] ifFalse:[
+ newSelection size == 0 ifTrue:[
+ selection := nil
+ ] ifFalse:[
+ selection := newSelection
+ ]
+ ]
+ ] ifFalse:[
+ selection == lineNr ifTrue:[
+ selection := nil
+ ] ifFalse:[
+ selection > lineNr ifTrue:[
+ selection := selection - 1
+ ]
+ ]
+ ]
+ ]
+!
+
+scrollSelectDown
+ "auto scroll action; scroll and reinstall timed-block"
+
+ self scrollDown.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+scrollSelectUp
+ "auto scroll action; scroll and reinstall timed-block"
+
+ self scrollUp.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+getListFromModel
+ |text|
+
+ listSymbol notNil ifTrue:[
+ items := model perform:listSymbol.
+ items notNil ifTrue:[
+ printItems ifTrue:[
+ text := items collect:[:element | element printString]
+ ] ifFalse:[
+ text := items
+ ].
+ text notNil ifTrue:[
+ text := text asStringCollection.
+ ]
+ ].
+ self list:text
+ ].
+! !
+
+!SelectionInListView methodsFor:'initialization'!
+
+initCursor
+ "set the cursor - a hand"
+
+ cursor := Cursor hand
+!
+
+realize
+ super realize.
+ selection notNil ifTrue:[
+ self makeLineVisible:selection
+ ]
+!
+
+initialize
+ super initialize.
+
+ fontHeight := font height + lineSpacing.
+ enabled := true.
+ multipleSelectOk := false.
+ ignoreReselect := true.
+ toggleSelect := false.
+ strikeOut := false.
+ keyActionStyle := #select.
+!
+
+initStyle
+ |nm|
+
+ super initStyle.
+
+ DefaultFont notNil ifTrue:[
+ font := DefaultFont on:device
+ ].
+
+ bgColor := viewBackground.
+ hilightFrameColor := nil.
+ hilightLevel := 0.
+ arrowLevel := 1.
+ smallArrow := false.
+
+ device hasGreyscales ifTrue:[
+ "
+ must get rid of these hard codings
+ "
+ nm := StyleSheet name asSymbol.
+ (nm == #next) ifTrue:[
+ hilightFgColor := fgColor.
+ hilightBgColor := White.
+ hilightFrameColor := fgColor
+ ] ifFalse:[
+ (nm == #motif) ifTrue:[
+ fgColor := White.
+ bgColor := Grey.
+ viewBackground := bgColor.
+ hilightFgColor := bgColor "fgColor" "White".
+ hilightBgColor := fgColor "bgColor lightened" "darkened".
+ ] ifFalse:[
+ (nm == #openwin) ifTrue:[
+ hilightFgColor := fgColor.
+ hilightBgColor := Color grey.
+ smallArrow := true.
+ ]
+ ]
+ ]
+ ].
+
+ hilightFgColor isNil ifTrue:[
+ hilightFgColor := bgColor.
+ ].
+ hilightBgColor isNil ifTrue:[
+ hilightBgColor := fgColor.
+ ].
+ DefaultForegroundColor notNil ifTrue:[
+ fgColor := DefaultForegroundColor
+ ].
+ DefaultBackgroundColor notNil ifTrue:[
+ bgColor := viewBackground := DefaultBackgroundColor
+ ].
+ DefaultHilightForegroundColor notNil ifTrue:[
+ hilightFgColor := DefaultHilightForegroundColor
+ ].
+ DefaultHilightBackgroundColor notNil ifTrue:[
+ hilightBgColor := DefaultHilightBackgroundColor
+ ].
+ DefaultHilightFrameColor notNil ifTrue:[
+ hilightFrameColor := DefaultHilightFrameColor
+ ].
+ DefaultHilightLevel notNil ifTrue:[
+ hilightLevel := DefaultHilightLevel
+ ].
+ DefaultRightArrowLevel notNil ifTrue:[
+ arrowLevel := DefaultRightArrowLevel
+ ].
+
+ DefaultShadowColor notNil ifTrue:[
+ shadowColor := DefaultShadowColor on:device
+ ].
+ DefaultLightColor notNil ifTrue:[
+ lightColor := DefaultLightColor on:device
+ ].
+
+ (hilightLevel abs > 0) ifTrue:[
+ lineSpacing := 3
+ ] ifFalse:[
+ lineSpacing := 2
+ ].
+
+ hilightFgColor isNil ifTrue:[
+ hilightFgColor := bgColor.
+ hilightBgColor := fgColor
+ ].
+
+ DefaultDisabledForegroundColor notNil ifTrue:[
+ halfIntensityFgColor := DefaultDisabledForegroundColor
+ ] ifFalse:[
+ halfIntensityFgColor := Color darkGrey.
+ ].
+
+ fgColor := fgColor on:device.
+ bgColor := bgColor on:device.
+ halfIntensityFgColor := halfIntensityFgColor on:device.
+ hilightFrameColor notNil ifTrue:[hilightFrameColor := hilightFrameColor on:device].
+ hilightFgColor := hilightFgColor on:device.
+ hilightBgColor := hilightBgColor on:device.
! !
!SelectionInListView methodsFor:'event handling'!
+buttonPress:button x:x y:y
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ enabled ifTrue:[
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (toggleSelect
+ and:[self isInSelection:listLineNr]) ifTrue:[
+ oldSelection := selection copy.
+ self removeFromSelection:listLineNr
+ ] ifFalse:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
+
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
+
+ (toggleSelect and:[multipleSelectOk]) ifTrue:[
+ oldSelection := selection copy.
+ self addToSelection:listLineNr
+ ] ifFalse:[
+ oldSelection := selection copy.
+ self selectWithoutScroll:listLineNr.
+ ].
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ self selectionChanged.
+ ].
+ clickLine := listLineNr
+ ].
+ ]
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+!
+
sizeChanged:how
"if there is a selection, make certain, its visible
after the sizechange"
|first wasAtEnd|
- wasAtEnd := (firstLineShown + nFullLinesShown) >= list size.
+ wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
super sizeChanged:how.
@@ -1501,6 +1642,14 @@
]
]
]
+
+
+!
+
+buttonRelease:button x:x y:y
+ "stop any autoscroll"
+
+ self stopAutoScroll
!
key:key select:selectAction x:x y:y
@@ -1511,7 +1660,7 @@
^ super keyPress:key x:x y:y
].
selectAction value.
- actionBlock notNil ifTrue:[actionBlock value:selection].
+ self selectionChanged.
keyActionStyle == #selectAndDoubleClick ifTrue:[
doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
]
@@ -1549,7 +1698,7 @@
^ self
].
(key == #End) ifTrue:[
- index := list size.
+ index := self size.
(selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
self key:key select:[self selection:index] x:x y:y
].
@@ -1567,7 +1716,7 @@
alphabetic keys: search for next entry
starting with keys character. If shift is pressed, search backward
"
- (list size > 0
+ (self size > 0
and:[key isCharacter
and:[key isLetter]]) ifTrue:[
keyActionStyle isNil ifTrue:[^ self].
@@ -1590,10 +1739,10 @@
startSearch := selection - 1
]
] ifFalse:[
- startSearch := list size
+ startSearch := self size
].
startSearch < 1 ifTrue:[
- startSearch := list size.
+ startSearch := self size.
].
] ifFalse:[
selection notNil ifTrue:[
@@ -1605,22 +1754,22 @@
] ifFalse:[
startSearch := 1
].
- startSearch > list size ifTrue:[
+ startSearch > self size ifTrue:[
startSearch := 1.
].
].
index := startSearch.
[true] whileTrue:[
- (((list at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
+ (((self at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
index = selection ifTrue:[^ self].
^ self key:key select:[self selection:index] x:x y:y
].
backSearch ifTrue:[
index := index - 1.
- index < 1 ifTrue:[index := list size]
+ index < 1 ifTrue:[index := self size]
] ifFalse:[
index := index + 1.
- index > list size ifTrue:[index := 1].
+ index > self size ifTrue:[index := 1].
].
index == startSearch ifTrue:[
^ self
@@ -1629,54 +1778,18 @@
].
].
^ super keyPress:key x:x y:y
+
!
-buttonPress:button x:x y:y
- |oldSelection listLineNr arg|
-
+buttonMultiPress:button x:x y:y
((button == 1) or:[button == #select]) ifTrue:[
- enabled ifTrue:[
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (toggleSelect
- and:[self isInSelection:listLineNr]) ifTrue:[
- oldSelection := selection copy.
- self removeFromSelection:listLineNr
- ] ifFalse:[
- (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
-
- (toggleSelect and:[multipleSelectOk]) ifTrue:[
- oldSelection := selection copy.
- self addToSelection:listLineNr
- ] ifFalse:[
- oldSelection := selection copy.
- self selectWithoutScroll:listLineNr.
- ].
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- "
- the ST/X way of doing things - perform actionBlock
- "
- actionBlock notNil ifTrue:[actionBlock value:selection].
- "
- the ST-80 way of doing things - notify model via changeSymbol
- "
- useIndex == true ifTrue:[
- arg := selection
- ] ifFalse:[
- arg := self selectionValue
- ].
- self sendChangeMessageWith:arg
- ].
- clickLine := listLineNr
- ].
+ doubleClickActionBlock isNil ifTrue:[
+ self buttonPress:button x:x y:y
+ ] ifFalse:[
+ doubleClickActionBlock value:selection
]
] ifFalse:[
- super buttonPress:button x:x y:y
+ super buttonMultiPress:button x:x y:y
]
!
@@ -1708,19 +1821,7 @@
]
].
(selection ~= oldSelection) ifTrue:[
- "
- the ST/X way of doing things
- "
- actionBlock notNil ifTrue:[actionBlock value:selection].
- "
- the ST-80 way of doing things
- "
- useIndex == true ifTrue:[
- arg := selection
- ] ifFalse:[
- arg := self selectionValue
- ].
- self sendChangeMessageWith:arg
+ self selectionChanged.
].
clickLine := listLineNr
]
@@ -1729,22 +1830,21 @@
]
!
-buttonMultiPress:button x:x y:y
- ((button == 1) or:[button == #select]) ifTrue:[
- doubleClickActionBlock isNil ifTrue:[
- self buttonPress:button x:x y:y
- ] ifFalse:[
- doubleClickActionBlock value:selection
- ]
- ] ifFalse:[
- super buttonMultiPress:button x:x y:y
- ]
-!
+update:something with:aParameter from:changedObject
+ |newList|
-buttonRelease:button x:x y:y
- "stop any autoscroll"
-
- self stopAutoScroll
+ changedObject == model ifTrue:[
+ (aspectSymbol notNil
+ and:[something == aspectSymbol]) ifTrue:[
+ self getListFromModel
+ ].
+ (initialSelectionSymbol notNil
+ and:[something == initialSelectionSymbol]) ifTrue:[
+ self selectElement:(model perform:initialSelectionSymbol).
+ ].
+ ^ self
+ ].
+ ^ super update:something with:aParameter from:changedObject
!
buttonMotion:buttonMask x:x y:y
@@ -1795,33 +1895,12 @@
].
((selection ~= oldSelection)
or:[selection size ~~ oldSelCount]) ifTrue:[
- actionBlock notNil ifTrue:[actionBlock value:selection]
+ self selectionChanged.
]
] ifFalse:[
self selectWithoutScroll:movedLine
].
clickLine := movedLine
-!
-update:something with:aParameter from:changedObject
- |newList|
-
- changedObject == model ifTrue:[
- (initialSelectionSymbol notNil
- and:[something == initialSelectionSymbol]) ifTrue:[
- self selectElement:(model perform:initialSelectionSymbol).
- ^ self
- ].
- (aspectSymbol notNil
- and:[something == aspectSymbol]) ifTrue:[
- newList := (model perform:listSymbol) asStringCollection.
- (newList = list) ifFalse:[
- self list:newList
- ].
- ^ self
- ].
- ^ self
- ].
- ^ super update:something with:aParameter from:changedObject
! !
--- a/Toggle.st Sat Mar 18 06:16:33 1995 +0100
+++ b/Toggle.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,18 +10,20 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:03:45 am'!
+
Button subclass:#Toggle
- instanceVariableNames:'showLamp lampColor lampWidth lampHeight'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Interactors'
+ instanceVariableNames:'showLamp lampColor lampWidth lampHeight'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
!
Toggle comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.13 1995-02-27 10:41:35 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.14 1995-03-18 05:16:19 claus Exp $
'!
!Toggle class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.13 1995-02-27 10:41:35 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.14 1995-03-18 05:16:19 claus Exp $
"
!
@@ -217,6 +219,10 @@
!Toggle methodsFor:'initialization'!
+defaultControllerClass
+ ^ ToggleController
+!
+
initStyle
super initStyle.
@@ -233,10 +239,6 @@
lampColor := StyleSheet at:#toggleLampColor default:Color yellow.
lampWidth := (device horizontalPixelPerMillimeter * 1.8) rounded.
lampHeight := (device verticalPixelPerMillimeter * 3.5) rounded.
-!
-
-defaultControllerClass
- ^ ToggleController
! !
!Toggle methodsFor:'accessing'!
@@ -268,7 +270,6 @@
]
! !
-
!Toggle methodsFor:'private'!
computeLabelOrigin
@@ -291,6 +292,30 @@
]
! !
+!Toggle methodsFor:'redrawing'!
+
+drawWith:fg and:bg
+ "redraw myself with fg/bg. Use super to draw the label,
+ drawing of the lamp is done here."
+
+ |x y clr|
+
+ super drawWith:fg and:bg. "this draws the text"
+
+ showLamp ifTrue:[
+ x := hSpace + margin.
+ y := (height - lampHeight) // 2.
+ self drawEdgesForX:x y:y width:lampWidth height:lampHeight level:-1.
+ controller pressed ifTrue:[
+ clr := lampColor.
+ ] ifFalse:[
+ clr := bgColor.
+ ].
+ self paint:clr.
+ self fillRectangleX:x+2 y:y+2 width:lampWidth - 4 height:lampHeight - 4
+ ]
+! !
+
!Toggle methodsFor:'changing state'!
toggleNoAction
@@ -319,38 +344,15 @@
|action pressed sym|
controller enabled ifTrue:[
- self toggleNoAction.
- (pressed := controller pressed) ifTrue:[
- action := controller pressAction
- ] ifFalse:[
- action := controller releaseAction
- ].
- action notNil ifTrue:[action value].
- self sendChangeMessageWith:pressed.
- self changed
+ self toggleNoAction.
+ (pressed := controller pressed) ifTrue:[
+ action := controller pressAction
+ ] ifFalse:[
+ action := controller releaseAction
+ ].
+ action notNil ifTrue:[action value].
+ self sendChangeMessageWith:pressed.
+ self changed:#toggle with:pressed
]
! !
-!Toggle methodsFor:'redrawing'!
-
-drawWith:fg and:bg
- "redraw myself with fg/bg. Use super to draw the label,
- drawing of the lamp is done here."
-
- |x y clr|
-
- super drawWith:fg and:bg. "this draws the text"
-
- showLamp ifTrue:[
- x := hSpace + margin.
- y := (height - lampHeight) // 2.
- self drawEdgesForX:x y:y width:lampWidth height:lampHeight level:-1.
- controller pressed ifTrue:[
- clr := lampColor.
- ] ifFalse:[
- clr := bgColor.
- ].
- self paint:clr.
- self fillRectangleX:x+2 y:y+2 width:lampWidth - 4 height:lampHeight - 4
- ]
-! !
--- a/VarHPanel.st Sat Mar 18 06:16:33 1995 +0100
+++ b/VarHPanel.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,7 +10,7 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:01:46'!
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:10:40 am'!
VariableVerticalPanel subclass:#VariableHorizontalPanel
instanceVariableNames:''
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.12 1995-03-06 21:05:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.13 1995-03-18 05:16:26 claus Exp $
'!
!VariableHorizontalPanel class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.12 1995-03-06 21:05:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.13 1995-03-18 05:16:26 claus Exp $
"
!
@@ -104,59 +104,6 @@
!VariableHorizontalPanel methodsFor:'private'!
-resizeSubviewsFrom:start to:stop
- "readjust size of some subviews"
-
- |step nSubviews|
-
- subViews notNil ifTrue:[
- (start <= stop) ifTrue:[
- step := 1
- ] ifFalse:[
- step := -1
- ].
- nSubviews := subViews size.
- start to:stop by:step do:[:index |
- |bw view o1 o2 relCorner relOrg newCorner newOrg|
-
- view := subViews at:index.
- bw := view borderWidth.
-
- index == 1 ifTrue:[
- o1 := 0.
- ] ifFalse:[
- o1 := barHeight // 2 - bw
- ].
- index == nSubviews ifTrue:[
- o2 := 0.
- ] ifFalse:[
- o2 := barHeight // 2 - bw
- ].
-
- relCorner := view relativeCorner.
- relCorner isNil ifTrue:[
- self error:'subview must have relative corner'
- ].
- newCorner := view cornerFromRelativeCorner.
- newCorner notNil ifTrue:[
- newCorner x:(newCorner x - o2)
- ].
-
- relOrg := view relativeOrigin.
- relOrg isNil ifTrue:[
- self error:'subview must have relative origin'
- ].
- newOrg := view originFromRelativeOrigin.
- newOrg notNil ifTrue:[
- (index ~~ 1) ifTrue:[
- newOrg x:(newOrg x + o1)
- ].
- ].
- view pixelOrigin:newOrg corner:newCorner
- ]
- ]
-!
-
handleOriginsFrom:start to:stop do:aBlock
"evaluate the argument block for some handle-origins"
@@ -192,6 +139,73 @@
]
!
+resizeSubviewsFrom:start to:stop
+ "readjust size of some subviews"
+
+ |step nSubviews|
+
+ subViews notNil ifTrue:[
+ (start <= stop) ifTrue:[
+ step := 1
+ ] ifFalse:[
+ step := -1
+ ].
+ nSubviews := subViews size.
+ start to:stop by:step do:[:index |
+ |bw view o1 o2 relCorner relOrg newCorner newOrg newExt|
+
+ view := subViews at:index.
+ bw := view borderWidth.
+
+ index == 1 ifTrue:[
+ o1 := 0.
+ ] ifFalse:[
+ o1 := barHeight // 2 - bw
+ ].
+ index == nSubviews ifTrue:[
+ o2 := 0.
+ ] ifFalse:[
+ o2 := barHeight // 2 - bw
+ ].
+
+ relCorner := view relativeCorner.
+ relCorner isNil ifTrue:[
+ self error:'subview must have relative corner'
+ ].
+ newCorner := view cornerFromRelativeCorner.
+ newCorner notNil ifTrue:[
+ newCorner x:(newCorner x - o2)
+ ].
+
+"
+ relOrg := view relativeOrigin.
+ relOrg isNil ifTrue:[
+ self error:'subview must have relative origin'
+ ].
+ newOrg := view originFromRelativeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg x:(newOrg x + o1)
+ ].
+ ].
+ view pixelOrigin:newOrg corner:newCorner
+"
+ newOrg := view computeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg x:(newOrg x + o1)
+ ].
+ ].
+ newExt := view computeExtent.
+ newExt notNil ifTrue:[
+ newExt x:(newExt x - o2 - o1)
+ ].
+
+ view pixelOrigin:newOrg extent:newExt.
+ ]
+ ]
+!
+
setupSubviewSizes
"setup subviews sizes (in case of non-relative sizes)"
@@ -217,6 +231,35 @@
x := x + w
]
]
+!
+
+setupSubviewOrigins
+ "setup subviews origins (SV 16.1.95)"
+
+ |x e|
+
+ x := 0.0.
+
+ 1 to:(subViews size) do:[:index |
+ |view|
+
+ view := subViews at:index.
+ e := view relativeExtent.
+ e notNil ifTrue:[
+ view relativeExtent:nil.
+ e := e x.
+ index == subViews size ifTrue:[
+ view origin:(x @ 0.0) corner:(1.0 @ 1.0)
+ ] ifFalse:[
+ view origin:(x @ 0.0) corner:((x+e) @ 1.0)
+ ].
+ x := x + e.
+ ] ifFalse: [
+ view origin:(x @ 0.0).
+ x := view relativeCorner x.
+ ].
+ ]
+
! !
!VariableHorizontalPanel methodsFor:'initializing'!
@@ -249,23 +292,6 @@
!VariableHorizontalPanel methodsFor:'drawing'!
-invertHandleBarAtX:hx y:hy
- self noClipByChildren.
- self xoring:[
- |x|
-
- trackLine ifTrue:[
- x := hx + (barHeight // 2).
- self displayLineFromX:x y:0 toX:x y:height.
- ] ifFalse:[
- self fillRectangleX:hx y:0 width:barHeight height:height
- ]
- ].
- self clipByChildren.
-
-
-!
-
drawHandleAtX:hx y:hy
|w x m|
@@ -338,5 +364,22 @@
].
self fillRectangleX:hx y:hy width:barHeight height:barWidth
]
+!
+
+invertHandleBarAtX:hx y:hy
+ self noClipByChildren.
+ self xoring:[
+ |x|
+
+ trackLine ifTrue:[
+ x := hx + (barHeight // 2).
+ self displayLineFromX:x y:0 toX:x y:height.
+ ] ifFalse:[
+ self fillRectangleX:hx y:0 width:barHeight height:height
+ ]
+ ].
+ self clipByChildren.
+
+
! !
--- a/VarHPanelC.st Sat Mar 18 06:16:33 1995 +0100
+++ b/VarHPanelC.st Sat Mar 18 06:16:50 1995 +0100
@@ -12,7 +12,7 @@
'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:00:05'!
-VariableVerticalPanelController subclass:#VariableHorizontalPanelController
+VariablePanelController subclass:#VariableHorizontalPanelController
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
@@ -37,130 +37,13 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VarHPanelC.st,v 1.1 1995-03-06 21:05:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarHPanelC.st,v 1.2 1995-03-18 05:16:30 claus Exp $
"
! !
-!VariableHorizontalPanelController methodsFor:'event handling'!
-
-buttonMotion:buttonMask x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |xpos limitLeft limitRight subViews barHeight|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
-
- "speedup - if there is already another movement,
- ignore thisone ... "
- view buttonMotionEventPending ifTrue:[^ self].
-
- barHeight := view barHeight.
- xpos := bx - start.
-
- "see comment in VariableVerticalPanel>>buttonMotion:x:y:"
-
-"/ limitLeft := barHeight // 2.
-"/ limitRight := self width - barHeight.
-
- limitLeft := 0.
- limitRight := view innerWidth.
-
- movedHandle > 1 ifTrue:[
- limitLeft := (subViews at:movedHandle) origin x + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitRight := (subViews at:(movedHandle + 2)) origin x - barHeight
- ].
- limitRight := limitRight - barHeight.
- (xpos < limitLeft) ifTrue:[ "check against view limits"
- xpos := limitLeft
- ] ifFalse:[
- (xpos > limitRight) ifTrue:[
- xpos := limitRight
- ]
- ].
-
- view invertHandleBarAtX:prev y:0.
- view invertHandleBarAtX:xpos y:0.
-
- prev := xpos
-
-
-!
-
-buttonRelease:button x:x y:y
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex newX oldX group subViews|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
-
- (group := view windowGroup) notNil ifTrue:[
- group restoreCursors
- ].
-
- "undo the last xor"
+!VariableHorizontalPanelController methodsFor:'initialization'!
- view invertHandleBarAtX:prev y:0.
-
- "compute the new relative heights"
-
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- movedHandle := nil.
- subViews := view subViews.
-
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- oldX := aboveView relativeCorner x.
- newX := (prev + start / view width) asFloat.
- aboveView relativeCorner:newX @ aboveView relativeCorner y.
- belowView relativeOrigin:newX @ belowView relativeOrigin y.
-
- view lockRedraw.
- oldX > newX ifTrue:[
- view resizeSubviewsFrom:aboveIndex to:belowIndex.
- ] ifFalse:[
- view resizeSubviewsFrom:belowIndex to:aboveIndex.
- ].
- view redrawHandlesFrom:aboveIndex to:belowIndex.
- view unlockRedraw.
- ] ifFalse:[
- super buttonRelease:button x:x y:y
- ]
-!
-
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
-
- |handle barHeight group|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- barHeight := view barHeight.
- view handleOriginsDo:[:hPoint |
- |hx|
-
- hx := hPoint x.
- (bx between:hx and:(hx + barHeight)) ifTrue:[
- movedHandle := handle.
- prev := hx.
- start := bx - hx.
-
- view invertHandleBarAtX:hx y:0.
- (group := view windowGroup) notNil ifTrue:[
- group showCursor:view cursor
- ].
- ^ self
- ].
- handle := handle + 1
- ].
- movedHandle := nil
- ] ifFalse:[
- super buttonPress:button x:bx y:by
- ]
-
+initialize
+ super initialize.
+ isHorizontal := true
! !
--- a/VarVPanel.st Sat Mar 18 06:16:33 1995 +0100
+++ b/VarVPanel.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,15 +10,15 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:01:51'!
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:10:57 am'!
View subclass:#VariableVerticalPanel
- instanceVariableNames:'barHeight barWidth separatingLine
- shadowForm lightForm showHandle handlePosition handleColor
- handleStyle noColor trackLine redrawLocked'
+ instanceVariableNames:'barHeight barWidth separatingLine shadowForm lightForm showHandle
+ handlePosition handleColor handleStyle noColor trackLine
+ redrawLocked'
classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
- DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
- DefaultCursor'
+ DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
+ DefaultCursor'
poolDictionaries:''
category:'Views-Layout'
!
@@ -27,7 +27,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.14 1995-03-06 21:06:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.15 1995-03-18 05:16:36 claus Exp $
'!
!VariableVerticalPanel class methodsFor:'documentation'!
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.14 1995-03-06 21:06:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.15 1995-03-18 05:16:36 claus Exp $
"
!
@@ -117,12 +117,6 @@
!VariableVerticalPanel class methodsFor:'defaults'!
-shadowFormOn:aDisplay
- "use same handle as Scroller"
-
- ^ Scroller handleShadowFormOn:aDisplay
-!
-
updateStyleCache
DefaultShowHandle := StyleSheet at:'variablePanelShowHandle' default:true.
DefaultHandleStyle := StyleSheet at:'variablePanelHandleStyle'.
@@ -132,6 +126,12 @@
DefaultHandleColor := StyleSheet colorAt:'variablePanelHandleColor' default:Black.
!
+shadowFormOn:aDisplay
+ "use same handle as Scroller"
+
+ ^ Scroller handleShadowFormOn:aDisplay
+!
+
lightFormOn:aDisplay
"use same handle as Scroller"
@@ -140,26 +140,6 @@
!VariableVerticalPanel methodsFor:'drawing'!
-redrawHandlesFrom:start to:stop
- "redraw some handles"
-
- subViews notNil ifTrue:[
- showHandle ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- ]
- ]
-!
-
-redraw
- "redraw all of the handles"
-
- redrawLocked ~~ true ifTrue:[
- self redrawHandlesFrom:1 to:(subViews size)
- ]
-!
-
drawHandleAtX:hx y:hy
"draw a single handle at hx/hy"
@@ -235,6 +215,18 @@
]
!
+redrawHandlesFrom:start to:stop
+ "redraw some handles"
+
+ subViews notNil ifTrue:[
+ showHandle ifTrue:[
+ self handleOriginsFrom:start to:stop do:[:hPoint |
+ self drawHandleAtX:(hPoint x) y:(hPoint y)
+ ].
+ ]
+ ]
+!
+
lockRedraw
redrawLocked := true
!
@@ -243,6 +235,14 @@
redrawLocked := false
!
+redraw
+ "redraw all of the handles"
+
+ redrawLocked ~~ true ifTrue:[
+ self redrawHandlesFrom:1 to:(subViews size)
+ ]
+!
+
invertHandleBarAtX:hx y:hy
self noClipByChildren.
self xoring:[
@@ -270,12 +270,6 @@
!VariableVerticalPanel methodsFor:'accessing'!
-barHeight
- "return the height of the separating bar"
-
- ^ barHeight
-!
-
barHeight:nPixel
"set the height of the separating bar"
@@ -292,6 +286,12 @@
]
!
+barHeight
+ "return the height of the separating bar"
+
+ ^ barHeight
+!
+
add:aView
"a view is added; make its size relative (if not already done)"
@@ -367,6 +367,11 @@
]
!
+initialize
+ super initialize.
+ noColor := Color noColor.
+!
+
initStyle
|mm|
@@ -407,9 +412,10 @@
].
!
-initialize
- super initialize.
- noColor := Color noColor.
+defaultControllerClass
+ ^ VariableVerticalPanelController
+
+
!
initCursor
@@ -432,54 +438,42 @@
].
DefaultCursor := cursor
]
-!
-
-defaultControllerClass
- ^ VariableVerticalPanelController
-
-
! !
!VariableVerticalPanel methodsFor:'private'!
-handleOriginsDo:aBlock
- "evaluate the argument block for every handle-origin"
-
- self handleOriginsFrom:1 to:(subViews size) do:aBlock
-!
-
handleOriginsFrom:start to:stop do:aBlock
"evaluate the argument block for some handle-origins"
|x hw hDelta|
subViews notNil ifTrue:[
- shadowForm notNil ifTrue:[
- hw := shadowForm width
- ] ifFalse:[
- hw := barWidth
- ].
- (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
- hDelta := barWidth // 2.
- ] ifFalse:[
- hDelta := 0
- ].
- (handlePosition == #left) ifTrue:[
- x := hDelta
- ] ifFalse:[
- (handlePosition == #right) ifTrue:[
- x := width - (1 "2" * hw) - margin - hDelta.
- ] ifFalse:[
- x := width - barWidth // 2
- ]
- ].
- (start + 1) to:stop do:[:index |
- |view y|
+ shadowForm notNil ifTrue:[
+ hw := shadowForm width
+ ] ifFalse:[
+ hw := barWidth
+ ].
+ (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
+ hDelta := barWidth // 2.
+ ] ifFalse:[
+ hDelta := 0
+ ].
+ (handlePosition == #left) ifTrue:[
+ x := hDelta
+ ] ifFalse:[
+ (handlePosition == #right) ifTrue:[
+ x := width - (1 "2" * hw) - margin - hDelta.
+ ] ifFalse:[
+ x := width - barWidth // 2
+ ]
+ ].
+ (start + 1) to:stop do:[:index |
+ |view y|
- view := subViews at:index.
- y := view origin y - barHeight + 1.
- aBlock value:(x @ y)
- ]
+ view := subViews at:index.
+ y := view top "origin y" - barHeight + 1.
+ aBlock value:(x @ y)
+ ]
]
!
@@ -489,53 +483,72 @@
|step nSubviews|
subViews notNil ifTrue:[
- (start <= stop) ifTrue:[
- step := 1
- ] ifFalse:[
- step := -1
- ].
- nSubviews := subViews size.
- start to:stop by:step do:[:index |
- |bw view o1 o2 relOrg relCorner newOrg newCorner|
+ (start <= stop) ifTrue:[
+ step := 1
+ ] ifFalse:[
+ step := -1
+ ].
+ nSubviews := subViews size.
+ start to:stop by:step do:[:index |
+ |bw view o1 o2 relOrg relCorner newOrg newCorner newExt|
- view := subViews at:index.
- bw := view borderWidth.
+ view := subViews at:index.
+ bw := view borderWidth.
- index == 1 ifTrue:[
- o1 := 0.
- ] ifFalse:[
- o1 := barHeight // 2 - bw
- ].
- index == nSubviews ifTrue:[
- o2 := 0.
- ] ifFalse:[
- o2 := barHeight // 2 - bw
- ].
+ index == 1 ifTrue:[
+ o1 := 0.
+ ] ifFalse:[
+ o1 := barHeight // 2 - bw
+ ].
+ index == nSubviews ifTrue:[
+ o2 := 0.
+ ] ifFalse:[
+ o2 := barHeight // 2 - bw
+ ].
- relCorner := view relativeCorner.
- relCorner isNil ifTrue:[
- self error:'subview must have relative corner'
- ].
- newCorner := view cornerFromRelativeCorner.
- newCorner notNil ifTrue:[
- newCorner y:(newCorner y - o2)
- ].
+"
+ relCorner := view relativeCorner.
+ relCorner isNil ifTrue:[
+ self error:'subview must have relative corner'
+ ].
+ newCorner := view cornerFromRelativeCorner.
+ newCorner notNil ifTrue:[
+ newCorner y:(newCorner y - o2)
+ ].
- relOrg := view relativeOrigin.
- relOrg isNil ifTrue:[
- self error:'subview must have relative origin'
- ].
- newOrg := view originFromRelativeOrigin.
- newOrg notNil ifTrue:[
- (index ~~ 1) ifTrue:[
- newOrg y:(newOrg y + o1)
- ].
- ].
- view pixelOrigin:newOrg corner:newCorner
- ]
+ relOrg := view relativeOrigin.
+ relOrg isNil ifTrue:[
+ self error:'subview must have relative origin'
+ ].
+ newOrg := view originFromRelativeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg y:(newOrg y + o1)
+ ].
+ ].
+ view pixelOrigin:newOrg corner:newCorner
+"
+ newOrg := view computeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg y:(newOrg y + o1)
+ ].
+ ].
+ newExt := view computeExtent.
+ newExt notNil ifTrue:[
+ newExt y:(newExt y - o2 - o1)
+ ].
+ view pixelOrigin:newOrg extent:newExt.
+ ]
]
!
+handleOriginsDo:aBlock
+ "evaluate the argument block for every handle-origin"
+
+ self handleOriginsFrom:1 to:(subViews size) do:aBlock
+!
+
anyNonRelativeSubviews
"return true, if any of my subviews has no relative origin/extent"
@@ -582,11 +595,12 @@
"tell subviews if I change size"
shown ifTrue:[
- (how == #smaller) ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size)
- ] ifFalse:[
- self resizeSubviewsFrom:(subViews size) to:1
- ]
- ]
+ (how == #smaller) ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size)
+ ] ifFalse:[
+ self resizeSubviewsFrom:(subViews size) to:1
+ ]
+ ].
+ self changed:#sizeOfView with:how.
! !
--- a/VarVPanelC.st Sat Mar 18 06:16:33 1995 +0100
+++ b/VarVPanelC.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,10 +10,10 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:00:02'!
+'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:00:05'!
-Controller subclass:#VariableVerticalPanelController
- instanceVariableNames:'movedHandle prev start'
+VariablePanelController subclass:#VariableVerticalPanelController
+ instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -37,134 +37,14 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VarVPanelC.st,v 1.1 1995-03-06 21:06:04 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanelC.st,v 1.2 1995-03-18 05:16:41 claus Exp $
"
! !
-!VariableVerticalPanelController methodsFor:'event handling'!
-
-buttonMotion:button x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |ypos limitTop limitBot subViews barHeight|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
-
- "speedup - if there is already another movement,
- ignore thisone ... "
-
- view buttonMotionEventPending ifTrue:[^ self].
-
- ypos := by - start.
-
- "
- the two lines below will not allow resizing down to zero
- (so that some is always visible)
- "
-"/ limitTop := barHeight // 2.
-"/ limitBot := self height - barHeight.
-
- "
- these allow resizing to zero - which is better ?
- "
- limitTop := 0.
- limitBot := view innerHeight.
- subViews := view subViews.
- barHeight := view barHeight.
-
- movedHandle > 1 ifTrue:[
- limitTop := (subViews at:movedHandle) origin y + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitBot := (subViews at:(movedHandle + 2)) origin y - barHeight
- ].
- limitBot := limitBot - barHeight.
- (ypos < limitTop) ifTrue:[ "check against view limits"
- ypos := limitTop
- ] ifFalse:[
- (ypos > limitBot) ifTrue:[
- ypos := limitBot
- ]
- ].
-
- view invertHandleBarAtX:0 y:prev.
- view invertHandleBarAtX:0 y:ypos.
-
- prev := ypos
-!
-
-buttonRelease:button x:x y:y
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex newY oldY group subViews|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
+!VariableVerticalPanelController methodsFor:'initialization'!
- (group := view windowGroup) notNil ifTrue:[
- group restoreCursors
- ].
-
- "undo the last xor"
-
- view invertHandleBarAtX:0 y:prev.
-
- "compute the new relative heights"
-
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- movedHandle := nil.
- subViews := view subViews.
-
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- oldY := aboveView relativeCorner y.
- newY := (prev + start / view height) asFloat.
- aboveView relativeCorner:aboveView relativeCorner x @ newY.
- belowView relativeOrigin:belowView relativeOrigin x @ newY.
+initialize
+ super initialize.
+ isHorizontal := false
+! !
- view lockRedraw.
- oldY > newY ifTrue:[
- view resizeSubviewsFrom:aboveIndex to:belowIndex.
- ] ifFalse:[
- view resizeSubviewsFrom:belowIndex to:aboveIndex.
- ].
- view redrawHandlesFrom:aboveIndex to:belowIndex.
- view unlockRedraw.
- ] ifFalse:[
- super buttonRelease:button x:x y:y
- ]
-!
-
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
-
- |handle barHeight group|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- barHeight := view barHeight.
- view handleOriginsDo:[:hPoint |
- |hy|
-
- hy := hPoint y.
- (by between:hy and:(hy + barHeight)) ifTrue:[
- movedHandle := handle.
- prev := hy.
- start := by - hy.
-
- view invertHandleBarAtX:0 y:hy.
- (group := view windowGroup) notNil ifTrue:[
- group showCursor:view cursor
- ].
- ^ self
- ].
- handle := handle + 1
- ].
- movedHandle := nil
- ] ifFalse:[
- super buttonPress:button x:bx y:by
- ]
-! !
--- a/VariableHorizontalPanel.st Sat Mar 18 06:16:33 1995 +0100
+++ b/VariableHorizontalPanel.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,7 +10,7 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:01:46'!
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:10:40 am'!
VariableVerticalPanel subclass:#VariableHorizontalPanel
instanceVariableNames:''
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.12 1995-03-06 21:05:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.13 1995-03-18 05:16:26 claus Exp $
'!
!VariableHorizontalPanel class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.12 1995-03-06 21:05:51 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.13 1995-03-18 05:16:26 claus Exp $
"
!
@@ -104,59 +104,6 @@
!VariableHorizontalPanel methodsFor:'private'!
-resizeSubviewsFrom:start to:stop
- "readjust size of some subviews"
-
- |step nSubviews|
-
- subViews notNil ifTrue:[
- (start <= stop) ifTrue:[
- step := 1
- ] ifFalse:[
- step := -1
- ].
- nSubviews := subViews size.
- start to:stop by:step do:[:index |
- |bw view o1 o2 relCorner relOrg newCorner newOrg|
-
- view := subViews at:index.
- bw := view borderWidth.
-
- index == 1 ifTrue:[
- o1 := 0.
- ] ifFalse:[
- o1 := barHeight // 2 - bw
- ].
- index == nSubviews ifTrue:[
- o2 := 0.
- ] ifFalse:[
- o2 := barHeight // 2 - bw
- ].
-
- relCorner := view relativeCorner.
- relCorner isNil ifTrue:[
- self error:'subview must have relative corner'
- ].
- newCorner := view cornerFromRelativeCorner.
- newCorner notNil ifTrue:[
- newCorner x:(newCorner x - o2)
- ].
-
- relOrg := view relativeOrigin.
- relOrg isNil ifTrue:[
- self error:'subview must have relative origin'
- ].
- newOrg := view originFromRelativeOrigin.
- newOrg notNil ifTrue:[
- (index ~~ 1) ifTrue:[
- newOrg x:(newOrg x + o1)
- ].
- ].
- view pixelOrigin:newOrg corner:newCorner
- ]
- ]
-!
-
handleOriginsFrom:start to:stop do:aBlock
"evaluate the argument block for some handle-origins"
@@ -192,6 +139,73 @@
]
!
+resizeSubviewsFrom:start to:stop
+ "readjust size of some subviews"
+
+ |step nSubviews|
+
+ subViews notNil ifTrue:[
+ (start <= stop) ifTrue:[
+ step := 1
+ ] ifFalse:[
+ step := -1
+ ].
+ nSubviews := subViews size.
+ start to:stop by:step do:[:index |
+ |bw view o1 o2 relCorner relOrg newCorner newOrg newExt|
+
+ view := subViews at:index.
+ bw := view borderWidth.
+
+ index == 1 ifTrue:[
+ o1 := 0.
+ ] ifFalse:[
+ o1 := barHeight // 2 - bw
+ ].
+ index == nSubviews ifTrue:[
+ o2 := 0.
+ ] ifFalse:[
+ o2 := barHeight // 2 - bw
+ ].
+
+ relCorner := view relativeCorner.
+ relCorner isNil ifTrue:[
+ self error:'subview must have relative corner'
+ ].
+ newCorner := view cornerFromRelativeCorner.
+ newCorner notNil ifTrue:[
+ newCorner x:(newCorner x - o2)
+ ].
+
+"
+ relOrg := view relativeOrigin.
+ relOrg isNil ifTrue:[
+ self error:'subview must have relative origin'
+ ].
+ newOrg := view originFromRelativeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg x:(newOrg x + o1)
+ ].
+ ].
+ view pixelOrigin:newOrg corner:newCorner
+"
+ newOrg := view computeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg x:(newOrg x + o1)
+ ].
+ ].
+ newExt := view computeExtent.
+ newExt notNil ifTrue:[
+ newExt x:(newExt x - o2 - o1)
+ ].
+
+ view pixelOrigin:newOrg extent:newExt.
+ ]
+ ]
+!
+
setupSubviewSizes
"setup subviews sizes (in case of non-relative sizes)"
@@ -217,6 +231,35 @@
x := x + w
]
]
+!
+
+setupSubviewOrigins
+ "setup subviews origins (SV 16.1.95)"
+
+ |x e|
+
+ x := 0.0.
+
+ 1 to:(subViews size) do:[:index |
+ |view|
+
+ view := subViews at:index.
+ e := view relativeExtent.
+ e notNil ifTrue:[
+ view relativeExtent:nil.
+ e := e x.
+ index == subViews size ifTrue:[
+ view origin:(x @ 0.0) corner:(1.0 @ 1.0)
+ ] ifFalse:[
+ view origin:(x @ 0.0) corner:((x+e) @ 1.0)
+ ].
+ x := x + e.
+ ] ifFalse: [
+ view origin:(x @ 0.0).
+ x := view relativeCorner x.
+ ].
+ ]
+
! !
!VariableHorizontalPanel methodsFor:'initializing'!
@@ -249,23 +292,6 @@
!VariableHorizontalPanel methodsFor:'drawing'!
-invertHandleBarAtX:hx y:hy
- self noClipByChildren.
- self xoring:[
- |x|
-
- trackLine ifTrue:[
- x := hx + (barHeight // 2).
- self displayLineFromX:x y:0 toX:x y:height.
- ] ifFalse:[
- self fillRectangleX:hx y:0 width:barHeight height:height
- ]
- ].
- self clipByChildren.
-
-
-!
-
drawHandleAtX:hx y:hy
|w x m|
@@ -338,5 +364,22 @@
].
self fillRectangleX:hx y:hy width:barHeight height:barWidth
]
+!
+
+invertHandleBarAtX:hx y:hy
+ self noClipByChildren.
+ self xoring:[
+ |x|
+
+ trackLine ifTrue:[
+ x := hx + (barHeight // 2).
+ self displayLineFromX:x y:0 toX:x y:height.
+ ] ifFalse:[
+ self fillRectangleX:hx y:0 width:barHeight height:height
+ ]
+ ].
+ self clipByChildren.
+
+
! !
--- a/VariableHorizontalPanelController.st Sat Mar 18 06:16:33 1995 +0100
+++ b/VariableHorizontalPanelController.st Sat Mar 18 06:16:50 1995 +0100
@@ -12,7 +12,7 @@
'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:00:05'!
-VariableVerticalPanelController subclass:#VariableHorizontalPanelController
+VariablePanelController subclass:#VariableHorizontalPanelController
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
@@ -37,130 +37,13 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanelController.st,v 1.1 1995-03-06 21:05:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanelController.st,v 1.2 1995-03-18 05:16:30 claus Exp $
"
! !
-!VariableHorizontalPanelController methodsFor:'event handling'!
-
-buttonMotion:buttonMask x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |xpos limitLeft limitRight subViews barHeight|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
-
- "speedup - if there is already another movement,
- ignore thisone ... "
- view buttonMotionEventPending ifTrue:[^ self].
-
- barHeight := view barHeight.
- xpos := bx - start.
-
- "see comment in VariableVerticalPanel>>buttonMotion:x:y:"
-
-"/ limitLeft := barHeight // 2.
-"/ limitRight := self width - barHeight.
-
- limitLeft := 0.
- limitRight := view innerWidth.
-
- movedHandle > 1 ifTrue:[
- limitLeft := (subViews at:movedHandle) origin x + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitRight := (subViews at:(movedHandle + 2)) origin x - barHeight
- ].
- limitRight := limitRight - barHeight.
- (xpos < limitLeft) ifTrue:[ "check against view limits"
- xpos := limitLeft
- ] ifFalse:[
- (xpos > limitRight) ifTrue:[
- xpos := limitRight
- ]
- ].
-
- view invertHandleBarAtX:prev y:0.
- view invertHandleBarAtX:xpos y:0.
-
- prev := xpos
-
-
-!
-
-buttonRelease:button x:x y:y
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex newX oldX group subViews|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
-
- (group := view windowGroup) notNil ifTrue:[
- group restoreCursors
- ].
-
- "undo the last xor"
+!VariableHorizontalPanelController methodsFor:'initialization'!
- view invertHandleBarAtX:prev y:0.
-
- "compute the new relative heights"
-
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- movedHandle := nil.
- subViews := view subViews.
-
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- oldX := aboveView relativeCorner x.
- newX := (prev + start / view width) asFloat.
- aboveView relativeCorner:newX @ aboveView relativeCorner y.
- belowView relativeOrigin:newX @ belowView relativeOrigin y.
-
- view lockRedraw.
- oldX > newX ifTrue:[
- view resizeSubviewsFrom:aboveIndex to:belowIndex.
- ] ifFalse:[
- view resizeSubviewsFrom:belowIndex to:aboveIndex.
- ].
- view redrawHandlesFrom:aboveIndex to:belowIndex.
- view unlockRedraw.
- ] ifFalse:[
- super buttonRelease:button x:x y:y
- ]
-!
-
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
-
- |handle barHeight group|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- barHeight := view barHeight.
- view handleOriginsDo:[:hPoint |
- |hx|
-
- hx := hPoint x.
- (bx between:hx and:(hx + barHeight)) ifTrue:[
- movedHandle := handle.
- prev := hx.
- start := bx - hx.
-
- view invertHandleBarAtX:hx y:0.
- (group := view windowGroup) notNil ifTrue:[
- group showCursor:view cursor
- ].
- ^ self
- ].
- handle := handle + 1
- ].
- movedHandle := nil
- ] ifFalse:[
- super buttonPress:button x:bx y:by
- ]
-
+initialize
+ super initialize.
+ isHorizontal := true
! !
--- a/VariableVerticalPanel.st Sat Mar 18 06:16:33 1995 +0100
+++ b/VariableVerticalPanel.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,15 +10,15 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:01:51'!
+'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:10:57 am'!
View subclass:#VariableVerticalPanel
- instanceVariableNames:'barHeight barWidth separatingLine
- shadowForm lightForm showHandle handlePosition handleColor
- handleStyle noColor trackLine redrawLocked'
+ instanceVariableNames:'barHeight barWidth separatingLine shadowForm lightForm showHandle
+ handlePosition handleColor handleStyle noColor trackLine
+ redrawLocked'
classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
- DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
- DefaultCursor'
+ DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
+ DefaultCursor'
poolDictionaries:''
category:'Views-Layout'
!
@@ -27,7 +27,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.14 1995-03-06 21:06:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.15 1995-03-18 05:16:36 claus Exp $
'!
!VariableVerticalPanel class methodsFor:'documentation'!
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.14 1995-03-06 21:06:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.15 1995-03-18 05:16:36 claus Exp $
"
!
@@ -117,12 +117,6 @@
!VariableVerticalPanel class methodsFor:'defaults'!
-shadowFormOn:aDisplay
- "use same handle as Scroller"
-
- ^ Scroller handleShadowFormOn:aDisplay
-!
-
updateStyleCache
DefaultShowHandle := StyleSheet at:'variablePanelShowHandle' default:true.
DefaultHandleStyle := StyleSheet at:'variablePanelHandleStyle'.
@@ -132,6 +126,12 @@
DefaultHandleColor := StyleSheet colorAt:'variablePanelHandleColor' default:Black.
!
+shadowFormOn:aDisplay
+ "use same handle as Scroller"
+
+ ^ Scroller handleShadowFormOn:aDisplay
+!
+
lightFormOn:aDisplay
"use same handle as Scroller"
@@ -140,26 +140,6 @@
!VariableVerticalPanel methodsFor:'drawing'!
-redrawHandlesFrom:start to:stop
- "redraw some handles"
-
- subViews notNil ifTrue:[
- showHandle ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- ]
- ]
-!
-
-redraw
- "redraw all of the handles"
-
- redrawLocked ~~ true ifTrue:[
- self redrawHandlesFrom:1 to:(subViews size)
- ]
-!
-
drawHandleAtX:hx y:hy
"draw a single handle at hx/hy"
@@ -235,6 +215,18 @@
]
!
+redrawHandlesFrom:start to:stop
+ "redraw some handles"
+
+ subViews notNil ifTrue:[
+ showHandle ifTrue:[
+ self handleOriginsFrom:start to:stop do:[:hPoint |
+ self drawHandleAtX:(hPoint x) y:(hPoint y)
+ ].
+ ]
+ ]
+!
+
lockRedraw
redrawLocked := true
!
@@ -243,6 +235,14 @@
redrawLocked := false
!
+redraw
+ "redraw all of the handles"
+
+ redrawLocked ~~ true ifTrue:[
+ self redrawHandlesFrom:1 to:(subViews size)
+ ]
+!
+
invertHandleBarAtX:hx y:hy
self noClipByChildren.
self xoring:[
@@ -270,12 +270,6 @@
!VariableVerticalPanel methodsFor:'accessing'!
-barHeight
- "return the height of the separating bar"
-
- ^ barHeight
-!
-
barHeight:nPixel
"set the height of the separating bar"
@@ -292,6 +286,12 @@
]
!
+barHeight
+ "return the height of the separating bar"
+
+ ^ barHeight
+!
+
add:aView
"a view is added; make its size relative (if not already done)"
@@ -367,6 +367,11 @@
]
!
+initialize
+ super initialize.
+ noColor := Color noColor.
+!
+
initStyle
|mm|
@@ -407,9 +412,10 @@
].
!
-initialize
- super initialize.
- noColor := Color noColor.
+defaultControllerClass
+ ^ VariableVerticalPanelController
+
+
!
initCursor
@@ -432,54 +438,42 @@
].
DefaultCursor := cursor
]
-!
-
-defaultControllerClass
- ^ VariableVerticalPanelController
-
-
! !
!VariableVerticalPanel methodsFor:'private'!
-handleOriginsDo:aBlock
- "evaluate the argument block for every handle-origin"
-
- self handleOriginsFrom:1 to:(subViews size) do:aBlock
-!
-
handleOriginsFrom:start to:stop do:aBlock
"evaluate the argument block for some handle-origins"
|x hw hDelta|
subViews notNil ifTrue:[
- shadowForm notNil ifTrue:[
- hw := shadowForm width
- ] ifFalse:[
- hw := barWidth
- ].
- (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
- hDelta := barWidth // 2.
- ] ifFalse:[
- hDelta := 0
- ].
- (handlePosition == #left) ifTrue:[
- x := hDelta
- ] ifFalse:[
- (handlePosition == #right) ifTrue:[
- x := width - (1 "2" * hw) - margin - hDelta.
- ] ifFalse:[
- x := width - barWidth // 2
- ]
- ].
- (start + 1) to:stop do:[:index |
- |view y|
+ shadowForm notNil ifTrue:[
+ hw := shadowForm width
+ ] ifFalse:[
+ hw := barWidth
+ ].
+ (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
+ hDelta := barWidth // 2.
+ ] ifFalse:[
+ hDelta := 0
+ ].
+ (handlePosition == #left) ifTrue:[
+ x := hDelta
+ ] ifFalse:[
+ (handlePosition == #right) ifTrue:[
+ x := width - (1 "2" * hw) - margin - hDelta.
+ ] ifFalse:[
+ x := width - barWidth // 2
+ ]
+ ].
+ (start + 1) to:stop do:[:index |
+ |view y|
- view := subViews at:index.
- y := view origin y - barHeight + 1.
- aBlock value:(x @ y)
- ]
+ view := subViews at:index.
+ y := view top "origin y" - barHeight + 1.
+ aBlock value:(x @ y)
+ ]
]
!
@@ -489,53 +483,72 @@
|step nSubviews|
subViews notNil ifTrue:[
- (start <= stop) ifTrue:[
- step := 1
- ] ifFalse:[
- step := -1
- ].
- nSubviews := subViews size.
- start to:stop by:step do:[:index |
- |bw view o1 o2 relOrg relCorner newOrg newCorner|
+ (start <= stop) ifTrue:[
+ step := 1
+ ] ifFalse:[
+ step := -1
+ ].
+ nSubviews := subViews size.
+ start to:stop by:step do:[:index |
+ |bw view o1 o2 relOrg relCorner newOrg newCorner newExt|
- view := subViews at:index.
- bw := view borderWidth.
+ view := subViews at:index.
+ bw := view borderWidth.
- index == 1 ifTrue:[
- o1 := 0.
- ] ifFalse:[
- o1 := barHeight // 2 - bw
- ].
- index == nSubviews ifTrue:[
- o2 := 0.
- ] ifFalse:[
- o2 := barHeight // 2 - bw
- ].
+ index == 1 ifTrue:[
+ o1 := 0.
+ ] ifFalse:[
+ o1 := barHeight // 2 - bw
+ ].
+ index == nSubviews ifTrue:[
+ o2 := 0.
+ ] ifFalse:[
+ o2 := barHeight // 2 - bw
+ ].
- relCorner := view relativeCorner.
- relCorner isNil ifTrue:[
- self error:'subview must have relative corner'
- ].
- newCorner := view cornerFromRelativeCorner.
- newCorner notNil ifTrue:[
- newCorner y:(newCorner y - o2)
- ].
+"
+ relCorner := view relativeCorner.
+ relCorner isNil ifTrue:[
+ self error:'subview must have relative corner'
+ ].
+ newCorner := view cornerFromRelativeCorner.
+ newCorner notNil ifTrue:[
+ newCorner y:(newCorner y - o2)
+ ].
- relOrg := view relativeOrigin.
- relOrg isNil ifTrue:[
- self error:'subview must have relative origin'
- ].
- newOrg := view originFromRelativeOrigin.
- newOrg notNil ifTrue:[
- (index ~~ 1) ifTrue:[
- newOrg y:(newOrg y + o1)
- ].
- ].
- view pixelOrigin:newOrg corner:newCorner
- ]
+ relOrg := view relativeOrigin.
+ relOrg isNil ifTrue:[
+ self error:'subview must have relative origin'
+ ].
+ newOrg := view originFromRelativeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg y:(newOrg y + o1)
+ ].
+ ].
+ view pixelOrigin:newOrg corner:newCorner
+"
+ newOrg := view computeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg y:(newOrg y + o1)
+ ].
+ ].
+ newExt := view computeExtent.
+ newExt notNil ifTrue:[
+ newExt y:(newExt y - o2 - o1)
+ ].
+ view pixelOrigin:newOrg extent:newExt.
+ ]
]
!
+handleOriginsDo:aBlock
+ "evaluate the argument block for every handle-origin"
+
+ self handleOriginsFrom:1 to:(subViews size) do:aBlock
+!
+
anyNonRelativeSubviews
"return true, if any of my subviews has no relative origin/extent"
@@ -582,11 +595,12 @@
"tell subviews if I change size"
shown ifTrue:[
- (how == #smaller) ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size)
- ] ifFalse:[
- self resizeSubviewsFrom:(subViews size) to:1
- ]
- ]
+ (how == #smaller) ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size)
+ ] ifFalse:[
+ self resizeSubviewsFrom:(subViews size) to:1
+ ]
+ ].
+ self changed:#sizeOfView with:how.
! !
--- a/VariableVerticalPanelController.st Sat Mar 18 06:16:33 1995 +0100
+++ b/VariableVerticalPanelController.st Sat Mar 18 06:16:50 1995 +0100
@@ -10,10 +10,10 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:00:02'!
+'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:00:05'!
-Controller subclass:#VariableVerticalPanelController
- instanceVariableNames:'movedHandle prev start'
+VariablePanelController subclass:#VariableVerticalPanelController
+ instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -37,134 +37,14 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VariableVerticalPanelController.st,v 1.1 1995-03-06 21:06:04 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanelController.st,v 1.2 1995-03-18 05:16:41 claus Exp $
"
! !
-!VariableVerticalPanelController methodsFor:'event handling'!
-
-buttonMotion:button x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |ypos limitTop limitBot subViews barHeight|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
-
- "speedup - if there is already another movement,
- ignore thisone ... "
-
- view buttonMotionEventPending ifTrue:[^ self].
-
- ypos := by - start.
-
- "
- the two lines below will not allow resizing down to zero
- (so that some is always visible)
- "
-"/ limitTop := barHeight // 2.
-"/ limitBot := self height - barHeight.
-
- "
- these allow resizing to zero - which is better ?
- "
- limitTop := 0.
- limitBot := view innerHeight.
- subViews := view subViews.
- barHeight := view barHeight.
-
- movedHandle > 1 ifTrue:[
- limitTop := (subViews at:movedHandle) origin y + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitBot := (subViews at:(movedHandle + 2)) origin y - barHeight
- ].
- limitBot := limitBot - barHeight.
- (ypos < limitTop) ifTrue:[ "check against view limits"
- ypos := limitTop
- ] ifFalse:[
- (ypos > limitBot) ifTrue:[
- ypos := limitBot
- ]
- ].
-
- view invertHandleBarAtX:0 y:prev.
- view invertHandleBarAtX:0 y:ypos.
-
- prev := ypos
-!
-
-buttonRelease:button x:x y:y
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex newY oldY group subViews|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
+!VariableVerticalPanelController methodsFor:'initialization'!
- (group := view windowGroup) notNil ifTrue:[
- group restoreCursors
- ].
-
- "undo the last xor"
-
- view invertHandleBarAtX:0 y:prev.
-
- "compute the new relative heights"
-
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- movedHandle := nil.
- subViews := view subViews.
-
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- oldY := aboveView relativeCorner y.
- newY := (prev + start / view height) asFloat.
- aboveView relativeCorner:aboveView relativeCorner x @ newY.
- belowView relativeOrigin:belowView relativeOrigin x @ newY.
+initialize
+ super initialize.
+ isHorizontal := false
+! !
- view lockRedraw.
- oldY > newY ifTrue:[
- view resizeSubviewsFrom:aboveIndex to:belowIndex.
- ] ifFalse:[
- view resizeSubviewsFrom:belowIndex to:aboveIndex.
- ].
- view redrawHandlesFrom:aboveIndex to:belowIndex.
- view unlockRedraw.
- ] ifFalse:[
- super buttonRelease:button x:x y:y
- ]
-!
-
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
-
- |handle barHeight group|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- barHeight := view barHeight.
- view handleOriginsDo:[:hPoint |
- |hy|
-
- hy := hPoint y.
- (by between:hy and:(hy + barHeight)) ifTrue:[
- movedHandle := handle.
- prev := hy.
- start := by - hy.
-
- view invertHandleBarAtX:0 y:hy.
- (group := view windowGroup) notNil ifTrue:[
- group showCursor:view cursor
- ].
- ^ self
- ].
- handle := handle + 1
- ].
- movedHandle := nil
- ] ifFalse:[
- super buttonPress:button x:bx y:by
- ]
-! !
--- a/YesNoBox.st Sat Mar 18 06:16:33 1995 +0100
+++ b/YesNoBox.st Sat Mar 18 06:16:50 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.11 1995-03-06 19:29:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.12 1995-03-18 05:16:46 claus Exp $
'!
!YesNoBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.11 1995-03-06 19:29:54 claus Exp $
+$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.12 1995-03-18 05:16:46 claus Exp $
"
!
@@ -306,8 +306,8 @@
make the two buttons of equal size
"
max := okButton preferedExtent x max:noButton preferedExtent x.
- okButton width:max; fixSize.
- noButton width:max; fixSize.
+ okButton width:max.
+ noButton width:max.
w := (formLabel width + textLabel width) max:max * 2.
w := w + (3 * ViewSpacing) + (okButton borderWidth + noButton borderWidth * 2).
h := ViewSpacing