more printf to fprintfs

This commit is contained in:
Danny Yoo 2012-05-03 13:45:36 -04:00
parent bf33504e06
commit f5e57f6e85
2 changed files with 33 additions and 28 deletions

View File

@ -10,7 +10,7 @@
(define (abort-abort) (define (abort-abort)
(printf "Aborting compilation.\n") (fprintf (current-report-port) "Aborting compilation.\n")
(exit)) (exit))
@ -31,7 +31,7 @@
(define (check-valid-module-source module-source-path) (define (check-valid-module-source module-source-path)
;; Check that the file exists. ;; Check that the file exists.
(unless (file-exists? module-source-path) (unless (file-exists? module-source-path)
(printf "ERROR: Can't read a Racket module from ~e. The file does not appear to exist.\n" (fprintf (current-report-port) "ERROR: Can't read a Racket module from ~e. The file does not appear to exist.\n"
module-source-path) module-source-path)
(abort-abort)) (abort-abort))
@ -40,7 +40,8 @@
(cond [(rewrite-path module-source-path) (cond [(rewrite-path module-source-path)
(void)] (void)]
[else [else
(printf "ERROR: The file ~e appears to be outside the root package directory ~e. You may need to use --root-dir.\n" (fprintf (current-report-port)
"ERROR: The file ~e appears to be outside the root package directory ~e. You may need to use --root-dir.\n"
module-source-path module-source-path
(current-root-path)) (current-root-path))
(abort-abort)]) (abort-abort)])
@ -49,7 +50,7 @@
;; Does it look like something out of moby or js-vm? Abort early, because if we don't do ;; Does it look like something out of moby or js-vm? Abort early, because if we don't do
;; this up front, Racket will try to install the deprecated module, and that's bad. ;; this up front, Racket will try to install the deprecated module, and that's bad.
(when (looks-like-old-moby-or-js-vm? module-source-path) (when (looks-like-old-moby-or-js-vm? module-source-path)
(printf "ERROR: The program in ~e appears to be written using the deprecated project js-vm or Moby.\n\nPlease change the lang line to:\n\n #lang planet dyoo/whalesong\n\ninstead.\n" (fprintf (current-report-port) "ERROR: The program in ~e appears to be written using the deprecated project js-vm or Moby.\n\nPlease change the lang line to:\n\n #lang planet dyoo/whalesong\n\ninstead.\n"
module-source-path) module-source-path)
(abort-abort)) (abort-abort))
@ -60,10 +61,10 @@
(lambda (exn) (lambda (exn)
;; We can't even get the bytecode for the file. ;; We can't even get the bytecode for the file.
;; Fail immediately. ;; Fail immediately.
(printf "ERROR: Can't read a Racket module from ~e. The file may be ill-formed or be written in a language that Whalesong doesn't recognize.\n" (fprintf (current-report-port) "ERROR: Can't read a Racket module from ~e. The file may be ill-formed or be written in a language that Whalesong doesn't recognize.\n"
module-source-path) module-source-path)
(printf "\nFor reference, the error message produced when trying to read ~e is:\n\n" module-source-path) (fprintf (current-report-port) "\nFor reference, the error message produced when trying to read ~e is:\n\n" module-source-path)
(printf "~a\n" (exn-message exn)) (fprintf (current-report-port) "~a\n" (exn-message exn))
(abort-abort))]) (abort-abort))])
(parameterize ([read-accept-reader #t]) (parameterize ([read-accept-reader #t])
(call-with-input-file* module-source-path (call-with-input-file* module-source-path
@ -76,7 +77,7 @@
[(module name language body ...) [(module name language body ...)
#'language] #'language]
[else [else
(printf "ERROR: Can't read a Racket module from ~e. The file exists, but does not appear to be a Racket module.\n" (fprintf (current-report-port) "ERROR: Can't read a Racket module from ~e. The file exists, but does not appear to be a Racket module.\n"
module-source-path) module-source-path)
(abort-abort)])) (abort-abort)]))
@ -104,7 +105,7 @@
;; in a language that we, most likely, can't compile. ;; in a language that we, most likely, can't compile.
;; ;;
;; Let's see if we can provide a good error message here ;; Let's see if we can provide a good error message here
(printf "ERROR: The file ~e is a Racket module, but is written in the language ~a [~e], which Whalesong does not know how to compile.\n" (fprintf (current-report-port) "ERROR: The file ~e is a Racket module, but is written in the language ~a [~e], which Whalesong does not know how to compile.\n"
module-source-path module-source-path
(syntax->datum relative-language-stx) (syntax->datum relative-language-stx)
normalized-resolved-language-path) normalized-resolved-language-path)
@ -115,10 +116,10 @@
;; check that the file compiles. ;; check that the file compiles.
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
(lambda (exn) (lambda (exn)
(printf "ERROR: the racket module ~e raises a compile-time error during compilation." module-source-path) (fprintf (current-report-port) "ERROR: the racket module ~e raises a compile-time error during compilation." module-source-path)
(printf "\n\nFor reference, the error message produced during compilation is the following:\n\n") (fprintf (current-report-port) "\n\nFor reference, the error message produced during compilation is the following:\n\n")
(printf "~a\n" (exn-message exn)) (fprintf (current-report-port) "~a\n" (exn-message exn))
(newline) (newline (current-report-port))
(abort-abort))]) (abort-abort))])
(parameterize ([current-namespace ns] (parameterize ([current-namespace ns]
[current-load-relative-directory [current-load-relative-directory

View File

@ -22,19 +22,19 @@
[parent command-panel] [parent command-panel]
[label "Build a package"] [label "Build a package"]
[callback (lambda (button event) [callback (lambda (button event)
(build-dialog))]) (build-frame))])
(void)) (void))
(define NO-FILE-SELECTED "No file selected") (define NO-FILE-SELECTED "No file selected")
(define (build-dialog) (define (build-frame)
(define source-path #f) (define source-path #f)
(define dialog (new dialog% [label "Build a Whalesong package"])) (define frame (new frame% [label "Build a Whalesong package"]))
(define file-button (new button% (define file-button (new button%
[parent dialog] [parent frame]
[label "Choose file to build"] [label "Choose file to build"]
[callback (lambda (button event) [callback (lambda (button event)
(set! source-path (get-file)) (set! source-path (get-file))
@ -59,23 +59,23 @@
(send source-path-message set-label (send source-path-message set-label
NO-FILE-SELECTED) NO-FILE-SELECTED)
(send build-button enabled #f)]))])) (send build-button enabled #f)]))]))
(define source-path-message (new message% [parent dialog] (define source-path-message (new message% [parent frame]
[label NO-FILE-SELECTED] [label NO-FILE-SELECTED]
[auto-resize #t])) [auto-resize #t]))
(define dest-dir-message (new message% [parent dialog] (define dest-dir-message (new message% [parent frame]
[label ""] [label ""]
[auto-resize #t])) [auto-resize #t]))
(define build-button (new button% (define build-button (new button%
[parent dialog] [parent frame]
[label "Build!"] [label "Build!"]
[enabled #f] [enabled #f]
[callback (lambda (button event) [callback (lambda (button event)
(do-the-build source-path))])) (do-the-build source-path))]))
(define options-panel (new group-box-panel% (define options-panel (new group-box-panel%
[parent dialog] [parent frame]
[label "Options"])) [label "Options"]))
(new check-box% (new check-box%
[parent options-panel] [parent options-panel]
@ -83,18 +83,22 @@
[value (current-compress-javascript?)] [value (current-compress-javascript?)]
[callback (lambda (c e) (current-compress-javascript? (send c get-value)))]) [callback (lambda (c e) (current-compress-javascript? (send c get-value)))])
(send dialog show #t) (send frame show #t)
(void)) (void))
(define (do-the-build source-path) (define (do-the-build source-path)
(define f (new frame% [label "Building..."]))
(define t (new text% [auto-wrap #t]))
(define c (new editor-canvas% [parent f] [editor t]))
(send f show #t)
(thread (lambda ()
(parameterize ([current-report-port (open-output-text-editor t)])
(build-html-and-javascript source-path) (build-html-and-javascript source-path)
(message-box "Whalesong" "Build complete.")) (fprintf (current-report-port) "Build complete.")))))
#;(main) #;(main)
(build-dialog) (build-frame)