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

adjust the colors of the little dot for online check syntax so it

Browse Source 
is more informative (one more stage) and it turns green when online
check syntax is finished (instead of being blank in that case)
This commit is contained in:
Robby Findler 2011-10-25 14:20:43 -05:00
parent 706198c059
commit 41b8b8142a
5 changed files with 58 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/drracket/private/expanding-place.rkt
View File

@ -48,7 +48,8 @@
(define path (vector-ref message 1)) (define path (vector-ref message 1))
(define response-pc (vector-ref message 2)) (define response-pc (vector-ref message 2))
(define settings (vector-ref message 3)) (define settings (vector-ref message 3))
(loop (new-job program-as-string path response-pc settings) (define pc-status-expanding-place (vector-ref message 4))
(loop (new-job program-as-string path response-pc settings pc-status-expanding-place)
old-registry)])))))) old-registry)]))))))
(define (abort-job job) (define (abort-job job)
@ -66,7 +67,7 @@
(struct exn:access exn:fail ()) (struct exn:access exn:fail ())
(define (new-job program-as-string path response-pc settings) (define (new-job program-as-string path response-pc settings pc-status-expanding-place)
(define cust (make-custodian)) (define cust (make-custodian))
(define exn-chan (make-channel)) (define exn-chan (make-channel))
(define result-chan (make-channel)) (define result-chan (make-channel))
@ -121,6 +122,7 @@
(define expanded (expand transformed-stx)) (define expanded (expand transformed-stx))
(channel-put old-registry-chan (channel-put old-registry-chan
(namespace-module-registry (current-namespace))) (namespace-module-registry (current-namespace)))
(place-channel-put pc-status-expanding-place (void))
(log-info "expanding-place.rkt: 10 expanded") (log-info "expanding-place.rkt: 10 expanded")
(define handler-results (define handler-results
(for/list ([handler (in-list handlers)]) (for/list ([handler (in-list handlers)])

63
collects/drracket/private/module-language.rkt
View File

@ -28,9 +28,10 @@
(define-runtime-path expanding-place.rkt "expanding-place.rkt") (define-runtime-path expanding-place.rkt "expanding-place.rkt")
(define sc-online-expansion-running (string-constant online-expansion-running)) (define sc-online-expansion-running (string-constant online-expansion-running))
(define sc-only-raw-text-files-supported (string-constant only-raw-text-files-supported)) (define sc-only-raw-text-files-supported (string-constant online-expansion-only-raw-text-files-supported))
(define sc-abnormal-termination (string-constant abnormal-termination)) (define sc-abnormal-termination (string-constant online-expansion-abnormal-termination))
(define sc-jump-to-error (string-constant jump-to-error)) (define sc-jump-to-error (string-constant jump-to-error))
(define sc-finished-successfully (string-constant online-expansion-finished-successfully))
(define op (current-output-port)) (define op (current-output-port))
(define (oprintf . args) (apply fprintf op args)) (define (oprintf . args) (apply fprintf op args))
@ -796,6 +797,11 @@
(case bkg-state (case bkg-state
[(reader-in-defs-error) 'parens] [(reader-in-defs-error) 'parens]
[(running) (list "blue")] [(running) (list "blue")]
[(finished-expansion) (list "purple")]
[(completed-successfully)
(if (null? bkg-colors)
(list "forestgreen")
(map (λ (x) (list-ref x 1)) bkg-colors))]
[(nothing) (if (null? bkg-colors) [(nothing) (if (null? bkg-colors)
#f #f
(map (λ (x) (list-ref x 1)) bkg-colors))] (map (λ (x) (list-ref x 1)) bkg-colors))]
@ -990,13 +996,15 @@
(define len (length colors-to-draw)) (define len (length colors-to-draw))
(for ([color (in-list colors-to-draw)] (for ([color (in-list colors-to-draw)]
[i (in-naturals)]) [i (in-naturals)])
(send dc set-brush color 'solid) (if color
(send dc set-brush color 'solid)
(send dc set-brush "black" 'transparent))
(send dc draw-arc (send dc draw-arc
(- (/ cw 2) (/ ball-size 2)) (- (/ cw 2) (/ ball-size 2))
(- (/ ch 2) (/ ball-size 2)) (- (/ ch 2) (/ ball-size 2))
ball-size ball-size ball-size ball-size
(* 2 pi (/ i len)) (+ (* pi 1/2) (* 2 pi (/ i len)))
(* 2 pi (/ (+ i 1) len))))] (+ (* pi 1/2) (* 2 pi (/ (+ i 1) len)))))]
[(eq? colors-to-draw 'parens) [(eq? colors-to-draw 'parens)
(send dc draw-text parens-mismatch-str (send dc draw-text parens-mismatch-str
(- (/ cw 2) (/ tw 2)) (- (/ cw 2) (/ tw 2))
@ -1108,7 +1116,12 @@
(define expanding-place #f) (define expanding-place #f)
(define pending-thread #f) (define pending-thread #f)
(define (send-to-place editor-contents filename prefab-module-settings show-results) (define (send-to-place editor-contents
filename
prefab-module-settings
show-results
tell-the-tab-show-bkg-running)
(tell-the-tab-show-bkg-running 'running sc-online-expansion-running)
(unless expanding-place (unless expanding-place
(set! expanding-place (dynamic-place expanding-place.rkt 'start)) (set! expanding-place (dynamic-place expanding-place.rkt 'start))
(place-channel-put expanding-place module-language-compile-lock) (place-channel-put expanding-place module-language-compile-lock)
@ -1120,22 +1133,32 @@
(set! pending-thread (set! pending-thread
(thread (λ () (thread (λ ()
(define-values (pc-in pc-out) (place-channel)) (define-values (pc-in pc-out) (place-channel))
(define-values (pc-status-drracket-place pc-status-expanding-place) (place-channel))
(define to-send (define to-send
(vector-immutable editor-contents (vector-immutable editor-contents
filename filename
pc-in pc-in
prefab-module-settings)) prefab-module-settings
pc-status-expanding-place))
(place-channel-put expanding-place to-send) (place-channel-put expanding-place to-send)
(define us (current-thread))
(thread (λ ()
(define got-status-update (place-channel-get pc-status-drracket-place))
(queue-callback
(λ ()
(when (eq? us pending-thread)
(tell-the-tab-show-bkg-running
'finished-expansion
sc-online-expansion-running))))))
(define res (place-channel-get pc-out)) (define res (place-channel-get pc-out))
(when res (when res
(let ([t (current-thread)]) (queue-callback
(queue-callback (λ ()
(λ () (when (eq? us pending-thread)
(when (eq? t pending-thread) (set! pending-thread #f)
(set! pending-thread #f) (when (getenv "PLTDRPLACEPRINT")
(when (getenv "PLTDRPLACEPRINT") (printf "PLTDRPLACEPRINT: got results back from the place\n"))
(printf "PLTDRPLACEPRINT: got results back from the place\n")) (show-results res)))))))))
(show-results res))))))))))
(define (stop-place-running) (define (stop-place-running)
(when expanding-place (when expanding-place
@ -1207,11 +1230,11 @@
(send-to-place editor-contents (send-to-place editor-contents
filename filename
(module-language-settings->prefab-module-settings settings) (module-language-settings->prefab-module-settings settings)
(λ (res) (show-results res))) (λ (res) (show-results res))
(λ (a b) (send (get-tab) show-bkg-running a b)))
(when status-line-open? (when status-line-open?
(clear-old-error) (clear-old-error)
(reset-frame-expand-error #t)) (reset-frame-expand-error #t))))))
(send (get-tab) show-bkg-running 'running sc-online-expansion-running)))))
(define/private (fetch-data-to-send) (define/private (fetch-data-to-send)
(define str (make-string (last-position) #\space)) (define str (make-string (last-position) #\space))
@ -1312,7 +1335,7 @@
(clear-old-error) (clear-old-error)
(reset-frame-expand-error #f)] (reset-frame-expand-error #f)]
[(no-errors) [(no-errors)
(send (get-tab) show-bkg-running 'nothing #f) (send (get-tab) show-bkg-running 'completed-successfully sc-finished-successfully)
(clear-old-error) (clear-old-error)
(reset-frame-expand-error #f)] (reset-frame-expand-error #f)]
[(handler-results) [(handler-results)
@ -1327,7 +1350,7 @@
(drracket:module-language-tools:online-expansion-handler-id o-e-h))) (drracket:module-language-tools:online-expansion-handler-id o-e-h)))
(when (equal? this-key that-key) (when (equal? this-key that-key)
((drracket:module-language-tools:online-expansion-handler-local-handler o-e-h) this val)))) ((drracket:module-language-tools:online-expansion-handler-local-handler o-e-h) this val))))
(send (get-tab) show-bkg-running 'nothing #f)] (send (get-tab) show-bkg-running 'completed-successfully sc-finished-successfully)]
[else [else
(error 'module-language.rkt "unknown response from the expanding place: ~s\n" res)])) (error 'module-language.rkt "unknown response from the expanding place: ~s\n" res)]))

2
collects/drracket/private/syncheck/gui.rkt
View File

@ -1506,7 +1506,7 @@ If the namespace does not, they are colored the unbound color.
(send tab syncheck:clear-error-message) (send tab syncheck:clear-error-message)
(send tab syncheck:clear-highlighting)) (send tab syncheck:clear-highlighting))
(send (send defs-text get-tab) add-bkg-running-color 'syncheck "forestgreen" cs-syncheck-running) (send (send defs-text get-tab) add-bkg-running-color 'syncheck "orchid" cs-syncheck-running)
(send defs-text syncheck:init-arrows) (send defs-text syncheck:init-arrows)
(let loop ([val val] (let loop ([val val]
[i 0]) [i 0])

8
collects/scribblings/drracket/interface-essentials.scrbl
View File

@ -143,12 +143,14 @@ annotations:
] ]
Check Syntax also runs interactively and the bottom, rightmost corner of the DrRacket window Check Syntax also runs interactively and the bottom, rightmost corner of the DrRacket window
shows its status. A blue or green dot indicates that Check Syntax is running in the background shows its status. A red dot means that something has gone wrong;
(the green dot indicates that the check syntax information has been computed and is
now being put into the DrRacket window proper). A red dot means that something has gone wrong;
move your mouse over the dot to find out what is wrong. Mis-matched parentheses indicates move your mouse over the dot to find out what is wrong. Mis-matched parentheses indicates
that the buffer's parens are also mismatched; mouse over the parens for details. that the buffer's parens are also mismatched; mouse over the parens for details.
When nothing goes wrong, the colors indicate the stages processing of the program:
blue (expanding), purple (computing check syntax information), orchid (updating the
editor with the check syntax information), and green (finished)
Also, right-clicking in that area yields a menu that lets you disable Also, right-clicking in that area yields a menu that lets you disable
(or re-eneable) online Check Syntax. (or re-eneable) online Check Syntax.

7
collects/string-constants/private/english-string-constants.rkt
View File

@ -220,10 +220,13 @@ please adhere to these guidelines:
;; the online check syntax status messages (mouse over the bottom right of drracket's window to see the messages during online expansion's various phases) ;; the online check syntax status messages (mouse over the bottom right of drracket's window to see the messages during online expansion's various phases)
(online-expansion-running "Online expansion running") (online-expansion-running "Online expansion running")
(only-raw-text-files-supported "Only pure text files supported") (online-expansion-only-raw-text-files-supported "Only pure text files supported")
(abnormal-termination "Online expansion terminated abnormally") (online-expansion-abnormal-termination "Online expansion terminated abnormally")
(online-expansion-finished-successfully "Online expansion finished successfully")
(jump-to-error "Jump to Error") (jump-to-error "Jump to Error")
(online-expansion-is-disabled "Online expansion is disabled") (online-expansion-is-disabled "Online expansion is disabled")
;; these next two show up in the bar along the bottom of the drracket window
(online-expansion-pending "Online expansion pending ...") (online-expansion-pending "Online expansion pending ...")
(online-expansion-finished "Online expansion finished") ;; note: there may still be errors in this case (online-expansion-finished "Online expansion finished") ;; note: there may still be errors in this case