summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2012-09-02 20:19:36 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2012-09-02 20:19:36 +0200
commit8f2e4ba17b704965f3a35d1d0a312dec31800862 (patch)
treef77861b30ff1a031292eed0104d195559fcc99cd
parentb05120e5872382528c73416046d4e19cdb1bc88f (diff)
downloadgeiser-chez-8f2e4ba17b704965f3a35d1d0a312dec31800862.tar.gz
geiser-chez-8f2e4ba17b704965f3a35d1d0a312dec31800862.tar.bz2
racket: displaying images also during evaluations
-rw-r--r--elisp/geiser-debug.el36
-rw-r--r--elisp/geiser-image.el46
-rw-r--r--elisp/geiser-repl.el4
-rw-r--r--scheme/racket/geiser/eval.rkt8
-rw-r--r--scheme/racket/geiser/images.rkt46
-rw-r--r--scheme/racket/geiser/user.rkt35
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))