fix problems with Scribble HTML and PDF buttons

This commit is contained in:
Matthew Flatt 2010-05-21 07:15:39 -06:00
parent 15ea740fa3
commit 94a55281c1
2 changed files with 13 additions and 5 deletions

View File

@ -27,6 +27,7 @@
(define current-extra-files (make-parameter null)) (define current-extra-files (make-parameter null))
(define current-redirect (make-parameter #f)) (define current-redirect (make-parameter #f))
(define current-redirect-main (make-parameter #f)) (define current-redirect-main (make-parameter #f))
(define current-quiet (make-parameter #f))
(define (read-one str) (define (read-one str)
(let ([i (open-input-string str)]) (let ([i (open-input-string str)])
@ -85,6 +86,9 @@
'scribble "bad procedure identifier for ++ref-in: ~s" proc-id)) 'scribble "bad procedure identifier for ++ref-in: ~s" proc-id))
(current-xref-input-modules (current-xref-input-modules
(cons (cons mod id) (current-xref-input-modules))))] (cons (cons mod id) (current-xref-input-modules))))]
#:once-each
[("--quiet") "suppress output-file reporting"
(current-quiet #t)]
#:args (file . another-file) #:args (file . another-file)
(let ([files (cons file another-file)]) (let ([files (cons file another-file)])
(build-docs (map (lambda (file) (dynamic-require `(file ,file) 'doc)) (build-docs (map (lambda (file) (dynamic-require `(file ,file) 'doc))
@ -104,7 +108,8 @@
(send renderer set-external-tag-path (current-redirect))) (send renderer set-external-tag-path (current-redirect)))
(when (current-redirect-main) (when (current-redirect-main)
(send renderer set-external-root-url (current-redirect-main))) (send renderer set-external-root-url (current-redirect-main)))
(send renderer report-output!) (unless (current-quiet)
(send renderer report-output!))
(let* ([fns (map (lambda (fn) (let* ([fns (map (lambda (fn)
(let-values ([(base name dir?) (split-path fn)]) (let-values ([(base name dir?) (split-path fn)])
(let ([fn (path-replace-suffix (let ([fn (path-replace-suffix

View File

@ -34,15 +34,18 @@
(list->vector (list->vector
(append (append
extra-cmdline extra-cmdline
(list "--dest" (path->string base)) (list "--dest" (path->string base) "--quiet")
(list mode (if (path? fn) (path->string fn) fn))))]) (list mode (if (path? fn) (path->string fn) fn))))])
(namespace-attach-module (namespace-anchor->empty-namespace anchor) 'setup/xref) (namespace-attach-module (namespace-anchor->empty-namespace anchor) 'setup/xref)
(dynamic-require 'scribble/run #f) (dynamic-require 'scribble/run #f)
(cond (cond
[(equal? label "HTML") [(equal? suffix #".html")
(send-url/file (path-replace-suffix fn suffix))] (send-url/file (path-replace-suffix fn suffix))]
[else (system (format "open ~a" (path-replace-suffix name suffix)))])) [else
(message-box "Scribble" (get-output-string p) drs-frame)) (system (format "open ~s" (path->string (path-replace-suffix fn suffix))))]))
(let ([s (get-output-string p)])
(unless (equal? s "")
(message-box "Scribble" s drs-frame))))
(message-box "Not Named" "Cannot render unsaved file")))))) (message-box "Not Named" "Cannot render unsaved file"))))))
(define drracket-buttons (define drracket-buttons