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

...

Browse Source 
original commit: 68476f7d0cba9c25e2e8e4422cf4f03dfb90256c
This commit is contained in:
Robby Findler 2000-08-13 14:49:40 +00:00
parent a16ddc1dcd
commit ad2528e6ad
1 changed files with 81 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
collects/framework/scheme.ss
View File

@ -119,7 +119,7 @@
[(= (position-line f) line) [(= (position-line f) line)
(let ([f-1 (- f 2)]) ;; -1 to go back one, -1 to be before char (let ([f-1 (- f 2)]) ;; -1 to go back one, -1 to be before char
(cond (cond
[(= f 0) [(< f-1 0)
#t] #t]
[(and (= (position-line f-1) line) [(and (= (position-line f-1) line)
(not (char=? (get-character f-1) #\\ ))) (not (char=? (get-character f-1) #\\ )))
@ -246,93 +246,87 @@
[mismatch-color (make-object color% "PINK")]) [mismatch-color (make-object color% "PINK")])
(opt-lambda ([just-clear? #f]) (opt-lambda ([just-clear? #f])
(when highlight-parens? (when highlight-parens?
(dynamic-wind (set! in-highlight-parens? #t)
(lambda () (begin-edit-sequence)
(set! in-highlight-parens? #t) (clear-old-locations)
(begin-edit-sequence)) (set! clear-old-locations void)
(lambda () (unless just-clear?
(clear-old-locations) (let* ([here (get-start-position)]
(set! clear-old-locations void) [there (get-end-position)]
(unless just-clear? [slash?
(let* ([here (get-start-position)] (lambda (before after)
[there (get-end-position)] (and (>= before 0)
[slash? (>= after 0)
(lambda (before after) (let ([text (get-text before after)])
(and (>= before 0) (and (string? text)
(>= after 0) (>= (string-length text) 1)
(let ([text (get-text before after)]) (char=? #\\ (string-ref text 0))))))]
(and (string? text) [is-paren?
(>= (string-length text) 1) (lambda (f)
(char=? #\\ (string-ref text 0))))))] (lambda (char)
[is-paren? (ormap (lambda (x) (char=? char (string-ref (f x) 0)))
(lambda (f) (scheme-paren:get-paren-pairs))))]
(lambda (char) [is-left-paren? (is-paren? car)]
(ormap (lambda (x) (char=? char (string-ref (f x) 0))) [is-right-paren? (is-paren? cdr)])
(scheme-paren:get-paren-pairs))))] (when (and (= here there)
[is-left-paren? (is-paren? car)] (not (in-single-line-comment? here)))
[is-right-paren? (is-paren? cdr)])
(when (and (= here there)
(not (in-single-line-comment? here)))
(let/ec k ;; before, after : (list number number boolean)
;; numbers indicate the range to highlight
;; boolean indicates if it is an errorneous highlight
(let ([before
(cond
[(and (> here 0)
(is-right-paren? (get-character (sub1 here))))
(cond
[(slash? (- here 2) (- here 1)) #f]
[(scheme-paren:backward-match
this here (get-limit here)
backward-cache)
=>
(lambda (end-pos)
(list end-pos here #f))]
[else (list (- here 1) here #t)])]
[else #f])]
[after
(cond
[(is-left-paren? (get-character here))
(cond
[(slash? (- here 1) here) #f]
[(scheme-paren:forward-match
this here (last-position)
forward-cache)
=>
(lambda (end-pos)
(list here end-pos #f))]
[else (list here (+ here 1) #t)])]
[else #f])]
[handle-single
(lambda (single)
(let* ([left (mzlib:function:first single)]
[right (mzlib:function:second single)]
[error? (mzlib:function:third single)]
[off (highlight-range
left
right
(if error? mismatch-color match-color)
(icon:get-paren-highlight-bitmap)
(= there here left))])
(set! clear-old-locations
(let ([old clear-old-locations])
(lambda ()
(old)
(off))))))])
;; before, after : (list number number boolean) (cond
;; numbers indicate the range to highlight [(and after before)
;; boolean indicates if it is an errorneous highlight (handle-single after)
(let ([before (handle-single before)]
(cond [after (handle-single after)]
[(and (> here 0) [before (handle-single before)]
(is-right-paren? (get-character (sub1 here)))) [else (void)])))))
(cond (end-edit-sequence)
[(slash? (- here 2) (- here 1)) #f] (set! in-highlight-parens? #f))))]
[(scheme-paren:backward-match
this here (get-limit here)
backward-cache)
=>
(lambda (end-pos)
(list end-pos here #f))]
[else (list (- here 1) here #t)])]
[else #f])]
[after
(cond
[(is-left-paren? (get-character here))
(cond
[(slash? (- here 1) here) #f]
[(scheme-paren:forward-match
this here (last-position)
forward-cache)
=>
(lambda (end-pos)
(list here end-pos #f))]
[else (list here (+ here 1) #t)])]
[else #f])]
[handle-single
(lambda (single)
(let* ([left (mzlib:function:first single)]
[right (mzlib:function:second single)]
[error? (mzlib:function:third single)]
[off (highlight-range
left
right
(if error? mismatch-color match-color)
(icon:get-paren-highlight-bitmap)
(= there here left))])
(set! clear-old-locations
(let ([old clear-old-locations])
(lambda ()
(old)
(off))))))])
(cond
[(and after before)
(handle-single after)
(handle-single before)]
[after (handle-single after)]
[before (handle-single before)]
[else (void)])))))))
(lambda ()
(end-edit-sequence)
(set! in-highlight-parens? #f))))))]
[get-limit (lambda (pos) 0)] [get-limit (lambda (pos) 0)]