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

make the paren highlight use non alpha=1 colors so that

Browse Source 
the paren highlight composes with other highlighting in the editor
This commit is contained in:
Robby Findler 2012-11-30 09:21:17 -06:00
parent cbe0831956
commit 7ac80bbb01
5 changed files with 107 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/framework/main.rkt
View File

@ -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

59
collects/framework/private/color.rkt
View File

@ -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))))))])
(define (between start end) (+ start (* (- end start) (/ x (- size 1)))))
(make-object color%
(between start-r end-r)
(between start-g end-g)
(between start-b end-b)))))))
(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%))

28
collects/framework/private/main.rkt
View File

@ -157,15 +157,33 @@
(editor:set-standard-style-list-pref-callbacks)
(color-prefs:set-default/color-scheme
'framework:paren-match-color
(let ([gray-level
(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))
(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

1
collects/framework/private/text.rkt
View File

@ -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

5
doc/release-notes/drracket/HISTORY.txt
View File

@ -39,6 +39,11 @@
- 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