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

*** empty log message ***

Browse Source 
original commit: e4269845662cb20dcfecd03d32e0662d9e582203
This commit is contained in:
Scott Owens 2003-11-11 06:27:46 +00:00
parent 8f2cc3e3fa
commit 29be2537d1
4 changed files with 51 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -107,17 +107,15 @@
(send bold-check set-value (eq? (send style get-weight) 'bold))
(send underline-check set-value (send style get-underlined))))
(define add/mult-set
(lambda (m v)
(send m set (car v) (cadr v) (caddr v))))
(define (add/mult-set m v)
(send m set (car v) (cadr v) (caddr v)))
(define add/mult-get
(lambda (m)
(let ([b1 (box 0)]
[b2 (box 0)]
[b3 (box 0)])
(send m get b1 b2 b3)
(map unbox (list b1 b2 b3)))))
(define (add/mult-get m)
(let ([b1 (box 0)]
[b2 (box 0)]
[b3 (box 0)])
(send m get b1 b2 b3)
(map unbox (list b1 b2 b3))))
(define style-delta-get/set
(list (cons (lambda (x) (send x get-alignment-off))
@ -166,22 +164,19 @@
sym
code-style
(lambda (x)
(is-a? x style-delta%)))
(preferences:set-un/marshall sym marshall-style unmarshall-style))
(is-a? x style-delta%))))
; a symbol naming the style and a delta to set it to
(define set-slatex-style
(lambda (sym 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)
(send style-list new-named-style name
(send style-list find-or-create-style
(send style-list find-named-style "Standard")
delta))))))
(define (set-slatex-style sym 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)
(send style-list new-named-style name
(send style-list find-or-create-style
(send style-list find-named-style "Standard")
delta)))))
(define (make-style-delta color bold? underline? italic?)
@ -221,11 +216,14 @@
(define (add tab-name symbols/defaults)
(let* ((prefix (string->symbol (format "syntax-coloring:~a" tab-name)))
(active-pref (string->symbol (format "~a:active" prefix))))
(active-pref (string->symbol (format "~a:active" prefix)))
(syms (map (lambda (s/d) (string->symbol (format "~a:~a" prefix (car s/d))))
symbols/defaults)))
(for-each set-default syms (map cadr symbols/defaults))
(for-each (lambda (s)
(set-default (string->symbol (format "~a:~a" prefix (car s)))
(cadr s)))
symbols/defaults)
(preferences:set-un/marshall s marshall-style unmarshall-style))
syms)
(for-each set-slatex-style syms (map preferences:get syms))
(preferences:set-default active-pref #t (lambda (x) #t))
(preferences:add-panel `("Editing" "Colors" ,tab-name)
(lambda (p)

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

@ -139,15 +139,17 @@
(set! current-pos (+ len current-pos))
(sync-invalid)
(when (and should-color? (not (eq? 'white-space type)))
(set! colors (cons
(let ((color (preferences:get (string->symbol (format "syntax-coloring:~a:~a"
prefix
type))))
(sp (+ in-start-pos (sub1 new-token-start)))
(ep (+ in-start-pos (sub1 new-token-end))))
(lambda ()
(change-style color sp ep #f)))
colors)))
(set! colors
(cons
(let ((color (send (get-style-list) find-named-style
(format "syntax-coloring:~a:~a"
prefix
type)))
(sp (+ in-start-pos (sub1 new-token-start)))
(ep (+ in-start-pos (sub1 new-token-end))))
(lambda ()
(change-style color sp ep #f)))
colors)))
(insert-last! tokens (new token-tree% (length len) (data data)))
(send parens add-token data len)
(cond

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

@ -16,7 +16,8 @@
[exit : framework:exit^]
[group : framework:group^]
[handler : framework:handler^]
[editor : framework:editor^])
[editor : framework:editor^]
[color-prefs : framework:color-prefs^])
(application-preferences-handler (lambda () (preferences:show-dialog)))
@ -215,4 +216,16 @@
(preferences:set 'framework:file-dialogs 'std)
(preferences:set 'framework:exit-when-no-frames #t)
;; This adds the preferences that scheme:text% needs for coloring
(color-prefs:add
"Scheme Color"
`((keyword ,(color-prefs:make-style-delta "Black" #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 "DimGray" #f #f #f))
(error ,(color-prefs:make-style-delta "Red" #f #f #f))
(identifier ,(color-prefs:make-style-delta "Navy" #f #f #f))
(other ,(color-prefs:make-style-delta "brown" #f #f #f))))
(void))))

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

@ -40,17 +40,6 @@
[-text% text%])
(color-prefs:add
"Scheme Color"
`((keyword ,(color-prefs:make-style-delta "Black" #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 "DimGray" #f #f #f))
(error ,(color-prefs:make-style-delta "Red" #f #f #f))
(identifier ,(color-prefs:make-style-delta "Navy" #f #f #f))
(other ,(color-prefs:make-style-delta "brown" #f #f #f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Sexp Snip ;;