fixed a bug in new paren coloring behavior

svn: r7872

original commit: 6913fab8f6122e7ca14b34bef78ea6708a75dd58
This commit is contained in:
Robby Findler 2007-11-30 19:54:44 +00:00
parent 6fa5a1d6ca
commit 8f3e7c056c
2 changed files with 10 additions and 6 deletions

View File

@ -413,14 +413,15 @@
(define mismatch-color (make-object color% "PINK")) (define mismatch-color (make-object color% "PINK"))
(define/private (get-match-color) (preferences:get 'framework:paren-match-color)) (define/private (get-match-color) (preferences:get 'framework:paren-match-color))
;; higlight : number number number (or/c #f #t color) ;; higlight : number number number (or/c color any)
;; if color is a boolean, then #t means the normal paren color and #f means an error color. ;; if color is a color, then it uses that color to higlight
;; Otherwise, color is a color ;; Otherwise, it treats it like a boolean, where a true value
;; means the normal paren color and #f means an error color.
(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 (boolean? color) (if (is-a? color color%)
(if color mismatch-color (get-match-color)) color
color) (if color mismatch-color (get-match-color)))
(and (send (icon:get-paren-highlight-bitmap) (and (send (icon:get-paren-highlight-bitmap)
ok?) ok?)
(icon:get-paren-highlight-bitmap)) (icon:get-paren-highlight-bitmap))

View File

@ -261,6 +261,9 @@ WARNING: printf is rebound in the body of the unit to always
(unless (or (eq? priority 'high) (eq? priority 'low)) (unless (or (eq? priority 'high) (eq? priority 'low))
(error 'highlight-range "expected last argument to be either 'high or 'low, got: ~e" (error 'highlight-range "expected last argument to be either 'high or 'low, got: ~e"
priority)) priority))
(unless (is-a? color color%)
(error 'highlight-range "expected a color for the third argument, got ~s" color))
(let ([l (make-range start end bitmap color caret-space?)]) (let ([l (make-range start end bitmap color caret-space?)])
(invalidate-rectangles range-rectangles) (invalidate-rectangles range-rectangles)
(set! ranges (if (eq? priority 'high) (cons l ranges) (append ranges (list l)))) (set! ranges (if (eq? priority 'high) (cons l ranges) (append ranges (list l))))