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

fixed a bug in persistent breakpoint maintenance (handling eval'd exprs

Browse Source 
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
This commit is contained in:
Greg Cooper 2006-07-18 04:24:35 +00:00
parent 1e41bbcffd
commit 7a44d396d1
1 changed files with 28 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/mztake/debug-tool.ss
View File

@ -21,9 +21,7 @@
(provide tool@) (provide tool@)
(define (robust-syntax-source stx) (define (robust-syntax-source stx)
(if (syntax? stx) (and (syntax? stx) (syntax-source stx)))
(syntax-source stx)
#f))
; QUESTIONS/IDEAS ; QUESTIONS/IDEAS
; what is the right way to deal with macros? ; what is the right way to deal with macros?
@ -277,17 +275,22 @@
(invalidate-bitmap-cache))) (invalidate-bitmap-cache)))
(let ([pc (send (get-tab) get-pc)]) (let ([pc (send (get-tab) get-pc)])
(if (and pc (= pos pc)) (if (and pc (= pos pc))
(let ([stat (send (get-tab) get-break-status)] (let* ([stat (send (get-tab) get-break-status)]
[f (get-top-level-window)]) [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) (when (cons? stat)
(send (make-object menu-item% #;(send (make-object menu-item%
(clean-status (clean-status (format "expr -> ~a" rendered-value))
(if (= 2 (length stat))
(format "value = ~a" (render (cadr stat)))
(format "~a" (cons 'values
(map (lambda (v) (render v)) (rest stat))))))
menu 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)) (when (not (eq? stat 'break))
(make-object menu-item% (make-object menu-item%
(if (cons? stat) (if (cons? stat)
@ -335,12 +338,12 @@
[val (mark-binding-value [val (mark-binding-value
binding)] binding)]
[menu (make-object popup-menu% #f)]) [menu (make-object popup-menu% #f)])
(send (make-object menu-item% (make-object menu-item%
(clean-status (clean-status
(format "~a = ~a" id-sym val)) (format "Print value of ~a to console" id-sym))
menu menu
(lambda (item evt) (lambda (item evt)
(printf "~a" val))) enable #f) (send (get-tab) print-to-console (format "~a = ~a" id-sym val))))
(make-object menu-item% (make-object menu-item%
(format "(set! ~a ...)" id-sym) (format "(set! ~a ...)" id-sym)
menu menu
@ -501,7 +504,8 @@
breakpoints breakpoints
(lambda (pos status) (lambda (pos status)
; possible efficiency problem for large files with many breakpoints ; 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))) (< pos (+ (syntax-position top-e) (syntax-span top-e)))
(not (memq pos break-posns))) (not (memq pos break-posns)))
(hash-table-remove! breakpoints pos)))) (hash-table-remove! breakpoints pos))))
@ -639,6 +643,11 @@
(channel-put result-ch (get-output-string s))))) (channel-put result-ch (get-output-string s)))))
(channel-get result-ch))) (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) (define/public (suspend-gui frames status)
(set! want-suspend-on-break? #f) (set! want-suspend-on-break? #f)
(hash-table-put! breakpoints -1 #f) (hash-table-put! breakpoints -1 #f)