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
This commit is contained in:
Robby Findler 2011-08-24 11:23:54 -05:00
parent 7dfffb3eb8
commit 41e22a6e3f
10 changed files with 102 additions and 89 deletions

View File

@ -243,6 +243,7 @@
(current-rep (current-rep
current-language-settings current-language-settings
current-value-port current-value-port
after-expression
get-drs-bindings-keymap get-drs-bindings-keymap
error-delta error-delta
get-welcome-delta get-welcome-delta

View File

@ -745,6 +745,18 @@
(loop (cdr files)) (loop (cdr files))
(cons (car files) (loop (cdr files))))]))) (cons (car files) (loop (cdr files))))])))
;; 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 ;; NOTE: drscheme-normal.rkt sets current-command-line-arguments to
;; the list of files to open, after parsing out flags like -h ;; the list of files to open, after parsing out flags like -h
(let* ([files-to-open (let* ([files-to-open
@ -773,4 +785,4 @@
(make-basic)) (make-basic))
(when (and (preferences:get 'drracket:open-in-tabs) (when (and (preferences:get 'drracket:open-in-tabs)
(not (null? no-dups))) (not (null? no-dups)))
(handler:edit-file (car no-dups)))) (handler:edit-file (car no-dups))))))

View File

@ -429,6 +429,8 @@ TODO
(define log-max-size 1000) (define log-max-size 1000)
(define log-entry-max-size 1000) (define log-entry-max-size 1000)
(define after-expression (make-parameter #f))
(define text-mixin (define text-mixin
(mixin ((class->interface text%) (mixin ((class->interface text%)
text:ports<%> text:ports<%>
@ -1057,6 +1059,7 @@ TODO
(set! in-evaluation? #t) (set! in-evaluation? #t)
(update-running #t) (update-running #t)
(set! need-interaction-cleanup? #t) (set! need-interaction-cleanup? #t)
(define the-after-expression (after-expression))
(run-in-evaluation-thread (run-in-evaluation-thread
(λ () ; =User=, =Handler=, =No-Breaks= (λ () ; =User=, =Handler=, =No-Breaks=
@ -1105,6 +1108,11 @@ TODO
(default-continuation-prompt-tag) (default-continuation-prompt-tag)
(λ args (void)))) (λ args (void))))
(when the-after-expression
(call-with-continuation-prompt
(λ ()
(the-after-expression))))
(set! in-evaluation? #f) (set! in-evaluation? #f)
(update-running #f) (update-running #f)
(cleanup) (cleanup)

View File

@ -63,13 +63,17 @@ all of the names in the tools library, for use defining keybindings
(map (map
(λ (case) (λ (case)
(with-syntax ([(id ctc) (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) [(proc-doc/names id ctc . stuff)
(identifier? #'id) (identifier? #'id)
#'(id ctc)] #'(id ctc)]
[(proc-doc id ctc . stuff) [(proc-doc id ctc . stuff)
(identifier? #'id) (identifier? #'id)
#'(id ctc)] #'(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)])]) (raise-syntax-error 'provide/dr/doc "unknown thing" case)])])
(with-syntax ([mid (munge-id #'id)]) (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.}) 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).})
; ;
; ;

View File

@ -32,7 +32,7 @@
(define (scribble-base-info) (define (scribble-base-info)
(lambda (key defval default) (lambda (key defval default)
(case key (case key
[(drscheme:toolbar-buttons) [(drracket:toolbar-buttons)
(dynamic-require 'scribble/tools/drracket-buttons 'drracket-buttons)] (dynamic-require 'scribble/tools/drracket-buttons 'drracket-buttons)]
[else ((scribble-base-reader-info) key defval default)]))) [else ((scribble-base-reader-info) key defval default)])))

View File

@ -5,9 +5,8 @@
racket/class racket/class
mrlib/bitmap-label mrlib/bitmap-label
racket/system racket/system
setup/xref
net/sendurl net/sendurl
racket/sandbox) drracket/tool-lib)
(provide drracket-buttons) (provide drracket-buttons)
@ -20,69 +19,39 @@
(define original-error-display-handler (error-display-handler)) (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 (list
label label
bmp bmp
(λ (drs-frame) (λ (drs-frame)
(let* ([t (send drs-frame get-definitions-text)] (define fn (send (send drs-frame get-definitions-text) get-filename))
[fn (send t get-filename)]) (cond
(if fn [fn
(let () (parameterize ([drracket:rep:after-expression
(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)))) (printf "scribble: loading xref\n")
(parameterize ([current-output-port p] (define xref ((dynamic-require 'setup/xref 'load-collections-xref)))
[current-error-port p] (printf "scribble: rendering\n")
[current-directory base] ((dynamic-require 'scribble/render 'render)
[error-display-handler original-error-display-handler] (list (eval 'doc))
[current-command-line-arguments (list fn)
(list->vector #:xrefs (list xref))
(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 (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") [(equal? suffix #".html")
(send-url/file (path-replace-suffix fn suffix))] (send-url/file (path-replace-suffix fn suffix))]
[else [else
(system (format "open ~s" (path->string (path-replace-suffix fn suffix))))]) (system (format "open ~s" (path->string (path-replace-suffix fn suffix))))]))])
(let ([s (get-output-string p)]) (send drs-frame execute-callback))]
(unless (equal? s "") [else
(message-box "Scribble" s drs-frame)))) (message-box "Scribble" "Cannot render buffer without filename")]))))
(message-box "Scribble" "Cannot render buffer without filename"))))))
(define drracket-buttons (define drracket-buttons
(let ([html-button (let ([html-button
(make-render-button "Scribble HTML" html.png "--html" #".html" (make-render-button "Scribble HTML" html.png "--html" #".html")]
'("++xref-in" "setup/xref" "load-collections-xref"))]
[pdf-button [pdf-button
;; only available on OSX currently ;; only available on OSX currently
;; when we have a general way of opening pdfs, can use that ;; 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) (case (system-type)
[(macosx) (list html-button pdf-button)] [(macosx) (list html-button pdf-button)]
[else (list html-button)]))) [else (list html-button)])))

View File

@ -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. (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. 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 If @racket['drracket:toolbar-buttons] is not recognized, DrRacket will also
pass @indexed-racket['drscheme:toolbar-buttons]; this is for backwards pass @indexed-racket['drscheme:toolbar-buttons]; this is for backwards
compatibility and new code should not use it. compatibility and new code should not use it.

View File

@ -102,6 +102,11 @@ The @racket[complete-program?] argument determines if the
@method[drracket:language:language<%> front-end/interaction] method. @method[drracket:language:language<%> front-end/interaction] method.
When evaluation finishes, it calls @racket[cleanup] on the user's main thread. 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. This method must be called from the DrRacket main thread.
} }

View File

@ -839,7 +839,7 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
(-> (is-a?/c (-> (is-a?/c
top-level-window<%>) top-level-window<%>)
any))]{ 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 argument to the info proc returned
from @racket[read-language]. from @racket[read-language].
} }

View File

@ -293,7 +293,7 @@ button or chooses the Run menu item.
It calls It calls
@method[drracket:rep:context<%> ensure-rep-shown] and then 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 @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. @litchar{#!} in which case, it skips the first line.