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

*** empty log message ***

Browse Source 
original commit: 1c49046a3bb9d85817b1d00b48946ce5e27d61e7
This commit is contained in:
Scott Owens 2003-11-14 22:49:41 +00:00
parent bb30bc6382
commit 81d5917125
1 changed files with 36 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -53,9 +53,16 @@
;; If the tree is completed ;; If the tree is completed
(define up-to-date? #t) (define up-to-date? #t)
;; The tokenizer is stopped
(define stopped? #t) (define stopped? #t)
;; The tokenizer is stopped and prevented from starting
(define force-stop? #f) (define force-stop? #f)
;; color-callback has been suspended because the text% became locked and
;; should be requeued when the text% is unlocked.
(define restart-callback #f)
;; ---------------------- Parnethesis matching -------------------------- ;; ---------------------- Parnethesis matching --------------------------
(define pairs '()) (define pairs '())
@ -87,7 +94,7 @@
(define background-thread #f) (define background-thread #f)
;; Prevent the background thread from being put to sleep while modifying ;; Prevent the background thread from being put to sleep while modifying
;; global state ;; global state
(define lock (make-semaphore 1)) (define mutex-lock (make-semaphore 1))
(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
@ -97,6 +104,7 @@
(send invalid-tokens reset-tree) (send invalid-tokens reset-tree)
(set! invalid-tokens-start +inf.0) (set! invalid-tokens-start +inf.0)
(set! up-to-date? #t) (set! up-to-date? #t)
(set! restart-callback #f)
(set! parens (new paren-tree% (matches pairs))) (set! parens (new paren-tree% (matches pairs)))
(set! current-pos start-pos) (set! current-pos start-pos)
(set! colors null) (set! colors null)
@ -131,7 +139,7 @@
(break-enabled #f) (break-enabled #f)
;; If a break occurs while we are suspended, the break will occur ;; If a break occurs while we are suspended, the break will occur
;; and the critical section will not be entered ;; and the critical section will not be entered
(semaphore-wait/enable-break lock) (semaphore-wait/enable-break mutex-lock)
(unless (eq? 'eof type) (unless (eq? 'eof type)
(let ((len (- new-token-end new-token-start))) (let ((len (- new-token-end new-token-start)))
(set! current-pos (+ len current-pos)) (set! current-pos (+ len current-pos))
@ -158,7 +166,7 @@
(insert-last! tokens invalid-tokens) (insert-last! tokens invalid-tokens)
(set! invalid-tokens-start +inf.0)) (set! invalid-tokens-start +inf.0))
(else (else
(semaphore-post lock) (semaphore-post mutex-lock)
(break-enabled #t) (break-enabled #t)
(re-tokenize in in-start-pos))))))) (re-tokenize in in-start-pos)))))))
@ -199,17 +207,21 @@
(inherit is-locked?) (inherit is-locked?)
(define (colorer-callback) (define (colorer-callback)
(unless (or (in-edit-sequence?) (is-locked?)) (cond
((is-locked?)
(set! restart-callback #t))
(else
(unless (in-edit-sequence?)
(thread-resume background-thread) (thread-resume background-thread)
(sleep .01) ;; This is when the background thread is working. (sleep .01) ;; This is when the background thread is working.
(semaphore-wait lock) (semaphore-wait mutex-lock)
(thread-suspend background-thread) (thread-suspend background-thread)
(semaphore-post lock) (semaphore-post mutex-lock)
(begin-edit-sequence #f #f) (begin-edit-sequence #f #f)
(color) (color)
(end-edit-sequence)) (end-edit-sequence))
(unless up-to-date? (unless up-to-date?
(queue-callback colorer-callback #f))) (queue-callback colorer-callback #f)))))
;; Breaks should be disabled on entry ;; Breaks should be disabled on entry
@ -231,13 +243,13 @@
(lambda (exn) (lambda (exn)
(printf "colorer thread: ~s\n" exn) (printf "colorer thread: ~s\n" exn)
(break-enabled #f) (break-enabled #f)
(semaphore-wait lock)))) (semaphore-wait mutex-lock))))
(re-tokenize (open-input-text-editor this current-pos end-pos) (re-tokenize (open-input-text-editor this current-pos end-pos)
current-pos)) current-pos))
;; Breaks should be disabled from exit of re-tokenize ;; Breaks should be disabled from exit of re-tokenize
;; lock will be held ;; lock will be held
(set! up-to-date? #t) (set! up-to-date? #t)
(semaphore-post lock) (semaphore-post mutex-lock)
(thread-suspend (current-thread)))) (thread-suspend (current-thread))))
(background-colorer)) (background-colorer))
@ -337,6 +349,14 @@
;; ------------------------- Callbacks to Override ---------------------- ;; ------------------------- Callbacks to Override ----------------------
(rename (super-lock lock))
(define/override (lock x)
(super-lock x)
(when (and restart-callback (not x))
(set! restart-callback #f)
(queue-callback colorer-callback)))
(rename (super-on-focus on-focus)) (rename (super-on-focus on-focus))
(define/override (on-focus on?) (define/override (on-focus on?)
(super-on-focus on?) (super-on-focus on?)