From 7a44d396d1ddfda97b55e9ff134046d60da70e92 Mon Sep 17 00:00:00 2001 From: Greg Cooper Date: Tue, 18 Jul 2006 04:24:35 +0000 Subject: [PATCH] fixed a bug in persistent breakpoint maintenance (handling eval'd exprs w/o source location info) implemented right-click menu feature to print variable and return values to the console (useful when rendering something wider than space around buttons in debug control pane) svn: r3748 --- collects/mztake/debug-tool.ss | 47 +++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 19 deletions(-) diff --git a/collects/mztake/debug-tool.ss b/collects/mztake/debug-tool.ss index 2ddcc5eddf..b5117f4b72 100644 --- a/collects/mztake/debug-tool.ss +++ b/collects/mztake/debug-tool.ss @@ -21,9 +21,7 @@ (provide tool@) (define (robust-syntax-source stx) - (if (syntax? stx) - (syntax-source stx) - #f)) + (and (syntax? stx) (syntax-source stx))) ; QUESTIONS/IDEAS ; what is the right way to deal with macros? @@ -277,17 +275,22 @@ (invalidate-bitmap-cache))) (let ([pc (send (get-tab) get-pc)]) (if (and pc (= pos pc)) - (let ([stat (send (get-tab) get-break-status)] - [f (get-top-level-window)]) + (let* ([stat (send (get-tab) get-break-status)] + [f (get-top-level-window)] + [rendered-value (if (= 2 (length stat)) + (render (cadr stat)) + (format "~a" (cons 'values + (map (lambda (v) (render v)) (rest stat)))))]) (when (cons? stat) - (send (make-object menu-item% - (clean-status - (if (= 2 (length stat)) - (format "value = ~a" (render (cadr stat))) - (format "~a" (cons 'values - (map (lambda (v) (render v)) (rest stat)))))) + #;(send (make-object menu-item% + (clean-status (format "expr -> ~a" rendered-value)) menu - void) enable #f)) + void) enable #f) + (make-object menu-item% + "Print return value to console" + menu + (lambda _ (send (get-tab) print-to-console (format "return val = ~a" + rendered-value))))) (when (not (eq? stat 'break)) (make-object menu-item% (if (cons? stat) @@ -335,12 +338,12 @@ [val (mark-binding-value binding)] [menu (make-object popup-menu% #f)]) - (send (make-object menu-item% - (clean-status - (format "~a = ~a" id-sym val)) - menu - (lambda (item evt) - (printf "~a" val))) enable #f) + (make-object menu-item% + (clean-status + (format "Print value of ~a to console" id-sym)) + menu + (lambda (item evt) + (send (get-tab) print-to-console (format "~a = ~a" id-sym val)))) (make-object menu-item% (format "(set! ~a ...)" id-sym) menu @@ -501,7 +504,8 @@ breakpoints (lambda (pos status) ; possible efficiency problem for large files with many breakpoints - (when (and (>= pos (syntax-position top-e)) + (when (and (syntax-position top-e) + (>= pos (syntax-position top-e)) (< pos (+ (syntax-position top-e) (syntax-span top-e))) (not (memq pos break-posns))) (hash-table-remove! breakpoints pos)))) @@ -639,6 +643,11 @@ (channel-put result-ch (get-output-string s))))) (channel-get result-ch))) + (define/public (print-to-console v) + ;; ==drscheme eventspace thread== + ;; only when a user thread is suspended + (channel-put in-user-ch (lambda () (fprintf (current-error-port) " ### DEBUGGER: ~a~n" v)))) + (define/public (suspend-gui frames status) (set! want-suspend-on-break? #f) (hash-table-put! breakpoints -1 #f)