elisp/geiser-image.el

   1 ;; geiser-image.el -- support for image display
   2
   3 ;; Copyright (c) 2012 Jose Antonio Ortega Ruiz
   4
   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>.
   9
  10 ;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz <jao@gnu.org>
  11 ;; Start date: Sun Sep 02, 2012 00:00
  12
  13 \f
  14
  15 (require 'geiser-custom)
  16 (require 'geiser-base)
  17
  18 \f
  19 ;;; Customization:
  20
  21 (defgroup geiser-image nil
  22   "Options for image displaying."
  23   :group 'geiser)
  24
  25 (geiser-custom--defcustom geiser-image-viewer "display"
  26   "Which system image viewer program to invoke upon M-x
  27 `geiser-view-last-image'."
  28   :type 'string
  29   :group 'geiser-image)
  30
  31 (geiser-custom--defcustom geiser-image-cache-keep-last 10
  32   "How many images to keep in geiser's image cache."
  33   :type 'integer
  34   :group 'geiser-image)
  35
  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
  40   ;; caches.
  41   "Directory where generated images are stored.  If nil, the
  42 system wide tmp dir will be used."
  43   :type 'path
  44   :group 'geiser-image)
  45
  46 (geiser-custom--defface image-button
  47   'button geiser-image "image buttons in terminal buffers")
  48
  49 \f
  50
  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")))
  57          (mapcar 'car
  58                  (sort files (lambda (a b)
  59                                (< (float-time (nth 6 a))
  60                                   (float-time (nth 6 b)))))))))
  61
  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'."
  65   (interactive)
  66   (dolist (f (butlast (geiser-image--list-cache) geiser-image-cache-keep-last))
  67     (delete-file f)))
  68
  69 (defun geiser-image--display (file)
  70   (start-process "Geiser image view" nil geiser-image-viewer file))
  71
  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))))
  75
  76 (define-button-type 'geiser-image--button
  77   'action 'geiser-image--button-action
  78   'follow-link t)
  79
  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"))
  86
  87 (defun geiser-image--replace-images (inline-images-p auto-p)
  88   "Replace all image patterns with actual images"
  89   (let ((seen 0))
  90     (with-silent-modifications
  91       (save-excursion
  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))
  97                  (end (match-end 0)))
  98             (delete-region begin end)
  99             (goto-char begin)
 100             (if (and inline-images-p (display-images-p))
 101                 (insert-image (create-image file) "[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)))))
 106     seen))
 107
 108 (defun geiser-view-last-image (n)
 109   "Open the last displayed image in the system's image viewer.
 110
 111 With prefix arg, open the N-th last shown image in the system's
 112 image viewer."
 113   (interactive "p")
 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))))
 118
 119 \f
 120 (provide 'geiser-image)