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

adjust find-next-outer-paren to avoid editing the buffer

Browse Source 
related to PR 13454

original commit: aaf4a2e16d5b4218ca4bd6788525fa7541879daa
This commit is contained in:
Robby Findler 2013-01-26 09:04:51 -06:00
parent 0bc00b3693
commit a5a8bc2e71
1 changed files with 22 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/framework/private/color.rkt
View File

@ -947,27 +947,28 @@ added get-regions
;; find-next-outer-paren : number (list string) ;; find-next-outer-paren : number (list string)
;; -> (values (or #f number) (or #f number) (or #f string)) ;; -> (values (or #f number) (or #f number) (or #f string))
(define/private (find-next-outer-paren pos closers) (define/private (find-next-outer-paren pos closers)
(let loop ([pos pos])
(define after-ws (skip-whitespace pos 'forward #f))
(cond (cond
[(null? closers) (values #f #f #f)] [after-ws
[else (define tok (classify-position after-ws))
(define c (car closers)) ; pick a close parens (define-values (a b) (get-token-range after-ws))
(define l (string-length c))
(define ls (find-ls pos))
(cond (cond
[(not ls) (values #f #f #f)] [(eq? tok 'parenthesis)
(define str (get-text a b))
(cond
[(member str closers)
(values a b str)]
[else [else
(define start-pos (lexer-state-start-pos ls)) (define m (forward-match a (last-position)))
(insert c pos) ; temporarily insert c (cond
(define m (backward-match (+ l pos) start-pos)) ; find matching open parens [m (loop m)]
(delete pos (+ l pos)) ; delete c [else (values #f #f #f)])])]
(define n ; now from the open parens find the *real* matching close parens [(<= b (last-position))
(and m (forward-match m (last-position)))) ; n is the position *after* the close (loop b)]
#;(printf "outer: ~a~n" (list pos n m (and n m (let-values ([(a b) (get-token-range (- n l))]) [else
(list a b))))) (values #f #f #f)])]
(if n [else (values #f #f)])))
(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 ;; returns the start and end positions of the next token at or after