--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/EditTextView.st Thu May 08 10:30:56 2014 +0200
@@ -0,0 +1,8619 @@
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+'From Smalltalk/X, Version:6.2.3.0 on 18-02-2014 at 18:37:41' !
+
+"{ Package: 'stx:libwidg' }"
+
+TextView subclass:#EditTextView
+ instanceVariableNames:'cursorLine cursorVisibleLine cursorCol cursorShown
+ prevCursorState readOnly modifiedChannel fixedSize exceptionBlock
+ cursorFgColor cursorBgColor cursorNoFocusFgColor cursorType
+ cursorTypeNoFocus typeOfSelection lastAction replacing
+ showMatchingParenthesis hasKeyboardFocus acceptAction lockUpdates
+ tabMeansNextField autoIndent insertMode editMode trimBlankLines
+ wordWrap replacementWordSelectStyle acceptChannel acceptEnabled
+ st80Mode disableIfInvisible cursorMovementWhenUpdating learnMode
+ learnedMacro cursorLineHolder cursorColHolder tabRequiresControl
+ undoSupport lastStringFromReplaceForNextSearch
+ lastReplacementInfo completionSupport codeAspectHolder'
+ classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
+ DefaultCursorType DefaultCursorNoFocusForegroundColor
+ DefaultCursorTypeNoFocus LastColumnNumberForSort Macros'
+ poolDictionaries:''
+ category:'Views-Text'
+!
+
+Object subclass:#EditAction
+ instanceVariableNames:'userFriendlyInfo'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditAction subclass:#DeleteRange
+ instanceVariableNames:'line1 col1 line2 col2'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditAction subclass:#DeleteCharacters
+ instanceVariableNames:'line col1 col2'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+Object subclass:#EditMode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditMode subclass:#InsertAndSelectMode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView::EditMode
+!
+
+EditTextView::EditMode subclass:#InsertMode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView::EditMode
+!
+
+EditTextView::EditMode subclass:#OverwriteMode
+ instanceVariableNames:''
+ classVariableNames:'InsertMode OverwriteMode InsertAndSelectMode'
+ poolDictionaries:''
+ privateIn:EditTextView::EditMode
+!
+
+Query subclass:#ExecutingMacroQuery
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+Object subclass:#LastReplacementInfo
+ instanceVariableNames:'lastReplacement lastStringToReplace lastReplaceWasMatch
+ lastReplaceIgnoredCase stillCollectingInput previousReplacements'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditAction subclass:#PasteString
+ instanceVariableNames:'line col string selected'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditAction subclass:#ReplaceCharacter
+ instanceVariableNames:'line col character'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditAction subclass:#ReplaceCharacters
+ instanceVariableNames:'line col1 col2 characters'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditAction subclass:#ReplaceContents
+ instanceVariableNames:'text'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditAction subclass:#ReplaceLine
+ instanceVariableNames:'line text'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+EditTextView::EditAction subclass:#ReplaceLines
+ instanceVariableNames:'line text'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:EditTextView
+!
+
+!EditTextView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ a view for editable text - adds editing functionality to TextView
+ Also, it adds accept functionality, and defines a new actionBlock:
+ acceptAction to be performed for accept
+
+ If used with a model, this is informed by sending it a changeMsg with
+ the current contents as argument.
+ (however, it is possible to define both changeMsg and acceptAction)
+
+ Please read the historic notice in the ListView class.
+
+ [Instance variables:]
+
+ cursorLine <Number> line where cursor sits (1..)
+
+ cursorVisibleLine <Number> visible line where cursor sits (1..nLinesShown)
+
+ cursorCol <Number> col where cursor sits (1..)
+
+ cursorShown <Boolean> true, if cursor is currently shown
+
+ readOnly <Boolean> true, if text may not be edited
+
+ modifiedChannel <ValueHolder> holding true, if text has been modified.
+ cleared on accept.
+
+ acceptChannel <ValueHolder> holding true, if text has been accepted.
+
+ fixedSize <Boolean> true, if no lines may be added/removed
+
+ exceptionBlock <Block> block to be evaluated when readonly text is about to be modified
+ if it returns true, the modification will be done anyway.
+ if it returns anything else, the modification is not done.
+
+ cursorFgColor <Color> color used for cursor drawing
+ cursorBgColor <Color> color used for cursor drawing
+
+ cursorType <Symbol> how the cursor is drawn; currently implemented
+ are #none, #block (solid-block cursor), #ibeam
+ (vertical bar at insertion point)
+ and #caret (caret below insertion-point).
+ see cursorType: for an up-to-date list.
+
+ cursorTypeNoFocus <Symbol> like above, if view has no focus
+ nil means: hide the cursor.
+
+ undoAction <Block> block which undoes last cut, paste or replace
+ (not yet fully implemented)
+
+ typeOfSelection <Symbol> #paste, if selection created by paste, nil otherwise
+ this affects the next keyPress: if #paste it does not
+ replace; otherwise it replaces the selection.
+
+ lastCut <String> last cut or replaced string
+
+ lastReplacementInfo <LastReplacementInfo> holds the information about the last replace action
+ lastStringToReplace is the string to be replaced by lastReplacement
+ lastReplacement is the string to replace lastStringToReplace
+
+ lastStringFromReplaceForNextSearch <String> string to be taken be the next search action
+ (cleared after a new selection)
+
+ replacing <Boolean> true if entered characters replace last selection
+
+ showMatchingParenthesis <Boolean> if true, shows matching parenthesis
+ when entering one; this is the default.
+
+ hasKeyboardFocus <Boolean> true if this view has the focus
+
+ acceptAction <Block> accept action - evaluated passing the contents as
+ argument
+
+ tabMeansNextField <Boolean> if true, Tab is ignored as input and shifts keyboard
+ focus to the next field. For editTextViews, this is false
+ by default (i.e. tabs can be entered into the text).
+ For some subclasses (inputFields), this may be true.
+
+ trimBlankLines <Boolean> if true, trailing blanks are
+ removed when editing.
+ Default is true.
+
+ wordWrap <Boolean> Currently not used.
+
+ lockUpdates <Boolean> internal, private
+
+ prevCursorState <Boolean> temporary, private
+
+ cursorMovementWhenUpdating
+ <Symbol> defines where the cursor is to be positioned if the
+ model changes its value by some outside activity
+ (i.e. not by user input into the field).
+ Can be one of:
+ #keep / nil -> stay where it was
+ #endOfText -> cursor to the end
+ #endOfLine -> stay in the line, but move to end
+ #beginOfText -> cursor to the beginning
+ #beginOfLine -> stay in the line, but move to begin
+ The default is #beginOfText
+
+
+
+ dropTarget <DropTarget|nil> drop operation descriptor or nil (drop disabled)
+
+
+ userPreference values:
+ userPreferences.st80EditMode
+ <Boolean> if true, cursor positioning is
+ done as in vi or ST80; i.e.
+ wysiwyg mode is somewhat relaxed,
+ in that the cursor cannot be
+ positioned behind a lines end.
+ This is not yet completely implemented.
+ used globals:
+
+ DeleteHistory <Text> last 1000 lines of deleted text
+ (but only if this variable exists already)
+
+ [styleSheet parameters:]
+
+ textCursorForegroundColor <Color> cursor fg color; default: text background
+ textCursorBackgroundColor <Color> cursor bg color; default: text foreground
+ textCursorNoFocusForegroundColor
+ <Color> cursor fg color if no focus; default: cursor fg color
+ textCursorType <Symbol> cursor type; default: #block
+
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ CodeView Workspace TextView ListView
+ EditField
+"
+!
+
+examples
+"
+ non MVC operation:
+
+ basic setup:
+ [exBegin]
+ |top textView|
+
+ top := StandardSystemView new.
+ top extent:300@200.
+
+ textView := EditTextView new.
+ textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ top addSubView:textView.
+
+ textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
+
+ top open.
+ [exEnd]
+
+
+ with vertical scrollbar:
+ [exBegin]
+ |top scrollView textView|
+
+ top := StandardSystemView new.
+ top extent:300@200.
+
+ scrollView := ScrollableView for:EditTextView.
+ textView := scrollView scrolledView.
+ scrollView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ top addSubView:scrollView.
+
+ textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
+
+ top open.
+ [exEnd]
+
+
+ with horizontal & vertical scrollbars:
+ [exBegin]
+ |top scrollView textView|
+
+ top := StandardSystemView new.
+ top extent:300@200.
+
+ scrollView := HVScrollableView for:EditTextView.
+ textView := scrollView scrolledView.
+ scrollView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ top addSubView:scrollView.
+
+ textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
+
+ top open.
+ [exEnd]
+
+
+ set the action for accept:
+ [exBegin]
+ |top textView|
+
+ top := StandardSystemView new.
+ top extent:300@200.
+
+ textView := EditTextView new.
+ textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ top addSubView:textView.
+
+ textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
+ textView acceptAction:[:contents |
+ Transcript showCR:'will not overwrite the file with:'.
+ Transcript showCR:contents asString
+ ].
+ top open.
+ [exEnd]
+
+
+
+ non-string (text) items:
+ [exBegin]
+ |top textView list|
+
+ list := '/etc/hosts' asFilename contentsOfEntireFile asStringCollection.
+ 1 to:list size by:2 do:[:nr |
+ list at:nr put:(Text string:(list at:nr)
+ emphasis:(Array with:#bold with:(#color->Color red)))
+ ].
+
+ top := StandardSystemView new.
+ top extent:300@200.
+
+ textView := EditTextView new.
+ textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ top addSubView:textView.
+
+ textView contents:list.
+ top open.
+ [exEnd]
+
+
+
+ MVC operation:
+ (the examples model here is a plug simulating a real model;
+ real world applications would not use a plug ..)
+ [exBegin]
+ |top textView model|
+
+ model := Plug new.
+ model respondTo:#accepted:
+ with:[:newContents |
+ Transcript showCR:'will not overwrite the file with:'.
+ Transcript showCR:newContents asString
+ ].
+ model respondTo:#getList
+ with:['/etc/hosts' asFilename contentsOfEntireFile].
+
+
+ top := StandardSystemView new.
+ top extent:300@200.
+
+ textView := EditTextView new.
+ textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ top addSubView:textView.
+
+ textView listMessage:#getList;
+ model:model;
+ changeMessage:#accepted:;
+ aspect:#list.
+ top open.
+ [exEnd]
+
+
+ two textViews on the same model:
+ [exBegin]
+ |top1 textView1 top2 textView2 model currentContents|
+
+ model := Plug new.
+ model respondTo:#accepted:
+ with:[:newContents |
+ Transcript showCR:'accepted:'.
+ Transcript showCR:newContents asString.
+ currentContents := newContents.
+ model changed:#contents
+ ].
+ model respondTo:#getList
+ with:[Transcript showCR:'query'.
+ currentContents].
+
+
+ top1 := StandardSystemView new.
+ top1 extent:300@200.
+
+ textView1 := EditTextView new.
+ textView1 origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ top1 addSubView:textView1.
+
+ textView1 listMessage:#getList;
+ model:model;
+ aspect:#contents;
+ changeMessage:#accepted:.
+ top1 open.
+
+ top2 := StandardSystemView new.
+ top2 extent:300@200.
+
+ textView2 := EditTextView new.
+ textView2 origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ top2 addSubView:textView2.
+
+ textView2 listMessage:#getList;
+ model:model;
+ aspect:#contents;
+ changeMessage:#accepted:.
+ top2 open.
+ [exEnd]
+"
+! !
+
+!EditTextView class methodsFor:'defaults'!
+
+defaultCompletionSupportClass
+ ^ nil
+
+ "Created: / 26-09-2013 / 17:59:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+st80Mode
+ "return true, if the st80 editing mode is turned on.
+ This setting affects the behavior of the cursor, when positioned
+ beyond the end of a line or the end of the text."
+
+ ^ UserPreferences current st80EditMode
+
+ "
+ EditTextView st80Mode:true
+ EditTextView st80Mode:false
+ "
+
+ "Modified: / 16.1.1998 / 22:54:57 / cg"
+!
+
+st80Mode:aBoolean
+ "turns on/off st80 behavior, where the cursor cannot be positioned
+ beyond the end of a line or the last line"
+
+ UserPreferences current st80EditMode:aBoolean.
+
+ "
+ EditTextView st80Mode:true
+ EditTextView st80Mode:false
+ "
+
+ "Modified: / 16.1.1998 / 22:55:19 / cg"
+!
+
+updateStyleCache
+ "extract values from the styleSheet and cache them in class variables"
+
+ <resource: #style (#'textCursor.foregroundColor' #'textCursor.backgroundColor'
+ #'textCursor.noFocusForegroundColor'
+ #'textCursor.type'
+ #'textCursor.typeNoFocus'
+ #'editText.st80Mode')>
+
+ DefaultCursorForegroundColor := StyleSheet colorAt:'textCursor.foregroundColor'.
+ DefaultCursorBackgroundColor := StyleSheet colorAt:'textCursor.backgroundColor'.
+ DefaultCursorNoFocusForegroundColor := StyleSheet colorAt:'textCursor.noFocusForegroundColor'.
+ DefaultCursorType := StyleSheet at:'textCursor.type' default:#block.
+ DefaultCursorTypeNoFocus := StyleSheet at:'textCursor.typeNoFocus'.
+
+ "
+ self updateStyleCache
+ "
+
+ "Modified: / 20.5.1998 / 04:27:41 / cg"
+! !
+
+!EditTextView class methodsFor:'specs'!
+
+searchReplaceDialogSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:DAPASX::ProjectEditorTextView andSelector:#searchReplaceDialogSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: searchReplaceDialogSpec
+ window:
+ (WindowSpec
+ label: 'String Search and Replace'
+ name: 'String Search and Replace'
+ min: (Point 283 196)
+ max: (Point 283 196)
+ bounds: (Rectangle 0 0 279 192)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Search Pattern:'
+ name: 'label'
+ layout: (LayoutFrame 1 0.0 3 0 -1 1.0 20 0)
+ level: 0
+ translateLabel: true
+ adjust: left
+ )
+ (ComboBoxSpec
+ name: 'patternComboBox'
+ layout: (LayoutFrame 3 0.0 26 0 -3 1.0 48 0)
+ tabable: true
+ model: searchPattern
+ immediateAccept: false
+ acceptOnLeave: true
+ acceptOnReturn: true
+ acceptOnTab: true
+ acceptOnLostFocus: true
+ acceptOnPointerLeave: false
+ autoSelectInitialText: true
+ comboList: patternList
+ )
+ (ComboBoxSpec
+ name: 'replaceComboBox'
+ layout: (LayoutFrame 3 0.0 76 0 -3 1.0 98 0)
+ tabable: true
+ model: replacePattern
+ immediateAccept: false
+ acceptOnLeave: true
+ acceptOnReturn: true
+ acceptOnTab: true
+ acceptOnLostFocus: true
+ acceptOnPointerLeave: false
+ autoSelectInitialText: true
+ comboList: patternList
+ )
+ (CheckBoxSpec
+ label: 'Ignore Case'
+ name: 'ignoreCaseCheckBox'
+ layout: (LayoutFrame 3 0.0 107 0 -3 1.0 130 0)
+ level: 0
+ tabable: true
+ model: ignoreCase
+ translateLabel: true
+ )
+ (VariableVerticalPanelSpec
+ name: 'VariableVerticalPanel1'
+ layout: (LayoutFrame 0 0 -64 1 0 1 -4 1)
+ component:
+ (SpecCollection
+ collection: (
+ (HorizontalPanelViewSpec
+ name: 'HorizontalPanel1'
+ level: 0
+ horizontalLayout: fitSpace
+ verticalLayout: center
+ horizontalSpace: 3
+ verticalSpace: 3
+ ignoreInvisibleComponents: true
+ reverseOrderIfOKAtLeft: true
+ component:
+ (SpecCollection
+ collection: (
+ (ActionButtonSpec
+ label: 'Replace'
+ name: 'replaceButton'
+ level: 2
+ translateLabel: true
+ tabable: true
+ model: replaceAction
+ extent: (Point 134 21)
+ )
+ (ActionButtonSpec
+ label: 'Replace All'
+ name: 'replaceAllButton'
+ level: 2
+ borderWidth: 1
+ translateLabel: true
+ tabable: true
+ model: replaceAllAction
+ extent: (Point 134 21)
+ )
+ )
+
+ )
+ )
+ (HorizontalPanelViewSpec
+ name: 'horizontalPanelView'
+ level: 0
+ horizontalLayout: fitSpace
+ verticalLayout: center
+ horizontalSpace: 3
+ verticalSpace: 3
+ ignoreInvisibleComponents: true
+ reverseOrderIfOKAtLeft: true
+ component:
+ (SpecCollection
+ collection: (
+ (ActionButtonSpec
+ label: 'Cancel'
+ name: 'cancelButton'
+ level: 2
+ translateLabel: true
+ tabable: true
+ model: cancel
+ extent: (Point 88 21)
+ )
+ (ActionButtonSpec
+ label: 'Prev'
+ name: 'prevButton'
+ level: 2
+ translateLabel: true
+ tabable: true
+ model: prevAction
+ extent: (Point 89 21)
+ )
+ (ActionButtonSpec
+ label: 'Next'
+ name: 'nextButton'
+ level: 2
+ borderWidth: 1
+ translateLabel: true
+ tabable: true
+ model: nextAction
+ isDefault: true
+ extent: (Point 88 21)
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ handles: (Any 0.5 1.0)
+ )
+ (LabelSpec
+ label: 'Replace By:'
+ name: 'ReplaceLabel'
+ layout: (LayoutFrame 1 0.0 53 0 -1 1.0 70 0)
+ level: 0
+ translateLabel: true
+ adjust: left
+ )
+ )
+
+ )
+ )
+
+ "Modified: / 11-10-2006 / 21:05:09 / cg"
+! !
+
+!EditTextView methodsFor:'Compatibility-ST80'!
+
+autoAccept:aBoolean
+ "ignored for now"
+
+ "Created: / 5.6.1998 / 15:30:32 / cg "
+!
+
+continuousAccept:aBoolean
+ "ignored for now"
+
+ "Created: / 19.6.1998 / 00:03:49 / cg"
+!
+
+cutSelection
+ self cut
+
+ "Created: / 31.10.1997 / 03:29:50 / cg"
+!
+
+deselect
+ "remove the selection"
+
+ ^ self unselect
+
+ "Created: / 19.6.1998 / 02:41:54 / cg"
+!
+
+enabled:aBoolean
+
+ self readOnly:aBoolean not
+
+ "Created: / 30.3.1999 / 15:10:23 / stefan"
+ "Modified: / 30.3.1999 / 15:10:53 / stefan"
+!
+
+find:pattern
+ self searchFwd:pattern ifAbsent:nil
+
+ "Created: / 29.1.1999 / 19:09:42 / cg"
+ "Modified: / 29.1.1999 / 19:10:12 / cg"
+!
+
+insert:aString at:aCharacterPosition
+ "insert a string at aCharacterPosition."
+
+ |line col|
+
+ line := self lineOfCharacterPosition:aCharacterPosition.
+ col := aCharacterPosition - (self characterPositionOfLine:line col:1) + 1.
+ col < 1 ifTrue:[
+ col := 1
+ ].
+ self insertString:aString atLine:line col:col.
+
+ "
+ |top v|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+ v := EditTextView origin:0.0@0.0 corner:1.0@1.0 in:top.
+ top openAndWait.
+ v contents:'1234567890\1234567890\1234567890\' withCRs.
+ v insert:'<- hello there' at:5.
+ "
+
+ "Modified: / 5.4.1998 / 17:20:08 / cg"
+!
+
+insertAndSelect:aString at:aCharacterPosition
+ "insert a selected string at aCharacterPosition."
+
+ |line col|
+
+ line := self lineOfCharacterPosition:aCharacterPosition.
+ col := (aCharacterPosition - (self characterPositionOfLine:line col:1) + 1) max:1.
+ self insertString:aString atLine:line col:col.
+ self selectFromLine:line col:col toLine:line col:col + aString size - 1
+ "
+ |v|
+
+ v := EditTextView new openAndWait.
+ v contents:'1234567890\1234567890\1234567890\' withCRs.
+ v insertAndSelect:'<- hello there' at:5.
+ "
+!
+
+pasteSelection
+ self paste
+
+ "Created: / 31.10.1997 / 03:28:53 / cg"
+!
+
+replaceSelectionWith:aString
+ ^ self replaceSelectionBy:aString
+
+ "Created: / 19.6.1998 / 02:42:32 / cg"
+!
+
+selectAt:pos
+ "move the cursor before cursorPosition."
+
+ self cursorToCharacterPosition:pos
+
+ "Modified: / 19.6.1998 / 02:41:28 / cg"
+ "Created: / 19.6.1998 / 02:43:39 / cg"
+!
+
+textHasChanged
+ ^ self modified
+
+ "Created: / 19.6.1998 / 00:09:43 / cg"
+!
+
+textHasChanged:aBoolean
+ "ST-80 compatibility: set/clear the modified flag."
+
+ self modified:aBoolean
+
+ "Created: / 5.2.2000 / 17:07:59 / cg"
+! !
+
+!EditTextView methodsFor:'accessing'!
+
+codeAspect
+ | codeAspect app |
+
+ codeAspect := codeAspectHolder value.
+ codeAspect notNil ifTrue:[^codeAspect].
+ self editedMethod notNil ifTrue:[^SyntaxHighlighter codeAspectMethod].
+
+ "/ Applications should set it explictly, however, to make it behavinh like
+ "/ CodeView2, I kept fetching code here for now.
+ ^((app := self topView application) notNil and:[app respondsTo: #codeAspect])
+ ifTrue:[app codeAspect]
+ ifFalse:[nil]
+
+ "Created: / 27-09-2013 / 09:53:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeAspect: aSymbol
+ codeAspectHolder value: aSymbol
+
+ "Created: / 27-09-2013 / 09:50:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+completionSupport
+ ^ completionSupport
+!
+
+completionSupport:anEditTextViewCompletionSupport
+ completionSupport := anEditTextViewCompletionSupport.
+!
+
+completionSupportClass
+ ^ self class defaultCompletionSupportClass
+
+ "Created: / 26-09-2013 / 17:54:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+editedClass
+ |cm|
+
+ cm := self editedMethodOrClass.
+ cm isBehavior ifTrue:[^ cm].
+ cm isMethod ifTrue:[^ cm mclass].
+ ^ nil
+!
+
+editedLanguage
+ ^ nil
+
+ "Created: / 18-09-2013 / 14:16:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+editedLanguage: aProgrammingLanguage
+ "Sets the edited language. Only defined here to make it polymorph with Workspace"
+
+ "Created: / 27-09-2013 / 10:15:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+editedMethod
+ |cm|
+
+ cm := self editedMethodOrClass.
+ cm isMethod ifTrue:[^ cm].
+ cm isBehavior ifTrue:[^ nil].
+ ^ nil
+!
+
+editedMethodOrClass
+ ^ nil
+!
+
+editedMethodOrClass: methodOrClass
+ "Sets the edited method or class. Only defined here to make it polymorph with Workspace"
+
+ "Created: / 27-09-2013 / 10:10:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasSelectionOrTextInCursorLine
+ ^ (self selectionOrTextOfCursorLine:false) notNil
+!
+
+selectionOrTextOfCursorLine
+ ^ self selectionOrTextOfCursorLine:true
+!
+
+selectionOrTextOfCursorLine:doSelect
+ |sel lNr line|
+
+ sel := self selectionAsString.
+ sel notNil ifTrue:[^ sel].
+
+ lNr := self cursorLine.
+ line := self listAt:lNr.
+ line notEmptyOrNil ifTrue:[
+ doSelect ifTrue:[
+ self selectLine:lNr.
+ ].
+ ^ line
+ ].
+
+ ^ nil
+! !
+
+!EditTextView methodsFor:'accessing-behavior'!
+
+acceptAction
+ "return the action to be performed on accept (or nil)"
+
+ ^ acceptAction
+!
+
+acceptAction:aBlock
+ "set the action to be performed on accept"
+
+ acceptAction := aBlock
+!
+
+acceptChannel
+ "return the valueHolder holding true if text was accepted.
+ By placing a true into this channel, an accept can also be forced."
+
+ ^ acceptChannel
+
+ "Modified: / 30.1.1998 / 14:17:11 / cg"
+!
+
+acceptChannel:aValueHolder
+ "set the valueHolder holding true if text was accepted.
+ By placing a true into this channel, an accept can also be forced."
+
+ |prev|
+
+ prev := acceptChannel.
+ acceptChannel := aValueHolder.
+ self setupChannel:aValueHolder for:nil withOld:prev
+
+ "Created: / 30.1.1998 / 14:51:09 / cg"
+!
+
+acceptEnabled:aBoolean
+ "enable/disable accept. This greys the corresponding item in the menu"
+
+ acceptEnabled := aBoolean
+
+ "Created: 7.3.1997 / 11:04:34 / cg"
+!
+
+accepted
+ "return true if text was accepted"
+
+ ^ acceptChannel value
+
+ "Created: 14.2.1997 / 16:43:46 / cg"
+!
+
+accepted:aBoolean
+ "set/clear the accepted flag.
+ This may force my current contents to be placed into my model."
+
+ acceptChannel value:aBoolean.
+
+ "Created: / 14.2.1997 / 16:44:01 / cg"
+ "Modified: / 30.1.1998 / 14:20:15 / cg"
+!
+
+autoIndent:aBoolean
+ autoIndent := aBoolean
+
+ "Created: 5.3.1996 / 14:37:50 / cg"
+!
+
+codeAspectHolder
+ ^ codeAspectHolder
+!
+
+codeAspectHolder:something
+ codeAspectHolder := something.
+!
+
+cursorMovementWhenUpdating
+ "return what is be done with the cursor,
+ when I get a new text (via the model or the #contents/#list)
+ Allowed arguments are:
+ #keep / nil -> stay where it was
+ #endOfText -> position cursor to the end
+ #beginOfText -> position cursor to the beginning
+ #endOfLine -> position cursor to the current lines end
+ #beginOfLine -> position cursor to the current lines start
+ The default is #beginOfText.
+ This may be useful for fields which get new values assigned from
+ the program (i.e. not from the user)"
+
+ ^ cursorMovementWhenUpdating
+
+ "Modified: 16.12.1995 / 16:27:55 / cg"
+!
+
+cursorMovementWhenUpdating:aSymbolOrNil
+ "define what should be done with the cursor,
+ when I get a new text (via the model or the #contents/#list)
+ Allowed arguments are:
+ #keep / nil -> stay where it was
+ #endOfText -> position cursor to the end
+ #beginOfText -> position cursor to the beginning
+ #endOfLine -> position cursor to the current lines end
+ #beginOfLine -> position cursor to the current lines start
+ The default is #beginOfText.
+ This may be useful for fields which get new values assigned from
+ the program (i.e. not from the user)"
+
+ cursorMovementWhenUpdating := aSymbolOrNil
+
+ "Modified: 16.12.1995 / 16:27:55 / cg"
+!
+
+disableIfInvisible:aBoolean
+ disableIfInvisible := aBoolean
+!
+
+dontReplaceSelectionOnInput
+ "remember that the current selection was created by a paste operation
+ (as opposed to an explicit selection by the user).
+ This selection will not be replaced by followup user input,
+ so multiple pastes will be possible."
+
+ typeOfSelection := #paste
+!
+
+editModeHolder
+ ^ editMode.
+!
+
+editModeInsert
+ editMode value:EditMode insertMode
+!
+
+editModeInsertAndSelect
+ editMode value:EditMode insertAndSelectMode
+!
+
+editModeOverwrite
+ editMode value:EditMode overwriteMode
+!
+
+exceptionBlock:aBlock
+ "define the action to be triggered when user tries to modify
+ readonly text"
+
+ exceptionBlock := aBlock
+!
+
+fixedSize
+ "make the texts size fixed (no lines may be added).
+ OBSOLETE: use readOnly"
+
+ <resource:#obsolete>
+
+ |menu|
+
+ self obsoleteMethodWarning:'use #readOnly:'.
+ readOnly == true ifFalse:[
+ readOnly := true.
+ (menu := self middleButtonMenu) notNil ifTrue:[
+ menu disableAll:#(cut paste replace indent)
+ ]
+ ]
+
+ "Modified: 14.2.1997 / 17:35:24 / cg"
+!
+
+insertMode:aBoolean
+ editMode value:(aBoolean ifTrue:[EditMode insertMode] ifFalse:[EditMode overwriteMode])
+
+ "Created: 6.3.1996 / 12:24:05 / cg"
+!
+
+insertModeHolder
+ ^ BlockValue
+ with:[:m | m isInsertMode]
+ argument:(editMode).
+
+ "Modified: / 08-03-2007 / 22:58:37 / cg"
+!
+
+isInInsertMode
+ ^ editMode value isInsertMode
+!
+
+isReadOnly
+ "return true, if the text is readonly."
+
+ ^ readOnly value
+
+ "Modified: 14.2.1997 / 17:35:56 / cg"
+!
+
+modeLabelHolder
+ "a valueHolder, which contains 'L' (learnMode), I (insertMode) or empty"
+
+ ^ BlockValue
+ with:[:e :l |
+ self isReadOnly ifTrue:[
+ ''
+ ] ifFalse:[
+ l ifTrue:[ 'L' allBold colorizeAllWith:Color red]
+ ifFalse:[ e infoPrintString]]]
+ argument:(self editModeHolder)
+ argument:(self learnModeHolder).
+
+ "Modified: / 08-03-2007 / 22:58:59 / cg"
+!
+
+modified
+ "return true if text was modified"
+
+ ^ modifiedChannel value
+!
+
+modified:aBoolean
+ "set/clear the modified flag"
+
+ modifiedChannel value:aBoolean
+
+ "Modified: 14.2.1997 / 16:44:05 / cg"
+!
+
+modifiedChannel
+ "return the valueHolder holding true if text was modified"
+
+ ^ modifiedChannel
+!
+
+modifiedChannel:aValueHolder
+ "set the valueHolder holding true if text was modified"
+
+ |prev|
+
+ prev := modifiedChannel.
+ modifiedChannel := aValueHolder.
+ self setupChannel:aValueHolder for:nil withOld:prev
+
+ "Created: / 30.1.1998 / 14:51:32 / cg"
+!
+
+readOnly
+ "make the text readonly.
+ Obsolete because it is obfuscating (looks like a getter)
+ - use #readOnly:"
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use #readOnly:'.
+ self readOnly:true.
+
+ "Modified: / 14-02-1997 / 17:35:56 / cg"
+ "Modified (comment): / 02-08-2013 / 16:46:57 / cg"
+!
+
+readOnly:aBoolean
+ "make the text readonly (aBoolean == true) or writable (aBoolean == false).
+ The argument may also be a valueHolder."
+
+ readOnly := aBoolean
+
+ "Created: 14.2.1997 / 17:35:39 / cg"
+!
+
+reallyModifiedChannel
+ "return the valueHolder holding true if text was really modified.
+ For compatibility with views which use the modified flag for syntax highlighting."
+
+ ^ self modifiedChannel
+!
+
+st80Mode:aBoolean
+ "set/clear the st80Mode flag.
+ If on, the cursor wraps at the line end (like in vi or st80);
+ if off, we have the Rand-editor behavior (random access)"
+
+ st80Mode := aBoolean
+
+ "Created: / 09-11-2010 / 13:55:50 / cg"
+!
+
+tabMeansNextField:aBoolean
+ "set/clear tabbing to the next field.
+ If true, Tab is ignored and shifts the keyboard focus.
+ If false, tabs can be entered into the text.
+ The default is true for editTextView, false for single-line
+ input fields."
+
+ tabMeansNextField := aBoolean
+!
+
+tabRequiresControl
+ "returns true, if a focus tabbing requires a control-key to be pressed.
+ The default is true for editTextView, false for other widgets,
+ to allow for easier text entry"
+
+ ^ tabRequiresControl
+!
+
+tabRequiresControl:aBoolean
+ "controls if a focus tabbing requires a control-key to be pressed.
+ The default is true for editTextView, false for other widgets,
+ to allow for easier text entry"
+
+ tabRequiresControl := aBoolean
+! !
+
+!EditTextView methodsFor:'accessing-contents'!
+
+at:lineNr basicPut:aLine
+ "change a line without change notification"
+
+ (self at:lineNr) = aLine ifFalse:[
+ super at:lineNr put:aLine.
+ ].
+!
+
+at:lineNr put:aLine
+ (self at:lineNr) = aLine ifFalse:[
+ super at:lineNr put:aLine.
+ self textChanged
+ ].
+!
+
+characterAfterCursor
+ "return the character one after the cursor - space if beyond line."
+
+ ^ self characterAtLine:cursorLine col:cursorCol+1
+!
+
+characterBeforeCursor
+ "return the character to the left of cursor - space if beyond line, nil if at the beginning."
+
+ cursorCol == 1 ifTrue:[^ nil].
+
+ ^ self characterAtLine:cursorLine col:cursorCol-1
+
+ "Created: / 17.6.1998 / 15:16:41 / cg"
+!
+
+characterUnderCursor
+ "return the character under the cursor - space if beyond line.
+ For non-block cursors, this is the character immediately to the right
+ of the insertion-bar or caret."
+
+ ^ self characterAtLine:cursorLine col:cursorCol
+!
+
+contents
+ "return the contents as a String or Text (i.e. with emphasis)"
+
+ list isNil ifTrue:[^ ''].
+ self removeTrailingBlankLines.
+ ^ super contents.
+
+ "Modified: / 04-07-2006 / 19:22:32 / fm"
+!
+
+contents:something
+ self contents:something keepUndoHistory:false.
+!
+
+contents:something keepUndoHistory:keepUndoHistory
+ super contents:something.
+ keepUndoHistory ifFalse:[
+ undoSupport resetHistories.
+ ].
+!
+
+contentsAsString
+ "return the contents as a String (i.e. without emphasis)"
+
+ list isNil ifTrue:[^ ''].
+ self removeTrailingBlankLines.
+ ^ (list collect:[:each | each isNil ifTrue:['']
+ ifFalse:[each string]
+ ]) asStringWithCRs
+!
+
+cursorCol
+ "return the cursors col (1..).
+ This is the absolute col; NOT the visible col"
+
+ ^ cursorCol
+!
+
+cursorColHolder
+ "return a valueHolder for the cursors column (1..)."
+
+ ^ cursorColHolder
+!
+
+cursorLine
+ "return the cursors line (1..).
+ This is the absolute line; NOT the visible line"
+
+ ^ cursorLine
+!
+
+cursorLineHolder
+ "return a valueHolder for the cursors line (1..).
+ This is the absolute line; NOT the visible line"
+
+ ^ cursorLineHolder
+!
+
+lineStringBeforeCursor
+ "return the line's string before the cursor.
+ Pad with spaces up to the cursor position if beyond the end of line"
+
+ |line|
+
+ line := ((self at:cursorLine) ? '') string.
+ line size < (cursorCol-1) ifTrue:[
+ ^ line paddedTo:(cursorCol-1)
+ ].
+ ^ line copyTo:(cursorCol-1)
+!
+
+list:something
+ "position cursor home when setting contents"
+
+ |prevCursorLine prevCursorCol|
+
+ prevCursorLine := cursorLine.
+ prevCursorCol := cursorCol.
+
+ super list:something.
+
+ (cursorMovementWhenUpdating == #endOfText
+ or:[cursorMovementWhenUpdating == #end]) ifTrue:[
+ ^ self cursorToEndOfText
+ ].
+
+ (cursorMovementWhenUpdating == #endOfLine) ifTrue:[
+ ^ self cursorLine:prevCursorLine col:(self listAt:cursorLine) size + 1.
+ ].
+
+ (cursorMovementWhenUpdating == #beginOfText
+ or:[cursorMovementWhenUpdating == #begin]) ifTrue:[
+ ^ self cursorHome
+ ].
+ (cursorMovementWhenUpdating == #beginOfLine) ifTrue:[
+ ^ self cursorLine:prevCursorLine col:1.
+ ].
+
+ "/ default: stay where it was
+ "/ self cursorLine:prevCursorLine col:prevCursorCol.
+!
+
+setContents:something
+ |selType|
+
+ undoSupport resetHistories.
+
+ selType := typeOfSelection.
+ super setContents:something.
+ typeOfSelection := selType.
+
+ "Created: / 31.3.1998 / 23:35:06 / cg"
+! !
+
+!EditTextView methodsFor:'accessing-dimensions'!
+
+absoluteXOfPosition:positionInText
+ |accumulatedX container|
+
+ accumulatedX := 0.
+ container := self.
+ [ container notNil ] whileTrue:[
+ accumulatedX := accumulatedX + container origin x.
+ container := container isTopView ifFalse:[
+ container container
+ ] ifTrue:[ nil ].
+ ].
+ ^ (self xOfPosition:positionInText) + accumulatedX
+
+ "Created: / 16-02-2010 / 10:05:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+absoluteYOfCursor
+
+ | accumulatedY container |
+ accumulatedY := 0.
+ container := self.
+ [ container notNil ] whileTrue:[
+ accumulatedY := accumulatedY + container origin y.
+ container := container isTopView
+ ifFalse:[container container]
+ ifTrue:[nil].
+ ].
+ ^(self yOfCursor) + accumulatedY
+
+ "Created: / 27-05-2005 / 07:45:53 / janfrog"
+ "Modified: / 27-05-2005 / 23:03:40 / janfrog"
+!
+
+xOfCursor
+ |point|
+
+ cursorVisibleLine isNil ifTrue:[
+ "/ take the end of the selection, if any
+ (selectionStartLine notNil
+ and:[ self listLineIsVisible:selectionEndLine ])
+ ifTrue:[
+ ^ self xOfCol:selectionEndCol inVisibleLine:selectionEndLine.
+ ].
+
+"/ point := device
+"/ translatePoint:(device pointerPosition)
+"/ fromView:nil
+"/ toView:self.
+"/ ((self bounds) containsPoint:point) ifTrue:[
+"/ ^ point x
+"/ ].
+"/ ^ 0
+ ^ nil
+ ].
+ ^self xOfCol:cursorCol inVisibleLine:cursorVisibleLine.
+
+ "Created: / 27-05-2005 / 07:43:41 / janfrog"
+!
+
+xOfPosition: positionInText
+
+ | line col |
+ line := self lineOfCharacterPosition: positionInText.
+ col := positionInText - (self characterPositionOfLine:line col:1) + 1.
+ ^
+ (self xOfCol:col inVisibleLine:(self listLineToVisibleLine: line))
+ - viewOrigin x.
+
+ "Created: / 16-02-2010 / 10:04:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+yOfCursor
+
+ ^self yOfVisibleLine:cursorVisibleLine.
+
+ "Created: / 27-05-2005 / 07:43:41 / janfrog"
+!
+
+yOfPosition: positionInText
+
+ | line |
+ line := self lineOfCharacterPosition: positionInText.
+ ^self yOfVisibleLine:(self listLineToVisibleLine: line)
+
+ "Created: / 16-02-2010 / 10:08:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!EditTextView methodsFor:'accessing-look'!
+
+cursorForegroundColor:color1 backgroundColor:color2
+ "set both cursor foreground and cursor background colors"
+
+ |wasOn|
+
+ wasOn := self hideCursor.
+ cursorFgColor := color1 onDevice:self graphicsDevice.
+ cursorBgColor := color2 onDevice:self graphicsDevice.
+ wasOn ifTrue:[self showCursor]
+!
+
+cursorType
+ "return the style of the text cursor.
+ Currently, supported are: #none
+ #block, #frame, #ibeam, #caret, #solidCaret
+ #bigCaret and #bigSolidCaret"
+
+ ^ cursorType
+
+ "Modified: / 5.5.1999 / 14:52:33 / cg"
+!
+
+cursorType:aCursorTypeSymbol
+ "set the style of the text cursor.
+ Currently, supported are: #none
+ #block, #frame, #ibeam, #caret, #solidCaret
+ #bigCaret and #bigSolidCaret"
+
+ cursorType := aCursorTypeSymbol.
+
+ "Created: 21.9.1997 / 13:42:23 / cg"
+ "Modified: 21.9.1997 / 13:43:35 / cg"
+!
+
+cursorTypeNoFocus
+ "return the style of the text cursor when the view has no focus.
+ If left unspecified, this is the same as the regular cursorType."
+
+ ^ cursorTypeNoFocus
+
+ "Created: / 5.5.1999 / 14:52:46 / cg"
+!
+
+cursorTypeNoFocus:aCursorTypeSymbol
+ "set the style of the text cursor when the view has no focus.
+ If left unspecified, this is the same as the regular cursorType."
+
+ cursorTypeNoFocus := aCursorTypeSymbol
+! !
+
+!EditTextView methodsFor:'accessing-replace'!
+
+lastReplacementInfo
+ ^ lastReplacementInfo
+!
+
+lastStringToReplace: aString
+!
+
+previousReplacements
+ "accessor for the code completion"
+
+ ^ lastReplacementInfo previousReplacements
+! !
+
+!EditTextView methodsFor:'change & update'!
+
+accept
+ "accept the current contents by executing the accept-action and/or
+ changeMessage."
+
+ acceptEnabled == false ifTrue:[
+ self beep.
+ ^ self
+ ].
+ (disableIfInvisible == true and:[self reallyRealized not]) ifTrue:[
+ ^ self
+ ].
+
+ lockUpdates := true.
+
+ "/
+ "/ ST-80 way of doing it
+ "/
+ model notNil ifTrue:[
+ self sendChangeMessage:changeMsg with:self argForChangeMessage.
+ acceptChannel value:true withoutNotifying:self.
+ ].
+
+ "/
+ "/ ST/X way of doing things
+ "/ as a historic (and temporary) leftover,
+ "/ the block is called with a stringCollection
+ "/ - not with the actual string
+ "/
+ acceptAction notNil ifTrue:[
+ acceptAction value:self list
+ ].
+
+ lockUpdates := false.
+
+ "Modified: / 30.1.1998 / 14:19:00 / cg"
+!
+
+argForChangeMessage
+ "return the argument to be passed with the change notification.
+ Defined as separate method for easier subclassability."
+
+ ^ self contents
+
+ "Modified: 29.4.1996 / 12:42:14 / cg"
+!
+
+getListFromModel
+ "get my contents from the model.
+ Redefined to ignore updates resulting from my own changes
+ (i.e. if lockUpdates is true)."
+
+ "
+ ignore updates from my own change
+ "
+ lockUpdates ifTrue:[
+ lockUpdates := false.
+ ^ self
+ ].
+ super getListFromModel.
+ undoSupport resetHistories.
+
+ "/ validate the cursorLine
+ (cursorLine notNil
+ and:[ cursorLine > list size ]) ifTrue:[
+ self cursorLine:list size + 1 col:1
+ ].
+!
+
+update:something with:aParameter from:changedObject
+ changedObject == acceptChannel ifTrue:[
+ acceptChannel value == true ifTrue:[
+ self accept.
+ ].
+ ^ self.
+ ].
+ super update:something with:aParameter from:changedObject
+
+ "Created: / 30.1.1998 / 14:15:56 / cg"
+ "Modified: / 1.2.1998 / 13:15:55 / cg"
+! !
+
+!EditTextView methodsFor:'cursor handling'!
+
+basicCursorReturn
+ "move cursor to start of next line; scroll if at end of visible text"
+
+ |wasOn|
+
+ self checkForExistingLine:(cursorLine + 1).
+ cursorVisibleLine notNil ifTrue:[
+ nFullLinesShown notNil ifTrue:[
+ (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown]
+ ]
+ ].
+
+ wasOn := self hideCursor.
+ self setValidatedCursorLine:(cursorLine + 1) col:1.
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: 22.5.1996 / 18:27:34 / cg"
+!
+
+characterPositionOfCursor
+ ^ self characterPositionOfLine:cursorLine col:cursorCol
+!
+
+cursorBacktab
+ "move cursor to prev tabstop"
+
+ self cursorCol:(self prevTabBefore:cursorCol).
+!
+
+cursorCol:newCol
+ "move cursor to some column in the current line"
+
+ |wasOn|
+
+ (cursorCol == newCol) ifTrue:[^ self].
+
+ wasOn := self hideCursor.
+ self setValidatedCursorCol:newCol.
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: 22.5.1996 / 14:25:53 / cg"
+!
+
+cursorDown
+ "move cursor down; scroll if at end of visible text;
+ beep if at end of physical text."
+
+ |wasOn|
+
+ self cursorDown:1.
+
+ "/ cursor beyond text ?
+ cursorLine > list size ifTrue:[
+ wasOn := self hideCursor.
+ self setValidatedCursorLine:(list size + 1) col:cursorCol.
+ self makeCursorVisibleAndShowCursor:wasOn.
+ self beep.
+ ].
+
+ "Modified: / 10.6.1998 / 17:00:23 / cg"
+!
+
+cursorDown:n
+ "move cursor down by n lines; scroll if at end of visible text"
+
+ |wasOn nv nL|
+
+ (nL := cursorLine) isNil ifTrue:[
+ nL := firstLineShown
+ ].
+
+ self st80EditMode ifTrue:[
+ nL == list size ifTrue:[
+ wasOn := self hideCursor.
+ self setValidatedCursorLine:(list size) col:(self listAt:list size) size + 1.
+ self makeCursorVisibleAndShowCursor:wasOn.
+ self beep.
+ ^ self.
+ ]
+ ].
+
+ cursorVisibleLine notNil ifTrue:[
+ wasOn := self hideCursor.
+ nv := cursorVisibleLine + n - 1.
+ (nv >= nFullLinesShown) ifTrue:[
+ self scrollDown:(nv - nFullLinesShown + 1)
+ ].
+ self setValidatedCursorLine:(cursorLine + n) col:cursorCol.
+ self makeCursorVisibleAndShowCursor:wasOn.
+ ] ifFalse:[
+ self setValidatedCursorLine:(nL + n) col:cursorCol.
+ self makeCursorVisible.
+ ].
+
+ "Modified: / 10.6.1998 / 16:59:17 / cg"
+!
+
+cursorHome
+ "scroll to top AND move cursor to first line of text."
+
+ self cursorLine:1 col:1
+
+"/ |wasOn|
+"/
+"/ wasOn := self hideCursor.
+"/ self scrollToTop.
+"/ cursorLine := cursorVisibleLine := 1.
+"/ cursorCol := self validateCursorCol:1 inLine:cursorLine.
+"/ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: 22.5.1996 / 18:26:42 / cg"
+!
+
+cursorLeft
+ "move cursor to left"
+
+ (cursorCol ~~ 1) ifTrue:[
+ self cursorCol:(cursorCol - 1)
+ ] ifFalse:[
+ cursorLine ~~ 1 ifTrue:[
+ self st80EditMode ifTrue:[
+ self cursorUp.
+ self cursorToEndOfLine.
+ ]
+ ]
+ ]
+
+ "Modified: / 23.1.1998 / 12:37:13 / cg"
+!
+
+cursorLeft:n
+ "move cursor to left"
+
+ n timesRepeat:[
+ self cursorLeft
+ ].
+!
+
+cursorLine:line col:col
+ "this positions onto physical - not visible - line"
+
+ |wasOn newCol|
+
+ ((line == cursorLine) and:[col == cursorCol]) ifTrue:[^ self].
+
+ wasOn := self hideCursor.
+ self setValidatedCursorLine:line.
+
+ (col < 1) ifTrue:[
+ newCol := 1
+ ] ifFalse:[
+ newCol := col.
+ ].
+ self st80EditMode ifTrue:[
+ (cursorLine == list size
+ and:[cursorLine ~~ line]) ifTrue:[
+ newCol := (self listAt:(list size)) size + 1.
+ ]
+ ].
+ self setValidatedCursorCol:newCol.
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: / 20.6.1998 / 18:19:06 / cg"
+!
+
+cursorMovementAllowed
+ "return true, if the user may move the cursor around
+ (via button-click, or cursor-key with selection).
+ By default, true is returned, but this may be redefined
+ in special subclasses (such as a terminal view), where
+ this is not wanted"
+
+ ^ true
+
+ "Created: / 18.6.1998 / 14:11:16 / cg"
+!
+
+cursorReturn
+ "move cursor to start of next line; scroll if at end of visible text"
+
+ self basicCursorReturn
+!
+
+cursorRight
+ "move cursor to right"
+
+ |l|
+
+ self st80EditMode ifTrue:[
+ l := (self listAt:cursorLine).
+ cursorCol >= (l size + 1) ifTrue:[
+ cursorLine < list size ifTrue:[
+ self cursorReturn.
+ ].
+ ^ self
+ ]
+ ].
+ self cursorCol:(cursorCol + 1)
+
+ "Modified: / 20.6.1998 / 18:19:07 / cg"
+!
+
+cursorRight:n
+ "move cursor to right"
+
+ n timesRepeat:[
+ self cursorRight
+ ].
+!
+
+cursorShown:aBoolean
+ "change cursor visibility
+ return true if cursor was visible before."
+
+ |oldState|
+
+ aBoolean == cursorShown ifTrue:[
+ ^ cursorShown
+ ].
+
+ oldState := cursorShown.
+
+ aBoolean ifTrue:[
+ self drawCursor.
+ ] ifFalse:[
+ (cursorShown and:[shown]) ifTrue: [
+ self undrawCursor.
+ ].
+ ].
+ cursorShown := aBoolean.
+
+ ^ oldState
+
+ "Modified: / 30.3.1999 / 15:32:43 / stefan"
+ "Created: / 30.3.1999 / 15:59:30 / stefan"
+!
+
+cursorTab
+ "move cursor to next tabstop"
+
+ self cursorCol:(self nextTabAfter:cursorCol).
+!
+
+cursorToBeginOfLine
+ "move cursor to the start of the current line"
+
+ |textStart l|
+
+ l := self listAt:cursorLine.
+ textStart := l isNil ifTrue:[1] ifFalse:[l indexOfNonSeparator].
+ cursorCol > textStart ifTrue:[
+ self cursorCol:textStart
+ ] ifFalse:[
+ self cursorCol:1
+ ]
+
+ "Created: / 8.8.2004 / 18:51:21 / janfrog"
+!
+
+cursorToBottom
+ "move cursor to the last line of text (col 1)"
+
+ |wasOn newTop|
+
+ wasOn := self hideCursor.
+
+ newTop := list size - nFullLinesShown.
+ (newTop < 1) ifTrue:[
+ newTop := 1
+ ].
+ self scrollToLine:newTop.
+
+ self setValidatedCursorLine:(list size) col:1.
+
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: 22.5.1996 / 18:27:45 / cg"
+!
+
+cursorToCharacterPosition:pos
+ "compute line/col from character position (1..)
+ and move the cursor onto that char"
+
+ |line col|
+
+ line := self lineOfCharacterPosition:pos.
+ col := pos - (self characterPositionOfLine:line col:1) + 1.
+ self cursorLine:line col:col
+
+ "Created: / 15.1.1998 / 21:55:33 / cg"
+!
+
+cursorToEnd
+ "move cursor down below last line of text"
+
+ |wasOn newTop lineNr line|
+
+ lineNr := list size.
+
+ cursorLine >= lineNr ifTrue:[
+ line := self listAt:cursorLine.
+ (line isEmptyOrNil) ifTrue:[
+ ^ self
+ ]
+ ].
+
+ wasOn := self hideCursor.
+
+ lineNr := lineNr + 1.
+ newTop := lineNr - nFullLinesShown.
+ (newTop < 1) ifTrue:[
+ newTop := 1
+ ].
+ self scrollToLine:newTop.
+
+ self setValidatedCursorLine:lineNr col:1.
+
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: 22.5.1996 / 18:27:53 / cg"
+!
+
+cursorToEndOfLine
+ "move cursor to end of current line"
+
+ |line|
+
+ line := (self listAt:cursorLine).
+ self cursorCol:(line size + 1)
+
+ "Modified: 13.8.1997 / 15:34:02 / cg"
+!
+
+cursorToEndOfText
+ "move cursor to the end of the text (behind the last character in last line)"
+
+ |wasOn newTop lastLineLength pos|
+
+ wasOn := self hideCursor.
+
+ newTop := list size - nFullLinesShown.
+ (newTop < 1) ifTrue:[
+ newTop := 1
+ ].
+ self scrollToLine:newTop.
+
+ self setValidatedCursorLine:list size.
+ lastLineLength := (self listAt:cursorLine) size.
+ pos := (lastLineLength==0) ifTrue:[0] ifFalse:[lastLineLength+1].
+ self setCursorCol:(self validateCursorCol:pos inLine:cursorLine).
+
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: / 15-07-2011 / 20:14:43 / cg"
+!
+
+cursorToEndOfWord
+ "move the cursor to the end of the word"
+
+ (cursorLine > list size) ifTrue:[^ self].
+
+ self wordAtLine:cursorLine col:cursorCol do:[
+ :beginLine :beginCol :endLine :endCol :style |
+
+ self cursorLine:endLine col:endCol+1
+ ]
+
+ "Created: / 28-06-2006 / 19:16:30 / cg"
+!
+
+cursorToFirstVisibleLine
+ "place cursor into the first visible line; do not scroll."
+
+ self cursorLine:(self visibleLineToAbsoluteLine:1) col:1
+!
+
+cursorToLastVisibleLine
+ "place cursor into the first visible line; do not scroll."
+
+ self cursorLine:(self visibleLineToAbsoluteLine:nFullLinesShown) col:1
+!
+
+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
+ ]
+!
+
+cursorToPreviousWord
+ "move the cursor to the beginning of this or the previous word"
+
+ |col line searching l|
+
+ (cursorLine > list size) ifTrue:[^ self]. "/ this is rubbish
+
+ self wordAtLine:cursorLine col:cursorCol do:[
+ :beginLine :beginCol :endLine :endCol :style |
+
+ line := beginLine.
+ col := beginCol.
+ style == #wordLeft ifTrue:[
+ col := col + 1
+ ].
+
+ (cursorLine == line
+ and:[cursorCol == col]) ifTrue:[
+ searching := true.
+
+ col > 1 ifTrue:[
+ col := col - 1.
+ ].
+
+ [searching] whileTrue:[
+ (col == 1) ifTrue:[
+ line == 1 ifTrue:[
+ searching := false
+ ] ifFalse:[
+ line := line - 1.
+ l := list at:line.
+ col := l size + 1.
+ ]
+ ] ifFalse:[
+ (self characterAtLine:line col:col) isSeparator ifFalse:[
+ self wordAtLine:line col:col do:[
+ :beginLine :beginCol :endLine :endCol :style |
+
+ line := beginLine.
+ col := beginCol.
+ style == #wordLeft ifTrue:[
+ col := col + 1
+ ].
+ searching := false.
+ ]
+ ] ifTrue:[
+ col := col - 1
+ ]
+ ]
+ ]
+ ].
+ self cursorLine:line col:col
+ ]
+
+ "Created: 8.3.1996 / 21:52:48 / cg"
+ "Modified: 8.3.1996 / 22:12:45 / cg"
+!
+
+cursorToTop
+ "move cursor to absolute home"
+
+ self cursorLine:1 col:1
+!
+
+cursorUp
+ "move cursor up; scroll if at start of visible text"
+
+ self cursorUp:1
+!
+
+cursorUp:n
+ "move cursor up n lines; scroll if at start of visible text"
+
+ |wasOn nv nl|
+
+ cursorLine isNil ifTrue:[
+ self setCursorLine:(firstLineShown + nFullLinesShown - 1).
+ ].
+ nl := cursorLine - n.
+ nl < 1 ifTrue:[nl := 1].
+
+ (nl ~~ cursorLine) ifTrue: [
+ wasOn := self hideCursor.
+ cursorVisibleLine notNil ifTrue:[
+ nv := cursorVisibleLine - n.
+ nv < 1 ifTrue:[
+ self scrollUp:(nv negated + 1)
+ ].
+ ].
+ self setValidatedCursorLine:nl col:cursorCol.
+"/ wasOn ifTrue:[self showCursor].
+ self makeCursorVisibleAndShowCursor:wasOn.
+ ]
+
+ "Modified: 22.5.1996 / 18:28:11 / cg"
+!
+
+cursorVisibleLine:visibleLineNr col:colNr
+ "put cursor to visibleline/col"
+
+ |wasOn newCol listLine|
+
+ wasOn := self hideCursor.
+
+ listLine := self visibleLineToAbsoluteLine:visibleLineNr.
+ self setValidatedCursorLine:listLine.
+ cursorVisibleLine := visibleLineNr.
+
+ newCol := colNr.
+ (newCol < 1) ifTrue:[
+ newCol := 1
+ ].
+ self setValidatedCursorCol:newCol.
+
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: / 20.6.1998 / 18:40:28 / cg"
+!
+
+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.
+!
+
+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
+ ]
+ ]
+ ]
+!
+
+drawCursor:cursorType with:fgColor and:bgColor
+ "draw a cursor; the argument cursorType specifies what type
+ of cursor should be drawn.
+ Currently, supported are: #none,
+ #block, #frame, #ibeam, #caret, #solidCaret
+ #bigCaret and #bigSolidCaret"
+
+ |x y w char y2 x1 x2 oldPaint oldClip|
+
+ self hasSelection ifTrue:[
+ "
+ hide cursor, if there is a selection
+ "
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+
+ cursorType == #none ifTrue:[
+ ^ self
+ ].
+
+ cursorType == #block ifTrue:[
+ super drawVisibleLine:cursorVisibleLine col:cursorCol with:fgColor and:bgColor.
+ ^ self
+ ].
+ x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - viewOrigin x.
+ y := self yOfVisibleLine:cursorVisibleLine.
+
+ oldPaint := self paint. "/ do not clobber GC
+ cursorType == #frame ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+
+ char := self characterUnderCursor asString.
+ self paint:bgColor.
+ self displayRectangleX:x y:y width:(gc font widthOf:char) height:fontHeight-2.
+ ] ifFalse:[
+ self paint:bgColor.
+ cursorType == #ibeam ifTrue:[
+ x1 := x - 1.
+ y2 := y + fontHeight - lineSpacing.
+ self displayLineFromX:x1 y:y toX:x1 y:y2.
+ self displayLineFromX:x y:y toX:x y:y2.
+ ^ self
+ ].
+
+ cursorType == #Ibeam ifTrue:[
+ x1 := x - 1.
+ y := y + 1.
+ y2 := y + fontHeight - lineSpacing.
+ self displayLineFromX:x1 y:y toX:x1 y:y2.
+ self displayLineFromX:x y:y toX:x y:y2.
+ self displayLineFromX:x1-2 y:y toX:x+2 y:y.
+ self displayLineFromX:x1-2 y:y2 toX:x+2 y:y2.
+ ^ self
+ ].
+
+ y := y + fontHeight - 3.
+ ((cursorType == #bigCaret) or:[cursorType == #bigSolidCaret]) ifTrue:[
+ w := (fontWidth * 2 // 3) max:4.
+ y2 := y + w + (w//2).
+ ] ifFalse:[
+ w := (fontWidth // 2) max:4.
+ y2 := y + w.
+ ].
+ x1 := x - w.
+ x2 := x + w.
+
+ oldClip := self clippingRectangleOrNil.
+ self clippingRectangle:(margin@margin extent:(width-margin) @ (height-margin)).
+
+ cursorType == #caret ifTrue:[
+ self lineWidth:2.
+ self displayLineFromX:x1 y:y2 toX:x y:y.
+ self displayLineFromX:x y:y toX:x2 y:y2.
+ ] ifFalse:[
+ "anything else: solidCaret"
+
+ self fillPolygon:(Array with:(x1 @ y2)
+ with:(x @ y)
+ with:(x2 @ y2))
+ ].
+
+ self clippingRectangle:oldClip
+ ].
+ self paint:oldPaint.
+
+ "Modified: / 15.12.1999 / 22:24:17 / cg"
+!
+
+drawCursorCharacter
+ "draw the cursor.
+ (i.e. the cursor if no selection)
+ - helper for many cursor methods"
+
+ (hasKeyboardFocus
+ and:[self enabled
+ and:[self isReadOnly not]]) ifTrue:[
+ self drawFocusCursor
+ ] ifFalse:[
+ self drawNoFocusCursor
+ ]
+
+ "Modified: / 23.3.1999 / 13:52:48 / cg"
+!
+
+drawFocusCursor
+ "draw the cursor when the focus is in the view."
+
+ self hasSelection ifTrue:[
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+ cursorType == #none ifTrue:[
+ ^ self undrawCursor
+ ].
+ self drawCursor:cursorType with:cursorFgColor and:cursorBgColor.
+
+ "Modified: 22.9.1997 / 00:16:38 / cg"
+!
+
+drawNoFocusCursor
+ "draw the cursor for the case when the view has no keyboard focus"
+
+ |cType|
+
+ self hasSelection ifTrue:[
+ ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
+ ].
+
+ cType := cursorTypeNoFocus ? cursorType.
+ cType == #none ifTrue:[
+ ^ self undrawCursor
+ ].
+
+ cType == #block ifTrue:[
+ ^ self drawCursor:#frame with:cursorNoFocusFgColor and:cursorBgColor
+ ].
+
+ ^ self drawCursor:cType with:cursorNoFocusFgColor and:cursorNoFocusFgColor.
+
+ "Modified: 22.9.1997 / 00:16:13 / cg"
+!
+
+gotoLine:aLineNumber
+ "position cursor onto line, aLineNumber.
+ Make certain that this line is visible"
+
+ self makeLineVisible:aLineNumber.
+ self unselect.
+ self cursorLine:aLineNumber col:1
+!
+
+hideCursor
+ "make cursor invisible if currently invisible"
+
+ ^ self cursorShown:false
+
+ "Modified: / 30.3.1999 / 16:02:28 / stefan"
+!
+
+makeCursorVisible
+ "scroll text to make cursorline visible
+ (i.e. to have cursorLine in visible area)"
+
+ |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:[
+ expandingTop ~~ false ifTrue:[
+ line := selectionStartLine.
+ col := selectionStartCol.
+ ] ifFalse:[
+ line := selectionEndLine.
+ col := selectionEndCol
+ ]
+ ].
+ self makeLineVisible:line.
+ self makeColVisible:col inLine:line
+ ]
+
+ "Modified: 6.3.1996 / 13:46:46 / cg"
+!
+
+makeCursorVisibleAndShowCursor:flag
+ "scroll to make cursorLine visible;
+ if flag is true, draw the cursor"
+
+ self makeCursorVisible.
+ flag ifTrue:[self showCursor]
+!
+
+setCursorCol:colNr
+ "strictly private: set the cursorCol"
+
+ cursorCol := (colNr max:1).
+ cursorColHolder value:cursorCol.
+!
+
+setCursorLine:lineNr
+ "strictly private: set the cursorLine"
+
+ "/ self assert:(lineNr notNil).
+
+ cursorLine := (lineNr ? 1).
+ cursorLineHolder value:cursorLine.
+ self updateCursorVisibleLine.
+!
+
+setCursorLine:lineNr col:colNr
+ "strictly private: set the cursorLine, col and update the visibleLine"
+
+ self setCursorLine:lineNr.
+ self setCursorCol:colNr.
+!
+
+setValidatedCursorCol:colNr
+ "strictly private: set the cursorCol"
+
+ self setCursorCol:(self validateCursorCol:colNr inLine:cursorLine).
+!
+
+setValidatedCursorLine:lineNr
+ "strictly private: set the cursorLine and update the visibleLine"
+
+ self setCursorLine:(self validateCursorLine:lineNr).
+!
+
+setValidatedCursorLine:lineNr col:colNr
+ "strictly private: set the cursorLine, col and update the visibleLine"
+
+ self setValidatedCursorLine:lineNr.
+ self setValidatedCursorCol:colNr.
+!
+
+showCursor
+ "make cursor visible if currently invisible"
+
+ ^ self cursorShown:true
+
+ "Modified: / 30.3.1999 / 16:02:34 / stefan"
+!
+
+undrawCursor
+ "undraw the cursor (i.e. redraw the character(s) under the cursor)"
+
+ |prevCol line oldClip x y e1 e2 e3|
+
+ cursorVisibleLine notNil ifTrue:[
+ prevCol := cursorCol - 1.
+
+ "/ if there is any italic stuff in the cursor line,
+ "/ redraw it completely (because characters overlap).
+ cursorCol > 1 ifTrue:[
+ (line := self listAt:cursorLine) notNil ifTrue:[
+ line hasChangeOfEmphasis ifTrue:[
+ line size >= (cursorCol-1) ifTrue:[
+ e1 := Text extractEmphasis:#italic from:(line emphasisAt:cursorCol-1).
+ line size >= (cursorCol) ifTrue:[
+ e2 := Text extractEmphasis:#italic from:(line emphasisAt:cursorCol).
+ line size >= (cursorCol+1) ifTrue:[
+ e3 := Text extractEmphasis:#italic from:(line emphasisAt:cursorCol+1)
+ ].
+ ].
+ ].
+ (e1 notNil or:[e2 notNil or:[e3 notNil]]) ifTrue:[
+ ^ super redrawVisibleLine:cursorVisibleLine
+ ]
+ ]
+ ]
+ ].
+
+ ((cursorType == #caret)
+ or:[cursorType == #solidCaret
+ or:[cursorType == #bigSolidCaret
+ or:[cursorType == #bigCaret
+ or:[cursorType == #Ibeam]]]]) ifTrue:[
+ "caret-cursor touches 4 characters"
+ ((cursorCol > 1) and:[fontIsFixedWidth]) ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine-1 from:prevCol to:cursorCol.
+ super redrawVisibleLine:cursorVisibleLine from:prevCol to:cursorCol.
+ super redrawVisibleLine:cursorVisibleLine+1 from:prevCol to:cursorCol.
+ ] ifFalse:[
+ "care for left margin"
+ super redrawVisibleLine:cursorVisibleLine; redrawVisibleLine:cursorVisibleLine+1.
+ ].
+ ^ self
+ ].
+
+ cursorType == #ibeam ifTrue:[
+ "ibeam-cursor touches 2 characters"
+ cursorCol > 1 ifTrue:[
+ super redrawVisibleLine:cursorVisibleLine from:prevCol to:cursorCol.
+ ] ifFalse:[
+ "care for left margin"
+ super redrawVisibleLine:cursorVisibleLine.
+ ].
+ ^ self
+ ].
+
+ "block cursor is simple - just one character under cursor"
+
+ "/ however, if italic characters are involved, we must care
+ "/ for the chars before/after the cursor.
+ "/ We redraw the part of the previous character which got
+ "/ detroyed by the block cursor.
+ "/ (must change the clip, to avoid destroying the prev-prev character)
+
+ line := self visibleAt:cursorVisibleLine.
+ (line notNil and:[line isText]) ifTrue:[
+ cursorCol > 1 ifTrue:[
+ oldClip := self clippingRectangleOrNil.
+ x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - viewOrigin x.
+ y := self yOfVisibleLine:cursorVisibleLine.
+ self clippingRectangle:(x@y extent:((gc font width * 2) @ fontHeight)).
+ super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
+ self clippingRectangle:oldClip.
+ ^ self.
+ ].
+ ].
+ super redrawVisibleLine:cursorVisibleLine col:cursorCol
+ ]
+
+ "Modified: / 15.12.1999 / 22:25:59 / cg"
+!
+
+updateCursorVisibleLine
+ "strictly private: set the visibleLine from the cursorLine.
+ notice: visibleLine will be set to nil if the cursor is not visible"
+
+ cursorVisibleLine := self listLineToVisibleLine:cursorLine.
+!
+
+validateCursorCol:col inLine:line
+ "check of col is a valid cursor position; return a new col-nr if not.
+ Here, no limits are enforced (and col is returned),
+ but it may be redefined in EditFields or views which dont like the
+ cursor to be positioned behind the end of a textLine (vi/st-80 behavior)"
+
+ |l max|
+
+ "/ in ST80 mode,
+ "/ the cursor may not be positioned beyond the
+ "/ end of a line or beyond the last line of the text
+
+ self st80EditMode ifTrue:[
+ l := (self listAt:line).
+ max := l size + 1.
+ col > max ifTrue:[
+ ^ max
+ ]
+ ].
+ ^ col
+
+ "Created: / 22.5.1996 / 14:25:30 / cg"
+ "Modified: / 20.6.1998 / 18:19:24 / cg"
+!
+
+validateCursorLine:line
+ "check of line is a valid cursor line; return a fixed line-nr if not.
+ Here, no limits are enforced (and line is returned), but it may be
+ redefined in views which dont like the cursor to be positioned
+ behind the end of the text (vi/st-80 behavior), or want to
+ skip reserved regions"
+
+ "/
+ "/ in st80Mode, the cursor may not be positioned
+ "/ beyond the last line
+ "/
+ self st80EditMode ifTrue:[
+ ^ (line min:(list size)) max:1
+ ].
+ ^ line
+
+ "Created: / 22.5.1996 / 18:22:23 / cg"
+ "Modified: / 20.6.1998 / 18:19:26 / cg"
+!
+
+withCursorOffDo:aBlock
+ "evaluate aBlock with cursor off; turn it on afterwards."
+
+ (shown not or:[cursorShown not]) ifTrue:[
+ ^ aBlock value
+ ].
+ self hideCursor.
+ aBlock ensure:[
+ self showCursor
+ ]
+! !
+
+!EditTextView methodsFor:'drag & drop'!
+
+allowDrop:aBoolean
+ "enable/disable drop support"
+
+ aBoolean ifFalse:[
+ dropTarget := nil.
+ ] ifTrue:[
+ dropTarget isNil ifTrue:[
+ dropTarget := DropTarget
+ receiver:self
+ argument:nil
+ dropSelector:#'drop:'
+ canDropSelector:#'canDrop:'
+ ]
+ ].
+!
+
+canDrop:aDropContext
+ "public from d&d.
+ I accept textObjects and fileObjects only."
+
+ "/ cg: disabled to avoid unintended drop (is same as copy-past, anyway)
+ aDropContext sourceWidget == self ifTrue:[^ false].
+ ^ self canDropObjects:aDropContext dropObjects
+
+ "Modified: / 13-10-2006 / 17:41:09 / cg"
+!
+
+canDropObjects:aCollectionOfDropObjects
+ "public from d&d.
+ I accept textObjects and fileObjects only."
+
+ self checkModificationsAllowed ifFalse:[^ false].
+
+ aCollectionOfDropObjects isEmpty ifTrue:[ ^ false ].
+ ^ aCollectionOfDropObjects conform:[:obj| (obj isTextObject or:[obj isFileObject])]
+
+ "Created: / 13-10-2006 / 15:56:57 / cg"
+ "Modified: / 13-10-2006 / 17:41:14 / cg"
+!
+
+drop:aDropContext
+ "public from d&d.
+ drop objects (new API)"
+
+ self dropObjects:(aDropContext dropObjects)
+
+ "Modified: / 13-10-2006 / 17:41:19 / cg"
+!
+
+dropFileObject:aDropObject
+ "drop objects
+ For bw. compatibility, also collections of drop objects are handled (may vanish)"
+
+ |answer text fn pasteWhat sensor dontAskAgainHolder enforcedDropMode app|
+
+ pasteWhat := #name.
+
+ fn := aDropObject asFilename.
+ (fn exists and:[fn isRegularFile]) ifTrue:[
+ enforcedDropMode := UserPreferences current enforcedDropModeForFiles.
+ (enforcedDropMode notNil
+ and:[enforcedDropMode ~~ #name or:[fn fileSize <= (1024*1024)]]) ifTrue:[
+ pasteWhat := enforcedDropMode.
+ ] ifFalse:[
+ sensor := self sensor.
+ (sensor shiftDown or:[sensor ctrlDown]) ifTrue:[
+ pasteWhat := #name.
+ ] ifFalse:[
+ (sensor metaDown) ifTrue:[
+ pasteWhat := #contents.
+ ] ifFalse:[
+ dontAskAgainHolder := false asValue.
+ answer := Dialog
+ confirmWithCancel:(resources
+ stringWithCRs:'Drop the Filename (%1)\or its Contents ?\\Hint: bypass this dialog by pressing SHIFT/CTRL or ALT during the next drop.\SHIFT/CTRL to drop the name, ALT for the contents.'
+ with:fn name allBold)
+ labels:#( 'Cancel' 'Name' 'Contents' )
+ values:#( nil #name #contents )
+ default:#contents
+ check:(resources string:'Do not ask again; instead, always paste the contents of small files.') on:dontAskAgainHolder
+ title:(resources string:'Drop What').
+ answer isNil ifTrue:[ ^ self ].
+
+ dontAskAgainHolder value ifTrue:[
+ UserPreferences current enforcedDropModeForFiles:#contents
+ ].
+ pasteWhat := answer.
+ ]
+ ]
+ ].
+ ].
+
+ pasteWhat == #name ifTrue:[
+ text := fn pathName
+ ] ifFalse:[
+ self withWaitCursorDo:[
+ text := fn contentsOfEntireFile
+ ].
+ (app := self application) notNil ifTrue:[
+ app droppedFile:fn in:self
+ ].
+ ].
+
+ self
+ undoablePaste:text
+ info:'Drop File'.
+
+ "Created: / 13-10-2006 / 17:38:31 / cg"
+ "Modified: / 28-07-2007 / 13:27:09 / cg"
+!
+
+dropObject:aDropObject
+ "drop objects
+ For bw. compatibility, also collections of drop objects are handled (may vanish)"
+
+ |text|
+
+ (aDropObject isFileObject) ifTrue:[
+ self dropFileObject:aDropObject
+ ] ifFalse:[
+ aDropObject isTextObject ifTrue:[
+ text := aDropObject theObject.
+ text isStringCollection ifTrue:[
+ text := text asStringWithoutFinalCR
+ ].
+ ] ifFalse:[
+ text := aDropObject theObject asString
+ ].
+ self
+ undoablePaste:text
+ info:'Drop'.
+ ].
+
+ "Created: / 13-10-2006 / 17:37:05 / cg"
+ "Modified: / 28-07-2007 / 13:26:53 / cg"
+!
+
+dropObjects:aCollectionOfDropObjects
+ "public from d&d.
+ drop objects (old API)"
+
+ aCollectionOfDropObjects do:[:el |
+ self dropObject:el
+ ].
+
+ "Created: / 13-10-2006 / 15:59:40 / cg"
+ "Modified: / 13-10-2006 / 17:41:23 / cg"
+! !
+
+!EditTextView methodsFor:'editing'!
+
+convertSelectionToLowercaseOrUppercaseOrUppercaseFirst
+ "toLower/toUppercaseFirst/toUpper selected text"
+
+ |line1 line2|
+
+ line1 := self selectionStartLine.
+ line2 := self selectionEndLine.
+ line1 isNil ifTrue:[
+ line1 := self perform:#cursorLine ifNotUnderstood:nil.
+ line1 notNil ifTrue:[
+ line2 := line1
+ ]
+ ].
+ line1 notNil ifTrue:[
+ line1 to:line2 do:[:lineNr |
+ |line col1 col2 isAllLower isLowerFirst isAllUpper isUpperFirst
+ makeLowercase makeUppercase makeUppercaseFirst makeLowercaseFirst|
+
+ line := (self listAt:lineNr) copy.
+ line size > 0 ifTrue:[
+ lineNr == line1 ifTrue:[
+ col1 := selectionStartCol.
+ ] ifFalse:[
+ col1 := 1.
+ ].
+ lineNr == line2 ifTrue:[
+ col2 := selectionEndCol.
+ ] ifFalse:[
+ col2 := (self listAt:lineNr) size.
+ ].
+ isAllLower := isAllUpper := isUpperFirst := isLowerFirst := true.
+ col1 to:col2 do:[:col |
+ |ch|
+
+ ch := line at:col.
+ ch isUppercase ifTrue:[
+ isAllLower := false.
+ col == col1 ifTrue:[
+ isLowerFirst := false.
+ ].
+ ] ifFalse:[
+ ch isLowercase ifTrue:[
+ isAllUpper := false.
+ col == col1 ifTrue:[
+ isUpperFirst := false.
+ ].
+ ]
+ ].
+ ].
+
+ makeLowercase := makeUppercase := makeUppercaseFirst := makeLowercaseFirst := false.
+ isLowerFirst ifTrue:[
+ makeUppercaseFirst := true.
+ ] ifFalse:[
+ "/ must remember where we come from - otherwise, we end up
+ "/ in upperFirst - lowerFirst cycle.
+ "/ think about a good place to store this state
+ false "(isUpperFirst and:[isAllUpper not])" ifTrue:[
+ makeLowercaseFirst := true.
+ ] ifFalse:[
+ isAllUpper ifTrue:[
+ makeLowercase := true.
+ ] ifFalse:[
+ makeUppercase := true.
+ ]
+ ]
+ ].
+ makeUppercaseFirst ifTrue:[
+ line at:col1 put:(line at:col1) asUppercase.
+ ] ifFalse:[
+ makeLowercaseFirst ifTrue:[
+ line at:col1 put:(line at:col1) asLowercase.
+ ] ifFalse:[
+ col1 to:col2 do:[:col |
+ |ch|
+
+ ch := line at:col.
+ ch := makeLowercase
+ ifTrue:[ ch asLowercase ]
+ ifFalse:[
+ makeUppercase
+ ifTrue:[ ch asUppercase ]
+ ifFalse:[
+ col == col1
+ ifTrue:[ ch asUppercase ]
+ ifFalse:[ ch asLowercase ]
+ ]
+ ].
+ line at:col put:ch.
+ ].
+ ].
+ ].
+ self withoutRedrawAt:lineNr put:line.
+ self invalidateLine:lineNr.
+ ].
+ ].
+ ]
+
+ "Created: / 14-07-2011 / 11:40:26 / cg"
+!
+
+copyAndDeleteSelection
+ "copy the selection into the pastBuffer and delete it"
+
+ selectionStartLine notNil ifTrue:[
+ self setClipboardText:(self selection).
+ self deleteSelection.
+ ].
+
+ "Created: 27.1.1996 / 16:23:28 / cg"
+!
+
+deleteCharAtCursor
+ "delete single character under cursor; does not merge lines"
+
+ |wasOn|
+
+ wasOn := self hideCursor.
+ self deleteCharAtLine:cursorLine col:cursorCol.
+ wasOn ifTrue:[self showCursor]
+!
+
+deleteCharAtLine:lineNr col:colNr
+ "delete a single character at colNr in line lineNr"
+
+ self st80EditMode ifTrue:[
+ (self listAt:cursorLine) size + 1 = colNr ifTrue:[
+ | wasOn |
+ wasOn := self hideCursor.
+ self
+ cursorReturn;
+ cursorCol:1;
+ deleteCharBeforeCursor.
+ wasOn ifTrue:[ self showCursor].
+ ^ self.
+ ].
+ ].
+
+ self deleteCharsAtLine:lineNr fromCol:colNr toCol:colNr
+!
+
+deleteCharBeforeCursor
+ "delete single character to the left of cursor and move cursor to left"
+
+ |soCol wasOn lineNrAboveCursor ln originalLine prevTab|
+
+ wasOn := self hideCursor.
+ (autoIndent and:[ (tabPositions includes:cursorCol)]) ifTrue:[
+ prevTab := (self prevTabBefore:cursorCol) max:1.
+ ln := originalLine := (list at:cursorLine ifAbsent:'') ? ''.
+ ln size < prevTab ifTrue:[
+ ln := ln , (String new:prevTab withAll:Character space).
+ ].
+ (ln copyTo:prevTab) isBlank ifTrue:[
+ (ln copyFrom:prevTab+1) isBlank ifTrue:[
+ cursorCol > prevTab ifTrue:[
+ self st80EditMode ifTrue:[
+ "/ ensure that there is no conflict here: st80EditMode will
+ "/ not allow a cursor position beyond the end of line,
+ "/ so avoid that cursorLine:col: will force us to the beginning of the line
+ originalLine size < prevTab ifTrue:[
+ self basicListAt:cursorLine put:ln
+ ]
+ ].
+ self cursorLine:cursorLine col:prevTab.
+ wasOn ifTrue:[ self showCursor ].
+ ^ self
+ ].
+ ] ifFalse:[
+ self deleteFromLine:cursorLine col:prevTab toLine:cursorLine col:cursorCol-1.
+ self cursorLine:cursorLine col:prevTab.
+ wasOn ifTrue:[ self showCursor ].
+ ^ self.
+ ]
+ ].
+ ].
+
+"/ (autoIndent
+"/ and:[cursorCol ~~ 1
+"/ and:[cursorLine <= (list size)]])
+"/ ifTrue:[
+"/ soCol := (self leftIndentForLine:cursorLine) + 1.
+"/
+"/ (cursorCol == soCol and:[soCol > 1]) ifTrue:[
+"/ ln := list at:cursorLine.
+"/ (ln notNil and:[(ln indexOfNonSeparatorStartingAt:1) < soCol]) ifTrue:[
+"/ soCol := 1
+"/ ]
+"/ ]
+"/ ] ifFalse:[
+ soCol := 1.
+"/ ].
+
+ (cursorCol ~~ soCol and:[cursorCol ~~ 1]) ifTrue:[
+ "
+ somewhere in the middle of a line
+ "
+ self cursorLeft.
+ self deleteCharAtLine:cursorLine col:cursorCol.
+ ] ifFalse:[
+ "
+ at begin of line - merge with previous line;
+ except for the very first line.
+ "
+ (cursorLine == 1) ifFalse:[
+ lineNrAboveCursor := self validateCursorLine:(cursorLine - 1).
+ lineNrAboveCursor < cursorLine ifTrue:[
+ (lineNrAboveCursor > 0 and:[lineNrAboveCursor > list size]) ifTrue:[
+ "/ we are beyond the end of the text.
+ "/ move the cursor to the previous line.
+ self cursorLine:lineNrAboveCursor col:1.
+ ] ifFalse:[
+ self mergeLine:lineNrAboveCursor removeBlanks:false.
+ ]
+ ]
+ ]
+ ].
+ wasOn ifTrue:[ self showCursor ]
+
+ "Modified: / 16.1.1998 / 22:33:04 / cg"
+!
+
+deleteCharsAtLine:lineNr fromCol:colNr
+ "delete characters from colNr up to the end in line lineNr"
+
+ |line|
+
+ (line := self listAt:lineNr) notNil ifTrue:[
+ self deleteCharsAtLine:lineNr fromCol:colNr toCol:(line size)
+ ]
+
+!
+
+deleteCharsAtLine:lineNr fromCol:startCol toCol:endCol
+ "delete characters from startCol to endCol in line lineNr"
+
+ |deleted|
+
+ deleted := self textFromLine:lineNr col:startCol toLine:lineNr col:endCol.
+ self basicDeleteCharsAtLine:lineNr fromCol:startCol toCol:endCol.
+ self addUndo:(PasteString line:lineNr col:startCol string:deleted info:'delete').
+!
+
+deleteCharsAtLine:lineNr toCol:colNr
+ "delete characters from start up to colNr in line lineNr"
+
+ self deleteCharsAtLine:lineNr fromCol:1 toCol:colNr
+
+
+!
+
+deleteCursorLine
+ "delete the line where the cursor sits"
+
+ self deleteLine:cursorLine
+!
+
+deleteFromCharacterPosition:charPos1 to:charPos2
+ "delete a substring at a character position"
+
+ |line1 col1 line2 col2|
+
+ line1 := self lineOfCharacterPosition:charPos1.
+ col1 := charPos1 - (self characterPositionOfLine:line1 col:1) + 1.
+ col1 == 0 ifTrue:[
+ line1 := line1 - 1.
+ col1 := (self listAt:line1) size + 1.
+ ].
+
+ line2 := self lineOfCharacterPosition:charPos2.
+ col2 := charPos2 - (self characterPositionOfLine:line2 col:1) + 1.
+
+ self deleteFromLine:line1 col:col1 toLine:line2 col:col2.
+!
+
+deleteFromLine:startLine col:startCol toLine:endLine col:endCol
+ "delete all text from startLine/startCol to endLine/endCol -
+ joining lines if nescessary"
+
+ |line newLine lineSize nMore|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+ list isNil ifTrue:[^ self].
+ startLine > list size ifTrue:[ ^ self]. "/ deleted space below text
+
+ (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 max:1).
+
+ "/ 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 startCol lies beyond end of startLine
+ startLine <= list size ifTrue:[
+ line := list at:startLine.
+ lineSize := line size.
+ (startCol > lineSize) ifTrue:[
+ newLine := line.
+ line isNil ifTrue:[
+ newLine := String new:(startCol - 1)
+ ] ifFalse:[
+ nMore := startCol - 1 - lineSize.
+ nMore > 0 ifTrue:[
+ newLine := line , (line species new:nMore)
+ ]
+ ].
+ newLine ~~ line ifTrue:[
+ self basicListAt:startLine put:newLine.
+ ].
+ "/ TODO: remember old maxwidth of linerange,
+ "/ only clear widthOfWidestLine, if this max
+ "/ length was (one of) the longest.
+ "/ avoids slow delete with huge texts.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ ]
+ ]
+ ].
+
+ "/ merge the left rest of 1st line with right rest of last line into one
+ self mergeLine:startLine removeBlanks:false
+
+ "Modified: / 10-11-1998 / 23:52:59 / cg"
+ "Modified: / 18-03-2011 / 18:25:01 / az"
+!
+
+deleteFromLine:startLineNr toLine:endLineNr
+ "delete some lines"
+
+ |deleted|
+
+ deleted := self textFromLine:startLineNr col:1 toLine:endLineNr+1 col:0.
+ self basicDeleteFromLine:startLineNr toLine:endLineNr.
+ self addUndo:(PasteString line:startLineNr col:1 string:deleted info:'delete').
+!
+
+deleteLine:lineNr
+ "delete line"
+
+ self deleteFromLine:lineNr toLine:lineNr
+
+
+!
+
+deleteLineWithoutRedraw:lineNr
+ "delete line - no redraw;
+ return true, if something was really deleted"
+
+ |deleted ret|
+
+ deleted := self textFromLine:lineNr col:1 toLine:lineNr+1 col:0.
+ ret := self basicDeleteLineWithoutRedraw:lineNr.
+ self addUndo:(PasteString line:lineNr col:1 string:deleted info:'delete').
+ ^ ret.
+!
+
+deleteLinesWithoutRedrawFrom:startLine to:endLine
+ "delete lines - no redraw;
+ return true, if something was really deleted"
+
+ |lastLine|
+
+ self checkModificationsAllowed ifFalse:[^ false].
+
+ (list isNil or:[startLine > list size]) ifTrue:[^ false].
+ (endLine > list size) ifTrue:[
+ lastLine := list size
+ ] ifFalse:[
+ lastLine := endLine
+ ].
+ self basicListRemoveFromIndex:startLine toIndex:lastLine.
+ "/ TODO: remember old maxwidth of linerange,
+ "/ only clear widthOfWidestLine, if this max
+ "/ length was (one of) the longest.
+ "/ avoids slow delete with huge texts.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ ^ true
+
+ "Modified: / 10.11.1998 / 23:55:29 / cg"
+!
+
+deleteSelection
+ "delete the selection"
+
+ |wasOn startLine startCol endLine endCol|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ selectionStartLine notNil ifTrue:[
+ wasOn := self hideCursor.
+
+ startLine := selectionStartLine.
+ startCol := selectionStartCol.
+ endLine := selectionEndLine.
+ endCol := selectionEndCol.
+ self unselectWithoutRedraw.
+ self deleteFromLine:startLine col:startCol toLine:endLine col:endCol.
+ self setCursorLine:startLine col:startCol.
+
+ self makeCursorVisibleAndShowCursor:wasOn
+ ]
+!
+
+deleteWordBeforeCursor
+ "delete the word to the left of cursor and move cursor to left"
+
+ |wasOn beginCol beginLine endCol endLine|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ wasOn := self hideCursor.
+ self
+ undoableDo:[
+ endCol := cursorCol-1.
+ endLine := cursorLine.
+ self cursorToPreviousWord.
+ beginCol := cursorCol.
+ beginLine := cursorLine.
+ self deleteFromLine:beginLine col:beginCol toLine:endLine col:endCol.
+ ]
+ info:'Delete Word'.
+ wasOn ifTrue:[ self showCursor ].
+
+ "Modified: / 22.2.2000 / 23:59:04 / cg"
+!
+
+insert:aCharacter atLine:lineNr col:colNr
+ "insert a single character at lineNr/colNr;
+ set emphasis to character at current position"
+
+ self basicInsert:aCharacter atLine:lineNr col:colNr.
+ aCharacter ~~ Character cr ifTrue:[
+ self addUndo:(DeleteCharacters line:lineNr col:colNr info:'insert').
+ ]
+!
+
+insertCharAtCursor:aCharacter
+ "insert a single character at cursor-position - advance cursor."
+
+ |wasOn|
+
+ wasOn := self hideCursor.
+ aCharacter == Character tab ifTrue:[
+ "/ needs special care to advance cursor correctly
+ self insertTabAtCursor
+ ] ifFalse:[
+ self insert:aCharacter atLine:cursorLine col:cursorCol.
+ aCharacter == (Character cr) ifTrue:[
+ self basicCursorReturn
+ ] ifFalse:[
+ self cursorRight.
+ ].
+ ].
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Modified: / 12.6.1998 / 21:50:20 / cg"
+!
+
+insertLine:aString before:lineNr
+ "insert the line aString before line lineNr"
+
+ ^ self insertLines:(Array with:aString) from:1 to:1 before:lineNr.
+
+ "Modified: 14.5.1996 / 13:42:54 / cg"
+!
+
+insertLines:aStringCollection before:lineNr
+ "insert a bunch before line lineNr"
+
+ self insertLines:aStringCollection from:1 to:aStringCollection size before:lineNr
+
+ "Modified: 6.9.1995 / 20:51:03 / claus"
+!
+
+insertLines:someText from:start to:end before:lineNr
+ "insert a bunch of lines before line lineNr.
+ The cursor position is left unchanged."
+
+ |text indent visLine w nLines "{ Class: SmallInteger }"
+ srcY "{ Class: SmallInteger }"
+ dstY "{ Class: SmallInteger }" |
+
+ autoIndent ifTrue:[
+ indent := self leftIndentForLine:lineNr.
+
+ text := someText
+ collect:[:ln||line|
+ ln notNil ifTrue:[
+ line := ln withoutLeadingSeparators.
+ (line isEmpty or:[indent == 0]) ifFalse:[
+ line := (String new:indent), line
+ ].
+ line
+ ] ifFalse:[
+ nil
+ ]
+ ].
+ ] ifFalse:[
+ text := someText
+ ].
+
+ visLine := self listLineToVisibleLine:lineNr.
+ (shown not or:[visLine isNil]) ifTrue:[
+ self withoutRedrawInsertLines:text
+ from:start to:end
+ before:lineNr.
+ ] ifFalse:[
+ nLines := end - start + 1.
+ ((visLine + nLines) >= nLinesShown) ifTrue:[
+ self withoutRedrawInsertLines:text
+ 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).
+
+ "/
+ "/ scroll ...
+ "/
+ "
+ stupid: must catchExpose before inserting new
+ stuff - since catchExpose may perform redraws
+ "
+ self catchExpose.
+ self withoutRedrawInsertLines:text
+ from:start to:end
+ before:lineNr.
+ self
+ copyFrom:self
+ x:textStartLeft y:srcY
+ toX:textStartLeft y:dstY
+ width:w
+ height:(height - dstY)
+ async:true.
+ self redrawFromVisibleLine:visLine to:(visLine + nLines - 1).
+ self waitForExpose
+ ].
+ ].
+ widthOfWidestLine notNil ifTrue:[
+ text do:[:line |
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
+ ]
+ ].
+ self textChanged.
+
+ "Modified: 29.1.1997 / 13:02:39 / cg"
+!
+
+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 wasOn|
+
+ 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:[
+ wasOn := self hideCursor.
+ self insertLines:lines from:start to:end before:cursorLine.
+ self setCursorLine:(cursorLine + (end - start + 1)).
+ wasOn ifTrue:[self showCursor].
+ ]
+ ].
+ withCr ifFalse:[
+ "last line without cr"
+ self insertStringAtCursor:(lines at:nLines)
+ ]
+ ]
+ ]
+
+ "Created: / 18.5.1996 / 15:32:06 / cg"
+ "Modified: / 12.6.1998 / 21:51:16 / cg"
+!
+
+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"
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use #insertLines:withCR:'.
+ self insertLines:lines withCR:withCr.
+
+ "Modified: 31.7.1997 / 23:07:22 / cg"
+!
+
+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).
+ self makeSelectionVisible.
+!
+
+insertString:aString atCharacterPosition:charPos
+ "insert the argument, aString at a character position"
+
+ |line col|
+
+ line := self lineOfCharacterPosition:charPos.
+ col := charPos - (self characterPositionOfLine:line col:1) + 1.
+ self insertString:aString atLine:line col:col
+!
+
+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 includes:(Character cr)) ifFalse:[
+ ^ 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
+ ]
+
+ "Modified: / 10.6.1998 / 19:03:59 / cg"
+!
+
+insertStringAtCursor:aString
+ "insert the argument, aString at cursor position
+ handle cr's correctly. A nil argument is interpreted as an empty line."
+
+ aString isNil ifTrue:[
+ "new:"
+ self insertCharAtCursor:(Character cr).
+ ^ self
+ ].
+ (aString includes:(Character cr)) ifFalse:[
+ ^ self insertStringWithoutCRsAtCursor:aString
+ ].
+
+ self insertLines:aString asStringCollection withCR:false.
+
+ "Modified: / 10.6.1998 / 19:03:21 / cg"
+!
+
+insertStringWithoutCRs:aString atLine:lineNr col:colNr
+ "insert aString (which has no crs) at lineNr/colNr"
+
+ self withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
+ shown ifTrue:[
+ gc font hasOverlappingCharacters ifTrue:[
+ self invalidateLine:lineNr.
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
+ ]
+
+ "Modified: / 09-11-2010 / 13:43:03 / cg"
+!
+
+insertStringWithoutCRsAtCursor:aString
+ "insert a string (which has no crs) at cursor position
+ - advance cursor"
+
+ |wasOn oldLen newLen deltaLen|
+
+ aString size > 0 ifTrue:[
+ wasOn := self hideCursor.
+ (aString includes:Character tab) ifTrue:[
+ self checkForExistingLine:cursorLine.
+ oldLen := (list at:cursorLine) size.
+ self insertString:aString atLine:cursorLine col:cursorCol.
+ newLen := (list at:cursorLine) size.
+ deltaLen := newLen - oldLen.
+ ] ifFalse:[
+ self insertString:aString atLine:(cursorLine ? 1) col:cursorCol.
+ deltaLen := aString size.
+ ].
+ self setCursorCol:(cursorCol + deltaLen).
+ wasOn ifTrue:[self showCursor]
+ ]
+
+ "Modified: / 10.6.1998 / 20:43:52 / cg"
+!
+
+insertTabAtCursor
+ "insert spaces to next tab"
+
+ |wasOn nextTab|
+
+ wasOn := self hideCursor.
+ nextTab := self nextTabAfter:cursorCol.
+ self insertStringAtCursor:(String new:(nextTab - cursorCol)).
+ self makeCursorVisibleAndShowCursor:wasOn.
+!
+
+joinLines
+ "join lines (remove line-break)"
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ self
+ undoableDo:[
+ |line col lineLen|
+
+ line := cursorLine.
+ col := cursorCol.
+ lineLen := (list at:line) size.
+ col > lineLen ifTrue:[
+ self insertString:(String new:col-lineLen) atLine:line col:col+1.
+ ] ifFalse:[
+ self deleteCharsAtLine:line fromCol:col toCol:lineLen.
+ ].
+ self mergeLine:line removeBlanks:true.
+ self cursorLine:line col:col.
+ ]
+ info:'Join'
+!
+
+mergeLine:lineNr
+ "merge line lineNr with line lineNr+1"
+
+ self mergeLine:lineNr removeBlanks:true
+
+ "Modified: 9.9.1997 / 09:28:03 / cg"
+!
+
+mergeLine:lineNr removeBlanks:removeBlanks
+ "merge line lineNr with line lineNr+1"
+
+ |len|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ len := (self listAt:lineNr) size.
+ self nonUndoableDo:[
+ self basicMergeLine:lineNr removeBlanks:removeBlanks.
+ ].
+ self addUndo:(PasteString new line:lineNr col:len+1 string:(Character cr asString) selected:false).
+!
+
+parenthizeSelectionWith:openingCharacter and:closingCharacter
+ |newSelectionEnd|
+
+ self hasSelection ifFalse:[^ self].
+
+ newSelectionEnd := selectionEndCol.
+
+ (self characterAtLine:selectionStartLine col:selectionStartCol) == openingCharacter ifTrue:[
+ (self characterAtLine:selectionEndLine col:selectionEndCol) == closingCharacter ifTrue:[
+ self deleteCharAtLine:selectionEndLine col:selectionEndCol.
+ newSelectionEnd := newSelectionEnd-1.
+ ].
+ self deleteCharAtLine:selectionStartLine col:selectionStartCol.
+ selectionStartLine == selectionEndLine ifTrue:[
+ newSelectionEnd := newSelectionEnd-1.
+ ]
+ ] ifFalse:[
+ self insert:closingCharacter atLine:selectionEndLine col:selectionEndCol+1.
+ newSelectionEnd := newSelectionEnd+1.
+ self insert:openingCharacter atLine:selectionStartLine col:selectionStartCol.
+ selectionStartLine == selectionEndLine ifTrue:[
+ newSelectionEnd := newSelectionEnd+1.
+ ]
+ ].
+ self
+ selectFromLine:selectionStartLine col:selectionStartCol
+ toLine:selectionEndLine col:newSelectionEnd.
+!
+
+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:[
+ self basicListAt:lastLine put:nil.
+ line := nil
+ ]
+ ].
+ line notNil ifTrue:[
+ finished := true
+ ] ifFalse:[
+ lastLine := lastLine - 1
+ ]
+ ]
+ ].
+ (lastLine ~~ list size) ifTrue:[
+ list grow:lastLine.
+"/ self textChanged
+ ]
+!
+
+replace:aCharacter atLine:lineNr col:colNr
+ "replace a single character at lineNr/colNr"
+
+ |originalChar|
+
+ originalChar := self characterAtLine:lineNr col:colNr.
+ self basicReplace:aCharacter atLine:lineNr col:colNr.
+ self addUndo:(ReplaceCharacters line:lineNr col:colNr character:originalChar info:'replace').
+!
+
+replace:patternArg by:replacePatternArg all:all ignoreCase:ignoreCase
+ |pattern replacePattern|
+
+ pattern := patternArg string.
+ replacePattern := replacePatternArg string.
+ (pattern notEmpty and:[ replacePattern notEmpty ]) ifTrue:[
+ self rememberSearchPattern:pattern.
+ self rememberSearchPattern:replacePattern.
+ LastSearchIgnoredCase := ignoreCase.
+ self
+ undoableDo:[
+ all ifTrue:[
+ self
+ replaceString:pattern
+ to:replacePattern
+ ignoreCase:ignoreCase
+ ] ifFalse:[
+ (self selectionAsString notNil
+ and:[ self selectionAsString sameAs:pattern caseSensitive:ignoreCase not ])
+ ifTrue:[
+ self replaceSelectionBy:replacePattern.
+ self
+ search:pattern
+ ignoreCase:ignoreCase
+ forward:(lastSearchDirection = #forward).
+ ].
+ ]
+ ]
+ info:'Replace'
+ ]
+
+ "Created: / 11-07-2006 / 11:19:57 / fm"
+!
+
+replaceCharAtCursor:aCharacter
+ "replace a single character at cursor-position - advance cursor"
+
+ |wasOn|
+
+ wasOn := self hideCursor.
+ aCharacter == (Character cr) ifTrue:[
+ self cursorReturn
+ ] ifFalse:[
+ self replace:aCharacter atLine:cursorLine col:cursorCol.
+ self cursorRight.
+ ].
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Created: 6.3.1996 / 12:27:42 / cg"
+!
+
+replaceContentsWith:newContents
+ "replace everything"
+
+ |originalContents|
+
+ originalContents := self contents.
+ self contents:newContents keepUndoHistory:true.
+ self addUndo:(ReplaceContents text:originalContents info:'replace').
+!
+
+replaceFromCharacterPosition:charPos1 to:charPos2 with:newString
+ "replace a substring at a character position"
+
+ "/ sigh - insert first, to avoid troible due to shifing-in virtual line ends
+ self insertString:newString atCharacterPosition:charPos1.
+ self deleteFromCharacterPosition:charPos1+newString size to:charPos2+newString size.
+!
+
+replaceLine:lineNr with:newText
+ "replace a line at lineNr"
+
+ |originalLine|
+
+ originalLine := self listAt:lineNr.
+ originalLine isNil ifTrue:[
+ self checkForExistingLine:lineNr
+ ].
+ self list at:lineNr put:newText.
+ self addUndo:(ReplaceLine line:lineNr string:originalLine info:'replace').
+ self invalidateLine:lineNr.
+
+ "Modified: / 12-04-2007 / 09:31:33 / cg"
+!
+
+replaceLines:lines withCR:withCr
+ "replace a bunch of lines at cursor position. Cursor
+ is moved behind replacement.
+ If withCr is true, move to the beginning of the next line
+ after the last line"
+
+ |line col nLines wasOn|
+
+ lines notNil ifTrue:[
+ wasOn := self hideCursor.
+ nLines := lines size.
+ line := cursorLine.
+ col := cursorCol.
+ lines keysAndValuesDo:[:i :l |
+ self replaceString:(l ? '') atLine:line col:col.
+ (i ~~ nLines or:[withCr]) ifTrue:[
+ line := line + 1.
+ col := 1.
+ ] ifFalse:[
+ col := col + (l size).
+ ]
+ ].
+ self cursorLine:line col:col.
+ self makeCursorVisibleAndShowCursor:wasOn.
+ "/ wasOn ifTrue:[self showCursor].
+ ]
+
+ "Created: / 18-05-1996 / 15:32:06 / cg"
+ "Modified: / 25-07-2013 / 17:00:53 / cg"
+!
+
+replaceSelectionBy:something
+ "delete the selection (if any) and insert something, a character or string;
+ leave cursor after insertion"
+
+ self replaceSelectionBy:something keepCursor:false select: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"
+
+ self replaceSelectionBy:something keepCursor:keep select:false
+
+ "Modified: 9.10.1996 / 16:14:35 / cg"
+!
+
+replaceSelectionBy:something keepCursor:keep select:selectNewText
+ "delete the selection (if any) and insert something, a character or string;
+ leave cursor after insertion or leave it, depending on keep.
+ If selectNewText is true, select the new text; otherwise deselect"
+
+ |sel l c selStartLine selStartCol|
+
+ l := cursorLine.
+ c := cursorCol.
+
+ sel := self selectionAsString.
+ sel isNil ifTrue:[
+ selStartLine := l.
+ selStartCol := c.
+ ] ifFalse:[
+ selStartLine := selectionStartLine.
+ selStartCol := selectionStartCol.
+
+ self setLastStringToReplace: sel.
+
+ self deleteSelection.
+ replacing := true.
+ lastReplacementInfo rememberReplacement.
+ lastReplacementInfo lastReplacement: ''.
+ lastReplacementInfo stillCollectingInput:true.
+ undoSupport actionInfo:'replace'.
+ ].
+
+ something isCharacter ifTrue:[
+ lastReplacementInfo lastReplacement notNil ifTrue:[
+ lastReplacementInfo stillCollectingInput ifTrue:[
+ lastReplacementInfo lastReplacement: (lastReplacementInfo lastReplacement copyWith:something).
+ ].
+ ].
+ self isInInsertMode ifTrue:[
+ self insertCharAtCursor:something
+ ] ifFalse:[
+ self replaceCharAtCursor:something
+ ]
+ ] ifFalse:[
+ something isString ifTrue:[
+ lastReplacementInfo lastReplacement: something.
+ self isInInsertMode ifTrue:[
+ self insertStringAtCursor:something
+ ] ifFalse:[
+ self replaceStringAtCursor:something
+ ]
+ ] ifFalse:[
+ Transcript showCR:'EditTextView: non String-or-Character in replace'.
+ ].
+ ].
+ keep ifTrue:[
+ self cursorLine:l col:c
+ ].
+ selectNewText ifTrue:[
+ self selectFromLine:selStartLine col:selStartCol toLine:cursorLine col:cursorCol-1
+ ]
+
+ "Modified: 9.10.1996 / 16:14:35 / cg"
+!
+
+replaceString:aString atLine:lineNr col:colNr
+ "replace multiple characters starting at lineNr/colNr.
+ This is not prepared to encounter special chars (except TAB) in the string."
+
+ |originalString|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ originalString := self textFromLine:lineNr col:colNr toLine:lineNr col:colNr+aString size-1.
+
+ self basicReplaceString:aString atLine:lineNr col:colNr.
+ self addUndo:(ReplaceCharacters line:lineNr col:colNr characters:originalString info:'replace').
+!
+
+replaceString:aString to:aNewString ignoreCase:ignoreCase
+ |continue count|
+
+ self cursorToTop.
+ self selectFromBeginning.
+ count := 0.
+ continue := true.
+ [ continue ] whileTrue:[
+ (self selectionAsString notNil
+ and:[ self selectionAsString sameAs:aString caseSensitive:ignoreCase not ])
+ ifTrue:[
+ self replaceSelectionBy:aNewString.
+ count := count + 1.
+ ].
+ self
+ searchFwd:aString
+ ignoreCase:ignoreCase
+ ifAbsent:[
+ Dialog information:('%1 has been replaced by %2 %3 times'
+ bindWith:aString with:aNewString with:count).
+ continue := false.
+ ].
+ ].
+
+ "Created: / 10-07-2006 / 16:42:48 / fm"
+!
+
+replaceStringAtCursor:aString
+ "replace multiple characters at cursor-position - advance cursor"
+
+ |wasOn i1 i2|
+
+ wasOn := self hideCursor.
+ (aString includes:Character tab) ifTrue:[
+ "/ need special care for TAB (to move cursor correctly)
+ i1 := 1.
+ [i1 ~~ 0] whileTrue:[
+ i2 := aString indexOf:Character tab startingAt:i1.
+ i2 ~~ 0 ifTrue:[
+ i1 ~~ i2 ifTrue:[
+ self replaceString:(aString copyFrom:i1 to:i2-1) atLine:cursorLine col:cursorCol.
+ self cursorCol:(cursorCol + (i2 - i1)).
+ ].
+ self replaceTABAtCursor.
+ i2 := i2 + 1.
+ ] ifFalse:[
+ self replaceString:(aString copyFrom:i1) atLine:cursorLine col:cursorCol.
+ self cursorCol:(cursorCol + (aString size - i1 + 1)).
+ ].
+ i1 := i2.
+ ]
+ ] ifFalse:[
+ self replaceString:aString atLine:cursorLine col:cursorCol.
+ self cursorCol:(cursorCol + aString size).
+ ].
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Created: / 9.6.1998 / 20:33:20 / cg"
+ "Modified: / 20.6.1998 / 19:41:02 / cg"
+!
+
+replaceTABAtCursor
+ "replace a single character at cursor-position by a TAB character"
+
+ |wasOn nextTab|
+
+ wasOn := self hideCursor.
+ nextTab := self nextTabAfter:cursorCol.
+ self replaceStringAtCursor:(String new:(nextTab - cursorCol)).
+ self makeCursorVisibleAndShowCursor:wasOn.
+
+ "Created: / 12.6.1998 / 21:53:23 / cg"
+!
+
+selectWordBeforeCursor
+ "select the word to the left of cursor"
+
+ |savCursorLine savCursorCol beginCol beginLine endCol endLine|
+
+ savCursorLine := cursorLine.
+ savCursorCol := cursorCol.
+
+ endCol := cursorCol-1.
+ endLine := cursorLine.
+ self cursorToPreviousWord.
+ beginCol := cursorCol.
+ beginLine := cursorLine.
+ self cursorLine:savCursorLine col:savCursorCol.
+ self selectFromLine:beginLine col:beginCol toLine:endLine col:endCol.
+
+ "Created: / 14-06-2011 / 14:46:35 / cg"
+!
+
+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"
+
+ self basicSplitLine:lineNr before:colNr.
+ self addUndo:(DeleteRange line1:lineNr col1:colNr line2:lineNr+1 col2:0 info:'split').
+!
+
+withoutRedrawAt:lineNr put:aString
+ "replace a line at lineNr"
+
+ |originalLine|
+
+ originalLine := self listAt:lineNr.
+ self addUndo:(ReplaceLine line:lineNr string:originalLine info:'replace').
+ super withoutRedrawAt:lineNr put:aString.
+!
+
+withoutRedrawInsertLine:aString before:lineNr
+ "insert the argument, aString before line lineNr; the string
+ becomes line lineNr; everything else is moved down; the view
+ is not redrawn"
+
+ self basicWithoutRedrawInsertLines:{ aString } from:1 to:1 before:lineNr.
+ self addUndo:(DeleteRange line1:lineNr col1:1 line2:lineNr+1 col2:0 info:'insert').
+!
+
+withoutRedrawInsertLines:lines from:start to:end before:lineNr
+ "insert a bunch of lines before line lineNr; the view is not redrawn"
+
+ self basicWithoutRedrawInsertLines:lines from:start to:end before:lineNr.
+ self isReadOnly ifFalse:[
+ self addUndo:(DeleteRange line1:lineNr col1:1 line2:lineNr+end-start+1 col2:0 info:'insert').
+ ].
+!
+
+withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr
+ "insert aString (which has no crs) at lineNr/colNr"
+
+ self basicWithoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
+ self addUndo:(DeleteRange line1:lineNr col1:colNr line2:lineNr col2:colNr+aString size-1 info:'insert').
+!
+
+wrapLines
+ "wrap lines (insert line-break)"
+
+ |lineLength answerString string|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ self hasSelection ifFalse:[
+ self selectLine:cursorLine.
+ ].
+ string := self selectionAsString.
+ string isEmptyOrNil ifTrue:[
+ Dialog information:(resources string:'Nothing selected.').
+ ^ self.
+ ].
+
+ answerString := Dialog request:(resources string:'Line length (wrap after how many chars)?') initialAnswer:80.
+ lineLength := Number readFrom:answerString onError:nil.
+ lineLength isNil ifTrue:[^ self].
+ lineLength < 1 ifTrue:[
+ lineLength := 1.
+ ].
+
+ self
+ undoableDo:[
+ |inStream line col lineLen lastGoodCol lastStartCol word|
+
+ line := selectionStartLine.
+ col := selectionStartCol.
+
+ self cutSelection.
+ self cursorLine:line col:col.
+
+ lastGoodCol := col.
+
+ inStream := string readStream.
+ [ inStream atEnd ] whileFalse:[
+ [inStream atEnd not and:[inStream peek isSeparator]] whileTrue:[ inStream next ].
+ word := WriteStream on:(String new:10).
+ [inStream atEnd not and:[inStream peek isSeparator not]] whileTrue:[ word nextPut:inStream next ].
+ (col + 1 + word size > lineLength) ifTrue:[
+ self insertCharAtCursor:(Character cr).
+ col := 1.
+ ] ifFalse:[
+ col ~~ 1 ifTrue:[
+ self insertStringAtCursor:' '.
+ col := col + 1.
+ ]
+ ].
+ self insertStringAtCursor:word contents.
+ col := col + word size.
+ ].
+ ]
+ info:'Wrap'
+
+ "Modified: / 01-03-2012 / 19:56:22 / cg"
+! !
+
+!EditTextView methodsFor:'editing-basic'!
+
+basicDeleteCharsAtLine:lineNr fromCol:startCol toCol:endCol
+ "delete characters from startCol to endCol in line lineNr"
+
+ |line lineSize newLine start stop prevWidth newWidth|
+
+ self unselect.
+
+ cursorLine == lineNr ifTrue:[
+ cursorCol >= startCol ifTrue:[
+ cursorCol >= endCol ifTrue:[
+ cursorCol := startCol.
+ ] ifFalse:[
+ cursorCol := cursorCol - (endCol - startCol + 1).
+ ]
+ ].
+ ].
+
+ line := self listAt:lineNr.
+
+ (self checkModificationsAllowed and:[line notNil]) ifFalse:[^ self].
+
+ lineSize := line size.
+
+ startCol == 0 ifFalse:[ start := startCol ] ifTrue:[ start := 1 ].
+ endCol > lineSize ifFalse:[ stop := endCol ] ifTrue:[ stop := lineSize ].
+
+ stop >= start ifTrue:[
+ start ~~ 1 ifTrue:[ newLine := line copyFrom:1 to:(start-1) ]
+ ifFalse:[ newLine := '' ].
+
+ stop == lineSize ifFalse:[
+ line bitsPerCharacter > newLine bitsPerCharacter ifTrue:[
+ newLine := line string species fromString:newLine.
+ ].
+ newLine := newLine, (line copyFrom:(stop + 1) to:lineSize)
+ ].
+
+ (trimBlankLines and:[newLine isBlank]) ifTrue:[
+ newLine := nil
+ ].
+
+ prevWidth := self widthOfLine:lineNr.
+
+ self basicListAt:lineNr put:newLine.
+
+ (prevWidth = widthOfWidestLine) ifTrue:[
+ "/ remember old width of this line,
+ "/ only clear widthOfWidestLine, if this lines
+ "/ length was (one of) the longest.
+ "/ avoids slow delete with huge texts.
+ widthOfWidestLine := nil. "i.e. unknown"
+
+ "/ scroll left if reqiured
+ viewOrigin x > 0 ifTrue:[
+ newWidth := self widthOfLine:lineNr.
+ newWidth < (viewOrigin x + width) ifTrue:[
+ self scrollHorizontalTo:(newWidth
+ - width
+ + margin + margin
+ + (gc font widthOf:' '))
+ ]
+ ].
+ self textChanged.
+ ] ifFalse:[
+ self textChanged "/ textChangedButNoSizeChange
+ ].
+ gc font hasOverlappingCharacters ifTrue:[
+ self invalidateLine:lineNr.
+ ] ifFalse:[
+ self redrawLine:lineNr from:start.
+ ].
+ ].
+
+ "Modified: / 09-11-2010 / 13:42:45 / cg"
+!
+
+basicDeleteFromLine:startLineNr toLine:endLineNr
+ "delete some lines"
+
+ |wasOn nLines|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+ list isNil ifTrue:[^ self].
+
+ wasOn := self hideCursor.
+
+ "/ isnt this the same as:
+ "/ self deleteLinesWithoutRedrawFrom:startLineNr to:endLineNr.
+ startLineNr <= list size ifTrue:[
+ self basicListRemoveFromIndex:startLineNr toIndex:(endLineNr min:list size).
+ ].
+ "/ TODO: remember old maxwidth of linerange,
+ "/ only clear widthOfWidestLine, if this max
+ "/ length was (one of) the longest.
+ "/ avoids slow delete with huge texts.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+
+ self redrawFromLine:startLineNr.
+
+ nLines := list size.
+ (firstLineShown >= nLines) ifTrue:[
+ self makeLineVisible:nLines
+ ].
+ wasOn ifTrue:[self showCursor].
+
+ "Modified: / 10-11-1998 / 23:55:05 / cg"
+ "Modified: / 18-03-2011 / 18:26:23 / az"
+!
+
+basicDeleteLineWithoutRedraw:lineNr
+ "delete line - no redraw;
+ return true, if something was really deleted"
+
+ self checkModificationsAllowed ifFalse:[ ^ false].
+
+ (list isNil or:[lineNr > list size]) ifTrue:[^ false].
+ list removeIndex:lineNr.
+ "/ TODO: remember old maxwidth of linerange,
+ "/ only clear widthOfWidestLine, if this max
+ "/ length was (one of) the longest.
+ "/ avoids slow delete with huge texts.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+ ^ true
+
+ "Modified: / 10.11.1998 / 23:53:24 / cg"
+!
+
+basicInsert:aCharacter atLine:lineNr col:colNr
+ "insert a single character at lineNr/colNr;
+ set emphasis to character at current position"
+
+ |line lineSize newLine drawCharacterOnly attribute oldClip x y|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ aCharacter == (Character cr) ifTrue:[
+ self splitLine:lineNr before:colNr.
+ ^ self
+ ].
+
+ drawCharacterOnly := false.
+ self checkForExistingLine:lineNr.
+ line := list at:lineNr.
+ lineSize := line size.
+
+ self st80EditMode ifFalse:[
+ (trimBlankLines
+ and:[colNr > lineSize
+ and:[aCharacter == Character space]]) ifTrue:[
+ ^ self
+ ]
+ ].
+
+ (lineSize == 0) ifTrue:[
+ newLine := aCharacter asString species new:colNr.
+ drawCharacterOnly := true
+ ] ifFalse: [
+ (colNr > lineSize) ifTrue: [
+ colNr == (lineSize +1) ifTrue:[
+ attribute := line emphasisAt:lineSize
+ ].
+ newLine := line species new:colNr.
+ newLine replaceFrom:1 to:lineSize with:line startingAt:1.
+ drawCharacterOnly := true
+ ] ifFalse: [
+ attribute := line emphasisAt:colNr.
+ newLine := line species new:(lineSize + 1).
+
+ newLine replaceFrom:1 to:(colNr - 1) with:line startingAt:1.
+ newLine replaceFrom:(colNr + 1) to:(lineSize + 1) with:line startingAt:colNr
+ ]
+ ].
+
+ aCharacter asString bitsPerCharacter > newLine bitsPerCharacter ifTrue:[
+ newLine := aCharacter asString species fromString:newLine.
+ line isText ifTrue:[
+ newLine := newLine asText
+ ]
+ ].
+ newLine at:colNr put:aCharacter.
+
+ attribute notNil ifTrue:[
+ newLine emphasisAt:colNr put:attribute.
+ ].
+
+ aCharacter == (Character tab) ifTrue:[
+ newLine := self withTabsExpanded:newLine.
+ drawCharacterOnly := false
+ ].
+
+ self basicListAt:lineNr put:(newLine ifNil:[newLine] ifNotNil:[newLine asSingleByteStringIfPossible]).
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:newLine).
+ ].
+ self textChanged.
+ shown ifTrue:[
+ "/ care for italic text - in this case, we must also
+ "/ redraw the character before the insertion in order
+ "/ to fix the slanted piece of the character.
+ "/ (but we must clip, to avoid destoying the character before)
+ (newLine notNil and:[newLine isText]) ifTrue:[
+ colNr > 1 ifTrue:[
+ cursorVisibleLine notNil ifTrue:[
+ oldClip := self clippingRectangleOrNil.
+ x := (self xOfCol:colNr-1 inVisibleLine:cursorVisibleLine) - viewOrigin x.
+ y := self yOfVisibleLine:cursorVisibleLine.
+
+ gc font hasOverlappingCharacters ifTrue:[
+ self invalidateLine:lineNr.
+ ] ifFalse:[
+ drawCharacterOnly ifTrue:[
+ self clippingRectangle:(x@y extent:((gc font width * 2) @ fontHeight)).
+ self redrawLine:lineNr from:colNr-1 to:colNr
+ ] ifFalse:[
+ self clippingRectangle:(x@y extent:((width - x) @ fontHeight)).
+ self redrawLine:lineNr from:colNr-1
+ ].
+ self clippingRectangle:oldClip.
+ ].
+ ].
+ ^ self.
+ ].
+ ].
+ gc font hasOverlappingCharacters ifTrue:[
+ self invalidateLine:lineNr.
+ ] ifFalse:[
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
+ ]
+ ]
+
+ "Modified: / 09-11-2010 / 13:43:18 / cg"
+!
+
+basicListAt:lineNr put:newLine
+ "redefinable for special subclasses (with virtual list)"
+
+ list at:lineNr put:newLine.
+!
+
+basicListRemoveFromIndex:startLineNr toIndex:endLineNr
+ "redefinable for special subclasses (with virtual list)"
+
+ list removeFromIndex:startLineNr toIndex:(endLineNr min:list size).
+!
+
+basicMergeLine:lineNr removeBlanks:removeBlanks
+ "merge line lineNr with line lineNr+1"
+
+ |leftPart rightPart bothParts nextLineNr i|
+
+ (list notNil and:[(list size) >= lineNr]) ifFalse:[
+ "/ empty list or beyond end of text
+ ^ self
+ ].
+ leftPart := self listAt:lineNr.
+
+ leftPart isNil ifTrue:[
+ leftPart := ''.
+ autoIndent ifTrue:[
+ (i := self leftIndentForLine:cursorLine) == 0 ifFalse:[
+ leftPart := String new:i
+ ]
+ ]
+ ].
+ self cursorLine:lineNr col:((leftPart size) + 1).
+ nextLineNr := self validateCursorLine:(lineNr + 1).
+
+ nextLineNr > (list size) ifFalse:[
+ (rightPart := self listAt:nextLineNr) isNil ifTrue:[
+ rightPart := ''
+ ] ifFalse:[
+ removeBlanks ifTrue:[
+ rightPart := rightPart withoutLeadingSeparators.
+ ]
+ ].
+
+ bothParts := leftPart , rightPart.
+ (trimBlankLines and:[bothParts isBlank]) ifTrue:[bothParts := nil].
+ self basicListAt:lineNr put:bothParts.
+ self redrawLine:lineNr.
+ self deleteLine:nextLineNr
+ ]
+
+ "Created: 9.9.1997 / 09:27:38 / cg"
+ "Modified: 9.9.1997 / 09:28:27 / cg"
+!
+
+basicReplace:aCharacter atLine:lineNr col:colNr
+ "replace a single character at lineNr/colNr"
+
+ |line lineSize newLine drawCharacterOnly|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ aCharacter == (Character cr) ifTrue:[
+ ^ self
+ ].
+
+ drawCharacterOnly := true.
+ self checkForExistingLine:lineNr.
+ line := list at:lineNr.
+ lineSize := line size.
+
+ (trimBlankLines
+ and:[colNr > lineSize
+ and:[aCharacter == Character space]]) ifTrue:[
+ ^ self
+ ].
+
+ (lineSize == 0) ifTrue:[
+ newLine := aCharacter asString species new:colNr.
+ ] ifFalse: [
+ (colNr > lineSize) ifTrue: [
+ newLine := line species new:colNr.
+ newLine replaceFrom:1 to:lineSize with:line startingAt:1.
+ ] ifFalse: [
+ newLine := line copy.
+ ]
+ ].
+ newLine at:colNr put:aCharacter.
+ aCharacter == (Character tab) ifTrue:[
+ newLine := self withTabsExpanded:newLine.
+ drawCharacterOnly := false
+ ].
+ self basicListAt:lineNr put:(newLine ifNil:[newLine] ifNotNil:[newLine asSingleByteStringIfPossible]).
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:newLine).
+ ].
+ self textChanged.
+ shown ifTrue:[
+ gc font hasOverlappingCharacters ifTrue:[
+ self invalidateLine:lineNr.
+ ] ifFalse:[
+ drawCharacterOnly ifTrue:[
+ self redrawLine:lineNr col:colNr
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
+ ]
+ ]
+
+ "Created: / 06-03-1996 / 12:29:20 / cg"
+ "Modified: / 09-11-2010 / 13:42:54 / cg"
+!
+
+basicReplaceString:aString atLine:lineNr col:colNr
+ "replace multiple characters starting at lineNr/colNr.
+ This is not prepared to encounter special chars (except TAB)
+ in the string."
+
+ |line lineSize newLine endCol|
+
+ self checkModificationsAllowed ifFalse:[ ^ self].
+
+ self checkForExistingLine:lineNr.
+ line := list at:lineNr.
+ lineSize := line size.
+
+ endCol := colNr + aString size - 1.
+ (lineSize == 0) ifTrue:[
+ newLine := aString species new:endCol.
+ ] ifFalse: [
+ (endCol > lineSize) ifTrue: [
+ aString isText ifTrue:[
+ newLine := aString species new:endCol.
+ ] ifFalse:[
+ newLine := line species new:endCol.
+ ].
+ newLine replaceFrom:1 to:lineSize with:line startingAt:1.
+ ] ifFalse: [
+ aString isText ifTrue:[
+ newLine := aString species new:line size.
+ newLine replaceFrom:1 to:lineSize with:line startingAt:1.
+ ] ifFalse:[
+ newLine := line copy.
+ ]
+ ]
+ ].
+ newLine replaceFrom:colNr with:aString.
+ (aString includes:(Character tab)) ifTrue:[
+ newLine := self withTabsExpanded:newLine.
+ ].
+ self basicListAt:lineNr put:(newLine ifNil:[newLine] ifNotNil:[newLine asSingleByteStringIfPossible]).
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:newLine).
+ ].
+ self textChanged.
+ shown ifTrue:[
+ gc font hasOverlappingCharacters ifTrue:[
+ self invalidateLine:lineNr.
+ ] ifFalse:[
+ self redrawLine:lineNr from:colNr
+ ]
+ ]
+
+ "Created: / 11-06-1998 / 10:38:32 / cg"
+ "Modified: / 09-11-2010 / 13:42:56 / cg"
+!
+
+basicSplitLine: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 h mustWait
+ srcY "{ Class: SmallInteger }" |
+
+ list isNil ifTrue:[ ^ self ].
+ lineNr > (list size) ifTrue:[ ^ self ].
+
+ (colNr == 1) ifTrue:[
+ self nonUndoableDo:[
+ self insertLine:nil before:lineNr.
+ ].
+ ^ self
+ ].
+
+ line := list at:lineNr.
+ line notNil ifTrue:[
+ 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:[
+ (trimBlankLines and:[leftRest isBlank]) ifTrue:[leftRest := nil]
+ ].
+ self basicListAt:lineNr put:leftRest.
+ self nonUndoableDo:[
+ self withoutRedrawInsertLine:rightRest before:(lineNr + 1).
+ ].
+ visLine := self listLineToVisibleLine:(lineNr).
+ visLine notNil ifTrue:[
+ w := self widthForScrollBetween:lineNr
+ and:(firstLineShown + nLinesShown).
+ srcY := topMargin + (visLine * fontHeight).
+ h := ((nLinesShown - visLine - 1) * fontHeight).
+ (mustWait := (w > 0 and:[h > 0])) ifTrue:[
+ self catchExpose.
+ self
+ copyFrom:self
+ x:textStartLeft y:srcY
+ toX:textStartLeft y:(srcY + fontHeight)
+ width:w
+ height:((nLinesShown - visLine - 1) * fontHeight)
+ async:true.
+ ].
+ self redrawLine:lineNr.
+ self redrawLine:(lineNr + 1).
+ mustWait ifTrue:[self waitForExpose]
+ ].
+ widthOfWidestLine := nil. "/ unknown
+ self textChanged.
+
+ "Modified: / 06-12-2010 / 13:12:55 / cg"
+!
+
+basicWithoutRedrawInsertLines:lines from:start to:end before:lineNr
+ "insert a bunch of lines before line lineNr; the view is not redrawn.
+ Tabs are expanded here with a tab=8 setting (independent of any editor-setting,
+ because the text might have been pasted from an alien view."
+
+ |newLine newLines nLines|
+
+ nLines := end - start + 1.
+ newLines := Array new:(lines size).
+ start to:end do:[:index |
+ newLine := lines at:index.
+ newLine notNil ifTrue:[
+ newLine isString ifTrue:[
+ newLine isBlank ifTrue:[
+ newLine := nil
+ ] ifFalse:[
+ (newLine includes:(Character tab)) ifTrue:[
+ newLine := self withTabs:(ListView tab8Positions) expand: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.
+ self contentsChanged
+
+ "Modified: / 07-10-2011 / 15:55:18 / cg"
+!
+
+basicWithoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr
+ "insert aString (which has no crs) at lineNr/colNr.
+ Tabs are expanded here with a tab=8 setting (independent of any editor-setting,
+ because the text might have been pasted from an alien view."
+
+ |isText strLen line lineSize newLine stringType sz lineCharWidth stringCharWidth|
+
+ (aString isNil) ifTrue:[ ^ self].
+
+ strLen := aString size.
+ self checkForExistingLine:lineNr.
+
+ stringType := aString string species.
+ isText := aString isText.
+ line := list at:lineNr.
+
+ line notNil ifTrue:[
+ lineSize := line size.
+ line isString ifFalse:[
+ stringType := line species
+ ] ifTrue:[
+ lineCharWidth := line bitsPerCharacter.
+ stringCharWidth := aString bitsPerCharacter.
+ lineCharWidth > stringCharWidth ifTrue:[
+ stringType := line string species
+ ] ifFalse:[
+ stringCharWidth > lineCharWidth ifTrue:[
+ stringType := aString string species
+ ]
+ ].
+ line isText ifTrue:[ isText := true ]
+ ].
+ ] ifFalse:[
+ lineSize := 0
+ ].
+
+ ((colNr == 1) and:[lineSize == 0]) ifTrue: [
+ newLine := aString
+ ] ifFalse:[
+ (lineSize == 0 or:[colNr > lineSize]) ifTrue: [
+ sz := colNr + strLen - 1
+ ] ifFalse:[
+ sz := lineSize + strLen
+ ].
+
+ newLine := stringType new:sz.
+ isText ifTrue:[
+ newLine := Text string:newLine
+ ].
+
+ (lineSize ~~ 0) ifTrue: [
+ (colNr > lineSize) ifTrue: [
+ newLine replaceFrom:1 to:lineSize with:line startingAt:1
+ ] ifFalse: [
+ newLine replaceFrom:1 to:(colNr - 1) with:line startingAt:1.
+ newLine replaceFrom:(colNr + strLen) to:(lineSize + strLen) with:line startingAt:colNr
+ ]
+ ].
+ newLine replaceFrom:(colNr max:1) to:(colNr + strLen - 1) with:aString startingAt:1
+ ].
+
+ (aString includes:(Character tab)) ifTrue:[
+ newLine := self withTabs:(ListView tab8Positions) expand:newLine
+ ].
+
+ self basicListAt:lineNr put:(newLine ifNil:[newLine] ifNotNil:[newLine asSingleByteStringIfPossible]).
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:newLine).
+ ].
+ self textChanged.
+
+ "Modified: / 25-01-2012 / 00:37:29 / cg"
+! !
+
+!EditTextView methodsFor:'event handling'!
+
+buttonPress:button x:x y:y
+ "hide the cursor when button is activated"
+
+ hasKeyboardFocus := true.
+ dragIsActive := false.
+
+ completionSupport notNil ifTrue:[
+ "/ also give that guy a chance to close its popup view
+ completionSupport buttonPress:button x:x y:y
+ ].
+
+ cursorShown ifTrue: [
+ self drawCursor
+ ].
+
+ "On X11, be nice and paste PRIMARY when middle click.
+ Note, that middle button on X11 is translated to button
+ 128 in Smalltalk/X - see XWorkstation class>>initializeConstants"
+ (button == #paste and:[self graphicsDevice platformName == #X11]) ifTrue:[
+ self undoableDo:[
+ self paste: (self getClipboardText:#selection).
+ ].
+ ^self.
+ ].
+
+ (button == 1) ifTrue:[
+ self hideCursor
+ ].
+"/ some very old code from times, when a right-click was a paste in X11
+"/
+"/ (button == #paste) ifTrue:[
+"/ self pasteOrReplace.
+"/ ^ self
+"/ ].
+ super buttonPress:button x:x y:y
+
+ "Modified: / 23-03-1999 / 13:51:40 / cg"
+ "Modified (comment): / 17-04-2012 / 21:02:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+buttonRelease:button x:x y:y
+ "move the cursor to the click-position of previous button press"
+
+ |x1 x2 x2_3 newCursorCol|
+
+ (button == 1) ifTrue:[
+ typeOfSelection := nil.
+
+ dragIsActive ifTrue:[
+ self unselect
+ ].
+ selectionStartLine isNil ifTrue:[
+ clickCol notNil ifTrue:[
+ self cursorMovementAllowed ifTrue:[
+ newCursorCol := clickCol.
+
+ cursorType ~~ #block ifTrue:[
+ clickPos notNil ifTrue:[
+ "/ we do something special, if the text-cursor's type is not a block-cursor
+ "/ (i.e. if its an ibeam).
+ "/ adjust clickCol if the user clicked in the right third of a character.
+ x1 := self xOfCol:clickCol inVisibleLine:clickLine.
+ x2 := self xOfCol:clickCol+1 inVisibleLine:clickLine.
+ x2_3 := x1 + ((x2-x1) * (2/3)).
+ (clickPos x >= x2_3) ifTrue:[ newCursorCol := clickCol+1 ].
+ ].
+ ].
+ self cursorLine:clickLine col:newCursorCol.
+ ].
+ true "self hadSelectionBeforeClick not" ifTrue:[
+ list notEmptyOrNil ifTrue:[
+ UserPreferences current selectAllWhenClickingBeyondEnd ifTrue:[
+ (clickLine >= list size) ifTrue:[
+ (clickLine > (self list size + 2)
+ or:[ clickCol > (list last size + 5) ]) ifTrue:[
+ self selectAll
+ ].
+ ].
+ ]
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ lastStringFromReplaceForNextSearch := nil. "new selection invalidates remembered string"
+ ].
+ self showCursor
+ ].
+ super buttonRelease:button x:x y:y
+
+ "Modified: / 07-03-2012 / 18:48:37 / cg"
+!
+
+cursorKeyPress:key shifted:shifted
+ <resource: #keyboard (#CursorRight #CursorDown #CursorUp #CursorDown)>
+
+ |n|
+
+ self changeTypeOfSelectionTo:nil.
+
+ (key == #CursorRight) ifTrue:[
+ (shifted and:[selectionStartLine isNil]) ifTrue:[
+ selectionStartLine := selectionEndLine := clickStartLine := cursorLine.
+ selectionStartCol := selectionEndCol := clickStartCol := cursorCol.
+ expandingTop := false.
+ self validateNewSelection.
+ self setPrimarySelection.
+ self selectionChanged.
+ self redrawLine:selectionStartLine.
+ ^ self.
+ ].
+
+ selectionStartLine notNil ifTrue:[
+ self cursorMovementAllowed ifTrue:[
+ "/
+ "/ treat the whole selection as cursor
+ "/
+ self setCursorLine:(selectionEndLine ? selectionStartLine).
+ selectionEndCol == 0 ifTrue:[
+ selectionEndCol := 1.
+ ].
+ self setCursorCol:selectionEndCol.
+ shifted ifTrue:[
+ self expandSelectionRight.
+ ^ self
+ ].
+ self unselect; makeCursorVisible.
+ cursorCol == 1 ifTrue:[^ self].
+ ].
+ ].
+ self cursorRight.
+ ^ self
+ ].
+ (key == #CursorDown) ifTrue:[
+ (shifted and:[selectionStartLine isNil]) ifTrue:[
+ selectionStartLine := clickStartLine := cursorLine. selectionEndLine := cursorLine + 1.
+ selectionStartCol := clickStartCol := selectionEndCol := cursorCol.
+ selectionEndCol == 1 ifTrue:[
+ selectionEndCol := 0.
+ ].
+ self validateNewSelection.
+ self selectionChanged.
+ self redrawLine:selectionStartLine.
+ expandingTop := false.
+ self redrawLine:selectionEndLine.
+ ^ self
+ ].
+
+ selectionStartLine notNil ifTrue:[
+ self cursorMovementAllowed ifTrue:[
+ "/
+ "/ treat the whole selection as cursor
+ "/
+ self setCursorLine:(selectionEndLine ? selectionStartLine).
+ self setCursorCol:selectionStartCol.
+ (cursorCol == 0 or:[selectionEndCol == 0]) ifTrue:[
+ self setCursorCol:1.
+ self setCursorLine:(cursorLine - 1).
+ ].
+ self makeCursorVisible.
+
+ shifted ifTrue:[
+ clickLine := cursorLine.
+ clickCol := cursorCol.
+ self expandSelectionDown.
+ ^ self
+ ].
+ self unselect.
+ ].
+ ].
+
+ n := 1 + (self sensor compressKeyPressEventsWithKey:#CursorDown).
+ self cursorDown:n.
+ "/
+ "/ flush keyboard to avoid runaway cursor
+ "/
+ self sensor flushKeyboardFor:self.
+ ^ self
+ ].
+ (key == #CursorLeft or:[key == #CursorUp]) ifTrue:[
+ (shifted and:[selectionStartLine isNil]) ifTrue:[
+ expandingTop := true.
+ key == #CursorLeft ifTrue:[
+ cursorCol > 1 ifTrue:[
+ selectionStartLine := selectionEndLine := clickStartLine := cursorLine.
+ selectionEndCol := clickStartCol := cursorCol-1.
+ selectionStartCol := cursorCol-1.
+ self validateNewSelection.
+ self selectionChanged.
+ self redrawLine:selectionStartLine.
+ ^ self
+ ]
+ ] ifFalse:[
+ cursorLine > 1 ifTrue:[
+ selectionEndLine := clickStartLine := cursorLine.
+ selectionEndCol := selectionStartCol := clickStartCol := cursorCol.
+ selectionStartLine := cursorLine - 1.
+ selectionEndCol == 1 ifTrue:[
+ selectionEndCol := 0.
+ ].
+ self validateNewSelection.
+ self selectionChanged.
+ self redrawFromLine:selectionStartLine to:cursorLine.
+ ^ self
+ ]
+ ]
+ ].
+
+ selectionStartLine notNil ifTrue:[
+ self cursorMovementAllowed ifTrue:[
+ "/
+ "/ treat the whole selection as cursor
+ "/
+ self setCursorLine:selectionStartLine.
+ self setCursorCol:selectionStartCol.
+ (key == #CursorLeft) ifTrue:[
+ self setCursorCol:(cursorCol+1). "/ compensate for followup crsr-left
+ ].
+ self makeCursorVisible.
+
+ shifted ifTrue:[
+ (key == #CursorUp) ifTrue:[
+ clickLine := cursorLine.
+ self expandSelectionUp.
+ ] ifFalse:[
+ self expandSelectionLeft.
+ ].
+ ^ self
+ ].
+ self unselect.
+ ].
+ ].
+ (key == #CursorLeft) ifTrue:[
+ self cursorLeft. ^self
+ ].
+ (key == #CursorUp) ifTrue:[
+ n := 1 + (self sensor compressKeyPressEventsWithKey:#CursorUp).
+ self cursorUp:n.
+ "/
+ "/ flush keyboard to avoid runaway cursor
+ "/
+ self sensor flushKeyboardFor:self.
+ ^ self
+ ].
+ ].
+
+ "Modified: / 17-04-2012 / 21:01:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doKeyPress:key x:x y:y
+ "handle keyboard input"
+
+ <resource: #keyboard (#Paste #Insert #PasteFromHistory #Cut #Again #AgainForAll
+ #Replace #Undo #Redo #Accept
+ #Delete #BasicDelete #BackSpace #BasicBackspace
+ #DeleteSpaces #Join
+ #SearchMatchingParent #SelectMatchingParents
+ #SelectWord #ExpandSelectionByWord
+ #SelectToEnd #SelectFromBeginning
+ #SelectLine #ExpandSelectionByLine
+ #BeginOfLine #EndOfLine #NextWord #PreviousWord
+ #CursorRight #CursorDown #CursorLeft #CursorUp
+ #Return #Tab #BackTab #NonInsertingTab #Escape
+ #GotoLine #BeginOfText #EndOfText
+ #InsertLine #DeleteLine
+ #SelectLineFromBeginning
+ #LearnKeyboardMacro #ExecuteKeyboardMacro #ToggleInsertMode
+ #OpenSpecialCharacterWindow
+ #'F*' #'f*')>
+
+ |fKeyMacros shiftPressed ctrlPressed i event macroName
+ immediateCompletion currentUserPrefs|
+
+ currentUserPrefs := UserPreferences current.
+
+ "/ experimental
+ immediateCompletion := currentUserPrefs immediateCodeCompletion.
+ (immediateCompletion
+ or:[currentUserPrefs codeCompletionOnControlKey
+ or:[currentUserPrefs codeCompletionOnTabKey]]) ifTrue:[
+ completionSupport isNil ifTrue:[
+ self initializeCompletionSupport.
+ ].
+ ].
+ "/ JV: why setting it to nil here?
+"/ ifFalse:[
+"/ completionService := nil
+"/ ].
+ completionSupport notNil ifTrue:[
+ (completionSupport handleKeyPress:key x:x y:y) ifTrue:["eaten" ^ self].
+ ].
+
+ key isSymbol ifTrue:[
+ (self graphicsDevice modifierKeys includes:key) ifFalse:[
+ lastReplacementInfo stillCollectingInput:false.
+ ]
+ ].
+ (key == #LearnKeyboardMacro) ifTrue:[
+ lastReplacementInfo stillCollectingInput:false.
+ self toggleLearnMode.
+ ^ self
+ ].
+ (key == #ExecuteKeyboardMacro) ifTrue:[
+ lastReplacementInfo stillCollectingInput:false.
+ self executeLearnedKeyboardMacro.
+ ^ self.
+ ].
+ (key == #Undo) ifTrue:[self undo. ^self].
+ (key == #Redo) ifTrue:[self redo. ^self].
+
+ self learnMode ifTrue:[
+ event := WindowGroup lastEventQuerySignal query.
+ learnedMacro add:event.
+ ].
+
+ (self executekeyboardMacroNamed:key) ifTrue:[
+ "the macro named key exists"
+ ^ self
+ ].
+
+ key isSymbol ifFalse:[
+ "the usual case: key is a character, but maybe a string also (in X11)"
+ self handleNonCommandKey:key.
+ ^ self
+ ].
+
+ event isNil ifTrue:[
+ event := WindowGroup lastEventQuerySignal query.
+ ].
+ shiftPressed := event hasShift.
+ ctrlPressed := event hasCtrl and:[(event rawKey asString startsWith:'Ctrl') not].
+
+ (key == #DeleteWordBeforeCursor) ifTrue:[
+ self deleteWordBeforeCursor.
+ ^ self.
+ ].
+
+ (key == #BackSpace or:[key == #BasicBackspace]) ifTrue:[
+ selectionStartLine notNil ifTrue:[
+ ((key == #BasicBackspace)
+ or:[ currentUserPrefs deleteSetsClipboardText not ])
+ ifTrue:[
+ self deleteSelection.
+ ] ifFalse: [
+ self copyAndDeleteSelection.
+ ].
+ ] ifFalse:[
+ self makeCursorVisible.
+"/ (shiftPressed and:[ ctrlPressed ]) ifTrue:[
+"/ self deleteWordBeforeCursor.
+"/ ] ifFalse:[
+ self deleteCharBeforeCursor.
+"/ ].
+ ].
+ true "immediateCompletion" ifTrue:[
+ completionSupport notNil ifTrue:[ completionSupport postKeyPress:key].
+ ].
+ ^ self
+ ].
+
+ (key == #ToggleAutoIndent) ifTrue:[
+ self autoIndent:(autoIndent not).
+ ^ self.
+ ].
+
+ key == #ToggleInsertMode ifTrue:[
+ self insertMode:(editMode value == EditMode insertMode) not.
+ ^ self.
+ ].
+
+ key == #OpenSpecialCharacterWindow ifTrue:[
+ CharacterSetView notNil ifTrue:[
+ self specialCharacters.
+ ^ self.
+ ]
+ ].
+
+ replacing := false.
+
+ "
+ Fn pastes a key-sequence (but only if not overlayed with
+ another function in the keyboard map)
+
+ see TextView>>:x:y
+ "
+ (key at:1) asLowercase == $f ifTrue:[
+ (('[fF][0-9]' match:key)
+ or:['[fF][0-9][0-9]' match:key]) ifTrue:[
+ shiftPressed ifFalse:[
+ fKeyMacros := currentUserPrefs functionKeySequences.
+ fKeyMacros notNil ifTrue:[
+ (fKeyMacros includesKey:key) ifTrue:[
+ self pasteOrReplace:(fKeyMacros at:key) asStringCollection.
+ ^ self
+ ]
+ ]
+ ]
+ ].
+ ].
+
+ (key == #'Ctrl8' or:[key == #'Ctrl9']) ifTrue:[
+ self parenthizeSelectionWith:$( and:$).
+ ^ self.
+ ].
+ (key == #'Ctrl2') ifTrue:[
+ self parenthizeSelectionWith:$" and:$".
+ ^ self.
+ ].
+ (key == #'Ctrl#') ifTrue:[
+ self parenthizeSelectionWith:$' and:$'.
+ ^ self.
+ ].
+ (key == #'ConvertSelectionToLowercaseOrUppercaseOrUppercaseFirst') ifTrue:[
+ self convertSelectionToLowercaseOrUppercaseOrUppercaseFirst.
+ ^ self.
+ ].
+
+ (key == #Accept) ifTrue:[^ self accept].
+
+ ((key == #Paste) or:[key == #Insert or:[key == #PasteFromHistory]]) ifTrue:[self pasteOrReplace. ^self].
+ (key == #Cut) ifTrue:[self cut. ^self].
+ (key == #Again) ifTrue:[self again. ^self].
+ (key == #AgainForAll) ifTrue:[self multipleAgain. ^self].
+
+ (key == #Join) ifTrue:[self joinLines. ^self].
+ (key == #Replace) ifTrue:[self replace. ^self].
+ (key == #ExpandSelectionByWord) ifTrue:[
+ self makeCursorVisible.
+ self findNextWordAfterSelectionAndAddToSelection.
+ ^ self
+ ].
+ (key == #SelectWord) ifTrue:[
+ self makeCursorVisible.
+ self selectWordUnderCursor.
+ ^ self
+ ].
+
+ (key == #SearchMatchingParent) ifTrue:[self searchForMatchingParenthesis. ^ self].
+ (key == #SelectMatchingParents) ifTrue:[self searchForAndSelectMatchingParenthesis. ^ self].
+ (key == #SelectToEnd) ifTrue:[self selectUpToEnd. ^ self].
+ (key == #SelectFromBeginning) ifTrue:[self selectFromBeginning. ^ self].
+
+" disabled - nobody liked it ...
+ and if you like it, its better done in the keymap.
+
+ (key == #Ctrlb) ifTrue:[self unselect. self cursorLeft. ^ self].
+ (key == #Ctrlf) ifTrue:[self unselect. self cursorRight. ^ self].
+ (key == #Ctrln) ifTrue:[self unselect. self cursorDown. ^ self].
+ (key == #Ctrlp) ifTrue:[self unselect. self cursorUp. ^ self].
+"
+
+ (key == #BeginOfLine) ifTrue:[
+ shiftPressed ifTrue: [
+ "/ "Original St/X code - now use Ctrl modifier"
+ "/ self unselect.
+ "/ self cursorHome.
+ "Jan's modification"
+ "/ self addToSelectionAfter:[ self cursorToBeginOfLine ].
+ "/ Jan's modification modified by his own request ;-))
+ self selectFromBeginOfLine.
+ ] ifFalse: [
+ self unselect.
+ ctrlPressed ifTrue:[
+ self cursorHome.
+ ] ifFalse:[
+ self cursorToBeginOfLine.
+ ]
+ ].
+ ^ self
+ ].
+ (key == #EndOfLine) ifTrue:[
+ shiftPressed ifTrue:[
+ "/ "Original St/X code - now use Ctrl modifier"
+ "/ self unselect.
+ "/ self cursorToBottom
+ " Jan's modification"
+ "/ self addToSelectionAfter:[ self cursorToEndOfLine ] .
+ "/ Jan's modification modified by his own request ;-))
+ self selectToEndOfLine.
+ ] ifFalse:[
+ self unselect.
+ ctrlPressed ifTrue:[
+ self cursorToBottom
+ ] ifFalse:[
+ self cursorToEndOfLine.
+ ]
+ ].
+ ^ self
+ ].
+ (key == #NextWord) ifTrue:[self cursorToNextWord. ^self].
+ (key == #EndOfWord) ifTrue:[self cursorToEndOfWord. ^self].
+ (key == #PreviousWord) ifTrue:[self cursorToPreviousWord. ^self].
+ (key == #GotoLine) ifTrue:[self gotoLine. ^self].
+
+ (key == #CursorRight
+ or:[key == #CursorDown
+ or:[key == #CursorLeft
+ or:[key == #CursorUp]]]) ifTrue:[
+ self cursorKeyPress:key shifted:shiftPressed.
+ ^ self.
+ ].
+
+ (key == #NonInsertingReturn) ifTrue:[
+ self unselect. self cursorReturn.
+ ^ self
+ ].
+
+ (key == #Return) ifTrue:[
+ shiftPressed ifTrue:[
+ self unselect. self cursorReturn.
+ ^ self
+ ].
+
+ self isReadOnly ifTrue:[
+ self unselect; makeCursorVisible.
+ self cursorReturn
+ ] ifFalse:[
+ self isInInsertMode ifFalse:[
+ self cursorReturn.
+ autoIndent == true ifTrue:[
+ i := self leftIndentForLine:(cursorLine + 1).
+ (self listAt:cursorLine) isEmptyOrNil ifTrue:[
+ self cursorCol:(i+1 max:1)
+ ]
+ ]
+ ] ifTrue:[
+ |left right oldIndent|
+
+ "/ old version just unselected ...
+ "/ self unselect; makeCursorVisible.
+
+ "/ new version deletes ...
+ typeOfSelection == #paste ifTrue:[
+ self unselect; makeCursorVisible.
+ ] ifFalse:[
+ self copyAndDeleteSelection.
+ ].
+ left := (self listAt:cursorLine to:cursorCol-1) ? ''.
+ right := (self listAt:cursorLine from:cursorCol) ? ''.
+ self insertCharAtCursor:(Character cr).
+ autoIndent == true ifTrue:[
+ (right isEmpty and:[cursorCol ~~ 1]) ifTrue:[
+ "/ nothing to do.
+ ] ifFalse:[
+ ((self listAt:cursorLine) isEmptyOrNil
+ or:[ cursorCol == 1 ]) ifTrue:[
+ i := (self leftIndentForLine:cursorLine).
+ left := left withoutSeparators.
+ right := right withoutSeparators.
+ (left endsWith:'[') ifTrue:[
+"/ i := i + 4.
+ ] ifFalse:[
+ (false "(left endsWith:']')" or:[(right startsWith:']')]) ifTrue:[
+ i := i - 4.
+ ].
+ ].
+ oldIndent := self leftIndentOfLine:cursorLine.
+ self indentFromLine:cursorLine toLine:cursorLine by:(i-oldIndent).
+ self st80EditMode ifTrue:[
+ (self listAt:cursorLine) size < i ifTrue:[
+ self insertStringAtCursor:(String new:((i-oldIndent) max:0)).
+ ].
+ ].
+ self cursorCol:(i+1 max:1)
+ ].
+ ]
+ ].
+ ].
+ ].
+ ^ self
+ ].
+
+ (key == #NonInsertingTab) ifTrue:[
+ self unselect. self cursorTab.
+ ^ self
+ ].
+ ((key == #BackTab) or:[(key == #Tab)]) ifTrue:[
+ self tabMeansNextField ifTrue:[^ super keyPress:key x:x y:y].
+
+ self hasSelection ifTrue:[
+ selectStyle == #line ifTrue:[
+ ((key == #Tab) and:[shiftPressed not]) ifTrue:[
+ macroName := #IndentBy4.
+ ] ifFalse:[
+ macroName := #UndentBy4.
+ ].
+ macroName notNil ifTrue:[
+ self executekeyboardMacroNamed:macroName.
+ ].
+ ]
+ ].
+
+ self unselect.
+ (key == #Tab) ifTrue:[
+ (shiftPressed or:[self isInInsertMode not]) ifTrue:[
+ self cursorTab.
+ ^ self
+ ].
+ self insertTabAtCursor.
+ ^ self
+ ].
+ self cursorBacktab.
+ ^ self
+ ].
+
+ "/ key == #DeleteSpaces ifTrue:[
+ (key == #Delete) ifTrue:[
+ shiftPressed ifTrue:[
+ [(cursorCol <= (self listAt:cursorLine) size)
+ and:[self characterUnderCursor isSeparator]] whileTrue:[
+ self makeCursorVisible.
+ self deleteCharAtCursor.
+ ].
+ ^ self
+ ]
+ ].
+
+ (key == #Delete
+ or:[key == #BasicDelete]) ifTrue:[
+ selectionStartLine notNil ifTrue:[
+"/ Again function is not supporting Delete action (on purpose, to avoid replacing the next search string)
+"/ To remove text repetetively, use Cut instead.
+"/ self setLastStringToReplace: self selection asStringWithoutFinalCR.
+"/ lastReplacementInfo lastReplacement: nil.
+ ((key == #BasicDelete)
+ or:[currentUserPrefs deleteSetsClipboardText not]) ifTrue:[
+ self deleteSelection.
+ ] ifFalse:[
+ self copyAndDeleteSelection.
+ ].
+ ^ self
+ ].
+ self makeCursorVisible.
+ self deleteCharAtCursor.
+ ^ self
+ ].
+
+ (key == #BeginOfText) ifTrue:[ "i.e. HOME"
+ self unselect.
+ cursorVisibleLine == 1 ifTrue:[
+ self cursorHome.
+ ] ifFalse:[
+ self cursorToFirstVisibleLine
+ ].
+ ^ self
+ ].
+ (key == #EndOfText) ifTrue:[ "i.e. END"
+ self unselect.
+ cursorVisibleLine == nFullLinesShown ifTrue:[
+ self cursorToBottom.
+ ] ifFalse:[
+ self cursorToLastVisibleLine
+ ].
+ ^ self
+ ].
+ ((key == #Escape)
+ or:[key == #SelectLineFromBeginning]) ifTrue:[
+ self makeCursorVisible.
+ self unselect. self selectCursorLineFromBeginning.
+ ^ self
+ ].
+ (key == #SelectLine) ifTrue:[
+ self makeCursorVisible.
+ self unselect. self selectCursorLine.
+ ^ self
+ ].
+ (key == #ExpandSelectionByLine) ifTrue:[
+ "/ self makeCursorVisible.
+ self selectExpandCursorLine.
+ ^ self
+ ].
+ (key == #DeleteLine) ifTrue:[
+ self makeCursorVisible.
+ self unselect. self deleteCursorLine.
+ ^ self
+ ].
+ (key == #InsertLine) ifTrue:[
+ self makeCursorVisible.
+ self unselect. self insertLine:nil before:cursorLine.
+ ^ self
+ ].
+
+ super keyPress:key x:x y:y
+
+ "Modified: / 06-02-1998 / 11:59:59 / stefan"
+ "Modified: / 14-07-2011 / 12:08:28 / cg"
+ "Modified: / 26-09-2013 / 17:52:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+executeKeyboardMacro:cmdMacro
+ Error handle:[:ex |
+ self warn:'Error in keyboard macro: ' , ex description.
+ ex return.
+ ] do:[
+ AbortOperationRequest handle:[:ex |
+ self warn:'Keyboard macro aborted'.
+ ex return.
+ ] do:[
+ Parser
+ evaluate:cmdMacro asString
+ receiver:self
+ notifying:nil
+ compile:false.
+ ].
+ ].
+!
+
+handleNonCommandKey:keyArg
+ |selStartLineBefore selStartColBefore selEndLineBefore selEndColBefore key|
+
+ self isReadOnly ifTrue:[
+ self flashReadOnly.
+ ^ self.
+ ].
+
+ key := keyArg.
+
+ typeOfSelection == #paste ifTrue:[
+ "pasted selection will NOT be replaced by keystroke"
+ self unselect
+ ].
+
+ selStartLineBefore := selectionStartLine.
+ selStartColBefore := self selectionStartCol.
+ selEndLineBefore := selectionEndLine.
+ selEndColBefore := self selectionEndCol.
+
+ (gc characterEncoding ? #'iso10646-1') ~~ #'iso10646-1' ifTrue:[
+ key isCharacter ifTrue:[
+ key := CharacterEncoder encode:key from:#'iso10646-1' into:gc characterEncoding.
+ ] ifFalse:[
+ key := CharacterEncoder encodeString:key from:#'iso10646-1' into:gc characterEncoding.
+ ].
+ ].
+
+ "replace selection by what is typed in -
+ if word was selected with a space, keep it.
+ if there was no selection, the key's character is inserted"
+
+ editMode value isInsertAndSelectMode ifTrue:[
+ selectionStartLine := selectionStartCol := selectionEndLine := selectionEndCol := nil.
+ ].
+
+ (selectStyle == #wordLeft) ifTrue:[
+ self replaceSelectionBy:(' ' , key asString)
+ ] ifFalse:[
+ (selectStyle == #wordRight) ifTrue:[
+ self replaceSelectionBy:(key asString , ' ').
+ self cursorLeft
+ ] ifFalse:[
+ self replaceSelectionBy:key
+ ]
+ ].
+ selectStyle := nil.
+
+ editMode value isInsertAndSelectMode ifTrue:[
+ selectionStartLine := selStartLineBefore.
+ selectionStartCol := selStartColBefore.
+ selectionEndLine := selEndLineBefore.
+ selectionEndCol := selEndColBefore.
+ ].
+
+ showMatchingParenthesis ifTrue:[
+ "emacs style parenthesis shower"
+ (ExecutingMacroQuery query ? false) ifFalse:[
+ "claus: only do it for closing parenthesis -
+ otherwise its too anoying.
+ "
+"
+ ('()[]{}' includes:key) ifTrue:[
+"
+ (')]}' includes:key) ifTrue:[
+ self
+ searchForMatchingParenthesisFromLine:cursorLine col:(cursorCol - 1)
+ ifFound:[:line :col |
+ |savLine savCol sensor|
+
+ self withCursor:Cursor eye do:[
+ savLine := cursorLine.
+ savCol := cursorCol.
+ self cursorLine:line col:col.
+ self flush.
+
+ "/ want to wait 200ms, but not if another keyPress
+ "/ arrives in the meantime ...
+
+ sensor := self sensor.
+ 5 timesRepeat:[
+ (sensor hasKeyPressEventFor:self) ifFalse:[
+ Processor activeProcess millisecondDelay:40.
+ ]
+ ].
+ self cursorLine:savLine col:savCol
+ ]
+ ]
+ ifNotFound:[self showNotFound]
+ onError:[self beep]
+ ].
+ ]
+ ].
+
+"/ true "autoExpandWhileTyping" ifTrue:[
+"/ self wordAtLine:cursorLine col:cursorCol-1 do:[
+"/ :beginLine :beginCol :endLine :endCol :style |
+"/
+"/ self selectFromLine:beginLine col:beginCol toLine:endLine col:endCol.
+"/ self selection.
+"/ typeOfSelection := #paste.
+"/ ].
+"/ ].
+ editMode value isInsertAndSelectMode ifTrue:[
+ selectionStartLine isNil ifTrue:[
+ self selectFromLine:cursorLine col:cursorCol-1 toLine:cursorLine col:cursorCol-1.
+ ] ifFalse:[
+ self selectFromLine:selectionStartLine col:selectionStartCol toLine:cursorLine col:cursorCol-1.
+ ].
+ ].
+ completionSupport notNil ifTrue:[ completionSupport postKeyPress:keyArg ].
+
+ "Modified (comment): / 25-01-2012 / 00:30:11 / cg"
+!
+
+keyPress:key x:x y:y
+ "handle keyboard input"
+
+ |wasOn|
+
+ wasOn := cursorShown.
+
+ NoModificationError handle:[:ex |
+ self flashReadOnly.
+ (cursorShown not and:[wasOn]) ifTrue:[
+ self makeCursorVisibleAndShowCursor:wasOn.
+ ].
+ ] do:[
+ self undoableDo:[
+ self doKeyPress:key x:x y:y
+ ].
+ ].
+ self repairDamage
+
+ "Modified: / 18-04-2011 / 21:35:27 / cg"
+!
+
+mapped
+ "view was made visible"
+
+ super mapped.
+ self updateCursorVisibleLine.
+!
+
+requestAutoAccept
+ "this is invoked when a dialog closes via accept or cancel.
+ This forces my value to be accepted into my model"
+
+ acceptEnabled == false ifTrue:[
+ "/ nope -
+ ^ false
+ ].
+ self accept.
+ ^ true.
+!
+
+sizeChanged:how
+ "make certain, cursor is visible after the sizechange"
+
+ |cv|
+
+ cv := cursorVisibleLine.
+ super sizeChanged:how.
+ cv notNil ifTrue:[
+ self makeLineVisible:cursorLine
+ ]
+!
+
+unmapped
+ super unmapped.
+
+ completionSupport notNil ifTrue:[
+ completionSupport release.
+ ].
+! !
+
+!EditTextView methodsFor:'focus handling'!
+
+focusOut
+ super focusOut.
+
+ completionSupport notNil ifTrue:[
+ completionSupport release.
+ ].
+!
+
+hasKeyboardFocus:aBoolean
+ "sent by the windowGroup, a delegate or myself to make me show a block cursor
+ (otherwise, I would not know about this)"
+
+ hasKeyboardFocus := aBoolean.
+
+ (cursorShown
+ and:[self enabled
+ and:[self isReadOnly not]]) ifTrue:[
+ self drawCursor
+ ].
+
+ hasKeyboardFocus ifFalse:[
+ completionSupport notNil ifTrue:[
+ "/ this is a hack for Windows:
+ "/ on windows, an activate:false event is first sent to my textView,
+ "/ then an activate is sent to the completion popup.
+ "/ this is done BEFORE the buttonPress event is delivered.
+ "/ therefore, allow for the activate of the completionMenu and it's button event to be processed.
+ "/ before forcing it to be closed...
+ Processor addTimedBlock:[completionSupport "release" editViewLostFocus] afterMilliseconds:200.
+ ].
+ ].
+
+ "Modified (format): / 06-11-2013 / 15:37:31 / cg"
+!
+
+showFocus:explicit
+ "in addition to however my superclass thinks how a focusView is to be
+ displayed, show the cursor when I got the focus"
+
+ self showCursor.
+ self hasKeyboardFocus:true.
+ super showFocus:explicit
+
+ "Modified: 11.12.1996 / 16:56:54 / cg"
+!
+
+showNoFocus:explicit
+ "the view lost the keyboard focus
+ (either explicit, via tabbing; or implicit, by pointer movement)
+ - change any display attributes as req'd."
+
+ super showNoFocus:explicit.
+ completionSupport notNil ifTrue:[
+ completionSupport release.
+ ].
+!
+
+wantsFocusWithPointerEnter
+ "return true, if I want the focus when
+ the mouse pointer enters"
+
+ (UserPreferences current focusFollowsMouse ~~ false
+ and:[(styleSheet at:#'editText.requestFocusOnPointerEnter' default:true)
+ and:[self enabled
+ and:[true "self isReadOnly not"]]]
+ ) ifTrue:[
+ ^ true
+ ].
+
+ ^ false
+! !
+
+!EditTextView methodsFor:'formatting'!
+
+executekeyboardMacroNamed:macroName
+ "try to execute the keyboard macro;
+ return true if that worked, false otherwise"
+
+ |cmdMacro|
+
+ cmdMacro := UserPreferences current functionKeySequences at:macroName ifAbsent:[^ false].
+ self
+ undoableDo:[ self executeKeyboardMacro:cmdMacro ]
+ info: macroName.
+ ^ true
+
+ "
+ EditTextView open
+ contents:'bla';
+ selectAll;
+ executekeyboardMacroNamed:#IndentBy4.
+ EditTextView open
+ contents:'bla';
+ selectAll;
+ executekeyboardMacroNamed:#blabla.
+ "
+
+ "Modified: / 14-02-2012 / 11:17:27 / cg"
+!
+
+indent
+ "indent a line-range - this is done by searching for the
+ last non-empty line before the selection, and changing the indent
+ of the selected line-range based on that line's indent."
+
+ |start end|
+
+ selectionStartLine isNil ifTrue:[^ self].
+
+ start := selectionStartLine.
+ end := selectionEndLine.
+ (selectionEndCol == 0) ifTrue:[
+ end := end - 1
+ ].
+ self unselect.
+ self
+ undoableDo:[self indentFromLine:start toLine:end]
+ info:'Indent'
+!
+
+indentBy4
+ self executekeyboardMacroNamed:#IndentBy4.
+
+ "Modified: / 06-04-2011 / 18:52:40 / cg"
+!
+
+indentFromLine:start toLine:end
+ "indent a line-range - this is done by searching for the
+ last non-empty line before start, and change the indent
+ of the selected line-range based on that line's indent."
+
+ |leftStart delta|
+
+ leftStart := self leftIndentForLine:start.
+ (leftStart == 0) ifTrue:[^ self].
+
+ delta := leftStart - (self leftIndentOfLine:start).
+ (delta == 0) ifTrue:[^ self].
+ self indentFromLine:start toLine:end by:delta
+!
+
+indentFromLine:start toLine:end by:delta
+ "indent a line-range - this is done by searching for the
+ last non-empty line before start, and change the indent
+ of the selected line-range based on that line's indent."
+
+ |d line spaces anyChange|
+
+ (delta == 0) ifTrue:[^ self].
+ (delta > 0) ifTrue:[
+ spaces := String new:delta
+ ].
+
+ anyChange := false.
+ start to:end do:[:lineNr |
+ line := self listAt:lineNr.
+ line notNil ifTrue:[
+ line isBlank ifTrue:[
+ self basicListAt:lineNr put:nil
+ ] ifFalse:[
+ (delta > 0) ifTrue:[
+ line := spaces , line.
+ widthOfWidestLine notNil ifTrue:[
+ widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
+ ]
+ ] ifFalse:[
+ "check if deletion is ok"
+ d := delta negated + 1.
+
+ line size > d ifTrue:[
+ (line copyTo:(d - 1)) withoutSeparators isEmpty ifTrue:[
+ line := line copyFrom:d
+ ]
+ ].
+ widthOfWidestLine := nil
+ ].
+ self replaceLine:lineNr with:line.
+ anyChange := true.
+ ]
+ ]
+ ].
+
+ anyChange ifTrue:[ self textChanged ].
+
+ "/ self redrawFromLine:start to:end
+
+ "Modified: 5.3.1996 / 14:59:18 / cg"
+!
+
+leftIndentForLine:lineNr
+ "find an appropriate indent for a line.
+ this is done by searching for the last non-empty line before it
+ and returning its indent.
+ cg: changed: only look for the single previous line."
+
+ "SHOULD GO TO ListView"
+
+ |line lnr indent|
+
+ lnr := lineNr.
+
+ "/ [lnr ~~ 1] whileTrue:[
+ (lnr ~~ 1) ifTrue:[
+ lnr := lnr - 1.
+ line := self listAt:lnr.
+
+ line notNil ifTrue:[
+ indent := line indexOfNonSeparatorStartingAt:1.
+ indent ~~ 0 ifTrue:[
+ (line endsWith:$[) ifTrue:[
+ ^ indent + 4 - 1
+ ].
+ ^ indent - 1
+ ]
+ ]
+ ].
+ ^ 0
+
+ "Created: 5.3.1996 / 14:58:53 / cg"
+!
+
+undentBy4
+ self executekeyboardMacroNamed:#UndentBy4.
+
+ "Modified: / 06-04-2011 / 18:52:49 / cg"
+! !
+
+!EditTextView methodsFor:'initialization'!
+
+fetchDeviceResources
+ "fetch device colors, to avoid reallocation at redraw time"
+
+ super fetchDeviceResources.
+
+ cursorFgColor notNil ifTrue:[cursorFgColor := cursorFgColor onDevice:self graphicsDevice].
+ cursorBgColor notNil ifTrue:[cursorBgColor := cursorBgColor onDevice:self graphicsDevice].
+ cursorNoFocusFgColor notNil ifTrue:[cursorNoFocusFgColor := cursorNoFocusFgColor onDevice:self graphicsDevice].
+
+ "Created: 14.1.1997 / 00:15:24 / cg"
+ "Modified: 18.2.1997 / 15:02:46 / cg"
+!
+
+initEvents
+ "enable enter/leave events in addition"
+
+ super initEvents.
+ self enableEnterLeaveEvents
+!
+
+initStyle
+ "initialize style specific stuff"
+
+ super initStyle.
+ "/ lineSpacing := 2. "/ for underwave - also looks better
+ lockUpdates := false.
+
+ cursorFgColor := DefaultCursorForegroundColor.
+ cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
+ cursorBgColor := DefaultCursorBackgroundColor.
+ cursorBgColor isNil ifTrue:[cursorBgColor := fgColor].
+ cursorType isNil ifTrue:[cursorType := DefaultCursorType].
+ cursorTypeNoFocus isNil ifTrue:[
+ cursorTypeNoFocus := cursorType.
+ DefaultCursorTypeNoFocus notNil ifTrue:[
+ cursorTypeNoFocus := DefaultCursorTypeNoFocus.
+ ]
+ ].
+ cursorNoFocusFgColor := DefaultCursorNoFocusForegroundColor.
+ cursorNoFocusFgColor isNil ifTrue:[
+ cursorType ~~ #block ifTrue:[
+ cursorNoFocusFgColor := cursorBgColor
+ ] ifFalse:[
+ cursorNoFocusFgColor := cursorFgColor
+ ]
+ ].
+
+ "Modified: / 15.12.1999 / 22:27:45 / cg"
+!
+
+initialize
+ "initialize a new EditTextView;
+ setup some instance variables"
+
+ super initialize.
+
+ self level:-1.
+ readOnly := false.
+ fixedSize := false.
+ exceptionBlock := [:errorText | ].
+ cursorShown := prevCursorState := true.
+ cursorLine := 1.
+ cursorVisibleLine := 1.
+ cursorCol := 1.
+ cursorLineHolder := 1 asValue.
+ cursorColHolder := 1 asValue.
+ modifiedChannel := ValueHolder with:false.
+ acceptChannel := ValueHolder with:false.
+ acceptChannel addDependent:self.
+ showMatchingParenthesis := false.
+ hasKeyboardFocus := false.
+ tabMeansNextField := false.
+ autoIndent := false.
+ editMode := EditMode insertMode asValue.
+ learnMode := false asValue.
+ trimBlankLines := self st80EditMode not.
+ cursorMovementWhenUpdating := #beginOfText.
+ lastReplacementInfo := LastReplacementInfo new.
+
+ "/ enable drop by default
+ self allowDrop:true. "/ readOnly tested in #canDrop:
+
+ undoSupport := UndoSupport for:self.
+ codeAspectHolder := nil asValue.
+
+ "Modified: / 27-09-2013 / 09:41:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+initializeCompletionSupport
+ |supportClass|
+
+ completionSupport isNil ifTrue:[
+ (supportClass := self completionSupportClass) notNil ifTrue:[
+ completionSupport := supportClass for:self.
+ ].
+ ].
+
+ "Created: / 26-09-2013 / 17:51:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+release
+ completionSupport notNil ifTrue:[
+ completionSupport release
+ ].
+ super release
+! !
+
+!EditTextView methodsFor:'macros'!
+
+executeLearnedKeyboardMacro
+ "replay the characters as learned previously"
+
+ (self learnMode not and:[learnedMacro size > 0]) ifTrue:[
+ ExecutingMacroQuery
+ answer:true
+ do:[
+ learnedMacro do:[:event |
+ WindowGroup lastEventQuerySignal answer:event
+ do:[
+ self
+ dispatchEvent:event
+ withFocusOn:nil
+ delegate:false
+ ]
+ ]
+ ].
+ ] ifFalse:[
+ self flash.
+ ].
+!
+
+learnMode
+ "true if currently learning"
+
+ ^ (learnMode value ? false).
+!
+
+learnMode:aBoolean
+ "toggle the learn-mode"
+
+ |fg bg|
+
+ self learnModeHolder value:aBoolean.
+
+ aBoolean ifTrue:[
+ learnedMacro := OrderedCollection new.
+ fg := Color white.
+ bg := Color black.
+ ] ifFalse:[
+ cursorFgColor := fg := (DefaultCursorForegroundColor ? bgColor).
+ cursorBgColor := bg := (DefaultCursorBackgroundColor ? fgColor).
+ ].
+ self cursorForegroundColor:fg backgroundColor:bg.
+!
+
+learnModeHolder
+ "a holder returning true, if in learn mode"
+
+ learnMode isNil ifTrue:[
+ learnMode := false asValue
+ ].
+ ^ learnMode
+!
+
+rememberLearnedMacroAs: nameString
+ Macros isNil ifTrue:[
+ Macros := Dictionary new.
+ ].
+ Macros at:nameString put:learnedMacro
+!
+
+toggleLearnMode
+ "toggle the learn-mode"
+
+ self learnMode:(self learnMode not).
+! !
+
+!EditTextView methodsFor:'menu & menu actions'!
+
+babelFishTranslate:fromToModeString
+ "translate the selected text and paste it after the selection"
+
+ |original translated|
+
+ original := self selectionAsString.
+ original size == 0 ifTrue:[^ self].
+
+ self withWaitCursorDo:[
+ (HostNameLookupError , SOAP::SoapImplError) handle:[:ex |
+ Dialog warn:('Translation failed - WEB Service error:\\%1.' bindWith:ex description allBold) withCRs
+ ] do:[
+ translated := SOAP::BabelFishClient new translate:original mode:fromToModeString.
+ ]
+ ].
+
+ "/ v pasteOrReplace:translated
+ self cursorLine:(self selectionEndLine) col:(self selectionEndCol + 1).
+ self unselect.
+ self
+ undoablePaste:translated
+ info:'Translate'
+
+ "Modified: / 28-07-2007 / 13:27:21 / cg"
+!
+
+compareWithClipboard
+ "compare the selection against the clipboard contents"
+
+ |t1 t2|
+
+ t2 := self getClipboardText.
+ t2 isEmptyOrNil ifTrue:[
+ Dialog information:'Clipboard is empty.'.
+ ^ self.
+ ].
+
+ self hasSelection ifTrue:[
+ t1 := self selectionAsString.
+ ] ifFalse:[
+ t1 := self contents asString
+ ].
+ t1 := t1 string.
+
+ t1 = t2 ifTrue:[
+ Dialog information:'Strings are equal.'.
+ ^ self.
+ ].
+ DiffTextView
+ openOn:t1 label:'Editor'
+ and:t2 label:'Clipboard'
+!
+
+cut
+ "cut selection into copybuffer"
+
+ self deleteCopyToClipboard:true
+!
+
+defaultForGotoLine
+ "return a default value to show in the gotoLine box"
+
+ cursorLine notNil ifTrue:[
+ ^ cursorLine
+ ].
+ ^ super defaultForGotoLine
+!
+
+deleteCopyToClipboard:toClipboard
+ "cut selection into copybuffer"
+
+ |line col history sel |
+
+ (self checkModificationsAllowed) ifFalse:[
+ self flashReadOnly.
+ ^ self
+ ].
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ self setLastStringToReplace: sel.
+
+ line := selectionStartLine.
+ col := selectionStartCol.
+
+ toClipboard ifTrue:[
+ "
+ remember in CopyBuffer
+ "
+ self setClipboardText:sel. "/ lastString.
+ ].
+
+ "
+ append to DeleteHistory (if there is one)
+ "
+ history := Smalltalk at:#DeleteHistory.
+ history notNil ifTrue:[
+ history addAll:(sel asStringCollection).
+ history size > 1000 ifTrue:[
+ history := history copyFrom:(history size - 1000)
+ ].
+ ].
+
+ "
+ now, delete it
+ "
+ self
+ undoableDo:[self deleteSelection]
+ info:'Delete'.
+ lastReplacementInfo lastReplacement: nil
+ ] ifFalse:[
+ "
+ a cut without selection will search&cut again
+ "
+ self undoableDo:[
+ self again
+ ]
+ ]
+
+ "Modified: / 5.4.1998 / 16:51:53 / cg"
+!
+
+editMenu
+ "return the views middleButtonMenu"
+
+ <resource: #keyboard (#Again #AgainForAll #Copy #Cut #Paste #Accept
+ #Find #GotoLine #SaveAs #Print
+ #PasteFromHistory #Join #Wrap #Undo #Redo
+ #ToggleAutoIndent #ToggleInsertMode
+ #LearnKeyboardMacro #ExecuteKeyboardMacro )>
+ <resource: #programMenu>
+
+ |items m sub translateItems sortItems miscItems toolItems subSub toolSub
+ transSub sortSub what undoIdx redoIdx sensor main mainItems|
+
+ items := #(
+ ('Redo' redo Redo )
+ ('Again (for All)' multipleAgain AgainForAll )
+ ('-' )
+ ('Search...' search Find )
+ ('Goto Line...' gotoLine GotoLine )
+ ('-' )
+ ('Tools' tools )
+ ('Insert Unicode...' insertUnicode )
+ ).
+ CharacterSetView notNil ifTrue:[
+ items := items ,
+ #(
+ ('Special Characters...' specialCharacters OpenSpecialCharacterWindow )
+ ).
+ ].
+ items := items , #(
+ ('-' )
+ ('Save As...' save SaveAs )
+ ('Print' doPrint Print )
+ ('=' )
+ ('Misc' misc ShiftCtrl) ).
+
+ miscItems := #(
+ ('AutoIndent \c' autoIndent: ToggleAutoIndent )
+ ('InsertMode \c' insertMode: ToggleInsertMode )
+ ('-' )
+ ('Paste Previous...' pasteOrReplaceFromHistory PasteFromHistory )
+ ('Join Lines' joinLines Join )
+ ('Wrap Lines...' wrapLines Wrap )
+ ('-' )
+ ('Learn Macro' learnMode: LearnKeyboardMacro)
+ ('Execute Macro' executeLearnedKeyboardMacro ExecuteKeyboardMacro )
+ ('-' )
+ ('Insert File...' insertFile )
+ ('Insert URL Contents...' insertURL )
+ ('Insert new UUID' insertUUID )
+ ('Insert Date && Time' insertDateAndTime )
+ ('-' )
+ ('Insert File as String Literal...' insertFileAsStringLiteral )
+ ('Paste as String Literal' pasteAsStringLiteral )
+ ('-' )
+ ).
+"/ CharacterSetView notNil ifTrue:[
+"/ miscItems := miscItems ,
+"/ #(
+"/ ('Special Characters...' specialCharacters OpenSpecialCharacterWindow )
+"/ ).
+"/ ].
+ miscItems := miscItems ,
+ #(
+ ('Font...' changeFont )
+"/ ('Encoding...' changeEncoding )
+ ).
+
+ translateItems := #(
+ ('English -> German' (babelFishTranslate: 'en_de') )
+ ('English -> French' (babelFishTranslate: 'en_fr') )
+ ('English -> Italian' (babelFishTranslate: 'en_it') )
+ ('English -> Spanish' (babelFishTranslate: 'en_es') )
+ ('English -> Portuguese' (babelFishTranslate: 'en_pt') )
+ ('-' )
+ ('German -> English' (babelFishTranslate: 'de_en') )
+ ('French -> English' (babelFishTranslate: 'fr_en') )
+ ('Italian -> English' (babelFishTranslate: 'it_en') )
+ ('Spanish -> English' (babelFishTranslate: 'es_en') )
+ ('Portuguese -> English' (babelFishTranslate: 'pt_en') )
+ ).
+
+ sortItems := #(
+ ('Lines' (sortSelection:ignoreCase: #lines false) )
+ ('Lines by First Word' (sortSelection:ignoreCase: #linesByFirstWord false) )
+ ('Lines by n''th Word' (sortSelection:ignoreCase: #linesByNthWord false) )
+ ('Lines by n''th Number' (sortSelection:ignoreCase: #linesByNthNumber false) )
+ ('Lines by n''th Hex Number' (sortSelection:ignoreCase: #linesByNthHexNumber false) )
+ ('Words' (sortSelection:ignoreCase: #words false) )
+ ('-' )
+ ('Lines (ignore case)' (sortSelection:ignoreCase: #lines true) )
+ ('Lines by First Word (ignore case)' (sortSelection:ignoreCase: #linesByFirstWord true) )
+ ('Lines by n''th Word (ignore case)' (sortSelection:ignoreCase: #linesByNthWord true) )
+ ('Words (ignore case)' (sortSelection:ignoreCase: #words true) )
+ ('-' )
+ ('By Line Length' (sortSelection:ignoreCase: #linesByLength nil) )
+ ('Reverse' (sortSelection:ignoreCase: #reverse nil) )
+ ).
+
+ toolItems := #(
+ ('Indent' indent )
+ ('Toggle Case' convertSelectionToLowercaseOrUppercaseOrUppercaseFirst ConvertSelectionToLowercaseOrUppercaseOrUppercaseFirst)
+ ('Sort' sort )
+ ('-' )
+ ('Google Spell Check' googleSpellingSuggestion )
+ ('Builtin Spell Check' internalSpellingSuggestion )
+ ('Translate' babelFishTranslate )
+ ('Compare with Clipboard...' compareWithClipboard )
+ ).
+
+ Smalltalk isStandAloneApp ifFalse:[
+ toolItems := toolItems , #(
+ ('-' )
+ ('Open FileBrowser on It' openFileBrowserOnIt )
+ ('Open Workspace with It' openWorkspaceWithIt )
+ ).
+ ].
+
+ sub := PopUpMenu itemList:items resources:resources performer:model.
+ sub receiver:self.
+
+ toolSub := PopUpMenu itemList:toolItems resources:resources performer:model.
+ toolSub receiver:self.
+ sub subMenuAt:#tools put:toolSub.
+
+ transSub := PopUpMenu itemList:translateItems resources:resources performer:model.
+ transSub receiver:self.
+ toolSub subMenuAt:#babelFishTranslate put:transSub.
+
+ sortSub := PopUpMenu itemList:sortItems resources:resources performer:model.
+ sortSub receiver:self.
+ toolSub subMenuAt:#sort put:sortSub.
+
+ subSub := PopUpMenu itemList:miscItems resources:resources performer:model.
+ subSub receiver:self.
+ subSub checkToggleAt:#autoIndent: put:autoIndent.
+ subSub checkToggleAt:#insertMode: put:(self isInInsertMode).
+ subSub checkToggleAt:#learnMode: put:(self learnModeHolder value).
+
+ sub subMenuAt:#misc put:subSub.
+
+ mainItems := #(
+ ('Undo' undo Undo )
+ ('Again' again Again )
+ ('-' )
+ ('Cut' cut Cut )
+ ('Copy' copySelection Copy )
+ ('Paste' pasteOrReplace Paste )
+ ('-' )
+ ('Accept' accept Accept )
+ ('=' )
+ ('More' others Ctrl )
+ ).
+ main := PopUpMenu itemList:mainItems resources:resources.
+ main subMenuAt:#others put:sub.
+
+ sensor := self sensor.
+ (sensor notNil and:[sensor ctrlDown]) ifTrue:[
+ sensor shiftDown ifTrue:[
+ m := subSub
+ ] ifFalse:[
+ m := sub
+ ]
+ ] ifFalse:[
+ m := main
+ ].
+
+ "/ the 'Smalltalk at:' code is here to
+ "/ avoid making the SOAP package a prerequisite for this package (libwidg)
+ (Smalltalk at:#'SOAP::GoogleClient') isNil ifTrue:[
+ "/ GoogleClient new spellingSuggestionOf: 'Smmalltlaak and Soaap'.
+ m disable:#googleSpellingSuggestion
+ ].
+ (Smalltalk at:#'RBSpellChecker') isNil ifTrue:[
+ m disable:#internalSpellingSuggestion
+ ].
+
+ HTTPInterface isNil ifTrue:[
+ m disableAll:#(insertURL)
+ ].
+
+ self isReadOnly ifTrue:[
+ m disableAll:#(accept undo again multipleAgain redo
+ paste pasteOrReplace pasteOrReplaceFromHistory
+ cut indent autoIndent: insertMode:
+ insertFile insertFileAsStringLiteral insertURL
+ babelFishTranslate googleSpellingSuggestion sort
+ convertSelectionToLowercaseOrUppercaseOrUppercaseFirst
+ joinLines wrapLines insertUUID insertDateAndTime pasteAsStringLiteral
+ insertUnicode specialCharacters)
+ ].
+ self hasSelectionForCopy ifFalse:[
+ m disable:#copySelection.
+ ].
+ self hasSelection ifFalse:[
+ m disableAll:#(cut googleSpellingSuggestion babelFishTranslate openFileBrowserOnIt openWorkspaceWithIt sort indent).
+ ] ifTrue:[
+ (Error handle:[:ex |
+ ex return:false
+ ] do:[
+ |fn|
+ fn := self selectionAsString.
+ fn asFilename exists or:[ fn withoutSeparators withoutQuotes asFilename exists ]
+ ]) ifFalse:[
+ m disableAll:#(openFileBrowserOnIt).
+ ]
+ ].
+ self hasUndoAction ifFalse:[
+ m disable:#undo.
+ ] ifTrue:[
+ what := undoSupport undoActionInfo.
+ what notNil ifTrue:[
+ undoIdx := m indexOf:#undo.
+ m labelAt:undoIdx put:(resources string:'Undo (%1)' with:what).
+ ]
+ ].
+ self hasRedoAction ifFalse:[
+ sub disable:#redo.
+ ] ifTrue:[
+ what := undoSupport redoActionInfo.
+ what notNil ifTrue:[
+ redoIdx := sub indexOf:#redo.
+ sub labelAt:redoIdx put:(resources string:'Redo (%1)' with:what).
+ ]
+ ].
+ acceptEnabled == false ifTrue:[
+ m disable:#accept
+ ].
+ ^ m.
+
+ "Modified: / 01-03-2012 / 19:56:58 / cg"
+!
+
+getTextSelectionFromHistory
+ |sel list box history|
+
+ history := self graphicsDevice getCopyBufferHistory copy.
+ list := history collect:[:entry |
+ |text shown|
+
+ text := entry asString string asCollectionOfLines.
+ shown := text detect:[:line| line notEmptyOrNil] ifNone:[' '].
+ text size > 1 ifTrue:[
+ shown := shown,(resources string:' ... [%1 lines]' with:text size).
+ ].
+ shown
+ ].
+
+ box := ListSelectionBox
+ title:(resources string:'Clipboard History')
+ okText:(resources string:'Paste')
+ abortText:(resources string:'Cancel')
+ list:list
+ action:[:idx | idx notNil ifTrue:[sel := history at:idx]].
+ box label:(resources string:'Select Previous Copybuffer String').
+ box useIndex:true.
+ box show.
+ ^ sel.
+
+ "Modified: / 25-08-2010 / 22:02:14 / cg"
+!
+
+getTextSelectionOrTextSelectionFromHistory
+
+ self sensor shiftDown ifTrue:[
+ ^ self getTextSelectionFromHistory
+ ].
+
+ "/ return either the (xterm-) selection or the clipBoard depending on
+ "/ the Ctrl-Key state.
+
+ "/ ouch - this used to be ok for ALT-c / ALT-v,
+ "/ but no longer works with CTRL-c / CTRL-v.
+ ^ self getClipboardText:#clipboard
+
+"/ ^ self
+"/ getClipboardText:(self sensor ctrlDown
+"/ ifTrue:[#selection]
+"/ ifFalse:[#clipboard])
+
+ "Modified: / 13-07-2011 / 14:55:58 / cg"
+!
+
+googleSpellingSuggestion
+ "insert the google-spelling suggestion for the selected text.
+ Requires that the SOAP stuff is loaded and working."
+
+ |text suggestion|
+
+ self withWaitCursorDo:[
+ text := self selection asString string withoutSeparators.
+ text size == 0 ifTrue:[^ self].
+
+ "/ the 'Smalltalk at:' code is here to
+ "/ avoid making the SOAP package a prerequisite for this package (libwidg)
+ (Smalltalk at:#'SOAP::SoapImplError') handle:[:ex |
+ Dialog warn:('Spelling correction failed - WEB Service error:\\%1.' bindWith:ex description allBold) withCRs.
+ ^ self.
+ ] do:[
+ suggestion := (Smalltalk at:#'SOAP::GoogleClient') new spellingSuggestionOf:text.
+ ].
+ suggestion size == 0 ifTrue:[
+ self information:('No spelling suggestion from Google for: ' , text).
+ Transcript showCR:('No spelling suggestion from Google for: ' , text).
+ ^ self.
+ ].
+ ].
+ self
+ undoablePaste:suggestion
+ info:'Spelling Suggestion'.
+
+ "Modified: / 28-07-2007 / 13:25:10 / cg"
+!
+
+insertDateAndTime
+ "insert the curent date and time string"
+
+ typeOfSelection := nil.
+ self
+ undoableDo:[ self pasteOrReplace:(Timestamp now printStringRFC1123Format)]
+ info:'Paste Date and Time'
+!
+
+insertFile
+ "insert contents of a file
+ - ask user for filename using a fileSelectionBox."
+
+ self insertFileAsStringLiteral:false
+!
+
+insertFileAsStringLiteral
+ "insert a file's contents as a string literal.
+ Almost the same as the insert file, but single-quotes are doubled,
+ to make it a legal string literal"
+
+ self insertFileAsStringLiteral:true
+!
+
+insertFileAsStringLiteral:asStringLiteral
+ "insert contents of a file; either as-is or as a string literal.
+ - ask user for filename using a fileSelectionBox."
+
+ |sel selFn file text ok initial|
+
+ ((sel := self selectionAsString) notEmptyOrNil
+ and:[ (selFn := sel asFilename) exists
+ and:[ selFn isRegularFile ]])
+ ifTrue:[
+ initial := selFn pathName.
+ ].
+
+ [
+ |why|
+
+ file := Dialog
+ requestFileName:(resources string:'Insert Contents Of:')
+ default:initial
+ ok:(resources string:'Insert')
+ abort:(resources string:'Cancel')
+ pattern:nil
+ fromDirectory:directoryForFileDialog.
+ file isNil ifTrue:[
+ "cancel"
+ ^ self.
+ ].
+ file := file asFilename.
+ directoryForFileDialog := file.
+
+ ok := file isReadable and:[file isDirectory not].
+ ok ifFalse:[
+ file isReadable ifFalse:[
+ why := '%1 is unreadable.\\Please try again.'
+ ] ifTrue:[
+ why := '%1 is a directory.\\Please try again.'
+ ].
+ Dialog warn:(resources stringWithCRs:why with:file pathName).
+ ].
+ ] doUntil:[ok].
+
+ text := file contentsOfEntireFile.
+ self
+ undoableDo:[ self paste:(asStringLiteral ifTrue:[text storeString] ifFalse:[text]) ]
+ info:'Paste File'
+
+ "Modified: / 28-07-2007 / 13:23:32 / cg"
+!
+
+insertURL
+ "insert contents of a URL
+ - ask user for URL using a dialog."
+
+ self insertURLAsStringLiteral:false
+!
+
+insertURLAsStringLiteral:asStringLiteral
+ "insert contents of a file; either as-is or as a string literal.
+ - ask user for filename using a fileSelectionBox."
+
+ |sel url text response initial|
+
+ (sel := self selectionAsString) notEmptyOrNil
+ ifTrue:[
+ initial := sel.
+ ].
+
+ url := Dialog
+ request:(resources string:'Insert Contents of URL:')
+ initialAnswer:initial
+ okLabel:(resources string:'Insert')
+ title:(resources string:'URL').
+ url isNil ifTrue:[
+ "cancel"
+ ^ self.
+ ].
+ response := HTTPInterface get:url.
+ response isErrorResponse ifTrue:[
+ Dialog warn:(resources string:'Could not fetch the document: %1' with:url).
+ ^ self.
+ ].
+ text := response data asString.
+
+ self
+ undoableDo:[
+ self paste:(asStringLiteral ifTrue:[text storeString] ifFalse:[text])
+ ]
+ info:'Insert Contents of URL'
+!
+
+insertUUID
+ "insert a new UUID's string"
+
+ typeOfSelection := nil.
+ self
+ undoableDo:[ self pasteOrReplace:(UUID genUUID printString)]
+ info:'Paste New UUID'
+
+ "Created: / 28-07-2007 / 13:01:16 / cg"
+!
+
+insertUnicode
+ "open a Dialog requesting an integer value and insert it as unicode character"
+
+ |unicodePoint unicodeChar unicodeString|
+
+ unicodeString := Dialog request:'Enter unicode (U+01FF or decimal number):'.
+ unicodeString size < 2 ifTrue:[
+ ^ self.
+ ].
+ (unicodeString second = $+ and:['Uu' includes:unicodeString first]) ifTrue:[
+ unicodePoint := Integer readFrom:(unicodeString copyFrom:3) radix:16 onError:[^ self].
+ ] ifFalse:[
+ unicodePoint := Integer readFrom:unicodeString onError:[^ self].
+ ].
+
+ unicodeChar := Character value:unicodePoint.
+ self keyPress:unicodeChar x:0 y:0.
+ self keyRelease:unicodeChar x:0 y:0.
+!
+
+internalSpellingSuggestion
+ "insert the internal-spelling suggestion for the selected text.
+ Requires that the RefactoryBrowser/line/spelCheck stuff is loaded."
+
+ |text suggestions best|
+
+ self withWaitCursorDo:[
+ text := self selection asString string withoutSeparators.
+ text size == 0 ifTrue:[^ self].
+
+ suggestions := RBSpellChecker default bestMatchesFor:text.
+ suggestions size == 0 ifTrue:[
+ self information:('No spelling suggestion from builtin checker for: ' , text).
+ Transcript showCR:('No spelling suggestion from builtin checker for: ' , text).
+ ^ self.
+ ].
+ Transcript showCR:suggestions.
+ best := suggestions first.
+ ].
+ self
+ undoablePaste:best
+ info:'Spelling Suggestion'.
+!
+
+openFileBrowserOnFileNamed:fileNameString
+ "open a fileBrowser on the given fileNameString"
+
+ |fn|
+
+ fn := fileNameString asFilename.
+ fn exists ifFalse:[
+ fn := fileNameString withoutSeparators withoutQuotes asFilename.
+ fn exists ifFalse:[
+ ^ self warn:'Oops - file is gone'.
+ ].
+ ].
+ UserPreferences fileBrowserClass openOn:fn
+
+ "Modified: / 06-09-2012 / 14:47:22 / cg"
+!
+
+openFileBrowserOnIt
+ "open a fileBrowser on the selected fileName"
+
+ |fileNameString|
+
+ fileNameString := self selectionAsString.
+ self openFileBrowserOnFileNamed:fileNameString
+
+ "Modified: / 06-09-2012 / 14:47:22 / cg"
+!
+
+openWorkspaceWithIt
+ "open a workspace containing the selected text"
+
+ |text|
+
+ text := self selectionAsString.
+ WorkspaceApplication openWith:text selected:true
+
+ "Created: / 26-05-2007 / 06:05:22 / cg"
+!
+
+paste
+ "paste the copybuffer; if there is a selection, unselect first.
+ Then paste at cursor position."
+
+ self checkModificationsAllowed ifTrue:[
+ self withSelfAndTextForPasteDo:[:me :text |
+ me unselect.
+ me undoablePaste:text
+ ]
+ ]
+!
+
+paste:someText
+ "paste someText at cursor"
+
+ self paste:someText withCR:false
+!
+
+paste:someText withCR:withCR
+ "paste someText at cursor"
+
+ |s nLines startLine startCol l1 l2 c1 c2 codingErrorReported|
+
+ self checkModificationsAllowed ifFalse:[^ self].
+ someText isNil ifTrue:[^ self].
+
+ s := someText.
+ codingErrorReported := false.
+ CharacterEncoderError handle:[:ex |
+ |code msg|
+
+ code := ex parameter.
+ codingErrorReported ifFalse:[
+ msg := 'Cannot represent pasted string in this Views encoding (',gc characterEncoding,').'.
+ code notNil ifTrue:[
+ msg := msg , '\\Reason: No representation for ' , (code radixPrintStringRadix:16).
+ ].
+ Dialog warn:(resources stringWithCRs:msg).
+ codingErrorReported := true.
+ ].
+ ex proceedWith:ex defaultValue
+ ] do:[
+ s isString ifTrue:[
+ s encoding ~~ gc characterEncoding ifTrue:[
+ s := s encodeFrom:(s encoding) into:gc characterEncoding.
+ ].
+
+ s := s asStringCollection.
+ (someText endsWith:Character cr) ifTrue:[
+ "/ s := s copyWith:nil.
+ s := s copyWith:'' "/ an empty line at the end
+
+ ]
+ ] ifFalse:[
+ s isStringCollection ifTrue:[
+ s := s encodeFrom:(s encoding) into:gc characterEncoding.
+ ] ifFalse:[
+ (self
+ confirm:(resources
+ stringWithCRs:'Selection (%1) is not convertable to Text.\\Paste storeString ?'
+ with:s class name)) ifFalse:[^ self].
+ s := StringCollection with:s storeString .
+ "/ ^ self
+ ].
+ ].
+ ].
+
+ (nLines := s size) == 0 ifTrue:[^ self].
+ (nLines == 1 and:[(s at:1) size == 0]) ifTrue:[^ self].
+
+ typeOfSelection := #paste.
+
+ startLine := l1 := cursorLine.
+ startCol := c1 := cursorCol.
+
+ "do not expand tabs into spaces here -
+ they get expanded in basicWithoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
+ Some Subviews want to paste with unexpanded tabs!!"
+
+ self insertLines:s withCR:withCR.
+ l2 := cursorLine.
+ c2 := (cursorCol - 1).
+ self selectFromLine:l1 col:c1 toLine:l2 col:c2.
+ typeOfSelection := #paste. "/ sigh - cleared by #selectFromLine:
+
+ "Modified: / 14-02-1996 / 11:14:14 / stefan"
+ "Modified: / 25-01-2012 / 00:31:30 / cg"
+!
+
+pasteAsStringLiteral
+ "insert clipboard string as a string literal.
+ Almost the same as a normal paste, but single-quotes are doubled,
+ to make it a legal string literal"
+
+ typeOfSelection := nil.
+ self
+ undoableDo:[ self pasteOrReplace:(self getClipboardText storeString) ]
+ info:'Paste as String Literal'
+!
+
+pasteOrReplace
+ "paste the copybuffer; if there is a selection, replace it.
+ otherwise paste at cursor position.
+ Replace is not done for selections which were created by a paste,
+ to allow multiple paste operations in a row."
+
+ self withSelfAndTextForPasteDo:[:me :text | me pasteOrReplace:text]
+!
+
+pasteOrReplace:someText
+ "paste someText; 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."
+
+ self checkModificationsAllowed ifFalse:[^ self].
+
+ self undoableDo:[
+ ((self hasSelection == true) and:[typeOfSelection ~~ #paste]) ifTrue:[
+ self replace:someText
+ ] ifFalse:[
+ self paste:someText.
+ ]
+ ] info:'Paste/Replace'.
+
+ "Modified: / 30.1.2000 / 02:33:00 / cg"
+!
+
+pasteOrReplaceFromHistory
+ "paste a previous item from the copybuffer history.
+ (i.e. repaste some previously deleted or copied text)"
+
+ |text|
+
+ self checkModificationsAllowed ifFalse:[
+ self flashReadOnly.
+ ^ self
+ ].
+ text := self getTextSelectionFromHistory.
+ text notNil ifTrue:[
+ self pasteOrReplace:text
+ ]
+!
+
+replace
+ "replace the selection by the contents of the copybuffer"
+
+ self hasSelection ifFalse:[^ self].
+ self checkModificationsAllowed ifFalse:[^ self].
+
+ self withSelfAndTextForPasteDo:[:me :text |
+ me undoableDo:[ me replace:text ]
+ info:'Replace'
+ ]
+!
+
+replace:someText
+ "replace the selection by someText"
+
+ |selected selectedString
+ selStartLine selStartCol selEndLine selEndCol|
+
+ self checkModificationsAllowed ifFalse:[^ self].
+
+ self undoableDo:[
+ 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."
+
+ selected size == 1 ifTrue:[
+ selectedString := selected at:1.
+ ].
+
+ someText size == 1 ifTrue:[
+ |cutOffSpace addSpace replacement replacementString|
+
+ cutOffSpace := false.
+ addSpace := false.
+ replacement := someText copyFrom: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
+ ]
+ ].
+ 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
+ ].
+ self setLastStringToReplace: selectedString.
+
+ lastReplacementInfo lastReplacement: someText.
+
+ selStartLine := selectionStartLine.
+ selStartCol := self selectionStartCol.
+ selEndLine := selectionEndLine.
+ selEndCol := self selectionEndCol.
+ ]
+ info:'Replace'
+
+ "Modified: / 14.2.1996 / 10:37:02 / stefan"
+ "Modified: / 5.4.1998 / 16:55:28 / cg"
+!
+
+searchReplace
+ "search for a string - show a box to enter searchpattern
+ replace for the found searchpattern or replace all searchpattern found to a new pattern - show a box to enter replacepattern
+ - currently no regular expressions are handled."
+
+ |searchBox patternHolder replacePatternHolder caseHolder flag ign initialString bindings bldr search modal replace action|
+
+ modal := false "(UserPreferences current searchDialogIsModal)".
+ lastSearchDirection := #forward.
+ ign := lastSearchIgnoredCase ? LastSearchIgnoredCase ? true.
+ caseHolder := ign asValue.
+ patternHolder := '' asValue.
+ replacePatternHolder := '' asValue.
+ lastSearchPattern notNil ifTrue:[
+ initialString := lastSearchPattern
+ ].
+ self hasSelectionWithinSingleLine ifTrue:[
+ initialString := self selectionAsString
+ ].
+ initialString isNil ifTrue:[
+ LastSearchPatterns size > 0 ifTrue:[
+ initialString := LastSearchPatterns first
+ ]
+ ].
+ initialString notNil ifTrue:[
+ patternHolder value:initialString.
+ replacePatternHolder value:initialString.
+ ].
+ flag := true.
+ search := [:fwd |
+ self
+ search:patternHolder value
+ ignoreCase:caseHolder value
+ forward:fwd.
+ ].
+ replace := [:all |
+ self
+ replace:patternHolder value
+ by:replacePatternHolder value
+ all:all
+ ignoreCase:caseHolder value
+ ].
+ bindings := IdentityDictionary new.
+ bindings at:#searchPattern put:patternHolder.
+ bindings at:#replacePattern put:replacePatternHolder.
+ modal ifTrue:[
+ bindings at:#nextAction
+ put:[
+ flag := true.
+ action := search.
+ searchBox doAccept.
+ ].
+ bindings at:#prevAction
+ put:[
+ flag := false.
+ action := search.
+ searchBox doAccept.
+ ].
+ bindings at:#replaceAction
+ put:[
+ flag := false.
+ action := replace.
+ searchBox doAccept.
+ ].
+ bindings at:#replaceAllAction
+ put:[
+ flag := true.
+ action := replace.
+ searchBox doAccept.
+ ].
+ ] ifFalse:[
+ bindings at:#nextAction put:[ search value:true. ].
+ bindings at:#prevAction put:[ search value:false. ].
+ bindings at:#replaceAction put:[ replace value:false. ].
+ bindings at:#replaceAllAction put:[ replace value:true. ].
+ ].
+ bindings at:#ignoreCase put:caseHolder.
+ bindings at:#patternList put:LastSearchPatterns.
+ modal ifTrue:[
+ searchBox := SimpleDialog new.
+ ] ifFalse:[
+ searchBox := ApplicationModel new.
+ searchBox createBuilder.
+ ].
+ searchBox resources:(self resources).
+ bldr := searchBox builder.
+ bldr addBindings:bindings.
+ searchBox allButOpenFrom:(self class searchReplaceDialogSpec).
+ (bldr componentAt:#nextButton) cursor:(Cursor thumbsUp).
+ (bldr componentAt:#prevButton) cursor:(Cursor thumbsUp).
+ (bldr componentAt:#cancelButton) cursor:(Cursor thumbsDown).
+ modal ifTrue:[
+ searchBox openDialog.
+ searchBox accepted ifTrue:[
+ action value:flag
+ ].
+ ] ifFalse:[
+ (bldr componentAt:#nextButton) isReturnButton:false.
+ (bldr componentAt:#cancelButton)
+ label:(resources string:'Close');
+ action:[ searchBox closeRequest ].
+
+ "/ searchBox masterApplication:self application.
+
+ self topView beMaster.
+ (searchBox window)
+ beSlave;
+ openInGroup:(self windowGroup).
+
+ "/ searchBox window open.
+
+ searchBox window assignKeyboardFocusToFirstInputField.
+ ]
+
+ "Modified: / 11-07-2006 / 11:20:06 / fm"
+!
+
+showDeleted
+ "open a readonly editor on all deleted text"
+
+ |v|
+
+ v := EditTextView openWith:(Smalltalk at:#DeleteHistory).
+ v readOnly:true.
+ v topView label:'deleted text'.
+!
+
+sort:how ignoreCase:ignoreCase fromLine:start toLine:end
+ "sort/reorder the selected lines.
+ how:
+ #lines
+ #linesByFirstWord
+ #linesByNthWord
+ #linesByNthNumber
+ #linesByNthHexNumber
+ #words
+ #linesByLength
+ #reverse
+ "
+
+ |lines extractor innerExtractor fetcher operation lineWise nStr n s words|
+
+ lineWise := true.
+
+ how == #reverse ifTrue:[
+ operation := [:lines | lines reverse].
+ ] ifFalse:[
+ operation := [:linesOrWords |
+ linesOrWords sort:[:item1 :item2 | (fetcher value:item1) < (fetcher value:item2)]
+ ].
+
+ how == #linesByLength ifTrue:[
+ fetcher := [:l | l size].
+ ] ifFalse:[
+ how == #lines ifTrue:[
+ extractor := [:l | l withoutLeadingSeparators].
+ ] ifFalse:[
+ how == #linesByFirstWord ifTrue:[
+ extractor := [:l | ((l asCollectionOfWords select:[:w | w isEmpty or:[w first isLetterOrDigit]]) at:1 ifAbsent:'')].
+ ] ifFalse:[
+ ((how == #linesByNthWord) or:[ how == #linesByNthNumber or:[ how == #linesByNthHexNumber]]) ifTrue:[
+ nStr := Dialog request:'Word/Column (1..)' initialAnswer:(LastColumnNumberForSort ? 2).
+ nStr isEmptyOrNil ifTrue:[^ self].
+ n := Integer readFrom:nStr onError:[^ self].
+ LastColumnNumberForSort := n.
+ extractor := [:l | ((l string asCollectionOfWords) at:n ifAbsent:'')].
+ how == #linesByNthNumber ifTrue:[
+ innerExtractor := extractor.
+ extractor := [:l | Integer readFrom:(innerExtractor value:l) onError:0]
+ ] ifFalse:[
+ how == #linesByNthHexNumber ifTrue:[
+ innerExtractor := extractor.
+ extractor := [:l |
+ |s|
+ s := innerExtractor value:l.
+ (s startsWith:'16r') ifTrue:[
+ (Integer readSmalltalkSyntaxFrom:s) ? 0
+ ] ifFalse:[
+ Integer readFrom:s radix:16 onError:[ 0 ]
+ ]
+ ]
+ ]
+ ].
+ ] ifFalse:[
+ how == #words ifTrue:[
+ lineWise := false.
+ extractor := [:w | w].
+ ] ifFalse:[
+ self error:'unknown sort criteria: ', how printString.
+ ]
+ ]
+ ]
+ ].
+ ignoreCase ifTrue:[
+ fetcher := [:l | (extractor value:l) asLowercase].
+ ] ifFalse:[
+ fetcher := extractor.
+ ].
+ ].
+ ].
+
+ lineWise ifTrue:[
+ "process the lines of the selection (aka a collection of lines)"
+ start == end ifTrue:[^ self ].
+ lines := (start to:end) collect:[:lineNr | (self listAt:lineNr) ? ''].
+ lines := operation value:lines.
+ (start to:end) with:lines do:[:lineNr :line | self replaceLine:lineNr with:line].
+ ] ifFalse:[
+ "process the whole selection as a string"
+ s := self selectionAsString.
+ words := s asCollectionOfWords.
+ words := operation value:words.
+ s := words asStringCollection asStringWith:Character space.
+ self replace:s.
+ ].
+ self textChanged.
+
+ "Modified: / 31-03-2012 / 10:59:28 / cg"
+!
+
+sortSelection:how ignoreCase:ignoreCase
+ "sort the selected lines"
+
+ |start end|
+
+ selectionStartLine isNil ifTrue:[^ self].
+
+ start := selectionStartLine.
+ end := selectionEndLine.
+ (selectionEndCol == 0) ifTrue:[
+ end := end - 1
+ ].
+
+ self
+ undoableDo:[
+ self sort:how ignoreCase:ignoreCase fromLine:start toLine:end
+ ]
+ info:'Sort'
+
+ "Modified (format): / 15-02-2012 / 16:52:53 / cg"
+!
+
+specialCharacters
+ CharacterSetView
+ openAsInputFor:self
+ label:'Special Character Input'
+ clickLabel:'Click to Insert Character'.
+!
+
+undoablePaste:someText
+ self undoablePaste:someText info:nil.
+
+ "Modified: / 28-07-2007 / 13:25:46 / cg"
+!
+
+undoablePaste:someText info:infoOrNil
+ self
+ undoableDo:[
+ self paste:someText.
+ ]
+ info:infoOrNil
+
+ "Created: / 28-07-2007 / 13:25:30 / cg"
+!
+
+undoablePasteOrReplace:someText info:infoOrNil
+ self
+ undoableDo:[
+ self pasteOrReplace:someText.
+ ]
+ info:infoOrNil
+
+ "Created: / 28-07-2007 / 13:26:16 / cg"
+!
+
+undoablePasteReplacingAll:someText info:infoOrNil
+ self
+ undoableDo:[
+ self selectAll.
+ self pasteOrReplace:someText.
+ ]
+ info:infoOrNil
+
+ "Created: / 28-07-2007 / 13:25:30 / cg"
+!
+
+withSelfAndTextForPasteDo:aBlock
+ "common code for paste/replace of the copybuffer"
+
+ |sel|
+
+ self checkModificationsAllowed ifFalse:[
+ self flashReadOnly.
+ ^ self
+ ].
+
+ sel := self getTextSelectionOrTextSelectionFromHistory.
+ sel notNil ifTrue:[
+ aBlock value:self value:sel.
+ ]
+! !
+
+!EditTextView methodsFor:'private'!
+
+beep
+ UserPreferences current beepInEditor ifTrue:[
+ super beep
+ ]
+!
+
+checkModificationsAllowed
+ "check if the text can be modified (i.e. is not readOnly).
+ evaluate the exceptionBlock if not.
+ This block should be provided by the application or user of the textView,
+ and may show a warnBox or whatever."
+
+ self isReadOnly ifTrue: [
+ exceptionBlock isNil ifTrue:[
+ ^ false
+ ].
+
+ (exceptionBlock value:'Text may not be modified') ~~ true ifTrue:[
+ ^ false
+ ]
+ ].
+ ^ true
+
+ "Modified: / 17.6.1998 / 15:51:10 / cg"
+!
+
+currentSelectionBgColor
+ typeOfSelection == #paste ifTrue:[
+ ^ DefaultAlternativeSelectionBackgroundColor ? selectionBgColor
+ ].
+ ^ super currentSelectionBgColor
+
+ "
+ DefaultAlternativeSelectionBackgroundColor := Color yellow blendWith:Color green
+ "
+!
+
+currentSelectionFgColor
+ typeOfSelection == #paste ifTrue:[
+ ^ DefaultAlternativeSelectionForegroundColor ? selectionFgColor
+ ].
+ ^ super currentSelectionFgColor
+!
+
+resetVariablesBeforeNewSearch
+ "clear the autosearch action, when the first pattern is searched for"
+
+ super resetVariablesBeforeNewSearch.
+
+ "/ new search invalidates remembered string
+ lastStringFromReplaceForNextSearch := nil.
+
+ "Modified (comment): / 07-03-2012 / 23:21:06 / cg"
+!
+
+setLastStringToReplace: aString
+
+ "This method will set the information coming from the last replace into the replacementInfo"
+
+ |lastReplaceIgnoredCase|
+
+ "/ The searchAction is mantained until a cut/replace or a search with a user selection is done
+ self clearSearchAction.
+
+ lastReplacementInfo lastStringToReplace: aString.
+ lastStringFromReplaceForNextSearch := aString.
+
+ "If the replace came after a search, the next replace will have the ignored case from that search action"
+ lastReplaceIgnoredCase := (typeOfSelection == #search)
+ ifTrue: [lastSearchIgnoredCase]
+ ifFalse: [nil].
+ lastReplacementInfo lastReplaceIgnoredCase: lastReplaceIgnoredCase.
+!
+
+st80EditMode
+ ^ st80Mode ? (UserPreferences current st80EditMode)
+!
+
+suppressEmphasisInSelection
+ "selection is shown without emphasis"
+
+ ^ true
+!
+
+textChanged
+ "my text was modified (internally).
+ Sent 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.).
+
+ As some authors of this code have been very sloppy in tha past
+ (not sending contentsChanged, but textChanged),
+ we do it here despite what is written above, to ensure that scrollers update correctly."
+
+ self contentsChanged.
+ self modified:true.
+ contentsWasSaved := false
+
+ "Modified: 14.2.1997 / 16:58:38 / cg"
+!
+
+textChangedButNoSizeChange
+ "my text was modified (internally).
+ Sent 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.)"
+
+ self modified:true.
+ contentsWasSaved := false
+
+ "Modified: 14.2.1997 / 16:58:38 / cg"
+! !
+
+!EditTextView methodsFor:'queries'!
+
+currentLine
+ "the current line (for relative gotos)"
+
+ ^ cursorLine
+
+ "Created: / 17.5.1998 / 20:07:52 / cg"
+!
+
+hasSearchActionSelection
+
+ ^ typeOfSelection == #searchAction
+!
+
+isKeyboardConsumer
+ "return true, if the receiver is a keyboard consumer;
+ Return true here, redefined from SimpleView."
+
+ ^ self isReadOnly not
+!
+
+specClass
+ "redefined, since the name of my specClass is nonStandard (i.e. not EditTextSpec)"
+
+ self class == EditTextView ifTrue:[^ TextEditorSpec].
+ ^ super specClass
+
+ "Modified: / 31.10.1997 / 19:48:19 / cg"
+!
+
+tabMeansNextField
+ "return true, if a Tab character should shift focus."
+
+ "if not readOnly, I want my tab keys ..."
+
+ ^ self isReadOnly or:[tabMeansNextField]
+
+ "Created: 7.2.1996 / 19:15:31 / cg"
+!
+
+widthOfContents
+ "return the width of the contents in pixels
+ Redefined to add the size of a space (for the cursor).
+ this enables us to scroll one position further than the longest
+ line (and possibly see the cursor behind the line)"
+
+ |w dev|
+
+ w := super widthOfContents.
+ (dev := self graphicsDevice ) isNil ifTrue:[
+ "/ really don't know ...
+ dev := Screen current
+ ].
+ ^ w + (gc font widthOn:dev)
+
+ "Modified: 28.5.1996 / 19:32:25 / cg"
+! !
+
+!EditTextView methodsFor:'realization'!
+
+realize
+ "make the view visible - scroll to make the cursor visible."
+
+ super realize.
+
+ self makeCursorVisible.
+ cursorFgColor := cursorFgColor onDevice:self graphicsDevice.
+ cursorBgColor := cursorBgColor onDevice:self graphicsDevice.
+
+ "Modified: 20.12.1996 / 14:16:05 / cg"
+ "Created: 24.7.1997 / 18:24:12 / cg"
+! !
+
+!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
+ "redraw a visible line"
+
+ super redrawVisibleLine:visLine.
+ self redrawCursorIfInVisibleLine:visLine
+!
+
+redrawVisibleLine:visLine col:colNr
+ "redraw the single character in visibleline at colNr"
+
+ super redrawVisibleLine:visLine col:colNr.
+ cursorShown ifTrue:[
+ (visLine == cursorVisibleLine) ifTrue:[
+ (colNr == cursorCol) ifTrue:[
+ self drawCursorCharacter.
+ ^ self
+ ]
+ ]
+ ].
+
+ "Modified: / 05-11-2007 / 17:35:53 / cg"
+!
+
+redrawVisibleLine:visLine from:startCol
+ "redraw a visible line from startCol to the end of line"
+
+ super redrawVisibleLine:visLine from:startCol.
+ cursorShown ifTrue:[
+ 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:'scrolling'!
+
+additionalMarginForHorizontalScroll
+ "return the number of pixels by which we may scroll more than the actual
+ width of the document would allow.
+ This is redefined by editable textViews, to allo for the cursor
+ to be visible if it is positioned right behind the longest line of text.
+ The default returned here is 10 pixels, which should be ok for most cursors"
+
+ ^ 10 max:gc font width
+!
+
+halfPageDown
+ "half a page down - to keep cursor on same visible line, it has to be moved
+ within the real text "
+
+ |prevCursorLine|
+
+ prevCursorLine := cursorVisibleLine.
+ super halfPageDown.
+ self cursorVisibleLine:prevCursorLine col:cursorCol
+!
+
+halfPageUp
+ "half a page up - to keep cursor on same visible line, it has to be moved
+ within the real text "
+
+ |prevCursorLine|
+
+ prevCursorLine := cursorVisibleLine.
+ super halfPageUp.
+ self cursorVisibleLine:prevCursorLine col:cursorCol
+!
+
+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 ?
+ "
+ self updateCursorVisibleLine.
+ prevCursorState ifTrue:[
+ self showCursor
+ ]
+
+ "Modified: / 17.6.1998 / 16:13:24 / cg"
+!
+
+originWillChange
+ "sent before scrolling - have to hide the cursor"
+
+ prevCursorState := cursorShown.
+ "/ cursorShown := false.
+ cursorShown ifTrue:[
+ self hideCursor
+ ]
+
+ "Modified: / 6.7.1998 / 13:07:23 / cg"
+!
+
+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
+!
+
+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
+! !
+
+!EditTextView methodsFor:'searching'!
+
+searchBwd:pattern ifAbsent:aBlock
+ "do a backward search"
+
+ self searchBwd:pattern ignoreCase:false ifAbsent:aBlock
+!
+
+searchBwd:pattern ignoreCase:ign ifAbsent:aBlock
+ "do a backward search"
+
+ cursorLine isNil ifTrue:[^ self].
+ super searchBwd:pattern ignoreCase:ign ifAbsent:aBlock
+!
+
+searchBwd:pattern ignoreCase:ign startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a backward search"
+
+ cursorLine isNil ifTrue:[^ self].
+
+ self
+ searchBackwardFor:pattern
+ ignoreCase:ign
+ startingAtLine:startLine col:startCol
+ ifFound:[:line :col |
+ self cursorMovementAllowed ifTrue:[
+ self cursorLine:line col:col.
+ ].
+ self showMatch:pattern isMatch:false atLine:line col:col.
+"/ self makeLineVisible:cursorLine
+ typeOfSelection := #search]
+ ifAbsent:aBlock
+
+ "Modified: 9.10.1997 / 13:02:13 / cg"
+!
+
+searchForAndSelectMatchingParenthesis
+ "select characters enclosed by matching parenthesis if one is under cusor"
+
+ self searchForAndSelectMatchingParenthesisFromLine:cursorLine col:cursorCol
+!
+
+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 cursorMovementAllowed ifFalse:[^ self].
+
+ self
+ searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
+ ifFound:[:line :col | self cursorLine:line col:col]
+ ifNotFound:[self showNotFound]
+ onError:[self beep]
+
+ "Modified: 9.10.1997 / 12:56:30 / cg"
+!
+
+searchFwd:pattern ignoreCase:ign match: match startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
+ cursorLine isNil ifTrue:[^ self].
+ self
+ searchForwardFor:pattern
+ ignoreCase:ign
+ match: match
+ startingAtLine:startLine col:startCol
+ ifFound:[:line :col |
+ self cursorMovementAllowed ifTrue:[
+ self cursorLine:line col:col.
+ ].
+ self showMatch:pattern isMatch:match atLine:line col:col.
+"/ self makeLineVisible:cursorLine
+ typeOfSelection := #search
+ ]
+ ifAbsent:aBlock
+
+ "Modified: 9.10.1997 / 12:57:47 / cg"
+ "Created: 9.10.1997 / 13:01:12 / cg"
+!
+
+searchFwd:pattern ignoreCase:ign startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
+ self searchFwd:pattern ignoreCase:ign match: false startingAtLine:startLine col:startCol ifAbsent:aBlock
+!
+
+searchFwd:pattern startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
+ self searchFwd:pattern ignoreCase:false startingAtLine:startLine col:startCol ifAbsent:aBlock
+!
+
+searchPatternForSearchBar
+
+ "Returns the next searchPattern from the user selection or from the autoSearch"
+
+ |searchPattern|
+
+ searchPattern := self searchPatternFromUserSelectionOrReplace.
+ searchPattern isNil
+ ifTrue: [searchPattern := lastSearchPattern]
+ ifFalse: [lastSearchPattern := searchPattern].
+ ^ searchPattern
+!
+
+setSearchPatternWithMatchEscapes: match
+ "set the searchpattern from the selection if there is one, and position
+ cursor to start of pattern"
+
+ |sel|
+
+ "/
+ "/ if the last operation was a replace, set pattern to last
+ "/ original string (for search after again)
+ "/ for cut or delete actions allow lastReplacement with nil
+ "/
+"/ (lastStringFromReplaceForNextSearch notNil
+"/ and:[typeOfSelection ~~ #search]) ifTrue:[
+"/ lastStringFromReplaceForNextSearch isString ifTrue:[
+"/ lastSearchPattern := lastStringFromReplaceForNextSearch.
+"/ ] ifFalse:[
+"/ lastSearchPattern := lastStringFromReplaceForNextSearch asStringWithoutFinalCR.
+"/ ].
+"/ ^ self
+"/ ].
+
+ "/
+ "/ if there is a selection:
+ "/ if there was no previous search, take it as search pattern.
+ "/ if there was a previous search, only take the selection if
+ "/ it did not result from a paste or from the last search itself.
+ "/ (to allow search-paste to be repeated)
+ "/
+ sel := self selection.
+ sel notNil ifTrue:[
+ (lastSearchPattern isNil
+ or:[typeOfSelection ~~ #paste and:[typeOfSelection ~~ #search]]
+ ) ifTrue:[
+ self cursorLine:selectionStartLine col:selectionStartCol.
+ lastSearchPattern := sel asStringWithoutFinalCR.
+ match ifTrue:[lastSearchPattern := lastSearchPattern withMatchEscapes].
+ ]
+ ]
+
+ "Modified: / 07-05-2011 / 17:25:59 / cg"
+!
+
+showMatch:pattern isMatch:isMatch atLine:line col:col
+ super showMatch:pattern isMatch:isMatch atLine:line col:col.
+ typeOfSelection := #search.
+!
+
+startPositionForSearchBackward
+ ^ self startPositionForSearchBackwardBasedOnCursorOrSelection
+!
+
+startPositionForSearchBackwardBasedOnCursorOrSelection
+ |startLine startCol|
+
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ cursorLine isNil ifTrue:[
+ startLine := list size.
+ startCol := self listAt:startLine size.
+ ] ifFalse:[
+ startLine := cursorLine min:list size.
+ startCol := cursorCol
+ ]
+ ].
+
+ ^ startCol @ cursorLine
+!
+
+startPositionForSearchForward
+ ^ self startPositionForSearchForwardBasedOnCursorOrSelection
+!
+
+startPositionForSearchForwardBasedOnCursorOrSelection
+ |startCol|
+
+ "/ if there is no selection and the cursor is at the origin,
+ "/ assume its the first search and do not skip the very first match
+ startCol := cursorCol.
+ self hasSelection ifTrue:[
+ ^ selectionEndCol @ selectionEndLine.
+ ] ifFalse:[
+ (cursorLine == 1 and:[cursorCol == 1]) ifTrue:[
+ startCol := 0
+ ].
+ startCol := startCol min:(self at:cursorLine) size
+ ].
+
+ ^ startCol @ cursorLine
+
+ "Modified (format): / 24-05-2012 / 13:58:37 / cg"
+! !
+
+!EditTextView methodsFor:'selections'!
+
+addToSelectionAfter:aBlock
+ "Pokud existuje selekce, upravi ji
+ podle aktualni pozice kurzoru a pozice
+ po provedeni blocku.
+ Urceno k implementaci Shift-Home a Shift-End
+ Nejak nevim, jak to presneji popsat :-)"
+
+ |startLine startCol endLine endCol |
+
+ self hasSelection ifTrue: [
+ startLine := selectionStartLine .
+ startCol := selectionStartCol .
+ endLine := selectionEndLine .
+ endCol := selectionEndCol .
+ ] ifFalse: [
+ startLine := endLine := cursorLine .
+ startCol := endCol := cursorCol .
+ ].
+
+ "deselectim a provedu presun kurzoru..."
+ self unselect .
+ aBlock value .
+
+ "funguje dost mizerne, jen na jednom radku..."
+ (startCol - cursorCol) abs <= (endCol - cursorCol) abs
+ ifTrue: [
+ startCol := cursorCol.
+ ] ifFalse: [
+ endCol := cursorCol - 1.
+ ].
+ self selectFromLine:startLine col:startCol toLine: endLine col:endCol .
+!
+
+autoMoveCursorToEndOfSelection
+ "return true, if the cursor should be automatically moved to the
+ end of a selection.
+ Redefined to return false in terminalViews, where the cursor should
+ not be affected by selecting"
+
+ ^ true
+!
+
+changeTypeOfSelectionTo:newType
+ typeOfSelection ~~ newType ifTrue:[
+ typeOfSelection := newType.
+ selectionStartLine notNil ifTrue:[
+ self
+ redrawFromLine:selectionStartLine col:selectionStartCol
+ toLine:selectionEndLine col:selectionEndCol
+ ].
+ ].
+!
+
+findNextWordAfterSelectionAndAddToSelection
+ |selStartCol selStartLine selEndCol selEndLine|
+
+ selectionStartCol isNil ifTrue:[
+ self selectWordUnderCursor.
+ ^ self
+ ].
+
+ selStartCol := selectionStartCol.
+ selEndCol := selectionEndCol.
+ selStartLine := selectionStartLine.
+ selEndLine := selectionEndLine.
+
+ self cursorToNextWord.
+ self selectWordUnderCursor.
+
+ self selectFromLine:selStartLine col:selStartCol toLine:selectionEndLine col:selectionEndCol.
+!
+
+searchPatternFromUserSelectionOrReplace
+
+ |sel searchPattern|
+
+ "/
+ "/ if the last operation was a replace, set pattern to last
+ "/ original string (for search after again)
+ "/
+ (lastStringFromReplaceForNextSearch notNil
+ and:[typeOfSelection ~~ #search]) ifTrue:[
+ lastStringFromReplaceForNextSearch isString ifTrue:[
+ searchPattern := lastStringFromReplaceForNextSearch.
+ ] ifFalse:[
+ searchPattern := lastStringFromReplaceForNextSearch asStringWithoutFinalCR.
+ ].
+ ^ searchPattern
+ ].
+
+ "/
+ "/ if there is a selection:
+ "/ if there was no previous search, take it as search pattern.
+ "/ if there was a previous search, only take the selection if
+ "/ it did not result from a paste.
+ "/ (to allow search-paste to be repeated)
+ "/
+ sel := self selection.
+ sel notNil ifTrue:[
+ typeOfSelection ~~ #search ifTrue:[
+ typeOfSelection ~~ #paste ifTrue:[
+ self cursorLine:selectionStartLine col:selectionStartCol.
+ searchPattern := sel asStringWithoutFinalCR.
+ ]
+ ].
+ ].
+
+ ^ searchPattern
+!
+
+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
+ ]
+
+ "Modified: 28.2.1997 / 19:14:54 / cg"
+!
+
+selectAllInitially
+ "select the whole text. This is called only once during the initialization
+ for editFields which are shown in a table or tree.
+ The selectAll is called via this method to allow for easier redefinition and
+ to distinguish auto-select from user-initiated selects."
+
+ self selectAll
+!
+
+selectCursorLine
+ "select cursorline"
+
+ self selectFromLine:cursorLine col:1 toLine:cursorLine+1 col:0
+!
+
+selectCursorLineFromBeginning
+ "select cursorline up to cursor position"
+
+ cursorCol > 1 ifTrue:[
+ self selectFromLine:cursorLine col:1
+ toLine:cursorLine col:(cursorCol-1)
+ ]
+
+ "Modified: 16.8.1996 / 19:14:14 / cg"
+!
+
+selectExpandCursorLine
+ "expand selection by one line or select cursorline"
+
+ selectionStartLine isNil ifTrue:[
+ self selectCursorLine
+ ] ifFalse:[
+ self selectFromLine:selectionStartLine col:selectionStartCol
+ toLine:cursorLine+1 col:0.
+ self makeLineVisible:selectionEndLine
+ ]
+!
+
+selectFromBeginOfLine
+ "select the text from the beginning of the current line to the current cursor position."
+
+ | newCursorCol ln |
+
+ list isNil ifTrue:[
+ self unselect
+ ] ifFalse:[
+ cursorCol > 1 ifTrue:[
+ ln := list at: cursorLine.
+ newCursorCol := ln notEmptyOrNil ifTrue:[ln indexOfNonSeparator] ifFalse:[1].
+ self selectFromLine:cursorLine col:newCursorCol toLine:cursorLine col:cursorCol-1.
+ cursorCol := newCursorCol.
+ typeOfSelection := nil
+ ]
+ ]
+
+ "Created: / 28-06-2011 / 22:47:04 / cg"
+ "Modified: / 18-07-2012 / 17:00:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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
+ ]
+!
+
+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.
+ (selectionEndLine notNil and:[self autoMoveCursorToEndOfSelection]) ifTrue:[
+ self cursorLine:selectionEndLine col:(selectionEndCol + 1).
+ ].
+ typeOfSelection := nil
+!
+
+selectToEndOfLine
+ "select the text from the current cursor position to the end of the current line"
+
+ | newCursorCol line |
+
+ list isNil ifTrue:[
+ self unselect
+ ] ifFalse:[
+ cursorCol >= 1 ifTrue:[
+ line := list at: cursorLine.
+ newCursorCol := line size.
+ [ newCursorCol > 1 and:[(line at:newCursorCol) isSeparator] ]
+ whileTrue:[newCursorCol := newCursorCol - 1].
+
+ self selectFromLine:cursorLine col:cursorCol toLine:cursorLine col: newCursorCol.
+ cursorCol := newCursorCol.
+ typeOfSelection := nil
+ ]
+ ]
+
+ "Created: / 28-06-2011 / 23:07:07 / cg"
+ "Modified: / 30-06-2011 / 19:51:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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
+ ]
+!
+
+selectWordUnderCursor
+ "select the word under the cursor"
+
+ self selectWordAtLine:cursorLine col:cursorCol
+!
+
+unselect
+ "forget and unhilight selection - must take care of cursor here"
+
+ |wasOn|
+
+ wasOn := self hideCursor.
+ super unselect.
+ typeOfSelection := nil.
+ wasOn ifTrue:[self showCursor]
+! !
+
+!EditTextView methodsFor:'undo & again'!
+
+addUndo:action
+ ^ undoSupport addUndo:action.
+!
+
+again
+ "repeat the last action (which was a cut or replace).
+ If current selection is not last string, search forward to
+ next occurrence of it before repeating the last operation."
+
+ |s l c sel savedSelectStyle startColForSearch
+ lastStringToReplace lastReplaceIgnoredCase lastReplaceWasMatch|
+
+ lastStringToReplace := lastReplacementInfo lastStringToReplace.
+ lastStringToReplace isNil ifTrue:[
+ ^ false
+ ].
+ lastReplaceIgnoredCase := lastReplacementInfo lastReplaceIgnoredCase.
+ lastReplaceWasMatch := lastReplacementInfo lastReplaceWasMatch.
+
+ self undoableDo:[
+ s := lastStringToReplace asString.
+ "remove final cr"
+ (s endsWith:Character cr) ifTrue:[s := s copyButLast:1].
+ "/ s := s withoutSpaces. "XXX - replacing text with spaces ..."
+
+ "set lastStringToReplace as the next search string
+ and set lastReplaceIgnoredCase as the next search ignored case flag"
+ lastStringFromReplaceForNextSearch := s.
+ lastSearchIgnoredCase := lastReplaceIgnoredCase.
+
+ savedSelectStyle := selectStyle.
+ selectStyle := nil.
+
+ sel := self selection.
+
+ "if we are already there (after a find), ommit search"
+
+ (sel notNil and:[sel asString withoutSeparators = s]) ifTrue:[
+ l := selectionStartLine "cursorLine".
+ c := selectionStartCol "cursorCol".
+ self deleteSelection.
+ lastReplacementInfo lastReplacement notNil ifTrue:[
+ self insertLines:lastReplacementInfo lastReplacement asStringCollection withCR:false.
+ self selectFromLine:l col:c toLine:cursorLine col:(cursorCol - 1).
+ typeOfSelection := #paste
+ ].
+ selectStyle := savedSelectStyle.
+ ^ true
+ ].
+
+ sel isEmptyOrNil ifTrue:[
+ startColForSearch := cursorCol - 1
+ ] ifFalse:[
+ startColForSearch := selectionEndCol ? (cursorCol - 1)
+ ].
+ self
+ searchForwardFor:s
+ ignoreCase: lastReplaceIgnoredCase
+ match: lastReplaceWasMatch
+ startingAtLine:cursorLine col:startColForSearch
+ ifFound:
+ [
+ :line :col |
+
+ |repl|
+
+ self selectFromLine:line col:col
+ toLine:line col:(col + s size - 1).
+ self makeLineVisible:line.
+
+ self deleteSelection.
+ lastReplacementInfo lastReplacement notNil ifTrue:[
+ lastReplacementInfo lastReplacement isString ifFalse:[
+ repl := lastReplacementInfo lastReplacement asString "withoutSpaces"
+ ] ifTrue:[
+ repl := lastReplacementInfo lastReplacement "withoutSpaces".
+ ].
+ self insertLines:repl asStringCollection withCR:false.
+ self selectFromLine:line col:col toLine:cursorLine col:(cursorCol - 1).
+ undoSupport actionInfo:'replace'.
+ ].
+ selectStyle := savedSelectStyle.
+ typeOfSelection := #paste.
+ ^ true
+ ]
+ ifAbsent:
+ [
+ self sensor compressKeyPressEventsWithKey:#Again.
+ self showNotFound.
+ selectStyle := savedSelectStyle.
+ ^ false
+ ].
+ ].
+
+ ^ true.
+
+ "Modified: 9.10.1996 / 16:14:11 / cg"
+!
+
+hasRedoAction
+ ^ undoSupport hasRedoAction.
+!
+
+hasUndoAction
+ ^ undoSupport hasUndoAction.
+!
+
+multipleAgain
+ "repeat the last action (which was a cut or replace) until search fails"
+
+ [self again] whileTrue:[]
+!
+
+nonUndoableDo:aBlock
+ undoSupport nonUndoableDo:aBlock.
+!
+
+redo
+ "undo the last undo"
+
+ undoSupport hasRedoAction ifFalse:[
+ self beep
+ ] ifTrue:[
+ undoSupport redo.
+ ]
+!
+
+undo
+ "undo the last edit operation"
+
+ undoSupport hasUndoAction ifFalse:[
+ self beep
+ ] ifTrue:[
+ undoSupport undo.
+ ]
+!
+
+undoableDo:aBlock
+ self undoableDo:aBlock info:nil.
+
+ "Modified: / 28-07-2007 / 13:20:14 / cg"
+!
+
+undoableDo:aBlock info:aString
+ self checkModificationsAllowed ifFalse:[
+ "/ will trigger an error-dialog there (no need for undo-carekeeping)
+ aBlock value.
+ ] ifTrue:[
+ undoSupport undoableDo:aBlock info:aString.
+ ].
+
+ "Modified: / 28-07-2007 / 13:21:00 / cg"
+! !
+
+!EditTextView::EditAction class methodsFor:'instance creation'!
+
+line1:arg1 col1:arg2 line2:arg3 col2:arg4
+ ^ self new line1:arg1 col1:arg2 line2:arg3 col2:arg4
+!
+
+line1:arg1 col1:arg2 line2:arg3 col2:arg4 info:info
+ ^ (self new line1:arg1 col1:arg2 line2:arg3 col2:arg4) info:info
+!
+
+line:arg1 col:arg2 character:arg3
+ ^ self new line:arg1 col:arg2 character:arg3
+!
+
+line:arg1 col:arg2 character:arg3 info:info
+ ^ (self new line:arg1 col:arg2 character:arg3) info:info
+!
+
+line:arg1 col:arg2 characters:arg3 info:info
+ ^ (self new line:arg1 col:arg2 characters:arg3) info:info
+!
+
+line:arg1 col:arg2 info:arg3
+ ^ self new line:arg1 col:arg2 info:arg3
+!
+
+line:arg1 col:arg2 string:arg3
+ ^ self new line:arg1 col:arg2 string:arg3
+!
+
+line:arg1 col:arg2 string:arg3 info:info
+ ^ (self new line:arg1 col:arg2 string:arg3) info:info
+!
+
+line:arg1 string:arg3 info:info
+ ^ (self new line:arg1 string:arg3) info:info
+!
+
+text:arg info:info
+ ^ (self new text:arg) info:info
+! !
+
+!EditTextView::EditAction methodsFor:'accessing'!
+
+info
+ ^ userFriendlyInfo
+!
+
+info:aString
+ userFriendlyInfo := aString
+! !
+
+!EditTextView::EditAction methodsFor:'combining'!
+
+canCombineWithPreviousPasteStringAction: aPasteStringAction
+ ^ false.
+
+ "Created: / 25-09-2006 / 12:16:25 / cg"
+! !
+
+!EditTextView::EditAction methodsFor:'queries'!
+
+canCombineWithNext:nextAction
+ ^ false
+! !
+
+!EditTextView::DeleteRange methodsFor:'accessing'!
+
+line1:line1Arg col1:col1Arg line2:line2Arg col2:col2Arg
+ "set instance variables (automatically generated)"
+
+ self assert:(line1Arg notNil).
+ self assert:(col1Arg notNil).
+ self assert:(line2Arg notNil).
+ self assert:(col2Arg notNil).
+
+ line1 := line1Arg.
+ col1 := col1Arg.
+ line2 := line2Arg.
+ col2 := col2Arg.
+! !
+
+!EditTextView::DeleteRange methodsFor:'execution'!
+
+executeIn:editor
+ editor unselect.
+ editor
+ deleteFromLine:line1
+ col:col1
+ toLine:line2
+ col:col2.
+ editor cursorLine:line1 col:col1.
+! !
+
+!EditTextView::DeleteCharacters methodsFor:'accessing'!
+
+col1
+ ^ col1
+!
+
+col2
+ ^ col2
+!
+
+line
+ ^ line
+!
+
+line:lineArg col1:col1Arg col2:col2Arg
+ "set instance variables (automatically generated)"
+
+ self assert:(lineArg notNil).
+ self assert:(col1Arg notNil).
+ self assert:(col2Arg notNil).
+
+ line := lineArg.
+ col1 := col1Arg.
+ col2 := col2Arg.
+!
+
+line:lineArg col:colArg info:infoArg
+ self assert:(lineArg notNil).
+ self assert:(colArg notNil).
+
+ line := lineArg.
+ col1 := col2 := colArg.
+ self info:infoArg.
+! !
+
+!EditTextView::DeleteCharacters methodsFor:'combining'!
+
+canCombineWithNext:anotherAction
+ ^ anotherAction perform:#canCombineWithPreviousDeleteCharactersAction: with:self ifNotUnderstood:false
+!
+
+canCombineWithPreviousDeleteCharactersAction:previousDeleteAction
+ "I will combine only if we both are single character deletes,
+ and my col-to-delete is the next after anotherDeleteActions col-to-delete.
+ (i.e. single-character typing)"
+
+ previousDeleteAction line == line ifTrue:[
+ previousDeleteAction col2 == (col1-1) ifTrue:[
+ ^ true
+ ].
+ ].
+
+ ^ false
+!
+
+combineWithNext:nextDeleteAction
+ self assert:(line == nextDeleteAction line).
+ self assert:(col2 == (nextDeleteAction col1 - 1)).
+
+ col2 := nextDeleteAction col2.
+ userFriendlyInfo := 'insert ' , (col2 - col1 + 1) printString
+! !
+
+!EditTextView::DeleteCharacters methodsFor:'execution'!
+
+executeIn:editor
+ editor unselect.
+ editor
+ deleteFromLine:line
+ col:col1
+ toLine:line
+ col:col2.
+ editor cursorLine:line col:col1.
+! !
+
+!EditTextView::EditMode class methodsFor:'constants'!
+
+insertAndSelectMode
+ ^ InsertAndSelectMode
+!
+
+insertMode
+ ^ InsertMode
+!
+
+overwriteMode
+ ^ OverwriteMode
+! !
+
+!EditTextView::EditMode class methodsFor:'queries'!
+
+isInsertAndSelectMode
+ ^ false
+!
+
+isInsertMode
+ ^ false
+!
+
+symbolicName
+ self subclassResponsibility
+! !
+
+!EditTextView::EditMode::InsertAndSelectMode class methodsFor:'info'!
+
+infoPrintString
+ ^ 'IS'
+! !
+
+!EditTextView::EditMode::InsertAndSelectMode class methodsFor:'queries'!
+
+isInsertAndSelectMode
+ ^ true
+!
+
+isInsertMode
+ ^ true
+! !
+
+!EditTextView::EditMode::InsertMode class methodsFor:'info'!
+
+infoPrintString
+ ^ 'I'
+! !
+
+!EditTextView::EditMode::InsertMode class methodsFor:'queries'!
+
+isInsertMode
+ ^ true
+! !
+
+!EditTextView::EditMode::OverwriteMode class methodsFor:'info'!
+
+infoPrintString
+ ^ 'O'
+! !
+
+!EditTextView::LastReplacementInfo methodsFor:'accessing'!
+
+lastReplaceIgnoredCase
+ ^ lastReplaceIgnoredCase ? false
+!
+
+lastReplaceIgnoredCase:something
+ lastReplaceIgnoredCase := something.
+!
+
+lastReplaceWasMatch
+ ^ lastReplaceWasMatch ? false
+!
+
+lastReplaceWasMatch:something
+ lastReplaceWasMatch := something.
+!
+
+lastReplacement
+ ^ lastReplacement
+!
+
+lastReplacement:something
+"/Transcript showCR: 'lastReplacement:', something printString.
+ lastReplacement := something.
+!
+
+lastStringToReplace
+ ^ lastStringToReplace
+!
+
+lastStringToReplace:something
+ lastStringToReplace := something.
+!
+
+previousReplacements
+ ^ previousReplacements ? #()
+!
+
+stillCollectingInput
+ ^ stillCollectingInput
+!
+
+stillCollectingInput:aBoolean
+ stillCollectingInput := aBoolean.
+! !
+
+!EditTextView::LastReplacementInfo methodsFor:'history'!
+
+rememberReplacement
+ "remember the previous replacement (called when a new one appears).
+ Mostly for the benefit of the code completion..."
+
+ |oldString newString|
+
+ oldString := lastStringToReplace.
+ newString := lastReplacement.
+ (oldString notEmptyOrNil and:[newString notEmptyOrNil]) ifTrue:[
+ previousReplacements isNil ifTrue:[
+ previousReplacements := OrderedCollection new.
+ ].
+ previousReplacements := previousReplacements reject:[:entry | entry key = oldString].
+ previousReplacements addFirst:(oldString -> newString).
+ previousReplacements size > 20 ifTrue:[
+ previousReplacements removeLast.
+ ]
+ ].
+! !
+
+!EditTextView::PasteString methodsFor:'accessing'!
+
+col
+ ^ col
+
+ "Created: / 25-09-2006 / 12:19:59 / cg"
+!
+
+col2
+ ^ col + string size - 1
+
+ "Created: / 25-09-2006 / 12:20:18 / cg"
+!
+
+line
+ ^ line
+
+ "Created: / 25-09-2006 / 12:21:08 / cg"
+!
+
+line:lineArg col:colArg string:stringArg
+ self assert:(lineArg notNil).
+ self assert:(colArg notNil).
+ self assert:(stringArg notNil).
+
+ line := lineArg.
+ col := colArg.
+ string := stringArg.
+!
+
+line:lineArg col:colArg string:stringArg selected:selectedArg
+ self assert:(lineArg notNil).
+ self assert:(colArg notNil).
+ self assert:(stringArg notNil).
+
+ line := lineArg.
+ col := colArg.
+ string := stringArg.
+ selected := selectedArg.
+!
+
+string
+ ^ string
+
+ "Created: / 25-09-2006 / 12:25:59 / cg"
+! !
+
+!EditTextView::PasteString methodsFor:'combining'!
+
+canCombineWithNext:anotherAction
+ ^ anotherAction canCombineWithPreviousPasteStringAction:self
+
+ "Created: / 25-09-2006 / 12:15:59 / cg"
+!
+
+canCombineWithPreviousPasteStringAction: previousPasteAction
+ "I will combine only if we both are single character inserts,
+ and my col-to-insert is the next after anotherInsertActions end-col.
+ (i.e. single-character deletes)"
+
+ previousPasteAction line == line ifTrue:[
+ previousPasteAction col == (self col2+1) ifTrue:[
+ ^ true
+ ].
+ ].
+
+ ^ false
+
+ "Modified: / 25-09-2006 / 12:22:21 / cg"
+!
+
+combineWithNext:nextPasteAction
+ |s1 s2|
+
+ self assert:(line == nextPasteAction line).
+ self assert:((col - 1) == (nextPasteAction col2)).
+
+ s1 := nextPasteAction string.
+ s1 isString ifFalse:[s1 := s1 asStringWith:nil].
+ s2 := string.
+ s2 isString ifFalse:[s2 := s2 asStringWith:nil].
+
+ string := s1, s2.
+ col := nextPasteAction col.
+ userFriendlyInfo := 'delete ' , string size printString
+
+ "Created: / 25-09-2006 / 12:24:10 / cg"
+! !
+
+!EditTextView::PasteString methodsFor:'execution'!
+
+executeIn:editor
+ editor cursorLine:line col:col.
+ editor paste:string.
+ selected ~~ true ifTrue:[
+ editor unselect
+ ].
+! !
+
+!EditTextView::ReplaceCharacter methodsFor:'accessing'!
+
+col
+ ^ col
+!
+
+col1
+ ^ col
+!
+
+col2
+ ^ col
+!
+
+line
+ ^ line
+!
+
+line:lineArg col:colArg character:characterArg
+ line := lineArg.
+ col := colArg.
+ character := characterArg.
+! !
+
+!EditTextView::ReplaceCharacter methodsFor:'execution'!
+
+executeIn:editor
+ editor
+ replace:character
+ atLine:line
+ col:col.
+ editor cursorLine:line col:col.
+! !
+
+!EditTextView::ReplaceCharacters methodsFor:'accessing'!
+
+characters
+ ^ characters
+!
+
+col1
+ ^ col1
+!
+
+col2
+ ^ col2
+!
+
+line
+ ^ line
+!
+
+line:lineArg col:colArg character:characterArg
+ line := lineArg.
+ col1 := col2 := colArg.
+ characters := characterArg asString.
+!
+
+line:lineArg col:colArg characters:charactersArg
+ line := lineArg.
+ col1 := colArg.
+ characters := charactersArg asString.
+ col2 := col1 + charactersArg size - 1
+! !
+
+!EditTextView::ReplaceCharacters methodsFor:'combining'!
+
+canCombineWithNext:anotherAction
+ ^ anotherAction perform:#canCombineWithPreviousReplaceCharactersAction: with:self ifNotUnderstood:false
+!
+
+canCombineWithPreviousReplaceCharactersAction:previousReplaceAction
+ "I will combine only if we both are single character deletes,
+ and my col-to-delete is the next after anotherDeleteActions col-to-delete.
+ (i.e. single-character typing)"
+
+ previousReplaceAction line == line ifTrue:[
+ previousReplaceAction col2 == (col1-1) ifTrue:[
+ ^ true
+ ].
+ ].
+
+ ^ false
+!
+
+combineWithNext:nextReplaceAction
+ self assert:(line == nextReplaceAction line).
+ self assert:(self col2 == (nextReplaceAction col1 - 1)).
+
+ col2 := nextReplaceAction col2.
+ userFriendlyInfo := 'replace ' , (col2 - col1 + 1) printString.
+ characters := characters , nextReplaceAction characters.
+! !
+
+!EditTextView::ReplaceCharacters methodsFor:'execution'!
+
+executeIn:editor
+ editor
+ replaceString:characters
+ atLine:line
+ col:col1.
+ editor cursorLine:line col:col1.
+! !
+
+!EditTextView::ReplaceContents methodsFor:'accessing'!
+
+text:something
+ text := something.
+! !
+
+!EditTextView::ReplaceContents methodsFor:'execution'!
+
+executeIn:editor
+ editor contents:text
+! !
+
+!EditTextView::ReplaceLine methodsFor:'accessing'!
+
+line:lineArg string:stringArg
+ line := lineArg.
+ text := stringArg.
+! !
+
+!EditTextView::ReplaceLine methodsFor:'execution'!
+
+executeIn:editor
+ editor list at:line put:text.
+ editor invalidateLine:line
+! !
+
+!EditTextView::ReplaceLines methodsFor:'accessing'!
+
+line:lineArg lines:lineCollectionArg
+ line := lineArg.
+ text := lineCollectionArg.
+
+ "Created: / 09-10-2006 / 10:35:22 / cg"
+! !
+
+!EditTextView::ReplaceLines methodsFor:'execution'!
+
+executeIn:editor
+ |lnr|
+
+ lnr := line.
+ text do:[:eachLine |
+ editor list at:lnr put:eachLine.
+ editor invalidateLine:lnr.
+ lnr := lnr + 1.
+ ].
+
+ "Modified: / 09-10-2006 / 10:39:16 / cg"
+! !
+
+!EditTextView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.604.2.1 2014-05-08 08:30:56 stefan Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.604.2.1 2014-05-08 08:30:56 stefan Exp $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ListView.st Thu May 08 10:30:56 2014 +0200
@@ -0,0 +1,5278 @@
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+'From Smalltalk/X, Version:6.2.3.0 on 08-05-2014 at 10:09:59' !
+
+"{ Package: 'stx:libwidg' }"
+
+View subclass:#ListView
+ instanceVariableNames:'list firstLineShown nFullLinesShown nLinesShown fgColor bgColor
+ partialLines leftMargin topMargin textStartLeft textStartTop
+ innerWidth tabPositions lineSpacing fontHeight fontAscent
+ fontIsFixedWidth fontWidth autoScroll autoScrollBlock
+ autoScrollDeltaT wordCheck includesNonStrings widthOfWidestLine
+ listMsg viewOrigin listChannel backgroundAlreadyClearedColor
+ scrollWhenUpdating scrollLocked lineEndCRLF highlightAreas
+ compareModelOnUpdate expandTabsWhenUpdating
+ checkLineEndConventionWhenUpdating
+ checkedLinesForWidthOfContentsComputation'
+ classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultTabPositions
+ UserDefaultTabPositions DefaultLeftMargin DefaultTopMargin'
+ poolDictionaries:''
+ category:'Views-Text'
+!
+
+Object subclass:#HighlightArea
+ instanceVariableNames:'startLine startCol endLine endCol fgColor bgColor'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ListView
+!
+
+Object subclass:#SearchSpec
+ instanceVariableNames:'pattern match ignoreCase variable fullWord forward'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ListView
+!
+
+!ListView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ a View for (string-)lists.
+
+ This class can only passively display collections of strings,
+ text or display objects which behave line-like (i.e. all have constant height).
+
+ Selections, editing, cursors etc. must be implemented in subclasses.
+ (see SelectionInListView, TextView etc.)
+
+ This code currently handles only fixed-height fonts correctly -
+ it should be rewritten in some places to not compute the position/height from
+ the view's font height, but by accumulating line heights...
+
+ It can only scroll by full lines vertically (i.e. setting firstLineShown to ~~ 1)
+ which should be changed to have this behavior optionally for smooth scroll.
+
+ The text is internally kept in the 'list' instance variable, and is supposed to consist
+ of a collection (Ordered- or StringCollection) of line entries.
+ Typically, individual entries are either strings/text or nil (for empty lines).
+ However, ANY object which supports the displayOn: and widthIn: protocol can be
+ used - see MultipleColumnListEntry as an example.
+ Therefore, ListView (and all subclasses) are prepared to handle non-string entries
+ (especially: attributed Text and labelAndIcon-like entities).
+
+ The internal version of the text has tabulators expanded to blanks. ListView is not prepared
+ to deal with them. When text is exchanged with an external medium (i.e. reading/writing files),
+ these are expanded/compressed assuming a tab-setting of 8.
+ This is done independent of the user's tab setting, which is used ONLY for positioning,
+ while the text is edited.
+ Thus, even if the tab setting is multiple of 4's, tabs are
+ written in multiples of 8 when the text is saved. Since this is the default on all ascii
+ terminals and printers, this assures that the text looks correctly indented when finally printed.
+
+ Notice:
+ -------
+ ListView is one of the OLDEST widget classes in the system and definitely requires a major rewrite:
+
+ Due to historic reasons (ListView implemented scrolling before the general
+ scrolling code in View was added), this one does scrolling different from all other
+ views. The general scrolling code (in View) uses the transformation for transparent scrolling
+ using the viewOrigin (transparent means, that the code does not need to know - it simply draws
+ as if all of the text was visible).
+ Here in ListView, the transformation is not used, instead it is done again, and different,
+ by keeping the firstLineShown (i.e. vertical offset) and leftOffset (horizontal offset).
+ Even worse: the firstLineShown is a line-index, the most annoying consequence of this is that
+ scrolling is done by lines here, whereas it is done in pixels in the View class.
+ Thus, be very careful, when changing things (better: don't touch it ;-).
+ Also, the viewOrigin variable is only valid for the x coordinate. The viewOrigin's y is always 0 !!
+
+ Also, all controller functionality is completely performed by the listView
+ (and subclasses) itself. It is still possible, to define and set a specialized
+ controller, though. I.e. if you like to change the input behavior, define
+ a corresponding controller class and intersect the keyXXX/buttonXXX messages
+ there.
+
+ This may be totally rewritten ... so don't depend on the internals; especially the scrolling
+ code will be totally removed here and the inherited functionality be used in the next version.
+
+ Also Notice:
+ ------------
+ because ListView was written at a time when most of the graphics was done via remote connections
+ (X-window network protocol), it is highly tuned to avoid redraw operations. Thus, it can be used
+ happily over a slow WLAN (say: 64kBit connection).
+ In that, it performed *much* better than other widgets, especialy Java and Qt, some of which are
+ hardly usable via the network.
+ It may be questionable whether this is still a requirement these days, where network connections
+ are usually pretty fast. However, the author insists on this to remain as it is!!
+ Future underlying graphics may well become network dependent in the future, for example, when
+ the display connection is implemented as an RPC into a web browser...
+
+
+ Also Notice:
+ ------------
+ ListView shall be configurable to avoid accesses to its underlying list if required.
+ Currently, it can be customized to disable lineWidth computation, tab expansion and scanning for
+ non-string entries. All of which is required when huge texts which are not in memory are to be displayed
+ (for example: a virtual array of 10million text lines). Please be careful to not reintroduce such
+ code when adding features (as happened in the past).
+
+
+ [Instance variables:]
+
+ list <aCollection> the text strings, a collection of lines.
+ Nils may be used for empty lines.
+
+ firstLineShown <Number> the index of the 1st visible line (1 ..)
+ leftOffset <Number> left offset for horizontal scroll
+
+ nFullLinesShown <Number> the number of unclipped lines in visible area
+ (internal; updated on size changes)
+ nLinesShown <Number> the number of lines in visible area, incl. partial
+ (internal; updated on size changes)
+
+ fgColor <Color> color to draw characters
+ bgColor <Color> the background
+
+ partialLines <Boolean> allow last line to be partial displayed
+ leftMargin <Number> margin at left in pixels
+ topMargin <Number> margin at top in pixels
+ textStartLeft <Number> margin + leftMargin (internal)
+ textStartTop <Number> margin + topMargin (internal)
+ innerWidth <Number> width - margins (internal)
+ tabPositions <aCollection> tab stops (cols)
+ fontHeight <Number> font height in pixels (internal)
+ fontAscent <Number> font ascent in pixels (internal)
+ fontIsFixed <Boolean> true if its a fixed font (internal)
+ fontWidth <Number> width of space (internal)
+ lineSpacing <Number> pixels between lines
+ lastSearchPattern <String> last pattern for searching
+ (kept to provide a default for next search)
+ lastSearchIgnoredCase <Boolean> last search ignored case
+ (kept to provide a default for next search)
+ wordCheck <Block> rule used for check for word boundaries in word select
+ The default rule is to return true for alphaNumeric characters.
+ (can be changed to allow for underscore and other
+ characters to be treated as alphaCharacters)
+
+ autoScrollBlock <Block> block installed as timeoutBlock when doing an
+ autoScroll (internal)
+ autoScrollDeltaT computed scroll time delta in seconds (internal)
+
+ includesNonStrings cached flag if any non-strings are in list
+ widthOfWidestLine cached width of widest line
+ listMsg if view has a model and listMsg is non-nil,
+ this is sent to the model to aquired a new contents
+ whenever a change of the aspect (aspectMsg) occurs.
+
+ viewOrigin the current origin
+
+ backgroundAlreadyClearedColor internal; speedup by avoiding
+ multiple fills when drawing
+ internal lines
+
+ scrollWhenUpdating
+ <Symbol> defines how the view is scrolled if the
+ model changes its value by some outside activity
+ (i.e. not by user input).
+ Can be one of:
+ #keep / nil -> stay unchanged
+ #endOfText -> scroll to the end
+ #beginOfText -> scroll to the top
+ The default is #beginOfText (i.e. scroll to top).
+
+ [StyleSheet parameters:]
+
+ textForegroundColor defaults to Black
+ textBackgroundColor defaults to White
+ textFont defaults to defaultFont
+ textTabPositions defaults to #(1 9 17 25 ...)
+
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ TextView EditTextView
+
+"
+!
+
+examples
+"
+ ListViews alone are rarely used - its mostly an abstract superclass
+ for TextView, EditTextView and SelectionInListView.
+
+ anyway, here are a few examples:
+
+ basic simple setup:
+ [exBegin]
+ |top l|
+
+ top := StandardSystemView new.
+ top extent:100@200.
+
+ l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
+ l list:#('one' 'two' 'three').
+
+ top open
+ [exEnd]
+
+
+
+ specifying textMargins (these have NOTHING to do with the viewInset):
+ [exBegin]
+ |top l|
+
+ top := StandardSystemView new.
+ top extent:100@200.
+
+ l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
+ l list:#('one' 'two' 'three').
+ l topMargin:10.
+ l leftMargin:20.
+
+ top open
+ [exEnd]
+
+
+
+ globally set the fg/bg colors:
+ [exBegin]
+ |top l|
+
+ top := StandardSystemView new.
+ top extent:100@200.
+
+ l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
+ l list:#('one' 'two' 'three').
+ l foregroundColor:(Color white).
+ l backgroundColor:(Color blue).
+
+ top open
+ [exEnd]
+
+
+
+ non-string (text) entries:
+ [exBegin]
+ |top list l|
+
+ top := StandardSystemView new.
+ top extent:100@200.
+
+ l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
+ list := #('all' 'of' 'your' 'preferred' 'colors')
+ with:#(red green blue 'orange' cyan)
+ collect:[:s :clr |
+ Text string:s
+ emphasis:(Array with:#bold
+ with:(#color->(Color name:clr))) ].
+ l list:list.
+
+ top open
+ [exEnd]
+
+
+
+ generic non-string entries:
+ (notice: ColoredListEntry is obsoleted by Text)
+ [exBegin]
+ |top list l|
+
+ top := StandardSystemView new.
+ top extent:100@200.
+
+ l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
+ list := #('all' 'of' 'your' 'preferred' 'colors')
+ with:#(red green blue 'orange' cyan)
+ collect:[:s :clr | ColoredListEntry string:s color:(Color name:clr) ].
+ l list:list.
+
+ top open
+ [exEnd]
+
+
+
+ using a model (default listMessage is aspectMessage):
+ [exBegin]
+ |top model l theModelsText|
+
+ model := Plug new.
+ model respondTo:#modelsAspect
+ with:[ theModelsText ].
+
+ top := StandardSystemView new.
+ top extent:100@200.
+
+ l := ListView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
+ l model:model.
+ l aspect:#modelsAspect.
+
+ top open.
+
+ Delay waitForSeconds:3.
+ theModelsText := #('foo' 'bar' 'baz').
+ model changed:#modelsAspect.
+ [exEnd]
+
+
+
+ using a model with different aspects
+ for two listViews:
+ [exBegin]
+ |top model l1 l2 plainText|
+
+ plainText := #('').
+
+ model := Plug new.
+ model respondTo:#modelsUppercaseText
+ with:[ plainText asStringCollection
+ collect:[:l | l asUppercase]].
+ model respondTo:#modelsLowercaseText
+ with:[ plainText asStringCollection
+ collect:[:l | l asLowercase]].
+
+ top := StandardSystemView extent:200@200.
+
+ l1 := ListView origin:0.0 @ 0.0 corner:1.0 @ 0.5 in:top.
+ l1 model:model.
+ l1 aspect:#modelsAspect.
+ l1 listMessage:#modelsUppercaseText.
+
+ l2 := ListView origin:0.0 @ 0.5 corner:1.0 @ 1.0 in:top.
+ l2 model:model.
+ l2 aspect:#modelsAspect.
+ l2 listMessage:#modelsLowercaseText.
+
+ top open.
+
+ Delay waitForSeconds:3.
+ plainText := #('foo' 'bar' 'baz').
+ model changed:#modelsAspect.
+ [exEnd]
+
+ using a big list (100000 lines),
+ wrapping in a ScrollableView:
+ [exBegin]
+ |bigList top lv|
+
+ bigList := (1 to:100000) collect:[:lineNr | 'List line Nr. ' , lineNr printString].
+ bigList at:10 put:('Some Text ' asText , 'with Bold part' allBold).
+ bigList at:20 put:('Some Text ' asText , 'with Italic part' allItalic).
+
+ top := StandardSystemView extent:200@200.
+
+ lv := HVScrollableView for:ListView in:top.
+ lv origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ lv list:bigList expandTabs:false scanForNonStrings:false includesNonStrings:false.
+
+ top open.
+ [exEnd]
+
+ using a huge virtual list (1 mio simulated lines),
+ wrapping in a ScrollableView:
+ [exBegin]
+ |virtualList top lv|
+
+ virtualList := Plug new.
+ virtualList inheritFrom:SequenceableCollection.
+ virtualList respondTo:#size with:[ 1000000 ].
+ virtualList respondTo:#at: with:[:lineNr | 'List line Nr. ' , lineNr printString ].
+
+ top := StandardSystemView extent:200@200.
+
+ lv := ScrollableView for:ListView in:top.
+ lv origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ lv list:virtualList expandTabs:false scanForNonStrings:false includesNonStrings:false.
+
+ top open.
+ [exEnd]
+
+
+ using a huge virtual array (1 mio simulated lines),
+ wrapping in a ScrollableView.
+ To simulate an expensive computation, a delay is planted into the line generator;
+ Startup and display of page full of lines should not take longer than the number of lines shown:
+ [exBegin]
+ |virtualList top lv|
+
+ virtualList := VirtualArray new.
+ virtualList
+ setSize:1000000;
+ generator:[:index | Transcript showCR:index.
+ Delay waitForSeconds:0.5.
+ '%1 -> %2' bindWith:index with:index squared].
+
+ top := StandardSystemView extent:200@200.
+
+ lv := ScrollableView for:ListView in:top.
+ lv origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+ lv expandTabsWhenUpdating:false.
+ lv checkLineEndConventionWhenUpdating:false.
+ lv checkedLinesForWidthOfContentsComputation:-1.
+ lv list:virtualList.
+
+ top open.
+ [exEnd]
+"
+! !
+
+!ListView class methodsFor:'defaults'!
+
+defaultTabPositions
+ "return an array containing the styleSheets default tab positions"
+
+ ^ DefaultTabPositions ? self tab4Positions
+!
+
+defaultTabPositions:aVector
+ "set the array containing the styleSheets tab positions"
+
+ DefaultTabPositions := aVector
+
+ "
+ ListView defaultTabPositions:(ListView tab4Positions)
+ "
+!
+
+tab4Positions
+ "return an array containing tab positions for 4-col tabs"
+
+ ^ #(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
+ "return an array containing tab positions for 8-col tabs"
+
+ ^ #(1 9 17 25 33 41 49 57 65 73 81 89 97 105 113 121 129 137 145)
+!
+
+updateStyleCache
+ "extract values from the styleSheet and cache them in class variables"
+
+ <resource: #style (#'text.foregroundColor' #'text.backgroundColor'
+ #'text.tabPositions'
+ #'text.font')>
+
+ DefaultForegroundColor := StyleSheet colorAt:'text.foregroundColor' default:Color black.
+ DefaultBackgroundColor := StyleSheet colorAt:'text.backgroundColor' default:Color white.
+ DefaultFont := StyleSheet fontAt:'text.font'.
+ DefaultTabPositions := StyleSheet at:'text.tabPositions'.
+ DefaultTabPositions isNil ifTrue:[DefaultTabPositions := self defaultTabPositions].
+ DefaultLeftMargin := 0.5.
+ DefaultTopMargin := 0.5.
+
+ "Modified: 20.10.1997 / 15:05:30 / cg"
+!
+
+userDefaultTabPositions
+ "return an array containing the users default tab positions"
+
+ ^ UserDefaultTabPositions
+!
+
+userDefaultTabPositions:aVector
+ "set the array containing the users tab positions"
+
+ UserDefaultTabPositions := aVector
+
+ "
+ self userDefaultTabPositions:(self tab4Positions)
+ "
+! !
+
+!ListView methodsFor:'accessing'!
+
+innerHeight
+ "return the number of pixels visible of the contents
+ - redefined since ListView adds another margin to start the text
+ somewhat to indented from the 3D border."
+
+ ^ height - (2 * margin) - topMargin
+! !
+
+!ListView methodsFor:'accessing-behavior'!
+
+checkLineEndConventionWhenUpdating
+ "return the line-end convention check when updating behavior.
+ If true (the default), the first line of the list given is checked for having a
+ cr-lf line end (which is a DOS convention), and the lineEndCRLF flag is set dynamically.
+ If false, the lineEndCRLF remains as specified by the user.
+ You may want to disable this flag if it is very expensive to generate a line
+ (although, only the very first line is checked, anyway)"
+
+ ^ checkLineEndConventionWhenUpdating
+!
+
+checkLineEndConventionWhenUpdating:aBoolean
+ "define the line-end convention check when updating behavior.
+ If true (the default), the first line of the list given is checked for having a
+ cr-lf line end (which is a DOS convention), and the lineEndCRLF flag is set dynamically.
+ If false, the lineEndCRLF remains as specified by the user.
+ You may want to disable this flag if it is very expensive to generate a line
+ (although, only the very first line is checked, anyway)"
+
+ checkLineEndConventionWhenUpdating := aBoolean
+!
+
+checkedLinesForWidthOfContentsComputation
+ "return which lines to consider in the widthOfContents computation,
+ which is needed by the scrollBar interface.
+ If nil (the default), all lines are processed and the width of the longest line is taken.
+ If positive, that number of lines is checked near the start of the text,
+ if negative, from the end of the text.
+ If 0, the width is dynamically re adjusted, as lines are drawn.
+ You may want to change this to 1 if it is guaranteed that all linesa are of the same width,
+ or -1, if all are shorter than the last line.
+ (useful, for example, when it is very expensive to generate all lines, and a huge number
+ of same-width lines is generated through a virtual array)"
+
+ ^ checkedLinesForWidthOfContentsComputation
+!
+
+checkedLinesForWidthOfContentsComputation:aNumberOrNil
+ "set which lines to consider in the widthOfContents computation,
+ which is needed by the scrollBar interface.
+ If nil (the default), all lines are processed and the width of the longest line is taken.
+ If positive, that number of lines is checked near the start of the text,
+ if negative, from the end of the text.
+ If 0, the width is dynamically re adjusted, as lines are drawn.
+ You may want to change this to 1 if it is guaranteed that all linesa are of the same width,
+ or -1, if all are shorter than the last line.
+ (useful, for example, when it is very expensive to generate all lines, and a huge number
+ of same-width lines is generated through a virtual array)"
+
+ checkedLinesForWidthOfContentsComputation := aNumberOrNil
+!
+
+compareModelWhenUpdating
+ "return the compare when updating behavior.
+ If true (the default), the list of lines as given due to a model update
+ is processed and compared against the currently shown text.
+ If they are the same, no action is taken.
+ This behavior is ok in 99.99% of all applications.
+ However, you may turn this off iff:
+ - it is very expensive to process the list (for example, because the list
+ is defined by a virtual array, which computes the lines dynamically, on
+ the fly).
+ One use where this flag should be turned off is in the hex-memory display,
+ which is able to simulate texts with millions of lines, but they are actually
+ simulated by generating the presented lines dynamically, as they are displayed."
+
+ ^ compareModelOnUpdate
+!
+
+compareModelWhenUpdating:aBoolean
+ "define the compare when updating behavior.
+ If true (the default), the list of lines as given due to a model update
+ is processed and compared against the currently shown text.
+ If they are the same, no action is taken.
+ This behavior is ok in 99.99% of all applications.
+ However, you may turn this off iff:
+ - it is very expensive to process the list (for example, because the list
+ is defined by a virtual array, which computes the lines dynamically, on
+ the fly).
+ One use where this flag should be turned off is in the hex-memory display,
+ which is able to simulate texts with millions of lines, but they are actually
+ simulated by generating the presented lines dynamically, as they are displayed."
+
+ compareModelOnUpdate := aBoolean
+!
+
+expandTabsWhenUpdating
+ "return the tab expansion behavior.
+ If true (the default), the list of lines as given via #list: or
+ due to a model update is processed and lines are replaced by lines with
+ tabs expanded.
+ This behavior is ok in 99.99% of all applications.
+ However, you may turn this off iff:
+ - you are certain, that no tabs are in the passed in list
+ - it is very expensive to process the list (for example, because the list
+ is defined by a virtual array, which computes the lines dynamically, on
+ the fly).
+ One use where this flag should be turned off is in the hex-memory display,
+ which is able to simulate texts with millions of lines, but they are actually
+ simulated by generating the presented lines dynamically, as they are displayed."
+
+ ^ expandTabsWhenUpdating
+!
+
+expandTabsWhenUpdating:aBoolean
+ "define the tab expansion behavior.
+ If true (the default), the list of lines as given via #list: or
+ due to a model update is processed and lines are replaced by lines with
+ tabs expanded.
+ This behavior is ok in 99.99% of all applications.
+ However, you may turn this off iff:
+ - you are certain, that no tabs are in the passed in list
+ - it is very expensive to process the list (for example, because the list
+ is defined by a virtual array, which computes the lines dynamically, on
+ the fly).
+ One use where this flag should be turned off is in the hex-memory display,
+ which is able to simulate texts with millions of lines, but they are actually
+ simulated by generating the presented lines dynamically, as they are displayed."
+
+ expandTabsWhenUpdating := aBoolean
+!
+
+lineEndCRLF
+ "answer true, if CRLF is used for the line end.
+ This is true for DOS/Windows files.
+ Otherwise 'Character cr' is the line end (which is LF in unix)"
+
+ ^ lineEndCRLF ? false
+
+ "Created: / 04-07-2006 / 19:05:01 / fm"
+!
+
+scrollWhenUpdating
+ "return the scroll behavior, when I get a new text
+ (via the model or the #contents/#list)
+ Possible returnValues are:
+ #keep / nil -> no change
+ #endOfText -> scroll to the end
+ #beginOfText -> scroll to the top
+ The default is #keep.
+ This may be useful for fields which get new values assigned from
+ the program (i.e. not from the user)"
+
+ ^ scrollWhenUpdating
+!
+
+scrollWhenUpdating:aSymbolOrNil
+ "define how to scroll, when I get a new text
+ (via the model or the #contents/#list)
+ Allowed arguments are:
+ #keep / nil -> no change
+ #endOfText -> scroll to the end
+ #beginOfText -> scroll to the top
+ The default is #keep.
+ This may be useful for fields which get new values assigned from
+ the program (i.e. not from the user)"
+
+ scrollWhenUpdating := aSymbolOrNil
+!
+
+wordCheckBlock:aBlock
+ "set the word-check block - this block is called with a character argument,
+ when the end/beginning of a word is searched.
+ It should return true, if the character belongs to the word.
+ The default block is set in #initialize, and returns true for alphanumeric
+ (national) characters.
+ Applications may change it to include underlines, dollars or other characters.
+ (a C/C++ editor would include underlines ...)"
+
+ wordCheck := aBlock.
+
+ "Modified: 22.5.1996 / 12:26:55 / cg"
+! !
+
+!ListView methodsFor:'accessing-contents'!
+
+add:aString
+ "add a line and redisplay"
+
+ |fontHeightBefore|
+
+ list isNil ifTrue:[list := OrderedCollection new].
+ list add:aString.
+
+ includesNonStrings ifFalse:[
+ includesNonStrings := (aString notNil and:[(aString isMemberOf:String) not]).
+ includesNonStrings ifTrue:[
+ fontHeightBefore := fontHeight.
+ self getFontParameters.
+ fontHeightBefore ~~ fontHeight ifTrue:[
+ self invalidate
+ ].
+ ].
+ ].
+
+ widthOfWidestLine notNil ifTrue:[
+ self recomputeWidthOfWidestLineFor:aString old:nil.
+ ].
+
+ shown ifTrue:[
+ self redrawLine:(self size).
+ ].
+ self enqueueDelayedContentsChangedNotification. "recompute scrollbars"
+
+ "Modified: / 25-07-2012 / 12:00:20 / cg"
+!
+
+add:aString beforeIndex:index
+ "add a line and redisplay"
+
+ |lastShown|
+
+ list isNil ifTrue:[list := OrderedCollection new].
+ list add:aString beforeIndex:index.
+
+ widthOfWidestLine notNil ifTrue:[
+ self recomputeWidthOfWidestLineFor:aString old:nil.
+ ].
+
+ includesNonStrings ifFalse:[
+ includesNonStrings := (aString notNil and:[(aString isMemberOf:String) not]).
+"/ includesNonStrings ifTrue:[self getFontParameters].
+ ].
+ shown ifTrue:[
+ lastShown := self lastLineShown.
+ index <= 2 ifTrue:[
+ self invalidate
+ ] ifFalse:[
+ index to:lastShown do:[:eachLine |
+ self invalidateLine:eachLine
+ ].
+ ].
+ ].
+ self enqueueDelayedContentsChangedNotification. "recompute scrollbars"
+
+ (scrollWhenUpdating == #end or:[scrollWhenUpdating == #endOfText]) ifTrue:[
+ "/ self selection isNil ifTrue:[
+ self scrollToBottom.
+ "/ ]
+ ].
+
+ "Modified: / 25-07-2012 / 12:00:42 / cg"
+!
+
+addAll:aCollectionOfLines beforeIndex:index
+ "add a bunch of lines and redisplay"
+
+ |lastShown|
+
+ list isNil ifTrue:[list := OrderedCollection new].
+ aCollectionOfLines do:[:eachLine |
+ list addAll:aCollectionOfLines beforeIndex:index.
+ ].
+ includesNonStrings ifFalse:[
+ includesNonStrings :=
+ aCollectionOfLines
+ contains:[:someLine |
+ someLine notNil and:[(someLine isMemberOf:String) not].
+ ]
+ ].
+
+ widthOfWidestLine notNil ifTrue:[
+ aCollectionOfLines do:[:eachLine |
+ self recomputeWidthOfWidestLineFor:eachLine old:nil.
+ ].
+ ].
+"/ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+
+ shown ifTrue:[
+ lastShown := self lastLineShown.
+ ((index-1) <= lastShown) ifTrue:[
+ index <= 2 ifTrue:[
+ self invalidate
+ ] ifFalse:[
+ index-1 to:lastShown do:[:eachLine |
+ self invalidateLine:eachLine
+ ].
+ "/ self redrawFromLine:index-1.
+ ].
+ ].
+ ].
+ self enqueueDelayedContentsChangedNotification. "recompute scrollbars"
+
+ (scrollWhenUpdating == #end or:[scrollWhenUpdating == #endOfText]) ifTrue:[
+ "/ self selection isNil ifTrue:[
+ self scrollToBottom.
+ "/ ]
+ ].
+
+ "Modified: / 25-07-2012 / 12:00:54 / cg"
+!
+
+at:lineNr
+ "retrieve a line; return nil if beyond end-of-text.
+ this allows textViews to be used like collections in some places."
+
+ list isNil ifTrue:[^ nil].
+ (lineNr between:1 and:self size) ifFalse:[^ nil].
+ ^ list at:lineNr
+!
+
+at:index put:aString
+ "change a line and redisplay"
+
+ |fontHeightBefore widthBefore|
+
+ fontHeightBefore := fontHeight.
+ widthBefore := widthOfWidestLine.
+ self withoutRedrawAt:index put:aString.
+
+ shown ifTrue:[
+ fontHeightBefore ~= fontHeight ifTrue:[
+ "/ must redraw everything
+ self invalidate.
+ ^ self
+ ].
+ self redrawLine:index.
+
+"/ the code below is wrong - we really have to redraw everything, if the
+"/ fontHeight changes (due to a labelAndIcon in the list).
+
+
+"/ "/ this could have changed the font height;
+"/ "/ must clear all below last line, if it became smaller
+"/ fontHeightBefore > fontHeight ifTrue:[
+"/ (self listLineIsVisible:(self size)) ifTrue:[
+"/ self clearRectangle:(margin @ (self yOfVisibleLine:nLinesShown+1))
+"/ corner:(width-margin) @ (height-margin).
+"/ ].
+"/ self redrawFromLine:index
+"/ ] ifFalse:[
+"/ self redrawLine:index
+"/ ].
+
+ "/ asynchronous:
+"/ visibleLine := self listLineToVisibleLine:index.
+"/ visibleLine notNil ifTrue:[
+"/ y := self yOfVisibleLine:visibleLine.
+"/ self invalidate:((margin @ y) extent:(width@fontHeight))
+"/ ].
+
+ widthBefore ~~ widthOfWidestLine ifTrue:[
+ self enqueueDelayedContentsChangedNotification
+ ]
+ ]
+
+ "Modified: / 25-07-2012 / 12:01:46 / cg"
+!
+
+characterAtCharacterPosition:charPos
+ "return the character at a 1-based character position.
+ Return a space character if nothing is there
+ (i.e. beyond the end of the line or below the last line)"
+
+ |line col|
+
+ line := self lineOfCharacterPosition:charPos.
+ col := charPos - (self characterPositionOfLine:line col:1) + 1.
+ col == 0 ifTrue:[^ Character cr].
+ ^ self characterAtLine:line col:col
+!
+
+characterAtLine:lineNr col:colNr
+ "return the character at physical line/col.
+ The lineNr and colNr arguments start at 1, for the top-left cgaracter.
+ Return a space character if nothing is there
+ (i.e. beyond the end of the line or below the last line)"
+
+ |line|
+
+ list notNil ifTrue:[
+ line := self listAt:lineNr.
+ line notNil ifTrue:[
+ (line size >= colNr) ifTrue:[
+ ^ line at:colNr
+ ]
+ ]
+ ].
+ ^ Character space
+
+ "Created: 29.4.1996 / 12:11:00 / cg"
+ "Modified: 29.4.1996 / 12:12:41 / cg"
+!
+
+contents
+ "return the contents as a string, terminated by the line end character (sequence)"
+
+ |stringCollection lineEnd|
+
+ list isNil ifTrue:[^ ''].
+
+ self lineEndCRLF ifTrue:[
+ lineEnd := String crlf.
+ ] ifFalse:[
+ lineEnd := Character cr.
+ ].
+
+ stringCollection := list asStringCollection.
+ ^ stringCollection
+ asStringWith:lineEnd
+ from:1 to:stringCollection size
+ compressTabs:false
+ final:lineEnd
+
+ "Modified: / 04-07-2006 / 19:18:47 / fm"
+!
+
+contents:something
+ "set the contents (either a String or a Collection of strings)
+ also scroll to top. See #setContents:, which does not scroll.
+ If the argument is a string, it is converted
+ to a collection of line-strings here."
+
+ |l|
+
+ l := something.
+ l notNil ifTrue:[
+ l isString ifTrue:[
+ l := l asStringCollection
+ ]
+ ].
+ self list:l
+
+ "Modified: 5.6.1997 / 11:11:54 / cg"
+!
+
+from:from to:to do:aBlock
+ "evaluate aBlock on some of my lines"
+
+ list from:from to:to do:aBlock.
+!
+
+grow:n
+ "grow our list"
+
+ ^ list grow:n.
+!
+
+lineAtY:y
+ "return the lineNr for a given y-(view-)coordinate"
+
+ |visibleLine|
+
+ visibleLine := self visibleLineOfY:y.
+ visibleLine isNil ifTrue:[^ nil].
+ ^ self visibleLineToListLine:visibleLine.
+!
+
+list
+ "return the contents as a collection of strings.
+ This returns the views internal list - modifying it may confuse
+ the listView."
+
+ ^ list
+
+ "Modified: 5.6.1997 / 11:10:54 / cg"
+!
+
+list:aCollection
+ "set the contents (a collection of strings or list entries)
+ and scroll as specified in scrollWhenUpdating (default:top-left).
+ See also #setList:, which does not scroll.
+ Tabs are expanded (to spaces).
+ The passed list is scanned for nonStrings
+ (remembered to optimize later redraws)."
+
+ self list:aCollection expandTabs:expandTabsWhenUpdating
+
+ "Modified: 5.6.1997 / 11:10:45 / cg"
+!
+
+list:aCollection expandTabs:expand
+ "set the contents (a collection of strings)
+ and scroll as specified in scrollWhenUpdating (default:top-left).
+ If expand is true, tabs are expanded (to spaces).
+ The passed list is scanned for nonStrings (remembered to optimize
+ later redraws)."
+
+ self list:aCollection expandTabs:expand scanForNonStrings:true
+
+ "Modified: 5.6.1997 / 11:09:44 / cg"
+!
+
+list:aCollection expandTabs:expand scanForNonStrings:scan
+ "set the contents (a collection of strings)
+ and scroll as specified in scrollWhenUpdating (default:top-left).
+ If expand is true, tabs are expanded (to spaces).
+ If scan is true, scan the passed list for nonStrings; otherwise,
+ assume that it does contain non-strings
+ (remembered to optimize later redraws)."
+
+ self
+ list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:nil
+
+ "Modified: 5.6.1997 / 12:40:35 / cg"
+!
+
+list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:nonStringsIfNoScan
+ "set the contents (a collection of strings)
+ and scroll as specified in scrollWhenUpdating (default:top-left).
+ If expand is true, tabs are expanded (to spaces).
+ If scan is true, scan the passed list for nonStrings;
+ otherwise, take the information from the nonStrings arg.
+ (the nonStrings information is remembered to optimize later redraws & height computations)."
+
+ self
+ list:aCollection
+ expandTabs:expand
+ scanForNonStrings:scan
+ includesNonStrings:nonStringsIfNoScan
+ redraw:true
+!
+
+list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:nonStringsIfNoScan redraw:doRedraw
+ "set the contents (a collection of strings)
+ and scroll as specified in scrollWhenUpdating (default:top-left).
+ If expand is true, tabs are expanded (to spaces).
+ If scan is true, scan the passed list for nonStrings;
+ otherwise, take the information from the nonStrings arg.
+ (the nonStrings information is remembered to optimize later redraws & height computations)."
+
+ |oldFirst oldLeft nonStringsBefore fontHeightBefore
+ scrollToEnd scrollToTop newLeftOffset wText same firstLine|
+
+ "/ cg: what is the point in comparing here?
+ "/ I think, if there is something to optimize,
+ "/ the caller should do so (moved to getListFromModel).
+ "/ notice, that it may be very expensive to ask aCollection for each line
+ "/ for example, iff the lines are generated on the fly by an algorithm
+ false ifTrue:[
+ "/ see if there is a change at all.
+ "/ use to compare using =, but that's not enough in case of emphasis change.
+ aCollection size == list size ifTrue:[
+ same := true.
+ aCollection size > 0 ifTrue:[
+ aCollection with:list do:[:eachNewLine :eachOldLine |
+ (eachNewLine == eachOldLine)
+ ifFalse:[
+ same := false.
+ ]
+ ]
+ ].
+ same ifTrue:[^ self].
+ ].
+ ].
+
+ scrollToTop := scrollWhenUpdating == #begin or:[scrollWhenUpdating == #beginOfText].
+ scrollToEnd := scrollWhenUpdating == #end or:[scrollWhenUpdating == #endOfText].
+
+ (aCollection isEmptyOrNil and:[list isEmptyOrNil]) ifTrue:[
+ "no contents change"
+ list := aCollection.
+ scrollLocked ifFalse:[
+ scrollToTop ifTrue:[
+ self scrollToTop.
+ ] ifFalse:[
+ scrollToEnd ifTrue:[
+ self scrollToBottom.
+ ]
+ ].
+ self scrollToLeft.
+ ].
+ ^ self
+ ].
+
+ checkLineEndConventionWhenUpdating ifTrue:[
+ "Check if the we use DOS/Windows line end convention with CR LF.
+ The LF has already been consumed by the conversion to a StringCollection,
+ now check for and remove the trailing left over CRs"
+
+ lineEndCRLF := (aCollection size > 0
+ and:[(firstLine := aCollection at:1) isString
+ and:[firstLine notEmpty
+ and:[firstLine string endsWith:Character return]]]).
+ ].
+ lineEndCRLF ifTrue:[
+ list := aCollection
+ collect:[:eachLineWithCROrNil |
+ eachLineWithCROrNil isNil
+ ifTrue:nil
+ ifFalse:[(eachLineWithCROrNil endsWith:Character return)
+ ifTrue:[eachLineWithCROrNil copyButLast:1]
+ ifFalse:[eachLineWithCROrNil]]].
+ ] ifFalse:[
+ list := aCollection.
+ ].
+
+ nonStringsBefore := includesNonStrings.
+ fontHeightBefore := fontHeight.
+ includesNonStrings := false.
+
+ list notNil ifTrue:[
+ expand ifTrue:[
+ self expandTabs
+ ] ifFalse:[
+ scan ifTrue:[
+ includesNonStrings := list contains:[:e | e isString not].
+ ] ifFalse:[
+ includesNonStrings := nonStringsIfNoScan ? nonStringsBefore
+ ]
+ ].
+ ].
+ (includesNonStrings ~~ nonStringsBefore) ifTrue:[
+ self getFontParameters.
+ ].
+
+ widthOfWidestLine := nil. "/ i.e. unknown
+ oldFirst := firstLineShown.
+ oldLeft := viewOrigin x.
+
+ (includesNonStrings ~~ nonStringsBefore) ifTrue:[
+ self computeNumberOfLinesShown.
+ ].
+
+ scrollLocked ifFalse:[
+ newLeftOffset := viewOrigin x.
+ scrollToTop ifTrue:[
+ firstLineShown := 1.
+ newLeftOffset := 0.
+ ] ifFalse:[
+ scrollToEnd ifTrue:[
+ firstLineShown := (list size - nFullLinesShown + 1) max:1.
+ newLeftOffset := 0.
+ ]
+ ].
+ newLeftOffset > 0 ifTrue:[
+ wText := self widthOfContents.
+ (viewOrigin x + self innerWidth) > wText ifTrue:[
+ newLeftOffset := (wText - self innerWidth) max:0.
+ ].
+ ].
+ newLeftOffset ~= oldLeft ifTrue:[
+ viewOrigin := newLeftOffset @ viewOrigin y.
+ ].
+ ].
+
+ realized ifTrue:[
+ self contentsChanged.
+ scrollLocked ifFalse:[
+ "
+ don't use scroll here to avoid double redraw
+ "
+ viewOrigin := viewOrigin isNil ifTrue:[0@0] ifFalse:[(viewOrigin x) @ 0].
+ gc transformation:nil.
+
+ oldFirst ~~ firstLineShown ifTrue:[
+ self originChanged:0 @ ((oldFirst - 1) * fontHeight negated).
+ ].
+ ].
+ doRedraw ifTrue:[
+ shown ifTrue:[
+ self invalidate.
+ ]
+ ]
+ ]
+
+ "Modified: / 30-08-1995 / 19:07:13 / claus"
+ "Created: / 05-06-1997 / 12:40:06 / cg"
+ "Modified: / 04-07-2006 / 19:12:39 / fm"
+ "Modified: / 22-08-2006 / 11:59:56 / cg"
+!
+
+listAt:lineNr
+ "given a lineNumber, return the corresponding string
+ This is used for accessing; i.e. for non-string entries, this
+ returns the corresponding string."
+
+ |l|
+
+ list isNil ifTrue:[^ nil].
+ (lineNr between:1 and:self size) ifFalse:[^ nil].
+ l := self at:lineNr.
+ l isNil ifTrue:[^ l].
+ ^ self visibleStringFrom:l "/ l asString
+
+ "Modified: 7.9.1995 / 15:54:59 / claus"
+!
+
+removeFromIndex:startLineNr toIndex:endLineNr
+ "delete some lines"
+
+ |nLines widestLineRemoved|
+
+ list isNil ifTrue:[^ self].
+
+ widestLineRemoved := self widthOfWidestLineBetween:startLineNr and:endLineNr.
+ list removeFromIndex:startLineNr toIndex:(endLineNr min:list size).
+
+ widthOfWidestLine == widestLineRemoved ifTrue:[
+ widthOfWidestLine := nil. "/ i.e. unknown
+ ].
+ self textChanged.
+
+ ((startLineNr <= self lastLineShown)
+ and:[endLineNr >= firstLineShown]) ifTrue:[
+ startLineNr to:self lastLineShown do:[:eachLine |
+ self invalidateLine:eachLine
+ ].
+ ].
+
+ nLines := list size.
+ (firstLineShown >= nLines) ifTrue:[
+ self makeLineVisible:nLines
+ ].
+ self enqueueDelayedContentsChangedNotification.
+
+ "Modified: / 25-07-2012 / 12:01:59 / cg"
+!
+
+removeIndex:lineNr
+ "delete a line, redraw the view"
+
+ |visLine w h x
+ srcY "{ Class: SmallInteger }" |
+
+ (self removeIndexWithoutRedraw:lineNr) ifFalse:[^ self].
+
+ "
+ is there a need to redraw ?
+ "
+ shown ifFalse:[^ self].
+ visLine := self listLineToVisibleLine:lineNr.
+ visLine notNil ifTrue:[
+ w := self widthForScrollBetween:lineNr and:(firstLineShown + nLinesShown).
+"/ x := textStartLeft.
+"/ CLAUS fixes leftOver selection pixels
+ w := w + leftMargin.
+ x := margin.
+
+ srcY := topMargin + (visLine * fontHeight).
+"/ h := ((nLinesShown - visLine) * fontHeight).
+ h := (height - margin - srcY).
+ h > 0 ifTrue:[
+ self catchExpose.
+ self
+ copyFrom:self
+ x:x y:srcY
+ toX:x y:(srcY - fontHeight)
+ width:w height:h
+ async:true.
+ ].
+ self redrawVisibleLine:nFullLinesShown.
+ "
+ redraw last partial line - if any
+ "
+ (nFullLinesShown ~~ nLinesShown) ifTrue:[
+ self redrawVisibleLine:nLinesShown
+ ].
+ h > 0 ifTrue:[
+ self waitForExpose
+ ].
+ ]
+
+ "Modified: / 27.2.1998 / 12:36:59 / cg"
+!
+
+removeIndexWithoutRedraw:lineNr
+ "delete a line, given its lineNr - no redraw;
+ return true, if something was really deleted (so sender knows,
+ if a redraw is needed)"
+
+ (list isNil or:[lineNr > self size]) ifTrue:[^ false].
+ list removeIndex:lineNr.
+
+ lineNr < firstLineShown ifTrue:[
+ firstLineShown := firstLineShown - 1
+ ].
+ self enqueueDelayedContentsChangedNotification.
+ ^ true
+
+ "Modified: / 25-07-2012 / 12:02:09 / cg"
+!
+
+replaceFrom:startLineNr to:endLineNr with:aCollection startingAt:replStartIndex
+ "replace some lines"
+
+ list isNil ifTrue:[
+ list := OrderedCollection new.
+ ].
+ list replaceFrom:startLineNr to:endLineNr with:aCollection startingAt:replStartIndex.
+
+ widthOfWidestLine := nil. "/ i.e. unknown
+ self textChanged.
+
+ ((startLineNr <= self lastLineShown)
+ and:[endLineNr >= firstLineShown]) ifTrue:[
+ self invalidate.
+ ].
+
+ self enqueueDelayedContentsChangedNotification.
+
+ "Modified: / 25-07-2012 / 12:02:15 / cg"
+!
+
+setContents:something
+ "set the contents (either a string or a Collection of strings)
+ dont change position (i.e. do not scroll).
+ This can be used to update a self-changing list
+ (for example: a file list being shown, without disturbing user too much).
+ Compare with #contents:, which scrolls to top."
+
+ |l|
+
+ l := something.
+ l notNil ifTrue:[
+ l isString ifTrue:[
+ l := l asStringCollection
+ ]
+ ].
+ self setList:l.
+
+ "Modified: 18.12.1995 / 22:20:43 / stefan"
+!
+
+setList:aCollection
+ "set the contents (a collection of strings);
+ do not 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
+!
+
+setList:aCollection expandTabs:expandTabs
+ "set the contents (a collection of strings);
+ do not 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 the user too much)"
+
+ self setList:aCollection expandTabs:expandTabs redraw:true
+
+ "Modified: / 22.4.1998 / 11:12:24 / cg"
+!
+
+setList:aCollection expandTabs:expandTabs redraw:doRedraw
+ "set the contents (a collection of strings);
+ do not 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 the user too much)"
+
+ self
+ setList:aCollection expandTabs:expandTabs scanForNonStrings:true includesNonStrings:nil
+ redraw:doRedraw
+!
+
+setList:aCollection expandTabs:expandTabs scanForNonStrings:scan includesNonStrings:nonStringsIfNoScan redraw:doRedraw
+ "set the contents (a collection of strings);
+ do not 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 the user too much).
+ TODO: this stinks: most of the code is the same as in #list:expandTabs:...
+ needs a refactoring"
+
+ |prev|
+
+ prev := scrollLocked.
+ [
+ scrollLocked := false.
+ self
+ list:aCollection
+ expandTabs:expandTabs
+ scanForNonStrings:scan
+ includesNonStrings:nonStringsIfNoScan
+ redraw:doRedraw
+ ] ensure:[
+ scrollLocked := prev
+ ].
+"/
+"/
+"/"/ scrollLocked ifTrue:[
+"/"/ self setList:newText expandTabs:expandTabsWhenUpdating
+"/"/ ] ifFalse:[
+"/ self list:newText expandTabs:expandTabsWhenUpdating scanForNonStrings:expandTabsWhenUpdating
+"/"/ ]
+"/
+"/ |oldFirst nonStringsBefore|
+"/
+"/ (aCollection isNil and:[list isNil]) ifTrue:[
+"/ "no change"
+"/ ^ self
+"/ ].
+"/
+"/ list := aCollection.
+"/
+"/ nonStringsBefore := includesNonStrings.
+"/ includesNonStrings := false.
+"/
+"/ list notNil ifTrue:[
+"/ expandTabs ifTrue:[
+"/ self expandTabs
+"/ ] ifFalse:[
+"/ scan ifTrue:[
+"/ includesNonStrings := (list findFirst:[:e | e isString not]) ~~ 0.
+"/ ] ifFalse:[
+"/ includesNonStrings := nonStringsIfNoScan ? nonStringsBefore
+"/ ]
+"/ ].
+"/ ].
+"/ (includesNonStrings ~~ nonStringsBefore) ifTrue:[
+"/ self getFontParameters.
+"/ self computeNumberOfLinesShown.
+"/ ].
+"/
+"/ "/ new: reposition horizontally if too big
+"/ widthOfWidestLine := nil. "/ i.e. unknown
+"/ innerWidth >= self widthOfContents ifTrue:[
+"/ viewOrigin := 0 @ viewOrigin y.
+"/ ].
+"/ self contentsChanged.
+"/
+"/ "/ new: reposition vertically if too big
+"/ (firstLineShown + nFullLinesShown) > self size ifTrue:[
+"/ oldFirst := firstLineShown.
+"/ firstLineShown := self size - nFullLinesShown + 1.
+"/ firstLineShown < 1 ifTrue:[firstLineShown := 1].
+"/ oldFirst ~= firstLineShown ifTrue:[
+"/ viewOrigin y:((firstLineShown - 1) * fontHeight).
+"/ self originChanged:0 @ ((oldFirst - 1) negated * fontHeight).
+"/ shown ifTrue:[
+"/ self clearView.
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ (shown and:[doRedraw]) ifTrue:[
+"/ self invalidate
+"/ "/ self redrawFromVisibleLine:1 to:nLinesShown
+"/ ]
+"/
+"/ "Modified: / 18.12.1995 / 23:27:54 / stefan"
+"/ "Created: / 22.4.1998 / 11:11:51 / cg"
+"/ "Modified: / 26.7.1998 / 13:46:49 / cg"
+!
+
+size
+ "return the size (i.e. number of lines)
+ this allows textViews to be used like collections in some places."
+
+ ^ list size.
+!
+
+stringAtLine:lineNr from:col1 to:col2
+ "return the substring starting at physical line/col1, up-to and
+ including col2.
+ The lineNr and colNr arguments start at 1, for the top-left character.
+ Fills the string with space characters at the right.
+ (i.e. beyond the end of the line or below the last line)"
+
+ |line len s|
+
+ len := col2 - col1 + 1.
+ list notNil ifTrue:[
+ line := self listAt:lineNr.
+ line notNil ifTrue:[
+ (line size >= col1) ifTrue:[
+ s := line copyFrom:col1.
+ s size < len ifTrue:[
+ ^ s paddedTo:len
+ ].
+ ^ s copyTo:len
+ ]
+ ]
+ ].
+ ^ String new:len withAll:Character space
+
+ "Created: 7.1.1997 / 19:58:43 / cg"
+!
+
+textFromCharacterPosition:charPos1 to:charPos2
+ "return some text as a collection of (line-)strings."
+
+ |line1 col1 line2 col2|
+
+ line1 := self lineOfCharacterPosition:charPos1.
+ col1 := charPos1 - (self characterPositionOfLine:line1 col:1) + 1.
+
+ line2 := self lineOfCharacterPosition:charPos2.
+ col2 := charPos2 - (self characterPositionOfLine:line2 col:1) + 1.
+
+ ^ self textFromLine:line1 col:col1 toLine:line2 col:col2.
+!
+
+textFromLine:startLine col:startCol toLine:endLine col:endCol
+ "return some text as a collection of (line-)strings."
+
+ |text sz index last|
+
+ startLine isNil ifTrue:[^ nil].
+ endLine isNil ifTrue:[^ nil].
+
+ (startLine == endLine) ifTrue:[
+ "part of a line"
+ ^ StringCollection with:(self listAt:startLine from:startCol to:endCol)
+ ].
+
+ sz := endLine - startLine + 1.
+ sz < 1 ifTrue:[^ nil].
+
+ text := StringCollection new:sz.
+
+ "get 1st and last (possibly) partial lines"
+ text at:1 put:(self listAt:startLine from:startCol).
+ endCol == 0 ifTrue:[
+ last := ''
+ ] ifFalse:[
+ last := self listAt:endLine to:endCol.
+ ].
+ 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
+
+ "Created: / 22-02-2000 / 23:53:06 / cg"
+!
+
+withoutRedrawAt:index put:aString
+ "change a line without redisplay and WITHOUT any sizeChange notifications.
+ Somewhat dangerous, since scrollBars will not be informed about contents-changes.
+ Use only if multiple lines are to be changed, and a sizeChanged is invoked by some other
+ means at the end."
+
+ |didIncludeNonStrings oldLine|
+
+ self checkForExistingLine:index.
+
+ oldLine := self listAt:index.
+ list at:index put:aString.
+ oldLine ~= aString ifTrue:[
+ self textChanged
+ ].
+
+ didIncludeNonStrings := includesNonStrings.
+ includesNonStrings ifFalse:[
+ includesNonStrings := (aString notNil and:[(aString isMemberOf:String) not]).
+ ] ifTrue:[
+ (aString isNil or:[(aString isMemberOf:String)]) ifTrue:[
+ includesNonStrings := list contains:[:l | l notNil and:[(l isMemberOf:String) not]].
+ ]
+ ].
+
+ includesNonStrings ~~ didIncludeNonStrings ifTrue:[
+ self getFontParameters.
+ self computeNumberOfLinesShown
+ ].
+
+ widthOfWidestLine notNil ifTrue:[
+ self recomputeWidthOfWidestLineFor:aString old:oldLine.
+ ].
+
+ "Modified: / 26.7.1998 / 13:00:14 / cg"
+! !
+
+!ListView methodsFor:'accessing-look'!
+
+backgroundColor
+ "return the background color"
+
+ ^ bgColor
+!
+
+backgroundColor:aColor
+ "set the background color of the contents"
+
+ bgColor ~~ aColor ifTrue:[
+ bgColor := aColor.
+ self viewBackground:bgColor.
+ self invalidate "/ clear; redraw
+ ]
+
+ "Modified: 3.5.1997 / 10:27:40 / cg"
+!
+
+font:aFont
+ "set the font for all shown text.
+ Redraws everything.
+ CAVEAT: with the addition of Text objects,
+ this method is going to be obsoleted by a textStyle
+ method, which allows specific control over
+ normalFont/boldFont/italicFont parameters."
+
+ aFont isNil ifTrue:[
+ ^ self error:'nil font' mayProceed:true
+ ].
+ gc font ~~ aFont ifTrue:[
+ preferredExtent := nil.
+ widthOfWidestLine := nil. "/ i.e. unknown
+ super font:aFont.
+ self getFontParameters.
+ realized ifTrue:[
+ (gc font graphicsDevice == gc device) ifTrue:[
+ self computeNumberOfLinesShown.
+ shown ifTrue:[
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
+ ].
+ self enqueueDelayedContentsChangedNotification
+ ]
+ ]
+
+ "Modified: / 25-07-2012 / 12:01:36 / cg"
+!
+
+fontHeight:pixels
+ "set the lines height - that's the number of pixels,
+ by which lines are vertically separated."
+
+ fontHeight ~~ pixels ifTrue:[
+ fontHeight := pixels.
+ ]
+
+ "Created: 17.4.1997 / 01:41:33 / cg"
+!
+
+foregroundColor
+ "return the foreground color"
+
+ ^ fgColor
+!
+
+foregroundColor:aColor
+ "set the foreground color"
+
+ fgColor ~~ aColor ifTrue:[
+ fgColor := aColor.
+ self invalidate
+ ]
+
+ "Modified: 29.5.1996 / 16:19:02 / cg"
+!
+
+foregroundColor:color1 backgroundColor:color2
+ "set both foreground and background colors"
+
+ ((fgColor ~~ color1) or:[bgColor ~~ color2]) ifTrue:[
+ fgColor := color1.
+ bgColor := color2.
+ self invalidate
+ ]
+
+ "Modified: 29.5.1996 / 16:19:05 / cg"
+!
+
+innerHorizontalMargin
+ "return the margin between the left border and the 1st col"
+
+ ^ leftMargin
+
+ "Created: 16.1.1996 / 19:28:23 / cg"
+!
+
+innerVerticalMargin
+ "return the margin between the top border and the 1st line"
+
+ ^ topMargin
+
+ "Created: 16.1.1996 / 19:28:00 / cg"
+!
+
+leftMargin
+ "return the margin to left of 1st col"
+
+ ^ leftMargin
+!
+
+leftMargin:aNumber
+ "set the margin between the left border and the 1st col"
+
+ leftMargin := aNumber.
+ textStartLeft := aNumber + margin.
+ innerWidth := width - aNumber - margin
+
+ "Modified: 28.2.1996 / 19:32:55 / cg"
+!
+
+level:aNumber
+ "set the 3D level - caught here to update text-position variables
+ (which avoids many computations later)"
+
+ |newMargin|
+
+ aNumber ~~ level ifTrue:[
+ newMargin := aNumber abs.
+ textStartLeft := leftMargin + newMargin.
+ textStartTop := topMargin + newMargin.
+ innerWidth := width - textStartLeft - newMargin.
+
+ super level:aNumber.
+ ]
+
+ "Modified: 11.8.1997 / 02:59:15 / cg"
+!
+
+lineSpacing
+ "get the lineSpacing - that's an additional number of pixels,
+ by which lines are vertically separated."
+
+ ^ lineSpacing
+!
+
+lineSpacing:pixels
+ "set the lineSpacing - that's an additional number of pixels,
+ by which lines are vertically separated."
+
+ lineSpacing ~~ pixels ifTrue:[
+ lineSpacing := pixels.
+ self getFontParameters.
+ ]
+
+ "Modified: 22.5.1996 / 12:22:29 / cg"
+!
+
+partialLines:aBoolean
+ "allow/disallow display of a last partial line"
+
+ partialLines := aBoolean.
+ self computeNumberOfLinesShown
+!
+
+topMargin:aNumber
+ "set the margin between the top border and the 1st line"
+
+ topMargin := aNumber.
+ textStartTop := topMargin + margin.
+!
+
+viewBackground:aColor
+ super viewBackground:aColor.
+ self isTextView ifFalse:[
+ self backgroundColor:aColor
+ ].
+! !
+
+!ListView methodsFor:'accessing-mvc'!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#listMessage put:listMsg
+!
+
+listMessage
+ "return the listMsg selector;
+ if non-nil, this is the message sent to the model (if any) to aquire
+ a new text upon change of the aspect.
+ This defaults to the aspect-selector."
+
+ ^ listMsg
+!
+
+listMessage:aSymbol
+ "ST-80 compatibility: set the listMsg selector;
+ if non-nil, this will be sent to the model (if any) to aquire a
+ new text upon change of the aspect.
+ This defaults to the aspect-selector."
+
+ listMsg := aSymbol.
+!
+
+model:aModel
+ "define the receivers model, from which the text is
+ to be aquired via list- or aspect-messages, whenever its aspect
+ changes."
+
+ super model:aModel.
+ self getListFromModel
+
+ "Created: 31.12.1996 / 14:56:43 / stefan"
+!
+
+on:aModel aspect:aspectSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:nil
+!
+
+on:aModel aspect:aspectSymbol change:changeSymbol
+ "ST-80 compatibility"
+
+ ^self on:aModel aspect:aspectSymbol change:changeSymbol list:aspectSymbol menu:nil
+!
+
+on:aModel aspect:aspectSymbol change:changeSymbol list:listSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ aspectSymbol notNil ifTrue:[
+ aspectMsg := aspectSymbol.
+ listMsg isNil ifTrue:[
+ listMsg := aspectSymbol
+ ]
+ ].
+ listSymbol notNil ifTrue:[listMsg := listSymbol].
+ changeSymbol notNil ifTrue:[changeMsg := changeSymbol].
+ menuMsg := menuSymbol.
+ self model:aModel.
+
+ "Modified: 2.1.1997 / 16:11:16 / cg"
+!
+
+on:aModel aspect:aspectSymbol change:changeSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:changeSymbol list:nil menu:menuSymbol
+!
+
+on:aModel aspect:aspectSymbol list:listSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^ self on:aModel aspect:aspectSymbol change:nil list:listSymbol menu:menuSymbol
+!
+
+on:aModel aspect:aspectSymbol menu:menuSymbol
+ "ST-80 compatibility"
+
+ ^self on:aModel aspect:aspectSymbol change:nil list:aspectSymbol menu:menuSymbol
+! !
+
+!ListView methodsFor:'change & update'!
+
+update:something with:aParameter from:changedObject
+ |idx|
+
+ changedObject == model ifTrue:[
+ model isList ifTrue:[
+ list ~~ model ifTrue:[
+ something == #at: ifTrue:[
+ idx := aParameter isCollection ifTrue:[aParameter at:1]
+ ifFalse:[aParameter].
+ ^ self at:aParameter put:(model at:idx).
+ ].
+ something == #insert: ifTrue:[
+ (list size + 1) >= aParameter ifTrue:[
+ ^ self add:(model at:aParameter) beforeIndex:aParameter
+ ].
+ ].
+ something == #remove: ifTrue:[
+ list size >= aParameter ifTrue:[
+ ^ self removeIndex:aParameter
+ ]
+ ].
+ ].
+ self getListFromModel.
+ ^ self
+ ].
+
+ (aspectMsg notNil
+ and:[something == aspectMsg]) ifTrue:[
+ self getListFromModel.
+ ^ self
+ ].
+ something isNil ifTrue:[
+ "/ model changed (not more information)
+ self getListFromModel.
+ ^ self
+ ].
+ something == #size ifTrue:[
+ self getListFromModelScroll:false.
+ ^ self
+ ].
+ ].
+ changedObject == listChannel ifTrue:[
+ self getListFromModel.
+ ^ self
+ ].
+
+ ^ super update:something with:aParameter from:changedObject
+
+ "Modified: / 08-11-2006 / 19:40:29 / cg"
+! !
+
+!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 sH l|
+
+ y := self yOfVisibleLine:startVisLineNr.
+ sH := lineSpacing // 2.
+
+ backgroundAlreadyClearedColor == bg ifFalse:[
+ self paint:bg.
+ self fillRectangleX:margin
+ y:y-sH
+ width:(width - (margin * 2))
+ height:(endVisLineNr - startVisLineNr + 1) * fontHeight + (lineSpacing - sH).
+ ].
+ 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 - viewOrigin x.
+ self paint:fg on:bg.
+ "/ dont use list from:to:do:, to allow for subclasses to redefine the enumeration (TableView)
+ self from:startLine to:e do:[:line |
+ line notNil ifTrue:[
+ "/ remove line's color emphasis, to enforce color.
+ "/ otherwise blue text is not visible if selection-bg is blue
+ l := self withoutColorEmphasis:line ifFg:fg andBg:bg.
+ self displayOpaqueString:l x:x y:y
+ ].
+ y := y + fontHeight
+ ]
+ ]
+
+ "Modified: / 15.12.1999 / 23:19:39 / cg"
+!
+
+drawLine:line atX:x inVisible:visLineNr with:fg and:bg
+ "draw a given string at visible lines position with
+ given x position in fg/bg. Clears the whole line before drawing the string.
+ Low level entry; not meant for public use."
+
+ |y l|
+
+ y := self yOfVisibleLine:visLineNr.
+ backgroundAlreadyClearedColor == bg ifFalse:[
+ self paint:bg.
+ self fillRectangleX:margin y:y - (lineSpacing//2)
+ width:(width - (2 * margin))
+ height:fontHeight.
+ ].
+ line notNil ifTrue:[
+ self paint:fg on:bg.
+
+ "/ remove lines color emphasis, to enforce color.
+ "/ otherwise blue text is not visible if selection-bg is blue.
+ "/ this is only done in EditTextViews and subClasses.
+ self suppressEmphasisInSelection ifTrue:[
+ l := self withoutColorEmphasis:line ifFg:fg andBg:bg.
+ ] ifFalse:[
+ l := line
+ ].
+ self displayOpaqueString:l x:x y:(y + fontAscent)
+ ]
+
+ "Modified: / 15.12.1999 / 23:19:46 / cg"
+!
+
+drawLine:line fromX:x inVisible:visLineNr with:fg and:bg
+ "draw a given string at visible lines position with
+ given x position in fg/bg. Clears partial line before drawing the string.
+ Low level entry; not meant for public use."
+
+ |y l|
+
+ y := self yOfVisibleLine:visLineNr.
+ line notNil ifTrue:[
+ self paint:fg on:bg.
+
+ "/ remove lines color emphasis, to enforce color.
+ "/ otherwise blue text is not visible if selection-bg is blue
+ l := self withoutColorEmphasis:line ifFg:fg andBg:bg.
+ self displayOpaqueString:l x:x y:(y + fontAscent)
+ ]
+
+ "Modified: / 15.12.1999 / 23:19:55 / cg"
+!
+
+drawLine:lineStringArg inVisible:visLineNr col:col with:fg and:bg
+ "draw single character at col index of visible line in fg/bg"
+
+ |y yf x len lineString characterString w|
+
+ lineString := lineStringArg.
+ len := lineString size.
+
+ x := (self xOfCol:col inVisibleLine:visLineNr) - viewOrigin x.
+ y := self yOfVisibleLine:visLineNr.
+ yf := y - (lineSpacing // 2).
+
+ self paint:bg.
+
+ (lineString notNil and:[lineString isString not]) ifTrue:[
+ w := lineString widthFrom:col to:(col min:len) on:self.
+ w <= 0 ifTrue:[
+ w := gc font width.
+ self fillRectangleX:x y:yf width:w height:fontHeight.
+ self paint:fg
+ ].
+ self clippedTo:(Rectangle left:x top:yf width:w height:fontHeight) do:[
+ self drawVisibleLine:visLineNr with:fg and:bg
+ ].
+ ^ self
+ ].
+
+ (lineString isNil or:[col > len]) ifTrue:[
+ self fillRectangleX:x y:yf width:(gc font width) height:fontHeight.
+ self paint:fg
+ ] ifFalse:[
+ characterString := lineString copyFrom:col to:col.
+
+ "/ remove lines color emphasis, to enforce color.
+ "/ otherwise blue text is not visible if selection-bg is blue
+ characterString := self withoutColorEmphasis:characterString ifFg:fg andBg:bg.
+ w := characterString widthOn:self.
+
+ self fillRectangleX:x y:yf width:w height:fontHeight.
+ self paint:fg.
+ self clippedTo:(Rectangle left:x top:yf width:w height:fontHeight) do:[
+ self displayString:characterString x:x y:(y + fontAscent)
+ ]
+ ]
+
+ "Modified: / 15.12.1999 / 23:21:12 / cg"
+!
+
+drawLine:lineStringArg inVisible:visLineNr from:startCol to:endColOrNil with:fg and:bg
+ "draw part of a visible line in fg/bg"
+
+ |y yf x lineString len characterString w endCol sCol eCol numExtraCols|
+
+ "/ hack - please rewrite
+ endCol := endColOrNil ? lineStringArg size.
+ (endCol >= startCol) ifTrue:[
+ sCol := startCol max:1.
+
+ lineString := lineStringArg.
+
+ x := (self xOfCol:sCol inVisibleLine:visLineNr) - viewOrigin x.
+ y := (self yOfVisibleLine:visLineNr).
+ yf := y - (lineSpacing // 2).
+
+ len := lineString size.
+ (lineString notNil and:[(lineString isMemberOf:String) not ])
+ ifTrue:[
+ w := lineString widthFrom:sCol to:(endCol min:len) on:self.
+ endCol > len ifTrue:[
+ sCol > len ifTrue:[
+ numExtraCols := (endCol - sCol + 1).
+ ] ifFalse:[
+ numExtraCols := (endCol - len" + 1").
+ ].
+ self paint:bg.
+ self fillRectangleX:x+w y:yf width:(numExtraCols * fontWidth) height:fontHeight.
+ ].
+ w > 0 ifTrue:[
+ self clippedTo:(Rectangle left:x top:yf width:w height:fontHeight) do:[
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ ]
+ ].
+ ^ self.
+ ].
+
+ (sCol > len) ifTrue:[
+ backgroundAlreadyClearedColor == bg ifFalse:[
+ len := endCol - sCol + 1.
+ self paint:bg.
+ self fillRectangleX:x y:yf
+ width:(fontWidth * len)
+ height:fontHeight
+ ]
+ ] ifFalse:[
+ eCol := endCol.
+ (endCol > len) ifTrue:[
+ backgroundAlreadyClearedColor == bg ifFalse:[
+ characterString := lineString string species new:endCol.
+ characterString replaceFrom:1 to:len with:lineString startingAt:1.
+ lineString := characterString.
+ ] ifTrue:[
+ eCol := len.
+ ].
+ ].
+
+ "/ remove any color emphasis, to enforce drawing in fg/bg
+
+ lineString := self withoutColorEmphasis:lineString ifFg:fg andBg:bg.
+
+ backgroundAlreadyClearedColor == bg ifFalse:[
+ (lineString isMemberOf:String) ifTrue:[
+ fontIsFixedWidth ifTrue:[
+ w := (eCol - sCol + 1) * fontWidth
+ ] ifFalse:[
+ w := gc font widthOf:lineString from:sCol to:eCol
+ ]
+ ] ifFalse:[
+ w := lineString widthFrom:sCol to:endCol on:self
+ ].
+ self paint:bg.
+ self fillRectangleX:x y:yf
+ width:w
+ height:fontHeight.
+ ].
+ self paint:fg on:bg.
+"/ w notNil ifTrue:[
+"/ "/ clip req'd for VISTAs new font rendering (which seems to shoot over the compute
+"/ self clippedTo:(Rectangle left:x top:yf width:w height:fontHeight) do:[
+"/ "/ self displayOpaqueString:lineString from:sCol to:eCol x:x y:(y + fontAscent)
+"/ self displayString:lineString from:sCol to:eCol x:x y:(y + fontAscent)
+"/ ]
+"/ ] ifFalse:[
+ "/ self displayOpaqueString:lineString from:sCol to:eCol x:x y:(y + fontAscent)
+ self displayString:lineString from:sCol to:eCol x:x y:(y + fontAscent) opaque:false maxWidth:self width
+"/ ].
+ ]
+ ]
+
+ "Modified: / 15.12.1999 / 23:21:43 / cg"
+!
+
+drawLine:lineString inVisible: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 index1 index2 lineWithoutColor|
+
+ (startCol < 1) ifTrue:[
+ index1 := 1
+ ] ifFalse:[
+ index1 := startCol
+ ].
+ y := self yOfVisibleLine:visLineNr.
+ x := (self xOfCol:index1 inVisibleLine:visLineNr) - viewOrigin x.
+ backgroundAlreadyClearedColor == bg ifFalse:[
+ self paint:bg.
+ self fillRectangleX:x y:y - (lineSpacing // 2)
+ width:(width + viewOrigin x - x)
+ height:fontHeight.
+ ].
+ lineString notNil ifTrue:[
+ lineString isString ifFalse:[
+ self drawLine:lineString inVisible:visLineNr from:startCol to:nil with:fg and:bg.
+ ] ifTrue:[
+ lineWithoutColor := self withoutColorEmphasis:lineString ifFg:fg andBg:bg.
+ index2 := lineWithoutColor size.
+ (index2 < index1) ifTrue:[^ self].
+ (index1 <= index2) ifTrue:[
+ self paint:fg on:bg.
+ "/ self displayOpaqueString:lineWithoutColor from:index1 to:index2 x:x y:(y + fontAscent)
+ self displayString:lineWithoutColor from:index1 to:index2 x:x y:(y + fontAscent)
+ ]
+ ]
+ ]
+
+ "Modified: / 15.12.1999 / 23:24:40 / cg"
+!
+
+drawLine:line inVisible:visLineNr with:fg and:bg
+ "draw a given string at visible lines position in fg/bg"
+
+ self drawLine:line atX:(textStartLeft - viewOrigin x) inVisible:visLineNr with:fg and:bg
+!
+
+drawVisibleLine:visLineNr col:col with:fg and:bg
+ "draw single character at col index of visible line in fg/bg"
+
+ self
+ drawLine:(self visibleAt:visLineNr)
+ inVisible:visLineNr
+ col:col
+ with:fg and:bg
+!
+
+drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
+ "draw part of a visible line in fg/bg"
+
+ self
+ drawLine:(self visibleAt:visLineNr)
+ inVisible:visLineNr
+ from:startCol to:endCol
+ with:fg and:bg
+!
+
+drawVisibleLine:visLineNr from:startCol with:fg and:bg
+ "draw right part of a visible line from startCol to end of line in fg/bg"
+
+ self
+ drawLine:(self visibleAt:visLineNr)
+ inVisible:visLineNr
+ from:startCol
+ with:fg and:bg
+!
+
+drawVisibleLine:visLineNr with:fg and:bg
+ "draw a visible line in fg/bg"
+
+ self
+ drawLine:(self visibleAt:visLineNr)
+ atX:(textStartLeft - viewOrigin x)
+ inVisible:visLineNr
+ with:fg
+ and:bg
+
+ "Modified: 28.2.1996 / 19:30:23 / cg"
+!
+
+fillRectangleX:x y:y width:w height:h
+ "fill rectangle; checks whether the rectangle already is filled with
+ the current paint (#redrawX:y:w:h)."
+
+ backgroundAlreadyClearedColor ~~ self paint ifTrue:[
+ super fillRectangleX:x y:y width:w height:h
+ ]
+!
+
+invalidateLine:line
+ "invalidate the area of a single line.
+ This arranges for that line to be redrawn asynchronously (later).
+ If multiple such invalidations arrive, those areas may be lumped
+ together for a block update.
+ The update takes place when the windowGroup process gets a chance to
+ process expose events."
+
+ |yTop visLineNr|
+
+ visLineNr := self listLineToVisibleLine:line.
+ visLineNr notNil ifTrue:[
+ yTop := self yOfVisibleLine:visLineNr.
+ yTop isNil ifTrue:[^ self]. "/ not visible
+ (yTop + fontHeight) < 0 ifTrue:[^ self]. "/ not visible
+ self
+ invalidateDeviceRectangle:(Rectangle
+ left:margin top:yTop-(lineSpacing//2)
+ width:(width - (2 * margin)) height:fontHeight)
+ repairNow:false.
+ ]
+
+ "Created: / 5.3.1998 / 01:24:19 / cg"
+ "Modified: / 5.3.1998 / 13:41:31 / cg"
+! !
+
+!ListView methodsFor:'event handling'!
+
+contentsChanged
+ "size of contents changed - move origin up if possible"
+
+ |listSize newOrigin|
+
+ shown ifTrue:[
+ list notNil ifTrue:[
+ listSize := self numberOfLines.
+
+ listSize == 0 ifTrue:[
+ widthOfWidestLine := 0.
+ ].
+
+ "
+ if we are beyond the end, scroll up a bit
+ "
+ ((firstLineShown + nFullLinesShown) > listSize) ifTrue:[
+ newOrigin := listSize - nFullLinesShown + 1.
+ newOrigin < 1 ifTrue:[
+ newOrigin := 1
+ ].
+ self scrollToLine: newOrigin.
+ ].
+ ].
+ ].
+
+ ^ super contentsChanged
+
+ "Modified: 18.11.1996 / 19:50:07 / stefan"
+ "Modified: 5.3.1997 / 15:50:46 / cg"
+!
+
+keyPress:key x:x y:y
+ "a key was pressed - handle page-keys here"
+
+ <resource: #keyboard (#PreviousPage #NextPage #HalfPageUp #HalfPageDown
+ #BeginOfText #EndOfText
+ #ScrollUp #ScrollDown )>
+ |n|
+
+ (key == #PreviousPage) ifTrue: [^ self pageUp].
+ (key == #NextPage) ifTrue: [^ self pageDown].
+ (key == #HalfPageUp) ifTrue: [^ self halfPageUp].
+ (key == #HalfPageDown) ifTrue: [^ self halfPageDown].
+
+ (key == #BeginOfText) ifTrue:[^ self scrollToTop].
+ (key == #EndOfText) ifTrue:[^ self scrollToBottom].
+
+ (key == #ScrollUp) ifTrue:[
+ n := 1 + (self sensor compressKeyPressEventsWithKey:#ScrollUp).
+ ^ self scrollUp:n
+ ].
+ (key == #ScrollDown) ifTrue:[
+ n := 1 + (self sensor compressKeyPressEventsWithKey:#ScrollDown).
+ ^ self scrollDown:n
+ ].
+
+ super keyPress:key x:x y:y
+!
+
+mapped
+ self stopAutoScroll.
+ super mapped
+!
+
+mouseWheelZoom:amount
+ "CTRL-wheel action"
+
+ |oldSize newSize delta mul currentFont|
+
+ amount > 0 ifTrue:[
+ "/ delta := 1. mul := 1.
+ delta := 0. mul := 1.2.
+ ] ifFalse:[
+ "/ delta := -1. mul := 1.
+ delta := 0. mul := 0.8.
+ ].
+
+ currentFont := gc font.
+ currentFont sizeUnit == #px ifFalse:[
+ oldSize := currentFont size.
+ newSize := ((oldSize + delta)* mul) max:2.
+ newSize ~= oldSize ifTrue:[
+ self font:(currentFont asSize:newSize).
+ ]
+ ].
+!
+
+redrawX:x y:y width:w height:h
+ "a region must be redrawn"
+
+ |startCol endCol line saveClip
+ startLine "{ Class:SmallInteger }"
+ stopLine "{ Class:SmallInteger }"
+ |
+
+ shown ifFalse:[^ self].
+
+ startLine := self visibleLineOfY:y.
+ stopLine := self visibleLineOfY:(y + h).
+
+ saveClip := gc clippingBoundsOrNil.
+ self clippingRectangle:(Rectangle left:x top:y width:w height:h).
+ self paint:bgColor.
+ self fillRectangleX:x y:y width:w height:h.
+ backgroundAlreadyClearedColor := bgColor.
+
+ (includesNonStrings or:[w > (width // 4 * 3)]) ifTrue:[
+ "includes non strings or area is big enough: redraw whole lines"
+ self redrawFromVisibleLine:startLine to:stopLine
+ ] ifFalse:[
+ line := self visibleAt:startLine.
+
+ (fontIsFixedWidth and:[line isMemberOf:String]) ifFalse:[
+ "start/end col has to be computed for each line"
+
+ startLine to:stopLine do:[:i |
+ startCol := self colOfX:x inVisibleLine:i.
+ endCol := self colOfX:(x + w) inVisibleLine:i.
+ startCol > 0 ifTrue:[
+ endCol > 0 ifTrue:[
+ self redrawVisibleLine:i from:startCol to:endCol
+ ]
+ ]
+ ]
+ ] ifTrue:[
+ "start/end col is the same for all lines"
+ startCol := self colOfX:x inVisibleLine:startLine.
+ endCol := self colOfX:(x + w) inVisibleLine:startLine.
+ startCol > 0 ifTrue:[
+ endCol > 0 ifTrue:[
+ startLine to:stopLine do:[:i |
+ line := self visibleAt:i.
+ (line isMemberOf:String) ifTrue:[
+ self redrawVisibleLine:i from:startCol to:endCol
+ ] ifFalse:[
+ self redrawVisibleLine:i
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ backgroundAlreadyClearedColor := nil.
+ self clippingRectangle:saveClip.
+!
+
+sizeChanged:how
+ "size changed - move origin up if possible"
+
+ super sizeChanged:how.
+
+ self computeNumberOfLinesShown.
+
+ innerWidth := width - textStartLeft - margin.
+
+"/ Makes trouble when fighting with SelListViews sizeChanged-positioning ...
+"/
+"/ shown ifFalse:[^ self].
+"/ list isNil ifTrue:[^ self].
+"/
+"/ listSize := self numberOfLines.
+"/ "
+"/ if we are beyond the end, scroll up a bit
+"/ "
+"/ ((firstLineShown + nFullLinesShown) >= listSize) ifTrue:[
+"/ self scrollToBottom.
+"/ ^ self
+"/ ].
+
+ "Modified: / 18.11.1996 / 19:37:02 / stefan"
+ "Modified: / 27.1.1998 / 14:10:04 / cg"
+!
+
+unmap
+ self stopAutoScroll.
+ super unmap
+! !
+
+!ListView methodsFor:'initialization'!
+
+create
+ super create.
+
+ "I cache font parameters here - they are used so often ..."
+ self getFontParameters.
+ self computeNumberOfLinesShown.
+ fgColor := fgColor onDevice:self graphicsDevice.
+ bgColor := bgColor onDevice:self graphicsDevice
+!
+
+defaultControllerClass
+ self class == ListView ifTrue:[^ ListViewController].
+ ^ super defaultControllerClass
+!
+
+fetchDeviceResources
+ "fetch device colors, to avoid reallocation at redraw time"
+
+ super fetchDeviceResources.
+
+ fgColor notNil ifTrue:[fgColor := fgColor onDevice:self graphicsDevice].
+ bgColor notNil ifTrue:[bgColor := bgColor onDevice:self graphicsDevice].
+
+ "Created: 14.1.1997 / 00:12:12 / cg"
+!
+
+initStyle
+ "setup viewStyle specifics"
+
+ |n|
+
+ super initStyle.
+
+ n := DefaultTopMargin.
+ n isInteger ifFalse:[
+ n := (self verticalPixelPerMillimeter:n) rounded.
+ ].
+ self topMargin:n.
+
+ n := DefaultLeftMargin.
+ n isInteger ifFalse:[
+ n := (self verticalPixelPerMillimeter:n) rounded.
+ ].
+ self leftMargin:n.
+
+ lineSpacing := 2.
+ "/ q&d temporary hack.
+ "/ X11 fonts are currently so ugly... add more spacing.
+ self graphicsDevice platformName = #X11 ifTrue:[
+ lineSpacing := lineSpacing + 3.
+ ].
+ fgColor := DefaultForegroundColor.
+ bgColor := DefaultBackgroundColor.
+
+ "Modified (comment): / 05-10-2011 / 15:51:02 / az"
+!
+
+initialize
+ super initialize.
+
+ viewOrigin := 0@0.
+
+ textStartTop := topMargin + margin.
+
+ bitGravity := #NorthWest.
+ list := nil.
+ firstLineShown := 1.
+ nFullLinesShown := 1. "just any value ..."
+ nLinesShown := 1. "just any value"
+ partialLines := true.
+ tabPositions := UserDefaultTabPositions ? DefaultTabPositions.
+ includesNonStrings := false.
+ lineEndCRLF := false.
+ checkedLinesForWidthOfContentsComputation := nil."/ i.e. all
+ self getFontParameters.
+ self initializeWordCheckAction.
+
+ scrollWhenUpdating := #keep. "/ #beginOfText.
+ expandTabsWhenUpdating := true.
+ compareModelOnUpdate := true.
+ checkLineEndConventionWhenUpdating := true.
+ scrollLocked := false.
+ autoScroll := true.
+
+ "Modified: / 03-07-2006 / 17:03:59 / cg"
+!
+
+initializeWordCheckAction
+ "the wordCheck is a predicate block which returns true if the given character
+ belongs to the (textual) word. Used with double click to select a word.
+ When editing code, typically characters which are part of an identifier
+ are part of a word (underline, dollar, but no other non-letters).
+ The standardWordCheck aks the current userPreferences for details."
+
+ wordCheck := [:char | self standardWordCheck:char].
+
+ "Created: / 03-07-2006 / 17:03:50 / cg"
+!
+
+realize
+ |sz|
+
+ self extentChangedFlag ifTrue:[
+ self computeNumberOfLinesShown.
+ ].
+
+ firstLineShown ~~ 1 ifTrue:[
+ sz := self size.
+ firstLineShown + nLinesShown > sz ifTrue:[
+ self scrollToLine:sz - nLinesShown.
+ ]
+ ].
+
+ super realize.
+
+"/ old: fetch models value on realize;
+"/ new: fetch value when model is assigned.
+"/
+"/ model notNil ifTrue:[
+"/ self getListFromModel.
+"/ ]
+
+ "Modified: 15.8.1996 / 13:08:56 / stefan"
+ "Modified: 28.2.1997 / 19:44:19 / cg"
+!
+
+recreate
+ "recreate after a snapin or a migration"
+ |n|
+
+ super recreate.
+
+ "
+ recompute margins and font parameters
+ - display may have different resolution/font sizes.
+ "
+"/ topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
+"/ self leftMargin:(self horizontalPixelPerMillimeter:0.5) rounded.
+
+ n := DefaultTopMargin.
+ n isInteger ifFalse:[
+ n := (self verticalPixelPerMillimeter:n) rounded.
+ ].
+ self topMargin:n.
+
+ n := DefaultLeftMargin.
+ n isInteger ifFalse:[
+ n := (self verticalPixelPerMillimeter:n) rounded.
+ ].
+ self leftMargin:n.
+
+ self getFontParameters
+
+ "Modified: / 26.9.1998 / 17:09:32 / cg"
+! !
+
+!ListView methodsFor:'private'!
+
+absoluteLineToVisibleLine:absLineNr
+ "given an absolute line (1..) return visible linenr or nil"
+
+ <resource:#obsolete>
+ self obsoleteMethodWarning:'use #listLineToVisibleLine:'.
+ ^ self listLineToVisibleLine:absLineNr
+
+"/ absLineNr isNil ifTrue:[^ nil].
+"/ (absLineNr < firstLineShown) ifTrue:[^ nil].
+"/ (absLineNr >= (firstLineShown + nLinesShown)) ifTrue:[^ nil].
+"/ ^ absLineNr - firstLineShown + 1
+"/
+!
+
+checkForExistingLine:lineNr
+ "check if a line for lineNr exists; if not, expand text"
+
+ list isNil ifTrue: [
+ list := StringCollection new:lineNr.
+ self contentsChanged
+ ] ifFalse: [
+ lineNr > (list size) ifTrue:[
+ self grow:lineNr.
+ self contentsChanged
+ ]
+ ]
+!
+
+colOfX:x inVisibleLine:visLineNr
+ "given a visible lineNr and x-coordinate, return colNr"
+
+ |lineString linePixelWidth xRel runCol posLeft posRight done
+ hasEmphasis oPosRight oPosLeft|
+
+ xRel := x - textStartLeft + viewOrigin x.
+ (xRel <= 0) ifTrue:[^ 1].
+
+ lineString := self visibleAt:visLineNr.
+
+ "
+ for fix fonts, this is easy ...
+ "
+ (fontIsFixedWidth
+ and:[lineString isNil
+ or:[lineString hasChangeOfEmphasis not]]) ifTrue:[
+ ^ (xRel // fontWidth) + 1
+ ].
+
+ "
+ for variable fonts, more work is required ...
+ "
+ lineString notNil ifTrue:[
+ lineString := self visibleStringFrom:lineString.
+ (hasEmphasis := lineString hasChangeOfEmphasis) ifTrue:[
+ linePixelWidth := lineString widthOn:self
+ ] ifFalse:[
+ lineString := lineString string.
+ linePixelWidth := gc font widthOf:lineString.
+ ]
+ ] ifFalse:[
+ linePixelWidth := 0
+ ].
+
+ (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
+ ].
+
+ "/ cannot simply count individual characters,
+ "/ since kerning or other non-linear effects may be involved ...
+ "/ use a binary search, initialized with some guess.
+
+ "/ a guess: take some 'average' character's width and compute an initial guess
+ runCol := x // (gc font widthOf:'e').
+ runCol := runCol min:lineString size.
+
+"/ runCol := lineString size // 2.
+"/ (runCol == 0) ifTrue:[runCol := 1].
+
+ hasEmphasis ifTrue:[
+ posLeft := (lineString copyFrom:1 to:(runCol - 1)) widthOn:self.
+ posRight := (lineString copyFrom:1 to:runCol) widthOn:self.
+ ] ifFalse:[
+ posLeft := gc font widthOf:lineString from:1 to:(runCol - 1).
+ posRight := gc font widthOf:lineString from:1 to:runCol.
+ ].
+
+ done := (posLeft <= xRel) and:[posRight > xRel].
+
+ [done] whileFalse:[
+ oPosRight := posRight.
+ oPosLeft := posLeft.
+
+ (posRight <= xRel) ifTrue:[
+ runCol := runCol + 1.
+ posLeft := posRight.
+ hasEmphasis ifTrue:[
+ posRight := (lineString copyFrom:1 to:runCol) widthOn:self.
+ ] ifFalse:[
+ posRight := gc font widthOf:lineString from:1 to:runCol
+ ]
+ ] ifFalse:[
+ (posLeft > xRel) ifTrue:[
+ runCol := runCol - 1.
+ (runCol == 0) ifTrue:[^ 0].
+ posRight := posLeft.
+ hasEmphasis ifTrue:[
+ posLeft := (lineString copyFrom:1 to:(runCol - 1)) widthOn:self.
+ ] ifFalse:[
+ posLeft := gc font widthOf:lineString from:1 to:(runCol - 1)
+ ]
+ ]
+ ].
+ done := (posLeft <= xRel) and:[posRight > xRel].
+"234567890123456789012345678901234567890"
+ ((oPosRight == posRight) and:[oPosLeft == posLeft]) ifTrue:[
+ "/ paranoia: just in case there are unprintable characters
+ "/ (avoid endless loop if the binary search does not make progress)
+ done := true.
+ ]
+ ].
+"/self paint:Color red.
+"/self displayRectangleX:posLeft+textStartLeft-viewOrigin x y:(self yOfVisibleLine:visLineNr)
+"/ width:(posRight-posLeft) height:fontHeight.
+"/self paint:Color black.
+ ^ runCol
+
+ "Modified: / 25-04-2011 / 11:26:58 / cg"
+ "Modified: / 02-05-2011 / 14:08:54 / sr"
+!
+
+computeNumberOfLinesShown
+ "recompute the number of visible lines"
+
+ |innerHeight|
+
+ innerHeight := self innerHeight.
+ nFullLinesShown := (innerHeight + lineSpacing) // fontHeight.
+ nLinesShown := nFullLinesShown.
+
+ partialLines ifTrue:[
+ ((nLinesShown * fontHeight) < innerHeight) ifTrue:[
+ nLinesShown := nLinesShown + 1
+ ]
+ ]
+
+ "Modified: 29.5.1996 / 14:48:43 / cg"
+!
+
+convertRTF:aList
+ <resource: #obsolete>
+ "this is a q&d RTF to poor-text converter which removes any rich stuff.
+ - a first shot 'til DocumentView is finished ..."
+
+ |newList newLine charIndex inEscape char special|
+
+ self obsoleteMethodWarning.
+
+ newList := StringCollection new:200.
+ newList grow:0.
+
+ newLine := ''.
+ aList do:[:line |
+ ((line size == 0) or:[line isBlank]) ifTrue:[
+ newList add:newLine.
+ newLine := ''
+ ] ifFalse:[
+ special := ((line at:1) == ${) or:[(line includes:$\)].
+ special := special or:[(line at:1) == $}].
+ special ifFalse:[
+ newList add:(newLine , line)
+ ] ifTrue:[
+ charIndex := 1.
+ [charIndex <= line size] whileTrue:[
+ char := line at:charIndex.
+ ((char == ${ ) or:[char == $} ]) ifTrue:[
+ "left-brace: ignore rest of line"
+ charIndex := line size + 1
+ ] ifFalse:[
+ (char == $\) ifTrue:[
+ inEscape := true
+ ] ifFalse:[
+ inEscape ifTrue:[
+ (char == Character space) ifTrue:[
+ inEscape := false
+ ]
+ ] ifFalse:[
+ newLine := newLine copyWith:char
+ ]
+ ].
+ charIndex := charIndex + 1
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ newList
+
+ "Modified: 18.5.1996 / 14:03:16 / cg"
+!
+
+enqueueDelayedContentsChangedNotification
+ "because contentschanged may be slow (recomputing width of widest line),
+ we delay its execution by pushing it onto the event queue.
+ This has the effect of allowing for multiple add-lines before recomputing.
+ Much speeding up inserting into long lists"
+
+ |sensor|
+
+ sensor := self sensor.
+ (sensor hasUserEvent:#contentsChanged for:self) ifFalse:[
+ sensor pushUserEvent:#contentsChanged for:self
+ ].
+ "/ used to be syncronous:
+ "/ self contentsChanged. "recompute scrollbars"
+
+ "Created: / 25-07-2012 / 11:59:58 / cg"
+!
+
+getFontParameters
+ "get some info of the used font. They are cached since we use them often ..
+ The code below uses the fonts average height parameters - these
+ are not OK for some oversized national characters (such as A-dieresis).
+ Therefore, this method should be redefined in views which will be used
+ with national characters (i.e. editTextViews)."
+
+ |hMax newDeviceFont|
+
+ newDeviceFont := gc createFontOnDevice.
+ hMax := newDeviceFont height.
+
+ includesNonStrings == true ifTrue:[
+ "/
+ "/ find maximum height of lines
+ "/
+ hMax := list inject:hMax into:[:maxSoFar :thisLine |
+ thisLine isNil ifTrue:[
+ maxSoFar
+ ] ifFalse:[
+ (thisLine isMemberOf:String) ifTrue:[
+ maxSoFar
+ ] ifFalse:[
+ maxSoFar max:(thisLine heightOn:self)
+ ]
+ ]
+ ].
+
+ ].
+ fontHeight := newDeviceFont maxHeight.
+ "/ fontHeight := font height.
+ fontHeight := fontHeight max:(hMax + lineSpacing).
+ fontAscent := newDeviceFont ascent. "/ maxAscent. -- see SelectionInListViews selection in motif style
+ "/ fontAscent := font maxAscent "ascent". "/ maxAscent. -- see SelectionInListViews selection in motif style
+ "/ fontAscent := (font maxAscent + font ascent) // 2. "/ maxAscent. -- see SelectionInListViews selection in motif style
+ fontWidth := newDeviceFont width.
+ fontIsFixedWidth := newDeviceFont isFixedWidth.
+
+ "Modified: 3.7.1997 / 12:24:25 / cg"
+!
+
+getListFromModel
+ "ask my model (if any) for the text via the listMsg.
+ If there is no listMessage, try aspect for backward compatibility."
+
+ |newText msg|
+
+ model notNil ifTrue:[
+ msg := listMsg ? aspectMsg.
+
+ msg notNil ifTrue:[
+ newText := model perform:msg.
+ "/ cg: this makes many optimizations (virtualArray) useless;
+ "/ I do not think that this is a good idea:
+ "/ text notNil ifTrue:[
+ "/ so I changed it to:
+ (newText notNil and:[newText isString]) ifTrue:[
+ newText := newText asStringCollection.
+ ].
+
+ compareModelOnUpdate ifTrue:[
+ "/ see if there is a change at all.
+ "/ use to compare using =, but that's not enough in case of emphasis change.
+ newText size == list size ifTrue:[
+ |same|
+
+ same := true.
+ newText size > 0 ifTrue:[
+ newText with:list do:[:eachNewLine :eachOldLine |
+ (eachNewLine == eachOldLine) ifFalse:[
+ same := false.
+ ]
+ ]
+ ].
+ same ifTrue:[^ self].
+ ].
+ ].
+
+ "/ SV: this compare does not work, if model uses (i.e. updates)
+ "/ the same stringCollection as the view!!
+ true "text ~= list" ifTrue:[
+ "/ changed #list to care for scrollLocked
+"/ scrollLocked ifTrue:[
+"/ self setList:newText expandTabs:expandTabsWhenUpdating
+"/ ] ifFalse:[
+ self list:newText expandTabs:expandTabsWhenUpdating scanForNonStrings:expandTabsWhenUpdating
+"/ ]
+ ].
+ ].
+ ].
+
+ "Modified: 26.4.1996 / 14:09:42 / cg"
+ "Modified: 19.2.1997 / 12:08:50 / stefan"
+!
+
+getListFromModelScroll:aBoolean
+ "ask my model (if any) for the text via the listMsg.
+ If there is no listMessage, try aspect for backward compatibility.
+ If aBoolean is false, scrolling is suppressed here"
+
+ |prev|
+
+ prev := scrollLocked.
+ scrollLocked := aBoolean not.
+ [
+ self getListFromModel
+ ] ensure:[
+ scrollLocked := prev.
+ ].
+!
+
+line:line withoutEmphasis:emphasisToRemove
+ (line notNil
+ and:[line isString]) ifTrue:[
+ ^ line withoutEmphasis:emphasisToRemove.
+ ].
+ ^ line
+!
+
+listAt:lineNr from:startCol
+ "return right substring from startCol to end of a line"
+
+ |line|
+
+ line := self listAt:lineNr.
+ line isNil ifTrue:[^ nil].
+ (startCol > line size) ifTrue:[^ nil].
+ ^ line copyFrom:startCol
+!
+
+listAt:lineNr from:startCol to:endCol
+ "return substring from startCol to endCol of a line"
+
+ |line lineLen nCols|
+
+ nCols := (endCol - startCol + 1).
+
+ line := self listAt:lineNr.
+ lineLen := line size.
+
+ (line isNil or:[startCol > lineLen]) ifTrue:[
+ (nCols > 0) ifTrue:[
+ ^ (String new:nCols)
+ ].
+ ^ nil
+ ].
+
+ (endCol > lineLen) ifTrue:[
+ ^ (line copyFrom:startCol to:lineLen) , (String new:(endCol-lineLen))
+ ].
+ ^ line copyFrom:startCol to:endCol
+!
+
+listAt:lineNr to:endCol
+ "return left substring from start to endCol of a line"
+
+ |line lineSize|
+
+ line := self listAt:lineNr.
+ line isNil ifTrue:[
+ (endCol > 0) ifTrue:[
+ ^ (String new:endCol)
+ ].
+ ^ nil
+ ].
+
+ lineSize := line size.
+
+ (endCol > lineSize) ifTrue:[
+ ^ (line copyTo:lineSize) , (String new:(endCol - lineSize)).
+ ].
+ ^ line copyTo:endCol
+!
+
+listLineIsVisible:listLineNr
+ "return true, if a particular line is visible"
+
+ |visibleLineNr "{ Class: SmallInteger }"|
+
+ shown ifFalse:[^ false].
+ listLineNr isNil ifTrue:[^ false].
+ visibleLineNr := listLineNr + 1 - firstLineShown.
+ ^ (visibleLineNr between:1 and:nLinesShown)
+
+ "Created: / 26.7.1998 / 13:24:16 / cg"
+!
+
+listLineToVisibleLine:listLineNr
+ "given a list line (1..) return visible linenr or nil"
+
+ |visibleLineNr "{ Class: SmallInteger }"|
+
+ shown ifFalse:[^ nil].
+ listLineNr isNil ifTrue:[^ nil].
+ visibleLineNr := listLineNr - firstLineShown + 1.
+ (visibleLineNr between:1 and:nLinesShown) ifFalse:[^ nil].
+ ^ visibleLineNr
+!
+
+recomputeWidthOfWidestLineFor:aString
+ <resource: #obsolete>
+ self recomputeWidthOfWidestLineFor:aString old:nil
+!
+
+recomputeWidthOfWidestLineFor:newEntry old:oldEntry
+ "a new line was added (oldEntry == nil) or replaced oldEntry.
+ Update the widthOfWidestLine cache or flush it, if we cannot easily
+ figure out the overall text width"
+
+ |newW oldW|
+
+ widthOfWidestLine notNil ifTrue:[
+ newEntry isNil ifTrue:[
+ newW := 0
+ ] ifFalse:[
+ (newEntry isMemberOf:String) ifTrue:[
+ newW := gc font widthOf:newEntry
+ ] ifFalse:[
+ newW := newEntry widthOn:self
+ ].
+ ].
+
+ newW >= widthOfWidestLine ifTrue:[
+ widthOfWidestLine := newW.
+ ] ifFalse:[
+ oldEntry isNil ifTrue:[
+ oldW := 0
+ ] ifFalse:[
+ (oldEntry isMemberOf:String) ifTrue:[
+ oldW := gc font widthOf:oldEntry
+ ] ifFalse:[
+ oldW := oldEntry widthOn:self
+ ].
+ ].
+ newW > oldW ifTrue:[
+ "/ no change; new entries width is between this width and amx width
+ ] ifFalse:[
+ "/ new entry is smaller than oldEntry; if the oldEntry was the previos max,
+ "/ we don't know the new max
+ oldW = widthOfWidestLine ifTrue:[
+ widthOfWidestLine := nil "/ means: unknown
+ ] ifFalse:[
+ "/ old line was not the widest, and new line is shorter;
+ "/ no change
+ ]
+ ]
+ ].
+ ].
+ ^ widthOfWidestLine
+!
+
+suppressEmphasisInSelection
+ "selection is shown with original emphasis"
+
+ ^ false
+!
+
+textChanged
+ "ignored here"
+!
+
+visibleAt:visibleLineNr
+ "return what is visible at line (numbers start at 1).
+ This is used for redrawing; i.e. for non-string entries, this
+ returns the original."
+
+ |listLineNr listsize|
+
+ listLineNr := visibleLineNr + firstLineShown - 1.
+ (listLineNr == 0) ifTrue:[^ nil].
+ (list notNil) ifTrue:[
+ listsize := self size
+ ] ifFalse:[
+ listsize := 0
+ ].
+ (listLineNr <= listsize) ifTrue:[^ self at:listLineNr].
+ ^ ''
+!
+
+visibleLineOfY:y
+ "given a y-coordinate, return the visible lineNr
+ - works for fix-height fonts only"
+
+ ^ (((y - textStartTop) // fontHeight) + 1) max:1
+
+ "Modified: / 13.2.1998 / 20:57:26 / stefan"
+!
+
+visibleLineToAbsoluteLine:visibleLineNr
+ "given a visible line (1..) return absolut linenr"
+
+ visibleLineNr isNil ifTrue:[^ nil].
+ ^ visibleLineNr + firstLineShown - 1
+!
+
+visibleLineToListLine:visibleLineNr
+ "given a visible line (1..) return linenr in list or nil
+ (this one returns nil if the given visibleLineNr is one of the
+ separators)"
+
+ |listLineNr "{ Class: SmallInteger }"
+ listsize "{ Class: SmallInteger }" |
+
+ visibleLineNr isNil ifTrue:[^ nil].
+ listLineNr := visibleLineNr + firstLineShown - 1.
+ (listLineNr == 0) ifTrue:[^nil].
+ listsize := self size.
+ (listLineNr <= listsize) ifTrue:[^ listLineNr].
+ ^ nil
+!
+
+visibleStringFrom:aString
+ ^ aString asString
+!
+
+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."
+
+ ^ innerWidth
+
+"/ "for small width, its not worth searching for
+"/ longest line ...
+"/ "
+"/ (width < 300) ifTrue:[^ innerWidth].
+"/
+"/ "for large lists, search may take longer than scrolling full
+"/ "
+"/ self size > 2000 ifTrue:[^ innerWidth].
+"/
+"/ "
+"/ if there is a pattern-background, we have to scroll everything
+"/ "
+"/ (viewBackground isColor not
+"/ or:[viewBackground isDithered]) ifTrue:[
+"/ ^ width
+"/ ].
+"/
+"/ w := self widthOfWidestLineBetween:firstLine and:lastLine.
+"/ (w > innerWidth) ifTrue:[^ innerWidth].
+"/ ^ w
+
+ "Modified: 17.1.1997 / 17:44:12 / cg"
+!
+
+widthOfLineString:entry
+ "return the width of an entry"
+
+ entry isNil ifTrue:[^ 0].
+ (entry isMemberOf:String) ifTrue:[
+ ^ gc font widthOf:entry
+ ].
+ ^ entry widthOn:self
+
+ "Modified: 12.5.1996 / 20:09:53 / cg"
+!
+
+widthOfWidestLineBetween:firstLine and:lastLine
+ "return the width in pixels of the widest line in a range
+ - used to optimize scrolling, by limiting the scrolled area"
+
+ |max "{ Class: SmallInteger }"
+ first "{ Class: SmallInteger }"
+ last "{ Class: SmallInteger }"
+ thisLen "{ Class: SmallInteger }"
+ listSize "{ Class: SmallInteger }" |
+
+ includesNonStrings ifTrue:[
+ ^ width
+ ].
+
+ fontIsFixedWidth ifTrue:[
+ ^ (self lengthOfLongestLineBetween:firstLine and:lastLine) * fontWidth
+ ].
+ listSize := self size.
+ max := 0.
+ first := firstLine.
+ last := lastLine.
+
+ (first > listSize) ifTrue:[^ max].
+ (last > listSize) ifTrue:[
+ last := listSize
+ ].
+
+ self from:first to:last do:[:line |
+ line notNil ifTrue:[
+ (line isMemberOf:String) ifTrue:[
+ thisLen := gc font widthOf:line
+ ] ifFalse:[
+ thisLen := line widthOn:self
+ ].
+ (thisLen > max) ifTrue:[
+ max := thisLen
+ ]
+ ]
+ ].
+ ^ max
+!
+
+withoutAnyColorEmphasis:line
+ (line notNil and:[line isText]) ifTrue:[
+ ^ line withoutAnyColorEmphasis
+ ].
+ ^ line
+
+ "
+ 'hello' asText colorizeAllWith:Color red.
+ ('hello' asText colorizeAllWith:Color red) withoutForegroundColorEmphasis.
+ ('hello' asText colorizeAllWith:Color red) withoutAnyColorEmphasis.
+ "
+
+ "Modified (comment): / 06-03-2012 / 18:16:41 / cg"
+!
+
+withoutBackgroundColorEmphasis:line
+ (line notNil and:[line isText]) ifTrue:[
+ ^ line withoutBackgroundColorEmphasis
+ ].
+ ^ line
+!
+
+withoutColorEmphasis:line
+ (line notNil and:[line isText]) ifTrue:[
+ ^ line withoutForegroundColorEmphasis
+ ].
+ ^ line
+!
+
+withoutColorEmphasis:line ifFg:fg andBg:bg
+ "/ remove lines color emphasis, to enforce color.
+ "/ otherwise blue text is not visible if selection-bg is blue
+
+ (line notNil
+ and:[line isText
+ and:[fg ~= fgColor or:[bg ~= bgColor]]]) ifTrue:[
+ ^ line withoutAnyColorEmphasis
+ ].
+ ^ line
+
+ "Created: / 15-12-1999 / 23:19:30 / cg"
+!
+
+xOfCol:col inVisibleLine:visLineNr
+ "given a visible line- and colNr, return the x-coordinate in view"
+
+ |line lineSize tcol lText|
+
+ col == 1 ifTrue:[
+ lText := 0
+ ] ifFalse:[
+ tcol := col - 1.
+
+ line := self visibleAt:visLineNr.
+ (fontIsFixedWidth
+ and:[line isNil or:[line isMemberOf:String]])
+ ifTrue:[
+ lText := (tcol * fontWidth)
+ ] ifFalse:[
+ line notNil ifTrue:[
+ lineSize := line string size
+ ] ifFalse:[
+ lineSize := 0
+ ].
+ (lineSize == 0) ifTrue:[
+ lText := (tcol * fontWidth)
+ ] ifFalse:[
+ (lineSize < col) ifTrue:[
+ lText := (line widthOn:self) + (fontWidth * (tcol - lineSize))
+ ] ifFalse:[
+ (line isMemberOf:String) ifTrue:[
+ lText := (gc font widthOf:line from:1 to:tcol)
+ ] ifFalse:[
+ lText := line widthFrom:1 to:tcol on:self.
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ lText + textStartLeft
+
+ "Modified: / 3.9.1998 / 21:56:33 / cg"
+!
+
+yOfLine:lineNr
+ "given a physical lineNr, return y-coordinate in view
+ - works for fix-height fonts only"
+
+ |visLine|
+
+ visLine := self listLineToVisibleLine:lineNr.
+ visLine isNil ifTrue:[
+ ^ nil
+ ].
+ ^ self yOfVisibleLine:visLine
+
+ "Created: / 26.7.1998 / 13:23:16 / cg"
+!
+
+yOfVisibleLine:visLineNr
+ "given a visible lineNr, return y-coordinate in view
+ - works for fix-height fonts only"
+
+ "/ care for visLineNr being nil during initialization
+ ^ (((visLineNr ? 1) - 1) * fontHeight) + textStartTop
+!
+
+yVisibleToLineNr:yVisible
+ |vL|
+
+ vL := self visibleLineOfY:yVisible.
+ ^ self visibleLineToListLine:vL
+
+ "Created: / 20-09-2006 / 15:29:12 / cg"
+! !
+
+!ListView methodsFor:'queries'!
+
+characterPositionOfLine:lineNr col:colArg
+ "given a line/col position, return the character index within the contents-string,
+ - used with compiler's error-positioning, which is based on character positions
+ of the contents-string."
+
+ |lineString charPos lineEndCharSize col|
+
+ lineEndCharSize := self lineEndCRLF ifTrue:[2] ifFalse:[1].
+
+ self checkForExistingLine:lineNr.
+ charPos := 1.
+ 1 to:(lineNr - 1) do:[:lnr |
+ lineString := self at:lnr.
+ lineString notNil ifTrue:[
+ charPos := charPos + (lineString string "withoutTrailingSeparators") size
+ ].
+ charPos := charPos + lineEndCharSize "the return-character"
+ ].
+
+ "/ if beyond end of line, be careful to not advance into next line.
+ "/ otherwise, syntaxHighlighter (and others) walk into trouble,
+ "/ if clicked on a space beyond a line's end.
+ col := colArg min:((self at:lineNr) size + 1).
+ ^ charPos + col - 1
+
+ "Modified: / 04-07-2006 / 19:14:25 / fm"
+ "Modified: / 21-08-2011 / 11:03:19 / cg"
+!
+
+colOfCharacterPosition:charPos
+ "given a character index within the contents-string,
+ return the column number where the character is
+ - used to find line to hilight from Compilers error-position"
+
+ |line|
+
+ line := self lineOfCharacterPosition:charPos.
+ ^ charPos - (self characterPositionOfLine:line col:1) + 1.
+
+!
+
+currentLine
+ "the current line (for relative gotos);
+ since listViews have no cursor, the first shown line is returned here.
+ Redefined in editTextView, to return the cursors line."
+
+ ^ firstLineShown
+
+ "Created: / 17.5.1998 / 20:07:36 / cg"
+!
+
+firstLineShown
+ "return the index of the first (possibly partial) visible line"
+
+ ^ firstLineShown
+!
+
+heightForLines:numberOfLines
+ "return the height of the receiver, if numberOfLines are to be displayed"
+
+ |realFont|
+
+ "need a device font for query"
+ realFont := gc createFontOnDevice.
+ ^ numberOfLines * fontHeight + topMargin + realFont descent + (lineSpacing) + (margin * 2)
+
+ "Created: 27.1.1996 / 16:55:39 / cg"
+!
+
+heightOfContents
+ "return the height of the contents in pixels
+ - used for scrollbar interface"
+
+ | numLines realFont|
+
+ numLines := self numberOfLines.
+ numLines == 0 ifTrue:[^ 0].
+
+ "/
+ "/ kludge for last partial line
+ "/
+"/ nFullLinesShown ~~ nLinesShown ifTrue:[
+"/ numLines := numLines + 1
+"/ ].
+ "
+ need device-font for query
+ "
+ realFont := gc createFontOnDevice.
+ ^ numLines * fontHeight "dont take font height here - think of LabelAndIcons"
+"/ + textStartTop
+ - (lineSpacing // 2)
+ + (realFont descent)
+"/ + (font descent)
+"/ + (font descent * 2) "makes it look better"
+ .
+
+"/ "it used to be that code - which is wrong"
+"/ (nLinesShown == nFullLinesShown) ifTrue:[
+"/ ^ numLines * fontHeight
+"/ ].
+"/ "add one - otherwise we cannot make last line
+"/ fully visible since scrolling is done by full lines only"
+"/
+"/ ^ (numLines + 1) * fontHeight
+!
+
+lastLineShown
+ "return the index of the last (possibly partial) visible line"
+
+ ^ firstLineShown + nLinesShown
+!
+
+leftIndentOfLine:lineNr
+ "return the number of spaces at the left in line, lineNr.
+ returns 0 for empty lines."
+
+ |lineString indent|
+
+ lineString := self listAt:lineNr.
+ lineString notNil ifTrue:[
+ indent := lineString leftIndent.
+ indent == lineString size ifTrue:[^ 0].
+ ^ indent.
+ ].
+ ^ 0
+
+ "Modified: 20.4.1996 / 19:30:38 / cg"
+!
+
+lengthOfLongestLine
+ "return the length (in characters) of the longest line"
+
+ ^ self lengthOfLongestLineBetween:1 and:self size
+!
+
+lengthOfLongestLineBetween:firstLine and:lastLine
+ "return the length (in characters) of the longest line in a line-range"
+
+ |max "{ Class: SmallInteger }"
+ thisLen "{ Class: SmallInteger }"
+ listSize "{ Class: SmallInteger }"
+ first "{ Class: SmallInteger }"
+ last "{ Class: SmallInteger }" |
+
+ list isNil ifTrue:[^ 0].
+
+ listSize := self size.
+ max := 0.
+ first := firstLine.
+ last := lastLine.
+
+ (first > listSize) ifTrue:[^ max].
+ (last > listSize) ifTrue:[
+ last := listSize
+ ].
+ self from:first to:last do:[:lineString |
+ lineString notNil ifTrue:[
+ thisLen := lineString size.
+ (thisLen > max) ifTrue:[
+ max := thisLen
+ ]
+ ]
+ ].
+ ^ max
+
+!
+
+lineIsFullyVisible:line
+ "is line fully visible?"
+
+ (line >= firstLineShown
+ and:[ line < (firstLineShown + nFullLinesShown) ]) ifTrue:[ ^ true ].
+ ^ false.
+
+ "Created: 26.4.1996 / 14:36:45 / cg"
+!
+
+lineIsVisible:line
+ "is line visible?"
+
+ (line >= firstLineShown and:[ line < (firstLineShown + nLinesShown) ]) ifTrue:[ ^ true ].
+ ^ false.
+!
+
+lineOfCharacterPosition:charPos
+ "given a character index within the contents-string,
+ return the lineNumber where the character is
+ - used to find line to hilight from compiler's error-position"
+
+ |lineNr sum lastLine lineEndCharSize l|
+
+ lineEndCharSize := self lineEndCRLF ifTrue:[2] ifFalse:[1].
+
+ lineNr := 1.
+ sum := 0.
+ lastLine := self size.
+ [(sum < charPos) and:[lineNr <= lastLine]] whileTrue:[
+ l := (self at:lineNr) ? ''.
+ sum := sum + (l string "withoutTrailingSeparators" size) + lineEndCharSize.
+ lineNr := lineNr + 1
+ ].
+ sum == charPos ifTrue:[
+ ^ lineNr
+ ].
+
+ ^ (lineNr - 1) max:1
+
+ "Modified: / 04-07-2006 / 19:13:32 / fm"
+ "Modified: / 21-08-2011 / 10:50:12 / cg"
+!
+
+numberOfLines
+ "return the number of lines the text has"
+
+ ^ self size
+!
+
+preferredExtentForContents
+ ^ (self widthOfContents @ self heightOfContents)
+!
+
+preferredExtentForLines:numLines cols:numCols
+ ^ (((gc font widthOf:'x') * numCols + margin + margin)
+ @
+ (fontHeight * numLines + margin + margin + gc font descent + lineSpacing + topMargin)).
+
+ "Modified: 26.5.1996 / 12:26:41 / cg"
+!
+
+supportsSyntaxElements
+ "see CodeView2::TextView"
+
+ ^ false
+!
+
+widthOfContents
+ "return the width of the contents in pixels
+ - used for scrollbar interface"
+
+ |f d
+ start "{ Class: SmallInteger }"
+ stop "{ Class: SmallInteger }"
+ lengthOfLongestString "{ Class: SmallInteger }"
+ lengthOfLongestLine "{ Class: SmallInteger }"
+ max "{ Class: SmallInteger }"|
+
+ list isEmptyOrNil ifTrue:[^ 0].
+ widthOfWidestLine notNil ifTrue:[
+ "/ already computed (cached); this cache is cleared when the contents is modified
+ ^ widthOfWidestLine + (leftMargin * 2)
+ ].
+
+ (d := gc device) isNil ifTrue:[
+ "/ mhmh - really dont know yet
+ d := Screen current
+ ].
+ f := gc font onDevice:d.
+ gc font:f.
+
+ checkedLinesForWidthOfContentsComputation isNil ifTrue:[
+ start := 1.
+ stop := list size
+ ] ifFalse:[
+ checkedLinesForWidthOfContentsComputation >= 0 ifTrue:[
+ start := 1.
+ stop := (checkedLinesForWidthOfContentsComputation min:list size)
+ ] ifFalse:[
+ stop := list size.
+ start := (list size + 1 + checkedLinesForWidthOfContentsComputation) max:1.
+ ]
+ ].
+
+ includesNonStrings ifTrue:[
+ max := 0.
+ start to:stop do:[:lineNr |
+ |entry w|
+
+ entry := list at:lineNr.
+ entry notNil ifTrue:[
+ (entry isMemberOf:String) ifTrue:[
+ w := f widthOf:entry
+ ] ifFalse:[
+ w := entry widthOn:self
+ ].
+ max := max max:w.
+ ].
+ ].
+ ] ifFalse:[
+ fontIsFixedWidth ifTrue:[
+ max := lengthOfLongestString := 0.
+ list notNil ifTrue:[
+ start to:stop do:[:lineNr |
+ |line|
+
+ line := list at:lineNr.
+ line notNil ifTrue:[
+ (line isMemberOf:String) ifTrue:[
+ line size > lengthOfLongestString ifTrue:[
+ lengthOfLongestString := line size
+ ].
+ ] ifFalse:[
+ max := max max:(line widthOn:self)
+ ]
+ ]
+ ].
+ max := max max:(lengthOfLongestString * fontWidth)
+ ].
+ ] ifFalse:[
+ max := lengthOfLongestLine := 0.
+ list notNil ifTrue:[
+ start to:stop do:[:lineNr |
+ |line len|
+
+ line := list at:lineNr.
+ line notNil ifTrue:[
+ len := line size.
+ "/ consider this a speed hack (not exact, but fast)
+ lengthOfLongestLine := lengthOfLongestLine max:len.
+ len > (lengthOfLongestLine // 3) ifTrue:[
+ max := max max:(line widthOn:self)
+ ].
+ ]
+ ].
+ ].
+ ].
+ ].
+ widthOfWidestLine := max.
+ ^ max + (leftMargin * 2)
+
+ "Modified: / 24.9.1998 / 18:21:08 / cg"
+!
+
+widthOfLine:lineNr
+ "return the width of a line in pixels"
+
+ |line f d|
+
+ list isNil ifTrue:[^ 0].
+ lineNr > list size ifTrue:[^ 0].
+ line := list at:lineNr.
+ list isNil ifTrue:[^ 0].
+
+ (d := self graphicsDevice) isNil ifTrue:[
+ "/ mhmh - really dont know yet
+ d := Screen current
+ ].
+ f := gc font onDevice:d.
+ gc font:f.
+
+ (line isMemberOf:String) ifTrue:[
+ ^ f widthOf:line
+ ].
+ ^ line widthOn:self
+
+ "Created: / 10.11.1998 / 23:59:20 / cg"
+ "Modified: / 11.11.1998 / 15:25:07 / cg"
+!
+
+xOriginOfContents
+ "return the horizontal origin of the contents in pixels
+ - used for scrollbar interface"
+
+ ^ viewOrigin x
+!
+
+yOriginOfContents
+ "return the vertical origin of the contents in pixels
+ - used for scrollbar interface"
+
+ ^ (firstLineShown - 1) * fontHeight
+! !
+
+!ListView methodsFor:'redrawing'!
+
+flash
+ "show contents in reverse colors for a moment - to wakeup the user :-)"
+
+ super flash.
+"/ self redrawInverted.
+"/ Delay waitForSeconds:0.1.
+"/ self redraw
+
+ "
+ Transcript flash
+ Transcript redrawInverted
+ Transcript redraw
+ "
+!
+
+redraw
+ "redraw complete view"
+
+ shown ifTrue:[
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
+!
+
+redrawFromLine:lineNr
+ "redraw starting at linrNr"
+
+ |visibleLine first|
+
+ shown ifTrue:[
+ "if first line to redraw is above 1st visible line,
+ start redraw at 1st visible line"
+ (lineNr < firstLineShown) ifTrue:[
+ first := firstLineShown
+ ] ifFalse:[
+ first := lineNr
+ ].
+ visibleLine := self listLineToVisibleLine:first.
+ visibleLine notNil ifTrue:[
+ self redrawFromVisibleLine:visibleLine to:nLinesShown
+ ]
+ ]
+!
+
+redrawFromLine:startLine col:startCol toLine:endLine col:endCol
+ shown ifTrue:[
+ self redrawLine:startLine from:startCol.
+ endLine > (startLine+1) ifTrue:[
+ self redrawFromLine:startLine+1 to:endLine-1
+ ].
+ self redrawLine:endLine from:1 to:endCol.
+ ]
+!
+
+redrawFromLine:start to:end
+ "redraw lines from start to end"
+
+ |visibleFirst visibleLast first last lastLineShown|
+
+ shown ifTrue:[
+ lastLineShown := firstLineShown + nLinesShown - 1.
+ (start <= lastLineShown) ifTrue:[
+ (end >= firstLineShown) ifTrue:[
+
+ "if first line to redraw is above 1st visible line,
+ start redraw at 1st visible line"
+
+ (start < firstLineShown) ifTrue:[
+ first := firstLineShown
+ ] ifFalse:[
+ first := start
+ ].
+ (end > lastLineShown) ifTrue:[
+ last := lastLineShown
+ ] ifFalse:[
+ last := end
+ ].
+ visibleFirst := self listLineToVisibleLine:first.
+ visibleLast := self listLineToVisibleLine:last.
+ self redrawFromVisibleLine:visibleFirst to:visibleLast
+ ]
+ ]
+ ]
+!
+
+redrawFromVisibleLine:startVisLineNr to:endVisLineNr
+ "redraw a visible line range"
+
+ shown ifTrue:[
+ self drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fgColor and:bgColor
+ ]
+!
+
+redrawInverted
+ "show contents in reverse colors"
+
+ |savFg savBg|
+
+ savFg := fgColor.
+ savBg := bgColor.
+ fgColor := savBg.
+ bgColor := savFg.
+ self redraw.
+ fgColor := savFg.
+ bgColor := savBg.
+!
+
+redrawLine:lineNr
+ "redraw a list line"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine
+ ]
+!
+
+redrawLine:lineNr col:col
+ "redraw a single character"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine col:col
+ ]
+!
+
+redrawLine:lineNr from:startCol
+ "redraw a list line from startCol to end of line"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine from:startCol
+ ]
+!
+
+redrawLine:lineNr from:startCol to:endCol
+ "redraw a list line from startCol to endCol"
+
+ |visibleLine|
+
+ visibleLine := self listLineToVisibleLine:lineNr.
+ visibleLine notNil ifTrue:[
+ self redrawVisibleLine:visibleLine from:startCol to:endCol
+ ]
+!
+
+redrawVisibleLine:visLineNr
+ "redraw a visible line"
+
+ shown ifTrue:[
+ self drawVisibleLine:visLineNr with:fgColor and:bgColor
+ ]
+!
+
+redrawVisibleLine:visLineNr col:col
+ "redraw single character at col index of visible line"
+
+ shown ifTrue:[
+ self drawVisibleLine:visLineNr col:col with:fgColor and:bgColor
+ ]
+!
+
+redrawVisibleLine:visLineNr from:startCol
+ "redraw right part of a visible line from startCol to end of line"
+
+ shown ifTrue:[
+ self drawVisibleLine:visLineNr from:startCol with:fgColor and:bgColor
+ ]
+!
+
+redrawVisibleLine:visLineNr from:startCol to:endCol
+ "redraw part of a visible line"
+
+ shown ifTrue:[
+ startCol == endCol ifTrue:[
+ self redrawVisibleLine:visLineNr col:startCol
+ ] ifFalse:[
+ self drawVisibleLine:visLineNr from:startCol to:endCol with:fgColor and:bgColor
+ ]
+ ]
+! !
+
+!ListView methodsFor:'scrolling'!
+
+gotoLine:aLineNumber
+ "position to line aLineNumber; this may be redefined
+ in subclasses (for example to move the cursor also)"
+
+ ^ self scrollToLine:aLineNumber
+!
+
+halfPageDown
+ "scroll down half a page"
+
+ self scrollDown:(nFullLinesShown // 2)
+!
+
+halfPageUp
+ "scroll up half a page"
+
+ self scrollUp:(nFullLinesShown // 2)
+!
+
+horizontalScrollStep
+ "return the amount to scroll when stepping up/down.
+ Here, the scrolling unit is characters."
+
+ ^ gc font width
+
+ "Created: / 21.5.1999 / 15:55:06 / cg"
+!
+
+makeColVisible:aCol inLine:aLineNr
+ "if column aCol is not visible, scroll horizontal to make it visible"
+
+ |xWant xVis visLnr|
+
+ (aCol isNil or:[shown not]) ifTrue:[^ self].
+
+ visLnr := self listLineToVisibleLine:aLineNr.
+ visLnr isNil ifTrue:[^ self].
+
+ xWant := self xOfCol:aCol inVisibleLine:visLnr.
+ xVis := xWant - viewOrigin x.
+
+ "
+ 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 - gc font width)]) ifTrue:[^ self].
+
+ self scrollHorizontalTo:(xWant - (width // 2)).
+!
+
+makeLineVisible:aListLineNr
+ "if aListLineNr is not visible, scroll to make it visible.
+ Numbering starts with 1 for the very first line of the text."
+
+ |bott newTopLine|
+
+ (aListLineNr isNil "or:[shown not]") ifTrue:[^ self].
+
+"/ Old code follows. It is no longer used, because:
+"/ 1. we must maintain our viewOrigin (not maintained in this code!!)
+"/ 2. we must inform our dependents about originChanges.
+"/
+"/ shown ifFalse:[
+"/ firstLineShown := (aListLineNr - 1) max:1.
+"/ firstLineShown > (list size - nFullLinesShown) ifTrue:[
+"/ firstLineShown := list size - nFullLinesShown
+"/ ].
+"/ list size <= nFullLinesShown ifTrue:[
+"/ firstLineShown := 1
+"/ ].
+"/ ^ self
+"/ ].
+
+ (self needScrollToMakeLineVisible:aListLineNr) ifFalse:[
+ ^ self
+ ].
+
+ (aListLineNr < nFullLinesShown) ifTrue:[
+ "/ at the very top of the list - show from top
+ newTopLine := 1
+ ] ifFalse:[
+ (nFullLinesShown < 3) ifTrue:[
+ "/ a small view - show from that line
+ newTopLine := aListLineNr
+ ] ifFalse:[
+ bott := self numberOfLines - (nFullLinesShown - 1).
+ (aListLineNr > bott) ifTrue:[
+ "/ at the end of the list - show the bottom of the list
+ newTopLine := bott
+ ] ifFalse:[
+ "/ somewhere else - place selected line into the middle of
+ "/ the view
+ newTopLine := (aListLineNr - (nFullLinesShown // 2) + 1)
+ ]
+ ]
+ ].
+
+ self scrollToLine:newTopLine.
+
+ "Modified: / 18.12.1996 / 17:48:22 / stefan"
+ "Modified: / 7.8.1998 / 15:14:12 / cg"
+!
+
+makeVisible:someString
+ "if nescessary, scroll to make the (first)
+ line containing someString visible."
+
+ |index list|
+
+ (list := self list) notNil ifTrue:[
+ index := list indexOf:someString.
+ index ~~ 0 ifTrue:[
+ self makeLineVisible:index
+ ]
+ ]
+
+ "Modified: 9.9.1997 / 10:10:13 / cg"
+!
+
+needScrollToMakeLine:aListLineNr
+ "return true, if a scroll is needd to make a line visible.
+ Numbering starts with 1 for the very first line of the text."
+
+ (aListLineNr >= firstLineShown) ifTrue:[
+ (aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
+ ^ false
+ ]
+ ].
+ ^ true
+
+ "Created: / 7.8.1998 / 15:13:51 / cg"
+ "Modified: / 7.8.1998 / 15:14:44 / cg"
+!
+
+needScrollToMakeLineVisible:aListLineNr
+ "return true, if a scroll is needd to make a line visible.
+ Numbering starts with 1 for the very first line of the text."
+
+ (aListLineNr >= firstLineShown) ifTrue:[
+ (aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
+ ^ false
+ ]
+ ].
+ ^ true
+
+ "Created: / 7.8.1998 / 15:13:51 / cg"
+ "Modified: / 7.8.1998 / 15:14:44 / cg"
+!
+
+pageDown
+ "change origin to display the next page"
+
+ "/ self scrollTo:(viewOrigin + (0 @ height))
+ self scrollToLine:(self firstLineShown + nFullLinesShown)
+
+ "Modified: / 15-12-2010 / 10:12:37 / cg"
+!
+
+pageUp
+ "change origin to display the previous page"
+
+ "/ self scrollTo:(viewOrigin - (0 @ height))
+ self scrollToLine:(self firstLineShown - nFullLinesShown)
+
+ "Modified: / 15-12-2010 / 10:12:41 / cg"
+!
+
+scrollDown:nLines
+ "change origin to scroll down some lines (towards the bottom of the text)"
+
+ nLines ~~ 0 ifTrue:[
+ self scrollTo:(viewOrigin + (0 @ (fontHeight * nLines)))
+ redraw:true
+ ]
+
+ "Modified: / 21.5.1999 / 15:59:52 / cg"
+!
+
+scrollDownPixels:pix
+ "change origin to scroll down some pixels
+ (towards the bottom of the text)
+ THIS WILL VANISH!!"
+
+ pix > 0 ifTrue:[
+ self scrollTo:(viewOrigin + (0 @ (pix abs))) redraw:true
+ ]
+
+
+!
+
+scrollHorizontalTo:aPixelOffset
+ "change origin to make aPixelOffset be the left col"
+
+ |nPixel|
+
+ nPixel := aPixelOffset - viewOrigin x.
+ nPixel ~~ 0 ifTrue:[
+ self scrollTo:(viewOrigin + (nPixel @ 0)) redraw:true
+ ]
+
+ "Modified: / 3.3.1999 / 22:55:20 / cg"
+!
+
+scrollLeft:nPixel
+ "change origin to scroll left some cols"
+
+ nPixel ~~ 0 ifTrue:[
+ self scrollTo:(viewOrigin - (nPixel @ 0)) redraw:true
+ ]
+
+ "Modified: / 21.5.1999 / 15:59:16 / cg"
+!
+
+scrollRight:nPixel
+ "change origin to scroll right some cols"
+
+ nPixel ~~ 0 ifTrue:[
+ self scrollTo:(self viewOrigin + (nPixel @ 0)) redraw:true
+ ]
+
+ "Modified: / 21.5.1999 / 15:59:21 / cg"
+!
+
+scrollSelectDown
+ "just a template - I do not know anything about selections"
+
+ ^ self subclassResponsibility
+!
+
+scrollSelectUp
+ "just a template - I do not know anything about selections"
+
+ ^ self subclassResponsibility
+!
+
+scrollToBottom
+ "change origin to show end of text"
+
+ "scrolling to the end is not really correct (i.e. should scroll to list size - nFullLinesShown),
+ but scrollDown: will adjust it ..."
+
+ self scrollToLine:(self size)
+!
+
+scrollToCol:aColNr
+ "change origin to make aColNr be the left col"
+
+ |pxlOffset leftOffset|
+
+ leftOffset := viewOrigin x.
+
+ aColNr == 1 ifTrue:[
+ leftOffset ~~ 0 ifTrue:[
+ self scrollLeft:leftOffset.
+ ].
+ ^ self
+ ].
+
+ pxlOffset := gc font width * (aColNr - 1).
+
+ pxlOffset < leftOffset ifTrue:[
+ self scrollLeft:(leftOffset - pxlOffset)
+ ] ifFalse:[
+ pxlOffset > leftOffset ifTrue:[
+ self scrollRight:(pxlOffset - leftOffset)
+ ]
+ ]
+!
+
+scrollToLeft
+ "change origin to start (left) of text"
+
+ viewOrigin x ~~ 0 ifTrue:[
+ self scrollToCol:1
+ ]
+!
+
+scrollToLine:aLineNr
+ "change origin to make aLineNr be the top line"
+
+ aLineNr < firstLineShown ifTrue:[
+ self scrollUp:(firstLineShown - aLineNr)
+ ] ifFalse:[
+ aLineNr > firstLineShown ifTrue:[
+ self scrollDown:(aLineNr - firstLineShown)
+ ]
+ ]
+!
+
+scrollToPercent:percentOrigin
+ "scroll to a position given in percent of total"
+
+ "kludge - ListView thinks in lines"
+
+ self scrollHorizontalToPercent:percentOrigin x.
+ self scrollVerticalToPercent:percentOrigin y.
+!
+
+scrollToTop
+ "change origin to start of text"
+
+ self scrollToLine:1
+!
+
+scrollUp:nLines
+ "change origin to scroll up some lines (towards the top of the text)"
+
+ nLines ~~ 0 ifTrue:[
+ self scrollTo:(viewOrigin - (0 @ (fontHeight * nLines)))
+ redraw:true
+ ]
+
+ "Modified: / 21.5.1999 / 15:59:45 / cg"
+!
+
+scrollUpPixels:pix
+ "change origin to scroll up some pixels
+ (towards the top of the text)
+ THIS WILL VANISH!!"
+
+ pix > 0 ifTrue:[
+ self scrollTo:(viewOrigin - (0 @ pix)) redraw:true
+ ]
+
+
+!
+
+scrollVerticalToPercent:percent
+ "scroll to a position given in percent of total"
+
+ |nL lineNr|
+
+ nL := self numberOfLines.
+ "/
+ "/ kludge for last partial line
+ "/
+ nFullLinesShown ~~ nLinesShown ifTrue:[
+ nL := nL + 1
+ ].
+ lineNr := (((nL * percent) asFloat / 100.0) + 0.5) asInteger + 1.
+ self scrollToLine:lineNr
+!
+
+startAutoScrollDown:yDistance
+ "setup for auto-scroll down (when button-press-moving below view)
+ - timeDelta for scroll is computed from distance"
+
+ self
+ startAutoScrollVertical:yDistance
+ scrollSelector:#scrollSelectDown
+!
+
+startAutoScrollHorizontal:xDistance scrollSelector:scrollSelector
+ "setup for auto-scroll left/right (when button-press-moving to the right of the view)
+ - timeDelta for scroll is computed from distance"
+
+ |deltaT mm|
+
+ autoScroll ifFalse:[^ self].
+
+ mm := xDistance // self horizontalIntegerPixelPerMillimeter + 1.
+ deltaT := 0.5 / mm.
+
+ (deltaT = autoScrollDeltaT) ifFalse:[
+ autoScrollDeltaT := deltaT.
+ autoScrollBlock isNil ifTrue:[
+ autoScrollBlock := [self realized ifTrue:[self perform:scrollSelector]].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
+ ]
+ ]
+!
+
+startAutoScrollLeft:xDistance
+ "setup for auto-scroll up (when button-press-moving to the left of the view)
+ - timeDelta for scroll is computed from distance"
+
+ self
+ startAutoScrollHorizontal:xDistance negated
+ scrollSelector:#scrollSelectLeft
+!
+
+startAutoScrollRight:xDistance
+ "setup for auto-scroll down (when button-press-moving to the right of the view)
+ - timeDelta for scroll is computed from distance"
+
+ self
+ startAutoScrollHorizontal:xDistance
+ scrollSelector:#scrollSelectRight
+!
+
+startAutoScrollUp:yDistance
+ "setup for auto-scroll up (when button-press-moving below view)
+ - timeDelta for scroll is computed from distance"
+
+ self
+ startAutoScrollVertical:yDistance negated
+ scrollSelector:#scrollSelectUp
+!
+
+startAutoScrollVertical:yDistance scrollSelector:scrollSelector
+ "setup for auto-scroll up (when button-press-moving below view)
+ - timeDelta for scroll is computed from distance"
+
+ |deltaT mm|
+
+ autoScroll ifFalse:[^ self].
+
+ mm := (yDistance abs // self verticalIntegerPixelPerMillimeter) + 1.
+ deltaT := 0.5 / mm.
+
+ (deltaT = autoScrollDeltaT) ifFalse:[
+ autoScrollDeltaT := deltaT.
+ autoScrollBlock isNil ifTrue:[
+ autoScrollBlock := [self realized ifTrue:[self perform:scrollSelector]].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
+ ]
+ ]
+
+ "Modified: / 08-08-2010 / 11:26:26 / cg"
+!
+
+stopAutoScroll
+ "stop any auto-scroll"
+
+ autoScrollBlock notNil ifTrue:[
+ self compressMotionEvents:true.
+ Processor removeTimedBlock:autoScrollBlock.
+ autoScrollBlock := nil.
+ autoScrollDeltaT := nil
+ ].
+!
+
+verticalScrollStep
+ "return the amount to scroll when stepping up/down.
+ Here, the scrolling unit is lines."
+
+ ^ 1
+
+ "Created: / 21.5.1999 / 14:00:12 / cg"
+!
+
+viewOrigin
+ "return the viewOrigin; thats the coordinate of the contents
+ which is shown topLeft in the view
+ (i.e. the origin of the visible part of the contents)."
+
+ ^ viewOrigin
+! !
+
+!ListView methodsFor:'scrolling-basic'!
+
+additionalMarginForHorizontalScroll
+ "return the number of pixels by which we may scroll more than the actual
+ width of the document would allow.
+ This is redefined by editable textViews, to allo for the cursor
+ to be visible if it is positioned right behind the longest line of text.
+ The default returned here is the width of a blank (to beautify italic text)"
+
+ ^ gc font width
+!
+
+scrollTo:anOrigin redraw:doRedraw
+ "change origin to have newOrigin be visible at the top-left.
+ The argument defines the integer device coordinates of the new top-left
+ point.
+ "
+ |dltOrg
+ noLn "{ Class:SmallInteger }"
+ max "{ Class:SmallInteger }"
+ tmp "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ w "{ Class:SmallInteger }"
+ y0 "{ Class:SmallInteger }"
+ y1 "{ Class:SmallInteger }"
+ y "{ Class:SmallInteger }"
+ x "{ Class:SmallInteger }"
+ delta newFirstLine newViewOrigin
+ hBefore wBefore inv wg|
+
+ hBefore := height.
+ wBefore := width.
+
+ dltOrg := anOrigin - viewOrigin.
+
+"/ compute valid horizontal offset x
+
+ (x := dltOrg x) ~~ 0 ifTrue:[
+ tmp := viewOrigin x + x.
+
+ x < 0 ifTrue:[ "/ scrolling left
+ tmp < 0 ifTrue:[x := 0 - viewOrigin x]
+ ] ifFalse:[ "/ scrolling right
+ "/ allows scrolling to the right of widest line
+ max := self widthOfContents + (self additionalMarginForHorizontalScroll).
+
+ tmp + width > max ifTrue:[
+ x := (max - viewOrigin x - width) max:0
+ ]
+ ]
+ ].
+
+"/ compute valid vertical offset measured in lines
+
+ (y := dltOrg y // fontHeight) ~~ 0 ifTrue:[
+ tmp := firstLineShown + y.
+
+ y < 0 ifTrue:[ "/ scrolling up
+ tmp < 1 ifTrue:[y := 1 - firstLineShown]
+ ] ifFalse:[ "/ scrolling down
+ max := self size.
+
+ tmp + nFullLinesShown > max ifTrue:[
+ y := (max - firstLineShown - nFullLinesShown + 1) max:0
+ ]
+ ]
+ ].
+
+ (x == 0 and:[y == 0]) ifTrue:[ "/ has viewOrigin changed ?
+ ^ self
+ ].
+
+ (noLn := y) ~~ 0 ifTrue:[
+ y := y * fontHeight
+ ].
+ delta := (x @ y).
+
+ newFirstLine := firstLineShown + noLn.
+ newViewOrigin := viewOrigin + delta.
+
+ (shown and:[doRedraw]) ifFalse:[
+ self originWillChange.
+ firstLineShown := newFirstLine.
+ viewOrigin := newViewOrigin.
+ self assert:(viewOrigin x >= 0).
+ ^ self originChanged:delta
+ ].
+
+"/ (self sensor notNil and: [self sensor hasExposeEventFor:self]) ifTrue:[ "/ outstanding expose events
+"/ self invalidate. "/ redraw all
+"/ self originWillChange.
+"/ ^ self originChanged:(x @ y )
+"/ ].
+
+ ( (y ~~ 0 and:[x ~~ 0]) "/ both x and y changed
+ or:[(noLn abs) >= nLinesShown "/ at least one area is
+ or:[(x abs) > (width // 4 * 3)]] "/ big enough to redraw all
+ ) ifTrue:[
+ self originWillChange.
+ firstLineShown := newFirstLine.
+ viewOrigin := newViewOrigin.
+ self invalidate.
+ ^ self originChanged:delta
+ ].
+
+ "/ OLD:
+ "/ self repairDamage.
+
+ (wg := self windowGroup) notNil ifTrue:[
+ wg processRealExposeEventsFor:self.
+ ].
+
+ self originWillChange.
+
+ "/ make certain, that all drawing is complete
+ "/ device sync.
+
+ self catchExpose.
+
+ x == 0 ifTrue:[
+ "/ scrolling vertical
+
+ y0 := textStartTop + (y abs).
+ h := hBefore - margin - y0.
+ w := wBefore - margin.
+ y > 0 ifTrue:[ "/ copy down
+ "/ kludge: if the selection highlighting draws into the textStartTop area,
+ "/ the copy below leaves some selection depris in the top area.
+ "/ Therefore, clear the top area.
+ "/ (should avoid this, in case we know there cannot be anything
+ "/ there - selection is nil or >= firstLineShown).
+ self clearDeviceRectangleX:margin y:margin width:width-margin-margin height:(textStartTop-margin).
+"/ self invalidateDeviceRectangle:((margin@margin) corner:(width-margin@textStartTop)) repairNow:false.
+
+ self copyFrom:self
+ x:0 y:y0 toX:0 y:textStartTop
+ width:w height:h async:true.
+ y1 := h - 1.
+ y0 := y0 + 1.
+ ] ifFalse:[ "/ copy up
+ self copyFrom:self
+ x:margin y:textStartTop toX:margin y:y0
+ width:w height:h async:true.
+ y1 := 0.
+ ].
+
+ inv := (margin@y1) extent:(w@y0).
+ ] ifFalse:[
+ "/ scrolling horizontal
+
+ x > 0 ifTrue:[ "/ scrolling right
+ y0 := margin + x.
+ y1 := wBefore - y0.
+ ] ifFalse:[ "/ scrolling left
+ y0 := margin - x.
+ y1 := 0.
+ ].
+ h := hBefore - margin - margin.
+ w := wBefore - margin - y0.
+
+ x > 0 ifTrue:[ "/ copy right
+ self copyFrom:self x:y0 y:margin toX:margin y:margin
+ width:w height:h async:true.
+ ] ifFalse:[ "/ copy left
+ "/ self copyFrom:self x:textStartLeft y:margin toX:y0 y:margin
+"/ viewOrigin x > margin ifTrue:[
+"/ self copyFrom:self x:0 y:margin toX:y0-margin y:margin
+"/ width:w height:h async:true.
+"/ ] ifFalse:[
+ self copyFrom:self x:margin y:margin toX:y0 y:margin
+ width:w height:h async:true.
+"/ ].
+ ].
+
+ inv := (y1@margin) extent:(y0@h).
+ ].
+
+ firstLineShown := newFirstLine.
+ viewOrigin := newViewOrigin.
+
+ self invalidateDeviceRectangle:inv repairNow:false.
+ viewOrigin x <= margin ifTrue:[
+ self invalidateDeviceRectangle:((0@margin) extent:(margin@h)) repairNow:false.
+ ].
+
+ self originChanged:delta.
+ self waitForExpose.
+
+ (wg := self windowGroup) notNil ifTrue:[
+ wg processRealExposeEventsFor:self.
+ ].
+
+"/ (hBefore ~= height or:[wBefore ~= width]) ifTrue:[
+"/ self halt.
+"/ ].
+
+ "Modified: / 08-08-2010 / 11:14:09 / cg"
+! !
+
+!ListView methodsFor:'searching'!
+
+findBeginOfWordAtLine:selectLine col:selectCol
+ "return the col of first character of the word at given line/col.
+ If the character under the initial col is a space character, return
+ the first col of the blank-block."
+
+ |beginCol thisCharacter|
+
+ beginCol := selectCol.
+ thisCharacter := self characterAtLine:selectLine col:beginCol.
+
+ "is this acharacter within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ [wordCheck value:thisCharacter] whileTrue:[
+ beginCol := beginCol - 1.
+ beginCol < 1 ifTrue:[
+ ^ 1
+ ].
+ 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 "{ Class: SmallInteger }"
+ len "{ Class: SmallInteger }"
+ thisCharacter|
+
+ endCol := selectCol.
+ endCol == 0 ifTrue:[endCol := 1].
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+
+ len := (self listAt:selectLine) size.
+
+ "is this acharacter within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ [wordCheck value:thisCharacter] whileTrue:[
+ endCol := endCol + 1.
+ endCol > len ifTrue:[ ^ len ].
+ thisCharacter := self characterAtLine:selectLine col:endCol
+ ].
+ endCol := endCol - 1.
+ ] ifFalse:[
+ "nope - maybe its a space"
+ thisCharacter == Character space ifTrue:[
+ 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.
+!
+
+searchBackwardFor:pattern ignoreCase:ignCase 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)"
+
+ ^ self
+ searchBackwardUsingSpec:(SearchSpec new
+ pattern:pattern
+ ignoreCase:ignCase
+ match:false)
+ startingAtLine:startLine col:startCol
+ ifFound:block1 ifAbsent:block2
+!
+
+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)"
+
+ ^ self
+ searchBackwardFor:pattern
+ ignoreCase:false
+ startingAtLine:startLine col:startCol
+ ifFound:block1
+ ifAbsent:block2
+
+ "Modified: 13.9.1997 / 01:07:36 / cg"
+!
+
+searchBackwardUsingSpec:searchSpec 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
+ pattern ignCase match fullWord
+ found firstChar1 firstChar2 c pc col1
+ col "{ Class: SmallInteger }"
+ cc "{ Class: SmallInteger }"
+ patternSize "{ Class: SmallInteger }"
+ line1 "{ Class: SmallInteger }"
+ lineSize "{ Class: SmallInteger }" |
+
+ pattern := searchSpec pattern.
+ ignCase := searchSpec ignoreCase.
+ match := searchSpec match.
+ match ifTrue:[ Transcript showCR:'backward matchsearch is (still) not implemented' ].
+ fullWord := searchSpec fullWord.
+
+ patternSize := pattern size.
+ (list notNil
+ and:[startLine > 0
+ and:[patternSize ~~ 0]])
+ ifTrue:[
+ self withCursor:Cursor questionMark do:[
+ col := startCol - 1.
+ firstChar1 := pattern at:1.
+ ignCase ifTrue:[
+ firstChar1 := firstChar1 asLowercase.
+ firstChar2 := firstChar1 asUppercase.
+ ] ifFalse:[
+ firstChar2 := firstChar1
+ ].
+
+ line1 := startLine.
+ line1 > list size ifTrue:[
+ line1 := list size.
+ col := -999
+ ] ifFalse:[
+ col > (list at:line1) size ifTrue:[
+ col := -999
+ ]
+ ].
+ line1 to:1 by:-1 do:[:lnr |
+ lineString := list at:lnr.
+ lineString notNil ifTrue:[
+ lineString := lineString asString.
+ lineString isString ifTrue:[
+ "/ quick check if pattern is present
+ col1 := lineString
+ findString:pattern
+ startingAt:1
+ ifAbsent:0
+ caseSensitive: ignCase not.
+ col1 ~~ 0 ifTrue:[
+ lineSize := lineString size.
+ col == -999 ifTrue:[col := lineSize - patternSize + 1].
+ [(col > 0)
+ and:[(c := lineString at:col) ~= firstChar1
+ and:[c ~= firstChar2]]] whileTrue:[
+ col := col - 1
+ ].
+ [col > 0] whileTrue:[
+ cc := col.
+ found := true.
+ 1 to:patternSize do:[:cnr |
+ cc > lineSize ifTrue:[
+ found := false
+ ] ifFalse:[
+ pc := pattern at:cnr.
+ c := lineString at:cc.
+ pc ~= c ifTrue:[
+ (ignCase not or:[pc asLowercase ~= c asLowercase]) ifTrue:[
+ found := false
+ ]
+ ]
+ ].
+ cc := cc + 1
+ ].
+ found ifTrue:[
+ (fullWord not
+ or:[ (self findBeginOfWordAtLine:lnr col:col) == col
+ and:[ (self findEndOfWordAtLine:lnr col:col) == (col + patternSize - 1) ]]
+ ) ifTrue:[
+ ^ block1 value:lnr value:col.
+ ]
+ ].
+ col := col - 1.
+ [(col > 0)
+ and:[(c := lineString at:col) ~= firstChar1
+ and:[c ~= firstChar2]]] whileTrue:[
+ col := col - 1
+ ]
+ ]
+ ]
+ ].
+ ].
+ col := -999.
+ ]
+ ]
+ ].
+ "not found"
+
+ ^ block2 value
+
+ "Created: / 13-09-1997 / 01:06:19 / cg"
+ "Modified: / 05-08-2012 / 12:16:31 / cg"
+!
+
+searchForwardFor:pattern ignoreCase:ignCase match:match 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."
+
+ ^ self
+ searchForwardUsingSpec:(SearchSpec new
+ pattern:pattern
+ ignoreCase:ignCase
+ match:match)
+ startingAtLine:startLine col:startCol
+ ifFound:block1 ifAbsent:block2
+!
+
+searchForwardFor:pattern ignoreCase:ignCase 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."
+
+ ^ self searchForwardFor:pattern ignoreCase:ignCase match: true startingAtLine:startLine col:startCol ifFound:block1 ifAbsent:block2
+!
+
+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."
+
+ ^ self
+ searchForwardFor:pattern
+ ignoreCase:false
+ startingAtLine:startLine col:startCol
+ ifFound:block1
+ ifAbsent:block2
+
+ "Modified: 13.9.1997 / 01:07:11 / cg"
+!
+
+searchForwardUsingSpec:searchSpec 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."
+
+ |lineString col pattern match ignCase fullWord
+ patternSize
+ line1 "{Class: SmallInteger}"
+ line2 "{Class: SmallInteger}"
+ p realPattern|
+
+ pattern := searchSpec pattern.
+ match := searchSpec match.
+ ignCase := searchSpec ignoreCase.
+ fullWord := searchSpec fullWord.
+
+ patternSize := pattern size.
+ (list notNil and:[patternSize ~~ 0]) ifTrue:[
+ self withCursor:Cursor questionMark do:[
+
+ col := startCol + 1.
+ line1 := startLine.
+ line2 := list size.
+
+ (match and:[pattern includesUnescapedMatchCharacters]) ifTrue:[
+ "perform a findMatchString (matching)"
+ p := pattern species new:0.
+ (pattern startsWith:$*) ifFalse:[
+ p := p , '*'
+ ].
+ p := p , pattern.
+ (pattern endsWith:$*) ifFalse:[
+ p := p , '*'
+ ].
+ realPattern := pattern.
+ (realPattern startsWith:$*) ifTrue:[
+ realPattern := realPattern copyFrom:2
+ ].
+ line1 to:line2 do:[:lnr |
+ lineString := list at:lnr.
+ lineString notNil ifTrue:[
+ lineString := lineString asString string.
+ lineString isString ifTrue:[
+ "/ first a crude check ...
+ (p match:lineString caseSensitive:ignCase not) ifTrue:[
+ "/ ok, there it is; look at which position
+ col := lineString
+ findMatchString:realPattern
+ startingAt:col
+ caseSensitive:ignCase not
+ ifAbsent:0.
+ col ~~ 0 ifTrue:[
+ ^ block1 value:lnr value:col.
+ ]
+ ]
+ ].
+ ].
+ col := 1
+ ]
+ ] ifFalse:[
+ "perform a findString (no matching)"
+ p := pattern "withoutMatchEscapes".
+ line1 to:line2 do:[:lnr |
+ lineString := list at:lnr.
+ lineString notNil ifTrue:[
+ lineString := lineString asString string.
+ lineString isString ifTrue:[
+ col := lineString
+ findString:p
+ startingAt:col
+ ifAbsent:0
+ caseSensitive: ignCase not.
+ col ~~ 0 ifTrue:[
+"/Transcript showCR:'---'.
+"/Transcript showCR:lineString.
+"/Transcript showCR:col.
+"/Transcript showCR:(self findBeginOfWordAtLine:lnr col:col).
+"/Transcript showCR:(self findEndOfWordAtLine:lnr col:col).
+"/Transcript showCR:(lineString copyFrom:(self findBeginOfWordAtLine:lnr col:col) to:(self findEndOfWordAtLine:lnr col:col)).
+ (fullWord not
+ or:[ (self findBeginOfWordAtLine:lnr col:col) == col
+ and:[ (self findEndOfWordAtLine:lnr col:col) == (col + patternSize - 1) ]]
+ ) ifTrue:[
+ ^ block1 value:lnr value:col.
+ ]
+ ]
+ ]
+ ].
+ col := 1
+ ]
+ ].
+ ]
+ ].
+ "not found"
+
+ ^ block2 value
+
+ "Created: / 13-09-1997 / 01:06:31 / cg"
+ "Modified: / 05-08-2012 / 12:22:42 / cg"
+!
+
+standardWordCheck:char
+ "the wordCheck is a predicate which returns true if the given character
+ belongs to the (textual) word. Used with double click to select a word.
+ When editing code, typically characters which are part of an identifier
+ are part of a word (underline, dollar, but no other non-letters).
+ The standardWordCheck aks the current userPreferences for details."
+
+ |prefs|
+
+ (prefs := UserPreferences current) whitespaceWordSelectMode ifTrue:[
+ "an extremely simple mode, where every non-space is treated as part of the word"
+ ^ char isSeparator not
+ ].
+ prefs extendedWordSelectMode ifTrue:[
+ "the typical mode, useful for text and code"
+ ^ char isNationalAlphaNumeric or:[char == $_]
+ ].
+ "another typical mode, also useful for text and code"
+ ^ char isNationalAlphaNumeric
+
+ "Modified (comment): / 17-03-2012 / 19:04:13 / cg"
+! !
+
+!ListView methodsFor:'tabulators'!
+
+expandTabs
+ "go through whole text expanding tabs into spaces.
+ This is meant to be called for text being imported from a file.
+ Therefore, 8-col tabs are assumed - independent of any private tab setting."
+
+ |line newLine nLines "{ Class: SmallInteger }"|
+
+ includesNonStrings := false.
+ list notNil ifTrue:[
+ nLines := self size.
+ 1 to:nLines do:[:index |
+ line := self at:index.
+ line notNil ifTrue:[
+ (line isString) ifTrue:[
+ newLine := line withTabsExpanded.
+ newLine ~~ line ifTrue:[
+ list at:index put:newLine
+ ].
+ ] ifFalse:[
+ includesNonStrings := true.
+ ]
+ ]
+ ]
+ ]
+
+ "Modified: 30.8.1995 / 19:06:37 / claus"
+ "Modified: 12.5.1996 / 12:48:03 / cg"
+!
+
+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:[
+ "/ fallback to mod-8 tabs if beyond tab-list.
+ thisTab := col + 1.
+ thisTab := thisTab + (8 - (thisTab \\ 8)).
+ ^ thisTab
+ ].
+ tabIndex := tabIndex + 1.
+ thisTab := tabPositions at:tabIndex
+ ].
+ ^ thisTab
+!
+
+prevTabBefore:colNr
+ "return the prev tab position before col"
+
+ |col "{ Class: SmallInteger }"
+ tabIndex "{ Class: SmallInteger }"
+ thisTab "{ Class: SmallInteger }"
+ nTabs "{ Class: SmallInteger }" |
+
+ tabIndex := 1.
+ col := colNr.
+ thisTab := tabPositions at:tabIndex.
+ nTabs := tabPositions size.
+ [thisTab < col] whileTrue:[
+ (tabIndex == nTabs) ifTrue:[^ thisTab].
+ tabIndex := tabIndex + 1.
+ thisTab := tabPositions at:tabIndex
+ ].
+ (tabIndex == 1) ifTrue:[
+ ^ 1
+ ].
+ ^ tabPositions at:(tabIndex - 1)
+!
+
+setTab4
+ "set 4-character tab stops"
+
+ tabPositions := self class tab4Positions.
+!
+
+setTab8
+ "set 8-character tab stops"
+
+ tabPositions := self class tab8Positions.
+!
+
+setTabPositions:aVector
+ "set tab stops"
+
+ tabPositions := aVector.
+!
+
+withTabs:line
+ "Assuming an 8-character tab,
+ compress multiple leading spaces to tabs, return a new line string
+ or the original line, if no tabs where created.
+ good idea, to make this one a primitive, since its called
+ many times when a big text is saved to a file."
+
+ |newLine eightSpaces nTabs|
+
+ "
+ the code below is a hack, producing many garbage strings for lines
+ which compress multiple tabs ... needs rewrite: saving big files
+ stresses the garbage collector a bit ...
+ "
+ line isNil ifTrue:[^ line].
+ eightSpaces := ' '.
+ (line startsWith:eightSpaces) ifFalse:[^ line].
+
+ nTabs := 1.
+ newLine := line copyFrom:9.
+ [newLine startsWith:eightSpaces] whileTrue:[
+ newLine := newLine copyFrom:9.
+ nTabs := nTabs + 1.
+ ].
+ ^ (line species new:nTabs withAll:Character tab) asString , newLine.
+
+ "Modified: 23.2.1996 / 19:10:36 / cg"
+!
+
+withTabs:tabulatorTable expand:line
+ "expand tabs into spaces, return a new line string,
+ or original line, if no tabs are included.
+ good idea, to make this one a primitive, since it is called
+ many times if a big text is read from a file."
+
+ |tmpString nString nTabs
+ currentMax "{ Class: SmallInteger }"
+ dstIndex "{ Class: SmallInteger }"
+ nextTab "{ Class: SmallInteger }" |
+
+ "
+ the code below tries to avoid creating too much garbage;
+ therefore, the string is scanned first for the number of
+ tabs to get a rough idea of the final strings size.
+ (it could be done better, by computing the exact size
+ required here ...)
+ "
+ line isNil ifTrue:[^ line].
+ nTabs := line occurrencesOf:(Character tab).
+ nTabs == 0 ifTrue:[^ line].
+
+ currentMax := line size + (nTabs * 7).
+ tmpString := line species 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 := line species new:currentMax.
+ nString replaceFrom:1 to:(dstIndex - 1)
+ with:tmpString startingAt:1.
+ tmpString := nString.
+ nString := nil
+ ].
+
+ "make stc-optimizer happy
+ - no need to return value of ifTrue:/ifFalse above"
+ 0
+ ].
+ dstIndex := dstIndex - 1.
+ dstIndex == currentMax ifTrue:[
+ ^ tmpString
+ ].
+ ^ tmpString copyTo:dstIndex
+
+ "Modified: 23.2.1996 / 19:11:01 / cg"
+!
+
+withTabsExpanded:line
+ "expand tabs into spaces, return a new line string,
+ or original line, if no tabs are included.
+ good idea, to make this one a primitive"
+
+ ^ self withTabs:tabPositions expand:line
+! !
+
+!ListView::HighlightArea methodsFor:'accessing'!
+
+bgColor
+ ^ bgColor
+!
+
+bgColor:something
+ bgColor := something.
+!
+
+endCol
+ ^ endCol
+!
+
+endCol:something
+ endCol := something.
+!
+
+endLine
+ ^ endLine
+!
+
+endLine:something
+ endLine := something.
+!
+
+fgColor
+ ^ fgColor
+!
+
+fgColor:something
+ fgColor := something.
+!
+
+startCol
+ ^ startCol
+!
+
+startCol:something
+ startCol := something.
+!
+
+startLine
+ ^ startLine
+!
+
+startLine:something
+ startLine := something.
+! !
+
+!ListView::SearchSpec methodsFor:'accessing'!
+
+forward
+ ^ forward ? true
+!
+
+fullWord
+ ^ fullWord ? false
+!
+
+ignoreCase
+ ^ ignoreCase ? false
+!
+
+match
+ ^ match ? false
+!
+
+pattern
+ ^ pattern
+!
+
+pattern:patternString
+ pattern := patternString.
+!
+
+pattern:patternString ignoreCase:ignoredCaseBoolean
+ pattern := patternString.
+ ignoreCase := ignoredCaseBoolean.
+!
+
+pattern:patternString ignoreCase:ignoredCaseBoolean match:matchBoolean
+ pattern := patternString.
+ ignoreCase := ignoredCaseBoolean.
+ match := matchBoolean.
+!
+
+pattern:patternString ignoreCase:ignoredCaseBoolean match:matchBoolean forward:forwardBoolean
+ pattern := patternString.
+ ignoreCase := ignoredCaseBoolean.
+ match := matchBoolean.
+ forward := forwardBoolean
+!
+
+pattern:patternString ignoreCase:ignoredCaseBoolean match:matchBoolean variable:variableBoolen forward:forwardBoolean
+ pattern := patternString.
+ ignoreCase := ignoredCaseBoolean.
+ match := matchBoolean.
+ variable := variableBoolen.
+ forward := forwardBoolean
+!
+
+pattern:patternString ignoreCase:ignoredCaseBoolean match:matchBoolean variable:variableBoolen fullWord:fullWordBoolen forward:forwardBoolean
+ pattern := patternString.
+ ignoreCase := ignoredCaseBoolean.
+ match := matchBoolean.
+ variable := variableBoolen.
+ fullWord := fullWordBoolen.
+ forward := forwardBoolean
+!
+
+variable
+ ^ variable
+!
+
+variable:variableBoolean
+ variable := variableBoolean
+! !
+
+!ListView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.391.2.1 2014-05-08 08:30:56 stefan Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.391.2.1 2014-05-08 08:30:56 stefan Exp $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TextCollector.st Thu May 08 10:30:56 2014 +0200
@@ -0,0 +1,1155 @@
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+'From Smalltalk/X, Version:6.2.3.0 on 20-03-2014 at 21:05:01' !
+
+"{ Package: 'stx:libwidg' }"
+
+EditTextView subclass:#TextCollector
+ instanceVariableNames:'entryStream lineLimit destroyAction outstandingLines
+ outstandingLine flushBlock flushPending inFlush collecting
+ timeDelay access currentEmphasis alwaysAppendAtEnd collectSize
+ autoRaise'
+ classVariableNames:'TranscriptQuerySignal DebugSendersOfMessagePattern
+ TraceSendersOfMessagePattern TimestampMessages'
+ poolDictionaries:''
+ category:'Views-Text'
+!
+
+!TextCollector class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ a view for editable text, which also understands some stream messages.
+ Instances of this view can take the place of a stream and display the
+ received text.
+ Its main use in the system is the Transcript, but it can also be used for
+ things like trace-windows, errorLogs etc.
+ It is also inherited by TerminalView, which especially uses the buffering and
+ delayed output features for high performance output (compare to a windows console).
+
+ If collecting is turned on, a textcollector will not immediately display
+ entered text, but wait for some short time (timeDelay) and collect incoming
+ data - finally updating the whole chunk in one piece.
+ This helps slow display devices, which would otherwise scroll a lot.
+ (on fast displays this is less of a problem).
+
+ The total number of lines kept is controlled by lineLimit, if more lines
+ than this limit are added at the bottom, the textcollector will forget lines
+ at the top. You can set linelimit to nil (i.e. no limit), but you may need a lot
+ of memory then ...
+
+ [StyleSheet paramters (transcript only):]
+
+ transcriptForegroundColor defaults to textForegroundColor
+ transcriptBackgroundColor' defaults to textBackgroundColor.
+
+ transcriptCursorForegroundColor
+ transcriptCursorBackgroundColor
+
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ CodeView EditTextView
+ ActorStream
+"
+! !
+
+!TextCollector class methodsFor:'instance creation'!
+
+initialize
+ TranscriptQuerySignal := QuerySignal new.
+
+!
+
+newTranscript
+ "create and open a new transcript.
+ This is a leftOver method from times were the Launcher & Transcript
+ were two different views. It is no longer recommended."
+
+ ^ self newTranscript:#Transcript
+
+ "
+ TextCollector newTranscript.
+ Transcript lineLimit:3000.
+ "
+
+ "Modified: 17.2.1997 / 18:20:27 / cg"
+!
+
+newTranscript:name
+ "create and open a new transcript.
+ This is a leftOver method from times were the Launcher & Transcript
+ were two different views. It is no longer recommended."
+
+ |topView transcript defSz f v lines cols|
+
+ transcript := Smalltalk at:name.
+ (transcript isTextView and:[transcript isOpen and:[transcript device == Screen current]]) ifTrue:[
+ "if there is already an open Transcript on the same device,
+ do not open an additional one.
+ expecco StandardLibrary <= 2.0.0.3 checked for Transcript>>#isStream and
+ tries to opens a new Transcript window for each new Transcribe with expecco >=2.4"
+ ^ transcript.
+ ].
+
+ topView := StandardSystemView label:name "minExtent:(100 @ 100)".
+
+ v := HVScrollableView for:self miniScrollerH:true miniScrollerV:false in:topView.
+ v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ transcript := v scrolledView.
+ "transcript partialLines:false."
+
+ f := transcript font.
+
+ "
+ should add the height of the frame & scrollbars to be exact ...
+ "
+ defSz := self defaultTranscriptSize.
+ cols := defSz x.
+ lines := defSz y.
+ topView extent:(((f widthOf:'x') * cols) @ (f height * lines)).
+
+ transcript beTranscript:name.
+
+ "
+ run it at a slightly higher prio, to allow for
+ delayed buffered updates to be performed
+ "
+ topView openWithPriority:(Processor userSchedulingPriority + 1).
+
+ ^ transcript
+
+ "
+ TextCollector newTranscript:#T2.
+ T2 showCR:'Hello world'.
+ "
+
+ "Modified: 17.2.1997 / 18:20:27 / cg"
+! !
+
+!TextCollector class methodsFor:'Signal constants'!
+
+transcriptQuerySignal
+ ^ TranscriptQuerySignal
+! !
+
+!TextCollector class methodsFor:'debugging'!
+
+debugSendersOfMessagePattern
+ ^ DebugSendersOfMessagePattern
+
+ "Created: / 02-02-2012 / 12:05:27 / cg"
+!
+
+debugSendersOfMessagePattern:aGLOBMatchPattern
+ "ever want to know, who sends a particular text-message to the transcript ?
+ Call this with a match string and get a halt, when a matching text is sent to the transcript"
+
+ DebugSendersOfMessagePattern := aGLOBMatchPattern asNilIfEmpty
+
+ "
+ self debugSendersOfMessagePattern:'no such*'
+ self debugSendersOfMessagePattern:'remove*'
+ self debugSendersOfMessagePattern:nil.
+ self debugSendersOfMessagePattern:'*'.
+ "
+
+ "Modified: / 02-02-2012 / 12:07:11 / cg"
+!
+
+timestampMessages
+ ^ TimestampMessages
+!
+
+timestampMessages:aBoolean
+ "if true, all messages are shown with a timestamp in front"
+
+ TimestampMessages := aBoolean
+
+ "
+ self timestampMessages:true
+ self timestampMessages:false.
+ "
+!
+
+traceSendersOfMessagePattern
+ ^ TraceSendersOfMessagePattern
+
+ "Created: / 02-02-2012 / 12:05:32 / cg"
+!
+
+traceSendersOfMessagePattern:aGLOBMatchPattern
+ "ever want to know, who sends a particular text-message to the transcript ?
+ Call this with a match string and get a trace, when a matching text is sent to the transcript"
+
+ TraceSendersOfMessagePattern := aGLOBMatchPattern asNilIfEmpty
+
+ "
+ self traceSendersOfMessagePattern:'removed unreached*'
+ self traceSendersOfMessagePattern:nil.
+ self traceSendersOfMessagePattern:'*'.
+ "
+
+ "Created: / 02-02-2012 / 11:59:22 / cg"
+! !
+
+!TextCollector class methodsFor:'defaults'!
+
+defaultCollectSize
+ "the number of lines buffered for delayed update"
+
+ ^ 1000
+
+ "Modified: / 27.7.1998 / 16:14:51 / cg"
+!
+
+defaultLineLimit
+ "the number of lines remembered by default"
+
+ ^ 1000
+!
+
+defaultTimeDelay
+ "the time in seconds to wait & collect by default"
+
+ ^ 0.2
+!
+
+defaultTranscriptSize
+ "the number of cols/lines by which the Transcript should come up"
+
+ ^ 70@11
+! !
+
+!TextCollector methodsFor:'Compatibility-ST80'!
+
+deselect
+ self unselect
+!
+
+flush
+ self endEntry.
+ super flush
+! !
+
+!TextCollector methodsFor:'accessing'!
+
+autoRaise
+ ^ autoRaise ? false
+!
+
+autoRaise:something
+ autoRaise := something.
+!
+
+collect:aBoolean
+ "turn on/off collecting - if on, do not output immediately
+ but collect text and output en-bloque after some time delta"
+
+ collecting := aBoolean
+!
+
+collectSize:numberOfLines
+ "set the collect buffer size. If collect is enabled,
+ the receiver will force update of the view,
+ whenever that many lines have been collected
+ (or the updateTimeDelay interval has passed).
+ With collect turned off, an immediate update is performed."
+
+ collectSize := numberOfLines
+
+ "Modified: / 27.7.1998 / 16:16:00 / cg"
+!
+
+destroyAction:aBlock
+ "define the action to be performed when I get destroyed.
+ This is a special feature, to allow resetting Transcript to Stderr
+ when closed. (see TextCollectorclass>>newTranscript)"
+
+ destroyAction := aBlock
+!
+
+lineLimit
+ "return the number of text-lines I am supposed to hold"
+
+ ^ lineLimit
+
+ "
+ Transcript lineLimit:5000
+ Transcript lineLimit
+ "
+
+ "Modified: / 16.5.1998 / 01:33:52 / cg"
+!
+
+lineLimit:aNumber
+ "define the number of text-lines I am supposed to hold"
+
+ lineLimit := aNumber
+
+ "
+ Transcript lineLimit:5000
+ "
+
+ "Modified: / 16.5.1998 / 01:33:52 / cg"
+!
+
+updateTimeDelay:seconds
+ "if collect is enabled, the receiver will update its view,
+ after that time delay (i.e. it collects output during that period),
+ or when collectSize lines have been collected without update.
+ With collect turned off, an immediate update is performed."
+
+ timeDelay := seconds
+
+ "Modified: / 27.7.1998 / 16:16:41 / cg"
+! !
+
+!TextCollector methodsFor:'event handling'!
+
+exposeX:x y:y width:w height:h
+ "flush buffered text when exposed"
+
+ super exposeX:x y:y width:w height:h.
+ "/ self endEntry
+! !
+
+!TextCollector methodsFor:'initialization & release'!
+
+destroy
+ "destroy this view"
+
+ destroyAction value.
+ super destroy
+
+ "Modified: / 9.11.1998 / 21:18:17 / cg"
+!
+
+editMenu
+ "return my popUpMenu; thats the superClasses menu,
+ minus any accept item."
+
+ <resource: #programMenu>
+
+ |m idx|
+
+ m := super editMenu.
+
+ "
+ textcollectors do not support #accept
+ remove it from the menu (and the preceeding separating line)
+ "
+ idx := m indexOf:#accept.
+ idx ~~ 0 ifTrue:[
+ m remove:idx.
+ (m labels at:(idx - 1)) = '-' ifTrue:[
+ m remove:idx - 1
+ ].
+ ].
+ ^ m
+
+ "Modified: 3.7.1997 / 13:54:11 / cg"
+!
+
+initialize
+ super initialize.
+
+ scrollWhenUpdating := #endOfText.
+
+ outstandingLines := nil.
+ alwaysAppendAtEnd := true.
+ collectSize := self class defaultCollectSize.
+
+ flushPending := inFlush := false.
+ collecting := true.
+ timeDelay := self class defaultTimeDelay.
+ access := RecursionLock new name:'TextCollector access lock'.
+
+ lineLimit := self class defaultLineLimit.
+ entryStream := ActorStream new.
+ entryStream nextPutBlock:[:something | self nextPut:something].
+ entryStream nextPutAllBlock:[:something | self nextPutAll:something]
+
+ "Modified: / 14.12.1999 / 21:13:54 / cg"
+!
+
+mapped
+ "view became visible - show collected lines (if any)"
+
+ super mapped.
+ self endEntry
+!
+
+reinitialize
+ "reinit after a snapIn.
+ recreate access-semaphore; image could have been save (theoretically)
+ with the semaphore locked - in this case, we had a deadlock"
+
+ flushPending := inFlush := false.
+ access := RecursionLock new. "/ Semaphore forMutualExclusion.
+ super reinitialize.
+
+ "Modified: / 5.3.1998 / 10:09:14 / stefan"
+!
+
+release
+ flushBlock notNil ifTrue:[
+ Processor removeTimedBlock:flushBlock.
+ flushBlock := nil.
+ ].
+ outstandingLines := nil.
+ outstandingLine := ''.
+
+ super release
+
+ "Modified: / 9.11.1998 / 21:18:17 / cg"
+! !
+
+!TextCollector methodsFor:'private'!
+
+checkLineLimit
+ "this method checks if the text has become too large (> lineLimit)
+ and cuts off some lines at the top if so; it must be called whenever lines
+ have been added to the bottom"
+
+ |nDel newCursorLine|
+
+ lineLimit notNil ifTrue:[
+ (cursorLine > lineLimit) ifTrue:[
+ nDel := list size - lineLimit.
+ self basicListRemoveFromIndex:1 toIndex:nDel.
+ newCursorLine := cursorLine - nDel.
+ firstLineShown := firstLineShown - nDel.
+ (firstLineShown < 1) ifTrue:[
+ newCursorLine := newCursorLine - firstLineShown + 1.
+ firstLineShown := 1
+ ].
+ self setCursorLine:newCursorLine.
+ self contentsChanged.
+ self invalidate.
+ ]
+ ].
+ self autoRaise ifTrue:[
+ self topView
+ raise;
+ "/ setForegroundWindow;
+ yourself.
+ ].
+
+ "Modified: / 26-07-2006 / 16:02:15 / fm"
+!
+
+installDelayedUpdate
+ "arrange for collecting input for some time,
+ and output all buffered strings at once after a while.
+ This makes output to the transcript much faster on systems
+ with poor scrolling performance (i.e. dumb vga cards ...)."
+
+ |p|
+
+ flushPending ifFalse:[
+ inFlush ifFalse:[
+ flushPending := true.
+ "
+ we could run under a process, which dies in the meantime;
+ therefore, we have to arrange for the transcript process to
+ be interrupted and do the update.
+ "
+ windowGroup isNil ifTrue:[
+ p := Processor timeoutHandlerProcess
+ ] ifFalse:[
+ p := windowGroup process
+ ].
+ (p isNil or:[p isSystemProcess]) ifTrue:[
+ self endEntry
+ ] ifFalse:[
+ flushBlock isNil ifTrue:[
+ flushBlock := [self delayedEndEntry].
+ ].
+ Processor addTimedBlock:flushBlock for:p afterSeconds:timeDelay.
+ ].
+ p := nil. "hack: avoid dangling references to p through the home context of flushBlock"
+ ]
+ ]
+
+ "Modified: / 17.4.1997 / 13:03:15 / stefan"
+ "Modified: / 9.11.1998 / 14:34:07 / cg"
+!
+
+senderTraceString
+ "generate a sender trace string."
+
+ |con|
+
+ "/ skip over intermediate contexts
+"/ con := con sender.
+"/ con := thisContext sender sender.
+"/ [ con receiver == self ] whileTrue:[
+"/ con := con sender
+"/ ].
+ con := DebugView interestingContextFrom:thisContext sender sender.
+ ^ con printString
+
+ "Created: / 02-02-2012 / 11:58:17 / cg"
+! !
+
+!TextCollector methodsFor:'queries'!
+
+current
+ "return the current (your screen's) transcript.
+ In multiDisplay applications, this need NOT be the main transcript.
+ But typically, this is the same as Transcript."
+
+ |theTranscript app|
+
+ theTranscript := TranscriptQuerySignal query.
+ theTranscript isNil ifTrue:[
+ app := self topView application class current.
+ (app notNil and:[thisContext isRecursive not]) ifTrue:[
+ theTranscript := (app transcript ? Stderr).
+ ] ifFalse:[
+ theTranscript := Stderr.
+ ]
+ ].
+ ^ theTranscript
+
+ "
+ Transcript current flash
+ "
+
+ "Created: / 05-07-1996 / 14:14:34 / cg"
+ "Modified (comment): / 29-08-2013 / 11:04:55 / cg"
+!
+
+isStream
+ "if I am the Transcript, I am used as a stream.
+ See #displayOn:"
+
+ ^ self == Transcript
+
+ "
+ Transcript isStream
+ "
+!
+
+isTextCollector
+ ^ true
+
+ "
+ Transcript isTextCollector
+ "
+
+ "Created: / 29-08-2013 / 11:32:46 / cg"
+! !
+
+!TextCollector methodsFor:'scrolling'!
+
+scrollTo:anOrigin redraw:doRedraw
+ access critical:[
+ super scrollTo:anOrigin redraw:doRedraw
+ ]
+! !
+
+!TextCollector methodsFor:'stream messages'!
+
+addLine:line
+ "append a line to the outstanding lines buffer"
+
+ access critical:[
+ outstandingLine size ~~ 0 ifTrue:[
+ outstandingLine := outstandingLine , line
+ ] ifFalse:[
+ (TimestampMessages == true and:[self == Transcript]) ifTrue:[
+ outstandingLine := Timestamp now printString,' ',line
+ ] ifFalse:[
+ outstandingLine := line
+ ]
+ ].
+ "/ self ~~ Transcript ifTrue:['xa' printCR].
+ outstandingLines isNil ifTrue:[
+ outstandingLines := OrderedCollection with:outstandingLine
+ ] ifFalse:[
+ outstandingLines add:outstandingLine.
+ ].
+ outstandingLine := ''.
+
+ collecting ifTrue:[
+ flushPending ifFalse:[
+ self installDelayedUpdate
+ ] ifTrue:[
+ outstandingLines size > collectSize ifTrue:[
+ self endEntry
+ ]
+ ]
+ ] ifFalse:[
+ self endEntry.
+ self cursorReturn.
+ self checkLineLimit.
+ self cursorToEnd.
+ ]
+ ].
+
+ "Created: / 28.7.1998 / 00:31:46 / cg"
+ "Modified: / 28.7.1998 / 00:34:58 / cg"
+!
+
+cr
+ "output a carriage return, finishing the current line"
+
+ access critical:[
+ |line|
+
+ collecting ifTrue:[
+ line := outstandingLine.
+ (TimestampMessages == true and:[self == Transcript]) ifTrue:[
+ outstandingLine size == 0 ifTrue:[
+ line := Timestamp now printString
+ ].
+ ].
+ "/ self ~~ Transcript ifTrue:['xc' printCR].
+ outstandingLines isNil ifTrue:[
+ outstandingLines := OrderedCollection with:line
+ ] ifFalse:[
+ outstandingLines add:line.
+ ].
+ outstandingLine := ''.
+ flushPending ifFalse:[
+ self installDelayedUpdate
+ ]
+ ] ifFalse:[
+ self cursorReturn.
+ self checkLineLimit.
+ self cursorToEnd.
+ ].
+ ].
+!
+
+display:someObject
+ "dolphin compatibility"
+
+ someObject printOn:self.
+!
+
+doesNotUnderstand:aMessage
+ "this is funny: all message we do not understand, are passed
+ on to the stream which will send the characters via nextPut:
+ This way, we understand all Stream messages - great isn't it!!"
+
+ ^ aMessage sendTo:entryStream
+!
+
+ensureCr
+ "if the output position is not already at the beginning of a line,
+ output a carriage return"
+
+ |needCR|
+
+ collecting ifTrue:[
+ needCR := outstandingLine notEmptyOrNil
+ ] ifFalse:[
+ needCR := cursorCol > 0
+ ].
+
+ needCR ifTrue:[
+ self cr.
+ ].
+
+ "Created: / 14-09-2011 / 09:01:03 / cg"
+!
+
+lineLength
+ "to make a textCollector (somewhat) compatible with printer
+ streams, support the lineLength query"
+
+ ^ width // (gc font width)
+
+ "Modified: 11.1.1997 / 14:42:41 / cg"
+!
+
+nextPut:something
+ "append somethings printString to my displayed text.
+ This allows TextCollectors to be used Stream-wise"
+
+ |txt|
+
+ (something isCharacter) ifTrue:[
+ ((something == Character cr) or:[something == Character nl]) ifTrue:[
+ ^ self cr
+ ].
+ ].
+
+ txt := something asString.
+ currentEmphasis notNil ifTrue:[
+ txt := txt emphasizeAllWith:currentEmphasis
+ ].
+ self show:txt.
+
+"/ flushPending ifTrue:[
+"/ self endEntry
+"/ ].
+"/ (something isMemberOf:Character) ifTrue:[
+"/ ((something == Character cr) or:[something == Character nl]) ifTrue:[
+"/ ^ self cr
+"/ ].
+"/ self insertCharAtCursor:something
+"/ ] ifFalse:[
+"/ self insertStringAtCursor:(something printString).
+"/ self checkLineLimit
+"/ ].
+"/ device flush
+
+ "Modified: 11.1.1997 / 14:43:05 / cg"
+!
+
+nextPutAll:something
+ "append all of something to my displayed text.
+ This allows TextCollectors to be used Stream-wise"
+
+ self show:(currentEmphasis notNil
+ ifTrue:[something emphasizeAllWith:currentEmphasis]
+ ifFalse:[something])
+
+ "Modified: 11.1.1997 / 14:43:26 / cg"
+!
+
+show:anObject
+ "insert the argument aString at current cursor position"
+
+ |printString lines|
+
+ printString := anObject printString.
+
+ (self == Transcript) ifTrue:[
+ DebugSendersOfMessagePattern notNil ifTrue:[
+ (DebugSendersOfMessagePattern match:printString string) ifTrue:[
+ "disable all with: DebugSendersOfMessagePattern := nil"
+ self halt:('Transcript: text matches: "', printString,'"').
+ ].
+ ].
+ TraceSendersOfMessagePattern notNil ifTrue:[
+ (TraceSendersOfMessagePattern match:printString string) ifTrue:[
+ printString := self senderTraceString,': ',printString
+ ].
+ ].
+ ].
+
+ (printString includes:(Character cr)) ifTrue:[
+ lines := printString asStringCollection.
+ lines keysAndValuesDo:[:nr :line |
+ (nr == lines size
+ and:[(printString endsWith:(Character cr)) not]) ifTrue:[
+ "/ the last one.
+ self show:line
+ ] ifFalse:[
+ self showCR:line
+ ].
+ ].
+ ^ self.
+ ].
+
+ access critical:[
+ "/ self ~~ Transcript ifTrue:['xs' printCR].
+ outstandingLine size ~~ 0 ifTrue:[
+ outstandingLine := outstandingLine , printString
+ ] ifFalse:[
+ outstandingLine := printString
+ ].
+ collecting ifTrue:[
+ flushPending ifFalse:[
+ self installDelayedUpdate
+ ] ifTrue:[
+ outstandingLines size > collectSize ifTrue:[
+ self endEntry
+ ]
+ ]
+ ] ifFalse:[
+ self endEntry
+ ]
+ ].
+
+ "Modified: / 24-03-2012 / 20:04:10 / cg"
+ "Modified (format): / 02-06-2012 / 01:54:55 / cg"
+!
+
+showCR:anObject
+ "insert the argument aString at current cursor position,
+ and advance to the next line. This is the same as a #show:
+ followed by a #cr."
+
+ |printString lines|
+
+"/ self ~~ Transcript ifTrue:[ ^ self tshow:anObject].
+ printString := anObject printString.
+ printString size == 0 ifTrue:[
+ self cr.
+ ^ self.
+ ].
+
+ self == Transcript ifTrue:[
+ DebugSendersOfMessagePattern notNil ifTrue:[
+ (DebugSendersOfMessagePattern match:printString string) ifTrue:[
+ "/ to disable this right from inside the debugger, evaluate:
+ "/ DebugSendersOfMessagePattern := nil
+ self halt:('Transcript: text matches: "', printString, '"').
+ ].
+ ].
+ TraceSendersOfMessagePattern notNil ifTrue:[
+ (TraceSendersOfMessagePattern match:printString string) ifTrue:[
+ printString := self senderTraceString,': ',printString
+ ].
+ ].
+ ].
+
+ (printString includesAny:(String crlf)) ifTrue:[
+ lines := printString asStringCollection.
+ lines do:[:line|
+ (line endsWith:Character nl) ifTrue:[
+ (line endsWith:(String crlf)) ifTrue:[
+ self addLine:(line copyButLast:2).
+ ] ifFalse:[
+ self addLine:(line copyButLast:1).
+ ]
+ ] ifFalse:[
+ (line endsWith:Character return) ifTrue:[
+ self addLine:(line copyButLast:1).
+ ] ifFalse:[
+ self addLine:line
+ ]
+ ]
+ ].
+ ^ self.
+ ].
+ self addLine:printString
+
+ "Modified: / 24-03-2012 / 20:00:08 / cg"
+!
+
+space
+ self show:' '
+!
+
+tab
+ "append a tab-character to the stream.
+ This is only allowed, if the receiver supports writing."
+
+ self nextPut:(Character tab)
+! !
+
+!TextCollector methodsFor:'stream messages-emphasis'!
+
+bgColor:aColor
+ aColor isNil ifTrue:[
+ currentEmphasis := Text removeEmphasis:#backgroundColor from:currentEmphasis
+ ] ifFalse:[
+ currentEmphasis := Text addEmphasis:(#backgroundColor->aColor) to:currentEmphasis
+ ]
+!
+
+bold
+ "switch to bold - followup text sent via show/nextPutAll: will be inserted in
+ a bold font."
+
+ currentEmphasis := Text addEmphasis:#bold to:currentEmphasis
+!
+
+color:aColor
+ aColor isNil ifTrue:[
+ currentEmphasis := Text removeEmphasis:#color from:currentEmphasis
+ ] ifFalse:[
+ currentEmphasis := Text addEmphasis:(#color->aColor) to:currentEmphasis
+ ].
+
+ "Modified: / 26.3.1999 / 14:29:21 / cg"
+!
+
+italic
+ currentEmphasis := Text addEmphasis:#italic to:currentEmphasis
+!
+
+normal
+ currentEmphasis := nil
+!
+
+notBold
+ "switch to non-bold - followup text sent via show/nextPutAll: will be inserted in
+ a non-bold font."
+
+ currentEmphasis := Text removeEmphasis:#bold from:currentEmphasis
+!
+
+notItalic
+ "switch to non-italic - followup text sent via show/nextPutAll: will be inserted in
+ a non-italic font."
+
+ currentEmphasis := Text removeEmphasis:#italic from:currentEmphasis
+!
+
+notReverse
+ currentEmphasis := Text removeEmphasis:#color from:currentEmphasis.
+ currentEmphasis := Text removeEmphasis:#backgroundColor from:currentEmphasis.
+!
+
+notUnderline
+ currentEmphasis := Text removeEmphasis:#underline from:currentEmphasis
+
+ "Created: / 26.3.1999 / 14:27:07 / cg"
+!
+
+reverse
+ currentEmphasis := Text addEmphasis:(#color->bgColor) to:currentEmphasis.
+ currentEmphasis := Text addEmphasis:(#backgroundColor->fgColor) to:currentEmphasis.
+!
+
+underline
+ currentEmphasis := Text addEmphasis:#underline to:currentEmphasis
+
+ "Created: / 26.3.1999 / 14:27:07 / cg"
+! !
+
+!TextCollector methodsFor:'transcript specials'!
+
+beTranscript
+ "make the receiver be the systemTranscript; this one
+ is accessable via the global Transcript and gets relevant
+ system messages from various places."
+
+ self beTranscript:#Transcript
+
+ "Modified: / 2.11.1997 / 22:34:47 / cg"
+!
+
+beTranscript:name
+ "make the receiver be the systemTranscript; this one
+ is accessable via the global Transcript and gets relevant
+ system messages from various places."
+
+ |fg bg cFg cBg|
+
+ Smalltalk at:name put:self.
+
+ "
+ fancy feature: whenever Transcript is closed, reset to StdError
+ "
+ self destroyAction:[
+ self == (Smalltalk at:name) ifTrue:[
+ Smalltalk at:name put:Stderr
+ ]
+ ].
+
+ "/ user may prefer a special color for this one;
+ "/ look into the style definitions ...
+
+ fg := styleSheet colorAt:'transcript.foregroundColor' default:self foregroundColor.
+ bg := styleSheet colorAt:'transcript.backgroundColor' default:self backgroundColor.
+ self foregroundColor:fg backgroundColor:bg.
+ self viewBackground:bg.
+
+ cFg := styleSheet colorAt:'transcript.cursorForegroundColor' default:bg.
+ cBg := styleSheet colorAt:'transcript.cursorBackgroundColor' default:fg.
+ self cursorForegroundColor:cFg backgroundColor:cBg.
+
+ "self lineLimit:1000. " "or whatever you think makes sense"
+
+ "Modified: / 2.11.1997 / 22:34:47 / cg"
+!
+
+beginEntry
+ "noop for now, ST80 compatibility"
+
+ ^ self
+
+ "Created: / 4.3.1998 / 11:08:14 / stefan"
+!
+
+clear
+ self endEntry.
+ self contents:nil.
+
+ "
+ Transcript clear
+ "
+!
+
+delayedEndEntry
+ "flush collected output; displaying all that has been buffered so far"
+
+ "/ self ~~ Transcript ifTrue:[ 'de0' printCR ].
+ inFlush ifTrue:[
+ "/ self ~~ Transcript ifTrue:[ 'deX' printCR ].
+ ^ self
+ ].
+
+ "/ self ~~ Transcript ifTrue:[ 'de1' printCR ].
+ access owner == Processor activeProcess ifTrue:[
+ "/ self ~~ Transcript ifTrue:[ 'de2' printCR ].
+ self installDelayedUpdate.
+ ^ self
+ ].
+
+ self endEntry
+!
+
+endEntry
+ "flush collected output; displaying all that has been buffered so far"
+
+ |nLines lines device|
+
+ ((outstandingLines isEmptyOrNil) and:[outstandingLine isEmptyOrNil]) ifTrue:[
+ "/ self ~~ Transcript ifTrue:[ 'e- ' print. thisContext sender selector printCR ].
+ ^ self
+ ].
+ shown ifFalse:[
+ "/ when iconified or not yet shown, keep
+ "/ collecting. But not too much ...
+ outstandingLines size < 300 ifTrue:[
+ "/ self ~~ Transcript ifTrue:[ 'eC' printCR ].
+ access critical:[
+ flushPending ifFalse:[
+ self installDelayedUpdate.
+ ].
+ ].
+ ^ self
+ ]
+ ].
+
+ device := self graphicsDevice.
+ (device isNil or:[device isOpen not or:[self drawableId isNil]]) ifTrue:[
+ "on snapshot load, Transcript may not yet be re-created.
+ Write to Stderr then."
+ Stderr notNil ifTrue:[
+ outstandingLines do:[:eachLine|
+ eachLine printOn:Stderr.
+ ].
+ outstandingLines := nil.
+ outstandingLine notNil ifTrue:[
+ outstandingLine printOn:Stderr.
+ outstandingLine := nil.
+ ].
+ Stderr cr.
+ ].
+ ^ self.
+ ].
+
+ "/ self ~~ Transcript ifTrue:[ 'e ' print.
+ "/ thisContext fullPrintAll.
+ "/ ].
+
+"/ access owner == Processor activeProcess ifTrue:[
+"/self ~~ Transcript ifTrue:[ 'eI' printCR ].
+"/ self installDelayedUpdate.
+"/ ^ self
+"/ ].
+
+ access critical:[
+ collecting ifTrue:[
+ flushBlock notNil ifTrue:[
+ Processor removeTimedBlock:flushBlock.
+ ].
+"/ flushPending ifFalse:[
+"/self ~~ Transcript ifTrue:[ 'eP' printCR ].
+"/ ^ self
+"/ ].
+ ].
+
+ "/ self ~~ Transcript ifTrue:[ 'e1' printCR ].
+ inFlush ifFalse:[
+ "/ self ~~ Transcript ifTrue:[ 'e2' printCR ].
+ inFlush := true.
+ [
+ flushPending := false.
+ "/ self ~~ Transcript ifTrue:[ 'e3 "' print. outstandingLine print. '" ' print. outstandingLine asByteArray hexPrintString print. ' ' printCR.
+ "/ (outstandingLines ? #()) do:[:l | '"' print. l print. '" ' print. l asByteArray hexPrintString printCR ]].
+ (nLines := outstandingLines size) ~~ 0 ifTrue:[
+ "/ self ~~ Transcript ifTrue:[ 'e4' printCR.].
+ "insert the bunch of lines - if any"
+ lines := outstandingLines.
+ outstandingLines := nil.
+
+ "/ self ~~ Transcript ifTrue:[ 'e5 ' print. nLines printCR.].
+ (nLines ~~ 0) ifTrue:[
+ self isInInsertMode ifTrue:[
+ "/ self ~~ Transcript ifTrue:[ (nLines > 1 and:[(lines second ? '') startsWith:'111']) ifTrue:['e6a' printCR.self halt.]].
+ self insertLines:lines withCR:true.
+ "/ self ~~ Transcript ifTrue:[ (nLines > 1 and:[(lines second ? '') startsWith:'111']) ifTrue:['e6a' printCR.self halt.]].
+ ] ifFalse:[
+ self replaceLines:lines withCR:true
+ ].
+ alwaysAppendAtEnd ifTrue:[
+ self cursorToEnd.
+ ].
+ (cursorLine >= (firstLineShown + nFullLinesShown)) ifTrue:[
+ self withCursorOffDo:[
+ self scrollDown:nLines
+ ]
+ ].
+ ].
+ ].
+
+ "/ self ~~ Transcript ifTrue:[ (nLines > 1 and:[(lines second ? '') startsWith:'111']) ifTrue:['e7a' printCR.self halt.]].
+ "and the last partial line - if any"
+ outstandingLine size ~~ 0 ifTrue:[
+ self isInInsertMode ifTrue:[
+ self insertStringAtCursor:outstandingLine.
+ ] ifFalse:[
+ self replaceStringAtCursor:outstandingLine.
+ ].
+ outstandingLine := ''.
+ ].
+ self checkLineLimit.
+ "/ device flush.
+ ] ensure:[
+ inFlush := false.
+ ]
+ ].
+"/ flushPending ifTrue:[
+"/ flushPending := false.
+"/ self installDelayedUpdate
+"/ ]
+ ].
+
+ "Modified: / 9.11.1998 / 21:17:56 / cg"
+!
+
+flash
+ "make sure everything is visible, before flashing"
+
+ self endEntry.
+ super flash.
+! !
+
+!TextCollector class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.134.2.1 2014-05-08 08:30:56 stefan Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.134.2.1 2014-05-08 08:30:56 stefan Exp $'
+! !
+
+
+TextCollector initialize!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TextView.st Thu May 08 10:30:56 2014 +0200
@@ -0,0 +1,4892 @@
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+'From Smalltalk/X, Version:6.2.3.0 on 18-02-2014 at 18:37:41' !
+
+"{ Package: 'stx:libwidg' }"
+
+ListView subclass:#TextView
+ instanceVariableNames:'selectionStartLine selectionStartCol selectionEndLine
+ selectionEndCol clickPos clickStartLine clickStartCol clickLine
+ clickCol clickCount expandingTop wordStartCol wordStartLine
+ wordEndCol wordEndLine selectionFgColor selectionBgColor
+ selectStyle directoryForFileDialog defaultFileNameForFileDialog
+ externalEncoding contentsWasSaved searchAction lastSearchPattern
+ lastSearchWasMatch lastSearchIgnoredCase lastSearchDirection
+ lastSearchWasVariableSearch parenthesisSpecification dropSource
+ dragIsActive saveAction st80SelectMode searchBarActionBlock'
+ classVariableNames:'DefaultViewBackground DefaultSelectionForegroundColor
+ DefaultSelectionBackgroundColor
+ DefaultAlternativeSelectionForegroundColor
+ DefaultAlternativeSelectionBackgroundColor MatchDelayTime
+ WordSelectCatchesBlanks LastSearchPatterns
+ NumRememberedSearchPatterns LastSearchIgnoredCase
+ LastSearchWasMatch DefaultParenthesisSpecification'
+ poolDictionaries:''
+ category:'Views-Text'
+!
+
+!TextView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ a view for readOnly text - this class adds selections to a simple list.
+ The text is not editable and there is no cursor.
+ Use TextViews for readonly text, EditTextView for editable text.
+
+ Please read the historic notice in the ListView class.
+
+ [Instance variables:]
+
+ selectionStartLine <Number> the line of the selection start (or nil)
+ selectionStartCol <Number> the col of the selection start
+ selectionEndLine <Number> the line of the selection end
+ selectionEndCol <Number> the col of the selection end
+
+ clickStartLine <Number> temporary - remember where select operation started
+ clickStartCol <Number> temporary
+ clickLine <Number> temporary
+ clickCol <Number> temporary
+ clickCount <Number> temporary
+ expandingTop <Boolean> temporary - for expandSelection
+
+ selectionFgColor <Color> color used to draw selections
+ selectionBgColor <Color> color used to draw selections
+
+ selectStyle <Symbol> how words are selected
+
+ directoryForFileDialog <nil|pathName> directory where save dialog should start
+
+ contentsWasSaved <Boolean> set to true, whenever saved in a file
+
+ externalEncoding <Symbol|nil> external encoding, used when text is saved to
+ a file. Usually something like
+ #jis7, #euc, #sjis etc.
+ (currently only passed down from the
+ fileBrowser)
+
+ dropSource <DropSource> drag operation descriptor or nil (dragging disabled)
+ dragIsActive <Boolean> true, drag operation is activated
+
+ searchAction <Block> an autosearch action; typically set by the browser.
+ Will be used as default when searchFwd/searchBwd is
+ pressed. If the searchPattern is changed, no autosearch
+ action will be executed.
+
+ searchBarActionBlock <Block> search action block for embedded search
+ panel. Used as second chance for searchFwd/bwd
+
+ [class variables:]
+ ST80Selections <Boolean> enables ST80 style doubleclick behavior
+ (right after opening parenthesis, right before
+ closing parenthesis, at begin of a line
+ at begin of text)
+
+ [StyleSheet parameters:]
+
+ textView.background defaults to viewBackground
+ textView.ViewFont defaults to textFont
+
+ text.st80Selections st80 behavior (click on char after parent or quote)
+
+ text.selectionForegroundColor defaults to textBackgroundColor
+ text.selectionBackgroundColor defaults to textForegroundColor
+
+ text.alternativeSelectionForegroundColor pasted text (i.e. paste will not replace)
+ defaults to selectionForegroundColor
+ text.alternativeSelectionBackgroundColor pasted text (i.e. paste will not replace)
+ defaults to selectionBackgroundColor
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ EditTextView CodeView Workspace
+"
+!
+
+examples
+"
+ although textViews (and instances of subclasses) are mostly used
+ as components (in the fileBrowser, the browser, the launcher etc.),
+ they may also be opened as a textEditor;
+
+ open a (readonly) textView on some information text:
+ [exBegin]
+ TextView
+ openWith:'read this'
+ title:'demonstration'
+ [exEnd]
+
+ the same, but open it modal:
+ [exBegin]
+ TextView
+ openModalWith:'read this first'
+ title:'demonstration'
+ [exEnd]
+
+
+ open it modal (but editable) on some text:
+ (must accept before closing)
+ This is somewhat kludgy - when closed, the view has already
+ nilled its link to the model. Therefore, the accept must be
+ done 'manually' below.
+ However, usually an applicationModel is installed as the
+ editor-topViews application. This would get a closeRequest,
+ where it could handle things.
+ [exBegin]
+ |m textView|
+
+ m := 'read this first' asValue.
+ textView := EditTextView openModalOnModel:m.
+ textView modified ifTrue:[
+ (self confirm:'text was not accepted - do it now ?')
+ ifTrue:[
+ m value:textView contents
+ ]
+ ].
+
+ Transcript showCR:m value.
+ [exEnd]
+
+
+ open a textEditor on some file:
+ [exBegin]
+ EditTextView openOn:'Makefile'
+ [exEnd]
+
+"
+
+! !
+
+!TextView class methodsFor:'instance creation'!
+
+on:aModel aspect:aspect change:change menu:menu initialSelection:initial
+ "for ST-80 compatibility"
+
+ ^ (self new)
+ on:aModel
+ aspect:aspect
+ list:aspect
+ change:change
+ menu:menu
+ initialSelection:initial
+!
+
+with:someText
+ ^ (self new)
+ contents:someText
+! !
+
+!TextView class methodsFor:'class initialization'!
+
+initialize
+ DefaultParenthesisSpecification isNil ifTrue:[
+ DefaultParenthesisSpecification := IdentityDictionary new.
+ DefaultParenthesisSpecification at:#open put:#( $( $[ ${ "$> $<") .
+ DefaultParenthesisSpecification at:#close put:#( $) $] $} "$> $<").
+ DefaultParenthesisSpecification at:#ignore put:#( $' $" '$[' '$]' '${' '$)' ).
+ DefaultParenthesisSpecification at:#eolComment put:'"/'. "/ sigh - must be 2 characters
+ ].
+! !
+
+!TextView class methodsFor:'defaults'!
+
+defaultIcon
+ "return the default icon if started as a topView"
+
+ <resource: #programImage>
+ <resource: #style (#ICON #ICON_FILE)>
+
+ |nm i|
+
+ i := self classResources at:'ICON' default:nil.
+ i isNil ifTrue:[
+ nm := ClassResources at:'ICON_FILE' default:'Editor.xbm'.
+ i := Smalltalk imageFromFileNamed:nm forClass:self.
+ ].
+ i notNil ifTrue:[
+ i := i onDevice:Display
+ ].
+ ^ i
+
+ "Modified: / 17-09-2007 / 11:36:29 / cg"
+!
+
+defaultMenuMessage
+ "This message is the default yo be sent to the menuHolder to get a menu"
+
+ ^ #editMenu
+
+ "Created: 3.1.1997 / 01:52:21 / stefan"
+!
+
+defaultParenthesisSpecification
+ ^ DefaultParenthesisSpecification
+
+ "Created: / 14-06-2011 / 14:00:59 / cg"
+!
+
+defaultSelectionBackgroundColor
+ "return the default selection background color"
+
+ ^DefaultSelectionBackgroundColor
+!
+
+defaultSelectionForegroundColor
+ "return the default selection foreground color"
+
+ ^DefaultSelectionForegroundColor
+!
+
+defaultViewBackgroundColor
+ "return the default view background"
+
+ ^DefaultViewBackground
+!
+
+lastSearchIgnoredCase
+ ^ LastSearchIgnoredCase
+!
+
+lastSearchWasMatch
+ ^ LastSearchWasMatch
+!
+
+st80SelectMode
+ ^ UserPreferences current st80SelectMode
+
+ "Modified: / 03-07-2006 / 16:26:44 / cg"
+!
+
+st80SelectMode:aBoolean
+ UserPreferences current st80SelectMode:aBoolean
+
+ "Created: / 07-01-1999 / 13:35:24 / cg"
+ "Modified: / 03-07-2006 / 16:27:01 / cg"
+!
+
+updateStyleCache
+ "extract values from the styleSheet and cache them in class variables"
+
+ <resource: #style (#'textView.background'
+ #'text.selectionForegroundColor'
+ #'text.selectionBackgroundColor'
+ #'text.alternativeSelectionForegroundColor'
+ #'text.alternativeSelectionBackgroundColor'
+ #'textView.font'
+ #'text.wordSelectCatchesBlanks'
+ #'text.st80Selections')>
+
+ DefaultViewBackground := StyleSheet colorAt:'textView.background' default:Color white.
+ DefaultSelectionForegroundColor := StyleSheet colorAt:'text.selectionForegroundColor'.
+ DefaultSelectionBackgroundColor := StyleSheet colorAt:'text.selectionBackgroundColor'.
+"/ DefaultAlternativeSelectionForegroundColor := StyleSheet colorAt:'text.alternativeSelectionForegroundColor' default:DefaultSelectionForegroundColor.
+"/ DefaultAlternativeSelectionBackgroundColor := StyleSheet colorAt:'text.alternativeSelectionBackgroundColor' default:DefaultSelectionBackgroundColor.
+ DefaultAlternativeSelectionForegroundColor := DefaultSelectionForegroundColor.
+ DefaultAlternativeSelectionBackgroundColor := DefaultSelectionBackgroundColor.
+ DefaultFont := StyleSheet fontAt:'textView.font'.
+ MatchDelayTime := 0.6.
+ WordSelectCatchesBlanks := StyleSheet at:'text.wordSelectCatchesBlanks' default:false.
+
+ "Modified: / 03-07-2006 / 16:29:42 / cg"
+! !
+
+!TextView class methodsFor:'help specs'!
+
+flyByHelpSpec
+ "This resource specification was automatically generated
+ by the UIHelpTool of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIHelpTool may not be able to read the specification."
+
+ "
+ UIHelpTool openOnClass:TextView
+ "
+
+ <resource: #help>
+
+ ^ Dictionary new addPairsFrom:#(
+
+#matchSearch
+'Search for a pattern (glob) as opposed to a direct string search'
+
+#searchCaseSensitive
+'Care for case differences'
+
+#searchFullWord
+'Search only for full words (ignore occurrences as substring)'
+
+#searchPattern
+'String or match-pattern to be searched'
+
+#searchVariable
+'Search only for that variable name (ignore occurrences in other contexts)'
+
+#replaceText
+'If checked, matching text is replaced by this (everywhere)'
+
+#selectLines
+'If checked, lines containing the matched string are selected.'
+
+)
+! !
+
+!TextView class methodsFor:'interface specs'!
+
+searchDialogSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:TextView andSelector:#searchDialogSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: searchDialogSpec
+ window:
+ (WindowSpec
+ label: 'String search'
+ name: 'String search'
+ min: (Point 10 10)
+ max: (Point 1280 1024)
+ bounds: (Rectangle 0 0 302 242)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'SearchPattern:'
+ name: 'label'
+ layout: (LayoutFrame 1 0.0 3 0 -1 1.0 20 0)
+ level: 0
+ translateLabel: true
+ adjust: left
+ )
+ (ComboBoxSpec
+ name: 'patternComboBox'
+ layout: (LayoutFrame 2 0.0 26 0 -2 1.0 48 0)
+ activeHelpKey: searchPattern
+ tabable: true
+ model: searchPattern
+ immediateAccept: false
+ acceptOnLeave: true
+ acceptOnReturn: true
+ acceptOnTab: true
+ acceptOnLostFocus: true
+ acceptOnPointerLeave: false
+ autoSelectInitialText: true
+ comboList: patternList
+ )
+ (VerticalPanelViewSpec
+ name: 'VerticalPanel1'
+ layout: (LayoutFrame 0 0.0 52 0 0 1.0 -30 1)
+ horizontalLayout: fit
+ verticalLayout: top
+ component:
+ (SpecCollection
+ collection: (
+ (CheckBoxSpec
+ label: 'Case Sensitive'
+ name: 'ignoreCaseCheckBox'
+ activeHelpKey: searchCaseSensitive
+ level: 0
+ tabable: true
+ model: caseSensitive
+ translateLabel: true
+ extent: (Point 302 24)
+ )
+ (CheckBoxSpec
+ label: 'Match (forward only)'
+ name: 'matchCheckBox'
+ activeHelpKey: matchSearch
+ level: 0
+ tabable: true
+ model: match
+ translateLabel: true
+ extent: (Point 302 24)
+ )
+ (CheckBoxSpec
+ label: 'Search Full Words'
+ name: 'CheckBox2'
+ activeHelpKey: searchFullWord
+ level: 0
+ enableChannel: searchFullWordEnabled
+ tabable: true
+ model: searchFullWord
+ translateLabel: true
+ extent: (Point 302 24)
+ )
+ (CheckBoxSpec
+ label: 'Variable Only'
+ name: 'CheckBox1'
+ activeHelpKey: searchVariable
+ level: 0
+ visibilityChannel: searchVariableVisible
+ enableChannel: searchVariableEnabled
+ tabable: true
+ model: searchVariable
+ translateLabel: true
+ labelChannel: stringWithVariableUnderCursorHolder
+ extent: (Point 302 24)
+ )
+ (CheckBoxSpec
+ label: 'Select Lines'
+ name: 'CheckBox3'
+ activeHelpKey: selectLines
+ level: 0
+ initiallyInvisible: true
+ tabable: true
+ model: selectLines
+ translateLabel: true
+ extent: (Point 302 24)
+ )
+ (ViewSpec
+ name: 'Box1'
+ component:
+ (SpecCollection
+ collection: (
+ (CheckBoxSpec
+ label: 'Global Replace With:'
+ name: 'CheckBox4'
+ layout: (LayoutFrame 0 0 0 0 162 0 23 0)
+ activeHelpKey: replaceText
+ level: 0
+ enableChannel: replaceEnabled
+ tabable: true
+ model: replaceBoolean
+ translateLabel: true
+ )
+ (InputFieldSpec
+ name: 'ReplaceEntryField'
+ layout: (LayoutFrame 164 0 0 0 -2 1 22 0)
+ activeHelpKey: replaceText
+ visibilityChannel: replaceBoolean
+ enableChannel: replaceBoolean
+ model: replaceTextHolder
+ acceptOnReturn: true
+ acceptOnTab: true
+ acceptOnPointerLeave: true
+ )
+ )
+
+ )
+ extent: (Point 302 24)
+ )
+ )
+
+ )
+ )
+ (HorizontalPanelViewSpec
+ name: 'horizontalPanelView'
+ layout: (LayoutFrame 0 0.0 -30 1.0 -16 1.0 0 1.0)
+ level: 0
+ horizontalLayout: fitSpace
+ verticalLayout: center
+ horizontalSpace: 3
+ verticalSpace: 3
+ ignoreInvisibleComponents: true
+ reverseOrderIfOKAtLeft: true
+ component:
+ (SpecCollection
+ collection: (
+ (ActionButtonSpec
+ label: 'Cancel'
+ name: 'cancelButton'
+ level: 2
+ translateLabel: true
+ tabable: true
+ model: cancel
+ extent: (Point 91 21)
+ )
+ (ActionButtonSpec
+ label: 'Prev'
+ name: 'prevButton'
+ level: 2
+ translateLabel: true
+ tabable: true
+ model: prevAction
+ extent: (Point 91 21)
+ )
+ (ActionButtonSpec
+ label: 'Next'
+ name: 'nextButton'
+ level: 2
+ borderWidth: 1
+ translateLabel: true
+ tabable: true
+ model: nextAction
+ isDefault: true
+ extent: (Point 90 21)
+ )
+ )
+
+ )
+ keepSpaceForOSXResizeHandleH: true
+ )
+ )
+
+ )
+ )
+! !
+
+!TextView class methodsFor:'startup'!
+
+open
+ "start an empty TextView"
+
+ ^ self openWith:nil
+!
+
+openModalOnModel:aModel
+ "start a textView on a model; return the textView"
+
+ |textView|
+
+ textView := self setupForModel:aModel.
+ textView topView openModal.
+ ^ textView
+
+ "Created: 14.2.1997 / 15:24:12 / cg"
+!
+
+openModalWith:aString
+ "start a textView with aString as initial contents"
+
+ ^ self openModalWith:aString title:nil
+
+ "
+ TextView openModalWith:'some text'
+ EditTextView openModalWith:'some text'
+ "
+
+ "Created: 14.2.1997 / 15:19:04 / cg"
+!
+
+openModalWith:aString title:aTitle
+ "start a textView with aString as initial contents. Return the textView."
+
+ |textView|
+
+ textView := self setupWith:aString title:aTitle.
+ textView topView openModal.
+ ^ textView
+
+ "
+ TextView openModalWith:'some text' title:'testing'
+ EditTextView openModalWith:'some text' title:'testing'
+ "
+
+ "Modified: 9.9.1996 / 19:32:29 / cg"
+ "Created: 14.2.1997 / 15:19:18 / cg"
+!
+
+openOn:aFileName
+ "start a textView on a file; return the textView"
+
+ |textView|
+
+ textView := self setupForFile:aFileName.
+ textView topView open.
+ ^ textView
+
+ "
+ TextView openOn:'../../doc/overview.doc'
+ EditTextView openOn:'../../doc/overview.doc'
+ "
+
+ "Modified: 14.2.1997 / 15:21:51 / cg"
+!
+
+openOnModel:aModel
+ "start a textView on a model; return the textView"
+
+ |textView|
+
+ textView := self setupForModel:aModel.
+ textView topView open.
+ ^ textView
+
+ "Created: 14.2.1997 / 15:23:36 / cg"
+!
+
+openWith:aStringOrStringCollection
+ "start a textView with aStringOrStringCollection as initial contents"
+
+ ^ self openWith:aStringOrStringCollection selected:false
+
+ "
+ TextView openWith:'some text'
+ EditTextView openWith:'some text'
+ Workspace openWith:'some text'
+ "
+
+ "Created: 10.12.1995 / 17:41:32 / cg"
+ "Modified: 5.3.1997 / 15:37:19 / cg"
+!
+
+openWith:aStringOrStringCollection selected:selectedBoolean
+ "start a textView with aStringOrStringCollection as initial (optionally selected) contents.
+ Return the textView."
+
+ |textView|
+
+ textView := self setupEmpty.
+ textView contents:aStringOrStringCollection selected:selectedBoolean.
+ textView topView open.
+ ^ textView
+
+ "
+ TextView openWith:'some text' selected:true
+ EditTextView openWith:'some text' selected:false
+ "
+!
+
+openWith:aStringOrStringCollection title:aTitle
+ "start a textView with aStringOrStringCollection as initial contents. Return the textView."
+
+ |textView|
+
+ textView := self setupWith:aStringOrStringCollection title:aTitle.
+ textView topView open.
+ ^ textView
+
+ "
+ TextView openWith:'some text' title:'testing'
+ EditTextView openWith:'some text' title:'testing'
+ "
+
+ "Created: 10.12.1995 / 17:40:02 / cg"
+ "Modified: 5.3.1997 / 15:37:26 / 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:self defaultIcon.
+
+ frame := HVScrollableView
+ for:self
+ miniScrollerH:true miniScrollerV:false
+ in:top.
+ frame origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ ^ frame scrolledView
+
+ "Modified: 23.5.1965 / 14:12:32 / cg"
+!
+
+setupForFile:aFileName
+ "setup a textView on a file; return the textView"
+
+ |textView|
+
+ textView := self setupEmpty.
+ aFileName notNil ifTrue:[
+ textView setupForFile:aFileName.
+ ].
+
+ ^ textView
+
+ "Created: / 14-02-1997 / 15:21:43 / cg"
+ "Modified: / 25-10-2006 / 14:46:54 / cg"
+!
+
+setupForModel:aModel
+ "setup a textView on a model; return the textView"
+
+ |textView|
+
+ textView := self setupEmpty.
+ textView model:aModel.
+ ^ textView
+
+ "Created: 14.2.1997 / 15:22:42 / cg"
+!
+
+setupWith:aStringOrStringCollection title:aTitle
+ "setup a textView with aStringOrStringCollection as initial contents in a topView"
+
+ |top textView|
+
+ textView := self setupEmpty.
+ top := textView topView.
+ aTitle notNil ifTrue:[top label:aTitle].
+
+ aStringOrStringCollection notNil ifTrue:[
+ textView contents:aStringOrStringCollection
+ ].
+
+ ^ textView
+
+ "Created: 9.9.1996 / 19:31:22 / cg"
+ "Modified: 5.3.1997 / 15:37:37 / cg"
+! !
+
+!TextView methodsFor:'Compatibility-ST80'!
+
+displaySelection:aBoolean
+ "ST-80 compatibility: ignored here."
+
+!
+
+editText:someText
+ "ST-80 compatibility: set the edited text."
+
+ self contents:someText
+
+ "Created: / 5.2.2000 / 17:06:18 / cg"
+!
+
+selectAndScroll
+ "ST-80 compatibility: ignored here."
+
+!
+
+selectFrom:startPos to:endPos
+ "change the selection given two character positions."
+
+ self selectFromCharacterPosition:startPos to:endPos
+!
+
+selectionStartIndex
+ "ST-80 compatibility: return the selections start character position."
+
+ ^ self characterPositionOfSelection
+
+ "Created: / 19.6.1998 / 00:21:44 / cg"
+!
+
+selectionStopIndex
+ "ST-80 compatibility: return the character position of
+ the character right after the selection."
+
+ |idx|
+
+ idx := self characterPositionOfSelectionEnd.
+ idx == 0 ifTrue:[^ 0].
+ ^ idx + 1
+
+ "Created: / 19.6.1998 / 00:22:08 / cg"
+! !
+
+!TextView methodsFor:'accessing'!
+
+characterEncoding:encodingArg
+ "define how the contents is encoded internally.
+ This should normally never be required, as ST/X now assumes
+ unicode (of which iso8859-1 is a subset) encoding.
+ The possibility to change the characterEncoding is provided as
+ a backward compatibility hook for programs which want to use
+ another encoding internally."
+
+ |encodingSymOrNil|
+
+ encodingSymOrNil := encodingArg isNil
+ ifTrue:[#'iso10646-1']
+ ifFalse:[encodingArg asSymbol].
+
+ gc characterEncoding ~~ encodingSymOrNil ifTrue:[
+ "/ TODO: reencode contents if required.
+ (list size ~~ 0
+ and:[ list contains:[:line | line size > 0]]) ifTrue:[
+ (self confirm:'Your text may need to be re-coded - this is not yet supported.\\Proceed ?')
+ ifFalse:[^ self].
+ ].
+ super characterEncoding:encodingSymOrNil.
+ ].
+
+ "Modified (format): / 25-01-2012 / 00:28:27 / cg"
+!
+
+characterPositionOfSelection
+ "return the character index of the first character in the selection.
+ Returns 0 if there is no selection."
+
+ selectionStartLine isNil ifTrue:[^ 0].
+ ^ self characterPositionOfLine:selectionStartLine
+ col:selectionStartCol
+
+ "Modified: 14.8.1997 / 16:35:37 / cg"
+!
+
+characterPositionOfSelectionEnd
+ "return the character index of the last character in the selection.
+ Returns 0 if there is no selection."
+
+ selectionStartLine isNil ifTrue:[^ 0].
+ ^ self characterPositionOfLine:selectionEndLine
+ col:selectionEndCol
+
+ "Created: 14.8.1997 / 16:35:24 / cg"
+ "Modified: 14.8.1997 / 16:35:45 / cg"
+!
+
+contentsWasSaved
+ "return true, if the contents was saved (by a save action),
+ false if not (or was modified again after the last save)."
+
+ ^ contentsWasSaved
+!
+
+contentsWasSaved:aBoolean
+ contentsWasSaved := aBoolean
+!
+
+defaultFileNameForFileDialog
+ "return the default fileName to use for the save-box"
+
+ ^ defaultFileNameForFileDialog
+!
+
+defaultFileNameForFileDialog:aBaseName
+ "define the default fileName to use for the save-box"
+
+ defaultFileNameForFileDialog := aBaseName
+
+ "Created: 13.2.1997 / 18:29:53 / cg"
+!
+
+directoryForFileDialog:aDirectory
+ "define the default directory to use for save-box"
+
+ directoryForFileDialog := aDirectory
+
+ "Modified: 13.2.1997 / 18:30:01 / cg"
+!
+
+externalEncoding
+ "return the encoding used when the contents is saved via the 'save / save as' dialog.
+ This is (currently only) passed down from the fileBrowser,
+ and required when utf8/japanese/chinese/korean text is edited.
+ (encoding is something like #utf8 #'iso8859-5' #euc, #sjis, #jis7, #gb, #big5 or #ksc).
+ Notice: this only affects the external representation of the text."
+
+ ^ externalEncoding
+!
+
+externalEncoding:encodingSymOrNil
+ "define how the contents should be encoded when saved
+ via the 'save / save as' dialog.
+ This is (currently only) passed down from the fileBrowser,
+ and required when utf8/japanese/chinese/korean text is edited.
+ (encoding is something like #utf8 #'iso8859-5' #euc, #sjis, #jis7, #gb, #big5 or #ksc).
+ Notice: this only affects the external representation of the text."
+
+ externalEncoding := encodingSymOrNil
+!
+
+parenthesisSpecification
+ "return the value of the instance variable 'parenthesisSpecification' (automatically generated)"
+
+ ^ parenthesisSpecification
+!
+
+parenthesisSpecification:aDictionary
+ "set the dictionary which specifies which characters are opening, which are closing
+ and which are ignored characters w.r.t. parenthesis matching.
+ See the classes initialize method for a useful value."
+
+ parenthesisSpecification := aDictionary
+!
+
+saveAction:something
+ saveAction := something.
+!
+
+searchBarActionBlock
+ ^ searchBarActionBlock
+!
+
+searchBarActionBlock:something
+ searchBarActionBlock := something.
+! !
+
+!TextView methodsFor:'accessing-behavior'!
+
+isReadOnly
+ ^ true
+!
+
+readOnly:aBoolean
+ "for protocol compatibility with editTextViews,
+ but actually ignored"
+! !
+
+!TextView methodsFor:'accessing-contents'!
+
+contents:newContents selected:selectedBoolean
+ self contents:newContents.
+ selectedBoolean ifTrue:[
+ list size == 1 ifTrue:[
+ self selectFromLine:1 col:1 toLine:1 col:(list at:1) size
+ ] ifFalse:[
+ self selectAll
+ ]
+ ]
+
+ "
+ |w|
+
+ w := Workspace new open.
+ w contents:'Hello world' selected:true.
+ "
+!
+
+fromFile:aFileName
+ "take contents from a named file"
+ <resource: #obsolete>
+
+ self obsoleteMethodWarning.
+ ^ self loadTextFile:aFileName.
+
+ "Modified: / 25-10-2006 / 14:47:35 / cg"
+!
+
+list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:nonStringsIfNoScan redraw:doRedraw
+ "set the displayed contents (a collection of strings) with redraw.
+ Redefined since changing the contents implies deselect"
+
+ self unselect.
+ super list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:nonStringsIfNoScan redraw:doRedraw
+!
+
+loadTextFile:aFileName
+ "take contents from a named file"
+
+ |f|
+
+ f := aFileName asFilename.
+ self directoryForFileDialog:(f directoryName).
+ self contents:(f contents)
+
+ "Created: / 25-10-2006 / 14:44:01 / cg"
+!
+
+setContents:something
+ "set the contents (either a string or a Collection of strings)
+ dont change the position (i.e. do not scroll) or the selection."
+
+ |selStartLine selStartCol selEndLine selEndCol selStyle|
+
+ selStartLine := selectionStartLine.
+ selStartCol := selectionStartCol.
+ selEndLine := selectionEndLine.
+ selEndCol := selectionEndCol.
+ selStyle := selectStyle.
+
+ super setContents:something.
+
+ selStartLine notNil ifTrue:[
+ self
+ selectFromLine:selStartLine col:selStartCol
+ toLine:selEndLine col:selEndCol.
+ selectStyle := selStyle
+ ].
+
+
+ "Modified: / 31.3.1998 / 23:33:21 / cg"
+!
+
+setList:something
+ "set the displayed contents (a collection of strings)
+ without redraw.
+ Redefined since changing contents implies deselect"
+
+ self unselect.
+ super setList:something
+!
+
+setupForFile:aFileName
+ "take contents from a named file"
+
+ |baseName|
+
+ self loadTextFile:aFileName.
+ aFileName notNil ifTrue:[
+ baseName := aFileName asFilename baseName.
+ self topView label:baseName.
+ self defaultFileNameForFileDialog:baseName.
+ ].
+
+ "Created: / 25-10-2006 / 14:47:13 / cg"
+!
+
+text
+ "for ST80 compatibility"
+
+ ^ self contents
+
+ "Created: / 19.4.1998 / 12:53:10 / cg"
+!
+
+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 character within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ "
+ try to catch a blank ...
+ "
+
+ WordSelectCatchesBlanks ifTrue:[
+ ((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
+
+ "Modified: 18.3.1996 / 17:31:04 / cg"
+! !
+
+!TextView methodsFor:'accessing-look'!
+
+selectionBackgroundColor
+ "return the selection-background color."
+
+ ^ selectionBgColor
+!
+
+selectionForegroundColor
+ "return the selection-foreground color."
+
+ ^ selectionFgColor
+!
+
+selectionForegroundColor:color1 backgroundColor:color2
+ "set both the selection-foreground and cursor background colors.
+ The default is defined by the styleSheet;
+ typically black-on-green for color displays and white-on-black for b&w displays."
+
+ selectionFgColor := color1 onDevice:self graphicsDevice.
+ selectionBgColor := color2 onDevice:self graphicsDevice.
+ self hasSelection ifTrue:[
+ self invalidate
+ ]
+
+ "Modified: 29.5.1996 / 16:22:15 / cg"
+! !
+
+!TextView methodsFor:'accessing-mvc'!
+
+on:aModel aspect:aspectSym list:listSym change:changeSym menu:menuSym initialSelection:initial
+ "set all of model, aspect, listMessage, changeSymbol, menySymbol
+ and selection. Added for ST-80 compatibility"
+
+ aspectSym notNil ifTrue:[aspectMsg := aspectSym.
+ listMsg isNil ifTrue:[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.
+
+ "Modified: 15.8.1996 / 12:52:54 / stefan"
+ "Modified: 2.1.1997 / 16:11:28 / cg"
+! !
+
+!TextView methodsFor:'drag & drop'!
+
+allowDrag:aBoolean
+ "enable/disable dragging support
+ "
+ aBoolean ifFalse:[
+ dropSource := nil.
+ ] ifTrue:[
+ dropSource isNil ifTrue:[
+ dropSource := DropSource
+ receiver:self
+ argument:nil
+ dropObjectSelector:#collectionOfDragObjects
+ displayObjectSelector:nil
+ ]
+ ].
+!
+
+canDrag
+ "returns true if dragging is enabled"
+
+ ^ dropSource notNil and:[ self hasSelection ]
+
+ "Modified (comment): / 12-02-2012 / 08:37:21 / cg"
+!
+
+collectionOfDragObjects
+ "returns collection of dragable objects assigned to selection
+ Here, by default, a collection of text-dragObjects is generated;
+ however, if a dragObjectConverter is defined, that one gets a chance
+ to convert as appropriate.
+ "
+ |selection|
+
+ selection := self selection.
+
+ selection size == 0 ifTrue:[^ nil].
+ ^ Array with:(DropObject newText:selection).
+!
+
+dropSource
+ "returns the dropSource or nil"
+
+ ^ dropSource
+!
+
+dropSource:aDropSourceOrNil
+ "set the dropSource or nil"
+
+ dropSource := aDropSourceOrNil.
+! !
+
+!TextView methodsFor:'encoding'!
+
+validateFontEncodingFor:newEncoding ask:ask
+ "if required, query user if he/she wants to change to another font,
+ which is able to display text encoded as specified by newEncoding"
+
+ |fontsEncoding msg filter f defaultFont pref matchingFonts
+ matchingFamilyFonts matchingFamilyFaceFonts matchingFamilyFaceStyleFonts
+ matchingFamilyFaceStyleSizeFonts|
+
+ fontsEncoding := gc font encoding.
+
+ pref := FontDescription preferredFontEncodingFor:newEncoding.
+
+ (pref match:fontsEncoding) ifTrue:[
+ ^ self
+ ].
+ (CharacterEncoder isEncoding:pref subSetOf:fontsEncoding) ifTrue:[
+ ^ self
+ ].
+
+ filter := [:f | |coding|
+ (coding := f encoding) notNil
+ and:[pref match:coding]].
+
+ self graphicsDevice flushListOfAvailableFonts.
+ matchingFonts := self graphicsDevice listOfAvailableFonts select:filter.
+ matchingFamilyFonts := matchingFonts select:[:f | f family = gc font family].
+ matchingFamilyFaceFonts := matchingFamilyFonts select:[:f | f face = gc font face].
+ matchingFamilyFaceStyleFonts := matchingFamilyFaceFonts select:[:f | f style = gc font style].
+ matchingFamilyFaceStyleSizeFonts := matchingFamilyFaceStyleFonts select:[:f | f size = gc font size].
+ matchingFamilyFaceStyleSizeFonts size > 0 ifTrue:[
+ defaultFont := matchingFamilyFaceStyleSizeFonts first
+ ] ifFalse:[
+ matchingFamilyFaceStyleFonts size > 0 ifTrue:[
+ defaultFont := matchingFamilyFaceStyleFonts first
+ ] ifFalse:[
+ matchingFamilyFaceFonts size > 0 ifTrue:[
+ defaultFont := matchingFamilyFaceFonts first
+ ] ifFalse:[
+ matchingFamilyFonts size > 0 ifTrue:[
+ defaultFont := matchingFamilyFonts first
+ ] ifFalse:[
+ matchingFonts size > 0 ifTrue:[
+ defaultFont := matchingFonts first
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ defaultFont isNil ifTrue:[
+ defaultFont isNil ifTrue:[
+ self warn:'Your display does not seem to provide any ' , newEncoding allBold , ' encoded font.\\Please select an appropriate font (iso10646-Unicode recommended)'.
+ pref := #'iso10646-1'.
+ ]
+ ].
+
+ msg := 'Switch to a %1 encoded font ?'.
+ (ask not or:[self confirm:(resources stringWithCRs:msg with:pref)])
+ ifTrue:[
+ self withWaitCursorDo:[
+ f := FontPanel
+ fontFromUserInitial:defaultFont
+ title:(resources string:'Font selection')
+ filter:filter
+ encoding:pref.
+
+ f notNil ifTrue:[
+ self font:f.
+ ]
+ ]
+ ]
+
+ "Created: 26.10.1996 / 12:06:54 / cg"
+ "Modified: 30.6.1997 / 17:46:46 / cg"
+! !
+
+!TextView methodsFor:'event handling'!
+
+buttonMotion:buttonState x:x y:y
+ "mouse-move while button was pressed - handle selection changes"
+
+ (clickLine isNil or:[clickPos isNil]) ifTrue:[
+ dragIsActive := false.
+ ^ self
+ ].
+
+ dragIsActive ifTrue:[
+ (clickPos dist:(x@y)) >= 5.0 ifTrue:[
+ dragIsActive := false.
+
+ self hasSelection ifTrue:[
+ dropSource startDragIn:self at:(x@y)
+ ]
+ ].
+ ^ self
+ ].
+
+ "is it the select or 1-button ?"
+ buttonState == 0 ifTrue:[^ self].
+ self sensor leftButtonPressed ifFalse:[
+ "/ self setPrimarySelection.
+ "/ self selectionChanged.
+ ^ self
+ ].
+"/ (device buttonMotionMask:buttonState includesButton:#select) ifFalse:[
+"/ (device buttonMotionMask:buttonState includesButton:1) ifFalse:[
+"/ ^ self
+"/ ].
+"/ ].
+
+ "if moved outside of view, start autoscroll"
+
+ ((y < 0) and:[firstLineShown ~~ 0]) ifTrue:[
+ self compressMotionEvents:false.
+ self startAutoScrollUp:y negated.
+ ^ self
+ ].
+ (y > height) ifTrue:[
+ self compressMotionEvents:false.
+ self startAutoScrollDown:(y - height).
+ ^ self
+ ].
+ ((x < 0) and:[viewOrigin x ~~ 0]) ifTrue:[
+ self compressMotionEvents:false.
+ self startAutoScrollLeft:x.
+ ^ self
+ ].
+ (x > width) ifTrue:[
+ self compressMotionEvents:false.
+ self startAutoScrollRight:(x - width).
+ ^ self
+ ].
+
+ "move inside - stop autoscroll if any"
+ autoScrollBlock notNil ifTrue:[
+ self stopScrollSelect
+ ].
+
+ self extendSelectionToX:x y:y setPrimarySelection:false.
+
+ "Modified: / 08-08-2010 / 11:20:54 / cg"
+!
+
+buttonMultiPress:button x:x y:y
+ "multi-mouse-click - select word under pointer"
+
+ (button == 1) ifTrue:[
+ clickPos := x @ y.
+
+ "/ The searchAction is mantained until a cut/replace or a search with a user selection is done
+"/ self clearSearchAction.
+
+ clickCount notNil ifTrue:[
+ clickCount := clickCount + 1.
+ (clickCount == 2) ifTrue:[
+ self doubleClickX:x y:y
+ ] ifFalse:[
+ (clickCount == 3) ifTrue:[
+ self tripleClickX:x y:y
+ ] ifFalse:[
+ (clickCount == 4) ifTrue:[
+ self quadClickX:x y:y
+ ]
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ super buttonMultiPress:button x:x y:y
+ ]
+
+ "Modified: 11.9.1997 / 04:15:35 / cg"
+!
+
+buttonPress:button x:x y:y
+ "mouse-click - prepare for selection change"
+
+ |sensor clickVisibleLine|
+
+ dragIsActive := false.
+ sensor := self sensor.
+
+ (button == 1) ifTrue:[
+ sensor shiftDown ifTrue:[
+ "mouse-click with shift - adding to selection"
+ self extendSelectionToX:x y:y.
+ ^ self
+ ].
+
+ clickVisibleLine := self visibleLineOfY:y.
+ clickPos := x @ y.
+ clickCol := self colOfX:x inVisibleLine:clickVisibleLine.
+ clickLine := self visibleLineToAbsoluteLine:clickVisibleLine.
+ clickStartLine := clickLine.
+ clickStartCol := clickCol.
+
+ (self canDrag
+ and:[(self isInSelection:clickLine col:clickCol)
+ and:[UserPreferences current startTextDragWithControl not
+ or:[sensor ctrlDown]]]) ifTrue:[
+ dragIsActive := true
+ ] ifFalse:[
+ self unselect.
+ ].
+ clickCount := 1
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+
+ "Modified: / 20.5.1999 / 17:02:45 / cg"
+!
+
+buttonRelease:button x:x y:y
+ "mouse- button release - turn off autoScroll if any"
+
+ (button == 1) ifTrue:[
+ self hasSelection ifTrue:[
+ self setPrimarySelection.
+ self selectionChanged.
+ ].
+
+ autoScrollBlock notNil ifTrue:[
+ self stopScrollSelect
+ ].
+ dragIsActive ifTrue:[
+ self unselect
+ ].
+ clickPos := nil.
+ ] ifFalse:[
+ super buttonRelease:button x:x y:y
+ ].
+ dragIsActive := false.
+
+ "/ clickPos := clickLine := clickCol := nil.
+
+ "Modified: / 20.5.1999 / 17:14:23 / cg"
+!
+
+doubleClickX:x y:y
+ "double-click - select word under pointer"
+
+ |sel ch scanCh matchCol scanCol fwdScan fwdSelect|
+
+ self selectWordAtX:x y:y.
+
+ "
+ special - if clicked on a parenthesis, select to matching
+ (must de before doing the ST80 stuff below)
+ "
+ ((sel := self selection) size == 1
+ and:[(sel := sel at:1) size == 1]) ifTrue:[
+ ch := sel at:1.
+
+ ((self isOpeningParenthesis:ch)
+ or:[ (self isClosingParenthesis:ch) ]) ifTrue:[
+ self
+ searchForMatchingParenthesisFromLine:selectionStartLine col:selectionStartCol
+ ifFound:[:line :col |
+ |prevLine prevCol moveBack pos1|
+
+ prevLine := firstLineShown.
+ prevCol := viewOrigin x.
+ self selectFromLine:selectionStartLine col:selectionStartCol
+ toLine:line col:col.
+
+ self sensor ctrlDown ifFalse:[
+ "/ undo scroll operation ...
+ self withCursor:Cursor eye do:[
+ |delayCount|
+
+ moveBack := false.
+ (self isClosingParenthesis:ch) ifTrue:[
+ (firstLineShown ~~ prevLine or:[prevCol ~~ viewOrigin x]) ifTrue:[
+ moveBack := true
+ ]
+ ] ifFalse:[
+ selectionEndLine > (firstLineShown + nFullLinesShown) ifTrue:[
+ self makeLineVisible:selectionEndLine.
+ moveBack := true
+ ]
+ ].
+ moveBack ifTrue:[
+ delayCount := 0.
+ pos1 := x@y.
+ self invalidateRepairNow:true.
+ Delay waitForSeconds:MatchDelayTime.
+ delayCount := delayCount + MatchDelayTime.
+ [self sensor hasUserEventFor:self] whileFalse:[
+ Delay waitForSeconds:MatchDelayTime / 2.
+ delayCount := delayCount + (MatchDelayTime / 2).
+ delayCount > 2 ifTrue:[
+ self cursor:Cursor eyeClosed.
+ ].
+ delayCount >= 2.3 ifTrue:[
+ self cursor:Cursor eye.
+ delayCount := 0.
+ ]
+ ].
+ self scrollToLine:prevLine; scrollToCol:prevCol.
+ ].
+ ]
+ ].
+ ^ self.
+ ]
+ ifNotFound:[self showNotFound]
+ onError:[self beep]
+ openingCharacters:((parenthesisSpecification at:#open) ", '([{'")
+ closingCharacters:((parenthesisSpecification at:#close) ", ')]}'").
+ selectStyle := nil
+ ]
+ ].
+
+ (self st80SelectMode or:[ self sensor ctrlDown]) ifTrue:[
+ "/ st80 selects:
+ "/ - if clicked right after a parenthesis -> select to matching parenthesis
+ "/ - if clicked right after a quote -> select to matching quote (unless escaped ;-)
+ "/ - if clicked at beginning of the line -> select that line
+ "/ - if clicked at the top of the text -> select all
+ "/ however, do none of the above, if clicked on a parenthesis
+ clickCol == 1 ifTrue:[
+ clickLine == 1 ifTrue:[
+ self selectAll.
+ ^ self.
+ ].
+ self selectLineAtY:y.
+ selectStyle := #line.
+ ^ self
+ ].
+
+ matchCol := nil.
+ "/ see what is to the left of that character ...
+ clickCol > 1 ifTrue:[
+ ch := self characterAtLine:clickLine col:clickCol-1.
+ (self isOpeningParenthesis:ch) ifTrue:[
+ matchCol := clickCol - 1
+ ] ifFalse:[
+ ('"''|' includes:ch) ifTrue:[
+ scanCol := clickCol - 1.
+ fwdScan := true.
+ scanCh := ch.
+ ]
+ ]
+ ].
+ fwdSelect := true.
+ (matchCol isNil and:[scanCol isNil]) ifTrue:[
+ clickCol < (self listAt:clickLine) size ifTrue:[
+ ch := self characterAtLine:clickLine col:clickCol+1.
+ (self isClosingParenthesis:ch) ifTrue:[
+ matchCol := clickCol + 1.
+ fwdSelect := false.
+ ] ifFalse:[
+ ('"''|' includes:ch) ifTrue:[
+ scanCol := clickCol + 1.
+ fwdScan := false.
+ scanCh := ch.
+ ]
+ ]
+ ].
+ ].
+ matchCol notNil ifTrue:[
+ self
+ searchForMatchingParenthesisFromLine:clickLine col:matchCol
+ ifFound:[:line :col |
+ self selectFromLine:clickLine col:matchCol+(fwdSelect ifTrue:1 ifFalse:-1)
+ toLine:line col:col-(fwdSelect ifTrue:1 ifFalse:-1)]
+ ifNotFound:[self showNotFound]
+ onError:[self beep]
+ openingCharacters:((parenthesisSpecification at:#open) , '([{')
+ closingCharacters:((parenthesisSpecification at:#close) , ')]}').
+ ^ self
+ ].
+ scanCol notNil ifTrue:[
+ "/ if its an EOL comment, do it differently
+ ch := self characterAtLine:clickLine col:clickCol.
+ ch == $/ ifTrue:[
+ self selectFromLine:clickLine col:clickCol+1 toLine:clickLine+1 col:0.
+ ^ self
+ ].
+
+ self
+ scanFor:scanCh fromLine:clickLine col:scanCol forward:fwdScan
+ ifFound:[:line :col |
+ |selStart selEnd|
+
+ fwdScan ifTrue:[
+ selStart := scanCol+1.
+ selEnd := col-1.
+ ] ifFalse:[
+ selStart := scanCol-1.
+ selEnd := col+1.
+ ].
+ self selectFromLine:clickLine col:selStart
+ toLine:line col:selEnd.
+ ^ self
+ ]
+ ifNotFound:[self showNotFound].
+ ^ self
+ ]
+ ].
+
+ "
+ 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
+ ]
+
+ "Created: / 11-09-1997 / 04:12:55 / cg"
+ "Modified: / 14-06-2011 / 14:04:59 / cg"
+!
+
+extendSelectionToX:x y:y
+ "mouse-move while button was pressed - handle selection changes"
+
+ self extendSelectionToX:x y:y setPrimarySelection:true
+!
+
+extendSelectionToX:x y:y setPrimarySelection:aBoolean
+ "mouse-move while button was pressed - handle selection changes"
+
+ |movedVisibleLine movedLine movedCol
+ movedUp
+ oldStartLine oldEndLine oldStartCol oldEndCol|
+
+ movedVisibleLine := self visibleLineOfY:y.
+ movedLine := self visibleLineToAbsoluteLine:movedVisibleLine.
+
+ (x < leftMargin) ifTrue:[
+ movedCol := 0
+ ] ifFalse:[
+ movedCol := self colOfX:x inVisibleLine:movedVisibleLine
+ ].
+ y < 0 ifTrue:[
+ movedCol := 0
+ ].
+ ((movedLine == clickLine) and:[movedCol == clickCol]) ifTrue:[
+ selectionStartLine notNil ifTrue:[
+ ^ self
+ ].
+ (clickPos isNil
+ or:[(clickPos x - x) abs < 3
+ and:[(clickPos y - y) abs < 3]]) ifTrue:[
+ ^ self
+ ].
+ selectionStartLine := clickLine.
+ selectionStartCol := clickCol.
+ selectionEndLine := selectionStartLine.
+ selectionEndCol := selectionStartCol.
+
+ oldStartLine := selectionStartLine.
+ oldEndLine := selectionEndLine.
+ oldStartCol := selectionStartCol.
+ oldEndCol := selectionEndCol-1.
+ ] ifFalse:[
+ selectionStartLine isNil ifTrue:[
+ selectionStartLine := selectionEndLine := clickLine.
+ selectionStartCol := selectionEndCol := clickCol.
+ ].
+ oldStartLine := selectionStartLine.
+ oldEndLine := selectionEndLine.
+ oldStartCol := selectionStartCol.
+ oldEndCol := selectionEndCol.
+ ].
+ oldEndLine isNil ifTrue:[
+ oldEndLine := selectionEndLine ? clickLine ? movedLine.
+ ].
+ oldEndCol isNil ifTrue:[
+ oldEndCol := selectionEndCol ? clickCol.
+ ].
+
+ "find out if we are before or after initial click"
+ movedUp := false.
+ clickStartLine isNil ifTrue:[
+ clickStartLine := movedLine.
+ ].
+ clickStartCol isNil ifTrue:[
+ clickStartCol := movedCol.
+ ].
+
+ (movedLine < clickStartLine) ifTrue:[
+ movedUp := true
+ ] ifFalse:[
+ (movedLine == clickStartLine) ifTrue:[
+ (movedCol < clickStartCol) ifTrue:[
+ movedUp := true
+ ]
+ ]
+ ].
+
+ movedUp ifTrue:[
+ "change selectionStart"
+ selectionStartCol := movedCol.
+ selectionStartLine := movedLine.
+ selectionEndCol := clickStartCol.
+ selectionEndLine := clickStartLine.
+ selectStyle notNil ifTrue:[
+ selectionEndCol := wordEndCol.
+ selectionEndLine := wordEndLine.
+ ]
+ ] ifFalse:[
+ "change selectionEnd"
+ selectionEndCol := movedCol.
+ selectionEndLine := movedLine.
+ selectionStartCol := clickStartCol.
+ selectionStartLine := clickStartLine.
+ selectStyle notNil ifTrue:[
+ selectionStartCol := wordStartCol.
+ selectionStartLine := wordStartLine.
+ ]
+ ].
+
+ selectionStartLine isNil ifTrue:[^ self].
+
+ (selectionStartCol == 0) ifTrue:[
+ selectionStartCol := 1
+ ].
+
+ "
+ if in word-select, just catch the rest of the word
+ "
+ (selectStyle notNil and:[selectStyle startsWith:'word']) ifTrue:[
+ movedUp ifTrue:[
+ selectionStartCol := self findBeginOfWordAtLine:selectionStartLine col:selectionStartCol
+ ] ifFalse:[
+ selectionEndCol := self findEndOfWordAtLine:selectionEndLine col:selectionEndCol.
+ selectionEndCol == 0 ifTrue:[
+ selectionEndLine := selectionEndLine + 1
+ ]
+ ].
+ ].
+
+ selectStyle == #line ifTrue:[
+ movedUp ifTrue:[
+ selectionStartCol := 1.
+ ] ifFalse:[
+ selectionEndCol := 0.
+ selectionEndLine := selectionEndLine + 1
+ ]
+ ].
+
+ self validateNewSelection.
+ aBoolean ifTrue:[
+ self setPrimarySelection.
+ self selectionChanged.
+ ].
+
+ "/ The searchAction is mantained until a cut/replace or a search with a user selection is done
+"/ self clearSearchAction.
+
+ (oldStartLine == selectionStartLine) ifTrue:[
+ (oldStartCol ~~ selectionStartCol) ifTrue:[
+ self
+ redrawLine:oldStartLine
+ from:((selectionStartCol min:oldStartCol) max:1)
+ to:((selectionStartCol max:oldStartCol) max:1)
+ ]
+ ] ifFalse:[
+ self
+ redrawFromLine:(oldStartLine?selectionStartLine min:selectionStartLine)
+ to:(oldStartLine?selectionStartLine max:selectionStartLine)
+ ].
+
+ (oldEndLine == selectionEndLine) ifTrue:[
+ (oldEndCol notNil and:[oldEndCol ~~ selectionEndCol]) ifTrue:[
+ self redrawLine:oldEndLine
+ from:((selectionEndCol min:oldEndCol) max:1)
+ to:((selectionEndCol max:oldEndCol) max:1)
+ ]
+ ] ifFalse:[
+ selectionEndLine isNil ifTrue:[
+ selectionStartLine := nil.
+ self redraw.
+ ] ifFalse:[
+ (selectionStartLine notNil) ifTrue:[
+ self redrawFromLine:(oldEndLine min:selectionEndLine)
+ to:(oldEndLine max:selectionEndLine)
+ ]
+ ]
+ ].
+ clickLine := movedLine.
+ clickCol := movedCol
+
+ "Modified: / 05-04-2011 / 17:13:35 / cg"
+ "Modified: / 17-04-2012 / 21:00:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+keyPress:key x:x y:y
+ "handle some keyboard input (there is not much to be done here)"
+
+ <resource: #keyboard (#Find #Copy #FindNext #FindPrev #FindAgain
+ #GotoLine #SelectAll #SaveAs #Print
+ #'F*' #'f*' #ZoomIn #ZoomOut)>
+
+ (key == #Find) ifTrue:[self search. ^self].
+ (key == #Copy) ifTrue:[self copySelection. ^self].
+ (key == #GotoLine) ifTrue:[self gotoLine. ^self].
+
+ (key == #FindNext) ifTrue:[self searchFwd. ^self].
+ (key == #FindPrev) ifTrue:[self searchBwd. ^self].
+ (key == #FindAgain) ifTrue:[self searchAgainInSameDirection. ^self].
+
+ (key == #SelectAll) ifTrue:[self selectAll. ^self].
+
+ (key == #SaveAs) ifTrue:[self save. ^self].
+ (key == #Print) ifTrue:[self doPrint. ^self].
+
+ (key == #ZoomIn or:[key == #ZoomOut]) ifTrue:[ self fontLargerOrSmaller:(key == #ZoomIn) ].
+
+ "
+ 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)
+ "
+ (key size > 1 and:[(key at:1) asLowercase == $f]) ifTrue:[
+ (('[fF][0-9]' match:key)
+ or:['[fF][0-9][0-9]' match:key]) ifTrue:[
+ self sensor shiftDown ifTrue:[
+ UserPreferences current functionKeySequences
+ at:key put:(self selection)
+ ].
+ ^ self
+ ].
+ ].
+
+ super keyPress:key x:x y:y
+
+ "Modified: / 18-04-1997 / 12:12:27 / stefan"
+ "Modified: / 10-03-2012 / 09:40:01 / cg"
+!
+
+mapped
+ super mapped.
+ selectionFgColor := selectionFgColor onDevice:self graphicsDevice.
+ selectionBgColor := selectionBgColor onDevice:self graphicsDevice.
+!
+
+quadClickX:x y:y
+ "quadrupleClick-click - select all"
+
+ self selectAll
+
+ "Created: / 11.9.1997 / 04:15:24 / cg"
+ "Modified: / 31.3.1998 / 14:21:13 / cg"
+!
+
+tripleClickX:x y:y
+ "triple-click - select line under pointer"
+
+ self selectLineAtY:y.
+ selectStyle := #line
+
+ "Created: 11.9.1997 / 04:13:37 / cg"
+! !
+
+!TextView methodsFor:'initialization & release'!
+
+fetchDeviceResources
+ "fetch device colors, to avoid reallocation at redraw time"
+
+ super fetchDeviceResources.
+
+ selectionFgColor notNil ifTrue:[selectionFgColor := selectionFgColor onDevice:self graphicsDevice].
+ selectionBgColor notNil ifTrue:[selectionBgColor := selectionBgColor onDevice:self graphicsDevice].
+
+ "Created: 14.1.1997 / 00:14:33 / cg"
+!
+
+initStyle
+ "setup viewStyle specifics"
+
+ super initStyle.
+
+ viewBackground := DefaultViewBackground.
+ selectionFgColor := DefaultSelectionForegroundColor.
+ selectionFgColor isNil ifTrue:[selectionFgColor := bgColor].
+ selectionBgColor := DefaultSelectionBackgroundColor.
+ selectionBgColor isNil ifTrue:[
+ self graphicsDevice hasColors ifTrue:[
+ DefaultSelectionForegroundColor isNil ifTrue:[
+ selectionFgColor := fgColor
+ ].
+ selectionBgColor := Color green
+ ] ifFalse:[
+ self graphicsDevice hasGrayscales ifTrue:[
+ DefaultSelectionForegroundColor isNil ifTrue:[
+ selectionFgColor := fgColor
+ ].
+ selectionBgColor := Color grey
+ ] ifFalse:[
+ selectionBgColor := fgColor
+ ]
+ ]
+ ].
+
+ "Modified: / 22-01-1997 / 11:57:53 / cg"
+ "Modified (comment): / 05-10-2011 / 15:50:45 / az"
+!
+
+initialize
+ super initialize.
+ self initializeSaveAction.
+ contentsWasSaved := false.
+ dragIsActive := false.
+ lastSearchWasMatch := lastSearchWasVariableSearch := false.
+ lastSearchIgnoredCase := true.
+
+ parenthesisSpecification isNil ifTrue:[
+ parenthesisSpecification := DefaultParenthesisSpecification.
+ ].
+
+ "I handle menus myself"
+ menuHolder := menuPerformer := self.
+
+ "/ on default allow drag
+ self allowDrag:true.
+!
+
+initializeSaveAction
+ saveAction := [ self openSaveDialog ]
+! !
+
+!TextView methodsFor:'menu & menu actions'!
+
+appendTo:aFileName
+ "append contents to a file named fileName"
+
+ |aStream msg filename|
+
+ filename := aFileName asFilename.
+
+ (FileStream userInitiatedFileSaveQuerySignal queryWith:filename) ifFalse:[
+ msg := resources string:'Refused to append to file ''%1'' !!' with:filename name.
+ self warn:(msg , '\\(ST/X internal permission check)' ) withCRs.
+ ^ self
+ ].
+
+ [
+ aStream := filename appendingWriteStream.
+ [
+ self fileOutContentsOn:aStream compressTabs:true encoding:externalEncoding.
+ ] ensure:[
+ aStream close.
+ ].
+ contentsWasSaved := true
+ ] on:FileStream openErrorSignal do:[:ex|
+ msg := resources string:'cannot append to file %1 !!' with:filename name.
+ self warn:(msg , '\\(' , FileStream lastErrorString , ')' ) withCRs
+ ]
+
+ "Modified: / 27-07-2012 / 09:41:18 / cg"
+!
+
+changeFont
+ "pop up a fontPanel to change font"
+
+ |newFont|
+
+ self withWaitCursorDo:[
+ newFont := FontPanel fontFromUserInitial:gc font.
+ ].
+ newFont notNil ifTrue:[
+ self font:newFont.
+ ]
+
+ "Modified: 27.2.1996 / 00:53:51 / cg"
+!
+
+copySelection
+ "copy contents into smalltalk copybuffer"
+
+ |text|
+
+ text := self selection.
+ text notNil ifTrue:[
+ self unselect.
+
+ "/ forget any emphasis ...
+ text := text collect:[:l | l isNil ifTrue:[l] ifFalse:[l string]].
+ self setClipboardText:text.
+ ]
+
+ "Modified: 17.5.1996 / 08:57:54 / cg"
+!
+
+defaultForGotoLine
+ "return a default value to show in the gotoLine box"
+
+ ^ selectionStartLine
+
+ "Modified: 1.3.1996 / 18:44:36 / cg"
+!
+
+doPrint
+ "print the contents on the printer"
+
+ |printStream|
+
+ list isNil ifTrue:[^ self].
+
+ self withWaitCursorDo:[
+ printStream := Printer new.
+ printStream supportsContext ifTrue:[
+ printStream printerContext font:(self font).
+ ].
+
+ Printer writeErrorSignal handle:[:ex |
+ self warn:('error while printing:\\'
+ , ex description
+ , '\\(printing with: ' , (Printer printCommand) , ')') withCRs
+ ] do:[
+ self fileOutContentsOn:printStream.
+ ].
+ printStream close
+ ].
+
+ "Created: / 06-05-1996 / 16:11:26 / cg"
+ "Modified: / 31-01-2012 / 18:16:39 / cg"
+!
+
+editMenu
+ "return my popUpMenu"
+
+ <resource: #keyboard (#Copy #Find #GotoLine #SaveAs #Print)>
+ <resource: #programMenu>
+
+ |items m|
+
+ items := #(
+ ('Copy' copySelection Copy)
+ ('-' nil )
+ ('Search...' search Find)
+ ('Goto Line...' gotoLine GotoLine)
+ ('-' nil )
+ ('Font...' changeFont )
+ ('-' nil )
+ ('Save As...' save SaveAs)
+ ('Print' doPrint Print)
+ ).
+
+ m := PopUpMenu itemList:items resources:resources.
+
+ self hasSelectionForCopy ifFalse:[
+ m disable:#copySelection.
+ ].
+ ^ m
+
+ "Modified: / 12.11.2001 / 13:43:56 / cg"
+!
+
+find
+ "same as search - for VW compatibility"
+
+ self search
+
+ "Created: 31.7.1997 / 19:13:58 / cg"
+!
+
+fontLargerOrSmaller:largerBoolean
+ |newFont|
+
+ newFont := gc font asSize:(largerBoolean
+ ifTrue:[gc font size + 1]
+ ifFalse:[(gc font size-1) max:4]).
+ self font:newFont.
+
+ "Modified: / 27-02-1996 / 00:53:51 / cg"
+ "Created: / 10-03-2012 / 09:38:32 / cg"
+!
+
+gotoLine
+ "show a box to enter lineNumber for positioning;
+ The entered number may be prefixed by a + or -;
+ in this case, the linenumber is taken relative to the current position."
+
+ |l lineNumberBox input lineToGo relative|
+
+ lineNumberBox :=
+ EnterBox
+ title:(resources string:'Line number (or +/- relativeNr):')
+ okText:(resources string:'Goto')
+ abortText:(resources string:'Cancel')
+ action:[:l | input := l].
+
+ l := self defaultForGotoLine.
+ l notNil ifTrue:[
+ l := l printString
+ ].
+ lineNumberBox initialText:l .
+ lineNumberBox label:(resources string:'Goto Line').
+ lineNumberBox showAtPointer.
+
+ input size > 0 ifTrue:[
+ input := input withoutSpaces.
+ input size > 0 ifTrue:[
+ (input startsWith:$+) ifTrue:[
+ relative := 1.
+ ] ifFalse:[
+ (input startsWith:$-) ifTrue:[
+ relative := -1.
+ ].
+ ].
+ relative notNil ifTrue:[
+ input := input copyFrom:2.
+ ].
+ lineToGo := Integer readFromString:input onError:nil.
+ lineToGo notNil ifTrue:[
+ relative notNil ifTrue:[
+ lineToGo := self currentLine + (lineToGo * relative)
+ ].
+ self gotoLine:lineToGo
+ ]
+ ]
+ ].
+
+ "Modified: / 17.5.1998 / 20:07:59 / cg"
+!
+
+openSaveDialog
+ "Ask user for filename using a fileSelectionBox
+ and save contents into that file."
+
+ Dialog
+ requestSaveFileName:(resources string:'Save contents in:')
+ default:defaultFileNameForFileDialog
+ fromDirectory:directoryForFileDialog
+ action:[:fileName | self saveAs:fileName]
+ appendAction:[:fileName | self appendTo:fileName]
+!
+
+openSearchBoxAndSearch
+ "search for a string - show a box to enter searchpattern
+ - currently no regular expressions are handled."
+
+ "
+ Q: is it a good idea to preserve the last searchstring between views?
+ cg: yes - turns out to be useful and less confusing than keeping last per view
+ "
+ |searchBox patternHolder caseHolder matchHolder fwd ign match initialString
+ bindings bldr doSearch modal searchVariableHolder selectedVariable searchFullWordHolder
+ replaceBooleanEnabledHolder replaceBooleanHolder replaceTextHolder|
+
+ searchBarActionBlock notNil ifTrue:[
+ self resetVariablesBeforeNewSearch.
+ searchBarActionBlock value:#search value:self.
+ ^ self
+ ].
+
+ modal := (UserPreferences current searchDialogIsModal). "/ thats experimental
+
+ ign := lastSearchIgnoredCase "? LastSearchIgnoredCase " ? true.
+ caseHolder := ign not asValue.
+
+ match := lastSearchWasMatch ? LastSearchWasMatch ? false.
+ matchHolder := match asValue.
+ searchVariableHolder := (lastSearchWasVariableSearch ? false) asValue.
+ searchFullWordHolder := false asValue.
+ replaceBooleanHolder := false asValue.
+ replaceTextHolder := '' asValue.
+ replaceBooleanEnabledHolder := self isReadOnly not asValue.
+
+ patternHolder := '' asValue.
+
+ self setSearchPatternWithMatchEscapes: match.
+
+ lastSearchPattern notNil ifTrue:[
+ initialString := lastSearchPattern.
+ ].
+"/ No longer force the current selection to be the initialString
+"/ self hasSelectionWithinSingleLine ifTrue:[
+"/ initialString := self selection asString.
+"/ ].
+ initialString isNil ifTrue:[
+ LastSearchPatterns size > 0 ifTrue:[
+ initialString := LastSearchPatterns first.
+ ]
+ ].
+
+ initialString notNil ifTrue:[
+ patternHolder value:initialString.
+ ].
+
+ fwd := true.
+
+ doSearch := [:fwd |
+ |isVariableSearch pattern searchAction|
+
+ self resetVariablesBeforeNewSearch.
+
+ isVariableSearch := self searchVariableVisible
+ and:[searchVariableHolder value
+ and:[selectedVariable notNil]].
+
+ isVariableSearch ifTrue:[
+ searchAction := [self searchVariableWithSyntaxElement:selectedVariable forward:fwd].
+ ] ifFalse:[
+ lastSearchWasVariableSearch := false.
+ LastSearchIgnoredCase := lastSearchIgnoredCase := (caseHolder value not).
+ LastSearchWasMatch := lastSearchWasMatch := matchHolder value.
+ pattern := patternHolder value.
+ pattern notEmptyOrNil ifTrue:[
+ searchAction := [
+ self searchUsingSpec:(
+ ListView::SearchSpec new
+ pattern:pattern
+ ignoreCase:lastSearchIgnoredCase
+ match: lastSearchWasMatch
+ variable: searchVariableHolder value
+ fullWord: searchFullWordHolder value
+ forward:fwd).
+ ]
+ ]
+ ].
+
+ replaceBooleanHolder value ifTrue:[
+ |selStart|
+
+ isVariableSearch ifTrue:[
+ "/ must replace from the end towards beginning,
+ "/ because syntax-elements do not update their position, when
+ "/ the text is changed (in replace).
+
+ selectedVariable := selectedVariable lastElementInChain.
+ self selectFromCharacterPosition:selectedVariable start to:selectedVariable stop.
+ searchAction := [selectedVariable := selectedVariable previousElement.
+ selectedVariable notNil ifTrue:[
+ self selectFromCharacterPosition:selectedVariable start to:selectedVariable stop.
+ ].
+ "/ self searchVariableWithSyntaxElement:selectedVariable forward:false
+ ].
+ ].
+
+ selStart := self characterPositionOfSelection.
+ self replace:(replaceTextHolder value).
+
+ searchAction value.
+ [self characterPositionOfSelection ~= selStart] whileTrue:[
+ selStart := self characterPositionOfSelection.
+ self replace:(replaceTextHolder value).
+ searchAction value.
+ ]
+ ] ifFalse:[
+ searchAction value.
+ ].
+ ].
+
+ bindings := IdentityDictionary new.
+ bindings at:#searchPattern put:patternHolder.
+ modal ifTrue:[
+ bindings at:#nextAction put:[searchBox doAccept.].
+ bindings at:#prevAction put:[fwd := false. searchBox doAccept.].
+ ] ifFalse:[
+ bindings at:#nextAction put:[doSearch value:true. "searchBox doAccept."].
+ bindings at:#prevAction put:[doSearch value:false. "fwd := false. searchBox doAccept."].
+ ].
+ bindings at:#caseSensitive put:caseHolder.
+ bindings at:#match put:matchHolder.
+ bindings at:#patternList put:LastSearchPatterns.
+
+ self supportsSyntaxElements ifFalse:[
+ bindings at:#searchVariableVisible put:false.
+ ] ifTrue:[
+ bindings at:#searchVariableVisible put:true.
+ selectedVariable := self syntaxElementForSelectedVariable.
+ bindings at:#searchVariableEnabled put:(selectedVariable notNil).
+ selectedVariable notNil ifTrue:[
+ bindings
+ at:#stringWithVariableUnderCursorHolder
+ put:('Variable ("%1")' bindWith:selectedVariable value).
+ searchVariableHolder value:true.
+ ] ifFalse:[
+ bindings
+ at:#stringWithVariableUnderCursorHolder
+ put:('Variable (none selected)').
+ ].
+ ].
+ bindings at:#searchVariable put:searchVariableHolder.
+
+ bindings at:#searchFullWord put:searchFullWordHolder.
+ bindings at:#searchFullWordEnabled put:true.
+
+ bindings at:#replaceEnabled put:replaceBooleanEnabledHolder.
+ bindings at:#replaceBoolean put:replaceBooleanHolder.
+ bindings at:#replaceTextHolder put:replaceTextHolder.
+ replaceBooleanHolder onChangeEvaluate:
+ [
+ replaceBooleanHolder value ifTrue:[
+ (bldr componentAt:#ReplaceEntryField) requestFocus
+ ] ifFalse:[
+ (bldr componentAt:#patternComboBox) requestFocus
+ ].
+ ].
+ modal ifTrue:[
+ searchBox := SimpleDialog new.
+ ] ifFalse:[
+ searchBox := ApplicationModel new.
+ searchBox createBuilder.
+ ].
+ searchBox resources:(self resources).
+
+ bldr := searchBox builder.
+ bldr addBindings:bindings.
+ bldr aspectAt:#flyByHelpSpec put:(self class flyByHelpSpec).
+ searchBox allButOpenFrom:(self class searchDialogSpec).
+
+ (bldr componentAt:#nextButton) cursor:(Cursor thumbsUp).
+ (bldr componentAt:#prevButton) cursor:(Cursor thumbsUp).
+ (bldr componentAt:#cancelButton) cursor:(Cursor thumbsDown).
+
+ modal ifTrue:[
+ searchBox openDialog.
+ searchBox accepted ifTrue:[ doSearch value:fwd ].
+ ] ifFalse:[
+ (bldr componentAt:#nextButton) isReturnButton:false.
+ (bldr componentAt:#cancelButton)
+ label:(resources string:'Close');
+ action:[searchBox closeRequest].
+ "/ searchBox masterApplication:self application.
+ self topView beMaster.
+ searchBox window
+ beSlave;
+ openInGroup:(self windowGroup).
+
+ "/ searchBox window open.
+ searchBox window assignKeyboardFocusToFirstInputField.
+ ]
+
+ "Modified: / 11-07-2006 / 11:18:38 / fm"
+ "Created: / 08-03-2012 / 14:02:59 / cg"
+!
+
+save
+ "save contents into a file
+ - ask user for filename using a fileSelectionBox."
+
+ saveAction value
+!
+
+saveAs:fileName
+ "save the contents into a file named fileName"
+
+ ^ self saveAs:fileName doAppend:false
+!
+
+saveAs:aFilename doAppend:doAppend
+ "save the contents into a file named fileName;
+ if doAppend is true, the views contents is appended to the existing
+ contents - otherwise, it overwrites any previous file contents.
+ on error return false otherwise return true"
+
+ ^ self saveAs:aFilename doAppend:doAppend compressTabs:true
+!
+
+saveAs:aFilename doAppend:doAppend compressTabs:compressTabs
+ "save the contents into a file named fileName;
+ if doAppend is true, the views contents is appended to the existing
+ contents - otherwise, it overwrites any previous file contents.
+ on error return false otherwise return true"
+
+ |filename msg|
+
+ filename := aFilename asFilename.
+
+ self withWriteCursorDo:[
+ |aStream|
+
+ (FileStream userInitiatedFileSaveQuerySignal queryWith:filename) ifFalse:[
+ msg := resources
+ stringWithCRs:'Refused to write file ''%1'' !!\(ST/X internal permission check)'
+ with:filename name.
+ ] ifTrue:[
+ [
+ doAppend ifTrue:[
+ aStream := filename appendingWriteStream.
+ ] ifFalse:[
+ aStream := filename newReadWriteStream.
+ ].
+ self fileOutContentsOn:aStream compressTabs:compressTabs encoding:externalEncoding.
+ aStream syncData; close.
+ contentsWasSaved := true.
+ defaultFileNameForFileDialog := filename.
+ ] on:FileStream openErrorSignal do:[:ex|
+ msg := resources stringWithCRs:'Cannot write file ''%1'' !!\(%2)'
+ with:filename name
+ with:FileStream lastErrorString.
+ ].
+ ].
+ ].
+
+ msg notNil ifTrue:[
+ Dialog warn:msg.
+ ^ false
+ ].
+ ^ true
+
+ "Modified: / 27-07-2012 / 09:45:13 / cg"
+!
+
+search
+ "search for a string - show a box to enter searchpattern
+ - currently no regular expressions are handled."
+
+ self openSearchBoxAndSearch
+
+ "Modified: / 11-07-2006 / 11:18:38 / fm"
+ "Modified: / 08-03-2012 / 14:03:10 / cg"
+!
+
+search:patternArg ignoreCase:ign forward:fwd
+ "search for a string without matching"
+
+ self search:patternArg ignoreCase:ign match: false forward:fwd
+!
+
+search:patternArg ignoreCase:ign match: match forward:fwd
+ |pattern|
+
+ pattern := patternArg string.
+ pattern notEmpty ifTrue:[
+ self rememberSearchPattern:pattern.
+ "/ LastSearchIgnoredCase := lastSearchIgnoredCase := ign.
+ "/ LastSearchWasMatch := match.
+ fwd ifFalse:[
+ lastSearchDirection := #backward.
+ self searchBwd:pattern ignoreCase:ign match: match. " backward search with match is not yet available "
+ ] ifTrue:[
+ lastSearchDirection := #forward.
+ self searchFwd:pattern ignoreCase:ign match: match.
+ ]
+ ]
+
+ "Created: / 11-07-2006 / 11:18:04 / fm"
+ "Modified: / 23-03-2012 / 12:12:07 / cg"
+!
+
+searchUsingSpec:aSearchSpec
+ self rememberSearchPattern:(aSearchSpec pattern).
+ "/ LastSearchIgnoredCase := lastSearchIgnoredCase := ign.
+ "/ LastSearchWasMatch := match.
+ aSearchSpec forward ifFalse:[
+ lastSearchDirection := #backward.
+ self searchBwdUsingSpec:aSearchSpec
+ ] ifTrue:[
+ lastSearchDirection := #forward.
+ self searchFwdUsingSpec:aSearchSpec
+ ]
+
+ "Created: / 11-07-2006 / 11:18:04 / fm"
+ "Modified: / 23-03-2012 / 12:12:07 / cg"
+!
+
+searchVariableVisible
+ "search variable option in searchbox visible?
+ (only true for codeview2's textview)"
+
+ ^ false
+
+ "Created: / 08-03-2012 / 14:01:24 / cg"
+!
+
+searchVariableWithSyntaxElement:syntaxElementForVariable forward:fwd
+ "this only works for CodeView2::TextView, which supports syntaxElements.
+ Finds the next occurrence of a syntax element (typically, a variable)"
+
+ |el el2|
+
+ lastSearchWasVariableSearch := true.
+ el := fwd
+ ifTrue:[syntaxElementForVariable nextElement]
+ ifFalse:[syntaxElementForVariable previousElement].
+
+ el notNil ifTrue:[
+ "bug workaround"
+ (el start = syntaxElementForVariable start) ifTrue:[
+ el2 := fwd
+ ifTrue:[el nextElement]
+ ifFalse:[el previousElement].
+ el2 notNil ifTrue:[
+ el := el2
+ ]
+ ].
+ ].
+ el notNil ifTrue:[
+ self selectFromCharacterPosition:el start to:el stop.
+ self makeLineVisible:(self lineOfCharacterPosition:el start).
+ ] ifFalse:[
+ self showNotFound
+ ].
+
+ "Created: / 08-03-2012 / 14:08:20 / cg"
+!
+
+syntaxElementForSelectedVariable
+ "for a better search; ignored here, but redefined in CodeView2"
+
+ ^ nil
+
+ "Created: / 08-03-2012 / 14:20:27 / cg"
+!
+
+syntaxElementForVariableUnderCursor
+ "for a better search; ignored here, but redefined in CodeView2"
+
+ ^ nil
+
+ "Created: / 08-03-2012 / 12:45:26 / cg"
+! !
+
+!TextView methodsFor:'private'!
+
+currentSelectionBgColor
+ ^ selectionBgColor
+!
+
+currentSelectionFgColor
+ ^ selectionFgColor
+!
+
+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."
+
+ self
+ fileOutContentsOn:aStream
+ compressTabs:compressTabs
+ encoding:nil
+!
+
+fileOutContentsOn:aStream compressTabs:compressTabs encoding:encodingSymOrNil
+ "save contents on a stream. If compressTabs is true,
+ leading spaces will be replaced by tab-characters in the output."
+
+ |startNr nLines string encoder|
+
+ self removeTrailingWhitespace.
+
+ encoder := CharacterEncoder encoderToEncodeFrom:gc characterEncoding into:encodingSymOrNil.
+ encoder isNullEncoder ifTrue:[
+ (list contains:[:lineOrNil|
+ |s|
+ lineOrNil notNil
+ and:[(s := lineOrNil string string) isWideString
+ and:[s asSingleByteStringIfPossible isWideString]]
+ ]
+ ) ifTrue:[
+ (Dialog confirm:'The text contains non-8bit characters. Encode as UTF8?') ifFalse:[
+ ^ self
+ ]
+ ].
+ encoder := CharacterEncoder encoderToEncodeFrom:#unicode into:#utf8
+ ].
+
+ aStream isFileStream ifTrue:[
+ "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:(encoder encodeString:string string).
+ startNr := startNr + 1000 + 1.
+ ].
+ ] ifFalse:[
+ list do:[:aLine |
+ aLine notNil ifTrue:[
+ aStream nextPutLine:(encoder encodeString:aLine).
+ ] ifFalse:[
+ aStream cr.
+ ]
+ ]
+ ]
+
+ "Modified: 8.6.1996 / 11:50:46 / cg"
+!
+
+getFontParameters
+ "get some info of the used font. They are cached since we use them often ..
+ This is redefined here, to use the font's maxHeight/maxAscent for
+ line separation. This is required, to allow for proper handling of
+ national characters, such as A-diaresis ..."
+
+ |italicFont boldFont fA iA bA currentDeviceFont|
+
+ currentDeviceFont := gc createFontOnDevice.
+ italicFont := currentDeviceFont asItalic onDevice:gc device.
+ boldFont := currentDeviceFont asBold onDevice:gc device.
+
+ fontHeight := currentDeviceFont height max:(italicFont height max:(boldFont height)).
+ includesNonStrings == true ifTrue:[
+ "/ for now, we do not support variable height entries ...
+ fontHeight := fontHeight max:(list first heightOn:self).
+ ].
+ fontHeight := fontHeight + lineSpacing.
+ fA := currentDeviceFont ascent.
+ "/ fA := font maxAscent.
+ iA := italicFont ascent.
+ "/ iA := italicFont maxAscent.
+ bA := boldFont ascent.
+ "/ bA := boldFont maxAscent.
+ fontAscent := fA max:(iA max:bA).
+ fontWidth := currentDeviceFont width.
+ fontIsFixedWidth := currentDeviceFont isFixedWidth and:[ italicFont isFixedWidth and:[ boldFont isFixedWidth ]].
+
+ "Modified: 22.5.1996 / 12:02:47 / cg"
+ "Created: 22.5.1996 / 12:18:34 / cg"
+!
+
+isClosingParenthesis:ch
+ ((parenthesisSpecification at:#close) includes:ch) ifTrue:[^ true].
+ ^ ')]}' includes:ch
+
+ "Modified: / 12-02-2012 / 08:37:01 / cg"
+!
+
+isOpeningParenthesis:ch
+ ((parenthesisSpecification at:#open) includes:ch) ifTrue:[^ true].
+ ^ '([{' includes:ch
+
+ "Modified: / 12-02-2012 / 08:37:11 / cg"
+!
+
+rememberSearchPattern:pattern
+ |nRemembered patternString|
+
+ self clearSearchAction.
+
+ patternString := pattern string.
+
+ nRemembered := NumRememberedSearchPatterns ? 20.
+
+ LastSearchPatterns isNil ifTrue:[
+ LastSearchPatterns := OrderedCollection new.
+ ].
+ "/ move to top or addFirst
+ (LastSearchPatterns includes:patternString) ifTrue:[
+ LastSearchPatterns remove:patternString.
+ ] ifFalse:[
+ LastSearchPatterns size > nRemembered ifTrue:[
+ LastSearchPatterns removeLast
+ ]
+ ].
+ LastSearchPatterns addFirst:patternString.
+
+ "Modified: / 23-03-2012 / 13:59:09 / cg"
+!
+
+removeTrailingWhitespace
+ list isNil ifTrue:[^self].
+ list keysAndValuesDo:[:lineNR :line |
+ |l|
+
+ line notNil ifTrue:[
+ l := line withoutTrailingSeparators.
+ list at:lineNR put:l.
+ ]
+ ].
+!
+
+resetVariablesBeforeNewSearch
+ "clear the autosearch action, when the first pattern is searched for"
+
+ searchAction := nil.
+!
+
+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.
+ self selectionChanged.
+!
+
+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.
+ self selectionChanged.
+!
+
+scrollSelectRight
+ "auto scroll action; scroll and reinstall timed-block"
+
+ |prevEndCol firstVisibleCol endLine|
+
+ "just to make certain ..."
+ selectionEndCol isNil ifTrue:[^ self].
+ selectionEndLine isNil ifTrue:[^ self].
+
+ prevEndCol := selectionEndCol.
+ selectionEndCol := (selectionEndCol + 1) min:(self listAt:selectionEndLine) size.
+
+ endLine := self listLineToVisibleLine:selectionEndLine.
+ endLine notNil ifTrue:[
+ firstVisibleCol := self colOfX:1 inVisibleLine:endLine.
+ selectionEndCol < firstVisibleCol ifTrue:[
+ "/ scrolling faster than selection advances...
+ selectionEndCol := firstVisibleCol
+ ].
+ ].
+
+ self selectionChanged.
+ self scrollRight.
+ "/ self repairDamage.
+
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
+
+ "Modified: / 05-08-2010 / 21:25:56 / cg"
+!
+
+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.
+ self selectionChanged.
+!
+
+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:[
+ "/ if there is a selection which covers multiple lines,
+ "/ we have to scroll the whole width (to include the selection-rectangle)
+
+ (lastLine < selectionStartLine) ifFalse:[
+ (firstLine > selectionEndLine) ifFalse:[
+ ^ width
+ ]
+ ].
+ ].
+ ^ super widthForScrollBetween:firstLine and:lastLine
+! !
+
+!TextView methodsFor:'queries'!
+
+hasSearchActionSelection
+ "Here we fake the use of typeOfSelection which is really in EditTextView"
+
+ ^ false
+!
+
+specClass
+ "redefined, since the name of my specClass is nonStandard (i.e. not TextViewSpec)"
+
+ self class == TextView ifTrue:[^ TextEditorSpec].
+ ^ super specClass
+
+ "Modified: / 31.10.1997 / 19:48:35 / cg"
+! !
+
+!TextView methodsFor:'redrawing'!
+
+clearMarginOfVisibleLine:visLine with:color
+ "if there is a margin, clear it - a helper for selection drawing"
+
+ (leftMargin ~~ 0) ifTrue:[
+ viewOrigin x <= margin ifTrue:[
+ self paint:color.
+ self fillRectangleX:margin-viewOrigin x
+ y:(self yOfVisibleLine:visLine)- (lineSpacing//2)
+ width:leftMargin
+ height:fontHeight
+ ]
+ ]
+
+ "Created: 6.3.1996 / 14:22:55 / cg"
+!
+
+drawSelectedFromVisibleLine:startVisLineNr to:endVisLineNr
+ startVisLineNr to:endVisLineNr do:[:visLine |
+ self drawVisibleLineSelected:visLine
+ ]
+!
+
+drawVisibleLineSelected:visLineNr
+ self
+ drawLine:(self withoutAnyColorEmphasis:(self visibleAt:visLineNr))
+ inVisible:visLineNr
+ with:self currentSelectionFgColor and:self currentSelectionBgColor
+!
+
+drawVisibleLineSelected:visLineNr col:col
+ self
+ drawLine:(self withoutAnyColorEmphasis:(self visibleAt:visLineNr))
+ inVisible:visLineNr
+ col:col
+ with:self currentSelectionFgColor and:self currentSelectionBgColor
+!
+
+drawVisibleLineSelected:visLineNr from:selectionStartCol
+ self
+ drawLine:(self withoutAnyColorEmphasis:(self visibleAt:visLineNr))
+ inVisible:visLineNr
+ from:selectionStartCol
+ with:self currentSelectionFgColor and:self currentSelectionBgColor.
+!
+
+drawVisibleLineSelected:visLineNr from:startCol to:endCol
+ self
+ drawLine:(self withoutAnyColorEmphasis:(self visibleAt:visLineNr))
+ inVisible:visLineNr
+ from:startCol to:endCol
+ with:self currentSelectionFgColor and:self currentSelectionBgColor.
+!
+
+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
+ ].
+
+ selectionEndLine isNil ifTrue:[
+ selectionStartLine := nil
+ ].
+
+ 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 drawSelectedFromVisibleLine:startVisLineNr to:end.
+ ^ 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 drawSelectedFromVisibleLine:line1 to:line2.
+
+ (line2 >= end) ifTrue:[^ self].
+
+ "last line of selection"
+ self redrawVisibleLine:(line2 + 1).
+
+ ((line2 + 2) <= end) ifTrue:[
+ super redrawFromVisibleLine:(line2 + 2) to:end
+ ]
+!
+
+redrawVisibleLine:visLineNr
+ "redraw visible line lineNr"
+
+ |line|
+
+ (selectionStartLine notNil and:[selectionEndLine notNil
+ and:[ selectionStartCol notNil and:[selectionEndCol notNil]]]) ifTrue:[
+ line := self visibleLineToAbsoluteLine:visLineNr.
+ (line between:selectionStartLine and:selectionEndLine) ifTrue:[
+ (line == selectionStartLine) ifTrue:[
+ (line == selectionEndLine) ifTrue:[
+ "it's part-of-single-line selection"
+ self clearMarginOfVisibleLine:visLineNr with:bgColor.
+ (selectionStartCol > 1) ifTrue:[
+ super redrawVisibleLine:visLineNr from:1 to:(selectionStartCol - 1)
+ ].
+ self drawVisibleLineSelected:visLineNr from:selectionStartCol to:selectionEndCol.
+ super redrawVisibleLine:visLineNr from:(selectionEndCol + 1).
+ ^ self
+ ].
+
+ "it's the first line of a multi-line selection"
+ (selectionStartCol ~~ 1) ifTrue:[
+ self clearMarginOfVisibleLine:visLineNr with:bgColor.
+ super redrawVisibleLine:visLineNr from:1 to:(selectionStartCol - 1)
+ ] ifFalse:[
+ viewOrigin x == 0 ifTrue:[
+ self clearMarginOfVisibleLine:visLineNr with:self currentSelectionBgColor.
+ ]
+ ].
+ self drawVisibleLineSelected:visLineNr from:selectionStartCol.
+ ^ self
+ ].
+
+ (line == selectionEndLine) ifTrue:[
+ "it's the last line of a multi-line selection"
+ (selectionEndCol == 0) ifTrue:[
+ ^ super redrawVisibleLine:visLineNr
+ ].
+
+ self clearMarginOfVisibleLine:visLineNr with:self currentSelectionBgColor.
+ self drawVisibleLineSelected:visLineNr from:1 to:selectionEndCol.
+ super redrawVisibleLine:visLineNr from:(selectionEndCol + 1).
+ ^ self
+ ].
+
+ "it's a full line in a multi-line selection"
+ self clearMarginOfVisibleLine:visLineNr with:self currentSelectionBgColor.
+ self drawVisibleLineSelected:visLineNr.
+ ^ self
+ ]
+ ].
+ super redrawVisibleLine:visLineNr
+
+ "Modified: 6.3.1996 / 14:22:19 / cg"
+!
+
+redrawVisibleLine:visLine col:col
+ "redraw single character at col in visible line lineNr."
+
+ |line|
+
+ "/
+ "/ care for selection
+ "/
+ (selectionStartLine notNil and:[selectionEndLine notNil
+ and:[ selectionStartCol notNil and:[selectionEndCol notNil]]]) ifTrue:[
+ line := self visibleLineToAbsoluteLine:visLine.
+ (line between:selectionStartLine and:selectionEndLine) ifTrue:[
+ ((line == selectionStartLine)
+ and: [col < selectionStartCol]) ifFalse:[
+ ((line == selectionEndLine)
+ and: [col > selectionEndCol]) ifFalse:[
+ "its in the selection"
+ self drawVisibleLineSelected:visLine col:col.
+ ^ self.
+ ]
+ ]
+ ]
+ ].
+ self drawVisibleLine:visLine col:col with:fgColor and:bgColor
+
+ "Modified: / 22.4.1998 / 08:53:05 / cg"
+!
+
+redrawVisibleLine:visLine from:startCol
+ "redraw visible line lineNr from startCol to end of line"
+
+ |col line|
+
+ col := startCol.
+ col == 0 ifTrue:[
+ col := 1.
+ ].
+
+ (selectionStartLine notNil and:[selectionEndLine notNil]) ifTrue:[
+ line := self visibleLineToAbsoluteLine:visLine.
+ (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 drawVisibleLineSelected:visLine from:col.
+ ^ self
+ ]
+ ].
+ super redrawVisibleLine:visLine from:col
+
+ "Modified: 6.3.1996 / 14:19:38 / cg"
+!
+
+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 or:[selectionEndLine isNil
+ or:[selectionStartCol isNil or:[selectionEndCol 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 drawVisibleLineSelected:visLine from:startCol to:endCol
+ ] 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 drawVisibleLineSelected:visLine from:leftCol to:rightCol.
+
+ "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 clearMarginOfVisibleLine:visLine with:self currentSelectionBgColor.
+ ].
+
+ ((line == selectionStartLine)
+ and:[(startCol == 1)
+ and:[selectionStartLine < selectionEndLine]])
+ ifTrue:[
+ self clearMarginOfVisibleLine:visLine with:bgColor.
+ ].
+
+ ((line > selectionStartLine)
+ and:[(startCol == 1)
+ and:[selectionStartLine < selectionEndLine
+ and:[line < selectionEndLine]]])
+ ifTrue:[
+ self clearMarginOfVisibleLine:visLine with:self currentSelectionBgColor.
+ ]
+
+ "Modified: 6.3.1996 / 14:23:26 / cg"
+! !
+
+!TextView methodsFor:'searching'!
+
+clearSearchAction
+ searchAction := nil.
+!
+
+scanFor:aCharacter fromLine:startLine col:startCol forward:forward
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ "search for a character in the direction given by forward.
+ Performs foundBlock with line/col as argument if found, notFoundBlock if not."
+
+ |lineString
+ line "{ Class: SmallInteger }"
+ col "{ Class: SmallInteger }"
+ delta "{ Class: SmallInteger }"
+ endCol "{ Class: SmallInteger }"
+ cc
+ maxLine "{ Class: SmallInteger }"
+ |
+
+ col := startCol.
+ line := startLine.
+ forward ifTrue:[
+ delta := 1.
+ ] ifFalse:[
+ delta := -1.
+ ].
+
+ lineString := list at:line.
+ maxLine := list size.
+
+ col := col + delta.
+ [true] whileTrue:[
+ lineString notNil ifTrue:[
+ forward ifTrue:[
+ endCol := lineString size.
+ ] ifFalse:[
+ endCol := 1
+ ].
+
+ col to:endCol by:delta do:[:rCol |
+ cc := lineString at:rCol.
+ cc == aCharacter ifTrue:[
+ ^ foundBlock value:line value:rCol.
+ ]
+ ].
+ ].
+ line := line + delta.
+ (line < 1 or:[line > maxLine]) ifTrue:[
+ ^ notFoundBlock value
+ ].
+ lineString := list at:line.
+ forward ifTrue:[
+ col := 1
+ ] ifFalse:[
+ col := lineString size
+ ]
+ ].
+ "not reached"
+
+ "Modified: 15.10.1996 / 12:22:30 / cg"
+ "Created: 11.9.1997 / 04:36:29 / cg"
+!
+
+searchAction
+ ^ searchAction
+!
+
+searchAction:aSearcherOrSearchBlock
+ searchAction := aSearcherOrSearchBlock
+!
+
+searchAgainInSameDirection
+ "search again in the same direction and -if found- position cursor"
+
+ |ign match|
+
+ searchBarActionBlock notNil ifTrue:[
+ searchBarActionBlock value:#forward value:self.
+ ^ self
+ ].
+
+ ign := lastSearchIgnoredCase ? LastSearchIgnoredCase ? true.
+ match := lastSearchWasMatch ? LastSearchWasMatch ? false.
+
+ self setSearchPatternWithMatchEscapes: match.
+ lastSearchPattern notNil ifTrue:[
+ lastSearchDirection == #backward ifTrue:[
+ self
+ searchBwd:lastSearchPattern
+ ignoreCase:ign
+ match: match
+ ] ifFalse:[
+ self
+ searchFwd:lastSearchPattern
+ ignoreCase:ign
+ match: match
+ ]
+ ]
+
+ "Created: / 03-05-1999 / 15:02:16 / cg"
+ "Modified: / 21-09-2006 / 16:47:57 / cg"
+!
+
+searchBwd
+ "search backward (for the same thing again)
+ If found, position cursor"
+
+ |ign selectedVariable|
+
+ searchAction notNil ifTrue:[
+ "/autosearch is cleared whenever there is search with user selection
+ (self hasSelection and:[self hasSearchActionSelection not]) ifTrue: [self clearSearchAction].
+ ].
+
+ searchAction notNil ifTrue:[
+ "/confusing: this is for autosearch of variables (browse variable uses, for example)
+ self searchUsingSearchAction:#backward.
+ ^ self.
+ ].
+ searchBarActionBlock notNil ifTrue:[
+ searchBarActionBlock value:#backward value:self.
+ ^ self
+ ].
+ lastSearchWasVariableSearch ifTrue:[
+ selectedVariable := self syntaxElementForSelectedVariable.
+ selectedVariable notNil ifTrue:[
+ self searchVariableWithSyntaxElement:selectedVariable forward:false.
+ ^ self.
+ ].
+ lastSearchWasVariableSearch := false.
+ ].
+
+ ign := lastSearchIgnoredCase ? LastSearchIgnoredCase ? true.
+
+ self setSearchPatternWithMatchEscapes: false.
+ lastSearchPattern isNil ifTrue:[
+ LastSearchPatterns size > 0 ifTrue:[
+ lastSearchPattern := LastSearchPatterns first
+ ]
+ ].
+
+ lastSearchPattern notNil ifTrue:[
+ lastSearchDirection := #backward.
+ self rememberSearchPattern:lastSearchPattern.
+ self
+ searchBwd:lastSearchPattern
+ ignoreCase:ign
+ ]
+
+ "Modified: / 08-03-2012 / 14:26:25 / cg"
+!
+
+searchBwd:pattern
+ "do a backward search"
+
+ self searchBwd:pattern ifAbsent:[self showNotFound].
+"/ lastSearchIgnoredCase := false.
+ lastSearchPattern := pattern string
+
+ "Modified: / 21-09-2006 / 16:48:29 / cg"
+!
+
+searchBwd:pattern ifAbsent:aBlock
+ "do a backward search"
+
+ self
+ searchBwdUsingSpec:(ListView::SearchSpec new
+ pattern:pattern)
+ ifAbsent:aBlock
+
+ "Modified: 13.9.1997 / 01:05:49 / cg"
+!
+
+searchBwd:pattern ignoreCase:ign
+ "do a backward search"
+
+ self
+ searchBwd:pattern
+ ignoreCase:ign
+ ifAbsent:[
+ self sensor compressKeyPressEventsWithKey:#FindPrev.
+ self showNotFound
+ ].
+ "/ lastSearchIgnoredCase := ign.
+ lastSearchPattern := pattern string
+
+ "Created: / 13-09-1997 / 06:18:00 / cg"
+ "Modified: / 23-03-2012 / 12:10:25 / cg"
+!
+
+searchBwd:pattern ignoreCase:ign ifAbsent:aBlock
+ "do a backward search"
+
+ self
+ searchBwdUsingSpec:(ListView::SearchSpec new
+ pattern:pattern
+ ignoreCase:ign)
+ ifAbsent:aBlock
+
+ "Modified: 13.9.1997 / 01:05:49 / cg"
+ "Created: 13.9.1997 / 06:18:41 / cg"
+!
+
+searchBwd:pattern ignoreCase:ign match: match
+ "do a backward search.
+ match pattern functionality is not yet available for backward search"
+
+ "/ lastSearchWasMatch := match.
+ self searchBwd:pattern ignoreCase:ign.
+
+ "Modified: / 23-03-2012 / 12:12:44 / cg"
+!
+
+searchBwdUsingSpec:searchSpec
+ "do a backward search"
+
+ self
+ searchBwdUsingSpec:searchSpec
+ ifAbsent:[self showNotFound].
+
+"/ lastSearchIgnoredCase := false.
+ lastSearchPattern := searchSpec pattern string
+
+ "Modified: / 21-09-2006 / 16:48:29 / cg"
+!
+
+searchBwdUsingSpec:searchSpec ifAbsent:aBlock
+ "do a backward search"
+
+ |pos startLine startCol|
+
+ pos := self startPositionForSearchBackward.
+ startLine := pos y.
+ startCol := pos x.
+
+ self
+ searchBackwardUsingSpec:searchSpec
+ startingAtLine:startLine col:startCol
+ ifFound:[:line :col | self showMatch:searchSpec pattern isMatch:searchSpec match atLine:line col:col]
+ ifAbsent:aBlock
+!
+
+searchForAndSelectMatchingParenthesisFromLine:startLine col:startCol
+ "select characters enclosed by matching parenthesis if one is under startLine/Col"
+
+ self
+ searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:[:line :col |
+ self selectFromLine:startLine col:startCol
+ toLine:line col:col]
+ ifNotFound:[self showNotFound]
+ onError:[self beep]
+
+ "Modified: 9.10.1997 / 12:57:34 / cg"
+!
+
+searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+
+ "search for a matching parenthesis; start search with character at startLine/startCol.
+ Search for the corresponding character is done forward if its an opening,
+ backwards if its a closing parenthesis.
+ Evaluate foundBlock with line/col as argument if found, notFoundBlock if not.
+ If there is a nesting error, evaluate failBlock."
+
+ ^ self
+ searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+ ignoring:(parenthesisSpecification at:#ignore ifAbsent:#()) "/ #( $' $" '$[' '$]' '${' '$)' )
+
+ "Modified: / 12-04-2007 / 11:24:24 / cg"
+!
+
+searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+ ignoring:ignoreSet
+
+ "search for a matching parenthesis; start search with character at startLine/startCol.
+ Search for the corresponding character is done forward if its an opening,
+ backwards if its a closing parenthesis.
+ Evaluate foundBlock with line/col as argument if found, notFoundBlock if not.
+ If there is a nesting error, evaluate failBlock."
+
+ ^ self
+ searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+ openingCharacters: (parenthesisSpecification at:#open) "/ #( $( $[ ${ "$> $<")
+ closingCharacters: (parenthesisSpecification at:#close) "/ #( $) $] $} "$> $<")
+ ignoredCharacters: ignoreSet
+ specialEOLComment: (parenthesisSpecification at:#eolComment ifAbsent:#()) "/
+
+"/ |i direction lineString
+"/ parChar charSet closingChar
+"/ ignoring
+"/ line "{ Class: SmallInteger }"
+"/ col "{ Class: SmallInteger }"
+"/ delta "{ Class: SmallInteger }"
+"/ endCol "{ Class: SmallInteger }"
+"/ runCol "{ Class: SmallInteger }"
+"/ cc prevCC nextCC incSet decSet
+"/ nesting "{ Class: SmallInteger }"
+"/ maxLine "{ Class: SmallInteger }"
+"/ ign skip anySet|
+"/
+"/ 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 fwd bwd) at:i.
+"/ closingChar := #( $) $( $] $[ $} ${ "$> $<") at:i.
+"/
+"/ col := startCol.
+"/ line := startLine.
+"/ direction == #fwd ifTrue:[
+"/ delta := 1.
+"/ incSet := #( $( $[ ${ "$<" ).
+"/ decSet := #( $) $] $} "$>" ).
+"/ ] ifFalse:[
+"/ delta := -1.
+"/ incSet := #( $) $] $} "$>" ).
+"/ decSet := #( $( $[ ${ "$<" ).
+"/ ].
+"/ anySet := Set new.
+"/ anySet addAll:incSet; addAll:decSet; addAll:ignoreSet.
+"/ anySet := (anySet select:[:c | c isCharacter]) asString.
+"/
+"/ nesting := 1.
+"/ ignoring := false.
+"/ lineString := list at:line.
+"/ maxLine := list size.
+"/
+"/ col := col + delta.
+"/ [nesting ~~ 0] whileTrue:[
+"/ (lineString notNil
+"/ and:[lineString includesAny:anySet]) ifTrue:[
+"/ direction == #fwd ifTrue:[
+"/ endCol := lineString size.
+"/ ] ifFalse:[
+"/ endCol := 1
+"/ ].
+"/
+"/ col to:endCol by:delta do:[:rCol |
+"/ runCol := rCol.
+"/
+"/ cc := lineString at:runCol.
+"/ runCol < lineString size ifTrue:[
+"/ nextCC := lineString at:runCol+1
+"/ ] ifFalse:[
+"/ nextCC := nil
+"/ ].
+"/ runCol > 1 ifTrue:[
+"/ prevCC := lineString at:runCol-1
+"/ ] ifFalse:[
+"/ prevCC := nil
+"/ ].
+"/
+"/ ign := skip := false.
+"/
+"/ "/ check for comments.
+"/
+"/ ((cc == $" and:[nextCC == $/])
+"/ or:[prevCC == $$ ]) ifTrue:[
+"/ "/ do nothing
+"/
+"/ skip := true.
+"/ ] ifFalse:[
+"/ ignoreSet do:[:ignore |
+"/ ignore == cc ifTrue:[
+"/ ign := true
+"/ ] ifFalse:[
+"/ ignore isString ifTrue:[
+"/ cc == (ignore at:2) ifTrue:[
+"/ runCol > 1 ifTrue:[
+"/ (lineString at:(runCol-1)) == (ignore at:1) ifTrue:[
+"/ skip := true
+"/ ]
+"/ ]
+"/ ] ifFalse:[
+"/ cc == (ignore at:1) ifTrue:[
+"/ runCol < lineString size ifTrue:[
+"/ (lineString at:(runCol+1)) == (ignore at:2) ifTrue:[
+"/ skip := true
+"/ ]
+"/ ]
+"/ ]
+"/ ]
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ ign ifTrue:[
+"/ ignoring := ignoring not
+"/ ].
+"/
+"/ ignoring ifFalse:[
+"/ skip ifFalse:[
+"/ (incSet includes:cc) ifTrue:[
+"/ nesting := nesting + 1
+"/ ] ifFalse:[
+"/ (decSet includes:cc) ifTrue:[
+"/ nesting := nesting - 1
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ nesting == 0 ifTrue:[
+"/ "check if legal"
+"/
+"/ skip ifFalse:[
+"/ 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: / 12-04-2007 / 11:25:36 / cg"
+!
+
+searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+ openingCharacters:openingCharacters
+ closingCharacters:closingCharacters
+
+ "search for a matching parenthesis; start search with character at startLine/startCol.
+ Search for the corresponding character is done forward if its an opening,
+ backwards if its a closing parenthesis.
+ Evaluate foundBlock with line/col as argument if found, notFoundBlock if not.
+ If there is a nesting error, evaluate failBlock."
+
+ ^ self
+ searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+ openingCharacters: openingCharacters
+ closingCharacters: closingCharacters
+ ignoredCharacters: (parenthesisSpecification at:#ignore ifAbsent:#())
+ specialEOLComment: (parenthesisSpecification at:#eolComment ifAbsent:#()) "/
+
+"/ |i direction lineString
+"/ parChar charSet closingChar
+"/ ignoring
+"/ line "{ Class: SmallInteger }"
+"/ col "{ Class: SmallInteger }"
+"/ delta "{ Class: SmallInteger }"
+"/ endCol "{ Class: SmallInteger }"
+"/ runCol "{ Class: SmallInteger }"
+"/ cc prevCC nextCC incSet decSet
+"/ nesting "{ Class: SmallInteger }"
+"/ maxLine "{ Class: SmallInteger }"
+"/ ign skip anySet|
+"/
+"/ 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 fwd bwd) at:i.
+"/ closingChar := #( $) $( $] $[ $} ${ "$> $<") at:i.
+"/
+"/ col := startCol.
+"/ line := startLine.
+"/ direction == #fwd ifTrue:[
+"/ delta := 1.
+"/ incSet := #( $( $[ ${ "$<" ).
+"/ decSet := #( $) $] $} "$>" ).
+"/ ] ifFalse:[
+"/ delta := -1.
+"/ incSet := #( $) $] $} "$>" ).
+"/ decSet := #( $( $[ ${ "$<" ).
+"/ ].
+"/ anySet := Set new.
+"/ anySet addAll:incSet; addAll:decSet; addAll:ignoreSet.
+"/ anySet := (anySet select:[:c | c isCharacter]) asString.
+"/
+"/ nesting := 1.
+"/ ignoring := false.
+"/ lineString := list at:line.
+"/ maxLine := list size.
+"/
+"/ col := col + delta.
+"/ [nesting ~~ 0] whileTrue:[
+"/ (lineString notNil
+"/ and:[lineString includesAny:anySet]) ifTrue:[
+"/ direction == #fwd ifTrue:[
+"/ endCol := lineString size.
+"/ ] ifFalse:[
+"/ endCol := 1
+"/ ].
+"/
+"/ col to:endCol by:delta do:[:rCol |
+"/ runCol := rCol.
+"/
+"/ cc := lineString at:runCol.
+"/ runCol < lineString size ifTrue:[
+"/ nextCC := lineString at:runCol+1
+"/ ] ifFalse:[
+"/ nextCC := nil
+"/ ].
+"/ runCol > 1 ifTrue:[
+"/ prevCC := lineString at:runCol-1
+"/ ] ifFalse:[
+"/ prevCC := nil
+"/ ].
+"/
+"/ ign := skip := false.
+"/
+"/ "/ check for comments.
+"/
+"/ ((cc == $" and:[nextCC == $/])
+"/ or:[prevCC == $$ ]) ifTrue:[
+"/ "/ do nothing
+"/
+"/ skip := true.
+"/ ] ifFalse:[
+"/ ignoreSet do:[:ignore |
+"/ ignore == cc ifTrue:[
+"/ ign := true
+"/ ] ifFalse:[
+"/ ignore isString ifTrue:[
+"/ cc == (ignore at:2) ifTrue:[
+"/ runCol > 1 ifTrue:[
+"/ (lineString at:(runCol-1)) == (ignore at:1) ifTrue:[
+"/ skip := true
+"/ ]
+"/ ]
+"/ ] ifFalse:[
+"/ cc == (ignore at:1) ifTrue:[
+"/ runCol < lineString size ifTrue:[
+"/ (lineString at:(runCol+1)) == (ignore at:2) ifTrue:[
+"/ skip := true
+"/ ]
+"/ ]
+"/ ]
+"/ ]
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ ign ifTrue:[
+"/ ignoring := ignoring not
+"/ ].
+"/
+"/ ignoring ifFalse:[
+"/ skip ifFalse:[
+"/ (incSet includes:cc) ifTrue:[
+"/ nesting := nesting + 1
+"/ ] ifFalse:[
+"/ (decSet includes:cc) ifTrue:[
+"/ nesting := nesting - 1
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ nesting == 0 ifTrue:[
+"/ "check if legal"
+"/
+"/ skip ifFalse:[
+"/ 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: / 12-04-2007 / 11:25:36 / cg"
+!
+
+searchForMatchingParenthesisFromLine:startLine col:startCol
+ ifFound:foundBlock
+ ifNotFound:notFoundBlock
+ onError:failBlock
+ openingCharacters:openingCharacters
+ closingCharacters:closingCharacters
+ ignoredCharacters:ignoreSet
+ specialEOLComment:eolCommentSequence
+
+ "search for a matching parenthesis; start search with character at startLine/startCol.
+ Search for the corresponding character is done forward if its an opening,
+ backwards if its a closing parenthesis.
+ Evaluate foundBlock with line/col as argument if found, notFoundBlock if not.
+ If there is a nesting error, evaluate failBlock."
+
+ |i direction lineString
+ parChar charSet closingChar
+ ignoring
+ line "{ Class: SmallInteger }"
+ col "{ Class: SmallInteger }"
+ delta "{ Class: SmallInteger }"
+ endCol "{ Class: SmallInteger }"
+ runCol "{ Class: SmallInteger }"
+ cc prevCC nextCC incSet decSet
+ nesting "{ Class: SmallInteger }"
+ maxLine "{ Class: SmallInteger }"
+ ign skip anySet
+ eol1 eol2|
+
+ self assert:(openingCharacters size == closingCharacters size).
+
+ charSet := openingCharacters , closingCharacters.
+
+ parChar := self characterAtLine:startLine col:startCol.
+ i := charSet indexOf:parChar.
+ i == 0 ifTrue:[
+ ^ failBlock value "not a parenthesis"
+ ].
+
+ direction := (i <= openingCharacters size) ifTrue:[#fwd] ifFalse:[#bwd].
+ closingChar := (closingCharacters , openingCharacters) at:i.
+
+ eol1 := eolCommentSequence at:1 ifAbsent:nil.
+ eol2 := eolCommentSequence at:2 ifAbsent:nil.
+
+ col := startCol.
+ line := startLine.
+ direction == #fwd ifTrue:[
+ delta := 1.
+ incSet := openingCharacters.
+ decSet := closingCharacters.
+ ] ifFalse:[
+ delta := -1.
+ incSet := closingCharacters.
+ decSet := openingCharacters.
+ ].
+ anySet := Set new.
+ anySet addAll:incSet; addAll:decSet; addAll:ignoreSet.
+ anySet := (anySet select:[:c | c isCharacter]) asString.
+
+ nesting := 1.
+ ignoring := false.
+ lineString := list at:line.
+ maxLine := list size.
+
+ col := col + delta.
+ [nesting ~~ 0] whileTrue:[
+ (lineString notNil
+ and:[lineString includesAny:anySet]) ifTrue:[
+ direction == #fwd ifTrue:[
+ endCol := lineString size.
+ ] ifFalse:[
+ endCol := 1
+ ].
+
+ col to:endCol by:delta do:[:rCol |
+ runCol := rCol.
+
+ cc := lineString at:runCol.
+ runCol < lineString size ifTrue:[
+ nextCC := lineString at:runCol+1
+ ] ifFalse:[
+ nextCC := nil
+ ].
+ runCol > 1 ifTrue:[
+ prevCC := lineString at:runCol-1
+ ] ifFalse:[
+ prevCC := nil
+ ].
+
+ ign := skip := false.
+
+ "/ check for comments.
+
+ ((cc == eol1 and:[nextCC == eol2])
+ or:[prevCC == $$ ]) ifTrue:[
+ "/ do nothing
+
+ skip := true.
+ ] ifFalse:[
+ ignoreSet do:[:ignore |
+ ignore == cc ifTrue:[
+ ign := true
+ ] ifFalse:[
+ ignore isString ifTrue:[
+ cc == (ignore at:2) ifTrue:[
+ runCol > 1 ifTrue:[
+ (lineString at:(runCol-1)) == (ignore at:1) ifTrue:[
+ skip := true
+ ]
+ ]
+ ] ifFalse:[
+ cc == (ignore at:1) ifTrue:[
+ runCol < lineString size ifTrue:[
+ (lineString at:(runCol+1)) == (ignore at:2) ifTrue:[
+ skip := true
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ ign ifTrue:[
+ ignoring := ignoring not
+ ].
+
+ ignoring ifFalse:[
+ skip ifFalse:[
+ (incSet includes:cc) ifTrue:[
+ nesting := nesting + 1
+ ] ifFalse:[
+ (decSet includes:cc) ifTrue:[
+ nesting := nesting - 1
+ ]
+ ]
+ ]
+ ].
+
+ nesting == 0 ifTrue:[
+ "check if legal"
+ skip ifFalse:[
+ 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: 15.10.1996 / 12:22:30 / cg"
+!
+
+searchFwd
+ "search forward for the same pattern or selection again"
+
+ |ign match variable|
+
+ searchAction notNil ifTrue:[
+ "/ autosearch is cleared whenever there is search with user selection
+ (self hasSelection and:[self hasSearchActionSelection not]) ifTrue: [self clearSearchAction].
+ ].
+
+ searchAction notNil ifTrue:[
+ "/ confusing: this is for autosearch of variables (browse variable uses, for example)
+ self searchUsingSearchAction:#forward.
+ ^ self.
+ ].
+ searchBarActionBlock notNil ifTrue:[
+ searchBarActionBlock value:#forward value:self.
+ ^ self
+ ].
+ lastSearchWasVariableSearch ifTrue:[
+ variable := self syntaxElementForSelectedVariable.
+ variable notNil ifTrue:[
+ self searchVariableWithSyntaxElement:variable forward:true.
+ ^ self.
+ ].
+ lastSearchWasVariableSearch := false.
+ ].
+
+ ign := lastSearchIgnoredCase ? LastSearchIgnoredCase ? true.
+ match := lastSearchWasMatch ? LastSearchWasMatch ? false.
+
+ selectStyle == #wordLeft ifTrue:[
+ "
+ remove the space from the selection
+ "
+ selectionStartCol := selectionStartCol + 1.
+ super redrawLine:selectionStartLine from:selectionStartCol-1 to:selectionStartCol-1.
+ selectStyle := #word.
+ self selectionChanged.
+ ].
+ self setSearchPatternWithMatchEscapes: match.
+
+ lastSearchPattern isNil ifTrue:[
+ LastSearchPatterns size > 0 ifTrue:[
+ lastSearchPattern := LastSearchPatterns first
+ ]
+ ].
+
+ lastSearchPattern notNil ifTrue:[
+ self rememberSearchPattern:lastSearchPattern.
+ lastSearchDirection := #forward.
+ self
+ searchFwd:lastSearchPattern
+ ignoreCase:ign
+ match: match
+ ]
+
+ "Modified: / 08-03-2012 / 14:25:42 / cg"
+!
+
+searchFwd:pattern
+ "do a forward search"
+
+ self searchFwd:pattern ifAbsent:[self showNotFound].
+"/ lastSearchIgnoredCase := false.
+ lastSearchPattern := pattern string
+
+ "Modified: / 21-09-2006 / 16:52:04 / cg"
+!
+
+searchFwd:pattern ifAbsent:aBlock
+ "do a forward search"
+
+ self
+ searchFwdUsingSpec:(ListView::SearchSpec new
+ pattern:pattern)
+ ifAbsent:aBlock
+
+ "Modified: / 21-09-2006 / 16:51:28 / cg"
+!
+
+searchFwd:pattern ignoreCase:ign
+ "do a forward search"
+
+ self
+ searchFwdUsingSpec:(ListView::SearchSpec new
+ pattern:pattern
+ ignoreCase:ign)
+ ifAbsent:[
+ self sensor compressKeyPressEventsWithKey:#FindNext.
+ self showNotFound
+ ].
+ "/ lastSearchIgnoredCase := ign.
+ lastSearchPattern := pattern string
+
+ "Created: / 13-09-1997 / 06:18:13 / cg"
+ "Modified: / 23-03-2012 / 12:09:59 / cg"
+!
+
+searchFwd:pattern ignoreCase:ign ifAbsent:aBlock
+ "do a forward search"
+
+ self
+ searchFwdUsingSpec:(ListView::SearchSpec new
+ pattern:pattern
+ ignoreCase:ign)
+ ifAbsent:aBlock
+
+ "Modified: 13.9.1997 / 01:05:35 / cg"
+ "Created: 13.9.1997 / 06:18:27 / cg"
+!
+
+searchFwd:pattern ignoreCase:ign match: match
+ "do a forward search"
+
+ self
+ searchFwdUsingSpec:(ListView::SearchSpec new
+ pattern:pattern
+ ignoreCase:ign
+ match:match)
+ ifAbsent:[
+ self sensor compressKeyPressEventsWithKey:#FindNext.
+ self showNotFound
+ ].
+ "/ lastSearchIgnoredCase := ign.
+ "/ lastSearchWasMatch := match.
+ lastSearchPattern := pattern string
+
+ "Created: / 13-09-1997 / 06:18:13 / cg"
+ "Modified: / 23-03-2012 / 12:12:47 / cg"
+!
+
+searchFwd:pattern ignoreCase:ign match: match ifAbsent:aBlock
+ "do a forward search"
+
+ self
+ searchFwdUsingSpec:(ListView::SearchSpec new
+ pattern:pattern
+ ignoreCase:ign
+ match:match)
+ ifAbsent:aBlock
+
+ "Modified: 13.9.1997 / 01:05:35 / cg"
+ "Created: 13.9.1997 / 06:18:27 / cg"
+!
+
+searchFwd:pattern ignoreCase:ign match: match startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
+ self
+ searchFwdUsingSpec:(ListView::SearchSpec new
+ pattern:pattern
+ ignoreCase:ign
+ match:match)
+ startingAtLine:startLine col:startCol
+ ifAbsent:aBlock
+!
+
+searchFwdUsingSpec:searchSpec
+ "do a forward search"
+
+ self
+ searchFwdUsingSpec:searchSpec
+ ifAbsent:[self showNotFound].
+
+"/ lastSearchIgnoredCase := false.
+ lastSearchPattern := searchSpec pattern string
+
+ "Modified: / 21-09-2006 / 16:52:04 / cg"
+!
+
+searchFwdUsingSpec:searchSpec ifAbsent:aBlock
+ "do a forward search"
+
+ |pos startLine startCol|
+
+ pos := self startPositionForSearchForward.
+ startLine := pos y.
+ startCol := pos x.
+
+ self
+ searchFwdUsingSpec:searchSpec
+ startingAtLine:startLine col:startCol
+ ifAbsent:aBlock
+
+ "Modified: 13.9.1997 / 01:05:35 / cg"
+ "Created: 13.9.1997 / 06:18:27 / cg"
+!
+
+searchFwdUsingSpec:searchSpec startingAtLine:startLine col:startCol ifAbsent:aBlock
+ "do a forward search"
+
+ self
+ searchForwardUsingSpec:searchSpec
+ startingAtLine:startLine col:startCol
+ ifFound:[:line :col | self showMatch:searchSpec pattern isMatch:searchSpec match atLine:line col:col]
+ ifAbsent:aBlock
+!
+
+searchPattern
+ "return the last search pattern"
+
+ ^ lastSearchPattern
+!
+
+searchUsingSearchAction:direction
+ self
+ searchUsingSearchAction:direction
+ ifAbsent:[
+ self sensor compressKeyPressEventsWithKey:#FindNext.
+ self showNotFound
+ ]
+!
+
+searchUsingSearchAction:direction ifAbsent:notFoundAction
+ |pos startLine startCol|
+
+ pos := direction == #backward
+ ifTrue:[self startPositionForSearchBackward]
+ ifFalse:[self startPositionForSearchForward].
+ startLine := pos y.
+ startCol := pos x.
+
+ searchAction notNil ifTrue:[
+ searchAction
+ value:direction
+ value:startLine
+ value:startCol
+ value:[:line :col | self selectFromLine:line toLine:line]
+ value:notFoundAction.
+ self hasSelection ifTrue: [
+ self changeTypeOfSelectionTo: #searchAction.
+ ].
+ ].
+!
+
+setSearchPattern
+ "set the searchpattern from the selection if there is one"
+
+ self setSearchPatternWithMatchEscapes: false.
+!
+
+setSearchPattern:aStringOrNil
+ "set the searchpattern for future searches"
+
+ aStringOrNil isEmptyOrNil ifTrue:[
+ lastSearchPattern := nil.
+ ] ifFalse:[
+ lastSearchPattern := aStringOrNil asString withoutSeparators string.
+ ].
+
+ "Modified: / 6.3.1999 / 23:47:36 / cg"
+!
+
+setSearchPattern:aString ignoreCase:aBoolean
+ "set the searchpattern and caseIgnore for future searches"
+
+ self setSearchPattern:aString.
+ lastSearchIgnoredCase := aBoolean.
+!
+
+setSearchPatternWithMatchEscapes: match
+ "set the searchpattern from the selection if there is one"
+
+ |sel searchPattern |
+
+"/ clickPos isNil ifTrue:[^ self].
+
+ sel := self selection.
+ sel notNil ifTrue:[
+ searchPattern := sel asString.
+ match ifTrue:[searchPattern := searchPattern withMatchEscapes].
+ self setSearchPattern:searchPattern.
+ ]
+
+ "Modified: / 6.3.1999 / 23:48:04 / cg"
+!
+
+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)"
+
+ self showMatch:pattern isMatch:true atLine:line col:col
+!
+
+showMatch:pattern isMatch:isMatch 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.
+
+ isMatch ifTrue: [
+ (realPattern startsWith:$*) ifTrue:[
+ realPattern := realPattern copyFrom:2
+ ].
+ (realPattern endsWith:$*) ifTrue:[
+ realPattern := realPattern copyButLast: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|
+
+ savedCursor := cursor.
+ [
+ self cursor:(Cursor cross).
+ self beep.
+ Processor activeProcess millisecondDelay:300.
+ ] ensure:[
+ self cursor:savedCursor
+ ]
+
+ "Modified: 20.2.1997 / 12:49:27 / cg"
+!
+
+startPositionForSearchBackward
+ ^ self startPositionForSearchBackwardBasedOnSelection
+!
+
+startPositionForSearchBackwardBasedOnSelection
+ |startLine startCol|
+
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ startLine := 1.
+ startCol := 1
+ ].
+
+ ^ startCol @ startLine
+!
+
+startPositionForSearchForward
+ ^ self startPositionForSearchForwardBasedOnSelection
+!
+
+startPositionForSearchForwardBasedOnSelection
+ |startLine startCol|
+
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ startCol := selectionStartCol
+ ] ifFalse:[
+ startLine := 1.
+ startCol := 1
+ ].
+
+ ^ startCol @ startLine
+! !
+
+!TextView methodsFor:'selections'!
+
+changeTypeOfSelectionTo:newType
+ "ignored here - but redefined in subclasses which
+ differentiate between pasted- and user-selections"
+!
+
+expandSelectionDown
+ |l t|
+
+ selectionStartLine notNil ifTrue:[
+ expandingTop == true ifTrue:[
+ l := selectionStartLine.
+ selectionStartLine := selectionStartLine + 1.
+ (selectionStartLine > clickLine
+ or:[selectionStartLine == clickLine and:[selectionStartCol > clickCol]])
+ ifTrue:[
+ t := selectionStartLine.
+ selectionStartLine := selectionEndLine.
+ selectionEndLine := t.
+ t := selectionStartCol.
+ selectionStartCol := selectionEndCol.
+ selectionEndCol := t.
+ expandingTop := false
+ ].
+ ] ifFalse:[
+ l := selectionEndLine.
+ selectionEndLine := selectionEndLine + 1.
+ ].
+"/ self redrawLine:l.
+"/ self redrawLine:l+1.
+ self validateNewSelection.
+ self setPrimarySelection.
+ self selectionChanged.
+ self redrawFromLine:l to:l+1.
+ self makeSelectionVisible.
+ ].
+
+ "Created: / 01-03-1996 / 23:35:08 / cg"
+ "Modified: / 18-03-1996 / 17:18:15 / cg"
+ "Modified: / 17-04-2012 / 21:01:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+expandSelectionLeft
+ |c l t c1 c2|
+
+ selectionStartLine notNil ifTrue:[
+ expandingTop == true ifTrue:[
+ selectionStartCol == 0 ifTrue:[^ self].
+ l := selectionStartLine.
+ selectionStartCol := (selectionStartCol - 1) max:1.
+ c := selectionStartCol.
+ ] ifFalse:[
+ l := selectionEndLine.
+ selectionEndCol := (selectionEndCol - 1) max:0.
+ c := selectionEndCol.
+ selectionEndLine == selectionStartLine ifTrue:[
+ selectionEndCol <= selectionStartCol ifTrue:[
+ t := selectionStartCol. selectionStartCol := selectionEndCol.
+ selectionEndCol := t.
+ expandingTop := true.
+ c := selectionStartCol.
+ ]
+ ].
+ ].
+ c1 := c.
+ c2 := c1 + 1.
+ c1 == 0 ifTrue:[
+ c1 := 1
+ ].
+ self validateNewSelection.
+ self setPrimarySelection.
+ self selectionChanged.
+ self redrawLine:l from:c1 to:c2.
+ self makeSelectionVisible.
+ ].
+
+ "Modified: / 18-03-1996 / 17:05:46 / cg"
+ "Modified: / 17-04-2012 / 21:01:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+expandSelectionRight
+ |l c t|
+
+ selectionStartLine notNil ifTrue:[
+ expandingTop == true ifTrue:[
+ l := selectionStartLine.
+ c := selectionStartCol.
+ selectionStartCol := selectionStartCol + 1.
+ l == selectionEndLine ifTrue:[
+ c >= selectionEndCol ifTrue:[
+ expandingTop := false.
+ t := selectionStartCol. selectionStartCol := selectionEndCol.
+ selectionEndCol := t.
+ c := selectionStartCol.
+ ]
+ ]
+ ] ifFalse:[
+ l := selectionEndLine.
+ c := selectionEndCol.
+ selectionEndCol := selectionEndCol + 1.
+ ].
+
+ self validateNewSelection.
+ self setPrimarySelection.
+ self selectionChanged.
+ self redrawLine:l from:(c max:1) to:c+1.
+ self makeSelectionVisible.
+ ].
+
+ "Created: / 01-03-1996 / 23:33:17 / cg"
+ "Modified: / 06-03-1996 / 13:54:10 / cg"
+ "Modified: / 17-04-2012 / 21:01:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+expandSelectionUp
+ |l t|
+
+ selectionStartLine notNil ifTrue:[
+ expandingTop == true ifTrue:[
+ selectionStartLine := (selectionStartLine - 1) max:1.
+ l := selectionStartLine.
+ ] ifFalse:[
+ selectionEndLine := (selectionEndLine - 1) max:0.
+
+ l := selectionEndLine.
+ (selectionEndLine < clickLine
+ or:[(selectionEndLine == clickLine and:[selectionEndCol < clickCol])])
+ ifTrue:[
+ t := selectionStartLine.
+ selectionStartLine := selectionEndLine.
+ selectionEndLine := t.
+ t := selectionStartCol.
+ selectionStartCol := selectionEndCol.
+ selectionEndCol := t.
+ l := selectionStartLine.
+ expandingTop := true
+ ].
+ ].
+ self validateNewSelection.
+ self setPrimarySelection.
+ self selectionChanged.
+ "/ self redrawLine:l.
+ "/ self redrawLine:l+1.
+ self redrawFromLine:l to:l+1.
+ self makeSelectionVisible.
+ ].
+
+ "Modified: / 06-03-1996 / 14:12:06 / cg"
+ "Modified: / 17-04-2012 / 21:01:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasSelection
+ "return true, if there is a selection"
+
+ ^ selectionStartLine notNil
+!
+
+hasSelectionForCopy
+ "return true, if there is a selection which can be copyied
+ (the same as #hasSelection, except for editfields in password-mode)"
+
+ ^ self hasSelection
+!
+
+hasSelectionWithinSingleLine
+ "return true, if there is a selection and it is within a line"
+
+ ^ selectionStartLine notNil
+ and:[ selectionStartLine == selectionEndLine ]
+
+ "Modified: / 04-07-2006 / 18:42:59 / fm"
+!
+
+hasSingleFullLineSelected
+ ^ (selectionStartLine notNil
+ and:[selectionEndLine notNil
+ and:[selectionEndLine == (selectionStartLine+1)
+ and:[selectionStartCol == 1
+ and:[selectionEndCol == 0
+ ]]]])
+!
+
+isInSelection:line col:aColNr
+ "returns true, if the line, and column is in the selection
+ "
+ selectionStartLine isNil ifTrue:[^ false].
+ selectionEndLine isNil ifTrue:[^ false].
+
+ (line between:selectionStartLine and:selectionEndLine) ifFalse:[
+ ^ false
+ ].
+
+ line == selectionStartLine ifTrue:[
+ aColNr < selectionStartCol ifTrue:[^ false]
+ ].
+
+ line == selectionEndLine ifTrue:[
+ (selectionEndCol ~~ 0 and:[selectionEndCol < aColNr]) ifTrue:[^ false]
+ ].
+ ^ true
+!
+
+makeSelectionVisible
+ "scroll to make the selection visible"
+
+ |line col|
+
+ selectionStartLine notNil ifTrue:[
+ expandingTop == true ifTrue:[
+ line := selectionStartLine.
+ col := selectionStartCol.
+ ] ifFalse:[
+ line := selectionEndLine.
+ col := selectionEndCol.
+ ].
+ self makeLineVisible:line.
+ self makeColVisible:col inLine:line.
+ ]
+
+ "Modified: 6.3.1996 / 13:53:45 / cg"
+!
+
+selectAll
+ "select the whole text"
+
+ self selectFromLine:1 col:1 toLine:(list size + 1) col:0
+!
+
+selectFromCharacterPosition:pos1
+ "compute line/col from the character position and select the text up to the end"
+
+ |line1 col1 line2 col2|
+
+ line1 := self lineOfCharacterPosition:pos1.
+ col1 := pos1 - (self characterPositionOfLine:line1 col:1) + 1.
+
+ line2 := (list size + 1).
+ col2 := 0.
+ self selectFromLine:line1 col:col1 toLine:line2 col:col2
+!
+
+selectFromCharacterPosition:pos1 to:pos2
+ "compute line/col from character positions and select the text"
+
+ |line1 col1 line2 col2|
+
+ pos1 > pos2 ifTrue:[
+ ^ self unselect
+ ].
+ line1 := self lineOfCharacterPosition:pos1.
+ col1 := pos1 - (self characterPositionOfLine:line1 col:1) + 1.
+ col1 < 1 ifTrue:[ col1 := 1 ].
+
+ line2 := self lineOfCharacterPosition:pos2.
+ col2 := pos2 - (self characterPositionOfLine:line2 col:1) + 1.
+ col2 < 1 ifTrue:[ col2 := 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.
+ self validateNewSelection.
+ self setPrimarySelection.
+ self selectionChanged.
+
+ (selectionStartLine == selectionEndLine) ifTrue:[
+ self redrawLine:selectionStartLine from:selectionStartCol to:selectionEndCol
+ ] ifFalse:[
+ selectionStartLine to:selectionEndLine do:[:lineNr |
+ self redrawLine:lineNr
+ ]
+ ].
+ selectStyle := nil.
+ ]
+
+ "
+ |v|
+
+ v := TextView extent:300@300.
+ v contents:('smalltalk.rc' asFilename contentsOfEntireFile).
+ v openAndWait.
+
+ Delay waitForSeconds:1.
+
+ v selectFromLine:2 col:2 toLine:10 col:15
+ "
+
+ "Modified: / 02-01-1997 / 13:32:25 / cg"
+ "Modified: / 17-04-2012 / 21:00:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectFromLine:startLine toLine:endLine
+ "select a piece of text and redraw that area"
+
+ self selectFromLine:startLine col:1 toLine:endLine+1 col:0
+
+ "
+ |v|
+
+ v := TextView extent:300@300.
+ v contents:('smalltalk.rc' asFilename contentsOfEntireFile).
+ v openAndWait.
+
+ Delay waitForSeconds:1.
+
+ v selectFromLine:2 toLine:10
+ "
+
+ "Modified: 29.4.1996 / 12:23:46 / cg"
+!
+
+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"
+
+ |selectLine|
+
+ selectLine := self lineAtY:y. "/ self visibleLineToListLine:(self visibleLineOfY:y).
+ 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
+ ]
+
+ "Modified: 18.3.1996 / 17:30:38 / cg"
+!
+
+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:selectVisibleLine.
+ self selectWordAtLine:selectLine col:selectCol
+ ]
+
+ "Modified: / 8.9.1998 / 21:22:46 / cg"
+!
+
+selectedInterval
+ "return the selection-boundaries as interval"
+
+ ^ self selectionStartIndex to:(self selectionStopIndex - 1)
+!
+
+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."
+
+ |sel|
+
+ selectionStartLine isNil ifTrue:[^ nil].
+ sel := self textFromLine:selectionStartLine col:(selectionStartCol max:1) toLine:selectionEndLine col:selectionEndCol.
+ sel notNil ifTrue:[
+ (gc characterEncoding ? #'iso10646-1' "eg unicode") ~~ #'iso10646-1' ifTrue:[
+ sel := sel encodeFrom:gc characterEncoding into:#'iso10646-1'
+ ].
+ ].
+ ^ sel
+
+ "Modified (comment): / 25-01-2012 / 00:29:09 / cg"
+!
+
+selectionAsString
+ "return the selection as a String (i.e. without emphasis)"
+
+ |sel|
+
+ (sel := self selection) isNil ifTrue:[^ nil].
+ sel := sel collect:[:each| each isNil ifTrue:[nil] ifFalse:[each string]].
+ ^ (sel asStringWithCRsFrom:1 to:(sel size) compressTabs:false withCR:false) string
+!
+
+selectionChanged
+ "can be redefined for notification or special actions"
+
+ "Modified: / 17-04-2012 / 20:59:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectionEndCol
+ ^ selectionEndCol
+!
+
+selectionEndLine
+ ^ selectionEndLine
+!
+
+selectionStartCol
+ ^ selectionStartCol
+!
+
+selectionStartLine
+ ^ selectionStartLine
+!
+
+setPrimarySelection
+ "can be redefined for notification or special actions"
+
+ self graphicsDevice notNil ifTrue:[
+ "On X11, be nice and set the PRIMARY selection.
+ (#setPrimaryText:ownerView: is void in DeviceWorkstation)"
+ self graphicsDevice setPrimaryText: self selectionAsString ownerView: self.
+ ].
+
+ "Created: / 17-04-2012 / 20:59:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+st80SelectMode
+ st80SelectMode notNil ifTrue:[^ st80SelectMode].
+ ^ self class st80SelectMode
+
+ "Created: / 03-07-2006 / 16:30:59 / cg"
+!
+
+st80SelectMode:aBoolean
+ st80SelectMode := aBoolean
+!
+
+unselect
+ "unselect - if there was a selection redraw that area"
+
+ |startLine endLine startVisLine endVisLine|
+
+ selectionStartLine notNil ifTrue:[
+ startLine := selectionStartLine.
+ endLine := selectionEndLine.
+
+ self unselectWithoutRedraw.
+
+ "/ if the 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
+
+ (startLine == endLine) ifTrue:[
+ super redrawVisibleLine:startVisLine from:selectionStartCol to:selectionEndCol
+ ] ifFalse:[
+ self redrawFromVisibleLine:startVisLine to:endVisLine
+ ].
+ ].
+ selectStyle := nil
+
+ "Modified: 29.5.1996 / 14:54:11 / cg"
+!
+
+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 (however, redraw knows about that anyway)."
+
+ selectionStartLine := selectionEndLine := nil.
+ self selectionChanged.
+!
+
+validateNewSelection
+ "make certain that the selection is valid.
+ This is a dummy here, but subclasses (like single-line editFields)
+ may redefine it to limit the selection to a single line, or whatever."
+
+ ^ self
+
+ "Modified: 29.4.1996 / 12:32:08 / cg"
+! !
+
+!TextView methodsFor:'testing'!
+
+isTextView
+ "I am showing text"
+
+ ^ true
+! !
+
+!TextView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.373.2.1 2014-05-08 08:30:56 stefan Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.373.2.1 2014-05-08 08:30:56 stefan Exp $'
+! !
+
+
+TextView initialize!