--- a/TextView.st Sat Dec 09 23:12:30 1995 +0100
+++ b/TextView.st Sun Dec 10 17:53:46 1995 +0100
@@ -11,23 +11,15 @@
"
ListView subclass:#TextView
- instanceVariableNames:'selectionStartLine selectionStartCol
- selectionEndLine selectionEndCol
- clickStartLine clickStartCol
- clickLine clickCol clickCount
- wordStartCol wordStartLine wordEndCol wordEndLine
- selectionFgColor selectionBgColor
- fileBox searchBox lineNumberBox
- selectStyle
- directoryForFileDialog
- contentsWasSaved'
- classVariableNames:'DefaultFont
- DefaultViewBackground
- DefaultSelectionForegroundColor
- DefaultSelectionBackgroundColor
- MatchDelayTime'
- poolDictionaries:''
- category:'Views-Text'
+ instanceVariableNames:'selectionStartLine selectionStartCol selectionEndLine
+ selectionEndCol clickStartLine clickStartCol clickLine clickCol
+ clickCount wordStartCol wordStartLine wordEndCol wordEndLine
+ selectionFgColor selectionBgColor fileBox searchBox lineNumberBox
+ selectStyle directoryForFileDialog contentsWasSaved'
+ classVariableNames:'DefaultFont DefaultViewBackground DefaultSelectionForegroundColor
+ DefaultSelectionBackgroundColor MatchDelayTime'
+ poolDictionaries:''
+ category:'Views-Text'
!
!TextView class methodsFor:'documentation'!
@@ -46,10 +38,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.29 1995-11-24 12:56:21 cg Exp $'
-!
-
documentation
"
a view for readOnly text - this class adds selections to a simple list.
@@ -85,77 +73,6 @@
"
! !
-!TextView class methodsFor:'startup'!
-
-setupEmpty
- "create a textview in a topview, with horizontal and
- vertical scrollbars - a helper for #startWith: and #startOn:"
-
- |top frame label|
-
- label := 'unnamed'.
- top := StandardSystemView
- label:label
- icon:(Form fromFile:'Editor.xbm' resolution:100).
-
- frame := HVScrollableView
- for:self
- miniScrollerH:true miniScrollerV:false
- in:top.
- frame origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- ^ frame scrolledView
-!
-
-open
- "start an empty TextView"
-
- ^ self openWith:nil
-!
-
-openWith:aString
- "start a textView with aString as initial contents"
-
- |top textView|
-
- textView := self setupEmpty.
- top := textView topView.
- aString notNil ifTrue:[
- textView contents:aString
- ].
-
- top open.
- ^ textView
-
- "
- TextView openWith:'some text'
- EditTextView openWith:'some text'
- "
-!
-
-openOn:aFileName
- "start a textView on a file"
-
- |top textView stream|
-
- textView := self setupEmpty.
- top := textView topView.
- aFileName notNil ifTrue:[
- top label:(OperatingSystem baseNameOf:aFileName).
- stream := aFileName asFilename readStream.
- stream notNil ifTrue:[
- textView contents:(stream contents)
- ]
- ].
-
- top open.
- ^ textView
-
- "
- TextView openOn:'../doc/info.doc'
- EditTextView openOn:'../doc/info.doc'
- "
-! !
-
!TextView class methodsFor:'instance creation'!
on:aModel aspect:aspect change:change menu:menu initialSelection:initial
@@ -180,127 +97,97 @@
MatchDelayTime := 0.6
! !
-!TextView methodsFor:'initialize & release'!
-
-initialize
- super initialize.
- contentsWasSaved := false.
+!TextView class methodsFor:'startup'!
- "
- initialize menu to be provided and performed by myself.
- This allows textViews without a model to provide a
- reasonable menu AND allows models to provide their own menu.
- "
- menuHolder := menuPerformer := self.
- menuMsg := #editMenu
+open
+ "start an empty TextView"
+
+ ^ self openWith:nil
!
-initStyle
- super initStyle.
+openOn:aFileName
+ "start a textView on a file"
+
+ |top textView stream|
- DefaultFont notNil ifTrue:[
- font := DefaultFont on:device
- ].
- viewBackground := DefaultViewBackground.
- selectionFgColor := DefaultSelectionForegroundColor.
- selectionFgColor isNil ifTrue:[selectionFgColor := bgColor].
- selectionBgColor := DefaultSelectionBackgroundColor.
- selectionBgColor isNil ifTrue:[
- device hasColors ifTrue:[
- DefaultSelectionForegroundColor isNil ifTrue:[
- selectionFgColor := fgColor
- ].
- selectionBgColor := Color green
- ] ifFalse:[
- device hasGreyscales ifTrue:[
- DefaultSelectionForegroundColor isNil ifTrue:[
- selectionFgColor := fgColor
- ].
- selectionBgColor := Color grey
- ] ifFalse:[
- selectionBgColor := fgColor
- ]
+ textView := self setupEmpty.
+ top := textView topView.
+ aFileName notNil ifTrue:[
+ top label:(OperatingSystem baseNameOf:aFileName).
+ stream := aFileName asFilename readStream.
+ stream notNil ifTrue:[
+ textView contents:(stream contents)
]
].
+
+ top open.
+ ^ textView
+
+ "
+ TextView openOn:'../doc/info.doc'
+ EditTextView openOn:'../doc/info.doc'
+ "
!
-destroy
- fileBox notNil ifTrue:[
- fileBox destroy.
- fileBox := nil
- ].
- searchBox notNil ifTrue:[
- searchBox destroy.
- searchBox := nil
- ].
- lineNumberBox notNil ifTrue:[
- lineNumberBox destroy.
- lineNumberBox := nil
- ].
- super destroy
-! !
+openWith:aString
+ "start a textView with aString as initial contents"
+
+ ^ self openWith:aString title:nil
-!TextView methodsFor:'accessing-mvc'!
-
-on:aModel aspect:aspectSym list:listSym change:changeSym menu:menuSym initialSelection:initial
- "ST-80 compatibility"
+ "
+ TextView openWith:'some text'
+ EditTextView openWith:'some text'
+ "
- aspectSym notNil ifTrue:[aspectMsg := aspectSym. listMsg := aspectSym].
- changeSym notNil ifTrue:[changeMsg := changeSym].
- listSym notNil ifTrue:[listMsg := listSym].
- menuSym notNil ifTrue:[menuMsg := menuSym].
-"/ initial notNil ifTrue:[initialSelectionMsg := initial].
- self model:aModel.
-
- listMsg notNil ifTrue:[
- self getListFromModel
- ].
+ "Created: 10.12.1995 / 17:41:32 / cg"
!
-model:aModel
- "when my model is set, and I am the menuPerformer/menuHolder,
- reset holder to the model. This is a compatibility kludge,
- since typically, ST-80 code expects the model to provide a menu
- and the view to perform it.
- Those apps which want the TextView to provide the menu have to reset
- this by sending menuHolder: (again)"
+openWith:aString title:aTitle
+ "start a textView with aString as initial contents"
+
+ |top textView|
+
+ textView := self setupEmpty.
+ top := textView topView.
+ aTitle notNil ifTrue:[top label:aTitle].
+
+ aString notNil ifTrue:[
+ textView contents:aString
+ ].
+
+ top open.
+ ^ textView
+
+ "
+ TextView openWith:'some text' title:'testing'
+ EditTextView openWith:'some text' title:'testing'
+ "
- super model:aModel.
- (menuPerformer == self and:[menuHolder == self]) ifTrue:[
- menuHolder := model
- ]
+ "Created: 10.12.1995 / 17:40:02 / cg"
+ "Modified: 10.12.1995 / 17:41:13 / cg"
+!
+
+setupEmpty
+ "create a textview in a topview, with horizontal and
+ vertical scrollbars - a helper for #startWith: and #startOn:"
+
+ |top frame label|
+
+ label := 'unnamed'.
+ top := StandardSystemView
+ label:label
+ icon:(Form fromFile:'Editor.xbm' resolution:100).
+
+ frame := HVScrollableView
+ for:self
+ miniScrollerH:true miniScrollerV:false
+ in:top.
+ frame origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ ^ frame scrolledView
! !
!TextView methodsFor:'accessing'!
-selectionForegroundColor:color1 backgroundColor:color2
- "set both selection-foreground and cursor background colors"
-
- selectionFgColor := color1 on:device.
- selectionBgColor := color2 on:device.
- shown ifTrue:[
- self redraw
- ]
-!
-
-setList:something
- "set the displayed contents (a collection of strings)
- without redraw.
- Redefined since changing contents implies deselect"
-
- self unselect.
- super setList:something
-!
-
-list:something
- "set the displayed contents (a collection of strings)
- with redraw.
- Redefined since changing contents implies deselect"
-
- self unselect.
- super list:something
-!
-
characterAtLine:lineNr col:colNr
"return the character at physical line/col -
return space if nothing is there"
@@ -326,12 +213,6 @@
col:selectionStartCol
!
-directoryForFileDialog:aDirectory
- "define the directory to use for save-box"
-
- directoryForFileDialog := aDirectory
-!
-
contentsWasSaved
"return true, if the contents was saved (by a save action),
false if not (or was modified again after the last save)."
@@ -339,1344 +220,80 @@
^ contentsWasSaved
!
+directoryForFileDialog:aDirectory
+ "define the directory to use for save-box"
+
+ directoryForFileDialog := aDirectory
+!
+
fromFile:aFileName
"take contents from a named file"
self directoryForFileDialog:(OperatingSystem directoryNameOf:aFileName).
self contents:(FileStream oldFileNamed:aFileName) contents
-! !
-
-!TextView methodsFor:'private'!
-
-fileOutContentsOn:aStream
- "save contents on a stream, replacing leading spaces by tab-characters."
-
- self fileOutContentsOn:aStream compressTabs:true
-!
-
-fileOutContentsOn:aStream compressTabs:compressTabs
- "save contents on a stream. If compressTabs is true,
- leading spaces will be replaced by tab-characters in the output."
-
- |startNr nLines string|
-
- "on some systems, writing linewise is very slow (via NFS)
- therefore we convert to a string and write it in big chunks.
- To avoid creating huge strings, we do it in blocks of 1000 lines,
- limiting temporary string creation to about 50-80k.
- "
- startNr := 1.
- nLines := list size.
- [startNr <= nLines] whileTrue:[
- string := list asStringWithCRsFrom:startNr
- to:((startNr + 1000) min:nLines)
- compressTabs:compressTabs.
- aStream nextPutAll:string.
- startNr := startNr + 1000 + 1.
- ].
-
-"/ "the old (obsolete) code:"
-"/
-"/ list do:[:aLine |
-"/ aLine notNil ifTrue:[
-"/ aStream nextPutAll:aLine.
-"/ ].
-"/ aStream cr
-"/ ]
-
-!
-
-widthForScrollBetween:firstLine and:lastLine
- "return the width in pixels for a scroll between firstLine and lastLine"
-
- selectionStartLine notNil ifTrue:[
- (lastLine < selectionStartLine) ifFalse:[
- (firstLine > selectionEndLine) ifFalse:[
- ^ width
- ]
- ]
- ].
- ^ super widthForScrollBetween:firstLine and:lastLine
-!
-
-scrollSelectUp
- "auto scroll action; scroll and reinstall timed-block"
-
- |prevStartLine|
-
- "just to make certain ..."
- selectionStartLine isNil ifTrue:[^ self].
-
- self scrollUp.
-
- "make new selection immediately visible"
- prevStartLine := selectionStartLine.
- selectionStartLine := firstLineShown.
- selectionStartCol := 1.
- selectionStartLine to:prevStartLine do:[:lineNr |
- self redrawLine:lineNr
- ].
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-scrollSelectDown
- "auto scroll action; scroll and reinstall timed-block"
-
- |prevEndLine|
-
- "just to make certain ..."
- selectionEndLine isNil ifTrue:[^ self].
-
- self scrollDown.
-
- "make new selection immediately visible"
- prevEndLine := selectionEndLine.
- selectionEndLine := firstLineShown + nFullLinesShown.
- selectionEndCol := 0.
- prevEndLine to:selectionEndLine do:[:lineNr |
- self redrawLine:lineNr
- ].
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-stopScrollSelect
- "stop auto scroll; deinstall timed-block"
-
- autoScrollBlock notNil ifTrue:[
- Processor removeTimedBlock:autoScrollBlock.
- self compressMotionEvents:true.
- autoScrollBlock := nil.
- autoScrollDeltaT := nil
- ]
-!
-
-scrollSelectLeft
- "auto scroll action; scroll and reinstall timed-block"
-
- |prevStartLine|
-
- "just to make certain ..."
- selectionStartLine isNil ifTrue:[^ self].
- selectionStartCol isNil ifTrue:[^ self].
-
- "make new selection immediately visible"
- prevStartLine := selectionStartLine.
- selectionStartCol := selectionStartCol - 1 max:1.
- self scrollLeft.
-
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-scrollSelectRight
- "auto scroll action; scroll and reinstall timed-block"
-
- |prevEndCol|
-
- "just to make certain ..."
- selectionEndCol isNil ifTrue:[^ self].
-
- prevEndCol := selectionEndCol.
- selectionEndCol := selectionEndCol + 1.
- self scrollRight.
-
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-! !
-
-
-!TextView methodsFor:'menu actions'!
-
-editMenu
- |labels selectors m|
-
- labels := #(
- 'copy'
- '-'
- 'font ...'
- '-'
- 'search ...'
- 'goto ...'
- '-'
- 'save as ...'
- 'print'
- ).
-
- selectors := #(
- copySelection
- nil
- changeFont
- nil
- search
- gotoLine
- nil
- save
- print
- ).
-
- m := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors.
-
- self hasSelection ifFalse:[
- m disable:#copySelection.
- ].
- ^ m
-!
-
-print
- "print the contents on the printer"
-
- |printStream|
-
- list isNil ifTrue:[^ self].
- printStream := Printer new.
- printStream notNil ifTrue:[
- self fileOutContentsOn:printStream.
- printStream close
- ]
-!
-
-saveAs:fileName
- "save contents into a file named fileName"
-
- |aStream msg|
-
- aStream := FileStream newFileNamed:fileName.
- aStream isNil ifTrue:[
- msg := resources string:'cannot write file %1 !!' with:fileName.
- self warn:(msg , '\\(' , FileStream lastErrorString , ')' ) withCRs
- ] ifFalse:[
- self fileOutContentsOn:aStream.
- aStream close.
- contentsWasSaved := true
- ]
-!
-
-appendTo:fileName
- "append contents to a file named fileName"
-
- |aStream msg|
-
- aStream := FileStream appendingOldFileNamed:fileName.
- aStream isNil ifTrue:[
- msg := resources string:'cannot append to file %1 !!' with:fileName.
- self warn:(msg , '\\(' , FileStream lastErrorString , ')' ) withCRs
- ] ifFalse:[
- self fileOutContentsOn:aStream.
- aStream close.
- contentsWasSaved := true
- ]
-!
-
-save
- "save contents into a file
- - ask user for filename using a fileSelectionBox."
-
- fileBox isNil ifTrue:[
- fileBox := FileSaveBox
- title:(resources string:'save contents in:')
- okText:(resources string:'save')
- abortText:(resources string:'cancel')
- action:[:fileName | self saveAs:fileName].
- fileBox appendAction:[:fileName | self appendTo:fileName].
- ].
- directoryForFileDialog notNil ifTrue:[
- fileBox directory:directoryForFileDialog
- ].
- fileBox showAtPointer
-!
-
-copySelection
- "copy contents into smalltalk copybuffer"
-
- |text|
-
- text := self selection.
- text notNil ifTrue:[
- self unselect.
- self setTextSelection:text
- ]
-!
-
-changeFont
- "pop up a fontPanel to change font"
-
- |panel|
-
- panel := FontPanel new.
- panel action:[:family :face :style :size |
- self font:(Font family:family
- face:face
- style:style
- size:size)
- ].
- panel initialFont:font.
- panel showAtPointer
-!
-
-defaultForGotoLine
- "return a default value to show in the gotoLine box"
-
- ^ nil
-!
-
-gotoLine
- "show a box to enter lineNumber for positioning"
-
- |l|
-
- lineNumberBox isNil ifTrue:[
- lineNumberBox :=
- EnterBox
- title:(resources string:'line number:')
- okText:(resources string:'goto')
- abortText:(resources string:'cancel')
- action:[:l | |num|
- num := Integer readFromString:l onError:nil.
- num notNil ifTrue:[self gotoLine:num]
- ]
- ].
- l := self defaultForGotoLine.
- l notNil ifTrue:[
- l := l printString
- ].
- lineNumberBox initialText:l .
- lineNumberBox showAtPointer
-! !
-
-!TextView methodsFor:'selections'!
-
-validateNewSelection
- ^ self
-!
-
-unselectWithoutRedraw
- "forget selection but do not redraw the selection area
- - can be done when the selected area is redrawn anyway or
- known to be invisible."
-
- selectionStartLine := nil.
!
-unselect
- "unselect - if there was a selection redraw that area"
-
- |startLine endLine startVisLine endVisLine|
-
- selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- endLine := selectionEndLine.
- selectionStartLine := nil.
-
- "if selection is not visible, we are done"
- startLine >= (firstLineShown + nLinesShown) ifTrue:[^ self].
- endLine < firstLineShown ifTrue:[^ self].
-
- startLine < firstLineShown ifTrue:[
- startVisLine := 1
- ] ifFalse:[
- startVisLine := self listLineToVisibleLine:startLine
- ].
- endLine >= (firstLineShown + nLinesShown) ifTrue:[
- endVisLine := nLinesShown
- ] ifFalse:[
- endVisLine := self listLineToVisibleLine:endLine
- ].
- "if its only part of a line, just redraw what has to be"
- (startVisLine == endVisLine) ifTrue:[
- super redrawVisibleLine:startVisLine from:selectionStartCol to:selectionEndCol
- ] ifFalse:[
- super redrawFromVisibleLine:startVisLine to:endVisLine
- ].
- self unselectWithoutRedraw
- ].
- selectStyle := nil
-!
-
-selectFromLine:startLine col:startCol toLine:endLine col:endCol
- "select a piece of text and redraw that area"
+list:something
+ "set the displayed contents (a collection of strings)
+ with redraw.
+ Redefined since changing contents implies deselect"
self unselect.
- startLine notNil ifTrue:[
- "new:"
- endLine < startLine ifTrue:[
- ^ self selectFromLine:endLine col:endCol toLine:startLine col:startCol
- ].
- (endLine == startLine and:[endCol < startCol]) ifTrue:[
- endCol ~~ 0 ifTrue:[
- self selectFromLine:endLine col:endCol toLine:startLine col:startCol.
- ].
- ^ self
- ].
-
-" old:
- endLine < startLine ifTrue:[^ self].
- (startLine == endLine and:[endCol < startCol]) ifTrue:[^ self].
-"
- selectionStartLine := startLine.
- selectionStartCol := startCol.
- selectionEndLine := endLine.
- selectionEndCol := endCol.
- (startLine == endLine) ifTrue:[
- self redrawLine:startLine from:startCol to:endCol
- ] ifFalse:[
- startLine to:endLine do:[:lineNr |
- self redrawLine:lineNr
- ]
- ].
- selectStyle := nil.
- ]
-!
-
-selectLine:selectLine
- "select one line and redraw it"
-
- self selectFromLine:selectLine col:1 toLine:(selectLine + 1) col:0.
- wordStartCol := selectionStartCol.
- wordEndCol := selectionEndCol.
- wordStartLine := selectionStartLine.
- wordEndLine := selectionEndLine.
- selectStyle := #line
-!
-
-selectLineWhereCharacterPosition:pos
- "select the line, where characterPosition pos is living.
- The argument pos starts at 1 from the start of the text
- and counts characters (i.e. can be used to convert from
- character position within a string to line-position in view)."
-
- self selectLine:(self lineOfCharacterPosition:pos)
-!
-
-selectFromCharacterPosition:pos1 to:pos2
- "compute line/col from character positions and select the text"
-
- |line1 col1 line2 col2|
-
- line1 := self lineOfCharacterPosition:pos1.
- col1 := pos1 - (self characterPositionOfLine:line1 col:1) + 1.
- line2 := self lineOfCharacterPosition:pos2.
- col2 := pos2 - (self characterPositionOfLine:line2 col:1) + 1.
- self selectFromLine:line1 col:col1 toLine:line2 col:col2
-!
-
-wordAtLine:selectLine col:selectCol do:aFiveArgBlock
- "find word boundaries, evaluate the block argument with those.
- A helper for nextWord and selectWord functions."
-
- |beginCol endCol endLine thisCharacter flag|
-
- flag := #word.
- beginCol := selectCol.
- endCol := selectCol.
- endLine := selectLine.
- thisCharacter := self characterAtLine:selectLine col:beginCol.
-
- beginCol := self findBeginOfWordAtLine:selectLine col:selectCol.
- endCol := self findEndOfWordAtLine:selectLine col:selectCol.
- endCol == 0 ifTrue:[
- endLine := selectLine + 1
- ].
-
- "is the initial acharacter within a word ?"
- (wordCheck value:thisCharacter) ifTrue:[
- "
- try to catch a blank ...
- "
- ((beginCol == 1)
- or:[(self characterAtLine:selectLine col:(beginCol - 1))
- ~~ Character space]) ifTrue:[
- ((self characterAtLine:selectLine col:(endCol + 1))
- == Character space) ifTrue:[
- endCol := endCol + 1.
- flag := #wordRight
- ]
- ] ifFalse:[
- beginCol := beginCol - 1.
- flag := #wordLeft
- ].
- ].
- aFiveArgBlock value:selectLine
- value:beginCol
- value:endLine
- value:endCol
- value:flag
-!
-
-selectWordAtLine:line col:col
- "select the word at given line/col"
-
- self wordAtLine:line col:col do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- self selectFromLine:beginLine col:beginCol toLine:endLine col:endCol.
- selectStyle := style
- ]
+ super list:something
!
-selectWordAtX:x y:y
- "select the word at given x/y-(view-)coordinate"
-
- |selectVisibleLine selectLine selectCol|
-
- selectStyle := nil.
- selectVisibleLine := self visibleLineOfY:y.
- selectLine := self visibleLineToListLine:selectVisibleLine.
- selectLine notNil ifTrue:[
- selectCol := self colOfX:x inVisibleLine:selectLine.
- self selectWordAtLine:selectLine col:selectCol
- ]
-!
-
-selectLineAtY:y
- "select the line at given y-(view-)coordinate"
-
- |selectVisibleLine selectLine|
-
- selectVisibleLine := self visibleLineOfY:y.
- selectLine := self visibleLineToListLine:selectVisibleLine.
- selectLine notNil ifTrue:[
- self selectLine:selectLine
- ]
-!
-
-selectAll
- "select the whole text"
-
- self selectFromLine:1 col:1 toLine:(list size + 1) col:0
-!
-
-hasSelection
- "return true, if there is a selection"
-
- ^ selectionStartLine notNil
-!
-
-selection
- "return the selection as a collection of (line-)strings.
- If the selection ends in a full line, the last entry in the returned
- collection will be an empty string."
-
- |text sz index last
- startLine "{ Class: SmallInteger }"
- endLine "{ Class: SmallInteger }"|
-
- selectionStartLine isNil ifTrue:[^ nil].
- startLine := selectionStartLine.
- endLine := selectionEndLine.
-
- (startLine == endLine) ifTrue:[
- "part of a line"
- ^ StringCollection with:(self listAt:startLine
- from:selectionStartCol
- to:selectionEndCol)
- ].
- sz := endLine - startLine + 1.
- text := StringCollection new:sz.
-
- "get 1st and last (possibly) partial lines"
- text at:1 put:(self listAt:startLine from:selectionStartCol).
- selectionEndCol == 0 ifTrue:[
- last := ''
- ] ifFalse:[
- last := self listAt:selectionEndLine to:selectionEndCol.
- ].
- text at:sz put:last.
-
- "get bulk of text"
- index := 2.
- (startLine + 1) to:(endLine - 1) do:[:lineNr |
- text at:index put:(self listAt:lineNr).
- index := index + 1
- ].
- ^ text
-!
-
-selectionStartLine
- ^ selectionStartLine
-!
+selectionForegroundColor:color1 backgroundColor:color2
+ "set both selection-foreground and cursor background colors"
-selectionStartCol
- ^ selectionStartCol
-!
-
-selectionEndLine
- ^ selectionEndLine
-!
-
-selectionEndCol
- ^ selectionEndCol
-!
-
-makeSelectionVisible
- "scroll to make the selection visible"
-
- selectionStartLine notNil ifTrue:[
- self makeLineVisible:selectionStartLine
- ]
-! !
-
-!TextView methodsFor:'searching'!
-
-search
- "show a box to enter searchpattern
- - currently no regular expressions are handled."
-
- "
- cache the searchBox
- Q: should we use one global searchBox for all textViews ?
- (we could then preserve the last searchstring between views)
- "
-
-"/ "soon to come: search & replace box ...
-"/ |box|
-"/
-"/ box := Dialog new.
-"/ (box addTextLabel:(resources at:'searchPattern:')) layout:#left.
-"/ box addVerticalSpace.
-"/ box addInputFieldOn:'' asValue.
-"/ box addVerticalSpace.
-"/ (box addTextLabel:(resources at:'replace with:')) layout:#left.
-"/ box addVerticalSpace.
-"/ box addInputFieldOn:'' asValue.
-"/ box addAbortButtonLabelled:(resources at:'cancel');
-"/ addButton:(Button label:(resources at:'all'));
-"/ addButton:(Button label:(resources at:'prev'));
-"/ addOkButtonLabelled:(resources at:'next').
-"/ box open.
-
- searchBox isNil ifTrue:[
- searchBox :=
- EnterBox2
- title:(resources at:'searchPattern:')
- okText1:(resources at:'prev')
- okText2:(resources at:'next')
- abortText:(resources at:'cancel')
- action1:[:pattern | pattern notEmpty ifTrue:[self searchBwd:(pattern withoutSeparators)]]
- action2:[:pattern | pattern notEmpty ifTrue:[self searchFwd:(pattern withoutSeparators)]]
- ].
- searchPattern notNil ifTrue:[
- searchBox initialText:searchPattern
- ].
- self hasSelection ifTrue:[
- selectionStartLine == selectionEndLine ifTrue:[
- searchBox initialText:self selection
- ]
- ].
- searchBox showAtPointer
-!
-
-setSearchPattern:aString
- "set the searchpattern for future searches"
-
- aString isNil ifTrue:[
- searchPattern := aString
- ] ifFalse:[
- searchPattern := aString withoutSeparators
- ]
-!
-
-setSearchPattern
- "set the searchpattern from the selection if there is one"
-
- |sel|
-
- sel := self selection.
- sel notNil ifTrue:[
- searchPattern := sel asString withoutSeparators
+ selectionFgColor := color1 on:device.
+ selectionBgColor := color2 on:device.
+ shown ifTrue:[
+ self redraw
]
!
-searchPattern
- "return the last search pattern"
-
- ^ searchPattern
-!
-
-showNotFound
- "search not found - tell user by beeping and changing
- cursor for a while (sometimes I work with a headset :-)
- (used to be: tell user by changing cursor for a while)"
-
- |savedCursor|
-
- device beep.
-
-"
- uncomment if you want a CROSS cursor to be shown for a while ..
-"
-
-" "
- savedCursor := cursor.
- self cursor:(Cursor cross).
- OperatingSystem millisecondDelay:300.
- self cursor:savedCursor
-" "
-!
-
-showMatch:pattern atLine:line col:col
- "after a search, highlight the matched pattern.
- The code below needs a rewrite to take care of match-characters
- (for now, it only highlights simple patterns and '*string*' correctly)"
-
- |realPattern|
-
- realPattern := pattern.
- (realPattern startsWith:$*) ifTrue:[
- realPattern := realPattern copyFrom:2
- ].
- (realPattern endsWith:$*) ifTrue:[
- realPattern := realPattern copyWithoutLast:1
- ].
-
- self selectFromLine:line col:col
- toLine:line col:(col + realPattern size - 1).
- self makeLineVisible:line
-!
-
-searchFwd
- "search forward for pattern or selection"
-
- selectStyle == #wordLeft ifTrue:[
- "
- remove the space from the selection
- "
- selectionStartCol := selectionStartCol + 1.
- super redrawLine:selectionStartLine from:selectionStartCol-1 to:selectionStartCol-1.
- ].
- self setSearchPattern.
- searchPattern notNil ifTrue:[
- self searchFwd:searchPattern
- ]
-!
-
-searchBwd
- "search backward and -if found- position cursor"
-
- self setSearchPattern.
- searchPattern notNil ifTrue:[
- self searchBwd:searchPattern
- ]
-!
-
-searchFwd:pattern
- "do a forward search"
-
- self searchFwd:pattern ifAbsent:[self showNotFound].
- searchPattern := pattern
-!
-
-searchBwd:pattern
- "do a backward search"
-
- self searchBwd:pattern ifAbsent:[self showNotFound].
- searchPattern := pattern
-
-!
-
-searchFwd:pattern ifAbsent:aBlock
- "do a forward search"
-
- |startLine startCol|
-
- selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- startCol := selectionStartCol
- ] ifFalse:[
- startLine := 1.
- startCol := 1
- ].
- self searchForwardFor:pattern startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self showMatch:pattern atLine:line col:col
- ] ifAbsent:aBlock
-!
-
-searchBwd:pattern ifAbsent:aBlock
- "do a backward search"
-
- |startLine startCol|
+setList:something
+ "set the displayed contents (a collection of strings)
+ without redraw.
+ Redefined since changing contents implies deselect"
- selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- startCol := selectionStartCol
- ] ifFalse:[
- startLine := 1.
- startCol := 1
- ].
- self searchBackwardFor:pattern startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self showMatch:pattern atLine:line col:col
- ] 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."
-
- ^ self
- searchForMatchingParenthesisFromLine:startLine col:startCol
- ifFound:foundBlock
- ifNotFound:notFoundBlock
- onError:failBlock
- ignoring:#( $' $" )
-
- "Modified: 18.11.1995 / 16:28:23 / cg"
-!
-
-searchForMatchingParenthesisFromLine:startLine col:startCol
- ifFound:foundBlock
- ifNotFound:notFoundBlock
- onError:failBlock
- ignoring:ignoreSet
- "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 closingChar
- ignoring delta endCol cc incSet decSet nesting maxLine|
-
- charSet := #( $( $) $[ $] ${ $} ).
-
- 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
-
- "Modified: 18.11.1995 / 16:30:56 / cg"
+ self unselect.
+ super setList:something
! !
-!TextView methodsFor:'redrawing'!
-
-clearMarginOfVisible:visLine with:color
- "if there is a margin, clear it - a helper for selection drawing"
+!TextView methodsFor:'accessing-mvc'!
- (leftMargin ~~ 0) ifTrue:[
- self paint:color.
- self fillRectangleX:margin
- y:(self yOfVisibleLine:visLine)
- width:leftMargin
- height:fontHeight
+model:aModel
+ "when my model is set, and I am the menuPerformer/menuHolder,
+ reset holder to the model. This is a compatibility kludge,
+ since typically, ST-80 code expects the model to provide a menu
+ and the view to perform it.
+ Those apps which want the TextView to provide the menu have to reset
+ this by sending menuHolder: (again)"
+
+ super model:aModel.
+ (menuPerformer == self and:[menuHolder == self]) ifTrue:[
+ menuHolder := model
]
!
-redrawVisibleLine:visLine col:col
- "redraw single character at col in visible line lineNr"
-
- |line|
-
- line := self visibleLineToAbsoluteLine:visLine.
- selectionStartLine notNil ifTrue:[
- (line between:selectionStartLine and:selectionEndLine) ifTrue:[
- ((line == selectionStartLine)
- and: [col < selectionStartCol]) ifFalse:[
- ((line == selectionEndLine)
- and: [col > selectionEndCol]) ifFalse:[
- "its in the selection"
- self drawVisibleLine:visLine col:col with:selectionFgColor
- and:selectionBgColor.
- ^ self
- ]
- ]
- ]
- ].
- super redrawVisibleLine:visLine col:col
-!
-
-redrawFromVisibleLine:startVisLineNr to:endVisLineNr
- "redraw a visible line range"
-
- |startLine endLine specialCare end selVisStart line1 line2|
-
- shown ifFalse:[^ self].
-
- end := endVisLineNr.
- (end > nLinesShown) ifTrue:[
- end := nLinesShown
- ].
-
- selectionStartLine isNil ifTrue:[
- specialCare := false
- ] ifFalse:[
- startLine := self visibleLineToAbsoluteLine:startVisLineNr.
- (startLine > selectionEndLine) ifTrue:[
- specialCare := false
- ] ifFalse:[
- endLine := self visibleLineToAbsoluteLine:end.
- (endLine < selectionStartLine) ifTrue:[
- specialCare := false
- ] ifFalse:[
- specialCare := true
- ]
- ]
- ].
-
- "easy: nothing is selected"
- specialCare ifFalse:[
- super redrawFromVisibleLine:startVisLineNr to:end.
- ^ self
- ].
-
- "easy: all is selected"
- ((selectionStartLine < startLine) and:[selectionEndLine > endLine]) ifTrue:[
- self drawFromVisibleLine:startVisLineNr to:end with:selectionFgColor
- and:selectionBgColor.
- ^ self
- ].
-
- (selectionStartLine >= firstLineShown) ifTrue:[
- "draw unselected top part"
-
- selVisStart := self listLineToVisibleLine:selectionStartLine.
- super redrawFromVisibleLine:startVisLineNr to:(selVisStart - 1).
-
- "and first partial selected line"
- self redrawVisibleLine:selVisStart.
-
- "rest starts after this one"
- line1 := selVisStart + 1
- ] ifFalse:[
- line1 := 1
- ].
-
- (line1 > end) ifTrue:[^ self].
- (line1 < startVisLineNr) ifTrue:[
- line1 := startVisLineNr
- ].
-
- "draw middle part of selection"
-
- (selectionEndLine >= (firstLineShown + nLinesShown)) ifTrue:[
- line2 := nLinesShown
- ] ifFalse:[
- line2 := (self listLineToVisibleLine:selectionEndLine) - 1
- ].
- (line2 > end) ifTrue:[
- line2 := end
- ].
-
- self drawFromVisibleLine:line1 to:line2 with:selectionFgColor
- and:selectionBgColor.
-
- (line2 >= end) ifTrue:[^ self].
-
- "last line of selection"
- self redrawVisibleLine:(line2 + 1).
-
- ((line2 + 2) <= end) ifTrue:[
- super redrawFromVisibleLine:(line2 + 2) to:end
- ]
-!
-
-redrawVisibleLine:visLine
- "redraw visible line lineNr"
-
- |len line l|
-
- selectionStartLine notNil ifTrue:[
- line := self visibleLineToAbsoluteLine:visLine.
- (line between:selectionStartLine and:selectionEndLine) ifTrue:[
- (line == selectionStartLine) ifTrue:[
- (line == selectionEndLine) ifTrue:[
- "its part-of-single-line selection"
- self clearMarginOfVisible:visLine with:bgColor.
- (selectionStartCol > 1) ifTrue:[
- super redrawVisibleLine:visLine
- from:1
- to:(selectionStartCol - 1)
- ].
- self drawVisibleLine:visLine from:selectionStartCol
- to:selectionEndCol
- with:selectionFgColor
- and:selectionBgColor.
- super redrawVisibleLine:visLine
- from:(selectionEndCol + 1).
- ^ self
- ].
+on:aModel aspect:aspectSym list:listSym change:changeSym menu:menuSym initialSelection:initial
+ "ST-80 compatibility"
- "its the first line of a multi-line selection"
- (selectionStartCol ~~ 1) ifTrue:[
- self clearMarginOfVisible:visLine with:bgColor.
- super redrawVisibleLine:visLine
- from:1
- to:(selectionStartCol - 1)
- ] ifFalse:[
- leftOffset == 0 ifTrue:[
- self clearMarginOfVisible:visLine with:selectionBgColor.
- ]
- ].
- self drawVisibleLine:visLine from:selectionStartCol
- with:selectionFgColor and:selectionBgColor.
- ^ self
- ].
-
- (line == selectionEndLine) ifTrue:[
- "its the last line of a multi-line selection"
- (selectionEndCol == 0) ifTrue:[
- ^ super redrawVisibleLine:visLine
- ].
- l := self visibleAt:selectionEndLine.
- len := l size.
-
- self clearMarginOfVisible:visLine with:selectionBgColor.
- self drawVisibleLine:visLine from:1 to:selectionEndCol
- with:selectionFgColor and:selectionBgColor.
- super redrawVisibleLine:visLine from:(selectionEndCol + 1).
- ^ self
- ].
-
- "its a full line in a multi-line selection"
- self clearMarginOfVisible:visLine with:selectionBgColor.
- self drawVisibleLine:visLine with:selectionFgColor and:selectionBgColor.
- ^ self
- ]
- ].
- super redrawVisibleLine:visLine
-!
-
-redrawVisibleLine:visLine from:startCol
- "redraw visible line lineNr from startCol to end of line"
-
- |line|
-
- line := self visibleLineToAbsoluteLine:visLine.
- selectionStartLine notNil ifTrue:[
- (line between:selectionStartLine and:selectionEndLine) ifTrue:[
- ((line == selectionStartLine)
- or:[line == selectionEndLine]) ifTrue:[
- "since I'm lazy, redraw full line"
- self redrawVisibleLine:visLine.
- ^ self
- ].
- "the line is fully within the selection"
- self drawVisibleLine:visLine from:startCol with:selectionFgColor
- and:selectionBgColor.
- ^ self
- ]
- ].
- super redrawVisibleLine:visLine from:startCol
-!
-
-redrawVisibleLine:visLine from:startCol to:endCol
- "redraw visible line lineNr from startCol to endCol"
-
- |line allOut allIn leftCol rightCol|
-
- line := self visibleLineToAbsoluteLine:visLine.
+ aspectSym notNil ifTrue:[aspectMsg := aspectSym. listMsg := aspectSym].
+ changeSym notNil ifTrue:[changeMsg := changeSym].
+ listSym notNil ifTrue:[listMsg := listSym].
+ menuSym notNil ifTrue:[menuMsg := menuSym].
+"/ initial notNil ifTrue:[initialSelectionMsg := initial].
+ self model:aModel.
- allIn := false.
- allOut := false.
- selectionStartLine isNil ifTrue:[
- allOut := true
- ] ifFalse:[
- (line between:selectionStartLine and:selectionEndLine) ifFalse:[
- allOut := true
- ] ifTrue:[
- (selectionStartLine == selectionEndLine) ifTrue:[
- ((endCol < selectionStartCol)
- or:[startCol > selectionEndCol]) ifTrue:[
- allOut := true
- ] ifFalse:[
- ((startCol >= selectionStartCol)
- and:[endCol <= selectionEndCol]) ifTrue:[
- allIn := true
- ]
- ]
- ] ifFalse:[
- (line == selectionStartLine) ifTrue:[
- (endCol < selectionStartCol) ifTrue:[
- allOut := true
- ] ifFalse:[
- (startCol >= selectionStartCol) ifTrue:[
- allIn := true
- ]
- ]
- ] ifFalse:[
- (line == selectionEndLine) ifTrue:[
- (startCol > selectionEndCol) ifTrue:[
- allOut := true
- ] ifFalse:[
- (endCol <= selectionEndCol) ifTrue:[
- allIn := true
- ]
- ]
- ] ifFalse:[
- allIn := true
- ]
- ]
- ]
- ]
+ listMsg notNil ifTrue:[
+ self getListFromModel
].
- allOut ifTrue:[
- super redrawVisibleLine:visLine from:startCol to:endCol.
- ^ self
- ].
-
- allIn ifTrue:[
- self drawVisibleLine:visLine from:startCol to:endCol
- with:selectionFgColor and:selectionBgColor
- ] ifFalse:[
- "redraw part before selection"
- ((line == selectionStartLine)
- and:[startCol <= selectionStartCol]) ifTrue:[
- super redrawVisibleLine:visLine from:startCol
- to:(selectionStartCol - 1).
- leftCol := selectionStartCol
- ] ifFalse:[
- leftCol := startCol
- ].
- "redraw selected part"
- (selectionEndLine > line) ifTrue:[
- rightCol := endCol
- ] ifFalse:[
- rightCol := selectionEndCol min:endCol
- ].
- self drawVisibleLine:visLine from:leftCol to:rightCol
- with:selectionFgColor and:selectionBgColor.
-
- "redraw part after selection"
- (rightCol < endCol) ifTrue:[
- super redrawVisibleLine:visLine from:(rightCol + 1) to:endCol
- ]
- ].
-
- "special care for first and last line of selection:
- must handle margin also"
-
- ((line == selectionEndLine)
- and:[(startCol == 1)
- and:[selectionStartLine < selectionEndLine]])
- ifTrue:[
- self clearMarginOfVisible:visLine with:selectionBgColor.
- ].
-
- ((line == selectionStartLine)
- and:[(startCol == 1)
- and:[selectionStartLine < selectionEndLine]])
- ifTrue:[
- self clearMarginOfVisible:visLine with:bgColor.
- ]
! !
!TextView methodsFor:'event processing'!
-mapped
- super mapped.
- selectionFgColor := selectionFgColor on:device.
- selectionBgColor := selectionBgColor on:device.
-!
-
-keyPress:key x:x y:y
- "handle some keyboard input (there is not much to be done here)"
-
- <resource: #keyboard (#Find #Copy #FindNext #FindPrev #SelectAll)>
-
- (key == #Find) ifTrue:[self search. ^self].
- (key == #Copy) ifTrue:[self copySelection. ^self].
-
- (key == #FindNext) ifTrue:[self searchFwd. ^self].
- (key == #FindPrev) ifTrue:[self searchBwd. ^self].
-
- (key == #SelectAll) ifTrue:[self selectAll. ^self].
-
- "
- shift-Fn defines a key-sequence
- Fn pastes that sequence
- cmd-Fn performs a 'doIt' on the sequence (Workspaces only)
-
- (see EditTextView>>keyPress:x:y and Workspace>>keyPress:x:y)
- "
- (('[fF][0-9]' match:key)
- or:['[fF][0-9][0-9]' match:key]) ifTrue:[
- device shiftDown ifTrue:[
- (Smalltalk at:#FunctionKeySequences) isNil ifTrue:[
- Smalltalk at:#FunctionKeySequences put:Dictionary new
- ].
- (Smalltalk at:#FunctionKeySequences) at:key put:(self selection)
- ].
- ^ self
- ].
-
- super keyPress:key x:x y:y
-!
-
-buttonPress:button x:x y:y
- "mouse-click - prepare for selection change"
-
- |clickVisibleLine|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- clickVisibleLine := self visibleLineOfY:y.
- clickCol := self colOfX:x inVisibleLine:clickVisibleLine.
- clickLine := self visibleLineToAbsoluteLine:clickVisibleLine.
- clickStartLine := clickLine.
- clickStartCol := clickCol.
- self unselect.
- clickCount := 1
- ] ifFalse:[
- super buttonPress:button x:x y:y
- ]
-!
-
-buttonShiftPress:button x:x y:y
- "mouse-click with shift - adding to selection"
-
- "very simple - just simulate a move"
- ^ self buttonMotion:(device button1MotionMask) x:x y:y
-!
-
-buttonMultiPress:button x:x y:y
- "multi-mouse-click - select word under pointer"
-
- |sel|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- clickCount notNil ifTrue:[
- clickCount := clickCount + 1.
- (clickCount == 2) ifTrue:[
- self selectWordAtX:x y:y.
- "
- special - if clicked on a parenthesis, select to matching
- "
- ((sel := self selection) size == 1
- and:[(sel := sel at:1) size == 1]) ifTrue:[
- ('()[]{}<>' includes:(sel at:1)) ifTrue:[
- self searchForMatchingParenthesisFromLine:selectionStartLine col:selectionStartCol
- ifFound:[:line :col |
- |prevLine prevCol|
-
- prevLine := firstLineShown.
- prevCol := leftOffset.
- self selectFromLine:selectionStartLine col:selectionStartCol
- toLine:line col:col.
- "/ undo scroll operation ...
- (')]}>' includes:(sel at:1)) ifTrue:[
- (firstLineShown ~~ prevLine or:[prevCol ~~ leftOffset]) ifTrue:[
- (Delay forSeconds:MatchDelayTime) wait.
- self scrollToLine:prevLine; scrollToCol:prevCol.
- ]
- ] ifFalse:[
- selectionEndLine > (firstLineShown + nFullLinesShown) ifTrue:[
- self makeLineVisible:selectionEndLine.
- (Delay forSeconds:MatchDelayTime) wait.
- self scrollToLine:prevLine; scrollToCol:prevCol.
- ]
- ]
- ]
- ifNotFound:[self showNotFound]
- onError:[device beep].
- selectStyle := nil
- ]
- ].
-
- "
- remember words position in case of a drag following
- "
- wordStartLine := selectionStartLine.
- wordEndLine := selectionEndLine.
- selectStyle == #wordLeft ifTrue:[
- wordStartCol := selectionStartCol + 1
- ] ifFalse:[
- wordStartCol := selectionStartCol.
- ].
- selectStyle == #wordRight ifTrue:[
- wordEndCol := selectionEndCol - 1
- ] ifFalse:[
- wordEndCol := selectionEndCol
- ]
- ] ifFalse:[
- (clickCount == 3) ifTrue:[
- self selectLineAtY:y.
- selectStyle := #line
- ] ifFalse:[
- (clickCount == 4) ifTrue:[
- self selectAll
- ]
- ]
- ]
- ]
- ] ifFalse:[
- super buttonMultiPress:button x:x y:y
- ]
-
- "Modified: 18.11.1995 / 18:30:33 / cg"
-!
-
buttonMotion:buttonMask x:x y:y
"mouse-move while button was pressed - handle selection changes"
@@ -1831,6 +448,101 @@
clickCol := movedCol
!
+buttonMultiPress:button x:x y:y
+ "multi-mouse-click - select word under pointer"
+
+ |sel|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ clickCount notNil ifTrue:[
+ clickCount := clickCount + 1.
+ (clickCount == 2) ifTrue:[
+ self selectWordAtX:x y:y.
+ "
+ special - if clicked on a parenthesis, select to matching
+ "
+ ((sel := self selection) size == 1
+ and:[(sel := sel at:1) size == 1]) ifTrue:[
+ ('()[]{}<>' includes:(sel at:1)) ifTrue:[
+ self searchForMatchingParenthesisFromLine:selectionStartLine col:selectionStartCol
+ ifFound:[:line :col |
+ |prevLine prevCol|
+
+ prevLine := firstLineShown.
+ prevCol := leftOffset.
+ self selectFromLine:selectionStartLine col:selectionStartCol
+ toLine:line col:col.
+ "/ undo scroll operation ...
+ (')]}>' includes:(sel at:1)) ifTrue:[
+ (firstLineShown ~~ prevLine or:[prevCol ~~ leftOffset]) ifTrue:[
+ (Delay forSeconds:MatchDelayTime) wait.
+ self scrollToLine:prevLine; scrollToCol:prevCol.
+ ]
+ ] ifFalse:[
+ selectionEndLine > (firstLineShown + nFullLinesShown) ifTrue:[
+ self makeLineVisible:selectionEndLine.
+ (Delay forSeconds:MatchDelayTime) wait.
+ self scrollToLine:prevLine; scrollToCol:prevCol.
+ ]
+ ]
+ ]
+ ifNotFound:[self showNotFound]
+ onError:[device beep].
+ selectStyle := nil
+ ]
+ ].
+
+ "
+ remember words position in case of a drag following
+ "
+ wordStartLine := selectionStartLine.
+ wordEndLine := selectionEndLine.
+ selectStyle == #wordLeft ifTrue:[
+ wordStartCol := selectionStartCol + 1
+ ] ifFalse:[
+ wordStartCol := selectionStartCol.
+ ].
+ selectStyle == #wordRight ifTrue:[
+ wordEndCol := selectionEndCol - 1
+ ] ifFalse:[
+ wordEndCol := selectionEndCol
+ ]
+ ] ifFalse:[
+ (clickCount == 3) ifTrue:[
+ self selectLineAtY:y.
+ selectStyle := #line
+ ] ifFalse:[
+ (clickCount == 4) ifTrue:[
+ self selectAll
+ ]
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ super buttonMultiPress:button x:x y:y
+ ]
+
+ "Modified: 18.11.1995 / 18:30:33 / cg"
+!
+
+buttonPress:button x:x y:y
+ "mouse-click - prepare for selection change"
+
+ |clickVisibleLine|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ clickVisibleLine := self visibleLineOfY:y.
+ clickCol := self colOfX:x inVisibleLine:clickVisibleLine.
+ clickLine := self visibleLineToAbsoluteLine:clickVisibleLine.
+ clickStartLine := clickLine.
+ clickStartCol := clickCol.
+ self unselect.
+ clickCount := 1
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+!
+
buttonRelease:button x:x y:y
"mouse- button release - turn off autoScroll if any"
@@ -1841,4 +553,1303 @@
] ifFalse:[
super buttonRelease:button x:x y:y
]
+!
+
+buttonShiftPress:button x:x y:y
+ "mouse-click with shift - adding to selection"
+
+ "very simple - just simulate a move"
+ ^ self buttonMotion:(device button1MotionMask) x:x y:y
+!
+
+keyPress:key x:x y:y
+ "handle some keyboard input (there is not much to be done here)"
+
+ <resource: #keyboard (#Find #Copy #FindNext #FindPrev #SelectAll)>
+
+ (key == #Find) ifTrue:[self search. ^self].
+ (key == #Copy) ifTrue:[self copySelection. ^self].
+
+ (key == #FindNext) ifTrue:[self searchFwd. ^self].
+ (key == #FindPrev) ifTrue:[self searchBwd. ^self].
+
+ (key == #SelectAll) ifTrue:[self selectAll. ^self].
+
+ "
+ shift-Fn defines a key-sequence
+ Fn pastes that sequence
+ cmd-Fn performs a 'doIt' on the sequence (Workspaces only)
+
+ (see EditTextView>>keyPress:x:y and Workspace>>keyPress:x:y)
+ "
+ (('[fF][0-9]' match:key)
+ or:['[fF][0-9][0-9]' match:key]) ifTrue:[
+ device shiftDown ifTrue:[
+ (Smalltalk at:#FunctionKeySequences) isNil ifTrue:[
+ Smalltalk at:#FunctionKeySequences put:Dictionary new
+ ].
+ (Smalltalk at:#FunctionKeySequences) at:key put:(self selection)
+ ].
+ ^ self
+ ].
+
+ super keyPress:key x:x y:y
+!
+
+mapped
+ super mapped.
+ selectionFgColor := selectionFgColor on:device.
+ selectionBgColor := selectionBgColor on:device.
! !
+
+!TextView methodsFor:'initialize & release'!
+
+destroy
+ fileBox notNil ifTrue:[
+ fileBox destroy.
+ fileBox := nil
+ ].
+ searchBox notNil ifTrue:[
+ searchBox destroy.
+ searchBox := nil
+ ].
+ lineNumberBox notNil ifTrue:[
+ lineNumberBox destroy.
+ lineNumberBox := nil
+ ].
+ super destroy
+!
+
+initStyle
+ super initStyle.
+
+ DefaultFont notNil ifTrue:[
+ font := DefaultFont on:device
+ ].
+ viewBackground := DefaultViewBackground.
+ selectionFgColor := DefaultSelectionForegroundColor.
+ selectionFgColor isNil ifTrue:[selectionFgColor := bgColor].
+ selectionBgColor := DefaultSelectionBackgroundColor.
+ selectionBgColor isNil ifTrue:[
+ device hasColors ifTrue:[
+ DefaultSelectionForegroundColor isNil ifTrue:[
+ selectionFgColor := fgColor
+ ].
+ selectionBgColor := Color green
+ ] ifFalse:[
+ device hasGreyscales ifTrue:[
+ DefaultSelectionForegroundColor isNil ifTrue:[
+ selectionFgColor := fgColor
+ ].
+ selectionBgColor := Color grey
+ ] ifFalse:[
+ selectionBgColor := fgColor
+ ]
+ ]
+ ].
+!
+
+initialize
+ super initialize.
+ contentsWasSaved := false.
+
+ "
+ initialize menu to be provided and performed by myself.
+ This allows textViews without a model to provide a
+ reasonable menu AND allows models to provide their own menu.
+ "
+ menuHolder := menuPerformer := self.
+ menuMsg := #editMenu
+! !
+
+!TextView methodsFor:'menu actions'!
+
+appendTo:fileName
+ "append contents to a file named fileName"
+
+ |aStream msg|
+
+ aStream := FileStream appendingOldFileNamed:fileName.
+ aStream isNil ifTrue:[
+ msg := resources string:'cannot append to file %1 !!' with:fileName.
+ self warn:(msg , '\\(' , FileStream lastErrorString , ')' ) withCRs
+ ] ifFalse:[
+ self fileOutContentsOn:aStream.
+ aStream close.
+ contentsWasSaved := true
+ ]
+!
+
+changeFont
+ "pop up a fontPanel to change font"
+
+ |panel|
+
+ panel := FontPanel new.
+ panel action:[:family :face :style :size |
+ self font:(Font family:family
+ face:face
+ style:style
+ size:size)
+ ].
+ panel initialFont:font.
+ panel showAtPointer
+!
+
+copySelection
+ "copy contents into smalltalk copybuffer"
+
+ |text|
+
+ text := self selection.
+ text notNil ifTrue:[
+ self unselect.
+ self setTextSelection:text
+ ]
+!
+
+defaultForGotoLine
+ "return a default value to show in the gotoLine box"
+
+ ^ nil
+!
+
+editMenu
+ |labels selectors m|
+
+ labels := #(
+ 'copy'
+ '-'
+ 'font ...'
+ '-'
+ 'search ...'
+ 'goto ...'
+ '-'
+ 'save as ...'
+ 'print'
+ ).
+
+ selectors := #(
+ copySelection
+ nil
+ changeFont
+ nil
+ search
+ gotoLine
+ nil
+ save
+ print
+ ).
+
+ m := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors.
+
+ self hasSelection ifFalse:[
+ m disable:#copySelection.
+ ].
+ ^ m
+!
+
+gotoLine
+ "show a box to enter lineNumber for positioning"
+
+ |l|
+
+ lineNumberBox isNil ifTrue:[
+ lineNumberBox :=
+ EnterBox
+ title:(resources string:'line number:')
+ okText:(resources string:'goto')
+ abortText:(resources string:'cancel')
+ action:[:l | |num|
+ num := Integer readFromString:l onError:nil.
+ num notNil ifTrue:[self gotoLine:num]
+ ]
+ ].
+ l := self defaultForGotoLine.
+ l notNil ifTrue:[
+ l := l printString
+ ].
+ lineNumberBox initialText:l .
+ lineNumberBox showAtPointer
+!
+
+print
+ "print the contents on the printer"
+
+ |printStream|
+
+ list isNil ifTrue:[^ self].
+ printStream := Printer new.
+ printStream notNil ifTrue:[
+ self fileOutContentsOn:printStream.
+ printStream close
+ ]
+!
+
+save
+ "save contents into a file
+ - ask user for filename using a fileSelectionBox."
+
+ fileBox isNil ifTrue:[
+ fileBox := FileSaveBox
+ title:(resources string:'save contents in:')
+ okText:(resources string:'save')
+ abortText:(resources string:'cancel')
+ action:[:fileName | self saveAs:fileName].
+ fileBox appendAction:[:fileName | self appendTo:fileName].
+ ].
+ directoryForFileDialog notNil ifTrue:[
+ fileBox directory:directoryForFileDialog
+ ].
+ fileBox showAtPointer
+!
+
+saveAs:fileName
+ "save contents into a file named fileName"
+
+ |aStream msg|
+
+ aStream := FileStream newFileNamed:fileName.
+ aStream isNil ifTrue:[
+ msg := resources string:'cannot write file %1 !!' with:fileName.
+ self warn:(msg , '\\(' , FileStream lastErrorString , ')' ) withCRs
+ ] ifFalse:[
+ self fileOutContentsOn:aStream.
+ aStream close.
+ contentsWasSaved := true
+ ]
+! !
+
+!TextView methodsFor:'private'!
+
+fileOutContentsOn:aStream
+ "save contents on a stream, replacing leading spaces by tab-characters."
+
+ self fileOutContentsOn:aStream compressTabs:true
+!
+
+fileOutContentsOn:aStream compressTabs:compressTabs
+ "save contents on a stream. If compressTabs is true,
+ leading spaces will be replaced by tab-characters in the output."
+
+ |startNr nLines string|
+
+ "on some systems, writing linewise is very slow (via NFS)
+ therefore we convert to a string and write it in big chunks.
+ To avoid creating huge strings, we do it in blocks of 1000 lines,
+ limiting temporary string creation to about 50-80k.
+ "
+ startNr := 1.
+ nLines := list size.
+ [startNr <= nLines] whileTrue:[
+ string := list asStringWithCRsFrom:startNr
+ to:((startNr + 1000) min:nLines)
+ compressTabs:compressTabs.
+ aStream nextPutAll:string.
+ startNr := startNr + 1000 + 1.
+ ].
+
+"/ "the old (obsolete) code:"
+"/
+"/ list do:[:aLine |
+"/ aLine notNil ifTrue:[
+"/ aStream nextPutAll:aLine.
+"/ ].
+"/ aStream cr
+"/ ]
+
+!
+
+scrollSelectDown
+ "auto scroll action; scroll and reinstall timed-block"
+
+ |prevEndLine|
+
+ "just to make certain ..."
+ selectionEndLine isNil ifTrue:[^ self].
+
+ self scrollDown.
+
+ "make new selection immediately visible"
+ prevEndLine := selectionEndLine.
+ selectionEndLine := firstLineShown + nFullLinesShown.
+ selectionEndCol := 0.
+ prevEndLine to:selectionEndLine do:[:lineNr |
+ self redrawLine:lineNr
+ ].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+scrollSelectLeft
+ "auto scroll action; scroll and reinstall timed-block"
+
+ |prevStartLine|
+
+ "just to make certain ..."
+ selectionStartLine isNil ifTrue:[^ self].
+ selectionStartCol isNil ifTrue:[^ self].
+
+ "make new selection immediately visible"
+ prevStartLine := selectionStartLine.
+ selectionStartCol := selectionStartCol - 1 max:1.
+ self scrollLeft.
+
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+scrollSelectRight
+ "auto scroll action; scroll and reinstall timed-block"
+
+ |prevEndCol|
+
+ "just to make certain ..."
+ selectionEndCol isNil ifTrue:[^ self].
+
+ prevEndCol := selectionEndCol.
+ selectionEndCol := selectionEndCol + 1.
+ self scrollRight.
+
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+scrollSelectUp
+ "auto scroll action; scroll and reinstall timed-block"
+
+ |prevStartLine|
+
+ "just to make certain ..."
+ selectionStartLine isNil ifTrue:[^ self].
+
+ self scrollUp.
+
+ "make new selection immediately visible"
+ prevStartLine := selectionStartLine.
+ selectionStartLine := firstLineShown.
+ selectionStartCol := 1.
+ selectionStartLine to:prevStartLine do:[:lineNr |
+ self redrawLine:lineNr
+ ].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+!
+
+stopScrollSelect
+ "stop auto scroll; deinstall timed-block"
+
+ autoScrollBlock notNil ifTrue:[
+ Processor removeTimedBlock:autoScrollBlock.
+ self compressMotionEvents:true.
+ autoScrollBlock := nil.
+ autoScrollDeltaT := nil
+ ]
+!
+
+widthForScrollBetween:firstLine and:lastLine
+ "return the width in pixels for a scroll between firstLine and lastLine"
+
+ selectionStartLine notNil ifTrue:[
+ (lastLine < selectionStartLine) ifFalse:[
+ (firstLine > selectionEndLine) ifFalse:[
+ ^ width
+ ]
+ ]
+ ].
+ ^ super widthForScrollBetween:firstLine and:lastLine
+! !
+
+!TextView methodsFor:'redrawing'!
+
+clearMarginOfVisible:visLine with:color
+ "if there is a margin, clear it - a helper for selection drawing"
+
+ (leftMargin ~~ 0) ifTrue:[
+ self paint:color.
+ self fillRectangleX:margin
+ y:(self yOfVisibleLine:visLine)
+ width:leftMargin
+ height:fontHeight
+ ]
+!
+
+redrawFromVisibleLine:startVisLineNr to:endVisLineNr
+ "redraw a visible line range"
+
+ |startLine endLine specialCare end selVisStart line1 line2|
+
+ shown ifFalse:[^ self].
+
+ end := endVisLineNr.
+ (end > nLinesShown) ifTrue:[
+ end := nLinesShown
+ ].
+
+ selectionStartLine isNil ifTrue:[
+ specialCare := false
+ ] ifFalse:[
+ startLine := self visibleLineToAbsoluteLine:startVisLineNr.
+ (startLine > selectionEndLine) ifTrue:[
+ specialCare := false
+ ] ifFalse:[
+ endLine := self visibleLineToAbsoluteLine:end.
+ (endLine < selectionStartLine) ifTrue:[
+ specialCare := false
+ ] ifFalse:[
+ specialCare := true
+ ]
+ ]
+ ].
+
+ "easy: nothing is selected"
+ specialCare ifFalse:[
+ super redrawFromVisibleLine:startVisLineNr to:end.
+ ^ self
+ ].
+
+ "easy: all is selected"
+ ((selectionStartLine < startLine) and:[selectionEndLine > endLine]) ifTrue:[
+ self drawFromVisibleLine:startVisLineNr to:end with:selectionFgColor
+ and:selectionBgColor.
+ ^ self
+ ].
+
+ (selectionStartLine >= firstLineShown) ifTrue:[
+ "draw unselected top part"
+
+ selVisStart := self listLineToVisibleLine:selectionStartLine.
+ super redrawFromVisibleLine:startVisLineNr to:(selVisStart - 1).
+
+ "and first partial selected line"
+ self redrawVisibleLine:selVisStart.
+
+ "rest starts after this one"
+ line1 := selVisStart + 1
+ ] ifFalse:[
+ line1 := 1
+ ].
+
+ (line1 > end) ifTrue:[^ self].
+ (line1 < startVisLineNr) ifTrue:[
+ line1 := startVisLineNr
+ ].
+
+ "draw middle part of selection"
+
+ (selectionEndLine >= (firstLineShown + nLinesShown)) ifTrue:[
+ line2 := nLinesShown
+ ] ifFalse:[
+ line2 := (self listLineToVisibleLine:selectionEndLine) - 1
+ ].
+ (line2 > end) ifTrue:[
+ line2 := end
+ ].
+
+ self drawFromVisibleLine:line1 to:line2 with:selectionFgColor
+ and:selectionBgColor.
+
+ (line2 >= end) ifTrue:[^ self].
+
+ "last line of selection"
+ self redrawVisibleLine:(line2 + 1).
+
+ ((line2 + 2) <= end) ifTrue:[
+ super redrawFromVisibleLine:(line2 + 2) to:end
+ ]
+!
+
+redrawVisibleLine:visLine
+ "redraw visible line lineNr"
+
+ |len line l|
+
+ selectionStartLine notNil ifTrue:[
+ line := self visibleLineToAbsoluteLine:visLine.
+ (line between:selectionStartLine and:selectionEndLine) ifTrue:[
+ (line == selectionStartLine) ifTrue:[
+ (line == selectionEndLine) ifTrue:[
+ "its part-of-single-line selection"
+ self clearMarginOfVisible:visLine with:bgColor.
+ (selectionStartCol > 1) ifTrue:[
+ super redrawVisibleLine:visLine
+ from:1
+ to:(selectionStartCol - 1)
+ ].
+ self drawVisibleLine:visLine from:selectionStartCol
+ to:selectionEndCol
+ with:selectionFgColor
+ and:selectionBgColor.
+ super redrawVisibleLine:visLine
+ from:(selectionEndCol + 1).
+ ^ self
+ ].
+
+ "its the first line of a multi-line selection"
+ (selectionStartCol ~~ 1) ifTrue:[
+ self clearMarginOfVisible:visLine with:bgColor.
+ super redrawVisibleLine:visLine
+ from:1
+ to:(selectionStartCol - 1)
+ ] ifFalse:[
+ leftOffset == 0 ifTrue:[
+ self clearMarginOfVisible:visLine with:selectionBgColor.
+ ]
+ ].
+ self drawVisibleLine:visLine from:selectionStartCol
+ with:selectionFgColor and:selectionBgColor.
+ ^ self
+ ].
+
+ (line == selectionEndLine) ifTrue:[
+ "its the last line of a multi-line selection"
+ (selectionEndCol == 0) ifTrue:[
+ ^ super redrawVisibleLine:visLine
+ ].
+ l := self visibleAt:selectionEndLine.
+ len := l size.
+
+ self clearMarginOfVisible:visLine with:selectionBgColor.
+ self drawVisibleLine:visLine from:1 to:selectionEndCol
+ with:selectionFgColor and:selectionBgColor.
+ super redrawVisibleLine:visLine from:(selectionEndCol + 1).
+ ^ self
+ ].
+
+ "its a full line in a multi-line selection"
+ self clearMarginOfVisible:visLine with:selectionBgColor.
+ self drawVisibleLine:visLine with:selectionFgColor and:selectionBgColor.
+ ^ self
+ ]
+ ].
+ super redrawVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine col:col
+ "redraw single character at col in visible line lineNr"
+
+ |line|
+
+ line := self visibleLineToAbsoluteLine:visLine.
+ selectionStartLine notNil ifTrue:[
+ (line between:selectionStartLine and:selectionEndLine) ifTrue:[
+ ((line == selectionStartLine)
+ and: [col < selectionStartCol]) ifFalse:[
+ ((line == selectionEndLine)
+ and: [col > selectionEndCol]) ifFalse:[
+ "its in the selection"
+ self drawVisibleLine:visLine col:col with:selectionFgColor
+ and:selectionBgColor.
+ ^ self
+ ]
+ ]
+ ]
+ ].
+ super redrawVisibleLine:visLine col:col
+!
+
+redrawVisibleLine:visLine from:startCol
+ "redraw visible line lineNr from startCol to end of line"
+
+ |line|
+
+ line := self visibleLineToAbsoluteLine:visLine.
+ selectionStartLine notNil ifTrue:[
+ (line between:selectionStartLine and:selectionEndLine) ifTrue:[
+ ((line == selectionStartLine)
+ or:[line == selectionEndLine]) ifTrue:[
+ "since I'm lazy, redraw full line"
+ self redrawVisibleLine:visLine.
+ ^ self
+ ].
+ "the line is fully within the selection"
+ self drawVisibleLine:visLine from:startCol with:selectionFgColor
+ and:selectionBgColor.
+ ^ self
+ ]
+ ].
+ super redrawVisibleLine:visLine from:startCol
+!
+
+redrawVisibleLine:visLine from:startCol to:endCol
+ "redraw visible line lineNr from startCol to endCol"
+
+ |line allOut allIn leftCol rightCol|
+
+ line := self visibleLineToAbsoluteLine:visLine.
+
+ allIn := false.
+ allOut := false.
+ selectionStartLine isNil ifTrue:[
+ allOut := true
+ ] ifFalse:[
+ (line between:selectionStartLine and:selectionEndLine) ifFalse:[
+ allOut := true
+ ] ifTrue:[
+ (selectionStartLine == selectionEndLine) ifTrue:[
+ ((endCol < selectionStartCol)
+ or:[startCol > selectionEndCol]) ifTrue:[
+ allOut := true
+ ] ifFalse:[
+ ((startCol >= selectionStartCol)
+ and:[endCol <= selectionEndCol]) ifTrue:[
+ allIn := true
+ ]
+ ]
+ ] ifFalse:[
+ (line == selectionStartLine) ifTrue:[
+ (endCol < selectionStartCol) ifTrue:[
+ allOut := true
+ ] ifFalse:[
+ (startCol >= selectionStartCol) ifTrue:[
+ allIn := true
+ ]
+ ]
+ ] ifFalse:[
+ (line == selectionEndLine) ifTrue:[
+ (startCol > selectionEndCol) ifTrue:[
+ allOut := true
+ ] ifFalse:[
+ (endCol <= selectionEndCol) ifTrue:[
+ allIn := true
+ ]
+ ]
+ ] ifFalse:[
+ allIn := true
+ ]
+ ]
+ ]
+ ]
+ ].
+ allOut ifTrue:[
+ super redrawVisibleLine:visLine from:startCol to:endCol.
+ ^ self
+ ].
+
+ allIn ifTrue:[
+ self drawVisibleLine:visLine from:startCol to:endCol
+ with:selectionFgColor and:selectionBgColor
+ ] ifFalse:[
+ "redraw part before selection"
+ ((line == selectionStartLine)
+ and:[startCol <= selectionStartCol]) ifTrue:[
+ super redrawVisibleLine:visLine from:startCol
+ to:(selectionStartCol - 1).
+ leftCol := selectionStartCol
+ ] ifFalse:[
+ leftCol := startCol
+ ].
+ "redraw selected part"
+ (selectionEndLine > line) ifTrue:[
+ rightCol := endCol
+ ] ifFalse:[
+ rightCol := selectionEndCol min:endCol
+ ].
+ self drawVisibleLine:visLine from:leftCol to:rightCol
+ with:selectionFgColor and:selectionBgColor.
+
+ "redraw part after selection"
+ (rightCol < endCol) ifTrue:[
+ super redrawVisibleLine:visLine from:(rightCol + 1) to:endCol
+ ]
+ ].
+
+ "special care for first and last line of selection:
+ must handle margin also"
+
+ ((line == selectionEndLine)
+ and:[(startCol == 1)
+ and:[selectionStartLine < selectionEndLine]])
+ ifTrue:[
+ self clearMarginOfVisible:visLine with:selectionBgColor.
+ ].
+
+ ((line == selectionStartLine)
+ and:[(startCol == 1)
+ and:[selectionStartLine < selectionEndLine]])
+ ifTrue:[
+ self clearMarginOfVisible:visLine with:bgColor.
+ ]
+! !
+
+!TextView methodsFor:'searching'!
+
+search
+ "show a box to enter searchpattern
+ - currently no regular expressions are handled."
+
+ "
+ cache the searchBox
+ Q: should we use one global searchBox for all textViews ?
+ (we could then preserve the last searchstring between views)
+ "
+
+"/ "soon to come: search & replace box ...
+"/ |box|
+"/
+"/ box := Dialog new.
+"/ (box addTextLabel:(resources at:'searchPattern:')) layout:#left.
+"/ box addVerticalSpace.
+"/ box addInputFieldOn:'' asValue.
+"/ box addVerticalSpace.
+"/ (box addTextLabel:(resources at:'replace with:')) layout:#left.
+"/ box addVerticalSpace.
+"/ box addInputFieldOn:'' asValue.
+"/ box addAbortButtonLabelled:(resources at:'cancel');
+"/ addButton:(Button label:(resources at:'all'));
+"/ addButton:(Button label:(resources at:'prev'));
+"/ addOkButtonLabelled:(resources at:'next').
+"/ box open.
+
+ searchBox isNil ifTrue:[
+ searchBox :=
+ EnterBox2
+ title:(resources at:'searchPattern:')
+ okText1:(resources at:'prev')
+ okText2:(resources at:'next')
+ abortText:(resources at:'cancel')
+ action1:[:pattern | pattern notEmpty ifTrue:[self searchBwd:(pattern withoutSeparators)]]
+ action2:[:pattern | pattern notEmpty ifTrue:[self searchFwd:(pattern withoutSeparators)]]
+ ].
+ searchPattern notNil ifTrue:[
+ searchBox initialText:searchPattern
+ ].
+ self hasSelection ifTrue:[
+ selectionStartLine == selectionEndLine ifTrue:[
+ searchBox initialText:self selection
+ ]
+ ].
+ searchBox showAtPointer
+!
+
+searchBwd
+ "search backward and -if found- position cursor"
+
+ self setSearchPattern.
+ searchPattern notNil ifTrue:[
+ self searchBwd:searchPattern
+ ]
+!
+
+searchBwd:pattern
+ "do a backward search"
+
+ self searchBwd:pattern ifAbsent:[self showNotFound].
+ searchPattern := pattern
+
+!
+
+searchBwd:pattern ifAbsent:aBlock
+ "do a backward search"
+
+ |startLine startCol|
+
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ startLine := 1.
+ startCol := 1
+ ].
+ self searchBackwardFor:pattern startingAtLine:startLine col:startCol
+ ifFound:[:line :col |
+ self showMatch:pattern atLine:line col:col
+ ] 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."
+
+ ^ self
+ searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+ ignoring:#( $' $" )
+
+ "Modified: 18.11.1995 / 16:28:23 / cg"
+!
+
+searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+ ignoring:ignoreSet
+ "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 closingChar
+ ignoring delta endCol cc incSet decSet nesting maxLine|
+
+ charSet := #( $( $) $[ $] ${ $} ).
+
+ 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
+
+ "Modified: 18.11.1995 / 16:30:56 / cg"
+!
+
+searchFwd
+ "search forward for pattern or selection"
+
+ selectStyle == #wordLeft ifTrue:[
+ "
+ remove the space from the selection
+ "
+ selectionStartCol := selectionStartCol + 1.
+ super redrawLine:selectionStartLine from:selectionStartCol-1 to:selectionStartCol-1.
+ ].
+ self setSearchPattern.
+ searchPattern notNil ifTrue:[
+ self searchFwd:searchPattern
+ ]
+!
+
+searchFwd:pattern
+ "do a forward search"
+
+ self searchFwd:pattern ifAbsent:[self showNotFound].
+ searchPattern := pattern
+!
+
+searchFwd:pattern ifAbsent:aBlock
+ "do a forward search"
+
+ |startLine startCol|
+
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ startLine := 1.
+ startCol := 1
+ ].
+ self searchForwardFor:pattern startingAtLine:startLine col:startCol
+ ifFound:[:line :col |
+ self showMatch:pattern atLine:line col:col
+ ] ifAbsent:aBlock
+!
+
+searchPattern
+ "return the last search pattern"
+
+ ^ searchPattern
+!
+
+setSearchPattern
+ "set the searchpattern from the selection if there is one"
+
+ |sel|
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ searchPattern := sel asString withoutSeparators
+ ]
+!
+
+setSearchPattern:aString
+ "set the searchpattern for future searches"
+
+ aString isNil ifTrue:[
+ searchPattern := aString
+ ] ifFalse:[
+ searchPattern := aString withoutSeparators
+ ]
+!
+
+showMatch:pattern atLine:line col:col
+ "after a search, highlight the matched pattern.
+ The code below needs a rewrite to take care of match-characters
+ (for now, it only highlights simple patterns and '*string*' correctly)"
+
+ |realPattern|
+
+ realPattern := pattern.
+ (realPattern startsWith:$*) ifTrue:[
+ realPattern := realPattern copyFrom:2
+ ].
+ (realPattern endsWith:$*) ifTrue:[
+ realPattern := realPattern copyWithoutLast:1
+ ].
+
+ self selectFromLine:line col:col
+ toLine:line col:(col + realPattern size - 1).
+ self makeLineVisible:line
+!
+
+showNotFound
+ "search not found - tell user by beeping and changing
+ cursor for a while (sometimes I work with a headset :-)
+ (used to be: tell user by changing cursor for a while)"
+
+ |savedCursor|
+
+ device beep.
+
+"
+ uncomment if you want a CROSS cursor to be shown for a while ..
+"
+
+" "
+ savedCursor := cursor.
+ self cursor:(Cursor cross).
+ OperatingSystem millisecondDelay:300.
+ self cursor:savedCursor
+" "
+! !
+
+!TextView methodsFor:'selections'!
+
+hasSelection
+ "return true, if there is a selection"
+
+ ^ selectionStartLine notNil
+!
+
+makeSelectionVisible
+ "scroll to make the selection visible"
+
+ selectionStartLine notNil ifTrue:[
+ self makeLineVisible:selectionStartLine
+ ]
+!
+
+selectAll
+ "select the whole text"
+
+ self selectFromLine:1 col:1 toLine:(list size + 1) col:0
+!
+
+selectFromCharacterPosition:pos1 to:pos2
+ "compute line/col from character positions and select the text"
+
+ |line1 col1 line2 col2|
+
+ line1 := self lineOfCharacterPosition:pos1.
+ col1 := pos1 - (self characterPositionOfLine:line1 col:1) + 1.
+ line2 := self lineOfCharacterPosition:pos2.
+ col2 := pos2 - (self characterPositionOfLine:line2 col:1) + 1.
+ self selectFromLine:line1 col:col1 toLine:line2 col:col2
+!
+
+selectFromLine:startLine col:startCol toLine:endLine col:endCol
+ "select a piece of text and redraw that area"
+
+ self unselect.
+ startLine notNil ifTrue:[
+ "new:"
+ endLine < startLine ifTrue:[
+ ^ self selectFromLine:endLine col:endCol toLine:startLine col:startCol
+ ].
+ (endLine == startLine and:[endCol < startCol]) ifTrue:[
+ endCol ~~ 0 ifTrue:[
+ self selectFromLine:endLine col:endCol toLine:startLine col:startCol.
+ ].
+ ^ self
+ ].
+
+" old:
+ endLine < startLine ifTrue:[^ self].
+ (startLine == endLine and:[endCol < startCol]) ifTrue:[^ self].
+"
+ selectionStartLine := startLine.
+ selectionStartCol := startCol.
+ selectionEndLine := endLine.
+ selectionEndCol := endCol.
+ (startLine == endLine) ifTrue:[
+ self redrawLine:startLine from:startCol to:endCol
+ ] ifFalse:[
+ startLine to:endLine do:[:lineNr |
+ self redrawLine:lineNr
+ ]
+ ].
+ selectStyle := nil.
+ ]
+!
+
+selectLine:selectLine
+ "select one line and redraw it"
+
+ self selectFromLine:selectLine col:1 toLine:(selectLine + 1) col:0.
+ wordStartCol := selectionStartCol.
+ wordEndCol := selectionEndCol.
+ wordStartLine := selectionStartLine.
+ wordEndLine := selectionEndLine.
+ selectStyle := #line
+!
+
+selectLineAtY:y
+ "select the line at given y-(view-)coordinate"
+
+ |selectVisibleLine selectLine|
+
+ selectVisibleLine := self visibleLineOfY:y.
+ selectLine := self visibleLineToListLine:selectVisibleLine.
+ selectLine notNil ifTrue:[
+ self selectLine:selectLine
+ ]
+!
+
+selectLineWhereCharacterPosition:pos
+ "select the line, where characterPosition pos is living.
+ The argument pos starts at 1 from the start of the text
+ and counts characters (i.e. can be used to convert from
+ character position within a string to line-position in view)."
+
+ self selectLine:(self lineOfCharacterPosition:pos)
+!
+
+selectWordAtLine:line col:col
+ "select the word at given line/col"
+
+ self wordAtLine:line col:col do:[
+ :beginLine :beginCol :endLine :endCol :style |
+
+ self selectFromLine:beginLine col:beginCol toLine:endLine col:endCol.
+ selectStyle := style
+ ]
+!
+
+selectWordAtX:x y:y
+ "select the word at given x/y-(view-)coordinate"
+
+ |selectVisibleLine selectLine selectCol|
+
+ selectStyle := nil.
+ selectVisibleLine := self visibleLineOfY:y.
+ selectLine := self visibleLineToListLine:selectVisibleLine.
+ selectLine notNil ifTrue:[
+ selectCol := self colOfX:x inVisibleLine:selectLine.
+ self selectWordAtLine:selectLine col:selectCol
+ ]
+!
+
+selection
+ "return the selection as a collection of (line-)strings.
+ If the selection ends in a full line, the last entry in the returned
+ collection will be an empty string."
+
+ |text sz index last
+ startLine "{ Class: SmallInteger }"
+ endLine "{ Class: SmallInteger }"|
+
+ selectionStartLine isNil ifTrue:[^ nil].
+ startLine := selectionStartLine.
+ endLine := selectionEndLine.
+
+ (startLine == endLine) ifTrue:[
+ "part of a line"
+ ^ StringCollection with:(self listAt:startLine
+ from:selectionStartCol
+ to:selectionEndCol)
+ ].
+ sz := endLine - startLine + 1.
+ text := StringCollection new:sz.
+
+ "get 1st and last (possibly) partial lines"
+ text at:1 put:(self listAt:startLine from:selectionStartCol).
+ selectionEndCol == 0 ifTrue:[
+ last := ''
+ ] ifFalse:[
+ last := self listAt:selectionEndLine to:selectionEndCol.
+ ].
+ text at:sz put:last.
+
+ "get bulk of text"
+ index := 2.
+ (startLine + 1) to:(endLine - 1) do:[:lineNr |
+ text at:index put:(self listAt:lineNr).
+ index := index + 1
+ ].
+ ^ text
+!
+
+selectionEndCol
+ ^ selectionEndCol
+!
+
+selectionEndLine
+ ^ selectionEndLine
+!
+
+selectionStartCol
+ ^ selectionStartCol
+!
+
+selectionStartLine
+ ^ selectionStartLine
+!
+
+unselect
+ "unselect - if there was a selection redraw that area"
+
+ |startLine endLine startVisLine endVisLine|
+
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ endLine := selectionEndLine.
+ selectionStartLine := nil.
+
+ "if selection is not visible, we are done"
+ startLine >= (firstLineShown + nLinesShown) ifTrue:[^ self].
+ endLine < firstLineShown ifTrue:[^ self].
+
+ startLine < firstLineShown ifTrue:[
+ startVisLine := 1
+ ] ifFalse:[
+ startVisLine := self listLineToVisibleLine:startLine
+ ].
+ endLine >= (firstLineShown + nLinesShown) ifTrue:[
+ endVisLine := nLinesShown
+ ] ifFalse:[
+ endVisLine := self listLineToVisibleLine:endLine
+ ].
+ "if its only part of a line, just redraw what has to be"
+ (startVisLine == endVisLine) ifTrue:[
+ super redrawVisibleLine:startVisLine from:selectionStartCol to:selectionEndCol
+ ] ifFalse:[
+ super redrawFromVisibleLine:startVisLine to:endVisLine
+ ].
+ self unselectWithoutRedraw
+ ].
+ selectStyle := nil
+!
+
+unselectWithoutRedraw
+ "forget selection but do not redraw the selection area
+ - can be done when the selected area is redrawn anyway or
+ known to be invisible."
+
+ selectionStartLine := nil.
+!
+
+validateNewSelection
+ ^ self
+!
+
+wordAtLine:selectLine col:selectCol do:aFiveArgBlock
+ "find word boundaries, evaluate the block argument with those.
+ A helper for nextWord and selectWord functions."
+
+ |beginCol endCol endLine thisCharacter flag|
+
+ flag := #word.
+ beginCol := selectCol.
+ endCol := selectCol.
+ endLine := selectLine.
+ thisCharacter := self characterAtLine:selectLine col:beginCol.
+
+ beginCol := self findBeginOfWordAtLine:selectLine col:selectCol.
+ endCol := self findEndOfWordAtLine:selectLine col:selectCol.
+ endCol == 0 ifTrue:[
+ endLine := selectLine + 1
+ ].
+
+ "is the initial acharacter within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ "
+ try to catch a blank ...
+ "
+ ((beginCol == 1)
+ or:[(self characterAtLine:selectLine col:(beginCol - 1))
+ ~~ Character space]) ifTrue:[
+ ((self characterAtLine:selectLine col:(endCol + 1))
+ == Character space) ifTrue:[
+ endCol := endCol + 1.
+ flag := #wordRight
+ ]
+ ] ifFalse:[
+ beginCol := beginCol - 1.
+ flag := #wordLeft
+ ].
+ ].
+ aFiveArgBlock value:selectLine
+ value:beginCol
+ value:endLine
+ value:endCol
+ value:flag
+! !
+
+!TextView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.30 1995-12-10 16:52:50 cg Exp $'
+! !