From 7aadb540ecaee8b23f0f22a29ac1e30fe90bb741 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Feb 2016 17:14:50 -0800 Subject: [PATCH] button works --- quad/quad/lang/buttons.rkt | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/quad/quad/lang/buttons.rkt b/quad/quad/lang/buttons.rkt index 588711b6..3fc9eb9b 100644 --- a/quad/quad/lang/buttons.rkt +++ b/quad/quad/lang/buttons.rkt @@ -3,10 +3,11 @@ racket/gui/base racket/class quad/render - quad) + quad + racket/system) (provide make-drracket-buttons) - +(define-namespace-anchor cache-module-ns) (module test racket/base) ; suppress testing by `raco test` (define-runtime-path html-png-path "cmd-char.png") @@ -17,12 +18,24 @@ http://pkg-build.racket-lang.org/doc/tools/drracket_module-language-tools.html#% |# + (define (make-command-char-button command-char) (let ([label "Render PDF"] [bitmap (make-object bitmap% html-png-path 'png/mask)] [callback (λ (drr-frame) - (time (send (new pdf-renderer%) render-to-file (typeset 'boom) "f2-test.pdf")))] + (define fn (send (send drr-frame get-definitions-text) get-filename)) + (define pdfn (path-replace-suffix fn #".pdf")) + (define fn-out (parameterize ([current-namespace (make-base-namespace)]) + (namespace-attach-module (namespace-anchor->namespace cache-module-ns) 'quad) + (dynamic-require fn 'out))) + (when fn-out + (define-values (fn-dir name dir?) (split-path fn)) + (parameterize ([current-directory fn-dir]) + (send (new pdf-renderer%) render-to-file (typeset fn-out) pdfn)) + (parameterize ([current-input-port (open-input-string "")]) + (system (format "open \"~a\"" (path->string pdfn))))))] [number 99]) + (list label bitmap callback number))) (define (make-drracket-buttons command-char)