diff --git a/bootstrap/scripts/upload_to_files.pharo.org.sh b/bootstrap/scripts/upload_to_files.pharo.org.sh old mode 100755 new mode 100644 diff --git a/src/NECompletion-Tests/CompletionEngineTest.class.st b/src/NECompletion-Tests/CompletionEngineTest.class.st index d6d503e78a6..4d2431b875a 100644 --- a/src/NECompletion-Tests/CompletionEngineTest.class.st +++ b/src/NECompletion-Tests/CompletionEngineTest.class.st @@ -28,7 +28,8 @@ CompletionEngineTest >> editorTextWithCaret [ | source | source := editor text asString. - ^ (source copyFrom: 1 to: editor caret-1), '|', (source copyFrom: editor caret to: source size) + ^ (source copyFrom: 1 to: editor caret - 1) , '|' + , (source copyFrom: editor caret to: source size) ] { #category : 'accessing' } diff --git a/src/Rubric-Tests/RubTextEditorTest.class.st b/src/Rubric-Tests/RubTextEditorTest.class.st index 525dae35849..5b6ab55b965 100644 --- a/src/Rubric-Tests/RubTextEditorTest.class.st +++ b/src/Rubric-Tests/RubTextEditorTest.class.st @@ -17,7 +17,7 @@ Class { RubTextEditorTest >> setUp [ super setUp. - editor := RubTextEditor forTextArea: RubTextFieldArea new. + editor := RubTextEditor forTextArea: RubEditingArea new. "Add text with a paragraph" string := 'Lorem ipsum '. editor addString: string @@ -69,10 +69,7 @@ RubTextEditorTest >> testNextWord [ Should be: Lorem| ipsum" self assert: (editor nextWord: i) equals: 6 ]. - "Lorem| ipsum >> Lorem |ipsum" - self assert: (editor nextWord: 6) equals: 7. - - 7 to: 11 do: [ :i | + 6 to: 11 do: [ :i | "From: Lorem |ipsum To: Lorem ipsu|m Should be: Lorem ipsum|" @@ -85,6 +82,90 @@ RubTextEditorTest >> testNextWord [ self assert: (editor nextWord: 999) equals: textSize + 1. "Out of range" ] +{ #category : 'tests' } +RubTextEditorTest >> testNextWordAtEndOfLineGoesToStartOfFirstWordOfNextLine [ + + editor addString: 'a + a +a'. + + self assert: (editor nextWord: 2) equals: 4 +] + +{ #category : 'tests' } +RubTextEditorTest >> testNextWordAtEndOfLineGoesToStartOfNextLine [ + + editor addString: 'a + +a'. + + self assert: (editor nextWord: 2) equals: 3 +] + +{ #category : 'tests' } +RubTextEditorTest >> testNextWordAtLineWithSpacesGoesToEndOfCurrentLine [ + + editor addString: 'a + + a'. + + self assert: (editor nextWord: 2) equals: 4 +] + +{ #category : 'tests' } +RubTextEditorTest >> testNextWordAtStartOfEmptyLineGoesToStartOfNextLine [ + + editor addString: 'a + +a'. + + self assert: (editor nextWord: 3) equals: 4 +] + +{ #category : 'tests' } +RubTextEditorTest >> testNextWordAtStartOfFirstWordGoesToEndOfLine [ + + editor addString: 'a + +a'. + + self assert: (editor nextWord: 4) equals: 5 +] + +{ #category : 'tests' } +RubTextEditorTest >> testNextWordGoesToEndOfCurrentWord [ + + editor addString: 'abc d'. + + self assert: (editor nextWord: 3) equals: 4 +] + +{ #category : 'tests' } +RubTextEditorTest >> testNextWordGoesToEndOfCurrentWordWithColon [ + + "Here it is a normal text editor, do not go over colons" + editor addString: 'abc: d'. + + self assert: (editor nextWord: 3) equals: 4 +] + +{ #category : 'tests' } +RubTextEditorTest >> testNextWordGoesToEndOfCurrentWordWithColonInCode [ + + editor := RubSmalltalkEditor forTextArea: RubEditingArea new. + editor addString: 'abc: d'. + + self assert: (editor nextWord: 3) equals: 5 +] + +{ #category : 'tests' } +RubTextEditorTest >> testNextWordSkipsCurrentSpacesAndGoesToEndOfCurrentWord [ + + editor addString: 'abc d'. + + self assert: (editor nextWord: 4) equals: 6 +] + { #category : 'tests' } RubTextEditorTest >> testNextWordStopOnUpperCase [ @@ -95,24 +176,21 @@ RubTextEditorTest >> testNextWordStopOnUpperCase [ self assert: (editor nextWord: -999 stopOnUpperCase: true) equals: 3. "Out of range means start of text" self assert: (editor nextWord: 0 stopOnUpperCase: true) equals: 3. "Out of range means start of text" - 1 to: 3 do: [ :i | + 1 to: 2 do: [ :i | "From: |loRem ipSum To: lo|Rem ipSum Should be: lo|Rem ipSum " self assert: (editor nextWord: i stopOnUpperCase: true) equals: 3 ]. - 4 to: 5 do: [ :i | + 3 to: 5 do: [ :i | "From: loR|em ipSum To: loRe|m ipSum Should be: loRem| ipSum " self assert: (editor nextWord: i stopOnUpperCase: true) equals: 6 ]. - "Lorem| ipsum >> Lorem |ipsum" - self assert: (editor nextWord: 6 stopOnUpperCase: true) equals: 7. - - 7 to: 8 do: [ :i | - "From: loRem |ipSum + 6 to: 8 do: [ :i | + "From: loRem| ipSum To: loRem i|pSum Should be: loRem ip|Sum " self assert: (editor nextWord: i stopOnUpperCase: true) equals: 9 ]. @@ -140,19 +218,84 @@ RubTextEditorTest >> testPreviousWord [ 1 to: 7 do: [ :i | "From: |Lorem ipsum - To: Lorem |ipsum - Should be: |Lorem ipsum" + To: Lore|m ipsum + Should be: Lorem| ipsum" self assert: (editor previousWord: i) equals: 1 ]. - 8 to: 13 do: [ :i | + 8 to: 12 do: [ :i | "From: Lorem |ipsum - To: Lorem ipsum| - Should be: Lorem |ipsum" + To: Lorem ipsu|m + Should be: Lorem ipsum|" self assert: (editor previousWord: i) equals: 7 ]. self assert: (editor previousWord: 999) equals: 7. "Out of range" ] +{ #category : 'tests' } +RubTextEditorTest >> testPreviousWordAtEmptyLineGoesToEndOfPreviousLine [ + + editor addString: 'a + +a'. + + self assert: (editor previousWord: 3) equals: 2 +] + +{ #category : 'tests' } +RubTextEditorTest >> testPreviousWordAtEndOfFirstWordOfLineGoesToStartOfLine [ + + editor addString: 'a + +a'. + + self assert: (editor previousWord: 5) equals: 4 +] + +{ #category : 'tests' } +RubTextEditorTest >> testPreviousWordAtLineWithSpacesGoesToStartOfCurrentLine [ + + editor addString: 'a + + a'. + + self assert: (editor previousWord: 6) equals: 4 +] + +{ #category : 'tests' } +RubTextEditorTest >> testPreviousWordAtStartOfLineGoesToEndOfLastWordOfPreviousLine [ + + editor addString: 'a +a'. + + self assert: (editor previousWord: 4) equals: 2 +] + +{ #category : 'tests' } +RubTextEditorTest >> testPreviousWordAtStartOfLineGoesToPreviousLine [ + + editor addString: 'a + +a'. + + self assert: (editor previousWord: 4) equals: 3 +] + +{ #category : 'tests' } +RubTextEditorTest >> testPreviousWordGoesToStartOfCurrentWord [ + + editor addString: 'abc def'. + + self assert: (editor previousWord: 6) equals: 5 +] + +{ #category : 'tests' } +RubTextEditorTest >> testPreviousWordSkipsCurrentSpacesAndGoesToStartOfCurrentWord [ + + editor addString: 'abc def'. + + self assert: (editor previousWord: 5) equals: 1 +] + { #category : 'tests' } RubTextEditorTest >> testPreviousWordStopOnUpperCase [ @@ -190,6 +333,19 @@ RubTextEditorTest >> testPreviousWordStopOnUpperCase [ self assert: (editor previousWord: 999 stopOnUpperCase: true) equals: 9. "Out of range" ] +{ #category : 'test-selection' } +RubTextEditorTest >> testSelectFromBeginToEnd [ + + editor addString: 'a + +a'. + + editor selectMark: 1 point: 5. + self assert: editor selection equals: 'a + +a'. +] + { #category : 'tests' } RubTextEditorTest >> testSelectWord [ @@ -252,9 +408,9 @@ RubTextEditorTest >> testSelectWordMarkPoint [ self assert: editor markIndex equals: 7. self assert: editor pointIndex equals: 12. - editor selectWordMark: 9 point: 12. "Lorem ipsum dolor sit amet >> Lorem [ipsum ]dolor sit amet " + editor selectWordMark: 9 point: 12. "Lorem ipsum dolor sit amet >> Lorem [ipsum dolor] sit amet " self assert: editor markIndex equals: 7. - self assert: editor pointIndex equals: 13. + self assert: editor pointIndex equals: 18. editor selectWordMark: 3 point: 24. "Lorem ipsum dolor sit amet >> [Lorem ipsum dolor sit amet ]" self assert: editor markIndex equals: 1. diff --git a/src/Rubric/RubTextEditor.class.st b/src/Rubric/RubTextEditor.class.st index 72fd7db7870..ea678cd6561 100644 --- a/src/Rubric/RubTextEditor.class.st +++ b/src/Rubric/RubTextEditor.class.st @@ -1680,22 +1680,38 @@ RubTextEditor >> nextWord: position stopOnUpperCase: stopOnUpperCase [ "Positions go from 1 to size + 1 Position N + 1 is after the Nth character" - | string index initialIsAlphaNumeric size | - index := 1 max: position. + | string index initialIsAlphaNumeric size initialPosition | + initialPosition := 1 max: position. + index := initialPosition. string := self string. size := string size + 1. position >= size ifTrue: [ ^ size ]. + [ + index < string size and: [ + { + Character space. + Character tab } includes: (string at: index) ] ] whileTrue: [ + index := index + 1 ]. + initialIsAlphaNumeric := self isWordCharacterAt: index in: string. + index = initialPosition ifTrue: [ index := index + 1 ]. + [ - index < size and: [ - (self - isWordCharacterAt: index - in: string - except: [ :char | stopOnUpperCase and: [ char isUppercase ] ]) - = initialIsAlphaNumeric ] ] whileTrue: [ index := index + 1 ]. + | nextCharacterInDirection | + "If we reach the end" + index >= size ifTrue: [ ^ index ]. + + nextCharacterInDirection := string at: index. + nextCharacterInDirection = Character cr ifTrue: [ ^ index ]. + + (stopOnUpperCase and: [ (string at: index) isUppercase ]) ifTrue: [ + ^ index ]. + + (self isWordCharacterAt: index in: string) = initialIsAlphaNumeric ] + whileTrue: [ index := index + 1 ]. ^ index ] @@ -1847,37 +1863,39 @@ RubTextEditor >> previousWord: position [ ] { #category : 'private' } -RubTextEditor >> previousWord: position stopOnUpperCase: stopOnUpperCase [ +RubTextEditor >> previousWord: position stopOnUpperCase: stopOnUpperCase [ - | string index size beforeCaretIsAlpha afterCaretIsAlpha | - "The main strategy behind this is to move the caret backwards until there is a alpha/nonalpha or nonalpha/alpha pair. - To avoid staying in the same place, we need always move the character at least once before checking the condition" + | string index initialIsAlphaNumeric size initialPosition | + "Positions go from 1 to size + 1 + Position N + 1 is after the Nth character" + string := self string. + size := string size + 1. + initialPosition := size min: position. + index := initialPosition. position <= 2 ifTrue: [ ^ 1 ]. - string := self string. - size := string size. - - "If we ask for the word starting after the string, start at the end of the string. - Remember that there are N+1 caret positions for a N-sized string." - index := (size + 1) min: position. - - "Go backwards once and check if character before the caret is alphanumeric. - If not alphanumeric, we go backwards once more. - This handles the case when the caret is after the first character of a word, in which case we should just go once backwards. - All other cases should go backwards more than once." - index := index - 1. - beforeCaretIsAlpha := index = 1 or: [ - self isWordCharacterAt: index in: string ]. - beforeCaretIsAlpha ifFalse: [ + [ + index > 0 and: [ + { + Character space. + Character tab } includes: (string at: index - 1) ] ] whileTrue: [ index := index - 1 ]. + initialIsAlphaNumeric := self isWordCharacterAt: index - 1 in: string. + + index = initialPosition ifTrue: [ index := index - 1 ]. - "Finally, iterate backwards until the alphanumericness before and after the caret changes" [ - afterCaretIsAlpha := beforeCaretIsAlpha := index = 1 or: [ - self isWordCharacterAt: index in: string except: [ :char | stopOnUpperCase and: [ char isUppercase ] ] ]. - beforeCaretIsAlpha := index = 1 or: [ - self isWordCharacterAt: index - 1 in: string ]. - beforeCaretIsAlpha = afterCaretIsAlpha and: [ index > 1 ] ] + | nextCharacterInDirection | + "If we reach the end" + index <= 1 ifTrue: [ ^ index ]. + + nextCharacterInDirection := string at: index - 1. + nextCharacterInDirection = Character cr ifTrue: [ ^ index ]. + + (stopOnUpperCase and: [ (string at: index) isUppercase ]) ifTrue: [ + ^ index ]. + + (self isWordCharacterAt: index - 1 in: string) = initialIsAlphaNumeric ] whileTrue: [ index := index - 1 ]. ^ index ]