'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 15 November 2003 at 1:53:26 pm'! "Change Set: altWordJump Date: 15 November 2003 Author: Hern‡n Tylim This changeset modifies ParagrahEditor #nextWord: and #previousWord: so they will return the index of the next word inside a composed word (the meaning for a composed word would be for example this string 'aComposedWord'). As an example. Imagine that you just typed the string 'aComposedWord', and you want to change the 'Word' part. If you type CTRL+left arrow, the cursor will be at the first $a, not the $W. This changeset modifies ParagraphEditor behaviour so it can navigate inside composed words too. I made a preference for this. It is named: #useAlternativeWordJump. When installing this changeset it will be turned on. To disable do: Preferences disable: #useAlternativeWordJump " Preferences enable: #useAlternativeWordJump. ! !ParagraphEditor methodsFor: 'private' stamp: 'hpt 11/15/2003 13:37'! nextWord: position | i string | i _ position - 1 max: 1. string _ paragraph text string. [(i between: 1 and: string size - 1) and: [(self wordBreaksFrom: i to: i + 1 on: string) not]] whileTrue: [i _ i + 1]. i_i+1. [(i between: 1 and: string size - 1) and: [(string at: i) isAlphaNumeric not]] whileTrue: [i _ i + 1]. ^ i! ! !ParagraphEditor methodsFor: 'private' stamp: 'hpt 11/15/2003 13:37'! previousWord: position | string i | string _ paragraph text string. i _ position + 1 min: string size. (i > 1 and: [self wordBreaksFrom: i to: i - 1 on: string]) ifTrue: [i _ i -1]. [(i between: 2 and: string size) and: [(string at: i) isAlphaNumeric not]] whileTrue: [i _ i - 1]. [(i between: 2 and: string size) and: [(self wordBreaksFrom: i to: i - 1 on: string) not]] whileTrue: [i _ i - 1]. ^ i! ! !ParagraphEditor methodsFor: 'private' stamp: 'hpt 11/15/2003 13:42'! wordBreaksFrom: p1 to: p2 on: string (string at: p1) isAlphaNumeric = (string at: p2) isAlphaNumeric ifFalse: [^ true]. (string at: p1) isAlphaNumeric not ifTrue: [^ false]. (Preferences valueOfFlag: #useAlternativeWordJump ifAbsent: [false]) ifFalse: [^false]. (string at: p1) isLowercase & (string at: p2) isLowercase ifTrue: [^ false]. (string at: p1) isUppercase & (string at: p2) isUppercase ifTrue: [^ true]. (string at: p1) isUppercase ifTrue: [^ p1 > p2]. (string at: p2) isUppercase ifTrue: [^ p2 > p1]. ^false.! !