From 9b31ffba524337003c00a62997a27a62a270100e Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 20 Aug 2012 06:15:04 +0200 Subject: [PATCH] Racket: configurable image cache directory Brought to you by a comma-command in the REPL and the REPL startup function. --- elisp/geiser-racket.el | 37 +++++++++++++++++++++++++------------ scheme/racket/geiser/user.rkt | 11 ++++++++++- 2 files changed, 35 insertions(+), 13 deletions(-) diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index 52f7a32..0cb4663 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -63,6 +63,12 @@ This executable is used by `run-gracket', and, if :type '(repeat string) :group 'geiser-racket) +(geiser-custom--defcustom geiser-racket-image-cache-directory nil + "The directory where temporary image files generated by Racket are stored. +If set to nil, the default system temp dir is used." + :type 'file + :group 'geiser-racket) + ;;; REPL support: @@ -92,6 +98,24 @@ This function uses `geiser-racket-init-file' if it exists." (defconst geiser-racket--prompt-regexp "\\(mzscheme\\|racket\\)@[^ ]*?> ") +(defun geiser-racket--startup (remote) + (when geiser-racket-image-cache-directory + (geiser-eval--send/wait + (format ",set-image-cache %S\n'done" + geiser-racket-image-cache-directory)))) + + +;;; Remote REPLs + +(defun connect-to-racket () + "Start a Racket REPL connected to a remote process. + +The remote process needs to be running a REPL server started +using start-geiser, a procedure in the geiser/server module." + (interactive) + (geiser-connect 'racket)) + + ;;; Evaluation support: @@ -281,24 +305,13 @@ This function uses `geiser-racket-init-file' if it exists." -;;; Remote REPLs - -(defun connect-to-racket () - "Start a Racket REPL connected to a remote process. - -The remote process needs to be running a REPL server started -using start-geiser, a procedure in the geiser/server module." - (interactive) - (geiser-connect 'racket)) - - - ;;; Implementation definition: (define-geiser-implementation racket (unsupported-procedures '(callers callees generic-methods)) (binary geiser-racket--binary) (arglist geiser-racket--parameters) + (repl-startup geiser-racket--startup) (prompt-regexp geiser-racket--prompt-regexp) (marshall-procedure geiser-racket--geiser-procedure) (find-module geiser-racket--get-module) diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt index 38eefd8..5d3ab32 100644 --- a/scheme/racket/geiser/user.rkt +++ b/scheme/racket/geiser/user.rkt @@ -79,6 +79,9 @@ [(geiser-eval) (geiser-eval)] [(geiser-no-values) (datum->syntax #f (void))] [(add-to-load-path) (add-to-load-path (read))] + [(set-image-cache) (image-cache (read))] + [(image-cache) (image-cache)] + [(gcd) (current-directory)] [(cd) (current-directory (read))] [else form])] [_ form]))) @@ -88,12 +91,18 @@ (printf "racket@~a> " (namespace->module-name (current-namespace) (last-entered))))) +(define image-cache + (let ([ensure-dir (lambda (dir) + (and (path-string? dir) + (begin (make-directory* dir) dir)))]) + (make-parameter #f ensure-dir))) + (define (geiser-prompt-read prompt) (make-repl-reader (geiser-read prompt))) (define (geiser-save-tmpimage imgbytes) ;; Save imgbytes to a new temporary file and return the filename - (define filename (make-temporary-file "geiser-img-~a.png")) + (define filename (make-temporary-file "geiser-img-~a.png" #f (image-cache))) (with-output-to-file filename #:exists 'truncate (lambda () (display imgbytes))) filename) -- 2.11.4.GIT