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

tracing window fixes: moved message for no trace results, fixed sizing, fixed streaming of infinite traces

Browse Source 
svn: r1392
This commit is contained in:
Matthew Flatt 2005-11-24 12:42:49 +00:00
parent 5e666ee64d
commit 80582a2a59
2 changed files with 38 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
collects/lang/htdp-langs.ss
View File

@ -701,10 +701,23 @@ tracing todo:
(fprintf sp "~v" arg))
(loop (cdr args))]))
(fprintf sp ")")
(parameterize ([current-eventspace drs-eventspace])
(queue-callback
(lambda ()
(send tab tracing:add-line (get-output-string sp))))))))))))))
(let ([sema (make-semaphore)])
;; Disable breaks, so an exn handler can't
;; grab the DrScheme eventspacae:
(parameterize-break #f
;; Queue callback to write trace line ---
;; low priority, so that infinite loops don't stop the user
;; from clicking "Break"
(parameterize ([current-eventspace drs-eventspace])
(queue-callback
(lambda ()
(send tab tracing:add-line (get-output-string sp))
(semaphore-post sema))
#f)))
;; Wait for th eline to get written, so that the
;; trace output doesn't get too far behind (which
;; matters, again, for infinite loops)
(semaphore-wait sema)))))))))))
(define-values/invoke-unit/sig tr:stacktrace^ tr:stacktrace@ tr tr:stacktrace-imports^)
@ -744,6 +757,8 @@ tracing todo:
(set! any-results? #f)
(send show-tracing-text lock #f)
(send show-tracing-text erase)
(send show-tracing-text auto-wrap #t)
(send show-tracing-text insert sc-tracing-nothing-to-show)
(send show-tracing-text lock #t))
(define show-tracing-text (new text:hide-caret/selection%))
@ -757,6 +772,9 @@ tracing todo:
(send (get-frame) show-tracing))
(send show-tracing-text begin-edit-sequence)
(send show-tracing-text lock #f)
(unless old-any?
(send show-tracing-text erase)
(send show-tracing-text auto-wrap #f))
(let ([insert
(lambda (s)
(send show-tracing-text insert s (send show-tracing-text last-position) 'same #f))])
@ -815,27 +833,22 @@ tracing todo:
(callback (lambda (x y) (toggle-tracing))))))
(define/public (show-tracing)
(set! tracing-visible? #t)
(send show-tracing-menu-item set-label sc-hide-tracing-window)
(send dragable-parent change-children
(lambda (l)
(let ([without (remq show-tracing-canvas l)])
(append without (list show-tracing-canvas)))))
(send dragable-parent set-percentages '(3/4 1/4)))
(set! tracing-visible? #t)
(send show-tracing-menu-item set-label sc-hide-tracing-window)
(send dragable-parent begin-container-sequence)
(send dragable-parent change-children
(lambda (l)
(let ([without (remq show-tracing-canvas l)])
(append without (list show-tracing-canvas)))))
(send dragable-parent set-percentages '(3/4 1/4))
(send dragable-parent end-container-sequence))
(define/private (hide-tracing)
(cond
[(not (send (get-current-tab) get-any-results?))
(message-box (string-constant drscheme)
sc-tracing-nothing-to-show
this
'(ok stop))]
[else
(set! tracing-visible? #f)
(send show-tracing-menu-item set-label sc-show-tracing-window)
(send dragable-parent change-children
(lambda (l)
(remq show-tracing-canvas l)))]))
(set! tracing-visible? #f)
(send show-tracing-menu-item set-label sc-show-tracing-window)
(send dragable-parent change-children
(lambda (l)
(remq show-tracing-canvas l))))
(define/private (toggle-tracing)
(if tracing-visible?

4
collects/string-constants/english-string-constants.ss
View File

@ -1059,7 +1059,7 @@ please adhere to these guidelines:
(tracing-enable-tracing "Enable tracing")
(tracing-show-tracing-window "Show Tracing")
(tracing-hide-tracing-window "Hide Tracing")
(tracing-tracing-nothing-to-show "No tracing results are available. Be sure your language supports tracing and it is enabled.")
(tracing-tracing-nothing-to-show "No tracing results are available, yet. (Make sure that your language supports tracing and that tracing is enabled.)")
;;; repl stuff
(evaluation-terminated "Evaluation Terminated")
@ -1295,7 +1295,7 @@ please adhere to these guidelines:
(profjBoxes-interactions-label "Interactions")
(profjBoxes-bad-java-id-error "Malformed Java ID")
(profjBoxes-examples-label "Examples")
(profjBoxes-add-new-example-button "Add new example")
(profjBoxes-add-new-example-button "Add New Example")
(profjBoxes-type "Type")
;; The Java identifier of an example of data
(profjBoxes-name "Name")