--- a/ETxtView.st Mon May 08 17:19:27 1995 +0200
+++ b/ETxtView.st Tue May 09 03:57:16 1995 +0200
@@ -17,7 +17,7 @@
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:''
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.26 1995-05-07 01:58:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.27 1995-05-09 01:55:23 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -49,13 +49,20 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.26 1995-05-07 01:58:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.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:
@@ -104,6 +111,45 @@
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
@@ -178,6 +224,10 @@
keyPress:key x:x y:y
"handle keyboard input"
+ |sensor n|
+
+ sensor := self sensor.
+
(key isMemberOf:Character) ifTrue:[
readOnly ifFalse:[
typeOfSelection == #paste ifTrue:[
@@ -235,7 +285,7 @@
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:[
@@ -301,7 +351,14 @@
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:[
@@ -315,7 +372,13 @@
self cursorLeft. ^self
].
(key == #CursorUp) ifTrue:[
- self cursorUp. ^self
+ sensor isNil ifTrue:[
+ n := 1
+ ] ifFalse:[
+ n := 1 + (sensor compressKeyPressEventsWithKey:#CursorUp).
+ ].
+ self cursorUp:n.
+ ^ self
].
].
@@ -563,7 +626,8 @@
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|
@@ -611,11 +675,14 @@
self lineWidth:2.
self displayLineFromX:x1 y:y2 toX:x y:y.
self displayLineFromX:x y:y toX:x2 y:y2.
- ].
- cursorType == #solidCaret ifTrue:[
- self fillPolygon:(Array with:(x1 @ y2)
- with:(x @ y)
- with:(x1 @ y2))
+ ] ifFalse:[
+ "anything else: solidCaret"
+
+"/ cursorType == #solidCaret ifTrue:[
+ self fillPolygon:(Array with:(x1 @ y2)
+ with:(x @ y)
+ with:(x2 @ y2))
+"/ ]
].
!
@@ -678,15 +745,29 @@
cursorUp
"move cursor up; scroll if at start of visible text"
- |wasOn|
-
- (cursorLine == 1) ifFalse: [
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown + nFullLinesShown - 1.
+ self cursorUp:1
+!
+
+cursorUp:n
+ "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 notNil ifTrue:[
+ nv := cursorVisibleLine - n.
+ nv < 1 ifTrue:[
+ self scrollUp:(nv negated + 1)
+ ].
].
- wasOn := self hideCursor.
- (cursorVisibleLine == 1) ifTrue:[self scrollUp].
- cursorLine := cursorLine - 1.
+ cursorLine := nl.
cursorVisibleLine := self listLineToVisibleLine:cursorLine.
wasOn ifTrue:[self showCursor].
"/
@@ -718,19 +799,28 @@
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].
- cursorLine := cursorLine + 1.
+ nv := cursorVisibleLine + n - 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.
].
@@ -851,7 +941,28 @@
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.
@@ -932,13 +1043,6 @@
]
!
-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"
@@ -1087,6 +1191,20 @@
]
! !
+!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
@@ -1341,7 +1459,7 @@
aCharacter == (Character cr) ifTrue:[
self cursorReturn
] ifFalse:[
- cursorCol := cursorCol + 1
+ self cursorRight.
].
self makeCursorVisibleAndShowCursor:wasOn.
!
@@ -1988,7 +2106,7 @@
"
somewhere in the middle of a line
"
- cursorCol := cursorCol - 1.
+ self cursorLeft.
self deleteCharAtLine:cursorLine col:cursorCol.
] ifTrue:[
"
@@ -2171,6 +2289,8 @@
"initialize style specific stuff"
super initStyle.
+ lockUpdates := false.
+
cursorFgColor := DefaultCursorForegroundColor.
cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
cursorBgColor := DefaultCursorBackgroundColor.
@@ -2279,17 +2399,6 @@
!EditTextView methodsFor:'menu actions'!
-accept
- "accept the contents"
-
- |value|
-
- value := self contents.
-
- "model-view behavior"
- self sendChangeMessageWith:value.
-!
-
paste:someText
"paste someText at cursor"
@@ -2798,4 +2907,3 @@
ifNotFound:[self showNotFound]
onError:[device beep]
! !
-