suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Autosaving when Scribble buttons are clicked

Browse Source
This commit is contained in:
Jay McCarthy 2010-08-26 10:27:02 -06:00
parent 7190d423f7
commit bd14fbb4ee
1 changed files with 26 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
collects/scribble/tools/drracket-buttons.rkt
View File

@ -24,30 +24,32 @@
(λ (drs-frame) (λ (drs-frame)
(let* ([t (send drs-frame get-definitions-text)] (let* ([t (send drs-frame get-definitions-text)]
[fn (send t get-filename)]) [fn (send t get-filename)])
(if (and fn (not (send t is-modified?))) (if fn
(let-values ([(p) (open-output-string)] (begin
[(base name dir?) (split-path fn)]) (send t save-file fn)
(parameterize ([current-namespace (make-base-namespace)] (let-values ([(p) (open-output-string)]
[current-output-port p] [(base name dir?) (split-path fn)])
[current-error-port p] (parameterize ([current-namespace (make-base-namespace)]
[current-directory base] [current-output-port p]
[current-command-line-arguments [current-error-port p]
(list->vector [current-directory base]
(append [current-command-line-arguments
extra-cmdline (list->vector
(list "--quiet") (append
(list mode (if (path? fn) (path->string fn) fn))))]) extra-cmdline
(namespace-attach-module (namespace-anchor->empty-namespace anchor) 'setup/xref) (list "--quiet")
(dynamic-require 'scribble/run #f) (list mode (if (path? fn) (path->string fn) fn))))])
(cond (namespace-attach-module (namespace-anchor->empty-namespace anchor) 'setup/xref)
[(equal? suffix #".html") (dynamic-require 'scribble/run #f)
(send-url/file (path-replace-suffix fn suffix))] (cond
[else [(equal? suffix #".html")
(system (format "open ~s" (path->string (path-replace-suffix fn suffix))))])) (send-url/file (path-replace-suffix fn suffix))]
(let ([s (get-output-string p)]) [else
(unless (equal? s "") (system (format "open ~s" (path->string (path-replace-suffix fn suffix))))]))
(message-box "Scribble" s drs-frame)))) (let ([s (get-output-string p)])
(message-box "Not Named" "Cannot render unsaved file")))))) (unless (equal? s "")
(message-box "Scribble" s drs-frame)))))
(message-box "Scribble" "Cannot render buffer without filename"))))))
(define drracket-buttons (define drracket-buttons
(let ([html-button (let ([html-button