From 41e22a6e3f53e927728353618151e3f6d5bb647c Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 24 Aug 2011 11:23:54 -0500 Subject: [PATCH] added the ability to tell drracket to run a program and then run something after that used that ability to make the scribble buttons work better --- collects/drracket/private/drsig.rkt | 1 + collects/drracket/private/main.rkt | 70 +++++++++------- collects/drracket/private/rep.rkt | 8 ++ collects/drracket/tool-lib.rkt | 16 +++- collects/scribble/base/reader.rkt | 2 +- collects/scribble/tools/drracket-buttons.rkt | 79 ++++++------------- .../tools/module-language-tools.scrbl | 4 + collects/scribblings/tools/rep.scrbl | 7 +- collects/scribblings/tools/tools.scrbl | 2 +- collects/scribblings/tools/unit.scrbl | 2 +- 10 files changed, 102 insertions(+), 89 deletions(-) diff --git a/collects/drracket/private/drsig.rkt b/collects/drracket/private/drsig.rkt index 63f03209ff..a1a4a0313c 100644 --- a/collects/drracket/private/drsig.rkt +++ b/collects/drracket/private/drsig.rkt @@ -243,6 +243,7 @@ (current-rep current-language-settings current-value-port + after-expression get-drs-bindings-keymap error-delta get-welcome-delta diff --git a/collects/drracket/private/main.rkt b/collects/drracket/private/main.rkt index ee99019681..3d9e6bc915 100644 --- a/collects/drracket/private/main.rkt +++ b/collects/drracket/private/main.rkt @@ -745,32 +745,44 @@ (loop (cdr files)) (cons (car files) (loop (cdr files))))]))) -;; NOTE: drscheme-normal.rkt sets current-command-line-arguments to -;; the list of files to open, after parsing out flags like -h -(let* ([files-to-open - (if (preferences:get 'drracket:open-in-tabs) - (vector->list (current-command-line-arguments)) - (reverse (vector->list (current-command-line-arguments))))] - [normalized/filtered - (let loop ([files files-to-open]) - (cond - [(null? files) null] - [else (let ([file (car files)]) - (if (file-exists? file) - (cons (normalize-path file) (loop (cdr files))) - (begin - (message-box - (string-constant drscheme) - (format (string-constant cannot-open-because-dne) file)) - (loop (cdr files)))))]))] - [no-dups (remove-duplicates normalized/filtered)] - [frames - (map (λ (f) (handler:edit-file - f - (λ () (drracket:unit:open-drscheme-window f)))) - no-dups)]) - (when (null? (filter (λ (x) x) frames)) - (make-basic)) - (when (and (preferences:get 'drracket:open-in-tabs) - (not (null? no-dups))) - (handler:edit-file (car no-dups)))) +;; we queue a callback here to open the first frame +;; so that the modules that are being loaded by drracket +;; are all finished before we trigger the dynamic +;; requires that can happen when the module language looks +;; at the #lang line (which can end up loading drracket itself +;; in a bad way leading to errors like this: +;; link: reference (phase 0) to a variable in module: ... +;; that is uninitialized (phase level 0); +;; reference appears in module: ...) + +(queue-callback + (λ () + ;; NOTE: drscheme-normal.rkt sets current-command-line-arguments to + ;; the list of files to open, after parsing out flags like -h + (let* ([files-to-open + (if (preferences:get 'drracket:open-in-tabs) + (vector->list (current-command-line-arguments)) + (reverse (vector->list (current-command-line-arguments))))] + [normalized/filtered + (let loop ([files files-to-open]) + (cond + [(null? files) null] + [else (let ([file (car files)]) + (if (file-exists? file) + (cons (normalize-path file) (loop (cdr files))) + (begin + (message-box + (string-constant drscheme) + (format (string-constant cannot-open-because-dne) file)) + (loop (cdr files)))))]))] + [no-dups (remove-duplicates normalized/filtered)] + [frames + (map (λ (f) (handler:edit-file + f + (λ () (drracket:unit:open-drscheme-window f)))) + no-dups)]) + (when (null? (filter (λ (x) x) frames)) + (make-basic)) + (when (and (preferences:get 'drracket:open-in-tabs) + (not (null? no-dups))) + (handler:edit-file (car no-dups)))))) diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index 7a92d35c56..cc08bfea90 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -429,6 +429,8 @@ TODO (define log-max-size 1000) (define log-entry-max-size 1000) + (define after-expression (make-parameter #f)) + (define text-mixin (mixin ((class->interface text%) text:ports<%> @@ -1057,6 +1059,7 @@ TODO (set! in-evaluation? #t) (update-running #t) (set! need-interaction-cleanup? #t) + (define the-after-expression (after-expression)) (run-in-evaluation-thread (λ () ; =User=, =Handler=, =No-Breaks= @@ -1105,6 +1108,11 @@ TODO (default-continuation-prompt-tag) (λ args (void)))) + (when the-after-expression + (call-with-continuation-prompt + (λ () + (the-after-expression)))) + (set! in-evaluation? #f) (update-running #f) (cleanup) diff --git a/collects/drracket/tool-lib.rkt b/collects/drracket/tool-lib.rkt index 500b058b77..9f2f66b2a3 100644 --- a/collects/drracket/tool-lib.rkt +++ b/collects/drracket/tool-lib.rkt @@ -63,13 +63,17 @@ all of the names in the tools library, for use defining keybindings (map (λ (case) (with-syntax ([(id ctc) - (syntax-case case (proc-doc/names proc-doc) + (syntax-case case (proc-doc/names proc-doc parameter-doc parameter/c) [(proc-doc/names id ctc . stuff) (identifier? #'id) #'(id ctc)] [(proc-doc id ctc . stuff) (identifier? #'id) #'(id ctc)] + [(parameter-doc id (parameter/c ctc) arg-id . stuff) + (and (identifier? #'id) + (identifier? #'arg-id)) + #'(id (parameter/c ctc))] [_ (raise-syntax-error 'provide/dr/doc "unknown thing" case)])]) (with-syntax ([mid (munge-id #'id)]) @@ -861,6 +865,16 @@ all of the names in the tools library, for use defining keybindings It is only initialized on the user's thread.}) + (parameter-doc + drracket:rep:after-expression + (parameter/c (or/c #f any/c)) + top-level-expression + @{This parameter is used by @method[drracket:rep:text% evaluate-from-port]. + When it is something other than @racket[#f], then DrRacket passes it to + @racket[eval] as the last thing that it does on the user's thread (before + cleaning up).}) + + ; ; diff --git a/collects/scribble/base/reader.rkt b/collects/scribble/base/reader.rkt index 11278df862..db82523337 100644 --- a/collects/scribble/base/reader.rkt +++ b/collects/scribble/base/reader.rkt @@ -32,7 +32,7 @@ (define (scribble-base-info) (lambda (key defval default) (case key - [(drscheme:toolbar-buttons) + [(drracket:toolbar-buttons) (dynamic-require 'scribble/tools/drracket-buttons 'drracket-buttons)] [else ((scribble-base-reader-info) key defval default)]))) diff --git a/collects/scribble/tools/drracket-buttons.rkt b/collects/scribble/tools/drracket-buttons.rkt index 36f5eb1881..95fbdb558f 100644 --- a/collects/scribble/tools/drracket-buttons.rkt +++ b/collects/scribble/tools/drracket-buttons.rkt @@ -5,9 +5,8 @@ racket/class mrlib/bitmap-label racket/system - setup/xref net/sendurl - racket/sandbox) + drracket/tool-lib) (provide drracket-buttons) @@ -20,69 +19,39 @@ (define original-error-display-handler (error-display-handler)) -(define (make-render-button label bmp mode suffix extra-cmdline) +(define (make-render-button label bmp mode suffix) (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 fn (send (send drs-frame get-definitions-text) get-filename)) + (cond + [fn + (parameterize ([drracket:rep:after-expression + (λ () + (printf "scribble: loading xref\n") + (define xref ((dynamic-require 'setup/xref 'load-collections-xref))) + (printf "scribble: rendering\n") + ((dynamic-require 'scribble/render 'render) + (list (eval 'doc)) + (list fn) + #:xrefs (list xref)) + (cond + [(equal? suffix #".html") + (send-url/file (path-replace-suffix fn suffix))] + [else + (system (format "open ~s" (path->string (path-replace-suffix fn suffix))))]))]) + (send drs-frame execute-callback))] + [else + (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"))] + (make-render-button "Scribble HTML" html.png "--html" #".html")] [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)]) + (make-render-button "Scribble PDF" pdf.png "--pdf" #".pdf")]) (case (system-type) [(macosx) (list html-button pdf-button)] [else (list html-button)]))) diff --git a/collects/scribblings/tools/module-language-tools.scrbl b/collects/scribblings/tools/module-language-tools.scrbl index f830e7de15..569671d45d 100644 --- a/collects/scribblings/tools/module-language-tools.scrbl +++ b/collects/scribblings/tools/module-language-tools.scrbl @@ -21,6 +21,10 @@ first. The string is the label on the button; the bitmap is the icon (it should be 16x16), and the function is called when the button is clicked. If the result is @racket[#f], then no toolbar buttons are created. +To implement functionality similar to the Run button, call the +@method[drracket:unit:frame% execute-callback] method. You may also +want to use the @racket[drracket:rep:after-expression] parameter. + If @racket['drracket:toolbar-buttons] is not recognized, DrRacket will also pass @indexed-racket['drscheme:toolbar-buttons]; this is for backwards compatibility and new code should not use it. diff --git a/collects/scribblings/tools/rep.scrbl b/collects/scribblings/tools/rep.scrbl index 9e6e9e1b74..aad85cab10 100644 --- a/collects/scribblings/tools/rep.scrbl +++ b/collects/scribblings/tools/rep.scrbl @@ -102,8 +102,13 @@ The @racket[complete-program?] argument determines if the @method[drracket:language:language<%> front-end/interaction] method. When evaluation finishes, it calls @racket[cleanup] on the user's main thread. + Just before calling @racket[cleanup], this invokes the thunk in + @racket[drracket:rep:after-expression] (if any). It takes the value of + the @racket[drracket:rep:after-expression] parameter on the DrRacket main thread, + but invokes the thunk on the user's thread. + This method must be called from the DrRacket main thread. -} + } @defmethod[#:mode augment (after-many-evals) any]{ Called from the DrRacket main thread after diff --git a/collects/scribblings/tools/tools.scrbl b/collects/scribblings/tools/tools.scrbl index ea87237798..5dd6f85c0f 100644 --- a/collects/scribblings/tools/tools.scrbl +++ b/collects/scribblings/tools/tools.scrbl @@ -839,7 +839,7 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to (-> (is-a?/c top-level-window<%>) any))]{ - This is meant to be used with the @racket['drscheme:toolbar-buttons] + This is meant to be used with the @racket['drracket:toolbar-buttons] argument to the info proc returned from @racket[read-language]. } diff --git a/collects/scribblings/tools/unit.scrbl b/collects/scribblings/tools/unit.scrbl index db332576b1..5d271d1625 100644 --- a/collects/scribblings/tools/unit.scrbl +++ b/collects/scribblings/tools/unit.scrbl @@ -293,7 +293,7 @@ button or chooses the Run menu item. It calls @method[drracket:rep:context<%> ensure-rep-shown] and then it calls -@method[drracket:rep:text% do-many-text-evals] passing in the result of +@method[drracket:rep:text% evaluate-from-port] passing in the result of @method[drracket:unit:frame<%> get-interactions-text] and its entire range, unless the first two characters are @litchar{#!} in which case, it skips the first line.