adjust the colors of the little dot for online check syntax so it
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
parent
706198c059
commit
41b8b8142a
|
|
@ -48,7 +48,8 @@
|
|||
(define path (vector-ref message 1))
|
||||
(define response-pc (vector-ref message 2))
|
||||
(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)]))))))
|
||||
|
||||
(define (abort-job job)
|
||||
|
|
@ -66,7 +67,7 @@
|
|||
|
||||
(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 exn-chan (make-channel))
|
||||
(define result-chan (make-channel))
|
||||
|
|
@ -121,6 +122,7 @@
|
|||
(define expanded (expand transformed-stx))
|
||||
(channel-put old-registry-chan
|
||||
(namespace-module-registry (current-namespace)))
|
||||
(place-channel-put pc-status-expanding-place (void))
|
||||
(log-info "expanding-place.rkt: 10 expanded")
|
||||
(define handler-results
|
||||
(for/list ([handler (in-list handlers)])
|
||||
|
|
|
|||
|
|
@ -28,9 +28,10 @@
|
|||
(define-runtime-path expanding-place.rkt "expanding-place.rkt")
|
||||
|
||||
(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-abnormal-termination (string-constant abnormal-termination))
|
||||
(define sc-only-raw-text-files-supported (string-constant online-expansion-only-raw-text-files-supported))
|
||||
(define sc-abnormal-termination (string-constant online-expansion-abnormal-termination))
|
||||
(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 (oprintf . args) (apply fprintf op args))
|
||||
|
|
@ -796,6 +797,11 @@
|
|||
(case bkg-state
|
||||
[(reader-in-defs-error) 'parens]
|
||||
[(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)
|
||||
#f
|
||||
(map (λ (x) (list-ref x 1)) bkg-colors))]
|
||||
|
|
@ -990,13 +996,15 @@
|
|||
(define len (length colors-to-draw))
|
||||
(for ([color (in-list colors-to-draw)]
|
||||
[i (in-naturals)])
|
||||
(if color
|
||||
(send dc set-brush color 'solid)
|
||||
(send dc set-brush "black" 'transparent))
|
||||
(send dc draw-arc
|
||||
(- (/ cw 2) (/ ball-size 2))
|
||||
(- (/ ch 2) (/ ball-size 2))
|
||||
ball-size ball-size
|
||||
(* 2 pi (/ i len))
|
||||
(* 2 pi (/ (+ i 1) len))))]
|
||||
(+ (* pi 1/2) (* 2 pi (/ i len)))
|
||||
(+ (* pi 1/2) (* 2 pi (/ (+ i 1) len)))))]
|
||||
[(eq? colors-to-draw 'parens)
|
||||
(send dc draw-text parens-mismatch-str
|
||||
(- (/ cw 2) (/ tw 2))
|
||||
|
|
@ -1108,7 +1116,12 @@
|
|||
(define expanding-place #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
|
||||
(set! expanding-place (dynamic-place expanding-place.rkt 'start))
|
||||
(place-channel-put expanding-place module-language-compile-lock)
|
||||
|
|
@ -1120,22 +1133,32 @@
|
|||
(set! pending-thread
|
||||
(thread (λ ()
|
||||
(define-values (pc-in pc-out) (place-channel))
|
||||
(define-values (pc-status-drracket-place pc-status-expanding-place) (place-channel))
|
||||
(define to-send
|
||||
(vector-immutable editor-contents
|
||||
filename
|
||||
pc-in
|
||||
prefab-module-settings))
|
||||
prefab-module-settings
|
||||
pc-status-expanding-place))
|
||||
(place-channel-put expanding-place to-send)
|
||||
(define res (place-channel-get pc-out))
|
||||
(when res
|
||||
(let ([t (current-thread)])
|
||||
(define us (current-thread))
|
||||
(thread (λ ()
|
||||
(define got-status-update (place-channel-get pc-status-drracket-place))
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(when (eq? t pending-thread)
|
||||
(when (eq? us pending-thread)
|
||||
(tell-the-tab-show-bkg-running
|
||||
'finished-expansion
|
||||
sc-online-expansion-running))))))
|
||||
(define res (place-channel-get pc-out))
|
||||
(when res
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(when (eq? us pending-thread)
|
||||
(set! pending-thread #f)
|
||||
(when (getenv "PLTDRPLACEPRINT")
|
||||
(printf "PLTDRPLACEPRINT: got results back from the place\n"))
|
||||
(show-results res))))))))))
|
||||
(show-results res)))))))))
|
||||
|
||||
(define (stop-place-running)
|
||||
(when expanding-place
|
||||
|
|
@ -1207,11 +1230,11 @@
|
|||
(send-to-place editor-contents
|
||||
filename
|
||||
(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?
|
||||
(clear-old-error)
|
||||
(reset-frame-expand-error #t))
|
||||
(send (get-tab) show-bkg-running 'running sc-online-expansion-running)))))
|
||||
(reset-frame-expand-error #t))))))
|
||||
|
||||
(define/private (fetch-data-to-send)
|
||||
(define str (make-string (last-position) #\space))
|
||||
|
|
@ -1312,7 +1335,7 @@
|
|||
(clear-old-error)
|
||||
(reset-frame-expand-error #f)]
|
||||
[(no-errors)
|
||||
(send (get-tab) show-bkg-running 'nothing #f)
|
||||
(send (get-tab) show-bkg-running 'completed-successfully sc-finished-successfully)
|
||||
(clear-old-error)
|
||||
(reset-frame-expand-error #f)]
|
||||
[(handler-results)
|
||||
|
|
@ -1327,7 +1350,7 @@
|
|||
(drracket:module-language-tools:online-expansion-handler-id o-e-h)))
|
||||
(when (equal? this-key that-key)
|
||||
((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
|
||||
(error 'module-language.rkt "unknown response from the expanding place: ~s\n" res)]))
|
||||
|
||||
|
|
|
|||
|
|
@ -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-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)
|
||||
(let loop ([val val]
|
||||
[i 0])
|
||||
|
|
|
|||
|
|
@ -143,12 +143,14 @@ annotations:
|
|||
]
|
||||
|
||||
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
|
||||
(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;
|
||||
shows its status. 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
|
||||
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
|
||||
(or re-eneable) online Check Syntax.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
(online-expansion-running "Online expansion running")
|
||||
(only-raw-text-files-supported "Only pure text files supported")
|
||||
(abnormal-termination "Online expansion terminated abnormally")
|
||||
(online-expansion-only-raw-text-files-supported "Only pure text files supported")
|
||||
(online-expansion-abnormal-termination "Online expansion terminated abnormally")
|
||||
(online-expansion-finished-successfully "Online expansion finished successfully")
|
||||
|
||||
(jump-to-error "Jump to Error")
|
||||
(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-finished "Online expansion finished") ;; note: there may still be errors in this case
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user