diff options
author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2012-09-02 02:34:47 +0200 |
---|---|---|
committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2012-09-02 02:34:47 +0200 |
commit | 67a2d3eac579b10e2f526f1282b459fcf8f12804 (patch) | |
tree | da37308f7919a1f4ff051702cfe1948fba5d5f6a /elisp | |
parent | de61b6f6580be0daad3e7aa97acd1534c30fbedf (diff) | |
download | geiser-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.am | 2 | ||||
-rw-r--r-- | elisp/geiser-image.el | 102 | ||||
-rw-r--r-- | elisp/geiser-racket.el | 13 | ||||
-rw-r--r-- | elisp/geiser-reload.el | 3 | ||||
-rw-r--r-- | elisp/geiser-repl.el | 69 | ||||
-rw-r--r-- | elisp/geiser.el | 3 |
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)) |