added a something to the preferences pane to be able to pick the parenthesis color scheme
svn: r7885 original commit: 063f1a95c9df25b95666a295b8a56f06aa653883
This commit is contained in:
Robby Findler
parent
ff3a88ac88
commit
3dd695d685
|
|
@ -9,7 +9,9 @@
|
|||
(import [prefix preferences: framework:preferences^]
|
||||
[prefix editor: framework:editor^]
|
||||
[prefix panel: framework:panel^]
|
||||
[prefix canvas: framework:canvas^])
|
||||
[prefix canvas: framework:canvas^]
|
||||
[prefix scheme: framework:scheme^]
|
||||
[prefix color: framework:color^])
|
||||
(export framework:color-prefs^)
|
||||
(init-depend framework:editor^)
|
||||
|
||||
|
|
@ -290,11 +292,11 @@
|
|||
(list (string-constant preferences-colors)
|
||||
(string-constant background-color))
|
||||
(λ (parent)
|
||||
(let ([vp (new vertical-panel% (parent parent))])
|
||||
(let ([vp (new vertical-panel% (parent parent) (alignment '(left top)))])
|
||||
(add-solid-color-config (string-constant background-color)
|
||||
vp
|
||||
'framework:basic-canvas-background)
|
||||
(add-solid-color-config (string-constant paren-match-color)
|
||||
(add-solid-color-config (string-constant basic-gray-paren-match-color)
|
||||
vp
|
||||
'framework:paren-match-color)
|
||||
(build-text-foreground-selection-panel vp
|
||||
|
|
@ -302,6 +304,27 @@
|
|||
(editor:get-default-color-style-name)
|
||||
(string-constant default-text-color))
|
||||
|
||||
(let* ([choice (new choice%
|
||||
[label (string-constant parenthesis-color-scheme)]
|
||||
[parent vp]
|
||||
[choices (map (λ (x) (list-ref x 1))
|
||||
(color:get-parenthesis-colors-table))]
|
||||
[callback
|
||||
(λ (choice _)
|
||||
(preferences:set 'framework:paren-color-scheme
|
||||
(car (list-ref (color:get-parenthesis-colors-table)
|
||||
(send choice get-selection)))))])]
|
||||
[update-choice
|
||||
(lambda (v)
|
||||
(send choice set-string-selection
|
||||
(cadr (or (assoc v (color:get-parenthesis-colors-table))
|
||||
(car (color:get-parenthesis-colors-table))))))])
|
||||
(preferences:add-callback
|
||||
'framework:paren-color-scheme
|
||||
(λ (p v)
|
||||
(update-choice v)))
|
||||
(update-choice (preferences:get 'framework:paren-color-scheme)))
|
||||
|
||||
(let ([hp (new horizontal-panel%
|
||||
[parent vp]
|
||||
[alignment '(center top)])])
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
(lib "token-tree.ss" "syntax-color")
|
||||
(lib "paren-tree.ss" "syntax-color")
|
||||
(lib "default-lexer.ss" "syntax-color")
|
||||
string-constants/string-constant
|
||||
"../preferences.ss"
|
||||
"sig.ss")
|
||||
|
||||
|
|
@ -749,50 +750,48 @@
|
|||
(define (pref-callback k v) (toggle-color v))
|
||||
(preferences:add-callback 'framework:coloring-active pref-callback #t)))
|
||||
|
||||
(define parenthesis-colors #f)
|
||||
(define (get-parenthesis-colors)
|
||||
(unless parenthesis-colors
|
||||
(set! parenthesis-colors
|
||||
|
||||
(vector (preferences:get 'framework:paren-match-color))
|
||||
|
||||
;; shades of blue
|
||||
#;
|
||||
(between 204 204 255
|
||||
153 153 255)
|
||||
|
||||
;; shades of yellow (too pale)
|
||||
#;
|
||||
(between 255 255 204
|
||||
255 255 153)
|
||||
|
||||
;; springtime
|
||||
#;
|
||||
(between 255 255 153
|
||||
204 255 153)
|
||||
|
||||
;; fall
|
||||
#;
|
||||
(between 255 204 153
|
||||
204 153 102)
|
||||
|
||||
|
||||
;; shades of grey
|
||||
#;
|
||||
(let ([size 4])
|
||||
(build-vector
|
||||
4
|
||||
(lambda (x)
|
||||
(let* ([grey-amount (floor (+ 180 (* 40 (/ x size))))])
|
||||
(make-object color% grey-amount grey-amount grey-amount)))))))
|
||||
parenthesis-colors)
|
||||
(define parenthesis-color-table #f)
|
||||
(define (get-parenthesis-colors-table)
|
||||
(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))
|
||||
(list 'shades-of-blue
|
||||
(string-constant paren-color-shades-of-blue)
|
||||
(between 204 204 255
|
||||
153 153 255))
|
||||
(list 'spring
|
||||
(string-constant paren-color-spring)
|
||||
(between 255 255 153
|
||||
204 255 153))
|
||||
(list 'fall
|
||||
(string-constant paren-color-fall)
|
||||
(between 255 204 153
|
||||
204 153 102))
|
||||
(list 'winter
|
||||
(string-constant paren-color-winter)
|
||||
(between 204 205 255
|
||||
255 255 255)))))
|
||||
(cons (list 'basic-grey
|
||||
(string-constant paren-color-basic-grey)
|
||||
(vector (preferences:get 'framework:paren-match-color)))
|
||||
parenthesis-color-table))
|
||||
|
||||
(define (get-parenthesis-colors)
|
||||
(let ([choice (or (assoc (preferences:get 'framework:paren-color-scheme)
|
||||
(get-parenthesis-colors-table))
|
||||
(car (get-parenthesis-colors-table)))])
|
||||
(caddr choice)))
|
||||
|
||||
(define (between start-r start-g start-b end-r end-g end-b)
|
||||
(let ([size 4])
|
||||
(build-vector
|
||||
4
|
||||
(lambda (x)
|
||||
(let ([between (λ (start end) (+ start (* (- end start) (/ x (- size 1)))))])
|
||||
(let ([between (λ (start end) (floor (+ start (* (- end start) (/ x (- size 1))))))])
|
||||
(make-object color%
|
||||
(between start-r end-r)
|
||||
(between start-g end-g)
|
||||
|
|
|
|||
|
|
@ -20,6 +20,8 @@
|
|||
|
||||
(application-preferences-handler (λ () (preferences:show-dialog)))
|
||||
|
||||
(preferences:set-default 'framework:paren-color-scheme 'basic-grey symbol?)
|
||||
|
||||
(preferences:set-default 'framework:square-bracket:cond/offset
|
||||
'(("case-lambda" 0)
|
||||
("cond" 0)
|
||||
|
|
|
|||
|
|
@ -365,7 +365,7 @@
|
|||
text-mode-mixin
|
||||
text-mode%))
|
||||
(define-signature color^ extends color-class^
|
||||
())
|
||||
(get-parenthesis-colors-table))
|
||||
|
||||
(define-signature color-prefs-class^
|
||||
())
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user