From 8c2dc5ccb7efea87fdab6e3eac9d017dc029ef92 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 11 Oct 2011 17:12:33 -0600
Subject: [PATCH] parallel `raco setup': print "running" before insead of after

That is, before actually running the document, so that the
"running" message is a useful indicator of what is happening
now.
---
 collects/setup/parallel-do.rkt | 22 ++++++++++++++++------
 collects/setup/scribble.rkt    |  7 ++++---
 2 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/collects/setup/parallel-do.rkt b/collects/setup/parallel-do.rkt
index a65e133923..3933729fa9 100644
--- a/collects/setup/parallel-do.rkt
+++ b/collects/setup/parallel-do.rkt
@@ -19,6 +19,7 @@
          match-message-loop
          send/success
          send/error
+         send/report
          send/msg
          recv/req
          worker/die
@@ -310,15 +311,20 @@
   
 (define list-queue% 
   (class* object% (work-queue<%>)
-    (init-field queue create-job-thunk success-thunk failure-thunk)
+    (init-field queue create-job-thunk success-thunk failure-thunk [report-proc display])
     (field [results null])
 
     (define/public (work-done work workerid msg)
       (match msg
+        [(list (list 'REPORT msg) stdout stderr)
+         (report-proc msg)
+         #f]
         [(list (list 'DONE result) stdout stderr)
-          (set! results (cons (success-thunk work result stdout stderr) results))]
+         (set! results (cons (success-thunk work result stdout stderr) results))
+         #t]
         [(list (list 'ERROR errmsg) stdout stderr)
-          (failure-thunk work errmsg stdout stderr)]))
+         (failure-thunk work errmsg stdout stderr)
+         #t]))
     (define/public (get-job workerid)
       (match queue
         [(cons h t)
@@ -340,6 +346,7 @@
 (define-syntax-parameter-error send/msg)
 (define-syntax-parameter-error send/success)
 (define-syntax-parameter-error send/error)
+(define-syntax-parameter-error send/report)
 (define-syntax-parameter-error recv/req)
 (define-syntax-parameter-error worker/die)
 
@@ -362,9 +369,10 @@
                                      [recv/req (make-rename-transformer #'recv/reqp)]
                                      [worker/die (make-rename-transformer #'die-k)])
                  ;; message handler:
-                 (lambda (msg send/successp send/errorp)
+                 (lambda (msg send/successp send/errorp send/reportp)
                    (syntax-parameterize ([send/success (make-rename-transformer #'send/successp)]
-                                         [send/error (make-rename-transformer #'send/errorp)])
+                                         [send/error (make-rename-transformer #'send/errorp)]
+                                         [send/report (make-rename-transformer #'send/reportp)])
                      (match msg
                        [work work-body ...]
                        ...))))))])))))
@@ -415,6 +423,8 @@
                           (send/resp (list 'DONE result)))
                         (define (send/errorp message)
                           (send/resp (list 'ERROR message)))
+                        (define (send/reportp message)
+                          (send/resp (list 'REPORT message)))
                         (with-handlers* ([exn:fail? (lambda (x) 
                                                       (send/errorp (exn-message x))
                                                       (loop (add1 i)))])
@@ -423,7 +433,7 @@
                             (let ([msg (pdo-recv)])
                               (match msg
                                 [(list 'DIE) (void)]
-                                [_ (msg-proc msg send/successp send/errorp)
+                                [_ (msg-proc msg send/successp send/errorp send/reportp)
                                    (loop (add1 i))])))))))))))
 
 (define-syntax (lambda-worker stx)
diff --git a/collects/setup/scribble.rkt b/collects/setup/scribble.rkt
index 256dadb79e..43b7802364 100644
--- a/collects/setup/scribble.rkt
+++ b/collects/setup/scribble.rkt
@@ -159,13 +159,14 @@
                          (parallel-do-error-handler setup-printf work errmsg outstr errstr)))
                       (define-worker (get-doc-info-worker workerid program-name verbosev only-dirs latex-dest 
                                                           auto-main? auto-user?) 
-                        (define ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user?) 
+                        (define ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user? send/report) 
                                  doc)
                           (define (setup-printf subpart formatstr . rest)
                             (let ([task (if subpart
                                             (format "~a: " subpart)
                                             "")])
-                              (printf "~a: ~a~a\n" program-name task (apply format formatstr rest))))
+                              (send/report
+                               (format "~a: ~a~a\n" program-name task (apply format formatstr rest)))))
                           (define (with-record-error cc go fail-k)
                             (with-handlers ([exn:fail?
                                              (lambda (exn)
@@ -180,7 +181,7 @@
                         (verbose verbosev)
                         (match-message-loop
                          [doc (send/success 
-                               ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user?) 
+                               ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user? send/report) 
                                 doc))])))))))
 
   (define (make-loop first? iter)