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

fixed some bugs in the paren matcher's new coloring scheme

Browse Source 
svn: r7895
This commit is contained in:
Robby Findler 2007-12-04 04:48:53 +00:00
parent f0567df751
commit 701da807d2
1 changed files with 19 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -418,6 +418,7 @@
;; if color is a color, then it uses that color to higlight ;; if color is a color, then it uses that color to higlight
;; Otherwise, it treats it like a boolean, where a true value ;; Otherwise, it treats it like a boolean, where a true value
;; means the normal paren color and #f means an error color. ;; means the normal paren color and #f means an error color.
;; numbers are expected to have zero be start-pos.
(define/private (highlight start end caret-pos color) (define/private (highlight start end caret-pos color)
(let ([off (highlight-range (+ start-pos start) (+ start-pos end) (let ([off (highlight-range (+ start-pos start) (+ start-pos end)
(if (is-a? color color%) (if (is-a? color color%)
@ -487,19 +488,24 @@
[end orig-end] [end orig-end]
[depth 0]) [depth 0])
(when (< depth (vector-length (get-parenthesis-colors))) (when (< depth (vector-length (get-parenthesis-colors)))
(let seq-loop ([inner-sequence-start (+ start 1)])
(when (< inner-sequence-start end) ;; when there is at least one more color in the vector we'll look
(let ([post-whitespace (skip-whitespace inner-sequence-start 'forward #t)]) ;; for regions to color at that next level
(let-values ([(start-inner end-inner error-inner) (when (< (+ depth 1) (vector-length (get-parenthesis-colors)))
(send parens match-forward (- post-whitespace start-pos))]) (let seq-loop ([inner-sequence-start (+ start 1)])
(cond (when (< inner-sequence-start end)
[(and start-inner end-inner (not error-inner)) (let ([post-whitespace (- (skip-whitespace (+ inner-sequence-start start-pos) 'forward #t) start-pos)])
(paren-loop start-inner end-inner (+ depth 1)) (let-values ([(start-inner end-inner error-inner)
(seq-loop end-inner)] (send parens match-forward post-whitespace)])
[(skip-past-token post-whitespace) (cond
=> [(and start-inner end-inner (not error-inner))
(λ (after-non-paren-thing) (paren-loop start-inner end-inner (+ depth 1))
(seq-loop after-non-paren-thing))]))))) (seq-loop end-inner)]
[(skip-past-token post-whitespace)
=>
(λ (after-non-paren-thing)
(seq-loop after-non-paren-thing))]))))))
(highlight start end here (vector-ref (get-parenthesis-colors) depth))))) (highlight start end here (vector-ref (get-parenthesis-colors) depth)))))
;; See docs ;; See docs