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
parent
7dfffb3eb8
commit
41e22a6e3f
|
|
@ -243,6 +243,7 @@
|
|||
(current-rep
|
||||
current-language-settings
|
||||
current-value-port
|
||||
after-expression
|
||||
get-drs-bindings-keymap
|
||||
error-delta
|
||||
get-welcome-delta
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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).})
|
||||
|
||||
|
||||
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -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)])))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)])))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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].
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user