[Pkg] The Trunk: Morphic-cmm.570.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Aug 20 19:12:38 UTC 2011


Chris Muller uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-cmm.570.mcz

==================== Summary ====================

Name: Morphic-cmm.570
Author: cmm
Time: 17 August 2011, 10:48:32.088 pm
UUID: b521400f-04c1-4cc3-9d26-929e2a1c1c9f
Ancestors: Morphic-cmm.568

- Properly capture UndoSelection like the old TextEditor.  The recent conversion of the TextEditor to be event-based was a great piece of work, but I cannot live without important functions of the Squeak text-editor, such as Command+j, and Command+z which stopped working.
	The old design would not update the start and mark blocks until after the UndoSelection was captured.  The new design could not do that easily because the typeAhead was replaced with an KeyboardEvent.
	The solution was to make typeAhead an instance-variable, and put back the interpret-key / update-paragraph cycle back.

=============== Diff against Morphic-cmm.568 ===============

Item was changed:
  ----- Method: Editor>>cursorDown: (in category 'nonediting/nontyping keys') -----
  cursorDown: aKeyboardEvent
  	"Private - Move cursor from position in current line to same position in
  	next line. If next line too short, put at end. If shift key down,
  	select."
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self 
  		moveCursor: [:position | self
  				sameColumn: position
  				newLine: [:line | line + 1]
  				forward: true]
  		forward: true
  		event: aKeyboardEvent
  		specialBlock: [:dummy | dummy].
  	^true!

Item was changed:
  ----- Method: Editor>>cursorLeft: (in category 'nonediting/nontyping keys') -----
  cursorLeft: aKeyboardEvent
  	"Private - Move cursor left one character if nothing selected, otherwise 
  	move cursor to beginning of selection. If the shift key is down, start 
  	selecting or extending current selection. Don't allow cursor past 
  	beginning of text"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self
  		moveCursor:[:position | position - 1 max: 1]
  		forward: false
  		event: aKeyboardEvent
  		specialBlock:[:position | self previousWord: position].
  	^ true!

Item was changed:
  ----- Method: Editor>>cursorPageDown: (in category 'nonediting/nontyping keys') -----
  cursorPageDown: aKeyboardEvent
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self 
  		moveCursor: [:position |
  			self
  				sameColumn: position
  				newLine: [:lineNo | lineNo + self pageHeight]
  				forward: true]
  		forward: true
  		event: aKeyboardEvent
  		specialBlock:[:dummy | dummy].
  	^true!

Item was changed:
  ----- Method: Editor>>cursorPageUp: (in category 'nonediting/nontyping keys') -----
  cursorPageUp: aKeyboardEvent 
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self 
  		moveCursor: [:position |
  			self
  				sameColumn: position
  				newLine: [:lineNo | lineNo - self pageHeight]
  				forward: false]
  		forward: false
  		event: aKeyboardEvent
  		specialBlock:[:dummy | dummy].
  	^true!

Item was changed:
  ----- Method: Editor>>cursorRight: (in category 'nonediting/nontyping keys') -----
  cursorRight: aKeyboardEvent 
  	"Private - Move cursor right one character if nothing selected, 
  	otherwise move cursor to end of selection. If the shift key is down, 
  	start selecting characters or extending already selected characters. 
  	Don't allow cursor past end of text"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self
  		moveCursor: [:position | position + 1]
  		forward: true
  		event: aKeyboardEvent
  		specialBlock:[:position | self nextWord: position].
  	^ true!

Item was changed:
  ----- Method: Editor>>cursorUp: (in category 'nonediting/nontyping keys') -----
  cursorUp: aKeyboardEvent 
  	"Private - Move cursor from position in current line to same position in
  	prior line. If prior line too short, put at end"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self
  		moveCursor: [:position | self
  				sameColumn: position
  				newLine:[:line | line - 1]
  				forward: false]
  		forward: false
  		event: aKeyboardEvent
  		specialBlock:[:dummy | dummy].
  	^true!

