From e12a6851076e38bac8dc2c73567efb6f84c7cfbc Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 21 Apr 2013 10:13:18 -0500
Subject: [PATCH] adjust drracket's online expansion machinery to track exns
 that are passed to the error-display-handler during expansion

(not just the exn records that actually get raised)

the motivation is to do a better job with TR's way of signalling
mutiple error messages.
---
 collects/drracket/private/drsig.rkt           |   1 +
 collects/drracket/private/expanding-place.rkt | 130 ++++++-----
 collects/drracket/private/get-extend.rkt      |   7 +-
 .../drracket/private/local-member-names.rkt   |   1 +
 collects/drracket/private/module-language.rkt | 202 ++++++++++++------
 collects/drracket/private/rep.rkt             |  11 +-
 collects/drracket/private/unit.rkt            |  37 ----
 collects/scribblings/tools/rep.scrbl          |  15 ++
 8 files changed, 240 insertions(+), 164 deletions(-)

diff --git a/collects/drracket/private/drsig.rkt b/collects/drracket/private/drsig.rkt
index 06291cc64a..ab2f01b2ba 100644
--- a/collects/drracket/private/drsig.rkt
+++ b/collects/drracket/private/drsig.rkt
@@ -97,6 +97,7 @@
   (module-language-online-expand-text-mixin
    module-language-online-expand-frame-mixin
    module-language-online-expand-tab-mixin
+   module-language-online-expand-rep-mixin
    module-language-big-defs/ints-interactions-text-mixin
    module-language-big-defs/ints-definitions-text-mixin
    initialize-prefs-panel
diff --git a/collects/drracket/private/expanding-place.rkt b/collects/drracket/private/expanding-place.rkt
index dd8ffb4962..6683ac559f 100644
--- a/collects/drracket/private/expanding-place.rkt
+++ b/collects/drracket/private/expanding-place.rkt
@@ -84,6 +84,7 @@
 (define (new-job program-as-string path response-pc settings pc-status-expanding-place)
   (define cust (make-custodian))
   (define exn-chan (make-channel))
+  (define extra-exns-chan (make-channel))
   (define result-chan (make-channel))
   (define normal-termination (make-channel))
   (define abnormal-termination (make-channel))
@@ -132,6 +133,11 @@
          (ep-log-info "expanding-place.rkt: 05 installing security guard")
          (install-security-guard) ;; must come after the call to set-module-language-parameters
          (ep-log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
+         (error-display-handler
+          (let ([e-d-h (error-display-handler)])
+            (λ (msg exn)
+              (channel-put extra-exns-chan exn)
+              (e-d-h msg exn))))
          (uncaught-exception-handler
           (λ (exn)
             (parameterize ([current-custodian orig-cust])
@@ -211,64 +217,72 @@
   
   (thread
    (λ ()
-     (sync
-      (handle-evt
-       abnormal-termination
-       (λ (val) 
-         (place-channel-put pc-status-expanding-place
-                            'abnormal-termination)
-         (place-channel-put 
-          response-pc
-          (vector 'abnormal-termination 
-                  ;; note: this message is actually ignored: a string 
-                  ;; constant is used back in the drracket place
-                  "Expansion thread terminated unexpectedly"
-                  '()
-                  
-                  ;; give up on dep paths in this case:
-                  '()))))
-      (handle-evt
-       result-chan
-       (λ (val+loaded-paths)
-         (place-channel-put response-pc (vector 'handler-results 
-                                                (list-ref val+loaded-paths 0)
-                                                (list-ref val+loaded-paths 1)))))
-      (handle-evt
-       exn-chan
-       (λ (exn+loaded-paths)
-         (place-channel-put pc-status-expanding-place 'exn-raised)
-         (define exn (list-ref exn+loaded-paths 0))
-         (place-channel-put 
-          response-pc
-          (vector 
-           (cond
-             [(exn:access? exn)
-              'access-violation]
-             [(and (exn:fail:read? exn)
-                   (andmap (λ (srcloc) (equal? (srcloc-source srcloc) the-source))
-                           (exn:fail:read-srclocs exn)))
-              'reader-in-defs-error]
-             [(and (exn? exn)
-                   (regexp-match #rx"expand: unbound identifier" (exn-message exn)))
-              'exn:variable]
-             [else 'exn])
-           (trim-message 
-            (if (exn? exn) 
-                (regexp-replace* #rx"[ \t]*\n[ \t]*" (exn-message exn) " ") 
-                (format "uncaught exn: ~s" exn)))
-           (if (exn:srclocs? exn)
-               (sort
-                (for/list ([srcloc ((exn:srclocs-accessor exn) exn)]
-                           #:when (and (srcloc? srcloc)
-                                       (equal? the-source (srcloc-source srcloc))
-                                       (srcloc-position srcloc)
-                                       (srcloc-span srcloc)))
-                  (vector (srcloc-position srcloc)
-                          (srcloc-span srcloc)))
-                <
-                #:key (λ (x) (vector-ref x 0)))
-               '())
-           (list-ref exn+loaded-paths 1))))))))
+     (let loop ([extra-exns '()])
+       (sync
+        (handle-evt
+         abnormal-termination
+         (λ (val) 
+           (place-channel-put pc-status-expanding-place
+                              'abnormal-termination)
+           (place-channel-put 
+            response-pc
+            (vector 'abnormal-termination 
+                    ;; note: this message is actually ignored: a string 
+                    ;; constant is used back in the drracket place
+                    "Expansion thread terminated unexpectedly"
+                    '()
+                    
+                    ;; give up on dep paths in this case:
+                    '()))))
+        (handle-evt
+         result-chan
+         (λ (val+loaded-paths)
+           (place-channel-put response-pc (vector 'handler-results 
+                                                  (list-ref val+loaded-paths 0)
+                                                  (list-ref val+loaded-paths 1)))))
+        (handle-evt extra-exns-chan (λ (exn) (loop (cons exn extra-exns))))
+        (handle-evt
+         exn-chan
+         (λ (exn+loaded-paths)
+           (place-channel-put pc-status-expanding-place 'exn-raised)
+           (define main-exn (list-ref exn+loaded-paths 0))
+           (define exn-type
+             (cond
+               [(exn:access? main-exn)
+                'access-violation]
+               [(and (exn:fail:read? main-exn)
+                     (andmap (λ (srcloc) (equal? (srcloc-source srcloc) the-source))
+                             (exn:fail:read-srclocs main-exn)))
+                'reader-in-defs-error]
+               [(and (exn? main-exn)
+                     (regexp-match #rx"expand: unbound identifier" (exn-message main-exn)))
+                'exn:variable]
+               [else 'exn]))
+           (define exn-infos
+             (for/list ([an-exn (in-list (cons main-exn extra-exns))])
+               (vector 
+                (trim-message 
+                 (if (exn? an-exn) 
+                     (regexp-replace* #rx"[ \t]*\n[ \t]*" (exn-message an-exn) " ") 
+                     (format "uncaught exn: ~s" an-exn)))
+                (if (exn:srclocs? an-exn)
+                    (sort
+                     (for/list ([srcloc ((exn:srclocs-accessor an-exn) an-exn)]
+                                #:when (and (srcloc? srcloc)
+                                            (equal? the-source (srcloc-source srcloc))
+                                            (srcloc-position srcloc)
+                                            (srcloc-span srcloc)))
+                       (vector (srcloc-position srcloc)
+                               (srcloc-span srcloc)))
+                     <
+                     #:key (λ (x) (vector-ref x 0)))
+                    '()))))
+           (place-channel-put 
+            response-pc
+            (vector 
+             exn-type
+             exn-infos
+             (list-ref exn+loaded-paths 1)))))))))
   
   (job cust response-pc working-thd stop-watching-abnormal-termination))
 
diff --git a/collects/drracket/private/get-extend.rkt b/collects/drracket/private/get-extend.rkt
index 9f9f199ef2..563d5dbdc4 100644
--- a/collects/drracket/private/get-extend.rkt
+++ b/collects/drracket/private/get-extend.rkt
@@ -109,9 +109,10 @@
   (make-extender get-base-unit-frame% 'drracket:unit:frame))
 
 (define (get-base-interactions-text%)
-  (drracket:module-language:module-language-big-defs/ints-interactions-text-mixin
-   (drracket:debug:test-coverage-interactions-text-mixin
-    drracket:rep:text%)))
+  (drracket:module-language:module-language-online-expand-rep-mixin
+   (drracket:module-language:module-language-big-defs/ints-interactions-text-mixin
+    (drracket:debug:test-coverage-interactions-text-mixin
+     drracket:rep:text%))))
 
 (define-values (extend-interactions-text get-interactions-text)
   (make-extender get-base-interactions-text% 'interactions-text%))
diff --git a/collects/drracket/private/local-member-names.rkt b/collects/drracket/private/local-member-names.rkt
index 1e08c403a2..04ae18b06e 100644
--- a/collects/drracket/private/local-member-names.rkt
+++ b/collects/drracket/private/local-member-names.rkt
@@ -35,6 +35,7 @@
 ;; used by the module language  
 (define-local-member-name
   frame-show-bkg-running
+  set-bottom-bar-most-recent-jumped-to-loc
   set-expand-error/status
   update-frame-expand-error
   expand-error-next
diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt
index 108f8e1e0a..db352c94d1 100644
--- a/collects/drracket/private/module-language.rkt
+++ b/collects/drracket/private/module-language.rkt
@@ -31,10 +31,14 @@
 (module oc-status-structs racket/base
   ;; the online compilation state for individual tabs
   ;; oc-state is either:
-  ;;   (clean symbol? string? (listof (vector number? number?)))
+  ;;   (clean (or/c symbol? #f)
+  ;;          (or/c (non-empty-listof 
+  ;;                 (vector/c string? 
+  ;;                           (listof (vector number? number?))))
+  ;;                #f))
   ;;   (dirty boolean?)
   ;;   (running symbol? string?)
-  (struct clean (error-type error-message error-locs) #:transparent)
+  (struct clean (error-type error-messages+locs) #:transparent)
   (struct dirty (timer-pending?) #:transparent)
   (struct running (sym str) #:transparent)
   
@@ -957,7 +961,7 @@
         (inner (void) on-close))
       
       ;; (or/c clean? dirty? running?)
-      (define running-status (clean #f #f '()))
+      (define running-status (clean #f #f))
       (define our-turn? #f)
       
       (define/public (set-oc-status s) 
@@ -975,8 +979,8 @@
         (send (get-defs) begin-edit-sequence #f #f)
         (send (get-defs) clear-old-error)
         (when (clean? running-status)
-          (match-define (clean error-type error-message error-locs) running-status)
-          (when error-message
+          (match-define (clean error-type error-messages+locs) running-status)
+          (when error-messages+locs
             (define pref-key
               (case error-type
                 [(exn access-violation abnormal-termination) 'drracket:online-expansion:other-errors]
@@ -986,17 +990,23 @@
             (case (preferences:get pref-key)
               [(margin) 
                (send (get-defs) set-margin-error-ranges
-                     (for/list ([range (in-list error-locs)])
-                       (define pos (vector-ref range 0))
-                       (define span (vector-ref range 1))
-                       (error-range (- pos 1) (+ pos span -1) #f)))]
+                     (set->list
+                      (for*/set ([error-message+loc (in-list error-messages+locs)]
+                                 [range (in-list (vector-ref error-message+loc 1))])
+                        (define pos (vector-ref range 0))
+                        (define span (vector-ref range 1))
+                        (error-range (- pos 1) (+ pos span -1) #f))))]
               [(gold) 
-               (send (get-defs) set-gold-highlighted-errors error-locs)])
+               (send (get-defs) set-gold-highlighted-errors 
+                     (remove-duplicates
+                      (apply append (map (λ (x) (vector-ref x 1)) error-messages+locs))))])
             (send (get-ints) set-error-ranges 
-                  (for/list ([range (in-list error-locs)])
-                    (define pos (vector-ref range 0))
-                    (define span (vector-ref range 1))
-                    (srcloc (get-defs) #f #f pos span)))))
+                  (set->list
+                   (for*/set ([error-message+loc (in-list error-messages+locs)]
+                              [range (in-list (vector-ref error-message+loc 1))])
+                     (define pos (vector-ref range 0))
+                     (define span (vector-ref range 1))
+                     (srcloc (get-defs) #f #f pos span))))))
         (send (get-defs) end-edit-sequence))
       
       (define/private (update-bottom-bar)
@@ -1006,23 +1016,22 @@
           [(and (dirty? running-status) our-turn?)
            (set-bottom-bar-status/pending)]
           [(and (dirty? running-status) (not our-turn?))
-           (send (get-defs) set-bottom-bar-status "" '() #f #f)]
+           (send (get-defs) set-bottom-bar-status (list (vector "" '())) #f #f)]
           [(clean? running-status)
-           (if (clean-error-message running-status)
+           (if (clean-error-messages+locs running-status)
                (send (get-defs) set-bottom-bar-status 
-                     (clean-error-message running-status)
-                     (clean-error-locs running-status)
+                     (clean-error-messages+locs running-status)
                      #t #t)
                (send (get-defs) set-bottom-bar-status
-                     (string-constant online-expansion-finished) 
-                     '() 
+                     (list (vector (string-constant online-expansion-finished) 
+                                   '()))
                      #f
                      #f))]))
       
       (define/private (set-bottom-bar-status/pending)
         (send (get-defs) set-bottom-bar-status
-              (string-constant online-expansion-pending) 
-              '() 
+              (list (vector (string-constant online-expansion-pending) 
+                            '()))
               #f
               #f))
       
@@ -1041,7 +1050,7 @@
                #f
                (map (λ (x) (list-ref x 1)) bkg-colors))]
           [(clean? running-status)
-           (if (clean-error-message running-status)
+           (if (clean-error-messages+locs running-status)
                (list "red")
                (if (null? bkg-colors)
                    (list "forestgreen")
@@ -1056,8 +1065,9 @@
                #f
                (map (λ (x) (list-ref x 2)) bkg-colors))]
           [(clean? running-status)
-           (if (clean-error-message running-status)
-               (list (clean-error-message running-status))
+           (if (clean-error-messages+locs running-status)
+               (for/list ([pr (clean-error-messages+locs running-status)])
+                 (vector-ref pr 0))
                (list sc-finished-successfully))]))
 
       (define bkg-colors '())
@@ -1123,21 +1133,34 @@
       ;; in the current tab)
       ; if the bar is hidden entirely 
       (define error/status-message-hidden? #t) 
-      ; the string message in the bar
-      (define error/status-message-str "")
+      ; a list of pairs (in a vector of size 2) of strings and srclocs
+      ; that show up in the bar and control the "jump to error" / next prev buttons
+      (define error/status-message-strs+srclocs '(#("" ())))
+      (define error/status-index 0)
+      
       ; if the string should be red/italic or just normal font
       (define error/status-message-err? #f)
-      ; the srclocs (controls the "jump to error" / next prev buttons)
-      (define error-message-srclocs '())
       
-      (define/public (set-bottom-bar-status new-error/status-message-str srclocs message-err? force-visible?)
-        (when (or (not (and (equal? error/status-message-str new-error/status-message-str)
-                            (equal? error-message-srclocs srclocs)
+      (define bottom-bar-most-recent-jumped-to-loc #f)
+      (define/public (set-bottom-bar-most-recent-jumped-to-loc loc)
+        (set! bottom-bar-most-recent-jumped-to-loc loc)
+        (update-frame-expand-error))
+      
+      (define/public (set-bottom-bar-status new-error/status-message-strs+srclocs message-err? force-visible?)
+        (define new-error/status-message-str (vector-ref (car new-error/status-message-strs+srclocs) 0))
+        (define srclocs (vector-ref (car new-error/status-message-strs+srclocs) 1))
+        (unless (string? new-error/status-message-str)
+          (error 'set-bottom-bar-status "expected a string, got ~s" new-error/status-message-str))
+        (when (or (not (and (equal? error/status-message-strs+srclocs new-error/status-message-strs+srclocs)
                             (equal? error/status-message-err? message-err?)))
                   (and force-visible?
                        error/status-message-hidden?))
-          (set! error/status-message-str new-error/status-message-str)
-          (set! error-message-srclocs srclocs)
+          (set! error/status-message-strs+srclocs new-error/status-message-strs+srclocs)
+          (unless (< error/status-index (length new-error/status-message-strs+srclocs))
+            ;; try to preserve the error/status-index in the case
+            ;; that the error messages didn't change much.
+            ;; not sure this is a good idea (or if the test above is the right test)
+            (set! error/status-index 0))
           (set! error/status-message-err? message-err?)
           (when force-visible? 
             (set! error/status-message-hidden? #f))
@@ -1146,45 +1169,74 @@
         (when (eq? (get-tab) (send (send (get-tab) get-frame) get-current-tab))
           (send (send (get-tab) get-frame) set-expand-error/status
                 error/status-message-hidden?
-                error/status-message-str 
+                (cond
+                  [bottom-bar-most-recent-jumped-to-loc
+                   (for/list ([error/status-message-str+srcloc (in-list error/status-message-strs+srclocs)]
+                              #:when (for/or ([pos+span-vec (vector-ref error/status-message-str+srcloc 1)])
+                                       (define pos (vector-ref pos+span-vec 0))
+                                       (define span (vector-ref pos+span-vec 1))
+                                       (and (equal? (send (get-tab) get-defs)
+                                                    (srcloc-source bottom-bar-most-recent-jumped-to-loc))
+                                            (equal? (srcloc-position bottom-bar-most-recent-jumped-to-loc)
+                                                    pos)
+                                            (equal? (srcloc-span bottom-bar-most-recent-jumped-to-loc)
+                                                    span))))
+                     (vector-ref error/status-message-str+srcloc 0))]
+                  [else
+                   (list (vector-ref (list-ref error/status-message-strs+srclocs error/status-index) 0))])
                 error/status-message-err?
-                (length error-message-srclocs))))
+                (cond
+                  [(null? error/status-message-strs+srclocs) 0]
+                  [(null? (cdr error/status-message-strs+srclocs))
+                   (length (vector-ref (car error/status-message-strs+srclocs) 1))]
+                  [else
+                   (for/sum ([error/status-message-str+srcloc (in-list error/status-message-strs+srclocs)])
+                     (max 1 (length (vector-ref error/status-message-str+srcloc 1))))]))))
       (define/public (hide-module-language-error-panel)
         (set! error/status-message-hidden? #t)
         (update-frame-expand-error))
 
       (define/public (expand-error-next) 
+        (define current-srclocs (vector-ref (list-ref error/status-message-strs+srclocs error/status-index) 1))
         (define candidates (filter (λ (error-message-srcloc) 
                                      (> (- (vector-ref error-message-srcloc 0) 1) 
                                         (get-end-position)))
-                                   error-message-srclocs))
+                                   current-srclocs))
         (cond
           [(null? candidates)
-           (unless (null? error-message-srclocs)
-             (jump-to (car error-message-srclocs)))]
+           (jump-to-new-index (modulo (+ error/status-index 1) 
+                                      (length error/status-message-strs+srclocs))
+                              first)]
           [else
            (jump-to (car candidates))]))
       
       (define/public (expand-error-prev) 
+        (define current-srclocs (vector-ref (list-ref error/status-message-strs+srclocs error/status-index) 1))
         (define candidates (filter (λ (error-message-srcloc) 
                                      (< (+ (vector-ref error-message-srcloc 0)
                                            (vector-ref error-message-srcloc 1)
                                            -1)
                                         (get-start-position)))
-                                   error-message-srclocs))
+                                   current-srclocs))
         (cond
           [(null? candidates)
-           (unless (null? error-message-srclocs)
-             (jump-to (last error-message-srclocs)))]
+           (jump-to-new-index (modulo (- error/status-index 1) 
+                                      (length error/status-message-strs+srclocs))
+                              last)]
           [else
            (jump-to (last candidates))]))
       
+      (define/private (jump-to-new-index new-error/status-index which)
+        (set! error/status-index new-error/status-index)
+        (define current-srclocs (vector-ref (list-ref error/status-message-strs+srclocs error/status-index) 1))
+        (unless (null? current-srclocs) (jump-to (which current-srclocs)))
+        (update-frame-expand-error))
+      
       (define/private (jump-to vec)
         (set-position (- (vector-ref vec 0) 1))
         (define cnvs (get-canvas))
         (when cnvs (send cnvs focus)))
       
-
       (define online-error-ranges '())
       (define online-highlighted-errors '())
       
@@ -1374,6 +1426,15 @@
       
       (super-new)))
   
+  (define module-language-online-expand-rep-mixin
+    (mixin (drracket:rep:text<%>) ()
+      (inherit get-definitions-text)
+      (define/override (on-highlighted-errors loc/s)
+        (send (get-definitions-text) set-bottom-bar-most-recent-jumped-to-loc
+              (and (not (list? loc/s)) loc/s))
+        (super on-highlighted-errors loc/s))
+      (super-new)))
+  
   (define module-language-online-expand-frame-mixin
     (mixin (frame:basic<%> frame:info<%> drracket:unit:frame<%>) ()
       (inherit get-info-panel get-current-tab)
@@ -1405,7 +1466,7 @@
         (set! expand-error-message (new error-message%
                                         [parent expand-error-panel]
                                         [stretchable-width #t]
-                                        [msg "hi"]
+                                        [msgs '("hi")]
                                         [err? #f]))
         (set! expand-error-button-parent-panel
               (new horizontal-panel%
@@ -1457,18 +1518,18 @@
         (send expand-error-parent-panel change-children (λ (l) (remq expand-error-panel l)))
         root)
       
-      (define expand-error-msg #f)
+      (define expand-error-msgs #f)
       (define expand-error-msg-is-err? #f)
       (define expand-error-srcloc-count 0)
       (define expand-error-hidden? #f)
       
-      (define/public (set-expand-error/status hidden? msg err? srcloc-count)
+      (define/public (set-expand-error/status hidden? msgs err? srcloc-count)
         (unless (and (equal? expand-error-hidden? hidden?)
-                     (equal? expand-error-msg msg)
+                     (equal? expand-error-msgs msgs)
                      (equal? expand-error-msg-is-err? err?)
                      (equal? expand-error-srcloc-count srcloc-count))
           (set! expand-error-hidden? hidden?)
-          (set! expand-error-msg msg)
+          (set! expand-error-msgs msgs)
           (set! expand-error-msg-is-err? err?)
           (set! expand-error-srcloc-count srcloc-count)
           (when expand-error-message
@@ -1480,7 +1541,7 @@
                              (if (memq expand-error-panel l)
                                  l
                                  (append l (list expand-error-panel))))))
-            (send expand-error-message set-msg expand-error-msg expand-error-msg-is-err?)
+            (send expand-error-message set-msgs expand-error-msgs expand-error-msg-is-err?)
             (send expand-error-button-parent-panel change-children
                   (λ (l)
                     (list (cond
@@ -1624,10 +1685,10 @@
   
   (define error-message%
     (class canvas%
-      (init-field msg err?)
+      (init-field msgs err?)
       (inherit refresh get-dc get-client-size popup-menu)
-      (define/public (set-msg _msg _err?) 
-        (set! msg _msg)
+      (define/public (set-msgs _msgs _err?) 
+        (set! msgs _msgs)
         (set! err? _err?)
         (set-the-height/dc-font (preferences:get 'framework:standard-style-list:font-size))
         (refresh))
@@ -1641,7 +1702,10 @@
                             [callback
                              (λ (itm evt)
                                (send the-clipboard set-clipboard-string 
-                                     msg
+                                     (apply
+                                      string-append
+                                      (for/list ([msg (in-list msgs)])
+                                        (format "~a\n" msg)))
                                      (send evt get-time-stamp)))]))
            (popup-menu m 
                        (+ (send evt get-x) 1)
@@ -1651,9 +1715,15 @@
       (define/override (on-paint)
         (define dc (get-dc))
         (define-values (cw ch) (get-client-size))
-        (define-values (tw th td ta) (send dc get-text-extent msg))
         (send dc set-text-foreground (if err? "firebrick" "black"))
-        (send dc draw-text msg 2 (- (/ ch 2) (/ th 2))))
+        (define tot-th
+          (for/sum ([msg (in-list msgs)])
+            (define-values (tw th td ta) (send dc get-text-extent msg))
+            th))
+        (for/fold ([y (- (/ ch 2) (/ tot-th 2))]) ([msg (in-list msgs)])
+          (define-values (tw th td ta) (send dc get-text-extent msg))
+          (send dc draw-text msg 2 y)
+          (+ y th)))
       (super-new [style '(transparent)])
       
       ;; need object to hold onto this function, so this is
@@ -1678,8 +1748,11 @@
                     (send normal-control-font get-weight)
                     (send normal-control-font get-underlined)
                     (send normal-control-font get-smoothing)))
-        (define-values (tw th td ta) (send dc get-text-extent msg))
-        (min-height (inexact->exact (ceiling th))))
+        (define tot-th
+          (for/sum ([msg (in-list msgs)])
+            (define-values (tw th td ta) (send dc get-text-extent msg))
+            th))
+        (min-height (inexact->exact (ceiling tot-th))))
       
       (inherit min-height)
       (set-the-height/dc-font
@@ -1836,11 +1909,11 @@
       [(eq? tab running-tab)
        (line-of-interest)
        (stop-place-running)
-       (send tab set-oc-status (clean #f #f '()))]
+       (send tab set-oc-status (clean #f #f))]
       [(eq? tab dirty/pending-tab)
        (line-of-interest)
        (send oc-timer stop)
-       (send tab set-oc-status (clean #f #f '()))]
+       (send tab set-oc-status (clean #f #f))]
       [else
        (line-of-interest)
        (void)])
@@ -1939,8 +2012,8 @@
          (line-of-interest)
          (send dirty/pending-tab set-oc-status
                (clean 'exn
-                      sc-only-raw-text-files-supported
-                      (list (vector (+ filename/loc 1) 1))))
+                      (list (vector sc-only-raw-text-files-supported
+                                    (list (vector (+ filename/loc 1) 1))))))
          (oc-maybe-start-something)])))
 
   (define/oc-log (oc-finished res)
@@ -1961,7 +2034,7 @@
                 (send running-tab get-defs)
                 val))))
          
-         (send running-tab set-oc-status (clean #f #f '()))
+         (send running-tab set-oc-status (clean #f #f))
          (send running-tab set-dep-paths (list->set (vector-ref res 2)) #f)]
         [else
          (line-of-interest)
@@ -1969,9 +2042,8 @@
                (clean (vector-ref res 0)
                       (if (eq? (vector-ref res 0) 'abnormal-termination)
                           sc-abnormal-termination
-                          (vector-ref res 1))
-                      (vector-ref res 2)))
-         (send running-tab set-dep-paths (list->set (vector-ref res 3)) #t)])
+                          (vector-ref res 1))))
+         (send running-tab set-dep-paths (list->set (vector-ref res 2)) #t)])
       (oc-maybe-start-something)))
   
   (define/oc-log (oc-status-message sym str)
diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt
index 9f4d804aad..32eaf570ba 100644
--- a/collects/drracket/private/rep.rkt
+++ b/collects/drracket/private/rep.rkt
@@ -72,6 +72,7 @@ TODO
       reset-highlighting
       highlight-errors
       highlight-errors/exn
+      on-highlighted-errors
       
       get-user-custodian
       get-user-eventspace
@@ -550,7 +551,8 @@ TODO
       (define/public (reset-error-ranges) 
         (set-error-ranges #f)
         (when definitions-text (send definitions-text set-error-arrows #f))
-        (clear-error-highlighting))
+        (clear-error-highlighting)
+        (on-highlighted-errors #f))
       
       ;; highlight-error : file number number -> void
       (define/public (highlight-error file start end)
@@ -605,6 +607,8 @@ TODO
                [first-start (and first-loc (- (srcloc-position first-loc) 1))]
                [first-span (and first-loc (srcloc-span first-loc))])
           
+          (on-highlighted-errors locs)
+          
           (when (and first-loc first-start first-span)
             (let ([first-finish (+ first-start first-span)])
               (when (eq? first-file definitions-text) ;; only move set the cursor in the defs window
@@ -653,6 +657,8 @@ TODO
                 (send source set-position start span))
               (send source scroll-to-position start #f finish)))
           
+          (on-highlighted-errors loc)
+          
           (send source end-edit-sequence)
           
           (when (eq? source definitions-text)
@@ -663,6 +669,9 @@ TODO
                 (send tlw ensure-defs-shown))))
           
           (send source set-caret-owner (get-focus-snip) 'global)))
+      
+      (define/public (on-highlighted-errors loc/s)
+        (void))
         
       (define/private (cleanup-locs locs)
         (let ([ht (make-hasheq)])
diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt
index 2620a5872b..c327555453 100644
--- a/collects/drracket/private/unit.rkt
+++ b/collects/drracket/private/unit.rkt
@@ -4055,43 +4055,6 @@ module browser threading seems wrong.
                   (send item enable (or (send ints get-error-ranges)
                                         (send tab get-test-coverage-info-visible?)))))))
         
-        ;; find-before-and-after : nat -> (values (or/c srcloc #f) (or/c srcloc #f) (listof srcloc))
-        ;;
-        ;; returns the source locations from the error ranges that are before and
-        ;; after get-start-position, or #f if the insertion point is before 
-        ;; all of them or after all of them, respectively
-        ;; also returns the sorted list of all srclocs
-        ;;
-        ;; this doesn't work properly when the positions are in embedded editor
-        ;;  (but it doesn't crash; it just has a strange notion of before and after)
-        (define (find-before-and-after)
-          (define tab (get-current-tab))
-          (define pos (send (send tab get-defs) get-start-position))
-          (define ranges (send (send tab get-ints) get-error-ranges))
-          (define sorted (sort ranges < #:key srcloc-position))
-          (let loop ([before #f]
-                     [lst sorted])
-            (cond
-              [(null? lst)
-               (values before #f sorted)]
-              [else
-               (define fst (car lst))
-               (cond 
-                 [(= pos (- (srcloc-position fst) 1))
-                  (values before 
-                          (if (null? (cdr lst))
-                              #f
-                              (cadr lst))
-                          sorted)]
-                 [(< pos (- (srcloc-position fst) 1))
-                  (values before fst sorted)]
-                 [else (loop (car lst) (cdr lst))])])))
-        
-        (define (jump-to-source-loc srcloc)
-          (define ed (srcloc-source srcloc))
-          (send ed set-position (- (srcloc-position srcloc) 1))
-          (send ed set-caret-owner #f 'global))
-        
         (new menu:can-restore-menu-item%
              (label (string-constant jump-to-next-error-highlight-menu-item-label))
              (parent language-specific-menu)
diff --git a/collects/scribblings/tools/rep.scrbl b/collects/scribblings/tools/rep.scrbl
index d22b0179d0..45baae5c57 100644
--- a/collects/scribblings/tools/rep.scrbl
+++ b/collects/scribblings/tools/rep.scrbl
@@ -184,6 +184,21 @@ See also
 
 }
 
+@defmethod[(on-highlighted-errors [loc/s (or/c srcloc? (listof srcloc?))]) void?]{
+  This method is called when an error is highlighted in a DrRacket window.
+  
+  If the input is a list of @racket[srcloc?] objects, then all of them
+  are highlighted, and they are all of the errors known to DrRacket at this
+  point.
+  
+  If a single one is passed, then user probably typed the @litchar{.} menu
+  shortcut to highlight a single error and there may be other errors
+  known to DrRacket.
+  
+  Errors are made known to DrRacket via
+  @method[drracket:rep:text% highlight-errors].
+}
+                 
 @defmethod[(initialize-console) void?]{
 
 This inserts the ``Welcome to DrRacket'' message into the interactions