automatic parenthesis mode improvements
Handle close parentheses in a smarter way while in
auto-parens mode and be a little more smart about
inserting brace pairs in general.
In summary:
- Add some "smart-skip" behavior to insert-close-paren,
described in the documentation.
- When auto-parens mode is enabled,
the existing "balance-parens" keybinding invokes
insert-close-paren with a smart-skip argument of
'adjacent
- A new "balance-parens-forward" keybinding invokes
insert-close-paren with a smart-skip argument of
'forward (whether or not auto-parens mode is
enabled)
- Enable basic smart-skip behavior for
strings ("...") and |...| pairs, specifically, typing
a double-quote or bar character when the cursor
immediately precedes one causes the cursor to simply
skip over the existing one
- Tweak auto-insertion of block comment pairs; i.e.
typing hash and a bar results in a properly balanced
#||# pair. Also, when you type a bar character when
the cursor immediately precedes a closing bar and
hash of a comment, then the cursor skips over both
characters (this seems better than having it just
skip over the bar, and then having to introduce a
new keybinding to detect when a hash is typed while
the cursor is between a bar and a hash)
- In strings and line/block comments, auto-parens mode
no longer has any effect (you can still use the M+..
keybindings to force insertion of a particular brace
pair)
- Detect when a character constant is being typed, and
don't insert brace pairs if so; i.e. if the cursor
is immediately after #\ , then typing any open parens,
double quote, or bar, does _not_ result in the
insertion of an open/close pair even in auto-parens
mode
- Add a bunch of tests related to auto-parens, matching
pairs of braces, strings, comments, etc. to
collects/tests/framework/racket.rkt
This commit is contained in:
Nadeem Abdul Hamid
Robby Findler
parent
5197649cb7
commit
8f3343cd01
|
|
@ -8,6 +8,7 @@ added get-regions
|
|||
|
||||
(require racket/class
|
||||
racket/gui/base
|
||||
(prefix-in r: racket/match) ; does 'match' conflict with something else
|
||||
syntax-color/token-tree
|
||||
syntax-color/paren-tree
|
||||
syntax-color/default-lexer
|
||||
|
|
@ -892,6 +893,7 @@ added get-regions
|
|||
(tokenize-to-pos ls position)))
|
||||
|
||||
;; See docs
|
||||
;; Note: this doesn't seem to handle sexp-comments correctly .nah.
|
||||
(define/public (skip-whitespace position direction comments?)
|
||||
(when stopped?
|
||||
(error 'skip-whitespace "called on a color:text<%> whose colorer is stopped."))
|
||||
|
|
@ -952,37 +954,126 @@ added get-regions
|
|||
#f)))))
|
||||
c))))))
|
||||
|
||||
(inherit insert delete flash-on on-default-char)
|
||||
|
||||
;; this returns the start/end positions
|
||||
;; of the matching close paren of the first open paren to the left of pos,
|
||||
;; if it is properly balanced. (this one assumes though that closers
|
||||
;; really contains only 'parenthesis type characters)
|
||||
;; find-next-outer-paren : number (list string)
|
||||
;; -> (values (or #f number) (or #f number) (or #f string))
|
||||
(define/private (find-next-outer-paren pos closers)
|
||||
(cond
|
||||
[(null? closers) (values #f #f #f)]
|
||||
[else
|
||||
(define c (car closers)) ; pick a close parens
|
||||
(define l (string-length c))
|
||||
(define ls (find-ls pos))
|
||||
(cond
|
||||
[(not ls) (values #f #f #f)]
|
||||
[else
|
||||
(define start-pos (lexer-state-start-pos ls))
|
||||
(insert c pos) ; temporarily insert c
|
||||
(define m (backward-match (+ l pos) start-pos)) ; find matching open parens
|
||||
(delete pos (+ l pos)) ; delete c
|
||||
(define n ; now from the open parens find the *real* matching close parens
|
||||
(and m (forward-match m (last-position)))) ; n is the position *after* the close
|
||||
#;(printf "outer: ~a~n" (list pos n m (and n m (let-values ([(a b) (get-token-range (- n l))])
|
||||
(list a b)))))
|
||||
(if n
|
||||
(let-values ([(a b) (get-token-range (- n l))])
|
||||
(values a b (get-text a b)))
|
||||
(find-next-outer-paren pos (cdr closers)))])]))
|
||||
|
||||
|
||||
;; returns the start and end positions of the next token at or after
|
||||
;; pos that matches any of the given list of closers, as well as
|
||||
;; the string of the matching token itself and whether it
|
||||
;; occurred immediately adjacent to pos, ignoring whitespace and comments
|
||||
;; find-next-close-paren : number (list string) boolean
|
||||
;; -> (values (or #f number) (or #f number) (or #f string) boolean)
|
||||
(define/private (find-next-close-paren pos closers [adj? #t])
|
||||
(define next-pos (skip-whitespace pos 'forward #t))
|
||||
(define tree (lexer-state-tokens (find-ls next-pos)))
|
||||
(define start-pos (begin (send tree search! next-pos)
|
||||
(send tree get-root-start-position)))
|
||||
(define end-pos (send tree get-root-end-position))
|
||||
|
||||
#;(printf "~a |~a| |~a|~n" (list pos next-pos start-pos end-pos (send tree get-root-data)) closers (get-text start-pos end-pos))
|
||||
|
||||
(cond
|
||||
[(or (not (send tree get-root-data)) (<= end-pos pos))
|
||||
(values #f #f #f #f)] ;; didn't find /any/ token ending after pos
|
||||
[(and (<= pos start-pos)
|
||||
(member (get-text start-pos end-pos) closers)) ; token at start-pos matches
|
||||
(values start-pos end-pos (get-text start-pos end-pos) adj?)]
|
||||
[else ; skip ahead
|
||||
(find-next-close-paren end-pos closers #f)]))
|
||||
|
||||
|
||||
;; given end-pos, a position right after a closing parens,
|
||||
;; flash the matching open parens
|
||||
(define/private (flash-from end-pos)
|
||||
(let ((to-pos (backward-match end-pos 0)))
|
||||
(when to-pos
|
||||
(let ([ls (find-ls to-pos)])
|
||||
(when ls
|
||||
(let ([start-pos (lexer-state-start-pos ls)]
|
||||
[parens (lexer-state-parens ls)])
|
||||
(when (and (send parens is-open-pos? (- to-pos start-pos))
|
||||
(send parens is-close-pos? (- end-pos 1 start-pos)))
|
||||
(flash-on to-pos (+ 1 to-pos)))))))))
|
||||
|
||||
|
||||
(inherit insert delete flash-on on-default-char set-position undo)
|
||||
;; See docs
|
||||
(define/public (insert-close-paren pos char flash? fixup?)
|
||||
(let ((closer
|
||||
(begin
|
||||
(begin-edit-sequence #f #f)
|
||||
(get-close-paren pos
|
||||
(if fixup?
|
||||
(let ([l (map symbol->string (map cadr pairs))])
|
||||
;; Ensure preference for given character:
|
||||
(cons (string char) (remove (string char) l)))
|
||||
null)
|
||||
;; If the inserted preferred (i.e., given) paren doesn't parse
|
||||
;; as a paren, then don't try to change it.
|
||||
#f))))
|
||||
(end-edit-sequence)
|
||||
(let ((insert-str (if closer closer (string char))))
|
||||
(for-each (lambda (c)
|
||||
(on-default-char (new key-event% (key-code c))))
|
||||
(string->list insert-str))
|
||||
(when flash?
|
||||
(unless stopped?
|
||||
(let ((to-pos (backward-match (+ (string-length insert-str) pos) 0)))
|
||||
(when to-pos
|
||||
(let ([ls (find-ls to-pos)])
|
||||
(when ls
|
||||
(let ([start-pos (lexer-state-start-pos ls)]
|
||||
[parens (lexer-state-parens ls)])
|
||||
(when (and (send parens is-open-pos? (- to-pos start-pos))
|
||||
(send parens is-close-pos? (- pos start-pos)))
|
||||
(flash-on to-pos (+ 1 to-pos)))))))))))))
|
||||
;; smart-skip : (or/c #f 'adjacent 'forward)
|
||||
(define/public (insert-close-paren pos char flash? fixup? [smart-skip #f])
|
||||
(begin-edit-sequence #t #f) ;; to hide get-close-paren's temporary edits
|
||||
(define closers (map symbol->string (map cadr pairs)))
|
||||
(define closer
|
||||
(get-close-paren pos (if fixup? ;; Ensure preference for given character:
|
||||
(cons (string char) (remove (string char) closers))
|
||||
null)
|
||||
;; If the inserted preferred (i.e., given) paren doesn't parse
|
||||
;; as a paren, then don't try to change it.
|
||||
#f))
|
||||
(define insert-str (if closer closer (string char)))
|
||||
(define-values (next-close-start next-close-end next-close-str next-close-adj?)
|
||||
(find-next-close-paren pos closers))
|
||||
(define-values (outer-close-start outer-close-end outer-close-str)
|
||||
(find-next-outer-paren pos closers))
|
||||
(end-edit-sequence) ;; wraps up the net-zero editing changes done by get-close-paren etc.
|
||||
(undo) ;; to avoid messing up the editor's modified state in case of a simple skip
|
||||
|
||||
;; an action is either '(insert) or '(skip p) where p is a position
|
||||
(define the-action
|
||||
(r:match smart-skip
|
||||
[#f '(insert)]
|
||||
['adjacent (if (and next-close-start next-close-adj?
|
||||
(string=? insert-str next-close-str))
|
||||
`(skip ,next-close-end)
|
||||
`(insert))]
|
||||
['forward (cond
|
||||
[(and outer-close-start
|
||||
(or fixup? (string=? insert-str outer-close-str)))
|
||||
`(skip ,outer-close-end)]
|
||||
[(and next-close-start
|
||||
(or fixup? (string=? insert-str next-close-str)))
|
||||
`(skip ,next-close-end)]
|
||||
[else `(insert)])]
|
||||
[_ (error 'insert-close-paren
|
||||
(format "invalid smart-skip option: ~a" smart-skip))]))
|
||||
|
||||
(define end-pos
|
||||
(r:match the-action
|
||||
[(list 'insert)
|
||||
(for-each (λ(c) (on-default-char (new key-event% (key-code c))))
|
||||
(string->list insert-str))
|
||||
(+ pos (string-length insert-str))]
|
||||
[(list 'skip p) (set-position p) p]))
|
||||
|
||||
(when (and flash? (not stopped?)) (flash-from end-pos)))
|
||||
|
||||
|
||||
(define/public (debug-printout)
|
||||
(for-each
|
||||
|
|
|
|||
|
|
@ -501,11 +501,14 @@
|
|||
|
||||
(define/public (get-limit pos) 0)
|
||||
|
||||
(define/public (balance-parens key-event)
|
||||
(define/public (balance-parens key-event [smart-skip #f])
|
||||
(insert-close-paren (get-start-position)
|
||||
(send key-event get-key-code)
|
||||
(preferences:get 'framework:paren-match)
|
||||
(preferences:get 'framework:fixup-parens)))
|
||||
(preferences:get 'framework:fixup-parens)
|
||||
(or smart-skip
|
||||
(and (preferences:get 'framework:automatic-parens)
|
||||
'adjacent))))
|
||||
|
||||
(define/public (tabify-on-return?) #t)
|
||||
(define/public (tabify [pos (get-start-position)])
|
||||
|
|
@ -1312,6 +1315,47 @@
|
|||
[(and lam-reg (regexp-match lam-reg text)) 'lambda]
|
||||
[else #f])))))
|
||||
|
||||
|
||||
(define (position-type-when-inserted text char)
|
||||
(define selection-start (send text get-start-position))
|
||||
(define selection-end (send text get-end-position))
|
||||
(send text begin-edit-sequence #t #f)
|
||||
(send text insert char selection-start)
|
||||
(define actual-type (send text classify-position selection-start))
|
||||
(send text delete selection-start (+ 1 selection-start))
|
||||
(send text end-edit-sequence)
|
||||
(send text undo) ; to avoid messing up the editor's modified state
|
||||
;(printf "check: |~a| actual: ~a~n" char actual-type)
|
||||
actual-type)
|
||||
|
||||
|
||||
;; determines if the cursor is currently sitting in a string
|
||||
;; literal or a comment. To do this more accurately, first
|
||||
;; insert a space at the current cursor start position, then
|
||||
;; check what classification of that space character itself
|
||||
(define (in-string/comment? text)
|
||||
(define selection-start (send text get-start-position))
|
||||
(define selection-end (send text get-end-position))
|
||||
(send text begin-edit-sequence #t #f)
|
||||
(send text insert " " selection-start)
|
||||
(define type (send text classify-position selection-start))
|
||||
(send text delete selection-start (add1 selection-start))
|
||||
(send text end-edit-sequence)
|
||||
(send text undo) ; to avoid messing up the editor's modified state
|
||||
; in case of a simple skip
|
||||
(and (member type '(comment string)) #t))
|
||||
|
||||
;; 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))
|
||||
(and (= selection-start (send text get-end-position)) ; nothing selected
|
||||
(< selection-start (send text last-position))
|
||||
(send text get-text selection-start (+ selection-start 1))))
|
||||
|
||||
|
||||
|
||||
(define set-mode-mixin
|
||||
(mixin (-text<%> mode:host-text<%>) ()
|
||||
(super-new)
|
||||
|
|
@ -1425,6 +1469,9 @@
|
|||
(send keymap add-function "balance-parens"
|
||||
(λ (edit event)
|
||||
(send edit balance-parens event)))
|
||||
(send keymap add-function "balance-parens-forward"
|
||||
(λ (edit event)
|
||||
(send edit balance-parens event 'forward)))
|
||||
|
||||
(send keymap map-function "TAB" "tabify-at-caret")
|
||||
|
||||
|
|
@ -1444,17 +1491,62 @@
|
|||
|
||||
(send keymap map-function "leftbuttondouble" "paren-double-select")
|
||||
|
||||
|
||||
|
||||
(define (insert-brace-pair text open-brace close-brace)
|
||||
(define selection-start (send text get-start-position))
|
||||
(define hash-before? ; tweak to detect and correctly close block comments #| ... |#
|
||||
(and (< 0 selection-start)
|
||||
(string=? "#" (send text get-text (- selection-start 1) selection-start))))
|
||||
(send text begin-edit-sequence)
|
||||
(send text set-position (send text get-end-position))
|
||||
(send text insert close-brace)
|
||||
(when (and (char=? #\| open-brace) hash-before?) (send text insert #\#))
|
||||
(send text set-position selection-start)
|
||||
(send text insert open-brace))
|
||||
(send text insert open-brace)
|
||||
(send text end-edit-sequence))
|
||||
|
||||
;; only insert a pair if:
|
||||
;; - automatic-parens is on, and
|
||||
;; - cursor is not in a string or line/block comment, and
|
||||
;; - cursor is not preceded by #\ or \ escape characters
|
||||
(define (maybe-insert-brace-pair text open-brace close-brace)
|
||||
(define open-parens
|
||||
(for/list ([x (racket-paren:get-paren-pairs)]) (string-ref (car x) 0)))
|
||||
(cond
|
||||
[(preferences:get 'framework:automatic-parens)
|
||||
(insert-brace-pair text open-brace close-brace)]
|
||||
(define c (immediately-following-cursor text))
|
||||
(define when-inserted (position-type-when-inserted text (string open-brace)))
|
||||
(cond
|
||||
; insert paren pair if it results valid parenthesis token...
|
||||
[(member open-brace open-parens)
|
||||
(if (eq? (position-type-when-inserted text (string open-brace)) 'parenthesis)
|
||||
(insert-brace-pair text open-brace close-brace)
|
||||
(send text insert open-brace))]
|
||||
|
||||
; 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...
|
||||
[(and (eq? 'error (send text classify-position (send text get-start-position)))
|
||||
(not (eq? 'error when-inserted)))
|
||||
(send text insert open-brace)]
|
||||
|
||||
; smart-skip over a " | or |# ...
|
||||
[(and c (char=? #\" open-brace) (string=? c "\""))
|
||||
(send text set-position (+ 1 (send text get-end-position)))]
|
||||
[(and c (char=? #\| open-brace) (string=? c "|"))
|
||||
(send text set-position (+ 1 (send text get-end-position)))
|
||||
(define d (immediately-following-cursor text))
|
||||
(when (and d (string=? d "#")) ; a block comment?
|
||||
(send text set-position (+ 1 (send text get-end-position))))]
|
||||
|
||||
; are we in a string or comment...
|
||||
[(in-string/comment? text) (send text insert open-brace)]
|
||||
|
||||
; otherwise if open-brace would result in some literal
|
||||
[(eq? 'constant when-inserted) (send text insert open-brace)]
|
||||
|
||||
[else (insert-brace-pair text open-brace close-brace)])]
|
||||
[else
|
||||
(send text insert open-brace)]))
|
||||
|
||||
|
|
@ -1550,6 +1642,10 @@
|
|||
;(map-meta "c:m" "mark-matching-parenthesis")
|
||||
; this keybinding doesn't interact with the paren colorer
|
||||
|
||||
(map-meta ")" "balance-parens-forward")
|
||||
(map-meta "]" "balance-parens-forward")
|
||||
(map-meta "}" "balance-parens-forward")
|
||||
|
||||
(map-meta "(" "insert-()-pair")
|
||||
(map-meta "[" "insert-[]-pair")
|
||||
(map-meta "{" "insert-{}-pair")
|
||||
|
|
@ -1673,7 +1769,9 @@
|
|||
(send text delete pos (+ pos 1) #f)
|
||||
(send text end-edit-sequence)
|
||||
(cond
|
||||
[(preferences:get 'framework:automatic-parens)
|
||||
[(and (preferences:get 'framework:automatic-parens)
|
||||
(not (in-string/comment? text))
|
||||
(eq? (position-type-when-inserted text real-char) 'parenthesis))
|
||||
(send text insert (case real-char
|
||||
[(#\() #\)]
|
||||
[(#\[) #\]]
|
||||
|
|
|
|||
|
|
@ -217,16 +217,40 @@
|
|||
|
||||
Must only be called while the tokenizer is started.
|
||||
}
|
||||
@defmethod*[(((insert-close-paren (position natural-number/c) (char char?) (flash? boolean?) (fixup? boolean?)) void?))]{
|
||||
|
||||
The @racket[position] is the place to put the parenthesis, and
|
||||
@defmethod*[(((insert-close-paren (position natural-number/c) (char char?)
|
||||
(flash? boolean?) (fixup? boolean?)
|
||||
(smart-skip? (or/c #f 'adjacent 'forward) #f)) void?))]{
|
||||
Inserts a close parentheses, or, under scenarios described further below, skips
|
||||
past a subsequent one. The @racket[position] is the place to put the parenthesis, or
|
||||
from which to start searching for a subsequent one, and
|
||||
@racket[char] is the parenthesis to be added (e.g., that the user typed).
|
||||
If @racket[fixup?] is true, the right kind of closing parenthesis will be
|
||||
chosen from the set previously passed to @method[color:text<%> start-colorer]---but only
|
||||
if an inserted @racket[char] would be colored as a parenthesis (i.e., with
|
||||
the @racket['parenthesis] classification). Otherwise, @racket[char] will
|
||||
be inserted, even if it is not the right kind. If @racket[flash?] is true,
|
||||
the matching open parenthesis will be flashed.
|
||||
be inserted (or skipped past), even if it is not the right kind.
|
||||
If @racket[flash?] is true, the matching open parenthesis will be flashed when
|
||||
the insertion or skip is done.
|
||||
|
||||
The "smart skipping" behavior of this function is determined by
|
||||
@racket[smart-skip?]. If @racket[smart-skip?] is false, no skip will
|
||||
take place. A parenthesis will simply be inserted as described in the
|
||||
paragraph above. When @racket[smart-skip?] is @racket['adjacent], if
|
||||
the next token after @racket[position], ignoring whitespace and
|
||||
comments (see @racket[skip-whitespace]), is a properly matched closing
|
||||
parenthesis (which may not necessarily match @racket[char] if
|
||||
@racket[fixup?] is true) then simply move the cursor to the position
|
||||
immediately after that already present closing parenthesis. When
|
||||
@racket[smart-skip?] is @racket['forward], this function attempts to
|
||||
determine the closest pair of properly balanced parentheses around
|
||||
@racket[position]. If that exists, then the cursor position skips
|
||||
to the position immediately after the closing parenthesis of that
|
||||
outer pair. If a properly balanced outer pair is not present, then
|
||||
the cursor attempts to skip immediately after the next closing
|
||||
parenthesis that occurs after @racket[position], ignoring whitespace,
|
||||
comments, and all other tokens. In both non-false cases of
|
||||
@racket[smart-skip?], if there is no subsequent parenthesis, then
|
||||
a parenthesis is simply inserted, as previously described.
|
||||
}
|
||||
@defmethod*[(((classify-position (position exact-nonnegative-integer?)) (or/c symbol? #f)))]{
|
||||
|
||||
|
|
|
|||
|
|
@ -91,3 +91,257 @@
|
|||
(test-magic-square-bracket 'local1 "(local " "(local [")
|
||||
(test-magic-square-bracket 'local2 "(local [" "(local [(")
|
||||
(test-magic-square-bracket 'local2 "(local [(define x 1)] " "(local [(define x 1)] (")
|
||||
|
||||
|
||||
;; tests what happens when a given key/s is/are typed in an editor with initial
|
||||
;; text and cursor position, under different settings of the auto-parentheses and
|
||||
;; smart-skip-parentheses preferences .nah.
|
||||
|
||||
;; test-auto-parens-behavior
|
||||
;; : any string [or num (list num num)] [or char symbol 1string (list char) (list key-event%)] [or num (list num num)] string
|
||||
(define (test-auto-parens-behavior which initial-text initial-pos keys final-text final-pos
|
||||
[auto-parens? #f])
|
||||
(test
|
||||
(string->symbol (format "racket:test-auto-parens-behavior ~a" which))
|
||||
(λ (x) (if (list? final-pos)
|
||||
(equal? x (car final-pos) (cadr final-pos) final-text)
|
||||
(equal? x (list final-pos final-pos final-text))))
|
||||
(λ ()
|
||||
(queue-sexp-to-mred
|
||||
`(let* ([t (new racket:text%)]
|
||||
[f (new frame% [label ""] [width 600] [height 600])]
|
||||
[ec (new editor-canvas% [parent f] [editor t])])
|
||||
(preferences:set 'framework:automatic-parens ,auto-parens?)
|
||||
(send f reflow-container)
|
||||
(send t insert ,initial-text)
|
||||
,(if (number? initial-pos)
|
||||
`(send t set-position ,initial-pos)
|
||||
`(send t set-position ,(car initial-pos) ,(cadr initial-pos)))
|
||||
,@(map
|
||||
(lambda (k)
|
||||
(cond [(char? k)
|
||||
`(send (racket:get-keymap)
|
||||
handle-key-event t (new key-event% [key-code ,k]))]
|
||||
[(string? k)
|
||||
`(send (racket:get-keymap)
|
||||
handle-key-event t (new key-event% [key-code ,(car (string->list k))]))]
|
||||
[(symbol? k)
|
||||
`(send (racket:get-keymap)
|
||||
handle-key-event t (new key-event% [key-code (quote ,k)]))]
|
||||
[else `(send (racket:get-keymap) handle-key-event t ,k)]))
|
||||
(if (list? keys) keys (list keys)))
|
||||
(list (send t get-start-position) (send t get-end-position) (send t get-text)))))))
|
||||
|
||||
|
||||
;; this takes an initial editor state (specified by the text before the cursor,
|
||||
;; some selected text (may be blank string), and text after the cursor), and
|
||||
;; 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
|
||||
;;
|
||||
;; 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
|
||||
(define (test-parens-behavior/full which
|
||||
init-text-before init-text-selected init-text-after
|
||||
keys
|
||||
final-states)
|
||||
(define initial-text (string-append init-text-before init-text-selected init-text-after))
|
||||
(define initial-start-pos (string-length init-text-before))
|
||||
(define initial-end-pos (+ initial-start-pos (string-length init-text-selected)))
|
||||
(for-each
|
||||
(lambda (label auto? final-pair)
|
||||
(test-auto-parens-behavior (format "~a-~a" which label)
|
||||
initial-text (list initial-start-pos initial-end-pos) keys
|
||||
(apply string-append final-pair) (string-length (car final-pair))
|
||||
auto?))
|
||||
'("no-auto-parens" "with-auto-parens")
|
||||
'(#f #t)
|
||||
final-states))
|
||||
|
||||
|
||||
(define SPECIAL-CHARS '(#\( #\) #\[ #\] #\" #\| #\{ #\}))
|
||||
|
||||
(for ([k SPECIAL-CHARS])
|
||||
;; test that character literals never result in a pair of characters typed...
|
||||
(test-parens-behavior/full (format "literal-~a" k)
|
||||
"(list 1 #\\" "" ")"
|
||||
k
|
||||
`([,(string-append "(list 1 #\\" (string k)) ")"]
|
||||
[,(string-append "(list 1 #\\" (string k)) ")"]))
|
||||
;; test that auto-parens has no effect in strings
|
||||
(test-parens-behavior/full (format "~a-in-string" k)
|
||||
"\" abc def " "" " \""
|
||||
k
|
||||
`([,(string-append "\" abc def " (string k)) " \""]
|
||||
[,(string-append "\" abc def " (string k)) " \""]))
|
||||
|
||||
;; test that auto-parens has no effect in various comment situations
|
||||
(define scenarios
|
||||
; description before-cursor after-cursor
|
||||
'(("in-line-comment" ";; abc def " " ghi ")
|
||||
("end-of-line-comment" ";; abc def " "")
|
||||
("in-block-comment" "#| abc def " " ghi |#")
|
||||
))
|
||||
(for ([s scenarios])
|
||||
(let* ([before (cadr s)]
|
||||
[after (caddr s)]
|
||||
[before-final (string-append before (string k))]
|
||||
[result (list before-final after)])
|
||||
(test-parens-behavior/full (format "~a-~a" k (car s))
|
||||
before "" after k `(,result ,result)))))
|
||||
|
||||
;;; assorted other scenarios...
|
||||
(test-parens-behavior/full 'open-parens
|
||||
"abcd" "" "efg" ; editor state: before, selected, after
|
||||
#\( ; key(s) pressed
|
||||
'(["abcd(" "efg"] ; result state sep by cursor, no auto-parens
|
||||
["abcd(" ")efg"])) ; result state with auto-parens
|
||||
|
||||
(test-parens-behavior/full 'close-1
|
||||
"abcd" "" "efg"
|
||||
#\)
|
||||
'(["abcd)" "efg"] ["abcd)" "efg"]))
|
||||
(test-parens-behavior/full 'close-2
|
||||
"(abcd" "" "efg"
|
||||
#\)
|
||||
'(["(abcd)" "efg"] ["(abcd)" "efg"]))
|
||||
(test-parens-behavior/full 'close-3
|
||||
"(abcd" "" ")efg"
|
||||
#\)
|
||||
'(["(abcd)" ")efg"] ["(abcd)" "efg"]))
|
||||
(test-parens-behavior/full 'close-4
|
||||
"(abcd efg " "" " ) efg"
|
||||
#\)
|
||||
'(["(abcd efg )" " ) efg"]
|
||||
["(abcd efg )" " efg"]))
|
||||
(test-parens-behavior/full 'close-5
|
||||
"(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84])"
|
||||
""
|
||||
""
|
||||
#\)
|
||||
'(["(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84]))" ""]
|
||||
["(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84]))" ""]))
|
||||
(test-parens-behavior/full 'close-6
|
||||
"(define before+afters `([\"\" abc \"efg\""
|
||||
""
|
||||
" 12345 xyz]) [84])"
|
||||
#\)
|
||||
'(["(define before+afters `([\"\" abc \"efg\"]" " 12345 xyz]) [84])"]
|
||||
["(define before+afters `([\"\" abc \"efg\"]" " 12345 xyz]) [84])"]))
|
||||
|
||||
|
||||
(test-parens-behavior/full 'close-skip-1
|
||||
"(define before+afters `([\"\" abc \"efg\" 12345 xyz]"
|
||||
""
|
||||
" ) [84])"
|
||||
#\)
|
||||
'(["(define before+afters `([\"\" abc \"efg\" 12345 xyz])" " ) [84])"]
|
||||
["(define before+afters `([\"\" abc \"efg\" 12345 xyz] )" " [84])"]))
|
||||
(test-parens-behavior/full 'close-skip-fixup-1
|
||||
"(define before+afters `{[abc 123]"
|
||||
""
|
||||
" ) [84])"
|
||||
#\) ; here the next close after ) doesn't match the {, so no skip happens
|
||||
'(["(define before+afters `{[abc 123]}" " ) [84])"]
|
||||
["(define before+afters `{[abc 123]}" " ) [84])"]))
|
||||
(test-parens-behavior/full 'close-skip-fixup-2
|
||||
"(define before+afters `{[abc 123]"
|
||||
""
|
||||
" } [84])"
|
||||
#\) ; here the next close does match the {, so skip
|
||||
'(["(define before+afters `{[abc 123]}" " } [84])"]
|
||||
["(define before+afters `{[abc 123] }" " [84])"]))
|
||||
|
||||
(test-parens-behavior/full 'surround-open-1
|
||||
"abcd" "ef" "g"
|
||||
#\(
|
||||
'(["abcd(" "g"] ["abcd(" "ef)g"]))
|
||||
|
||||
(test-parens-behavior/full 'double-quote-1
|
||||
"" "" ""
|
||||
#\"
|
||||
'(["\"" ""] ["\"" "\""]))
|
||||
(test-parens-behavior/full 'double-quote-2
|
||||
"abc " "" ""
|
||||
#\"
|
||||
'(["abc \"" ""] ["abc \"" "\""]))
|
||||
(test-parens-behavior/full 'double-quote-selection-1
|
||||
"(abc " "def 123" " xyz]"
|
||||
#\"
|
||||
'(["(abc \"" " xyz]"] ["(abc \"" "def 123\" xyz]"]))
|
||||
(test-parens-behavior/full 'double-quote-skip-1
|
||||
"\"abc def " "" "\" 123"
|
||||
#\"
|
||||
'(["\"abc def \"" "\" 123"] ["\"abc def \"" " 123"]))
|
||||
(test-parens-behavior/full 'double-quote-escaped-1
|
||||
"\"abcd \\" "" ""
|
||||
#\"
|
||||
'(["\"abcd \\\"" ""]
|
||||
["\"abcd \\\"" "\""])) ; this one inserts a pair
|
||||
; because the string wasn't closed anyway
|
||||
; (it's a hard case to distinguish)
|
||||
(test-parens-behavior/full 'double-quote-escaped-2
|
||||
"\"abcd \\" "" "\""
|
||||
#\"
|
||||
'(["\"abcd \\\"" "\""]
|
||||
["\"abcd \\\"" "\""]))
|
||||
|
||||
(test-parens-behavior/full 'bar
|
||||
"abc " "" "123"
|
||||
#\|
|
||||
'(["abc |" "123"] ["abc |" "|123"]))
|
||||
(test-parens-behavior/full 'bar-literal
|
||||
"(list 1 #\\" "" ")"
|
||||
#\|
|
||||
'(["(list 1 #\\|" ")"] ["(list 1 #\\|" ")"]))
|
||||
(test-parens-behavior/full 'bar-skip
|
||||
"abc |def" "" "|123"
|
||||
#\|
|
||||
'(["abc |def|" "|123"] ["abc |def|" "123"]))
|
||||
(test-parens-behavior/full 'bar-selection
|
||||
"abc |def " "hij" "|123"
|
||||
#\|
|
||||
'(["abc |def |" "|123"] ["abc |def |" "hij||123"]))
|
||||
|
||||
|
||||
(test-parens-behavior/full 'block-comment-1
|
||||
" #" "" ""
|
||||
#\|
|
||||
'([" #|" ""]
|
||||
[" #|" "|#"]))
|
||||
(test-parens-behavior/full 'block-comment-2
|
||||
"(123 abc#" "" " def 456)"
|
||||
#\|
|
||||
'(["(123 abc#|" " def 456)"]
|
||||
["(123 abc#|" "|# def 456)"]))
|
||||
(test-parens-behavior/full 'block-comment-skip-1
|
||||
"#| (123 abc" "" "|# def 456)"
|
||||
#\|
|
||||
'(["#| (123 abc|" "|# def 456)"]
|
||||
["#| (123 abc|#" " def 456)"]))
|
||||
|
||||
#| 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. |#
|
||||
(when (equal? 'macosx (system-type))
|
||||
(test-parens-behavior/full 'meta-open-1
|
||||
"abcd" "" "efg"
|
||||
'(escape #\() ; '((new key-event% [key-code #\(] [meta-down #t]))
|
||||
'(["abcd(" ")efg"] ["abcd(" ")efg"]))
|
||||
|
||||
(test-parens-behavior/full 'meta-close-skip-1
|
||||
"(define before (list 1 2" "" " 3 4)"
|
||||
'(escape #\)) ; '((new key-event% [key-code #\)] [meta-down #t]))
|
||||
'(["(define before (list 1 2 3 4)" ""]
|
||||
["(define before (list 1 2 3 4)" ""]))
|
||||
(test-parens-behavior/full 'meta-close-skip-2
|
||||
"#lang racket\n(define before+afters `([\"\" abc \"efg\""
|
||||
""
|
||||
" 12345 xyz] [84])"
|
||||
'(escape #\)) ;'((new key-event% [key-code #\)] [meta-down #t]))
|
||||
'(["#lang racket\n(define before+afters `([\"\" abc \"efg\" 12345 xyz]" " [84])"]
|
||||
["#lang racket\n(define before+afters `([\"\" abc \"efg\" 12345 xyz]" " [84])"]))
|
||||
(test-parens-behavior/full 'meta-close-skip-3
|
||||
"(define before" "" " (list 1 2 3 4)"
|
||||
'(escape #\)) ; '((new key-event% [key-code #\)] [meta-down #t]))
|
||||
'(["(define before (list 1 2 3 4)" ""]
|
||||
["(define before (list 1 2 3 4)" ""]))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -8,6 +8,36 @@
|
|||
more to use the #lang language (unless they are using the teaching
|
||||
languages)
|
||||
|
||||
. Automatic-parenthesis mode improvements:
|
||||
- Added some "smart-skip" behavior to insert-close-paren,
|
||||
described in the documentation.
|
||||
- When auto-parens mode is enabled,
|
||||
the existing "balance-parens" keybinding invokes
|
||||
insert-close-paren with a smart-skip argument of
|
||||
'adjacent
|
||||
- A new "balance-parens-forward" keybinding invokes
|
||||
insert-close-paren with a smart-skip argument of
|
||||
'forward (whether or not auto-parens mode is
|
||||
enabled)
|
||||
|
||||
- Some basic smart-skip behavior is also enabled for
|
||||
strings ("...") and |...| pairs, specifically, typing
|
||||
a double-quote or bar character when the cursor
|
||||
immediately precedes one causes the cursor to simply
|
||||
skip over the existing one
|
||||
|
||||
- Tweaked insertion of block comment pairs in
|
||||
auto-parens mode
|
||||
|
||||
- In strings and line/block comments, auto-parens mode
|
||||
no longer has any effect (you can still use the M+..
|
||||
keybindings to force insertion of a particular brace
|
||||
pair)
|
||||
|
||||
- Detect when a character constant is being typed, and
|
||||
don't insert brace pairs if so
|
||||
|
||||
|
||||
------------------------------
|
||||
Version 5.3.1
|
||||
------------------------------
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user