Item was changed:
  ----- Method: Editor>>paste: (in category 'editing keys') -----
  paste: aKeyboardEvent 
  	"Replace the current text selection by the text in the shared buffer."
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self paste.
  	^true!

Item was changed:
  ----- Method: Editor>>selectAll: (in category 'typing/selecting keys') -----
  selectAll: aKeyboardEvent 
  	"select everything, invoked by cmd-a.  1/17/96 sw"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self selectFrom: 1 to: self string size.
  	^ true!

Item was changed:
  ----- Method: Editor>>selectWord: (in category 'nonediting/nontyping keys') -----
  selectWord: aKeyboardEvent
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self selectWord.
  	^ true!

Item was changed:
  Editor subclass: #TextEditor
+ 	instanceVariableNames: 'model paragraph markBlock pointBlock beginTypeInIndex emphasisHere lastParenLocation otherInterval oldInterval typeAhead'
- 	instanceVariableNames: 'model paragraph markBlock pointBlock beginTypeInIndex emphasisHere lastParenLocation otherInterval oldInterval'
  	classVariableNames: 'AutoEnclose AutoIndent ChangeText FindText UndoInterval UndoMessage UndoParagraph UndoSelection Undone'
  	poolDictionaries: ''
  	category: 'Morphic-Text Support'!
  TextEditor class
  	instanceVariableNames: 'cmdActions shiftCmdActions yellowButtonMenu shiftedYellowButtonMenu'!
  
  !TextEditor commentStamp: '<historical>' prior: 0!
  See comment in Editor.
  
  My instances edit Text, this is, they support multiple lines and TextAttributes.
  They have no specific facilities for editing Smalltalk code. Those are found in SmalltalkEditor.!
  TextEditor class
  	instanceVariableNames: 'cmdActions shiftCmdActions yellowButtonMenu shiftedYellowButtonMenu'!

Item was changed:
  ----- Method: TextEditor>>addString: (in category 'typing support') -----
  addString: aString
+ 	self typeAhead nextPutAll: aString!
- 	"Think of a better name"
- 
- 	self zapSelectionWith: aString!

Item was changed:
  ----- Method: TextEditor>>againOnce: (in category 'private') -----
  againOnce: indices
  	"Find the next occurrence of FindText.  If none, answer false.
  	Append the start index of the occurrence to the stream indices, and, if
  	ChangeText is not the same object as FindText, replace the occurrence by it.
  	Note that the search is case-sensitive for replacements, otherwise not."
  
  	| where |
  	where := self text
  				findString: FindText
  				startingAt: self stopIndex
  				caseSensitive: ((ChangeText ~~ FindText) or: [Preferences caseSensitiveFinds]).
  	where = 0 ifTrue: [^ false].
  
+ 	self deselect; selectInvisiblyFrom: where to: where + FindText size - 1.	"Repeat it here. Senders beware: only one of these should last"
- 	self selectInvisiblyFrom: where to: where + FindText size - 1.	"Repeat it here. Senders beware: only one of these should last"
  
  	ChangeText ~~ FindText ifTrue: [ self zapSelectionWith: ChangeText ].
  	indices nextPut: where.
  	^ true!

Item was changed:
  ----- Method: TextEditor>>argAdvance: (in category 'typing/selecting keys') -----
  argAdvance: aKeyboardEvent
  	"Invoked by Ctrl-a.  Useful after Ctrl-q.
  	 Search forward from the end of the selection for a colon followed by
  		a space.  Place the caret after the space.  If none are found, place the
  		caret at the end of the text.  Does not affect the undoability of the 
  	 	previous command."
  
  	| start |
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	start := paragraph text findString: ': ' startingAt: self stopIndex.
  	start = 0 ifTrue: [start := paragraph text size + 1].
  	self selectAt: start + 2.
  	^true!

