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

.

Browse Source 
original commit: 0e2a1e38916935ef053931d1e818dd5884967e40
This commit is contained in:
Robby Findler 2004-10-11 23:20:00 +00:00
parent af016863c7
commit accfdc0b84
3 changed files with 26 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/framework/framework.ss
View File

@ -1327,13 +1327,17 @@
"@flink editor:get-standard-style-list %" "@flink editor:get-standard-style-list %"
".") ".")
(editor:update-standard-style (editor:set-default-font-color
(-> (-> (is-a?/c style-delta%) void?) void?) (-> (is-a?/c color%) void?)
(change-delta) (color)
"Calls \\var{change-delta} with the \"Standard\" style delta from" "Sets the color of the style named"
"the result of" "@flink editor:get-default-color-style-name %"
"@flink editor:get-standard-style-list %"
".") ".")
(editor:get-default-color-style-name
(-> string?)
"The name of the style (in the list returned by "
"@flink editor:get-standard-style-list %"
") that holds the default color.")
(editor:set-standard-style-list-delta (editor:set-standard-style-list-delta
(string? (is-a?/c style-delta%) . -> . void?) (string? (is-a?/c style-delta%) . -> . void?)
(name delta) (name delta)

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

@ -211,7 +211,7 @@
'framework:paren-match-color) 'framework:paren-match-color)
(build-text-foreground-selection-panel vp (build-text-foreground-selection-panel vp
'framework:default-text-color 'framework:default-text-color
"Standard" (editor:get-default-color-style-name)
(string-constant default-text-color)))))) (string-constant default-text-color))))))
(define (build-text-foreground-selection-panel parent pref-sym style-name example-text) (define (build-text-foreground-selection-panel parent pref-sym style-name example-text)

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

@ -46,7 +46,9 @@
backward-containing-sexp backward-containing-sexp
forward-match forward-match
insert-close-paren insert-close-paren
classify-position)) classify-position
get-colorer-blank-style))
(define text-mixin (define text-mixin
(mixin (text:basic<%>) (-text<%>) (mixin (text:basic<%>) (-text<%>)
@ -134,7 +136,8 @@
(inherit change-style begin-edit-sequence end-edit-sequence highlight-range (inherit change-style begin-edit-sequence end-edit-sequence highlight-range
get-style-list in-edit-sequence? get-start-position get-end-position get-style-list in-edit-sequence? get-start-position get-end-position
local-edit-sequence? get-styles-fixed has-focus?) local-edit-sequence? get-styles-fixed has-focus?
get-fixed-style)
(define/private (reset-tokens) (define/private (reset-tokens)
(send tokens reset-tree) (send tokens reset-tree)
@ -187,8 +190,8 @@
(when (and should-color? (should-color-type? type) (not frozen?)) (when (and should-color? (should-color-type? type) (not frozen?))
(set! colors (set! colors
(cons (cons
(let ((color (send (get-style-list) find-named-style (let* ([style-name (token-sym->style type)]
(token-sym->style type))) (color (send (get-style-list) find-named-style style-name))
(sp (+ in-start-pos (sub1 new-token-start))) (sp (+ in-start-pos (sub1 new-token-start)))
(ep (+ in-start-pos (sub1 new-token-end)))) (ep (+ in-start-pos (sub1 new-token-end))))
(lambda () (lambda ()
@ -323,8 +326,7 @@
(set! stopped? #t) (set! stopped? #t)
(when (and clear-colors (not frozen?)) (when (and clear-colors (not frozen?))
(begin-edit-sequence #f #f) (begin-edit-sequence #f #f)
(change-style (send (get-style-list) find-named-style "Standard") (change-style (get-fixed-style) start-pos end-pos #f)
start-pos end-pos #f)
(end-edit-sequence)) (end-edit-sequence))
(match-parens #t) (match-parens #t)
(reset-tokens) (reset-tokens)
@ -332,6 +334,8 @@
(set! token-sym->style #f) (set! token-sym->style #f)
(set! get-token #f))) (set! get-token #f)))
(define/public (get-colorer-blank-style) (send (get-style-list) find-named-style "Standard"))
(define/public (is-frozen?) frozen?) (define/public (is-frozen?) frozen?)
;; See docs ;; See docs
@ -385,8 +389,7 @@
((and should-color? (not on?)) ((and should-color? (not on?))
(set! should-color? on?) (set! should-color? on?)
(begin-edit-sequence #f #f) (begin-edit-sequence #f #f)
(change-style (send (get-style-list) find-named-style "Standard") (change-style (get-fixed-style) start-pos end-pos #f)
start-pos end-pos #f)
(end-edit-sequence)))) (end-edit-sequence))))
;; see docs ;; see docs