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

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