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

*** empty log message ***

Browse Source 
original commit: 0b19269acf90556d27cde4d6059baed8fc541f12
This commit is contained in:
Scott Owens 2003-11-14 19:09:10 +00:00
parent b6ec6b57ff
commit 5db63babae
1 changed files with 39 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -54,6 +54,7 @@
(define up-to-date? #t)
(define stopped? #t)
(define force-stop? #f)
;; ---------------------- Parnethesis matching --------------------------
@ -162,7 +163,7 @@
(re-tokenize in in-start-pos)))))))
(define (do-insert/delete edit-start-pos change-length)
(unless stopped?
(unless (or stopped? force-stop?)
(when (> edit-start-pos start-pos)
(set! edit-start-pos (sub1 edit-start-pos)))
(modify)
@ -241,31 +242,33 @@
(background-colorer))
(define/public (start-colorer prefix- get-token- pairs-)
(set! stopped? #f)
(reset-tokens)
(set! should-color? (preferences:get (string->symbol (format "syntax-coloring:~a:active" prefix-))))
(set! prefix prefix-)
(set! get-token get-token-)
(set! pairs pairs-)
(set! parens (new paren-tree% (matches pairs)))
(unless remove-prefs-callback-thunk
(set! remove-prefs-callback-thunk
(preferences:add-callback
(string->symbol (format "syntax-coloring:~a:active" prefix))
(lambda (_ on?)
(set! should-color? on?)
(cond
(on?
(reset-tokens)
(do-insert/delete start-pos 0))
(else (change-style (send (get-style-list) find-named-style "Standard")
start-pos end-pos #f)))))))
(unless background-thread
(break-enabled #f)
(set! background-thread (thread (lambda () (background-colorer-entry))))
(break-enabled #t))
(do-insert/delete start-pos 0))
(unless force-stop?
(set! stopped? #f)
(reset-tokens)
(set! should-color?
(preferences:get (string->symbol (format "syntax-coloring:~a:active" prefix-))))
(set! prefix prefix-)
(set! get-token get-token-)
(set! pairs pairs-)
(set! parens (new paren-tree% (matches pairs)))
(unless remove-prefs-callback-thunk
(set! remove-prefs-callback-thunk
(preferences:add-callback
(string->symbol (format "syntax-coloring:~a:active" prefix))
(lambda (_ on?)
(set! should-color? on?)
(cond
(on?
(reset-tokens)
(do-insert/delete start-pos 0))
(else (change-style (send (get-style-list) find-named-style "Standard")
start-pos end-pos #f)))))))
(unless background-thread
(break-enabled #f)
(set! background-thread (thread (lambda () (background-colorer-entry))))
(break-enabled #t))
(do-insert/delete start-pos 0)))
(define/public (stop-colorer)
(set! stopped? #t)
(when remove-prefs-callback-thunk
@ -280,6 +283,16 @@
(set! get-token #f))
(define/public (force-stop-colorer x)
(printf "~a~n" x)
(set! force-stop? x)
(when x
(stop-colorer)
(when background-thread
(kill-thread background-thread)
(set! background-thread #f))))
;; ----------------------- Match parentheses ----------------------------
(define clear-old-locations 'dummy)