fix problems with Scribble HTML and PDF buttons
This commit is contained in:
parent
15ea740fa3
commit
94a55281c1
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user