hg/stx-libwidg: comparison EditTextView.st

equal deleted inserted replaced

-:7abd3a234296
+:3ffa271732f7
 TextView subclass:#EditTextView
 	 instanceVariableNames:'cursorLine cursorVisibleLine cursorCol cursorShown
 		prevCursorState readOnly modified fixedSize exceptionBlock
 		errorMessage cursorFgColor cursorBgColor cursorType undoAction
 		typeOfSelection lastString lastReplacement lastAction replacing
-		showMatchingParenthesis hasKeyboardFocus'
+		showMatchingParenthesis hasKeyboardFocus acceptAction lockUpdates'
 	 classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
 		DefaultCursorType'
 	 poolDictionaries:''
 	 category:'Views-Text'
 !
 EditTextView comment:'
 COPYRIGHT (c) 1989 by Claus Gittinger
 	    All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.26 1995-05-07 01:58:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.27 1995-05-09 01:55:23 claus Exp $
 '!
 !EditTextView class methodsFor:'documentation'!
 copyright
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.26 1995-05-07 01:58:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.27 1995-05-09 01:55:23 claus Exp $
 "
 !
 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 moth changeMsg and acceptAction)
 Instance variables:
 cursorLine              <Number>        line where cursor sits (1..)
 cursorVisibleLine       <Number>        visible line where cursor sits (1..nLinesShown)
 DefaultCursorForegroundColor := StyleSheet colorAt:'textCursorForegroundColor'.
 DefaultCursorBackgroundColor := StyleSheet colorAt:'textCursorBackgroundColor'.
 DefaultCursorType := StyleSheet at:'textCursorType' default:#block.
 ! !
+!EditTextView methodsFor:'change & update '!
+getListFromModel
+"get my contents from the model.
+Redefined to ignore updates resulting from my own change."
+"
+ignore updates from my own change
+"
+lockUpdates ifTrue:[
+	lockUpdates := false.
+	^ self
+].
+^ super getListFromModel
+!
+accept
+"accept the current contents by executing the accept-action and/or
+changeMessage."
+lockUpdates := true.
+"/
+"/ 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
+].
+"/
+"/ ST-80 way of doing it
+"/
+self sendChangeMessageWith:self contents.
+lockUpdates := false.
+! !
 !EditTextView methodsFor:'event processing'!
 hasKeyboardFocus:aBoolean
 "sent by a delegate to make me show a block cursor
 (otherwise, I would not know about this)"
 ]
 !
 keyPress:key x:x y:y
 "handle keyboard input"
