elisp/geiser-image.el

   1 ;;; geiser-image.el -- support for image display
   2
   3 ;; Copyright (c) 2012, 2015 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 ;;; Code:
  15
  16 (require 'geiser-custom)
  17 (require 'geiser-base)
  18 (require 'geiser-impl)
  19
  20 \f
  21 ;;; Customization:
  22
  23 (defgroup geiser-image nil
  24   "Options for image displaying."
  25   :group 'geiser)
  26
  27 (geiser-custom--defcustom geiser-image-viewer "display"
  28   "Which system image viewer program to invoke upon M-x
  29 `geiser-view-last-image'."
  30   :type 'string
  31   :group 'geiser-image)
  32
  33 (geiser-custom--defcustom geiser-image-cache-keep-last 10
  34   "How many images to keep in geiser's image cache."
  35   :type 'integer
  36   :group 'geiser-image)
  37
  38 (geiser-custom--defcustom geiser-image-cache-dir nil
  39   "Default directory where generated images are stored.
  40
  41 If nil, then the system wide tmp dir will be used."
  42   :type 'path
  43   :group 'geiser-image)
  44
  45 (geiser-custom--defface image-button
  46   'button geiser-image "image buttons in terminal buffers")
  47
  48 (geiser-impl--define-caller geiser-image--cache-dir image-cache-dir ()
  49   "Directory where generated images are stored.
  50 If this function returns nil, then no images are generated.")
  51
  52 \f
  53
  54 (defun geiser-image--list-cache ()
  55   "List all the images in the image cache."
  56   (let ((cdir (geiser-image--cache-dir nil)))
  57     (and cdir
  58          (file-directory-p cdir)
  59          (let ((files (directory-files-and-attributes cdir t
  60                                                       "geiser-img-[0-9]*.png")))
  61            (mapcar 'car (sort files (lambda (a b)
  62                                       (< (float-time (nth 6 a))
  63                                          (float-time (nth 6 b))))))))))
  64
  65 (defun geiser-image--clean-cache ()
  66   "Clean all except for the last `geiser-image-cache-keep-last'
  67 images in `geiser-image--cache-dir'."
  68   (interactive)
  69   (dolist (f (butlast (geiser-image--list-cache) geiser-image-cache-keep-last))
  70     (delete-file f)))
  71
  72 (defun geiser-image--display (file)
  73   (start-process "Geiser image view" nil geiser-image-viewer file))
  74
  75 (defun geiser-image--button-action (button)
  76   (let ((file (button-get button 'geiser-image-file)))
  77     (when (file-exists-p file) (geiser-image--display file))))
  78
  79 (define-button-type 'geiser-image--button
  80   'action 'geiser-image--button-action
  81   'follow-link t)
  82
  83 (defun geiser-image--insert-button (file)
  84   (insert-text-button "[image]"
  85                       :type 'geiser-image--button
  86                       'face 'geiser-font-lock-image-button
  87                       'geiser-image-file file
  88                       'help-echo "Click to display image"))
  89
  90 (defun geiser-image--replace-images (inline-images-p auto-p)
  91   "Replace all image patterns with actual images"
  92   (let ((seen 0))
  93     (with-silent-modifications
  94       (save-excursion
  95         (goto-char (point-min))
  96         (while (re-search-forward "\"?#<Image: \\([-+.\\\\/_:0-9a-zA-Z]+\\)>\"?"
  97                                   nil t)
  98           (setq seen (+ 1 seen))
  99           (let* ((file (match-string 1))
 100                  (begin (match-beginning 0))
 101                  (end (match-end 0)))
 102             (delete-region begin end)
 103             (goto-char begin)
 104             (if (and inline-images-p (display-images-p))
 105                 (insert-image (create-image file) "[image]")
 106               (geiser-image--insert-button file)
 107               (when auto-p (geiser-image--display file)))))))
 108     seen))
 109
 110 (defun geiser-view-last-image (n)
 111   "Open the last displayed image in the system's image viewer.
 112
 113 With prefix arg, open the N-th last shown image in the system's
 114 image viewer."
 115   (interactive "p")
 116   (let ((images (reverse (geiser-image--list-cache))))
 117     (if (>= (length images) n)
 118         (geiser-image--display (nth (- n 1) images))
 119       (error "There aren't %d recent images" n))))
 120
 121 \f
 122 (provide 'geiser-image)