suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Tweak auto-parens behavior of double quote typed in a string

Browse Source 
so that it results in the string split into two strings or,
in case part of the string is already selected, three strings,
where the selection is retained in the latter situation.
This commit is contained in:
Nadeem Abdul Hamid 2013-05-23 16:29:31 -04:00 committed by Robby Findler
parent 803f1db884
commit b71e44ea9a
2 changed files with 127 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
collects/framework/private/racket.rkt
View File

@ -1358,11 +1358,15 @@
actual-type) actual-type)
;; determines if the cursor is currently sitting in a string ;; in-position? : text (list symbol) -> boolean
;; literal or a comment. To do this more accurately, first ;; determines if the cursor is currently sitting in a particular
;; insert a space at the current cursor start position, then ;; position. To do this more accurately, first
;; check what classification of that space character itself ;; insert a space at the current cursor start position, then
(define (in-string/comment? text) ;; check what classification of that space character itself
;; (note: the place where this shows up is if the cursor is
;; right in front of the quotes of a string literal, i.e.
;; |"...." where | indicates cursor position)
(define (in-position? text sym-list)
(define selection-start (send text get-start-position)) (define selection-start (send text get-start-position))
(define selection-end (send text get-end-position)) (define selection-end (send text get-end-position))
(send text begin-edit-sequence #t #f) (send text begin-edit-sequence #t #f)
@ -1372,19 +1376,23 @@
(send text end-edit-sequence) (send text end-edit-sequence)
(send text undo) ; to avoid messing up the editor's modified state (send text undo) ; to avoid messing up the editor's modified state
; in case of a simple skip ; in case of a simple skip
(and (member type '(comment string)) #t)) (and (member type sym-list) #t))
;; produces the 1 character string immediately following ;; determines if the cursor is currently sitting in a string
;; the cursor, if there is one and if there is not a current ;; literal or a comment.
;; selection, in which case produces #f (define (in-string/comment? text)
(define (immediately-following-cursor text) (in-position? text '(comment string)))
;; produces the 1 character string immediately following
;; the cursor, if there is one and if there is not a current
;; selection, in which case produces #f
(define (immediately-following-cursor text)
(define selection-start (send text get-start-position)) (define selection-start (send text get-start-position))
(and (= selection-start (send text get-end-position)) ; nothing selected (and (= selection-start (send text get-end-position)) ; nothing selected
(< selection-start (send text last-position)) (< selection-start (send text last-position))
(send text get-text selection-start (+ selection-start 1)))) (send text get-text selection-start (+ selection-start 1))))
(define set-mode-mixin (define set-mode-mixin
(mixin (-text<%> mode:host-text<%>) () (mixin (-text<%> mode:host-text<%>) ()
(super-new) (super-new)
@ -1520,19 +1528,21 @@
(send keymap map-function "leftbuttondouble" "paren-double-select") (send keymap map-function "leftbuttondouble" "paren-double-select")
(define (insert-brace-pair text open-brace close-brace [space-between? #f])
(define (insert-brace-pair text open-brace close-brace)
(define selection-start (send text get-start-position)) (define selection-start (send text get-start-position))
(define hash-before? ; tweak to detect and correctly close block comments #| ... |# (define hash-before? ; tweak to detect and correctly close block comments #| ... |#
(and (< 0 selection-start) (and (< 0 selection-start)
(string=? "#" (send text get-text (- selection-start 1) selection-start)))) (string=? "#" (send text get-text (- selection-start 1) selection-start))))
(send text begin-edit-sequence) (send text begin-edit-sequence)
(send text set-position (send text get-end-position)) (send text set-position (send text get-end-position))
(when space-between? (send text insert " "))
(send text insert close-brace) (send text insert close-brace)
(when (and (char=? #\| open-brace) hash-before?) (send text insert #\#)) (when (and (char? open-brace) (char=? #\| open-brace) hash-before?)
(send text insert #\#))
(send text set-position selection-start) (send text set-position selection-start)
(send text insert open-brace) (send text insert open-brace)
(when space-between?
(send text set-position (+ (send text get-start-position) 1)))
(send text end-edit-sequence)) (send text end-edit-sequence))
;; only insert a pair if: ;; only insert a pair if:
@ -1543,41 +1553,70 @@
(define open-parens (define open-parens
(for/list ([x (racket-paren:get-paren-pairs)]) (string-ref (car x) 0))) (for/list ([x (racket-paren:get-paren-pairs)]) (string-ref (car x) 0)))
(cond (cond
[(preferences:get 'framework:automatic-parens) [(not (preferences:get 'framework:automatic-parens))
(send text insert open-brace)]
[else ; automatic-parens is enabled
(define c (immediately-following-cursor text)) (define c (immediately-following-cursor text))
(define when-inserted (position-type-when-inserted text (string open-brace))) (define cur-token
(send text classify-position (send text get-start-position)))
(define when-inserted
(position-type-when-inserted text (string open-brace)))
(cond (cond
; insert paren pair if it results valid parenthesis token... ; insert paren pair if it results valid parenthesis token...
[(member open-brace open-parens) [(member open-brace open-parens)
(if (eq? (position-type-when-inserted text (string open-brace)) 'parenthesis) (if (eq? 'parenthesis when-inserted)
(insert-brace-pair text open-brace close-brace) (insert-brace-pair text open-brace close-brace)
(send text insert open-brace))] (send text insert open-brace))]
; ASSUME: from here on, open-brace is either " or | ; ASSUME: from here on, open-brace is either " or |
; is there a token error at current position which would
; be fixed by inserting the character... ; is there a token error at current position - see if inserting an
[(and (eq? 'error (send text classify-position (send text get-start-position))) ; open brace would fix it
(not (eq? 'error when-inserted))) [(and (eq? 'error cur-token) (not (eq? 'error when-inserted)))
(send text insert open-brace)] (send text insert open-brace)]
; smart-skip over a " | or |# ... ; smart-skip over a | , or |# ...
[(and c (char=? #\" open-brace) (string=? c "\"")) [(and c (char=? #\| open-brace) (string=? c "|")
(send text set-position (+ 1 (send text get-end-position)))] (in-position? text '(symbol comment)))
[(and c (char=? #\| open-brace) (string=? c "|"))
(send text set-position (+ 1 (send text get-end-position))) (send text set-position (+ 1 (send text get-end-position)))
(define d (immediately-following-cursor text)) (define d (immediately-following-cursor text))
(when (and d (string=? d "#")) ; a block comment? (when (and d (string=? d "#")) ; a block comment?
(send text set-position (+ 1 (send text get-end-position))))] (send text set-position (+ 1 (send text get-end-position))))]
; are we in a string or comment... ; are we in a string and " has been typed?
[(and (in-position? text '(string)) (char=? #\" open-brace))
(define start-position (send text get-start-position))
(define end-position (send text get-end-position))
(cond
; smart skip a " if it is the immediately following character (c)
[(and c (string=? c "\""))
(send text set-position (+ 1 end-position))]
; there is no current selection - split the string in two
[(= start-position end-position)
(insert-brace-pair text #\" #\" #t)]
; there is a selection - split the selected text off as a
; separate string from the surrounding in an intelligent way
; and retain selection of the split-out string
[else (define selection-length (- end-position start-position))
(insert-brace-pair text "\" \"" "\" \"")
(define cur-position (send text get-start-position))
(send text set-position (- cur-position 1) (+ cur-position selection-length 1))])]
; are we otherwise in a string or comment...
; (note, in-string/comment? doesn't work very well if tokenizer is in
; an error state and inserting the open-brace doesn't help,
; e.g. typing " or | at the end of "blah blah\
[(in-string/comment? text) (send text insert open-brace)] [(in-string/comment? text) (send text insert open-brace)]
; otherwise if open-brace would result in some literal ; otherwise if open-brace would result in some literal...
[(eq? 'constant when-inserted) (send text insert open-brace)] [(eq? 'constant when-inserted) (send text insert open-brace)]
; at this point probably the tokenizer is in some error state anyway...
[else (insert-brace-pair text open-brace close-brace)])] [else (insert-brace-pair text open-brace close-brace)])]
[else ))
(send text insert open-brace)]))
(add-edit-function "insert-()-pair" (λ (text) (insert-brace-pair text #\( #\)))) (add-edit-function "insert-()-pair" (λ (text) (insert-brace-pair text #\( #\))))
(add-edit-function "insert-[]-pair" (λ (text) (insert-brace-pair text #\[ #\]))) (add-edit-function "insert-[]-pair" (λ (text) (insert-brace-pair text #\[ #\])))

51
collects/tests/framework/racket.rkt
View File

@ -104,7 +104,7 @@
(test (test
(string->symbol (format "racket:test-auto-parens-behavior ~a" which)) (string->symbol (format "racket:test-auto-parens-behavior ~a" which))
(λ (x) (if (list? final-pos) (λ (x) (if (list? final-pos)
(equal? x (car final-pos) (cadr final-pos) final-text) (equal? x (list (car final-pos) (cadr final-pos) final-text))
(equal? x (list final-pos final-pos final-text)))) (equal? x (list final-pos final-pos final-text))))
(λ () (λ ()
(queue-sexp-to-mred (queue-sexp-to-mred
@ -139,8 +139,10 @@
;; a key(s), and runs tests to check what happens when that key(s) is/are ;; a key(s), and runs tests to check what happens when that key(s) is/are
;; typed - in both possible settings of the 'automatic-parens preference ;; typed - in both possible settings of the 'automatic-parens preference
;; ;;
;; final-states is a list of 2 pairs of strings. each pair is the final text before ;; final-states is a list of 2-pairs of strings. each pair is the final text before
;; and after the cursor, for auto-parens disabled and enabled respectively ;; and after the cursor, for auto-parens disabled and enabled respectively
;; (NB. final-states could also contain 3-pairs of strings, the middle portion
;; representing text that is selected after the insertion)
(define (test-parens-behavior/full which (define (test-parens-behavior/full which
init-text-before init-text-selected init-text-after init-text-before init-text-selected init-text-after
keys keys
@ -150,9 +152,14 @@
(define initial-end-pos (+ initial-start-pos (string-length init-text-selected))) (define initial-end-pos (+ initial-start-pos (string-length init-text-selected)))
(for-each (for-each
(lambda (label auto? final-pair) (lambda (label auto? final-pair)
(test-auto-parens-behavior (format "~a-~a" which label) (test-auto-parens-behavior (format "~a (~a)" which label)
initial-text (list initial-start-pos initial-end-pos) keys initial-text (list initial-start-pos initial-end-pos) keys
(apply string-append final-pair) (string-length (car final-pair)) (apply string-append final-pair)
(if (= 3 (length final-pair))
; final-pair could actually be a triplet to indicate residual selection after insertion
(list (string-length (car final-pair)) (string-length (string-append (car final-pair)
(cadr final-pair))))
(string-length (car final-pair)))
auto?)) auto?))
'("no-auto-parens" "with-auto-parens") '("no-auto-parens" "with-auto-parens")
'(#f #t) '(#f #t)
@ -168,12 +175,22 @@
k k
`([,(string-append "(list 1 #\\" (string k)) ")"] `([,(string-append "(list 1 #\\" (string k)) ")"]
[,(string-append "(list 1 #\\" (string k)) ")"])) [,(string-append "(list 1 #\\" (string k)) ")"]))
;; test that auto-parens has no effect in strings ;; test that escaped characters in a string never result in a pair of characters typed...
;; except for | which is a hard case to detect, because the tokenizer ends up
;; in an error state
(unless (or (eq? #\| k))
(test-parens-behavior/full (format "literal-~a-in-string" k)
"\"abc \\" "" "def\""
k
`([,(string-append "\"abc \\" (string k)) "def\""]
[,(string-append "\"abc \\" (string k)) "def\""])))
;; test that auto-parens has no effect in strings, *except for double quotes*
(unless (eq? #\" k)
(test-parens-behavior/full (format "~a-in-string" k) (test-parens-behavior/full (format "~a-in-string" k)
"\" abc def " "" " \"" "\" abc def " "" " \""
k k
`([,(string-append "\" abc def " (string k)) " \""] `([,(string-append "\" abc def " (string k)) " \""]
[,(string-append "\" abc def " (string k)) " \""])) [,(string-append "\" abc def " (string k)) " \""])))
;; test that auto-parens has no effect in various comment situations ;; test that auto-parens has no effect in various comment situations
(define scenarios (define scenarios
@ -278,9 +295,7 @@
"\"abcd \\" "" "" "\"abcd \\" "" ""
#\" #\"
'(["\"abcd \\\"" ""] '(["\"abcd \\\"" ""]
["\"abcd \\\"" "\""])) ; this one inserts a pair ["\"abcd \\\"" "\""])) ; this happens to insert double since string was not closed
; because the string wasn't closed anyway
; (it's a hard case to distinguish)
(test-parens-behavior/full 'double-quote-escaped-2 (test-parens-behavior/full 'double-quote-escaped-2
"\"abcd \\" "" "\"" "\"abcd \\" "" "\""
#\" #\"
@ -353,6 +368,24 @@
'([")]" "" ""] '([")]" "" ""]
[")]" "" ""])) [")]" "" ""]))
(test-parens-behavior/full '|"-splits-string|
" \"abcd" "" "efg\" "
#\"
'([" \"abcd\"" "efg\" "]
[" \"abcd\" " "\"efg\" "]))
(test-parens-behavior/full '|"-splits-string-at-beginning|
" \"" "" "abcdefg\" "
#\"
'([" \"\"" "abcdefg\" "]
[" \"\" " "\"abcdefg\" "]))
(test-parens-behavior/full '|"-splits-out-selected-string|
" \"abc" "def" "ghi\" "
#\"
'([" \"abc\"" "" "ghi\" "]
; test that "def" remains selected afterwards...
[" \"abc\" " "\"def\"" " \"ghi\" "]))
#| for these, the key-event with meta-down doesn't seem to work... maybe a Mac OS #| for these, the key-event with meta-down doesn't seem to work... maybe a Mac OS
issue; and may cause problems with these tests on another platform? .nah. |# issue; and may cause problems with these tests on another platform? .nah. |#