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

add preference settings so that the misspelled words color

Browse Source 
can be configured
This commit is contained in:
Robby Findler 2012-10-14 22:27:50 -05:00
parent 44a0c8a6c1
commit a59df8c7ee
5 changed files with 62 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/framework/private/color-prefs.rkt
View File

@ -341,6 +341,11 @@
(editor:get-default-color-style-name)
(string-constant default-text-color))
(build-text-foreground-selection-panel vp
'framework:misspelled-text-color
color:misspelled-text-color-style-name
(string-constant misspelled-text-color))
(let* ([choice (new choice%
[label (string-constant parenthesis-color-scheme)]
[parent vp]

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

@ -363,28 +363,32 @@ added get-regions
(define color (send (get-style-list) find-named-style style-name))
(cond
[(and spell-check-strings? (eq? type 'string))
(define misspelled-color (send (get-style-list) find-named-style "Standard"))
(define strs (regexp-split #rx"\n" (get-text sp ep)))
(let loop ([strs strs]
[pos sp])
(unless (null? strs)
(define str (car strs))
(let loop ([spellos (query-aspell str)]
[lp 0])
(cond
[(null? spellos)
(set! colorings (cons (vector color (+ sp lp) (+ sp (string-length str)))
colorings))]
[else
(define err (car spellos))
(define err-start (list-ref err 0))
(define err-len (list-ref err 1))
(set! colorings (list* (vector color (+ pos lp) (+ pos err-start))
(vector misspelled-color (+ pos err-start) (+ pos err-start err-len))
colorings))
(loop (cdr spellos) (+ err-start err-len))]))
(loop (cdr strs)
(+ pos (string-length str) 1))))]
(define misspelled-color (send (get-style-list) find-named-style misspelled-text-color-style-name))
(cond
[misspelled-color
(define strs (regexp-split #rx"\n" (get-text sp ep)))
(let loop ([strs strs]
[pos sp])
(unless (null? strs)
(define str (car strs))
(let loop ([spellos (query-aspell str)]
[lp 0])
(cond
[(null? spellos)
(set! colorings (cons (vector color (+ sp lp) (+ sp (string-length str)))
colorings))]
[else
(define err (car spellos))
(define err-start (list-ref err 0))
(define err-len (list-ref err 1))
(set! colorings (list* (vector color (+ pos lp) (+ pos err-start))
(vector misspelled-color (+ pos err-start) (+ pos err-start err-len))
colorings))
(loop (cdr spellos) (+ err-start err-len))]))
(loop (cdr strs)
(+ pos (string-length str) 1))))]
[else
(set! colorings (cons (vector color sp ep) colorings))])]
[else
(set! colorings (cons (vector color sp ep) colorings))]))
@ -1141,3 +1145,5 @@ added get-regions
(super-new)))
(define text-mode% (text-mode-mixin mode:surrogate-text%))
(define misspelled-text-color-style-name "Misspelled Text")

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

@ -12,7 +12,8 @@
[prefix editor: framework:editor^]
[prefix color-prefs: framework:color-prefs^]
[prefix racket: framework:racket^]
[prefix early-init: framework:early-init^])
[prefix early-init: framework:early-init^]
[prefix color: framework:color^])
(export framework:main^)
(init-depend framework:preferences^ framework:exit^ framework:editor^
framework:color-prefs^ framework:racket^ framework:early-init^)
@ -371,10 +372,34 @@
(editor:set-default-font-color v)))
(editor:set-default-font-color (preferences:get 'framework:default-text-color))
(color-prefs:set-default/color-scheme 'framework:misspelled-text-color "black" "white")
(color-prefs:set-default/color-scheme 'framework:delegatee-overview-color
"light blue"
(make-object color% 62 67 155))
(let ([delta (make-object style-delta%)]
[style (send (editor:get-standard-style-list) find-named-style color:misspelled-text-color-style-name)])
(if style
(send style set-delta delta)
(send (editor:get-standard-style-list) new-named-style color:misspelled-text-color-style-name
(send (editor:get-standard-style-list) find-or-create-style
(send (editor:get-standard-style-list) find-named-style "Standard")
delta))))
(let ([update-style-list
(λ (v)
(define sl (editor:get-standard-style-list))
(define style (send sl find-named-style color:misspelled-text-color-style-name))
(define delta (new style-delta%))
(send style get-delta delta)
(send delta set-delta-foreground v)
(send style set-delta delta))])
(preferences:add-callback
'framework:misspelled-text-color
(λ (p v) (update-style-list v)))
(update-style-list
(preferences:get 'framework:misspelled-text-color)))
;; groups

3
collects/framework/private/sig.rkt
View File

@ -400,7 +400,8 @@
text-mode-mixin
text-mode%))
(define-signature color^ extends color-class^
(get-parenthesis-colors-table))
(get-parenthesis-colors-table
misspelled-text-color-style-name))
(define-signature color-prefs-class^
())

2
collects/string-constants/private/english-string-constants.rkt
View File

@ -1685,5 +1685,5 @@ please adhere to these guidelines:
;; menu item in the 'edit' menu; applies to editors with programs in them
;; (technically, editors that implement color:text<%>)
(spell-check-string-constants "Spell Check String Constants")
(misspelled-text-color "Misspelled Text Color") ;; in the preferences dialog
)