89 lines
3.6 KiB
Racket
89 lines
3.6 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/runtime-path
|
|
racket/gui/base
|
|
racket/class
|
|
mrlib/bitmap-label
|
|
racket/system
|
|
setup/xref
|
|
net/sendurl
|
|
racket/sandbox)
|
|
|
|
(provide drracket-buttons)
|
|
|
|
(define-runtime-path pdf-png-path "pdf.png")
|
|
(define-runtime-path html-png-path "html.png")
|
|
(define pdf.png (make-object bitmap% pdf-png-path 'png/mask))
|
|
(define html.png (make-object bitmap% html-png-path 'png/mask))
|
|
|
|
(define-namespace-anchor anchor)
|
|
|
|
(define original-error-display-handler (error-display-handler))
|
|
|
|
(define (make-render-button label bmp mode suffix extra-cmdline)
|
|
(list
|
|
label
|
|
bmp
|
|
(λ (drs-frame)
|
|
(let* ([t (send drs-frame get-definitions-text)]
|
|
[fn (send t get-filename)])
|
|
(if fn
|
|
(let ()
|
|
(send t save-file fn)
|
|
(define p (open-output-string))
|
|
(define-values (base name dir?) (split-path fn))
|
|
(define sb
|
|
(parameterize ([sandbox-security-guard (current-security-guard)])
|
|
(make-evaluator 'racket/base)))
|
|
(define result
|
|
(call-in-sandbox-context
|
|
sb
|
|
(λ ()
|
|
(with-handlers (((λ (x) #t) (λ (e) (list 'exn e))))
|
|
(parameterize ([current-output-port p]
|
|
[current-error-port p]
|
|
[current-directory base]
|
|
[error-display-handler original-error-display-handler]
|
|
[current-command-line-arguments
|
|
(list->vector
|
|
(append
|
|
extra-cmdline
|
|
(list "--quiet")
|
|
(list mode (if (path? fn) (path->string fn) fn))))])
|
|
(namespace-attach-module (namespace-anchor->empty-namespace anchor) 'setup/xref)
|
|
(dynamic-require 'scribble/run #f)
|
|
(list 'normal))))))
|
|
(cond
|
|
[(eq? (list-ref result 0) 'exn)
|
|
(define exn (list-ref result 1))
|
|
(define sp (open-output-string))
|
|
(cond
|
|
[(exn? exn)
|
|
(fprintf sp "~a\n" (exn-message exn))
|
|
(for ([x (in-list (continuation-mark-set->context (exn-continuation-marks exn)))])
|
|
(fprintf sp " ~s\n" x))]
|
|
[else
|
|
(fprintf sp "uncaught exn: ~s\n" exn)])
|
|
(message-box "Scribble HTML - DrRacket"
|
|
(get-output-string sp))]
|
|
[(equal? suffix #".html")
|
|
(send-url/file (path-replace-suffix fn suffix))]
|
|
[else
|
|
(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 "Scribble" "Cannot render buffer without filename"))))))
|
|
|
|
(define drracket-buttons
|
|
(let ([html-button
|
|
(make-render-button "Scribble HTML" html.png "--html" #".html"
|
|
'("++xref-in" "setup/xref" "load-collections-xref"))]
|
|
[pdf-button
|
|
;; only available on OSX currently
|
|
;; when we have a general way of opening pdfs, can use that
|
|
(make-render-button "Scribble PDF" pdf.png "--pdf" #".pdf" null)])
|
|
(case (system-type)
|
|
[(macosx) (list html-button pdf-button)]
|
|
[else (list html-button)])))
|