From 7ac80bbb01ef6048df4a471dc7fd08b1838fce8d Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 30 Nov 2012 09:21:17 -0600 Subject: [PATCH] make the paren highlight use non alpha=1 colors so that the paren highlight composes with other highlighting in the editor --- collects/framework/main.rkt | 11 +++-- collects/framework/private/color.rkt | 61 ++++++++++++++++---------- collects/framework/private/main.rkt | 36 +++++++++++---- collects/framework/private/text.rkt | 1 + doc/release-notes/drracket/HISTORY.txt | 59 +++++++++++++------------ 5 files changed, 107 insertions(+), 61 deletions(-) diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt index ed52b54432..7063ffebe5 100644 --- a/collects/framework/main.rkt +++ b/collects/framework/main.rkt @@ -66,11 +66,16 @@ (proc-doc color:get-parenthesis-colors-table - (-> (listof (list/c symbol? string? (vectorof (is-a?/c color%))))) + (-> (listof (list/c symbol? string? (vectorof (is-a?/c color%)) (or/c 'low 'high)))) @{Returns a table of colors that get used for parenthesis highlighting. Each entry in the table consists of a symbolic name, a name to show - in a GUI, and the color to use. The colors are used to show the nesting - structure in the parens.}) + in a GUI, the color to use, and the @racket[_priority] argument to + pass to @racket[text:basic<%> highlight-range] when highlighting the parens. + Generally the priority should be @racket['low] if the color is solid + (α=1) but can be @racket['high] if the α component is small. + + When an entry in the table has multiple colors, they are used to show the nesting + structure in the parentheses.}) (thing-doc color:misspelled-text-color-style-name diff --git a/collects/framework/private/color.rkt b/collects/framework/private/color.rkt index 94f8fa25ed..e78cf4f323 100644 --- a/collects/framework/private/color.rkt +++ b/collects/framework/private/color.rkt @@ -665,14 +665,14 @@ added get-regions ;; Otherwise, it treats it like a boolean, where a true value ;; means the normal paren color and #f means an error color. ;; numbers are expected to have zero be start-pos. - (define/private (highlight ls start end caret-pos color) + (define/private (highlight ls start end caret-pos color [priority 'low]) (let* ([start-pos (lexer-state-start-pos ls)] [off (highlight-range (+ start-pos start) (+ start-pos end) (if (is-a? color color%) color (if color mismatch-color (get-match-color))) (= caret-pos (+ start-pos start)) - 'low)]) + priority)]) (set! clear-old-locations (let ([old clear-old-locations]) (λ () @@ -739,14 +739,16 @@ added get-regions ;; highlight-nested-region : lexer-state number number number -> void ;; colors nested regions of parentheses. (define/private (highlight-nested-region ls orig-start orig-end here) + (define priority (get-parenthesis-priority)) + (define paren-colors (get-parenthesis-colors)) (let paren-loop ([start orig-start] [end orig-end] [depth 0]) - (when (< depth (vector-length (get-parenthesis-colors))) + (when (< depth (vector-length paren-colors)) ;; when there is at least one more color in the vector we'll look ;; for regions to color at that next level - (when (< (+ depth 1) (vector-length (get-parenthesis-colors))) + (when (< (+ depth 1) (vector-length paren-colors)) (let seq-loop ([inner-sequence-start (+ start 1)]) (when (< inner-sequence-start end) (let ([post-whitespace (skip-whitespace inner-sequence-start 'forward #t)]) @@ -761,7 +763,7 @@ added get-regions (λ (after-non-paren-thing) (seq-loop after-non-paren-thing))])))))) - (highlight ls start end here (vector-ref (get-parenthesis-colors) depth))))) + (highlight ls start end here (vector-ref paren-colors depth) priority)))) ;; See docs (define/public (forward-match position cutoff) @@ -1155,32 +1157,40 @@ added get-regions (define parenthesis-color-table #f) (define (get-parenthesis-colors-table) + (define (reverse-vec v) (list->vector (reverse (vector->list v)))) (unless parenthesis-color-table (set! parenthesis-color-table (list (list 'shades-of-gray (string-constant paren-color-shades-of-gray) - (between 180 180 180 - 220 220 220)) + (reverse-vec + (between .2 0 0 0 + .2 0 0 0)) + 'high) (list 'shades-of-blue (string-constant paren-color-shades-of-blue) - (between 204 204 255 - 153 153 255)) + (between .4 153 153 255 + .4 153 153 255) + 'high) (list 'spring (string-constant paren-color-spring) - (between 255 255 153 - 204 255 153)) + (between 1 255 255 153 + 1 204 255 153) + 'low) (list 'fall (string-constant paren-color-fall) - (between 255 204 153 - 204 153 102)) + (between 1 255 204 153 + 1 204 153 102) + 'low) (list 'winter (string-constant paren-color-winter) - (between 204 205 255 - 238 238 255))))) + (between 1 204 205 255 + 1 238 238 255) + 'low)))) (cons (list 'basic-grey (string-constant paren-color-basic-grey) - (vector (preferences:get 'framework:paren-match-color))) + (vector (preferences:get 'framework:paren-match-color)) + 'high) parenthesis-color-table)) (define (get-parenthesis-colors) @@ -1189,16 +1199,23 @@ added get-regions (car (get-parenthesis-colors-table)))]) (caddr choice))) -(define (between start-r start-g start-b end-r end-g end-b) +(define (get-parenthesis-priority) + (let ([choice (or (assoc (preferences:get 'framework:paren-color-scheme) + (get-parenthesis-colors-table)) + (car (get-parenthesis-colors-table)))]) + (list-ref choice 3))) + +(define (between start-a start-r start-g start-b end-a end-r end-g end-b) (let ([size 4]) (build-vector 4 (lambda (x) - (let ([between (λ (start end) (floor (+ start (* (- end start) (/ x (- size 1))))))]) - (make-object color% - (between start-r end-r) - (between start-g end-g) - (between start-b end-b))))))) + (define (between start end) (+ start (* (- end start) (/ x (- size 1))))) + (make-object color% + (floor (between start-r end-r)) + (floor (between start-g end-g)) + (floor (between start-b end-b)) + (between start-a end-a)))))) (define -text% (text-mixin text:keymap%)) diff --git a/collects/framework/private/main.rkt b/collects/framework/private/main.rkt index d84cb1ef93..d6bc9635df 100644 --- a/collects/framework/private/main.rkt +++ b/collects/framework/private/main.rkt @@ -157,15 +157,33 @@ (editor:set-standard-style-list-pref-callbacks) -(color-prefs:set-default/color-scheme - 'framework:paren-match-color - (let ([gray-level - ;; old gray-level 192 - (if (eq? (system-type) 'windows) - (* 3/4 256) - (- (* 7/8 256) 1))]) - (make-object color% gray-level gray-level gray-level)) - (make-object color% 50 50 50)) +(let ([gray-level + ;; old gray-level 192 + (if (eq? (system-type) 'windows) + (* 3/4 256) + (- (* 7/8 256) 1))]) + (define default-color (make-object color% 0 0 0 (- 1. (/ gray-level 255)))) + (define w-o-b-default-color (make-object color% 255 255 255 (/ 50 255))) + (color-prefs:set-default/color-scheme 'framework:paren-match-color + default-color + w-o-b-default-color) + + ;; when the preference is currently set to the old color, + ;; then just update it to the new one (if someone really + ;; wants the old default, they can still have a color that is + ;; off by one from the old default which should be ok) + (define current-color (preferences:get 'framework:paren-match-color)) + (cond + [(and (= (send current-color red) gray-level) + (= (send current-color green) gray-level) + (= (send current-color blue) gray-level) + (= (send current-color alpha) 1.0)) + (preferences:set 'framework:paren-match-color default-color)] + [(and (= (send current-color red) 50) + (= (send current-color green) 50) + (= (send current-color blue) 50) + (= (send current-color alpha) 1.0)) + (preferences:set 'framework:paren-match-color w-o-b-default-color)])) (preferences:set-default 'framework:recently-opened-files/pos null diff --git a/collects/framework/private/text.rkt b/collects/framework/private/text.rkt index 3f8888c87b..45fe22bfcf 100644 --- a/collects/framework/private/text.rkt +++ b/collects/framework/private/text.rkt @@ -423,6 +423,7 @@ (define height (if (bottom . <= . top) 0 (- bottom top))) (define color (let ([rc (rectangle-color rectangle)]) (cond + [(not (= 1 (send rc alpha))) rc] [(and last-color (eq? last-color rc)) rc] [rc diff --git a/doc/release-notes/drracket/HISTORY.txt b/doc/release-notes/drracket/HISTORY.txt index c2db1ad43a..d13538382f 100644 --- a/doc/release-notes/drracket/HISTORY.txt +++ b/doc/release-notes/drracket/HISTORY.txt @@ -11,34 +11,39 @@ . Automatic-parenthesis mode improvements (thanks to Nadeem Abdul Hamid) - - Added some "smart-skip" behavior to insert-close-paren, - described in the documentation. - - When auto-parens mode is enabled, - the existing "balance-parens" keybinding invokes - insert-close-paren with a smart-skip argument of - 'adjacent - - A new "balance-parens-forward" keybinding invokes - insert-close-paren with a smart-skip argument of - 'forward (whether or not auto-parens mode is - enabled) - - - Some basic smart-skip behavior is also enabled for - strings ("...") and |...| pairs, specifically, typing - a double-quote or bar character when the cursor - immediately precedes one causes the cursor to simply - skip over the existing one - - - Tweaked insertion of block comment pairs in - auto-parens mode - - - In strings and line/block comments, auto-parens mode - no longer has any effect (you can still use the M+.. - keybindings to force insertion of a particular brace - pair) - - - Detect when a character constant is being typed, and - don't insert brace pairs if so + - Added some "smart-skip" behavior to insert-close-paren, + described in the documentation. + - When auto-parens mode is enabled, + the existing "balance-parens" keybinding invokes + insert-close-paren with a smart-skip argument of + 'adjacent + - A new "balance-parens-forward" keybinding invokes + insert-close-paren with a smart-skip argument of + 'forward (whether or not auto-parens mode is + enabled) + + - Some basic smart-skip behavior is also enabled for + strings ("...") and |...| pairs, specifically, typing + a double-quote or bar character when the cursor + immediately precedes one causes the cursor to simply + skip over the existing one + + - Tweaked insertion of block comment pairs in + auto-parens mode + + - In strings and line/block comments, auto-parens mode + no longer has any effect (you can still use the M+.. + keybindings to force insertion of a particular brace + pair) + + - Detect when a character constant is being typed, and + don't insert brace pairs if so + + . DrRacket's window can now be substantially narrower + . DrRacket's paren highlighting uses alpha-blending to avoid having + the highlight disappear completely when completely inside an + error. ------------------------------ Version 5.3.1