summaryrefslogtreecommitdiff
path: root/elisp
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2012-09-02 02:34:47 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2012-09-02 02:34:47 +0200
commit67a2d3eac579b10e2f526f1282b459fcf8f12804 (patch)
treeda37308f7919a1f4ff051702cfe1948fba5d5f6a /elisp
parentde61b6f6580be0daad3e7aa97acd1534c30fbedf (diff)
downloadgeiser-guile-67a2d3eac579b10e2f526f1282b459fcf8f12804.tar.gz
geiser-guile-67a2d3eac579b10e2f526f1282b459fcf8f12804.tar.bz2
Image display functionality refactored to its own module
Diffstat (limited to 'elisp')
-rw-r--r--elisp/Makefile.am2
-rw-r--r--elisp/geiser-image.el102
-rw-r--r--elisp/geiser-racket.el13
-rw-r--r--elisp/geiser-reload.el3
-rw-r--r--elisp/geiser-repl.el69
-rw-r--r--elisp/geiser.el3
6 files changed, 113 insertions, 79 deletions
diff --git a/elisp/Makefile.am b/elisp/Makefile.am
index 1f1ca76..4b2b511 100644
--- a/elisp/Makefile.am
+++ b/elisp/Makefile.am
@@ -14,6 +14,7 @@ dist_lisp_LISP = \
geiser.el \
geiser-eval.el \
geiser-guile.el \
+ geiser-image.el \
geiser-impl.el \
geiser-log.el \
geiser-menu.el \
@@ -34,4 +35,3 @@ CLEANFILES = geiser-install.el geiser-load.el
geiser-install.el: $(srcdir)/geiser.el $(srcdir)/geiser-install.el.in
@sed -e "s|@SCHEME_DIR[@]|$(datarootdir)/geiser|" \
$(srcdir)/geiser-install.el.in >$@
-
diff --git a/elisp/geiser-image.el b/elisp/geiser-image.el
new file mode 100644
index 0000000..222e0d3
--- /dev/null
+++ b/elisp/geiser-image.el
@@ -0,0 +1,102 @@
+;; geiser-image.el -- support for image display
+
+;; 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>.
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Sun Sep 02, 2012 00:00
+
+
+
+(require 'geiser-custom)
+(require 'geiser-base)
+
+
+;;; Customization:
+
+(defgroup geiser-image nil
+ "Options for image displaying."
+ :group 'geiser)
+
+
+(geiser-custom--defcustom geiser-system-image-viewer "display"
+ "Which system image viewer program to invoke upon M-x
+`geiser-view-last-image'."
+ :type 'string
+ :group 'geiser-image)
+
+(geiser-custom--defcustom geiser-image-cache-keep-last 10
+ "How many images to keep in geiser's image cache."
+ :type 'integer
+ :group 'geiser-image)
+
+(geiser-custom--defcustom geiser-image-cache-dir nil
+ ;; Currently, this variable is updated, if needed, by racket during
+ ;; initialization. If/when we add image support for other
+ ;; implementations, we'll have to work with implementation-specific
+ ;; caches.
+ "Directory where generated images are stored. If nil, the
+system wide tmp dir will be used."
+ :type 'path
+ :group 'geiser-image)
+
+
+
+(defun geiser-image--list-cache ()
+ "List all the images in the image cache."
+ (and geiser-image-cache-dir
+ (file-directory-p geiser-image-cache-dir)
+ (let ((files (directory-files-and-attributes
+ geiser-image-cache-dir t "geiser-img-[0-9]*.png")))
+ (mapcar 'car
+ (sort files (lambda (a b)
+ (< (float-time (nth 6 a))
+ (float-time (nth 6 b)))))))))
+
+(defun geiser-image--clean-cache ()
+ "Clean all except for the last `geiser-image-cache-keep-last'
+images in `geiser-image-cache-dir'."
+ (interactive)
+ (dolist (f (butlast (geiser-image--list-cache) geiser-image-cache-keep-last))
+ (delete-file f)))
+
+(defun geiser-image--replace-images (inline-images-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]")
+ (progn
+ (goto-char begin)
+ (insert "[image] ; use M-x geiser-view-last-image to view")))
+ (setq geiser-image-cache-dir (file-name-directory file))
+ (geiser-image--clean-cache))))))
+
+(defun geiser-view-last-image (n)
+ "Open the last displayed image in the system's image viewer.
+
+With prefix arg, open the N-th last shown image in the system's
+image viewer."
+ (interactive "p")
+ (let ((images (reverse (geiser-image--list-cache))))
+ (if (>= (length images) n)
+ (start-process "Geiser image view"
+ nil
+ geiser-system-image-viewer
+ (nth (- n 1) images))
+ (error "There aren't %d recent images" n))))
+
+
+(provide 'geiser-image)
diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index 6a9847b..8794f84 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -14,6 +14,7 @@
(require 'geiser-edit)
(require 'geiser-doc)
(require 'geiser-eval)
+(require 'geiser-image)
(require 'geiser-syntax)
(require 'geiser-custom)
(require 'geiser-base)
@@ -63,12 +64,6 @@ 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:
@@ -99,10 +94,10 @@ This function uses `geiser-racket-init-file' if it exists."
(defconst geiser-racket--prompt-regexp "\\(mzscheme\\|racket\\)@[^ ]*?> ")
(defun geiser-racket--startup (remote)
- (if geiser-racket-image-cache-directory
+ (if geiser-image-cache-dir
(geiser-eval--send/wait
- `(:eval (image-cache ,geiser-racket-image-cache-directory) geiser/user))
- (setq geiser-racket-image-cache-directory
+ `(:eval (image-cache ,geiser-image-cache-dir) geiser/user))
+ (setq geiser-image-cache-dir
(geiser-eval--send/result '(:eval (image-cache) geiser/user)))))
diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el
index ca3eb1c..9d82840 100644
--- a/elisp/geiser-reload.el
+++ b/elisp/geiser-reload.el
@@ -1,6 +1,6 @@
;; geiser-reload.el -- unload/load geiser packages
-;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010, 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
@@ -40,6 +40,7 @@
geiser-menu
geiser-inf
geiser-impl
+ geiser-image
geiser-custom
geiser-log
geiser-popup
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index 704a7fb..7eb7cf0 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -19,6 +19,7 @@
(require 'geiser-eval)
(require 'geiser-connection)
(require 'geiser-menu)
+(require 'geiser-image)
(require 'geiser-custom)
(require 'geiser-base)
@@ -118,17 +119,6 @@ If you have a slow system, try to increase this time."
:type 'boolean
:group 'geiser-repl)
-(geiser-custom--defcustom geiser-system-image-viewer "display"
- "Which system image viewer program to invoke upon M-x
-`geiser-view-last-image'."
- :type 'string
- :group 'geiser-repl)
-
-(geiser-custom--defcustom geiser-image-cache-keep-last 10
- "How many images to keep in geiser's image cache."
- :type 'integer
- :group 'geiser-repl)
-
(geiser-custom--defface repl-input
'comint-highlight-input geiser-repl "evaluated input highlighting")
@@ -282,64 +272,9 @@ module command as a string")
(geiser-repl--host)
(geiser-repl--port)))))
-(defvar geiser-image-cache-dir nil)
-;; XXX make this a parameter from Racket...
-
-(defun geiser-repl--list-image-cache ()
- "List all the images in the image cache."
- (and geiser-image-cache-dir
- (file-directory-p geiser-image-cache-dir)
- (let ((files (directory-files-and-attributes
- geiser-image-cache-dir t "geiser-img-[0-9]*.png")))
- (mapcar 'car
- (sort files '(lambda (a b)
- (< (float-time (nth 6 a))
- (float-time (nth 6 b)))))))))
-
-(defun geiser-repl--clean-image-cache ()
- "Clean all except for the last `geiser-image-cache-keep-last'
-images in 'geiser-image-cache-dir'."
- (interactive)
- (dolist (file (butlast (geiser-repl--list-image-cache)
- geiser-image-cache-keep-last))
- (delete-file file)))
-
-(defun geiser-repl--replace-images ()
- "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 geiser-repl-inline-images (display-images-p))
- (put-image (create-image file) begin "[image]")
- (progn
- (goto-char begin)
- (insert "[image] ; use M-x geiser-view-last-image to view")))
- (setq geiser-image-cache-dir (file-name-directory file))
- (geiser-repl--clean-image-cache))))))
-
-(defun geiser-view-last-image (n)
- "Open the last displayed image in the system's image viewer.
-
-With prefix arg, open the N-th last shown image in the system's image viewer."
- (interactive "p")
- (let ((images (reverse (geiser-repl--list-image-cache))))
- (if (>= (length images) n)
- (start-process "Geiser image view"
- nil
- geiser-system-image-viewer
- (nth (- n 1) images))
- (error "There aren't %d recent images" n))))
-
(defun geiser-repl--output-filter (txt)
(geiser-con--connection-update-debugging geiser-repl--connection txt)
- (geiser-repl--replace-images)
+ (geiser-image--replace-images geiser-repl-inline-images)
(when (string-match-p (geiser-con--connection-prompt geiser-repl--connection)
txt)
(geiser-autodoc--disinhibit-autodoc)))
diff --git a/elisp/geiser.el b/elisp/geiser.el
index b88d48f..98ae410 100644
--- a/elisp/geiser.el
+++ b/elisp/geiser.el
@@ -1,6 +1,6 @@
;;; geiser.el -- main geiser file
-;; 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
@@ -83,6 +83,7 @@
geiser-faces
geiser-mode
geiser-guile
+ geiser-image
geiser-racket
geiser-implementation
geiser-xref))