1 ;; geiser-image.el -- support for image display
3 ;; Copyright (c) 2012 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
10 ;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz <jao@gnu.org>
11 ;; Start date: Sun Sep 02, 2012 00:00
15 (require 'geiser-custom
)
16 (require 'geiser-base
)
21 (defgroup geiser-image nil
22 "Options for image displaying."
25 (geiser-custom--defcustom geiser-system-image-viewer
"display"
26 "Which system image viewer program to invoke upon M-x
27 `geiser-view-last-image'."
31 (geiser-custom--defcustom geiser-image-cache-keep-last
10
32 "How many images to keep in geiser's image cache."
36 (geiser-custom--defcustom geiser-image-cache-dir nil
37 ;; Currently, this variable is updated, if needed, by racket during
38 ;; initialization. If/when we add image support for other
39 ;; implementations, we'll have to work with implementation-specific
41 "Directory where generated images are stored. If nil, the
42 system wide tmp dir will be used."
46 (geiser-custom--defface image-button
47 'button geiser-image
"image buttons in terminal buffers")
51 (defun geiser-image--list-cache ()
52 "List all the images in the image cache."
53 (and geiser-image-cache-dir
54 (file-directory-p geiser-image-cache-dir
)
55 (let ((files (directory-files-and-attributes
56 geiser-image-cache-dir t
"geiser-img-[0-9]*.png")))
58 (sort files
(lambda (a b
)
59 (< (float-time (nth 6 a
))
60 (float-time (nth 6 b
)))))))))
62 (defun geiser-image--clean-cache ()
63 "Clean all except for the last `geiser-image-cache-keep-last'
64 images in `geiser-image-cache-dir'."
66 (dolist (f (butlast (geiser-image--list-cache) geiser-image-cache-keep-last
))
69 (defun geiser-image--display (file)
70 (start-process "Geiser image view" nil geiser-system-image-viewer file
))
72 (defun geiser-image--button-action (button)
73 (let ((file (button-get button
'geiser-image-file
)))
74 (when (file-exists-p file
) (geiser-image--display file
))))
76 (define-button-type 'geiser-image--button
77 'action
'geiser-image--button-action
80 (defun geiser-image--insert-button (file)
81 (insert-text-button "[image]"
82 :type
'geiser-image--button
83 'face
'geiser-font-lock-image-button
84 'geiser-image-file file
85 'help-echo
"Click to display image"))
87 (defun geiser-image--replace-images (inline-images-p auto-p
)
88 "Replace all image patterns with actual images"
90 (with-silent-modifications
92 (goto-char (point-min))
93 (while (re-search-forward "\"?#<Image: \\([-+./_0-9a-zA-Z]+\\)>\"?" nil t
)
94 (setq seen
(+ 1 seen
))
95 (let* ((file (match-string 1))
96 (begin (match-beginning 0))
98 (delete-region begin end
)
99 (if (and inline-images-p
(display-images-p))
100 (put-image (create-image file
) begin
"[image]")
102 (geiser-image--insert-button file
)
103 (when auto-p
(geiser-image--display file
)))
104 (setq geiser-image-cache-dir
(file-name-directory file
))
105 (geiser-image--clean-cache)))))
108 (defun geiser-view-last-image (n)
109 "Open the last displayed image in the system's image viewer.
111 With prefix arg, open the N-th last shown image in the system's
114 (let ((images (reverse (geiser-image--list-cache))))
115 (if (>= (length images
) n
)
116 (geiser-image--display (nth (- n
1) images
))
117 (error "There aren't %d recent images" n
))))
120 (provide 'geiser-image
)