diff options
| -rw-r--r-- | elisp/geiser-debug.el | 36 | ||||
| -rw-r--r-- | elisp/geiser-image.el | 46 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 4 | ||||
| -rw-r--r-- | scheme/racket/geiser/eval.rkt | 8 | ||||
| -rw-r--r-- | scheme/racket/geiser/images.rkt | 46 | ||||
| -rw-r--r-- | scheme/racket/geiser/user.rkt | 35 |
6 files changed, 109 insertions, 66 deletions
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index d7cf338..e5c13bf 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -1,6 +1,6 @@ ;;; geiser-debug.el -- displaying debug information and evaluation results -;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010, 2011, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -42,6 +42,15 @@ has no effect." :group 'geiser-debug :type 'int) + +(geiser-custom--defcustom geiser-debug-auto-display-images-p t + "Whether to automatically invoke the external viewer to display +images when they're evaluated. + +See also `geiser-repl-auto-display-images-p'." + :group 'geiser-debug + :type 'boolean) + ;;; Debug buffer mode: @@ -102,13 +111,26 @@ buffer.") (count-lines (point-min) (point-max))) geiser-debug-long-sexp-lines))) -(defun geiser-debug--display-retort (what ret &optional res) +(defun geiser-debug--insert-res (res) + (let ((begin (point))) + (insert res) + (let ((end (point))) + (goto-char begin) + (let ((no + (geiser-image--replace-images t + geiser-debug-auto-display-images-p))) + (goto-char end) + (newline 2) + (and no (> no 0)))))) + +(defun geiser-debug--display-retort (what ret &optional res auto-p) (let* ((err (geiser-eval--retort-error ret)) (key (geiser-eval--error-key err)) (output (geiser-eval--retort-output ret)) (impl geiser-impl--implementation) (module (geiser-eval--get-module)) - (jump nil) + (dbg nil) + (img nil) (dir default-directory) (buffer (current-buffer)) (debug (eq key 'geiser-debugger)) @@ -122,16 +144,14 @@ buffer.") (unless after (geiser-debug--display-error impl module nil what) (newline 2)) - (when (and res (not err)) - (insert res) - (newline 2)) - (setq jump (geiser-debug--display-error impl module key output)) + (setq img (when (and res (not err)) (geiser-debug--insert-res res))) + (setq dbg (geiser-debug--display-error impl module key output)) (when after (goto-char (point-max)) (insert "\nExpression evaluated was:\n\n") (geiser-debug--display-error impl module nil what)) (goto-char (point-min))) - (when jump (geiser-debug--pop-to-buffer)))) + (when (or img dbg) (geiser-debug--pop-to-buffer)))) (defsubst geiser-debug--wrap-region (str) (format "(begin %s)" str)) diff --git a/elisp/geiser-image.el b/elisp/geiser-image.el index 6b77ff3..f194e04 100644 --- a/elisp/geiser-image.el +++ b/elisp/geiser-image.el @@ -77,29 +77,33 @@ images in `geiser-image-cache-dir'." 'action 'geiser-image--button-action 'follow-link t) +(defun geiser-image--insert-button (file) + (insert-text-button "[image]" + :type 'geiser-image--button + 'face 'geiser-font-lock-image-button + 'geiser-image-file file + 'help-echo "Click to display image")) + (defun geiser-image--replace-images (inline-images-p auto-p) "Replace all image patterns with actual images" - (with-silent-modifications - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "#<Image: \\([-+./_0-9a-zA-Z]+\\)>" nil t) - ;; can't pass a filename to create-image because emacs might - ;; not display it before it gets deleted (race condition) - (let* ((file (match-string 1)) - (begin (match-beginning 0)) - (end (match-end 0))) - (delete-region begin end) - (if (and inline-images-p (display-images-p)) - (put-image (create-image file) begin "[image]") - (goto-char begin) - (insert-text-button "[image]" - :type 'geiser-image--button - 'face 'geiser-font-lock-image-button - 'geiser-image-file file - 'help-echo "Click to display image") - (when auto-p (geiser-image--display file))) - (setq geiser-image-cache-dir (file-name-directory file)) - (geiser-image--clean-cache)))))) + (let ((seen 0)) + (with-silent-modifications + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\"?#<Image: \\([-+./_0-9a-zA-Z]+\\)>\"?" nil t) + (setq seen (+ 1 seen)) + (let* ((file (match-string 1)) + (begin (match-beginning 0)) + (end (match-end 0))) + (delete-region begin end) + (if (and inline-images-p (display-images-p)) + (put-image (create-image file) begin "[image]") + (goto-char begin) + (geiser-image--insert-button file) + (when auto-p (geiser-image--display file))) + (setq geiser-image-cache-dir (file-name-directory file)) + (geiser-image--clean-cache))))) + seen)) (defun geiser-view-last-image (n) "Open the last displayed image in the system's image viewer. diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index ddcc6b8..c8846ea 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -123,7 +123,9 @@ If you have a slow system, try to increase this time." (geiser-custom--defcustom geiser-repl-auto-display-images-p t "Whether to automatically invoke the external viewer to display -images pooping up in the REPL." +images popping up in the REPL. + +See also `geiser-debug-auto-display-images-p'." :type 'boolean :group 'geiser-repl) diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt index 26ad959..9b510cf 100644 --- a/scheme/racket/geiser/eval.rkt +++ b/scheme/racket/geiser/eval.rkt @@ -1,6 +1,6 @@ ;;; eval.rkt -- evaluation -;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010, 2011, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -18,7 +18,7 @@ make-repl-reader) -(require geiser/enter geiser/modules) +(require geiser/enter geiser/modules geiser/images) (require errortrace/errortrace-lib) (define last-result (void)) @@ -37,10 +37,10 @@ (define (write-value v) (with-output-to-string - (lambda () (write v)))) + (lambda () (maybe-write-image v)))) (define (set-last-result . vs) - (set! last-result `((result ,@(map write-value vs))))) + (set! last-result `((result ,@(map write-value vs))))) (define (call-with-result thunk) (set-last-result (void)) diff --git a/scheme/racket/geiser/images.rkt b/scheme/racket/geiser/images.rkt new file mode 100644 index 0000000..ddc0286 --- /dev/null +++ b/scheme/racket/geiser/images.rkt @@ -0,0 +1,46 @@ +;;; images.rkt -- support for image handline + +;; Copyright (C) 2012 Jose Antonio Ortega Ruiz + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the Modified BSD License. You should +;; have received a copy of the license along with this program. If +;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. + +;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sun Sep 2, 2012 18:54 + + +#lang racket/base + +(require racket/file file/convertible racket/pretty) +(provide image-cache maybe-print-image maybe-write-image) + +(define image-cache + (let ([ensure-dir (lambda (dir) + (if (path-string? dir) + (begin (make-directory* dir) + (if (path? dir) (path->string dir) dir)) + (path->string (find-system-path 'temp-dir))))]) + (make-parameter (ensure-dir #f) ensure-dir))) + +(define (save-tmpimage imgbytes) + ;; Save imgbytes to a new temporary file and return the filename + (define filename (make-temporary-file "geiser-img-~a.png" #f (image-cache))) + (with-output-to-file filename #:exists 'truncate + (lambda () (display imgbytes))) + (format "#<Image: ~a>" filename)) + +(define (maybe-save-image value) + (and (convertible? value) + ;; (The above could be problematic if a future version of racket + ;; suddenly decides it can "convert" strings to picts) + (save-tmpimage (convert value 'png-bytes)))) + +(define (maybe-print-image value) + (cond [(maybe-save-image value) => (lambda (s) (printf "~a\n" s))] + [else (unless (void? value) + (pretty-print value))])) + +(define (maybe-write-image value) + (write (or (maybe-save-image value) value))) diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt index 2eb0cb5..e9540b0 100644 --- a/scheme/racket/geiser/user.rkt +++ b/scheme/racket/geiser/user.rkt @@ -14,12 +14,10 @@ (provide init-geiser-repl run-geiser-server start-geiser) (require (for-syntax racket/base) - file/convertible mzlib/thread - racket/file - racket/pretty racket/tcp geiser + geiser/images geiser/enter geiser/eval geiser/modules) @@ -91,41 +89,14 @@ (printf "racket@~a> " (namespace->module-name (current-namespace) (last-entered))))) -(define image-cache - (let ([ensure-dir (lambda (dir) - (if (path-string? dir) - (begin (make-directory* dir) - (if (path? dir) (path->string dir) dir)) - (path->string (find-system-path 'temp-dir))))]) - (make-parameter (ensure-dir #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" #f (image-cache))) - (with-output-to-file filename #:exists 'truncate - (lambda () (display imgbytes))) - filename) - -(define (geiser-maybe-print-image value) - (cond - [(and (convertible? value) - (convert value 'png-bytes)) - => (lambda (pngbytes) - ;; (The above could be problematic if a future version of racket - ;; suddenly decides it can "convert" strings to picts) - (printf "#<Image: ~a>\n" (geiser-save-tmpimage pngbytes)))] - [else - (unless (void? value) - (pretty-print value))])) - (define (init-geiser-repl) (compile-enforce-module-constants #f) (current-load/use-compiled geiser-loader) (current-prompt-read (geiser-prompt-read geiser-prompt)) - (current-print geiser-maybe-print-image)) + (current-print maybe-print-image)) (define (run-geiser-repl in out enforce-module-constants) (parameterize [(compile-enforce-module-constants enforce-module-constants) @@ -134,7 +105,7 @@ (current-error-port out) (current-load/use-compiled geiser-loader) (current-prompt-read (geiser-prompt-read geiser-prompt)) - (current-print geiser-maybe-print-image)] + (current-print maybe-print-image)] (read-eval-print-loop))) (define server-channel (make-channel)) |