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?))
(else position))))))))
(define/private (get-close-paren pos closers)
(define/private (get-close-paren pos closers continue-after-non-paren?)
(cond
((null? closers) #f)
(else
@ -859,16 +859,23 @@ added get-regions
(if ls
(let ([start-pos (lexer-state-start-pos ls)])
(insert c pos)
(let ((m (backward-match (+ l pos) start-pos)))
(cond
((and m
(send (lexer-state-parens ls) is-open-pos? (- m start-pos))
(send (lexer-state-parens ls) is-close-pos? (- pos start-pos)))
(delete pos (+ l pos))
c)
(else
(delete pos (+ l pos))
(get-close-paren pos (cdr closers))))))
(let ((cls (classify-position pos)))
(if (eq? cls 'parenthesis)
(let ((m (backward-match (+ l pos) start-pos)))
(cond
((and m
(send (lexer-state-parens ls) is-open-pos? (- m start-pos))
(send (lexer-state-parens ls) is-close-pos? (- pos start-pos)))
(delete pos (+ l pos))
c)
(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))))))
(inherit insert delete flash-on on-default-char)
@ -877,7 +884,15 @@ added get-regions
(let ((closer
(begin
(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)
(let ((insert-str (if closer closer (string char))))
(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))]{
Position is the place to put the parenthesis and char is the
parenthesis to be added. If @scheme[fixup?] is true, the right kind of closing
parenthesis will be chosen from the pairs list kept last passed to
@scheme[start-colorer], otherwise char will be inserted, even if it is not the
right kind. If @scheme[flash?] is true the matching open parenthesis will be
The @scheme[position] is the place to put the parenthesis, and @scheme[char] is the
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 set previously passed to
@scheme[start-colorer]---but only if an inserted @scheme[char] would be colored
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.
}
@defmethod*[(((classify-position (position natural-number?)) symbol?))]{