*** empty log message ***
original commit: 8448b16fa2c4483a9317b6183e5b9b62880d204a
This commit is contained in:
parent
524280b693
commit
b2dd2f5c15
|
@ -24,7 +24,7 @@
|
|||
(define sym (get-full-pref-name tab-name symbol))
|
||||
|
||||
(define delta (preferences:get sym))
|
||||
(define style-name (symbol->string sym))
|
||||
(define style-name (get-full-style-name tab-name symbol))
|
||||
(define c (make-object editor-canvas% this
|
||||
#f
|
||||
(list 'hide-hscroll
|
||||
|
@ -44,9 +44,9 @@
|
|||
(super-instantiate ()))))
|
||||
(preferences:add-callback sym
|
||||
(lambda (sym v)
|
||||
(set-slatex-style sym v)
|
||||
(set-slatex-style style-name v)
|
||||
#t))
|
||||
(set-slatex-style sym delta)
|
||||
(set-slatex-style style-name delta)
|
||||
(define (make-check name on off)
|
||||
(let* ([c (lambda (check command)
|
||||
(if (send check get-value)
|
||||
|
@ -167,10 +167,9 @@
|
|||
(lambda (x)
|
||||
(is-a? x style-delta%))))
|
||||
|
||||
; a symbol naming the style and a delta to set it to
|
||||
(define (set-slatex-style sym delta)
|
||||
; a string naming the style and a delta to set it to
|
||||
(define (set-slatex-style name delta)
|
||||
(let* ([style-list (editor:get-standard-style-list)]
|
||||
[name (symbol->string sym)]
|
||||
[style (send style-list find-named-style name)])
|
||||
(if style
|
||||
(send style set-delta delta)
|
||||
|
@ -228,9 +227,7 @@
|
|||
(define (add-staged tab-name symbols/defaults)
|
||||
(let* ((tab-name-symbol (string->symbol tab-name))
|
||||
(active-pref (get-full-pref-name tab-name "active"))
|
||||
(current (hash-table-get prefs-table tab-name-symbol (lambda () #f)))
|
||||
(syms (map (lambda (s/d) (get-full-pref-name tab-name (car s/d)))
|
||||
symbols/defaults)))
|
||||
(current (hash-table-get prefs-table tab-name-symbol (lambda () #f))))
|
||||
(when (eq? 'too-late current)
|
||||
(error 'color-prefs:add-staged
|
||||
"cannot be invoked after the preferences have already been created for this tab."))
|
||||
|
@ -239,11 +236,17 @@
|
|||
(preferences:add-callback active-pref
|
||||
(lambda (_ on?)
|
||||
(do-active-pref-callbacks tab-name on?))))
|
||||
(for-each set-default syms (map cadr symbols/defaults))
|
||||
(for-each (lambda (s)
|
||||
(preferences:set-un/marshall s marshall-style unmarshall-style))
|
||||
syms)
|
||||
(for-each set-slatex-style syms (map preferences:get syms))
|
||||
(for-each (lambda (s/d)
|
||||
(set-default (get-full-pref-name tab-name (car s/d)) (cadr s/d)))
|
||||
symbols/defaults)
|
||||
(for-each (lambda (s/d)
|
||||
(preferences:set-un/marshall (get-full-pref-name tab-name (car s/d))
|
||||
marshall-style unmarshall-style))
|
||||
symbols/defaults)
|
||||
(for-each (lambda (s/d)
|
||||
(set-slatex-style (get-full-style-name tab-name (car s/d))
|
||||
(preferences:get (get-full-pref-name tab-name (car s/d)))))
|
||||
symbols/defaults)
|
||||
(hash-table-put! prefs-table
|
||||
tab-name-symbol
|
||||
(append (if current current null) symbols/defaults))
|
||||
|
|
|
@ -17,7 +17,8 @@
|
|||
[group : framework:group^]
|
||||
[handler : framework:handler^]
|
||||
[editor : framework:editor^]
|
||||
[color-prefs : framework:color-prefs^])
|
||||
[color-prefs : framework:color-prefs^]
|
||||
[scheme : framework:scheme^])
|
||||
|
||||
(application-preferences-handler (lambda () (preferences:show-dialog)))
|
||||
|
||||
|
@ -216,5 +217,5 @@
|
|||
(preferences:set 'framework:file-dialogs 'std)
|
||||
(preferences:set 'framework:exit-when-no-frames #t)
|
||||
|
||||
|
||||
(scheme:add-coloring-preferences-panel)
|
||||
(void))))
|
||||
|
|
|
@ -257,21 +257,30 @@
|
|||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
||||
;;; ;;; ;;; ;;; ;;; ;; ; ;; ;;; ; ;;; ;;; ;; ;; ;;;
|
||||
|
||||
|
||||
|
||||
;; This adds the preferences that scheme:text% needs for coloring
|
||||
;; It returns a thunk that, when invoked will setup the panel in the
|
||||
;; preferences dialog.
|
||||
(define add-coloring-preferences-panel
|
||||
(color-prefs:add-staged
|
||||
"Scheme"
|
||||
`((symbol ,(color-prefs:make-style-delta "navy" #f #f #f))
|
||||
(keyword ,(color-prefs:make-style-delta "navy" #f #f #f))
|
||||
(comment ,(color-prefs:make-style-delta (make-object color% 0 105 255) #f #f #f))
|
||||
(string ,(color-prefs:make-style-delta "ForestGreen" #f #f #f))
|
||||
(constant ,(color-prefs:make-style-delta (make-object color% 51 135 39) #f #f #f))
|
||||
(parenthesis ,(color-prefs:make-style-delta "brown" #f #f #f))
|
||||
(error ,(color-prefs:make-style-delta "red" #f #f #f))
|
||||
(other ,(color-prefs:make-style-delta "black" #f #f #f)))))
|
||||
;; It uses the set! trick because it needs to not call add-staged
|
||||
;; until the preferences has been turned on in main.ss
|
||||
(define add-coloring-pref-state #f)
|
||||
(define (add-coloring-preferences-panel)
|
||||
(cond
|
||||
(add-coloring-pref-state
|
||||
(add-coloring-pref-state))
|
||||
(else
|
||||
(set! add-coloring-pref-state
|
||||
(color-prefs:add-staged
|
||||
"Scheme"
|
||||
`((symbol ,(color-prefs:make-style-delta "navy" #f #f #f))
|
||||
(keyword ,(color-prefs:make-style-delta "navy" #f #f #f))
|
||||
(comment ,(color-prefs:make-style-delta (make-object color% 0 105 255) #f #f #f))
|
||||
(string ,(color-prefs:make-style-delta "ForestGreen" #f #f #f))
|
||||
(constant ,(color-prefs:make-style-delta (make-object color% 51 135 39) #f #f #f))
|
||||
(parenthesis ,(color-prefs:make-style-delta "brown" #f #f #f))
|
||||
(error ,(color-prefs:make-style-delta "red" #f #f #f))
|
||||
(other ,(color-prefs:make-style-delta "black" #f #f #f))))))))
|
||||
|
||||
|
||||
;; for check syntax (to be moved elsewhere)
|
||||
(color-prefs:add-staged
|
||||
|
|
Loading…
Reference in New Issue
Block a user