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

*** empty log message ***

Browse Source 
original commit: 288ad2a7269bcd815f0784e34471a9ba121f3987
This commit is contained in:
Scott Owens 2003-12-01 05:22:50 +00:00
parent d3dffc7e92
commit 3894596b2a
4 changed files with 21 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,7 @@
(module color-prefs mzscheme (module color-prefs mzscheme
(require (lib "class.ss") (require (lib "class.ss")
(lib "unitsig.ss") (lib "unitsig.ss")
(lib "etc.ss")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "string-constant.ss" "string-constants") (lib "string-constant.ss" "string-constants")
"sig.ss") "sig.ss")
@ -225,7 +226,7 @@
syms) syms)
(for-each set-slatex-style syms (map preferences:get syms)) (for-each set-slatex-style syms (map preferences:get syms))
(preferences:set-default active-pref #t (lambda (x) #t)) (preferences:set-default active-pref #t (lambda (x) #t))
(preferences:add-panel `("Editing" "Colors" ,tab-name) (preferences:add-panel `("Syntax Coloring" ,tab-name)
(lambda (p) (lambda (p)
(let ((vp (new vertical-panel% (parent p)))) (let ((vp (new vertical-panel% (parent p))))
(new color-selection-panel% (new color-selection-panel%

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

@ -87,6 +87,9 @@
(define remove-prefs-callback-thunk #f) (define remove-prefs-callback-thunk #f)
(define prefix #f) (define prefix #f)
(define/public (coloring-active?)
should-color?)
;; ---------------------- Multi-threading ------------------------------- ;; ---------------------- Multi-threading -------------------------------
;; A list of thunks that color the buffer ;; A list of thunks that color the buffer
(define colors null) (define colors null)
@ -271,13 +274,15 @@
(preferences:add-callback (preferences:add-callback
(string->symbol (format "syntax-coloring:~a:active" prefix)) (string->symbol (format "syntax-coloring:~a:active" prefix))
(lambda (_ on?) (lambda (_ on?)
(set! should-color? on?)
(cond (cond
(on? ((and (not should-color?) on?)
(set! should-color? #t)
(reset-tokens) (reset-tokens)
(do-insert/delete start-pos 0)) (do-insert/delete start-pos 0))
(else (change-style (send (get-style-list) find-named-style "Standard") ((and should-color? (not on?))
start-pos end-pos #f))))))) (set! should-color? #f)
(change-style (send (get-style-list) find-named-style "Standard")
start-pos end-pos #f)))))))
(unless background-thread (unless background-thread
(break-enabled #f) (break-enabled #f)
(set! background-thread (thread (lambda () (background-colorer-entry)))) (set! background-thread (thread (lambda () (background-colorer-entry))))
@ -417,6 +422,8 @@
(set! remove-prefs-callback-thunk #f)) (set! remove-prefs-callback-thunk #f))
(super-on-close)) (super-on-close))
(rename (super-change-style change-style))
(super-instantiate ()))) (super-instantiate ())))
(define -text% (text-mixin text:keymap%)) (define -text% (text-mixin text:keymap%))

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

@ -219,13 +219,14 @@
;; This adds the preferences that scheme:text% needs for coloring ;; This adds the preferences that scheme:text% needs for coloring
(color-prefs:add (color-prefs:add
"Scheme Color" "Scheme Color"
`((keyword ,(color-prefs:make-style-delta "Black" #f #f #f)) `((symbol ,(color-prefs:make-style-delta "navy" #f #f #f))
(keyword ,(color-prefs:make-style-delta (make-object color% 40 25 15) #f #f #f))
(unbound-variable ,(color-prefs:make-style-delta "red" #f #f #f))
(bound-variable ,(color-prefs:make-style-delta "navy" #f #f #f))
(constant ,(color-prefs:make-style-delta (make-object color% 51 135 39) #f #f #f))
(string ,(color-prefs:make-style-delta "ForestGreen" #f #f #f)) (string ,(color-prefs:make-style-delta "ForestGreen" #f #f #f))
(literal ,(color-prefs:make-style-delta "ForestGreen" #f #f #f))
(comment ,(color-prefs:make-style-delta (make-object color% 0 105 255) #f #f #f)) (comment ,(color-prefs:make-style-delta (make-object color% 0 105 255) #f #f #f))
(error ,(color-prefs:make-style-delta "Red" #f #f #f)) (error ,(color-prefs:make-style-delta "red" #f #f #f))
(identifier ,(color-prefs:make-style-delta "Navy" #f #f #f)) (base ,(color-prefs:make-style-delta "brown" #f #f #f))))
(other ,(color-prefs:make-style-delta "brown" #f #f #f))))
(void)))) (void))))

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

@ -1044,7 +1044,7 @@
(define (scheme-lexer-wrapper in) (define (scheme-lexer-wrapper in)
(let-values (((type lex start end) (scheme-lexer in))) (let-values (((type lex start end) (scheme-lexer in)))
(cond (cond
((and (eq? type 'identifier) ((and (eq? type 'symbol)
(hash-table-get (preferences:get 'framework:tabify) (hash-table-get (preferences:get 'framework:tabify)
(string->symbol lex) (string->symbol lex)
(lambda () #f))) (lambda () #f)))