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

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

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
+;; we queue a callback here to open the first frame
-;; the list of files to open, after parsing out flags like -h
+;; so that the modules that are being loaded by drracket
-(let* ([files-to-open 
+;; are all finished before we trigger the dynamic 
-        (if (preferences:get 'drracket:open-in-tabs)
+;; requires that can happen when the module language looks
-            (vector->list (current-command-line-arguments))
+;; at the #lang line (which can end up loading drracket itself
-            (reverse (vector->list (current-command-line-arguments))))]
+;; in a bad way leading to errors like this:
-       [normalized/filtered
+;;   link: reference (phase 0) to a variable in module: ...
-        (let loop ([files files-to-open])
+;;   that is uninitialized (phase level 0); 
-          (cond
+;;   reference appears in module: ...)
-            [(null? files) null]
+
-            [else (let ([file (car files)])
+(queue-callback
-                    (if (file-exists? file)
+ (λ ()
-                        (cons (normalize-path file) (loop (cdr files)))
+   ;; NOTE: drscheme-normal.rkt sets current-command-line-arguments to
-                        (begin
+   ;; the list of files to open, after parsing out flags like -h
-                          (message-box
+   (let* ([files-to-open 
-                           (string-constant drscheme)
+           (if (preferences:get 'drracket:open-in-tabs)
-                           (format (string-constant cannot-open-because-dne) file))
+               (vector->list (current-command-line-arguments))
-                          (loop (cdr files)))))]))]
+               (reverse (vector->list (current-command-line-arguments))))]
-       [no-dups (remove-duplicates normalized/filtered)]
+          [normalized/filtered
-       [frames
+           (let loop ([files files-to-open])
-        (map (λ (f) (handler:edit-file
+             (cond
-                     f
+               [(null? files) null]
-                     (λ () (drracket:unit:open-drscheme-window f))))
+               [else (let ([file (car files)])
-             no-dups)])
+                       (if (file-exists? file)
-  (when (null? (filter (λ (x) x) frames))
+                           (cons (normalize-path file) (loop (cdr files)))
-    (make-basic))
+                           (begin
-  (when (and (preferences:get 'drracket:open-in-tabs)
+                             (message-box
-             (not (null? no-dups)))
+                              (string-constant drscheme)
-    (handler:edit-file (car no-dups))))
+                              (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))))))

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)

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).})
+  
+ 
  
  ;                                                                        
  ;                                                                        

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)])))
 

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)]
+     (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))
+                          (printf "scribble: loading xref\n")
-             (define-values (base name dir?) (split-path fn))
+                          (define xref ((dynamic-require 'setup/xref 'load-collections-xref)))
-             (define sb 
+                          (printf "scribble: rendering\n")
-               (parameterize ([sandbox-security-guard (current-security-guard)])
+                          ((dynamic-require 'scribble/render 'render) 
-                 (make-evaluator 'racket/base)))
+                           (list (eval 'doc))
-             (define result
+                           (list fn)
-               (call-in-sandbox-context
+                           #:xrefs (list xref))
-                sb
+                          (cond
-                (λ ()
+                            [(equal? suffix #".html")
-                  (with-handlers (((λ (x) #t) (λ (e) (list 'exn e))))
+                             (send-url/file (path-replace-suffix fn suffix))]
-                    (parameterize ([current-output-port p]
+                            [else
-                                   [current-error-port p]
+                             (system (format "open ~s" (path->string (path-replace-suffix fn suffix))))]))]) 
-                                   [current-directory base]
+          (send drs-frame execute-callback))]
-                                   [error-display-handler original-error-display-handler]
+       [else
-                                   [current-command-line-arguments
+        (message-box "Scribble" "Cannot render buffer without filename")]))))
-                                    (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" 
+         (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)])
+         (make-render-button "Scribble PDF" pdf.png "--pdf" #".pdf")])
     (case (system-type)
       [(macosx) (list html-button pdf-button)]
       [else (list html-button)])))

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.

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

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].
 }

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.