dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

geiser-image.el (4110B)


      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 
     14 ;;; Code:
     15 
     16 (require 'geiser-custom)
     17 (require 'geiser-base)
     18 (require 'geiser-impl)
     19 
     20 
     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 
     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 
    122 (provide 'geiser-image)