Item was changed:
  ----- Method: TextEditor>>backTo: (in category 'typing support') -----
  backTo: startIndex
  	"During typing, backspace to startIndex.  Deleted characters fall into three
  	 clusters, from left to right in the text: (1) preexisting characters that were
  	 backed over; (2) newly typed characters that were backed over;
  	(3) preexisting characters that
  	 were highlighted before typing began.  If typing has not yet been opened,
  	 open it and watch for the first and third cluster.  If typing has been opened,
  	 watch for the first and second cluster.  Save characters from the first and third
  	 cluster in UndoSelection.  Tally characters from the first cluster in UndoMessage's parameter.
  	 Delete all the clusters.  Do not alter Undoer or UndoInterval (except via
  	 openTypeIn).  The code is shorter than the comment."
  
  	| saveLimit newBackovers |
  	saveLimit := beginTypeInIndex
  		ifNil: [self openTypeIn. UndoSelection := self nullText. self stopIndex].
  	markBlock := paragraph characterBlockForIndex: startIndex.
  	startIndex < saveLimit ifTrue: [
  		newBackovers := beginTypeInIndex - startIndex.
  		beginTypeInIndex := self startIndex.
  		UndoSelection replaceFrom: 1 to: 0 with:
  			(self text copyFrom: startIndex to: saveLimit - 1).
  		UndoMessage arguments size > 0 ifTrue: [
  			UndoMessage argument: (UndoMessage argument ifNil: [1]) + newBackovers]].
  	self zapSelectionWith: self nullText.
+ 	self unselect!
- 	markBlock := pointBlock!