+|sensor n|
+sensor := self sensor.
 (key isMemberOf:Character) ifTrue:[
 	readOnly ifFalse:[
 	    typeOfSelection == #paste ifTrue:[
 		"pasted selection will NOT be replaced by keystroke"
 "
 Fn      pastes a key-sequence (but only if not overlayed with
 	     another function in the keyboard map)
-see TextView>>keyPress:x:y
+see TextView>>:x:y
 "
 (#(F1 F2 F3 F4 F5 F6 F7 F8 F9) includes:key) ifTrue:[
 	device shiftDown ifFalse:[
 	    (Smalltalk at:#FunctionKeySequences) notNil ifTrue:[
 		self paste:((Smalltalk at:#FunctionKeySequences) at:key) asStringCollection.
 		cursorVisibleLine := self listLineToVisibleLine:cursorLine.
 	    ].
 	    self makeCursorVisible
 	].
 	self unselect.
-	self cursorDown. ^self
+	sensor isNil ifTrue:[
+	    n := 1
+	] ifFalse:[
+	    n := 1 + (sensor compressKeyPressEventsWithKey:#CursorDown).
+	].
+	self cursorDown:n.
+	^ self
 ].
 (key == #CursorLeft or:[key == #CursorUp]) ifTrue:[
 	selectionStartLine notNil ifTrue:[
 	    cursorLine := selectionStartLine.
 	    cursorVisibleLine := self listLineToVisibleLine:cursorLine.
 	self unselect.
 	(key == #CursorLeft) ifTrue:[
 	    self cursorLeft. ^self
 	].
 	(key == #CursorUp)        ifTrue:[
-	    self cursorUp. ^self
+	    sensor isNil ifTrue:[
+		n := 1
+	    ] ifFalse:[
+		n := 1 + (sensor compressKeyPressEventsWithKey:#CursorUp).
+	    ].
+	    self cursorUp:n.
+	    ^ self
 	].
 ].
 (key == #Return)    ifTrue:[
 	device shiftDown ifTrue:[
 self drawCursor:cursorType with:cursorFgColor and:cursorBgColor.
 !
 drawCursor:cursorType with:fgColor and:bgColor
 "draw a cursor; the argument cursorType specifies what type
-of cursor should be drawn."
+of cursor should be drawn.
+Currently, supported are: #block, #frame, #ibeam, #caret and #solidCaret"
 |x y w char y2 x1 x2|
 self hasSelection ifTrue:[
 	"
 x2 := x + w.
 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:[
-cursorType == #solidCaret ifTrue:[
+	"anything else: solidCaret"
-	self fillPolygon:(Array with:(x1 @ y2)
-				with:(x @ y)
+"/        cursorType == #solidCaret ifTrue:[
-				with:(x1 @ y2))
+	    self fillPolygon:(Array with:(x1 @ y2)
+				    with:(x @ y)
+				    with:(x2 @ y2))
+"/        ]
 ].
 !
 cursorReturn
 "move cursor to start of next line; scroll if at end of visible text"
 !
 cursorUp
 "move cursor up; scroll if at start of visible text"
-|wasOn|
+self cursorUp:1
+!
-(cursorLine == 1) ifFalse: [
-	cursorLine isNil ifTrue:[
+cursorUp:n
-	    cursorLine := firstLineShown + nFullLinesShown - 1.
+"move cursor up n lines; scroll if at start of visible text"
-	].
+|wasOn nv nl|
+cursorLine isNil ifTrue:[
+	cursorLine := firstLineShown + nFullLinesShown - 1.
+].
+nl := cursorLine - n.
+nl < 1 ifTrue:[nl := 1].
+(nl ~~ cursorLine) ifTrue: [
 	wasOn := self hideCursor.
-	(cursorVisibleLine == 1) ifTrue:[self scrollUp].
+	cursorVisibleLine notNil ifTrue:[
-	cursorLine := cursorLine - 1.
+	    nv := cursorVisibleLine - n.
+	    nv < 1 ifTrue:[
+		self scrollUp:(nv negated + 1)
+	    ].
+	].
+	cursorLine := nl.
 	cursorVisibleLine := self listLineToVisibleLine:cursorLine.
 	wasOn ifTrue:[self showCursor].
 "/
 "/ to make cursor visible (even if below visible end):
 "/
 !
 cursorDown
 "move cursor down; scroll if at end of visible text"
-|wasOn|
+self cursorDown:1
+!
+cursorDown:n
+"move cursor down by n lines; scroll if at end of visible text"
+|wasOn nv|
 cursorVisibleLine notNil ifTrue:[
 	wasOn := self hideCursor.
-	(cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown].
+	nv := cursorVisibleLine + n - 1.
-	cursorLine := cursorLine + 1.
+	(nv >= nFullLinesShown) ifTrue:[
+	    self scrollDown:(nv - nFullLinesShown + 1)
+	].
+	cursorLine := cursorLine + n.
 	cursorVisibleLine := self listLineToVisibleLine:cursorLine.
 	wasOn ifTrue:[self showCursor].
 ] ifFalse:[
 	cursorLine isNil ifTrue:[
 	    cursorLine := firstLineShown
 	].
-	cursorLine := cursorLine + 1.
+	cursorLine := cursorLine + n.
 	cursorVisibleLine := self listLineToVisibleLine:cursorLine.
 	self makeCursorVisible.
 ].
 !
 self makeLineVisible:aLineNumber.
 self cursorLine:aLineNumber col:1
 ! !
-!EditTextView methodsFor:'accessing'!
+!EditTextView methodsFor:'accessing-behavior'!
+acceptAction:aBlock
+"set the action to be performed on accept"
+acceptAction := aBlock
+!
+acceptAction
+"return the action to be performed on accept (or nil)"
+^ acceptAction
+!
+exceptionBlock:aBlock
+"define the action to be triggered when user tries to modify
+readonly text"
+exceptionBlock := aBlock
+! !
+!EditTextView methodsFor:'accessing-contents'!
 characterUnderCursor
 "return the character under the cursor - space if behond line.
 For non-block cursors, this is the character immediately to the right
 of the insertion-bar or caret."
 	middleButtonMenu disable:#cut.
 	middleButtonMenu disable:#paste.
 	middleButtonMenu disable:#replace.
 	middleButtonMenu disable:#indent
 ]
-!
-exceptionBlock:aBlock
-"define the action to be triggered when user tries to modify
-readonly text"
-exceptionBlock := aBlock
 !
 fromFile:aFileName
 "take contents from a named file"
 	self unselect
 ] ifFalse:[
 	super selectFromLine:cursorLine col:cursorCol toLine:(list size + 1) col:0.
 	typeOfSelection := nil
 ]
+! !
+!EditTextView methodsFor:'queries'!
+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|
+w := super widthOfContents.
+^ w + (font widthOf:' ')
 ! !
 !EditTextView methodsFor:'private'!
 textChanged
 wasOn := self hideCursor.
 self insert:aCharacter atLine:cursorLine col:cursorCol.
 aCharacter == (Character cr) ifTrue:[
 	self cursorReturn
 ] ifFalse:[
-	cursorCol := cursorCol + 1
+	self cursorRight.
 ].
 self makeCursorVisibleAndShowCursor:wasOn.
 !
 insertString:aString atLine:lineNr col:colNr
 (cursorCol == 1) ifFalse:[
 	"
 	 somewhere in the middle of a line
 	"
-	cursorCol := cursorCol - 1.
+	self cursorLeft.
 	self deleteCharAtLine:cursorLine col:cursorCol.
 ] ifTrue:[
 	"
 	 at begin of line - merge with previous line;
 	 except for the very first line.
 initStyle
 "initialize style specific stuff"
 super initStyle.
+lockUpdates := false.
 cursorFgColor := DefaultCursorForegroundColor.
 cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
 cursorBgColor := DefaultCursorBackgroundColor.
 cursorBgColor isNil ifTrue:[cursorBgColor := fgColor].
 cursorType := DefaultCursorType.
 ].
 ^ m.
 ! !
 !EditTextView methodsFor:'menu actions'!
-accept
-"accept the contents"
-|value|
-value := self contents.
-"model-view behavior"
-self sendChangeMessageWith:value.
-!
 paste:someText
 "paste someText at cursor"
 |s startLine startCol|
 						       toLine:line col:col
 				      ]
 			   ifNotFound:[self showNotFound]
 			      onError:[device beep]
 ! !

changeset 125	3ffa271732f7
parent 123	25ab7ade4d3a
child 127	462396b08e30