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

DrScheme: only correct a paren if the inserted character would be colored as a parenthesis (which matters for @-form coloring)

Browse Source 
svn: r15685
This commit is contained in:
Matthew Flatt 2009-08-07 14:59:14 +00:00
parent d1bd8a7a40
commit 450d9b604e
2 changed files with 34 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/framework/private/color.ss
View File

@ -849,7 +849,7 @@ added get-regions
comments?)) comments?))
(else position)))))))) (else position))))))))
(define/private (get-close-paren pos closers) (define/private (get-close-paren pos closers continue-after-non-paren?)
(cond (cond
((null? closers) #f) ((null? closers) #f)
(else (else
@ -859,16 +859,23 @@ added get-regions
(if ls (if ls
(let ([start-pos (lexer-state-start-pos ls)]) (let ([start-pos (lexer-state-start-pos ls)])
(insert c pos) (insert c pos)
(let ((m (backward-match (+ l pos) start-pos))) (let ((cls (classify-position pos)))
(cond (if (eq? cls 'parenthesis)
((and m (let ((m (backward-match (+ l pos) start-pos)))
(send (lexer-state-parens ls) is-open-pos? (- m start-pos)) (cond
(send (lexer-state-parens ls) is-close-pos? (- pos start-pos))) ((and m
(delete pos (+ l pos)) (send (lexer-state-parens ls) is-open-pos? (- m start-pos))
c) (send (lexer-state-parens ls) is-close-pos? (- pos start-pos)))
(else (delete pos (+ l pos))
(delete pos (+ l pos)) c)
(get-close-paren pos (cdr closers)))))) (else
(delete pos (+ l pos))
(get-close-paren pos (cdr closers) #t))))
(begin
(delete pos (+ l pos))
(if continue-after-non-paren?
(get-close-paren pos (cdr closers) #t)
#f)))))
c)))))) c))))))
(inherit insert delete flash-on on-default-char) (inherit insert delete flash-on on-default-char)
@ -877,7 +884,15 @@ added get-regions
(let ((closer (let ((closer
(begin (begin
(begin-edit-sequence #f #f) (begin-edit-sequence #f #f)
(get-close-paren pos (if fixup? (map symbol->string (map cadr pairs)) null))))) (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) (end-edit-sequence)
(let ((insert-str (if closer closer (string char)))) (let ((insert-str (if closer closer (string char))))
(for-each (lambda (c) (for-each (lambda (c)

12
collects/scribblings/framework/color.scrbl
View File

@ -203,11 +203,13 @@
} }
@defmethod*[(((insert-close-paren (position natural-number?) (char char?) (flash? boolean?) (fixup? boolean?)) void))]{ @defmethod*[(((insert-close-paren (position natural-number?) (char char?) (flash? boolean?) (fixup? boolean?)) void))]{
Position is the place to put the parenthesis and char is the The @scheme[position] is the place to put the parenthesis, and @scheme[char] is the
parenthesis to be added. If @scheme[fixup?] is true, the right kind of closing parenthesis to be added (e.g., that the user typed). If @scheme[fixup?] is true, the right kind of closing
parenthesis will be chosen from the pairs list kept last passed to parenthesis will be chosen from the set previously passed to
@scheme[start-colorer], otherwise char will be inserted, even if it is not the @scheme[start-colorer]---but only if an inserted @scheme[char] would be colored
right kind. If @scheme[flash?] is true the matching open parenthesis will be as a parenthesis (i.e., with the @scheme['parenthesis] classification).
Otherwise, @scheme[char] will be inserted, even if it is not the
right kind. If @scheme[flash?] is true, the matching open parenthesis will be
flashed. flashed.
} }
@defmethod*[(((classify-position (position natural-number?)) symbol?))]{ @defmethod*[(((classify-position (position natural-number?)) symbol?))]{