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

PR 10375

Browse Source 
svn: r15698
This commit is contained in:
Robby Findler 2009-08-11 01:02:56 +00:00
parent 5604144718
commit 86d0ef6b1b
2 changed files with 43 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/drscheme/private/debug.ss
View File

@ -277,26 +277,28 @@ profile todo:
((exn:srclocs-accessor exn) exn) ((exn:srclocs-accessor exn) exn)
(if (null? stack) (if (null? stack)
'() '()
(list (car stack))))]) (list (car stack))))]
[rep (let ([rep (drscheme:rep:current-rep)])
(and (is-a? rep drscheme:rep:text<%>)
rep))])
(print-planet-icon-to-stderr exn) (print-planet-icon-to-stderr exn)
(unless (null? stack) (unless (null? stack)
(print-bug-to-stderr msg stack)) (print-bug-to-stderr msg stack rep))
(display-srclocs-in-error src-locs) (display-srclocs-in-error src-locs)
(display msg (current-error-port)) (display msg (current-error-port))
(when (exn:fail:syntax? exn) (when (exn:fail:syntax? exn)
(show-syntax-error-context (current-error-port) exn)) (show-syntax-error-context (current-error-port) exn))
(newline (current-error-port)) (newline (current-error-port))
(flush-output (current-error-port)) (flush-output (current-error-port))
(let ([rep (drscheme:rep:current-rep)]) (when (and rep
(when (and (is-a? rep drscheme:rep:text<%>) (eq? (current-error-port)
(eq? (current-error-port) (send rep get-err-port)))
(send rep get-err-port))) (parameterize ([current-eventspace drscheme:init:system-eventspace])
(parameterize ([current-eventspace drscheme:init:system-eventspace]) (queue-callback
(queue-callback (λ ()
(λ () ;; need to make sure that the user's eventspace is still the same
;; need to make sure that the user's eventspace is still the same ;; and still running here?
;; and still running here? (send rep highlight-errors src-locs stack)))))))
(send rep highlight-errors src-locs stack))))))))
;; =User= ;; =User=
(define (print-planet-icon-to-stderr exn) (define (print-planet-icon-to-stderr exn)
@ -356,12 +358,12 @@ profile todo:
(get-output-string sp))) (get-output-string sp)))
;; =User= ;; =User=
(define (print-bug-to-stderr msg cms) (define (print-bug-to-stderr msg cms rep)
(when (port-writes-special? (current-error-port)) (when (port-writes-special? (current-error-port))
(let ([note% (if (mf-bday?) mf-note% bug-note%)]) (let ([note% (if (mf-bday?) mf-note% bug-note%)])
(when note% (when note%
(let ([note (new note%)]) (let ([note (new note%)])
(send note set-callback (λ () (show-backtrace-window msg cms))) (send note set-callback (λ () (show-backtrace-window msg cms rep)))
(write-special note (current-error-port)) (write-special note (current-error-port))
(display #\space (current-error-port))))))) (display #\space (current-error-port)))))))
@ -571,7 +573,7 @@ profile todo:
;; (listof srcloc?) ;; (listof srcloc?)
;; -> ;; ->
;; void ;; void
(define (show-backtrace-window error-text dis/exn) (define (show-backtrace-window error-text dis/exn [rep #f])
(let ([dis (if (exn? dis/exn) (let ([dis (if (exn? dis/exn)
(cms->srclocs (exn-continuation-marks dis/exn)) (cms->srclocs (exn-continuation-marks dis/exn))
dis/exn)]) dis/exn)])
@ -597,7 +599,7 @@ profile todo:
(cond (cond
[(and (< n (vector-length di-vec)) [(and (< n (vector-length di-vec))
(< n (+ index how-many-at-once))) (< n (+ index how-many-at-once)))
(show-frame ec text (vector-ref di-vec n)) (show-frame ec text (vector-ref di-vec n) rep)
(loop (+ n 1))] (loop (+ n 1))]
[else [else
(set! index n)])) (set! index n)]))
@ -658,10 +660,11 @@ profile todo:
;; show-frame : (instanceof editor-canvas%) ;; show-frame : (instanceof editor-canvas%)
;; (instanceof text%) ;; (instanceof text%)
;; st-mark? ;; st-mark?
;; rep
;; -> ;; ->
;; void ;; void
;; shows one frame of the continuation ;; shows one frame of the continuation
(define (show-frame editor-canvas text di) (define (show-frame editor-canvas text di rep)
(let* ([debug-source (srcloc-source di)] (let* ([debug-source (srcloc-source di)]
[line (srcloc-line di)] [line (srcloc-line di)]
[column (srcloc-column di)] [column (srcloc-column di)]
@ -689,18 +692,24 @@ profile todo:
(send text insert (render-bindings/snip bindings)))) (send text insert (render-bindings/snip bindings))))
(send text insert #\newline) (send text insert #\newline)
(insert-context editor-canvas text debug-source start span) (insert-context editor-canvas text debug-source start span rep)
(send text insert #\newline))) (send text insert #\newline)))
;; insert-context : (instanceof editor-canvas%) ;; insert-context : (instanceof editor-canvas%)
;; (instanceof text%) ;; (instanceof text%)
;; debug-info ;; debug-info
;; number ;; number
;; rep
;; -> ;; ->
;; void ;; void
(define (insert-context editor-canvas text file start span) (define (insert-context editor-canvas text file start span rep)
(let-values ([(from-text close-text) (let-values ([(from-text close-text)
(cond (cond
[(and rep (send rep port-name-matches? file))
(values rep void)]
[(and rep (send (send rep get-definitions-text) port-name-matches? file))
(values (send rep get-definitions-text) void)]
#;
[(symbol? file) [(symbol? file)
;; can this case happen? ;; can this case happen?
(let ([text (new text:basic%)]) (let ([text (new text:basic%)])

23
collects/drscheme/tool-lib.ss
View File

@ -365,20 +365,27 @@ all of the names in the tools library, for use defining keybindings
(proc-doc/names (proc-doc/names
drscheme:debug:show-backtrace-window drscheme:debug:show-backtrace-window
(string? (->* (string?
(or/c exn? (or/c exn?
(listof srcloc?) (listof srcloc?)
(non-empty-listof (cons/c string? (listof srcloc?)))) (non-empty-listof (cons/c string? (listof srcloc?)))))
. -> . ((or/c #f (is-a?/c drscheme:rep:text<%>)))
void?) void?)
(error-message dis) ((error-message dis)
((rep #f)))
@{Shows the backtrace window you get when clicking on the bug in @{Shows the backtrace window you get when clicking on the bug in
DrScheme's REPL. DrScheme's REPL.
The @scheme[error-message] argument is the text of the error, The @scheme[error-message] argument is the text of the error,
@scheme[dis] is the debug information, extracted from the @scheme[dis] is the debug information, extracted from the
continuation mark in the exception record, using continuation mark in the exception record, using
@scheme[errortrace-key].}) @scheme[errortrace-key].
The @scheme[rep] argument should be non-@scheme[#f] if there are
possibly stacktrace frames that contain unsaved versions of the
definitions text or the repl from drscheme. Use
@scheme[drscheme:rep:current-rep] to get the rep.
})
; ;