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

sending things to the report port

Browse Source
This commit is contained in:
Danny Yoo 2012-05-02 23:34:45 -04:00
parent 4f929a7171
commit 89c224439b
3 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
whalesong-cmd.rkt
View File

@ -51,8 +51,8 @@
(define (set-root-path! root-path)
(unless (directory-exists? root-path)
(printf "ERROR: root path ~a does not appear to exist.\n" root-path)
(printf "Aborting compilation.\n")
(fprintf (current-report-port) "ERROR: root path ~a does not appear to exist.\n" root-path)
(fprintf (current-report-port) "Aborting compilation.\n")
(exit))
(current-root-path (normalize-path root-path)))

4
whalesong-gui.rkt
View File

@ -52,12 +52,12 @@
(path->string source-path))))
(send dest-dir-message set-label
(gui-utils:quote-literal-label
(format "Output will be written to ~s."
(format "Output will be written to directory ~s."
(path->string (current-output-dir)))))
(send build-button enable #t)]
[else
(send source-path-message set-label
(format NO-FILE-SELECTED source-path))
NO-FILE-SELECTED)
(send build-button enabled #f)]))]))
(define source-path-message (new message% [parent dialog]
[label NO-FILE-SELECTED]

18
whalesong-helpers.rkt
View File

@ -48,15 +48,15 @@
(define (with-catchall-exception-handler thunk)
(with-handlers
[(void (lambda (exn)
(printf "ERROR: Whalesong has encountered an internal error.\n\n")
(printf "Please send the following error report log to dyoo@hashcollision.org.\n\n")
(fprintf (current-report-port) "ERROR: Whalesong has encountered an internal error.\n\n")
(fprintf (current-report-port) "Please send the following error report log to dyoo@hashcollision.org.\n\n")
(define op (open-output-string))
(parameterize ([current-error-port op])
((error-display-handler) (exn-message exn) exn))
(printf "------------------\n")
(displayln (get-output-string op))
(printf "------------------\n")
(printf "\nAborting compilation.\n")
(fprintf (current-report-port) "------------------\n")
(displayln (get-output-string op) (current-report-port))
(fprintf (current-report-port) "------------------\n")
(fprintf (current-report-port) "\nAborting compilation.\n")
(exit)))]
(thunk)))
@ -80,8 +80,8 @@
(let ([msg (sync receiver)])
(match msg
[(vector level msg data)
(fprintf (current-error-port)"~a: ~a\n" level msg)
(flush-output (current-error-port))]))
(fprintf (current-report-port)"~a: ~a\n" level msg)
(flush-output (current-report-port))]))
(loop)))))))
(define (build-standalone-xhtml f)
@ -278,4 +278,4 @@
(define (print-version)
(printf "~a\n" (this-package-version)))
(fprintf (current-report-port) "~a\n" (this-package-version)))