Item was changed:
  ----- Method: TextEditor>>changeEmphasis: (in category 'editing keys') -----
  changeEmphasis: aKeyboardEvent 
  	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."
  
  	"control 0..9 -> 0..9"
  
  	| keyCode attribute oldAttributes index thisSel colors extras |
  	keyCode := ('0123456789-=' indexOf: aKeyboardEvent keyCharacter ifAbsent: [1]) - 1.
  	oldAttributes := paragraph text attributesAt: self pointIndex.
  	thisSel := self selection.
  
  	"Decipher keyCodes for Command 0-9..."
  	(keyCode between: 1 and: 5) 
  		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
  
  	keyCode = 6 
  		ifTrue: [
  			colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
  			extras := self emphasisExtras.
  			index := UIManager default chooseFrom:colors , #('choose color...' ), extras
  						lines: (Array with: colors size + 1).
  			index = 0 ifTrue: [^true].
  			index <= colors size 
  				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
  				ifFalse: [
  					index := index - colors size - 1.	"Re-number!!!!!!"
  					index = 0 
  						ifTrue: [attribute := self chooseColor]
  						ifFalse:[^self handleEmphasisExtra: index with: aKeyboardEvent]	"handle an extra"]].
  	(keyCode between: 7 and: 11) 
  		ifTrue: [
  			aKeyboardEvent shiftPressed 
  				ifTrue: [
  					keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
  					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
  				ifFalse: [
  					attribute := TextEmphasis 
  								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
  					oldAttributes 
  						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
  	keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
  	attribute ifNotNil: [
  		thisSel size = 0
  			ifTrue: [
  				"only change emphasisHere while typing"
+ 				self insertTypeAhead.
  				emphasisHere := Text addAttribute: attribute toArray: oldAttributes ]
  			ifFalse: [
  				self replaceSelectionWith: (thisSel asText addAttribute: attribute) ]].
  	^true!

Item was changed:
  ----- Method: TextEditor>>changeStyle: (in category 'typing/selecting keys') -----
  changeStyle: aKeyboardEvent 
  	"Put up the style-change menu"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self changeStyle.
  	^ true!

Item was removed:
- ----- Method: TextEditor>>cursorDown: (in category 'nonediting/nontyping keys') -----
- cursorDown: aKeyboardEvent 
- 
- 	"Private - Move cursor from position in current line to same position in
- 	next line. If next line too short, put at end. If shift key down,
- 	select."
- 	self closeTypeIn.
- 	self 
- 		moveCursor:[:position | self
- 				sameColumn: position
- 				newLine:[:line | line + 1]
- 				forward: true]
- 		forward: true
- 		event: aKeyboardEvent
- 		specialBlock:[:dummy | dummy].
- 	^true!

Item was changed:
  ----- Method: TextEditor>>cursorEnd: (in category 'nonediting/nontyping keys') -----
  cursorEnd: aKeyboardEvent 
  
  	"Private - Move cursor end of current line."
  	| string |
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	string := paragraph text string.
  	self
  		moveCursor:
  			[:position | Preferences wordStyleCursorMovement
  				ifTrue:[| targetLine |
  					targetLine := paragraph lines at:(paragraph lineIndexOfCharacterIndex: position).
  					targetLine = paragraph lastLine
  						ifTrue:[targetLine last + 1]
  						ifFalse:[targetLine last]]
  				ifFalse:[
  					string
  						indexOfAnyOf: CharacterSet crlf
  						startingAt: position
  						ifAbsent:[string size + 1]]]
  		forward: true
  		event: aKeyboardEvent
  		specialBlock:[:dummy | string size + 1].
  	^true!

Item was added:
+ ----- Method: TextEditor>>destructiveBackWord: (in category 'typing/selecting keys') -----
+ destructiveBackWord: aKeyboardEvent
+ 	typeAhead isEmpty
+ 		ifTrue: [ super destructiveBackWord: aKeyboardEvent ]
+ 		ifFalse: [ typeAhead reset ].
+ 	^ false!

Item was changed:
  ----- Method: TextEditor>>dispatchOnEnterWith: (in category 'typing support') -----
  dispatchOnEnterWith: aKeyboardEvent
  	"Enter key hit.  Treat is as an 'accept', viz a synonym for cmd-s.  If cmd key is down, treat is as a synonym for print-it. "
  
  	aKeyboardEvent commandKeyPressed
  		ifTrue:
  			[self printIt.]
  		ifFalse: 
+ 			[self insertAndCloseTypeIn.
- 			[self closeTypeIn.
  			self accept].
  	^ true!

Item was changed:
  ----- Method: TextEditor>>dispatchOnKeyboardEvent: (in category 'typing support') -----
  dispatchOnKeyboardEvent: aKeyboardEvent
  	"Carry out the action associated with this character, if any.
  	Type-ahead is passed so some routines can flush or use it."
  
  	| honorCommandKeys openers closers result |
  	(aKeyboardEvent keyCharacter == Character cr and: [ morph acceptOnCR ])
  		ifTrue: [ 
  			self closeTypeIn.
  			^ true ].
  	self clearParens.
  	aKeyboardEvent keyValue = 13
  		ifTrue: [ 
  			aKeyboardEvent controlKeyPressed
  				ifTrue: [ ^ self normalCharacter: aKeyboardEvent ].
  			aKeyboardEvent shiftPressed
  				ifTrue: [ ^ self lf: aKeyboardEvent ].
  			aKeyboardEvent commandKeyPressed
  				ifTrue: [ ^ self crlf: aKeyboardEvent ].
  			^ self crWithIndent: aKeyboardEvent ].
  	((honorCommandKeys := Preferences cmdKeysInText) and: [ aKeyboardEvent keyCharacter = Character enter ])
  		ifTrue: [ ^ self dispatchOnEnterWith: aKeyboardEvent ].	"Special keys overwrite crtl+key combinations - at least on Windows. To resolve this
  	conflict, assume that keys other than cursor keys aren't used together with Crtl."
  	((self class specialShiftCmdKeys includes: aKeyboardEvent keyValue) and: [ aKeyboardEvent keyValue < 27 ])
  		ifTrue: [ 
  			^ aKeyboardEvent controlKeyPressed
  				ifTrue: [ self perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ]
  				ifFalse: [ self perform: (self class cmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ] ].	"backspace, and escape keys (ascii 8 and 27) are command keys"
  	((honorCommandKeys and: [ aKeyboardEvent commandKeyPressed ])
  		or: [ self class specialShiftCmdKeys includes: aKeyboardEvent keyValue ])
  		ifTrue: [ 
  			^ aKeyboardEvent shiftPressed
  				ifTrue: [ self perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ]
  				ifFalse: [ self perform: (self class cmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ] ].	"the control key can be used to invoke shift-cmd shortcuts"
  	(honorCommandKeys and: [ aKeyboardEvent controlKeyPressed ])
+ 		ifTrue: [ ^ self perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ].
- 		ifTrue: [^ self perform: (self class shiftCmdActions at: (aKeyboardEvent keyValue + 1)) with: aKeyboardEvent ].
  	openers := '([{'.
  	closers := ')]}'.
  	result := self normalCharacter: aKeyboardEvent.
  	(closers includes: aKeyboardEvent keyCharacter)
  		ifTrue: [ self blinkPrevParen: aKeyboardEvent ].
  	(self class autoEnclose and: [ openers includes: aKeyboardEvent keyCharacter ])
  		ifTrue: [ 
+ 			self 
+ 				addString: (closers at: (openers indexOf: aKeyboardEvent keyCharacter)) asString;  
+ 				insertTypeAhead ;
+ 
+ 				moveCursor: [ :position | position - 1 ] 
+ 				forward: false 
+ 				select: false ].
- 			markBlock := pointBlock.
- 			self addString: (closers at: (openers indexOf: aKeyboardEvent keyCharacter)) asString.
- 			markBlock := pointBlock.
- 			self moveCursor: [ :position | position - 1 ] forward: false select: false	"no special behavior" ].
  	^ result!

Item was changed:
  ----- Method: TextEditor>>doAgainMany: (in category 'typing/selecting keys') -----
  doAgainMany: aKeyboardEvent 
  	"Do the previous thing again repeatedly. 1/26/96 sw"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self againOrSame: (UndoMessage sends: #undoAgain:andReselect:typedKey:) many: true.
  	^ true!

Item was changed:
  ----- Method: TextEditor>>doAgainOnce: (in category 'typing/selecting keys') -----
  doAgainOnce: aKeyboardEvent 
  	"Do the previous thing again once. 1/26/96 sw"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self again.
  	^ true!

Item was changed:
  ----- Method: TextEditor>>exchange: (in category 'editing keys') -----
  exchange: eKeyboardEvent
  	"Exchange the current and prior selections.  Keeps typeahead."
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self exchange.
  	^true!

Item was changed:
  ----- Method: TextEditor>>find: (in category 'typing/selecting keys') -----
  find: aKeyboardEvent
  	"Prompt the user for what to find, then find it, searching from the current selection onward.  1/24/96 sw"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self find.
  	^ true!

Item was changed:
  ----- Method: TextEditor>>findAgain: (in category 'typing/selecting keys') -----
  findAgain: aKeyboardEvent 
  	"Find the desired text again.  1/24/96 sw"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self againOrSame: true many: aKeyboardEvent shiftPressed.
  	^ true!

Item was added:
+ ----- Method: TextEditor>>insertAndCloseTypeIn (in category 'typing support') -----
+ insertAndCloseTypeIn
+ 	self
+ 		insertTypeAhead ;
+ 		closeTypeIn!

Item was added:
+ ----- Method: TextEditor>>insertTypeAhead (in category 'typing support') -----
+ insertTypeAhead
+ 	self typeAhead position = 0 ifFalse:
+ 		[self zapSelectionWith: (Text string: self typeAhead contents emphasis: emphasisHere).
+ 		self typeAhead reset.
+ 		self unselect]!

Item was changed:
  ----- Method: TextEditor>>keyStroke: (in category 'events') -----
  keyStroke: anEvent
+  	self resetTypeAhead; deselect.
-  	self deselect.
  	(self dispatchOnKeyboardEvent: anEvent) 
  		ifTrue:
  			[self doneTyping.
  			self storeSelectionInParagraph.
  			^self].
  	self openTypeIn.
  	self hasSelection ifTrue: [ "save highlighted characters"
  		UndoSelection := self selection].
+ 	self 
+ 		zapSelectionWith: self typeAhead contents ; 
+ 		resetTypeAhead ;
+ 		unselect ;
+ 		storeSelectionInParagraph!
- 	markBlock := pointBlock.
- 	self storeSelectionInParagraph!

Item was changed:
  ----- Method: TextEditor>>offerFontMenu: (in category 'editing keys') -----
  offerFontMenu: aKeyboardEvent 
  	"The user typed the command key that requests a font change; Offer the font menu.  5/27/96 sw"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self offerFontMenu.
  	^ true!

Item was changed:
  ----- Method: TextEditor>>pasteInitials: (in category 'editing keys') -----
  pasteInitials: aKeyboardEvent 
  	"Replace the current text selection by an authorship name/date stamp; invoked by cmd-shift-v, easy way to put an authorship stamp in the comments of an editor."
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self replace: self selectionInterval with: (Text fromString: Utilities changeStamp) and: [self selectAt: self stopIndex].
  	^ true!

Item was changed:
  ----- Method: TextEditor>>querySymbol: (in category 'typing/selecting keys') -----
  querySymbol: aKeyboardEvent
  	"Invoked by Ctrl-q to query the Symbol table and display alternate symbols.
  	 See comment in completeSymbol:lastOffering: for details."
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self hasCaret
  		ifTrue: "Ctrl-q typed when a caret"
  			[self perform: #completeSymbol:lastOffering: withArguments:
  				((UndoParagraph == paragraph and: [UndoMessage sends: #undoQuery:lastOffering:])
  					ifTrue: [UndoMessage arguments] "repeated Ctrl-q"
  					ifFalse: [Array with: nil with: nil])] "initial Ctrl-q"
  		ifFalse: "Ctrl-q typed when statements were highlighted"
  			[morph flash].
  	^true!

Item was added:
+ ----- Method: TextEditor>>resetTypeAhead (in category 'private') -----
+ resetTypeAhead
+ 	typeAhead := WriteStream on: (String new: 1)!

Item was changed:
  ----- Method: TextEditor>>save: (in category 'editing keys') -----
  save: aKeyboardEvent
  	"Submit the current text.  Equivalent to 'accept' 1/18/96 sw"
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self accept.
  	^ true!

Item was changed:
  ----- Method: TextEditor>>search: (in category 'typing/selecting keys') -----
  search: aKeyboardEvent
  	"Invoked by Ctrl-S.  Same as 'again', but always uses the existing FindText
  	 and ChangeText regardless of the last edit."
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self
  		againOrSame: true "true means use same keys"
  		many: aKeyboardEvent shiftPressed.
  	^true!

Item was changed:
  ----- Method: TextEditor>>selectCurrentTypeIn: (in category 'nonediting/nontyping keys') -----
  selectCurrentTypeIn: aKeyboardEvent 
  	"Select what would be replaced by an undo (e.g., the last typeIn)."
  
  	| prior |
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	prior := otherInterval.
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self selectInterval: UndoInterval.
  	otherInterval := prior.
  	^ true!

Item was changed:
  ----- Method: TextEditor>>setSearchString: (in category 'nonediting/nontyping keys') -----
  setSearchString: aKeyboardEvent
  	"Establish the current selection as the current search string."
  
  	| aString |
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self lineSelectAndEmptyCheck: [^ true].
  	aString :=  self selection string.
  	aString size = 0
  		ifTrue:
  			[self flash]
  		ifFalse:
  			[self setSearch: aString].
  	^ true!

Item was added:
+ ----- Method: TextEditor>>typeAhead (in category 'private') -----
+ typeAhead
+ 	^ typeAhead ifNil:
+ 		[ self resetTypeAhead.
+ 		typeAhead ]!

Item was changed:
  ----- Method: TextEditor>>undo: (in category 'editing keys') -----
  undo: aKeyboardEvent 
  	"Undo the last edit."
  
+ 	self insertAndCloseTypeIn.
- 	self closeTypeIn.
  	self undo.
  	^true!

Item was added:
+ ----- Method: TextEditor>>unselect (in category 'accessing-selection') -----
+ unselect
+ 	markBlock := pointBlock copy!



More information about the Packages mailing list