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

added a something to the preferences pane to be able to pick the parenthesis color scheme

Browse Source 
svn: r7885
This commit is contained in:
Robby Findler 2007-12-01 16:16:58 +00:00
parent 2ea9ded9bf
commit 063f1a95c9
6 changed files with 78 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/drscheme/private/font.ss
View File

@ -21,7 +21,7 @@
(define (setup-preferences)
(preferences:add-panel
(list (string-constant font-prefs-panel-title)
(string-constant drscheme))
#;(string-constant drscheme)) ;; thre is no help desk font configuration anymore ...
(λ (panel)
(letrec ([main (make-object vertical-panel% panel)]
[min-size 1]

29
collects/framework/private/color-prefs.ss
View File

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

75
collects/framework/private/color.ss
View File

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

2
collects/framework/private/main.ss
View File

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

2
collects/framework/private/sig.ss
View File

@ -365,7 +365,7 @@
text-mode-mixin
text-mode%))
(define-signature color^ extends color-class^
())
(get-parenthesis-colors-table))
(define-signature color-prefs-class^
())

12
collects/string-constants/english-string-constants.ss
View File

@ -256,6 +256,16 @@ please adhere to these guidelines:
(syntax-coloring-choose-color "Choose a color for ~a")
(preferences-colors "Colors") ;; used in the preferences dialog
;; parenthesis color scheme string constants
(parenthesis-color-scheme "Parenthesis color scheme") ;; label for the choice% menu in the preferences dialog
(paren-color-basic-grey "Basic grey")
(paren-color-shades-of-gray "Shades of grey")
(paren-color-shades-of-blue "Shades of blue")
(paren-color-spring "Spring")
(paren-color-fall "Fall")
(paren-color-winter "Winter")
(url: "URL:")
(open-url... "Open URL...")
(open-url "Open URL")
@ -410,7 +420,7 @@ please adhere to these guidelines:
(separate-dialog-for-searching "Use separate dialog for searching")
(reuse-existing-frames "Reuse existing frames when opening new files")
(default-fonts "Default Fonts")
(paren-match-color "Parenthesis highlight color") ; in prefs dialog
(basic-gray-paren-match-color "Basic gray parenthesis highlight color") ; in prefs dialog
(online-coloring-active "Color syntax interactively")
(open-files-in-tabs "Open files in separate tabs (not separate windows)")
(show-interactions-on-execute "Automatically open interactions window when running a program")