Improve the backtrace window to make it show both the errortrace and the

racket-level stack traces

collects/drracket/private/debug.rkt

@@ -277,24 +277,29 @@ profile todo:
            #:definitions-text [defs (let ([rep (drracket:rep:current-rep)])
                                       (and rep
                                            (send rep get-definitions-text)))])
-                                                                     
+    (let* ([stack1 (or pre-stack '())]
-    (let* ([stack (or pre-stack
+           [stack2 (if (exn? exn)
-                      (if (exn? exn)
                        (map cdr (filter cdr (continuation-mark-set->context (exn-continuation-marks exn))))
-                          '()))]
+                       '())]
-           [src-locs (if (exn:srclocs? exn)
+           [src-locs (cond
-                         ((exn:srclocs-accessor exn) exn)
+                       [(exn:srclocs? exn)
-                         (if (null? stack)
+                        ((exn:srclocs-accessor exn) exn)]
-                             '()
+                       [(pair? stack1)
-                             (list (car stack))))]
+                        (list (car stack1))]
+                       [(pair? stack2)
+                        (list (car stack2))]
+                       [else '()])]
            [port-name-matches-cache (make-hasheq)]
-           [stack-editions (map (λ (x) (srcloc->edition/pair defs ints x port-name-matches-cache)) stack)]
+           [stack1-editions (map (λ (x) (srcloc->edition/pair defs ints x port-name-matches-cache)) stack1)]
+           [stack2-editions (map (λ (x) (srcloc->edition/pair defs ints x port-name-matches-cache)) stack2)]
            [src-locs-edition (and (pair? src-locs)
                                   (srcloc->edition/pair defs ints (car src-locs) port-name-matches-cache))])
+
       (print-planet-icon-to-stderr exn)
       (unless (exn:fail:user? exn)
-        (unless (null? stack)
+        (unless (and (null? stack1)
-          (print-bug-to-stderr msg stack stack-editions defs ints))
+                     (null? stack2))
+          (print-bug-to-stderr msg stack1 stack1-editions stack2 stack2-editions defs ints))
         (display-srclocs-in-error src-locs src-locs-edition))
       (display msg (current-error-port))
       (when (exn:fail:syntax? exn)
@@ -310,7 +315,9 @@ profile todo:
            (λ ()
              ;; need to make sure that the user's eventspace is still the same
              ;; and still running here?
-             (send ints highlight-errors src-locs stack)))))))
+             (send ints highlight-errors src-locs (if (null? stack1)
+                                                      stack2
+                                                      stack1))))))))
   
   (define (srcloc->edition/pair defs ints srcloc [port-name-matches-cache #f])
     (let ([src (srcloc-source srcloc)])
@@ -397,12 +404,12 @@ profile todo:
       (get-output-string sp)))
   
   ;; =User=
-  (define (print-bug-to-stderr msg cms editions defs ints)
+  (define (print-bug-to-stderr msg cms1 editions1 cms2 editions2 defs ints)
     (when (port-writes-special? (current-error-port))
       (let ([note% (if (mf-bday?) mf-note% bug-note%)])
         (when note%
           (let ([note (new note%)])
-            (send note set-callback (λ () (show-backtrace-window/edition-pairs msg cms editions defs ints)))
+            (send note set-callback (λ () (show-backtrace-window/edition-pairs/two msg cms1 editions1 cms2 editions2 defs ints)))
             (write-special note (current-error-port))
             (display #\space (current-error-port)))))))
   
@@ -623,16 +630,46 @@ profile todo:
     (show-backtrace-window/edition-pairs error-text dis (map (λ (x) #f) dis) defs rep)))
   
   (define (show-backtrace-window/edition-pairs error-text dis editions defs ints)
+    (show-backtrace-window/edition-pairs/two error-text dis editions '() '() defs ints))
+  
+  (define (show-backtrace-window/edition-pairs/two error-text dis1 editions1 dis2 editions2 defs ints)
     (reset-backtrace-window)
-    (letrec ([text (make-object (text:wide-snip-mixin text:hide-caret/selection%))]
+    (when (mf-bday?)
-             [mf-bday-note (when (mf-bday?)
       (instantiate message% ()
         (label (string-constant happy-birthday-matthias))
-                               (parent (send current-backtrace-window get-area-container))))]
+        (parent (send current-backtrace-window get-area-container))))
-             [ec (make-object (canvas:color-mixin canvas:wide-snip%)
+    (define tab-panel 
-                   (send current-backtrace-window get-area-container)
+      (if (and (pair? dis1) (pair? dis2))
-                   text)]
+          (new tab-panel% 
-             [di-vec (list->vector dis)]
+               [choices (list "Errortrace" "Builtin")]
+               [parent (send current-backtrace-window get-area-container)]
+               [callback
+                (λ (a b) 
+                  (send tab-panel change-children
+                        (λ (l) (if (zero? (send tab-panel get-selection))
+                                   (list ec1)
+                                   (list ec2)))))])
+          (new panel% [parent (send current-backtrace-window get-area-container)])))
+    (define text1 (and (pair? dis1) (new (text:wide-snip-mixin text:hide-caret/selection%))))
+    (define ec1 (and (pair? dis1) 
+                     (new (canvas:color-mixin canvas:wide-snip%)
+                          [parent tab-panel]
+                          [editor text1])))
+    (define text2 (and (pair? dis2) (new (text:wide-snip-mixin text:hide-caret/selection%))))
+    (define ec2 (and (pair? dis2) 
+                     (new (canvas:color-mixin canvas:wide-snip%)
+                          [parent tab-panel]
+                          [editor text2])))
+    (when (pair? dis1)
+      (add-one-set-to-frame text1 ec1 error-text dis1 editions1 defs ints))
+    (when (pair? dis2)
+      (add-one-set-to-frame text2 ec2 error-text dis2 editions2 defs ints))
+    (when (and (pair? dis1) (pair? dis2))
+      (send tab-panel change-children (λ (l) (list ec1)))))
+
+  
+  (define (add-one-set-to-frame text ec error-text dis editions defs ints)
+    (letrec ([di-vec (list->vector dis)]
              [editions-vec (list->vector editions)]
              [index 0]
              [how-many-at-once 15]
@@ -739,8 +776,9 @@ profile todo:
           (send text insert (render-bindings/snip bindings))))
       (send text insert #\newline)
       
+      (when (and start span)
         (insert-context editor-canvas text debug-source start span defs ints)
-      (send text insert #\newline)))
+        (send text insert #\newline))))
   
   ;; insert-context : (instanceof editor-canvas%)
   ;;                  (instanceof text%)

collects/drracket/private/drsig.rkt

@@ -72,6 +72,7 @@
    hide-backtrace-window
    show-backtrace-window
    show-backtrace-window/edition-pairs
+   show-backtrace-window/edition-pairs/two
    open-and-highlight-in-file
    
    small-planet-bitmap

collects/drracket/tool-lib.rkt

@@ -502,7 +502,11 @@ all of the names in the tools library, for use defining keybindings
   drracket:debug:show-backtrace-window/edition-pairs
   (-> string?
       (listof srcloc?)
-      (listof (or/c #f (cons/c (λ (x) (and (weak-box? x)
+      (listof 
+       (or/c 
+        #f
+        (cons/c (λ (x) 
+                  (and (weak-box? x)
                        (let ([v (weak-box-value x)])
                          (or (not v)
                              (is-a?/c v editor<%>)))))
@@ -511,16 +515,51 @@ all of the names in the tools library, for use defining keybindings
       (or/c #f (is-a?/c drracket:rep:text<%>))
       void?)
   (error-message dis editions-pairs defs ints)
+  @{Same as @racket[drracket:debug:show-backtrace-window/edition-pairs/two],
+            where the @racket[_dis2] and @racket[_editions-pairs2] arguments
+            are both @racket['()]})
+ 
+ (proc-doc/names
+  drracket:debug:show-backtrace-window/edition-pairs/two
+  (-> string?
+      (listof srcloc?)
+      (listof 
+       (or/c 
+        #f
+        (cons/c (λ (x) 
+                  (and (weak-box? x)
+                       (let ([v (weak-box-value x)])
+                         (or (not v)
+                             (is-a?/c v editor<%>)))))
+                number?)))
+      (listof srcloc?)
+      (listof 
+       (or/c 
+        #f
+        (cons/c (λ (x) 
+                  (and (weak-box? x)
+                       (let ([v (weak-box-value x)])
+                         (or (not v)
+                             (is-a?/c v editor<%>)))))
+                number?)))
+      (or/c #f (is-a?/c drracket:unit:definitions-text<%>))
+      (or/c #f (is-a?/c drracket:rep:text<%>))
+      void?)
+  (error-message dis1 editions-pairs1 dis2 editions-pairs2 defs ints)
   @{Shows the backtrace window you get when clicking on the bug in
     DrRacket's REPL.
     
     The @racket[error-message] argument is the text of the error,
-    @racket[dis] is the debug information, extracted from the
+    @racket[dis1] and @racket[dis2] are the stacktrace information, 
+    extracted from the
     continuation mark in the exception record, using
-    @racket[errortrace-key].
+    @racket[errortrace-key] and using
+    @racket[continuation-mark-set->context].
     
-    The @racket[editions] argument indicates the editions of any editors
+    The @racket[editions1] and @racket[editions2] arguments indicate
-    that are open editing the files corresponding to the source locations
+    the editions of any editors
+    that are open editing the files corresponding to the source locations.
+    The lists must have the same length as @racket[dis1] and @racket[dis2].
     
     The @racket[defs] argument should be non-@racket[#f] if there are 
     possibly stacktrace frames that contain unsaved versions of the