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

..

Browse Source 
original commit: ea95c0c66b632b77cd673852236ec079d63d36f6
This commit is contained in:
Robby Findler 2003-12-10 19:12:44 +00:00
parent 5ace21a45d
commit 9350fac023
3 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -102,7 +102,7 @@
;; ---------------------- Preferences ------------------------------- ;; ---------------------- Preferences -------------------------------
(define should-color? #t) (define should-color? #t)
(define tab-name #f) (define token-sym->style #f)
;; ---------------------- Multi-threading --------------------------- ;; ---------------------- Multi-threading ---------------------------
;; A list of thunks that color the buffer ;; A list of thunks that color the buffer
@ -165,7 +165,7 @@
(set! colors (set! colors
(cons (cons
(let ((color (send (get-style-list) find-named-style (let ((color (send (get-style-list) find-named-style
(scheme:short-sym->style-name type))) (token-sym->style type)))
(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 ()
@ -284,12 +284,12 @@
(colorer-driver) (colorer-driver)
(loop))))) (loop)))))
(define/public (start-colorer tab-name- get-token- pairs-) (define/public (start-colorer token-sym->style- get-token- pairs-)
(unless force-stop? (unless force-stop?
(set! stopped? #f) (set! stopped? #f)
(reset-tokens) (reset-tokens)
(set! should-color? (preferences:get 'framework:coloring-active)) (set! should-color? (preferences:get 'framework:coloring-active))
(set! tab-name tab-name-) (set! token-sym->style token-sym->style-)
(set! get-token get-token-) (set! get-token get-token-)
(set! pairs pairs-) (set! pairs pairs-)
(set! parens (new paren-tree% (matches pairs))) (set! parens (new paren-tree% (matches pairs)))
@ -308,7 +308,7 @@
(match-parens #t) (match-parens #t)
(reset-tokens) (reset-tokens)
(set! pairs null) (set! pairs null)
(set! tab-name #f) (set! token-sym->style #f)
(set! get-token #f))) (set! get-token #f)))
(define/public (freeze-colorer) (define/public (freeze-colorer)
@ -326,7 +326,7 @@
(when frozen? (when frozen?
(set! frozen? #f) (set! frozen? #f)
(when restart-after-freeze (when restart-after-freeze
(let ((tn tab-name) (let ((tn token-sym->style)
(gt get-token) (gt get-token)
(p pairs)) (p pairs))
(stop-colorer (not should-color?)) (stop-colorer (not should-color?))
@ -491,7 +491,9 @@
;; ;;
;; matches is a list of lists of matching paren types. ;; matches is a list of lists of matching paren types.
;; For example, '((|(| |)|) (|[| |]|)) ;; For example, '((|(| |)|) (|[| |]|))
(init-field (get-token default-lexer) (tab-name 'default) (matches null)) (init-field (get-token default-lexer)
(token-sym->style (lambda (x) "Standard"))
(matches null))
(rename (super-on-disable-surrogate on-disable-surrogate)) (rename (super-on-disable-surrogate on-disable-surrogate))
(define/override (on-disable-surrogate text) (define/override (on-disable-surrogate text)
@ -501,7 +503,7 @@
(rename (super-on-enable-surrogate on-enable-surrogate)) (rename (super-on-enable-surrogate on-enable-surrogate))
(define/override (on-enable-surrogate text) (define/override (on-enable-surrogate text)
(super-on-enable-surrogate text) (super-on-enable-surrogate text)
(send text start-colorer tab-name get-token matches)) (send text start-colorer token-sym->style get-token matches))
(super-instantiate ()))) (super-instantiate ())))

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

@ -195,8 +195,6 @@
color))) color)))
(scheme:get-color-prefs-table)) (scheme:get-color-prefs-table))
(preferences:set-default 'framework:coloring-active #t boolean?) (preferences:set-default 'framework:coloring-active #t boolean?)
;; need to add in the editor checkbox.
;; groups ;; groups

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

@ -257,7 +257,7 @@
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
;;; ;;; ;;; ;;; ;;; ;; ; ;; ;;; ; ;;; ;;; ;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;; ; ;; ;;; ; ;;; ;;; ;; ;; ;;;
(define color-prefs-table (define color-prefs-table
`((symbol ,(make-object color% 38 38 128) ,(string-constant scheme-mode-color-symbol)) `((symbol ,(make-object color% 38 38 128) ,(string-constant scheme-mode-color-symbol))
(keyword ,(make-object color% 38 38 128) ,(string-constant scheme-mode-color-keyword)) (keyword ,(make-object color% 38 38 128) ,(string-constant scheme-mode-color-keyword))
@ -1062,8 +1062,9 @@
(send text end-edit-sequence)) (send text end-edit-sequence))
(super-new (get-token scheme-lexer-wrapper) (super-new (get-token scheme-lexer-wrapper)
(tab-name "Scheme") (token-sym->style short-sym->style-name)
(matches '((|(| |)|) (matches '((|(| |)|)
(#\| \|#)
(|[| |]|) (|[| |]|)
(|{| |}|)))))) (|{| |}|))))))