LCOV - code coverage report
Current view: top level - lisp - image.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 2 396 0.5 %
Date: 2017-08-27 09:44:50 Functions: 1 42 2.4 %

          Line data    Source code
       1             : ;;; image.el --- image API  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 1998-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Maintainer: emacs-devel@gnu.org
       6             : ;; Keywords: multimedia
       7             : ;; Package: emacs
       8             : 
       9             : ;; This file is part of GNU Emacs.
      10             : 
      11             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      12             : ;; it under the terms of the GNU General Public License as published by
      13             : ;; the Free Software Foundation, either version 3 of the License, or
      14             : ;; (at your option) any later version.
      15             : 
      16             : ;; GNU Emacs is distributed in the hope that it will be useful,
      17             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      18             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      19             : ;; GNU General Public License for more details.
      20             : 
      21             : ;; You should have received a copy of the GNU General Public License
      22             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      23             : 
      24             : ;;; Commentary:
      25             : 
      26             : ;;; Code:
      27             : 
      28             : (defgroup image ()
      29             :   "Image support."
      30             :   :group 'multimedia)
      31             : 
      32             : (defalias 'image-refresh 'image-flush)
      33             : 
      34             : (defconst image-type-header-regexps
      35             :   `(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
      36             :     ("\\`P[1-6]\\(?:\
      37             : \\(?:\\(?:#[^\r\n]*[\r\n]\\)?[[:space:]]\\)+\
      38             : \\(?:\\(?:#[^\r\n]*[\r\n]\\)?[0-9]\\)+\
      39             : \\)\\{2\\}" . pbm)
      40             :     ("\\`GIF8[79]a" . gif)
      41             :     ("\\`\x89PNG\r\n\x1a\n" . png)
      42             :     ("\\`[\t\n\r ]*#define \\([a-z0-9_]+\\)_width [0-9]+\n\
      43             : #define \\1_height [0-9]+\n\\(\
      44             : #define \\1_x_hot [0-9]+\n\
      45             : #define \\1_y_hot [0-9]+\n\\)?\
      46             : static \\(unsigned \\)?char \\1_bits" . xbm)
      47             :     ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff)
      48             :     ("\\`[\t\n\r ]*%!PS" . postscript)
      49             :     ("\\`\xff\xd8" . jpeg)    ; used to be (image-jpeg-p . jpeg)
      50             :     (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
      51             :              (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
      52             :         (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<"
      53             :                 comment-re "*"
      54             :                 "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
      55             :                 "[Ss][Vv][Gg]"))
      56             :      . svg)
      57             :     )
      58             :   "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
      59             : When the first bytes of an image file match REGEXP, it is assumed to
      60             : be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol.  If not a symbol,
      61             : IMAGE-TYPE must be a pair (PREDICATE . TYPE).  PREDICATE is called
      62             : with one argument, a string containing the image data.  If PREDICATE returns
      63             : a non-nil value, TYPE is the image's type.")
      64             : 
      65             : (defvar image-type-file-name-regexps
      66             :   '(("\\.png\\'" . png)
      67             :     ("\\.gif\\'" . gif)
      68             :     ("\\.jpe?g\\'" . jpeg)
      69             :     ("\\.bmp\\'" . bmp)
      70             :     ("\\.xpm\\'" . xpm)
      71             :     ("\\.pbm\\'" . pbm)
      72             :     ("\\.xbm\\'" . xbm)
      73             :     ("\\.ps\\'" . postscript)
      74             :     ("\\.tiff?\\'" . tiff)
      75             :     ("\\.svgz?\\'" . svg)
      76             :     )
      77             :   "Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
      78             : When the name of an image file match REGEXP, it is assumed to
      79             : be of image type IMAGE-TYPE.")
      80             : 
      81             : ;; We rely on `auto-mode-alist' to detect xbm and xpm files, instead
      82             : ;; of content autodetection.  Their contents are just C code, so it is
      83             : ;; easy to generate false matches.
      84             : (defvar image-type-auto-detectable
      85             :   '((pbm . t)
      86             :     (xbm . nil)
      87             :     (bmp . maybe)
      88             :     (gif . maybe)
      89             :     (png . maybe)
      90             :     (xpm . nil)
      91             :     (jpeg . maybe)
      92             :     (tiff . maybe)
      93             :     (svg . maybe)
      94             :     (postscript . nil))
      95             :   "Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files.
      96             : \(See `image-type-auto-detected-p').
      97             : 
      98             : AUTODETECT can be
      99             :  - t      always auto-detect.
     100             :  - nil    never auto-detect.
     101             :  - maybe  auto-detect only if the image type is available
     102             :             (see `image-type-available-p').")
     103             : 
     104             : (defvar image-format-suffixes
     105             :   '((image/x-rgb "rgb") (image/x-icon "ico"))
     106             :   "An alist associating image types with file name suffixes.
     107             : This is used as a hint by the ImageMagick library when detecting
     108             : the type of image data (that does not have an associated file name).
     109             : Each element has the form (MIME-CONTENT-TYPE EXTENSION).
     110             : If `create-image' is called with a :format attribute whose value
     111             : equals a content-type found in this list, the ImageMagick library is
     112             : told that the data would have the associated suffix if saved to a file.")
     113             : 
     114             : (defcustom image-load-path
     115             :   (list (file-name-as-directory (expand-file-name "images" data-directory))
     116             :         'data-directory 'load-path)
     117             :   "List of locations in which to search for image files.
     118             : If an element is a string, it defines a directory to search.
     119             : If an element is a variable symbol whose value is a string, that
     120             : value defines a directory to search.
     121             : If an element is a variable symbol whose value is a list, the
     122             : value is used as a list of directories to search.
     123             : 
     124             : Subdirectories are not automatically included in the search."
     125             :   :type '(repeat (choice directory variable))
     126             :   :initialize #'custom-initialize-delay)
     127             : 
     128             : (defcustom image-scaling-factor 'auto
     129             :   "When displaying images, apply this scaling factor before displaying.
     130             : This is not supported for all image types, and is mostly useful
     131             : when you have a high-resolution monitor.
     132             : The value is either a floating point number (where numbers higher
     133             : than 1 means to increase the size and lower means to shrink the
     134             : size), or the symbol `auto', which will compute a scaling factor
     135             : based on the font pixel size."
     136             :   :type '(choice number
     137             :                  (const :tag "Automatically compute" auto))
     138             :   :version "26.1")
     139             : 
     140             : ;; Map put into text properties on images.
     141             : (defvar image-map
     142             :   (let ((map (make-sparse-keymap)))
     143             :     (define-key map "-" 'image-decrease-size)
     144             :     (define-key map "+" 'image-increase-size)
     145             :     (define-key map "r" 'image-rotate)
     146             :     (define-key map "o" 'image-save)
     147             :     map))
     148             : 
     149             : (defun image-load-path-for-library (library image &optional path no-error)
     150             :   "Return a suitable search path for images used by LIBRARY.
     151             : 
     152             : It searches for IMAGE in `image-load-path' (excluding
     153             : \"`data-directory'/images\") and `load-path', followed by a path
     154             : suitable for LIBRARY, which includes \"../../etc/images\" and
     155             : \"../etc/images\" relative to the library file itself, and then
     156             : in \"`data-directory'/images\".
     157             : 
     158             : Then this function returns a list of directories which contains
     159             : first the directory in which IMAGE was found, followed by the
     160             : value of `load-path'.  If PATH is given, it is used instead of
     161             : `load-path'.
     162             : 
     163             : If NO-ERROR is non-nil and a suitable path can't be found, don't
     164             : signal an error.  Instead, return a list of directories as before,
     165             : except that nil appears in place of the image directory.
     166             : 
     167             : Here is an example that uses a common idiom to provide
     168             : compatibility with versions of Emacs that lack the variable
     169             : `image-load-path':
     170             : 
     171             :     ;; Shush compiler.
     172             :     (defvar image-load-path)
     173             : 
     174             :     (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
     175             :            (image-load-path (cons (car load-path)
     176             :                                   (when (boundp \\='image-load-path)
     177             :                                     image-load-path))))
     178             :       (mh-tool-bar-folder-buttons-init))"
     179           0 :   (unless library (error "No library specified"))
     180           0 :   (unless image   (error "No image specified"))
     181           0 :   (let (image-directory image-directory-load-path)
     182             :     ;; Check for images in image-load-path or load-path.
     183           0 :     (let ((img image)
     184           0 :           (dir (or
     185             :                 ;; Images in image-load-path.
     186           0 :                 (image-search-load-path image)
     187             :                 ;; Images in load-path.
     188           0 :                 (locate-library image)))
     189             :           parent)
     190             :       ;; Since the image might be in a nested directory (for
     191             :       ;; example, mail/attach.pbm), adjust `image-directory'
     192             :       ;; accordingly.
     193           0 :       (when dir
     194           0 :         (setq dir (file-name-directory dir))
     195           0 :         (while (setq parent (file-name-directory img))
     196           0 :           (setq img (directory-file-name parent)
     197           0 :                 dir (expand-file-name "../" dir))))
     198           0 :       (setq image-directory-load-path dir))
     199             : 
     200             :     ;; If `image-directory-load-path' isn't Emacs's image directory,
     201             :     ;; it's probably a user preference, so use it. Then use a
     202             :     ;; relative setting if possible; otherwise, use
     203             :     ;; `image-directory-load-path'.
     204           0 :     (cond
     205             :      ;; User-modified image-load-path?
     206           0 :      ((and image-directory-load-path
     207           0 :            (not (equal image-directory-load-path
     208           0 :                        (file-name-as-directory
     209           0 :                         (expand-file-name "images" data-directory)))))
     210           0 :       (setq image-directory image-directory-load-path))
     211             :      ;; Try relative setting.
     212           0 :      ((let (library-name d1ei d2ei)
     213             :         ;; First, find library in the load-path.
     214           0 :         (setq library-name (locate-library library))
     215           0 :         (if (not library-name)
     216           0 :             (error "Cannot find library %s in load-path" library))
     217             :         ;; And then set image-directory relative to that.
     218           0 :         (setq
     219             :          ;; Go down 2 levels.
     220           0 :          d2ei (file-name-as-directory
     221           0 :                (expand-file-name
     222           0 :                 (concat (file-name-directory library-name) "../../etc/images")))
     223             :          ;; Go down 1 level.
     224           0 :          d1ei (file-name-as-directory
     225           0 :                (expand-file-name
     226           0 :                 (concat (file-name-directory library-name) "../etc/images"))))
     227           0 :         (setq image-directory
     228             :               ;; Set it to nil if image is not found.
     229           0 :               (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
     230           0 :                     ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
     231             :      ;; Use Emacs's image directory.
     232           0 :      (image-directory-load-path
     233           0 :       (setq image-directory image-directory-load-path))
     234           0 :      (no-error
     235           0 :       (message "Could not find image %s for library %s" image library))
     236             :      (t
     237           0 :       (error "Could not find image %s for library %s" image library)))
     238             : 
     239             :     ;; Return an augmented `path' or `load-path'.
     240           0 :     (nconc (list image-directory)
     241           0 :            (delete image-directory (copy-sequence (or path load-path))))))
     242             : 
     243             : 
     244             : ;; Used to be in image-type-header-regexps, but now not used anywhere
     245             : ;; (since 2009-08-28).
     246             : (defun image-jpeg-p (data)
     247             :   "Value is non-nil if DATA, a string, consists of JFIF image data.
     248             : We accept the tag Exif because that is the same format."
     249           0 :   (setq data (ignore-errors (string-to-unibyte data)))
     250           0 :   (when (and data (string-match-p "\\`\xff\xd8" data))
     251           0 :     (catch 'jfif
     252           0 :       (let ((len (length data)) (i 2))
     253           0 :         (while (< i len)
     254           0 :           (when (/= (aref data i) #xff)
     255           0 :             (throw 'jfif nil))
     256           0 :           (setq i (1+ i))
     257           0 :           (when (>= (+ i 2) len)
     258           0 :             (throw 'jfif nil))
     259           0 :           (let ((nbytes (+ (lsh (aref data (+ i 1)) 8)
     260           0 :                            (aref data (+ i 2))))
     261           0 :                 (code (aref data i)))
     262           0 :             (when (and (>= code #xe0) (<= code #xef))
     263             :               ;; APP0 LEN1 LEN2 "JFIF\0"
     264           0 :               (throw 'jfif
     265           0 :                      (string-match-p "JFIF\\|Exif"
     266           0 :                                      (substring data i (min (+ i nbytes) len)))))
     267           0 :             (setq i (+ i 1 nbytes))))))))
     268             : 
     269             : 
     270             : ;;;###autoload
     271             : (defun image-type-from-data (data)
     272             :   "Determine the image type from image data DATA.
     273             : Value is a symbol specifying the image type or nil if type cannot
     274             : be determined."
     275           0 :   (let ((types image-type-header-regexps)
     276             :         type)
     277           0 :     (while types
     278           0 :       (let ((regexp (car (car types)))
     279           0 :             (image-type (cdr (car types))))
     280           0 :         (if (or (and (symbolp image-type)
     281           0 :                      (string-match-p regexp data))
     282           0 :                 (and (consp image-type)
     283           0 :                      (funcall (car image-type) data)
     284           0 :                      (setq image-type (cdr image-type))))
     285           0 :             (setq type image-type
     286           0 :                   types nil)
     287           0 :           (setq types (cdr types)))))
     288           0 :     type))
     289             : 
     290             : 
     291             : ;;;###autoload
     292             : (defun image-type-from-buffer ()
     293             :   "Determine the image type from data in the current buffer.
     294             : Value is a symbol specifying the image type or nil if type cannot
     295             : be determined."
     296           0 :   (let ((types image-type-header-regexps)
     297             :         type
     298           0 :         (opoint (point)))
     299           0 :     (goto-char (point-min))
     300           0 :     (while types
     301           0 :       (let ((regexp (car (car types)))
     302           0 :             (image-type (cdr (car types)))
     303             :             data)
     304           0 :         (if (or (and (symbolp image-type)
     305           0 :                      (looking-at-p regexp))
     306           0 :                 (and (consp image-type)
     307           0 :                      (funcall (car image-type)
     308           0 :                               (or data
     309           0 :                                   (setq data
     310           0 :                                         (buffer-substring
     311           0 :                                          (point-min)
     312           0 :                                          (min (point-max)
     313           0 :                                               (+ (point-min) 256))))))
     314           0 :                      (setq image-type (cdr image-type))))
     315           0 :             (setq type image-type
     316           0 :                   types nil)
     317           0 :           (setq types (cdr types)))))
     318           0 :     (goto-char opoint)
     319           0 :     (and type
     320           0 :          (boundp 'image-types)
     321           0 :          (memq type image-types)
     322           0 :          type)))
     323             : 
     324             : 
     325             : ;;;###autoload
     326             : (defun image-type-from-file-header (file)
     327             :   "Determine the type of image file FILE from its first few bytes.
     328             : Value is a symbol specifying the image type, or nil if type cannot
     329             : be determined."
     330           0 :   (unless (or (file-readable-p file)
     331           0 :               (file-name-absolute-p file))
     332           0 :     (setq file (image-search-load-path file)))
     333           0 :   (and file
     334           0 :        (file-readable-p file)
     335           0 :        (with-temp-buffer
     336           0 :          (set-buffer-multibyte nil)
     337           0 :          (insert-file-contents-literally file nil 0 256)
     338           0 :          (image-type-from-buffer))))
     339             : 
     340             : 
     341             : ;;;###autoload
     342             : (defun image-type-from-file-name (file)
     343             :   "Determine the type of image file FILE from its name.
     344             : Value is a symbol specifying the image type, or nil if type cannot
     345             : be determined."
     346           0 :   (let (type first (case-fold-search t))
     347           0 :     (catch 'found
     348           0 :       (dolist (elem image-type-file-name-regexps first)
     349           0 :         (when (string-match-p (car elem) file)
     350           0 :           (if (image-type-available-p (setq type (cdr elem)))
     351           0 :               (throw 'found type)
     352             :             ;; If nothing seems to be supported, return first type that matched.
     353           0 :             (or first (setq first type))))))))
     354             : 
     355             : ;;;###autoload
     356             : (defun image-type (source &optional type data-p)
     357             :   "Determine and return image type.
     358             : SOURCE is an image file name or image data.
     359             : Optional TYPE is a symbol describing the image type.  If TYPE is omitted
     360             : or nil, try to determine the image type from its first few bytes
     361             : of image data.  If that doesn't work, and SOURCE is a file name,
     362             : use its file extension as image type.
     363             : Optional DATA-P non-nil means SOURCE is a string containing image data."
     364           0 :   (when (and (not data-p) (not (stringp source)))
     365           0 :     (error "Invalid image file name `%s'" source))
     366           0 :   (unless type
     367           0 :     (setq type (if data-p
     368           0 :                    (image-type-from-data source)
     369           0 :                  (or (image-type-from-file-header source)
     370           0 :                      (image-type-from-file-name source))))
     371           0 :     (or type (error "Cannot determine image type")))
     372           0 :   (or (memq type (and (boundp 'image-types) image-types))
     373           0 :       (error "Invalid image type `%s'" type))
     374           0 :   type)
     375             : 
     376             : 
     377             : (if (fboundp 'image-metadata)           ; eg not --without-x
     378             :     (define-obsolete-function-alias 'image-extension-data
     379             :       'image-metadata "24.1"))
     380             : 
     381             : (define-obsolete-variable-alias
     382             :     'image-library-alist
     383             :     'dynamic-library-alist "24.1")
     384             : 
     385             : ;;;###autoload
     386             : (defun image-type-available-p (type)
     387             :   "Return non-nil if image type TYPE is available.
     388             : Image types are symbols like `xbm' or `jpeg'."
     389           0 :   (and (fboundp 'init-image-library)
     390           0 :        (init-image-library type)))
     391             : 
     392             : 
     393             : ;;;###autoload
     394             : (defun image-type-auto-detected-p ()
     395             :   "Return t if the current buffer contains an auto-detectable image.
     396             : This function is intended to be used from `magic-fallback-mode-alist'.
     397             : 
     398             : The buffer is considered to contain an auto-detectable image if
     399             : its beginning matches an image type in `image-type-header-regexps',
     400             : and that image type is present in `image-type-auto-detectable' with a
     401             : non-nil value.  If that value is non-nil, but not t, then the image type
     402             : must be available."
     403           0 :   (let* ((type (image-type-from-buffer))
     404           0 :          (auto (and type (cdr (assq type image-type-auto-detectable)))))
     405           0 :     (and auto
     406           0 :          (or (eq auto t) (image-type-available-p type)))))
     407             : 
     408             : 
     409             : ;;;###autoload
     410             : (defun create-image (file-or-data &optional type data-p &rest props)
     411             :   "Create an image.
     412             : FILE-OR-DATA is an image file name or image data.
     413             : Optional TYPE is a symbol describing the image type.  If TYPE is omitted
     414             : or nil, try to determine the image type from its first few bytes
     415             : of image data.  If that doesn't work, and FILE-OR-DATA is a file name,
     416             : use its file extension as image type.
     417             : Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
     418             : Optional PROPS are additional image attributes to assign to the image,
     419             : like, e.g. `:mask MASK'.
     420             : Value is the image created, or nil if images of type TYPE are not supported.
     421             : 
     422             : Images should not be larger than specified by `max-image-size'.
     423             : 
     424             : Image file names that are not absolute are searched for in the
     425             : \"images\" sub-directory of `data-directory' and
     426             : `x-bitmap-file-path' (in that order)."
     427             :   ;; It is x_find_image_file in image.c that sets the search path.
     428           0 :   (setq type (image-type file-or-data type data-p))
     429           0 :   (when (image-type-available-p type)
     430           0 :     (append (list 'image :type type (if data-p :data :file) file-or-data)
     431           0 :             (and (not (plist-get props :scale))
     432           0 :                  (list :scale
     433           0 :                        (image-compute-scaling-factor image-scaling-factor)))
     434           0 :             props)))
     435             : 
     436             : (defun image--set-property (image property value)
     437             :   "Set PROPERTY in IMAGE to VALUE.
     438             : Internal use only."
     439           0 :   (if (null value)
     440           0 :       (while (cdr image)
     441             :         ;; IMAGE starts with the symbol `image', and the rest is a
     442             :         ;; plist.  Decouple plist entries where the key matches
     443             :         ;; the property.
     444           0 :         (if (eq (cadr image) property)
     445           0 :             (setcdr image (cddr image))
     446           0 :           (setq image (cddr image))))
     447             :     ;; Just enter the new value.
     448           0 :     (plist-put (cdr image) property value))
     449           0 :   value)
     450             : 
     451             : (defun image-property (image property)
     452             :   "Return the value of PROPERTY in IMAGE.
     453             : Properties can be set with
     454             : 
     455             :   (setf (image-property IMAGE PROPERTY) VALUE)
     456             : If VALUE is nil, PROPERTY is removed from IMAGE."
     457             :   (declare (gv-setter image--set-property))
     458           0 :   (plist-get (cdr image) property))
     459             : 
     460             : (defun image-compute-scaling-factor (scaling)
     461           0 :   (cond
     462           0 :    ((numberp scaling) scaling)
     463           0 :    ((eq scaling 'auto)
     464           0 :     (let ((width (/ (float (window-width nil t)) (window-width))))
     465             :       ;; If we assume that a typical character is 10 pixels in width,
     466             :       ;; then we should scale all images according to how wide they
     467             :       ;; are.  But don't scale images down.
     468           0 :       (if (< width 10)
     469             :           1
     470           0 :         (/ (float width) 10))))
     471             :    (t
     472           0 :     (error "Invalid scaling factor %s" scaling))))
     473             : 
     474             : ;;;###autoload
     475             : (defun put-image (image pos &optional string area)
     476             :   "Put image IMAGE in front of POS in the current buffer.
     477             : IMAGE must be an image created with `create-image' or `defimage'.
     478             : IMAGE is displayed by putting an overlay into the current buffer with a
     479             : `before-string' STRING that has a `display' property whose value is the
     480             : image.  STRING is defaulted if you omit it.
     481             : The overlay created will have the `put-image' property set to t.
     482             : POS may be an integer or marker.
     483             : AREA is where to display the image.  AREA nil or omitted means
     484             : display it in the text area, a value of `left-margin' means
     485             : display it in the left marginal area, a value of `right-margin'
     486             : means display it in the right marginal area."
     487           0 :   (unless string (setq string "x"))
     488           0 :   (let ((buffer (current-buffer)))
     489           0 :     (unless (eq (car-safe image) 'image)
     490           0 :       (error "Not an image: %s" image))
     491           0 :     (unless (or (null area) (memq area '(left-margin right-margin)))
     492           0 :       (error "Invalid area %s" area))
     493           0 :     (setq string (copy-sequence string))
     494           0 :     (let ((overlay (make-overlay pos pos buffer))
     495           0 :           (prop (if (null area) image (list (list 'margin area) image))))
     496           0 :       (put-text-property 0 (length string) 'display prop string)
     497           0 :       (overlay-put overlay 'put-image t)
     498           0 :       (overlay-put overlay 'before-string string)
     499           0 :       (overlay-put overlay 'map image-map)
     500           0 :       overlay)))
     501             : 
     502             : 
     503             : ;;;###autoload
     504             : (defun insert-image (image &optional string area slice)
     505             :   "Insert IMAGE into current buffer at point.
     506             : IMAGE is displayed by inserting STRING into the current buffer
     507             : with a `display' property whose value is the image.  STRING
     508             : defaults to a single space if you omit it.
     509             : AREA is where to display the image.  AREA nil or omitted means
     510             : display it in the text area, a value of `left-margin' means
     511             : display it in the left marginal area, a value of `right-margin'
     512             : means display it in the right marginal area.
     513             : SLICE specifies slice of IMAGE to insert.  SLICE nil or omitted
     514             : means insert whole image.  SLICE is a list (X Y WIDTH HEIGHT)
     515             : specifying the X and Y positions and WIDTH and HEIGHT of image area
     516             : to insert.  A float value 0.0 - 1.0 means relative to the width or
     517             : height of the image; integer values are taken as pixel values."
     518             :   ;; Use a space as least likely to cause trouble when it's a hidden
     519             :   ;; character in the buffer.
     520           0 :   (unless string (setq string " "))
     521           0 :   (unless (eq (car-safe image) 'image)
     522           0 :     (error "Not an image: %s" image))
     523           0 :   (unless (or (null area) (memq area '(left-margin right-margin)))
     524           0 :     (error "Invalid area %s" area))
     525           0 :   (if area
     526           0 :       (setq image (list (list 'margin area) image))
     527             :     ;; Cons up a new spec equal but not eq to `image' so that
     528             :     ;; inserting it twice in a row (adjacently) displays two copies of
     529             :     ;; the image.  Don't try to avoid this by looking at the display
     530             :     ;; properties on either side so that we DTRT more often with
     531             :     ;; cut-and-paste.  (Yanking killed image text next to another copy
     532             :     ;; of it loses anyway.)
     533           0 :     (setq image (cons 'image (cdr image))))
     534           0 :   (let ((start (point)))
     535           0 :     (insert string)
     536           0 :     (add-text-properties start (point)
     537           0 :                          `(display ,(if slice
     538           0 :                                         (list (cons 'slice slice) image)
     539           0 :                                       image)
     540             :                                    rear-nonsticky (display)
     541           0 :                                    keymap ,image-map))))
     542             : 
     543             : 
     544             : ;;;###autoload
     545             : (defun insert-sliced-image (image &optional string area rows cols)
     546             :   "Insert IMAGE into current buffer at point.
     547             : IMAGE is displayed by inserting STRING into the current buffer
     548             : with a `display' property whose value is the image.  The default
     549             : STRING is a single space.
     550             : AREA is where to display the image.  AREA nil or omitted means
     551             : display it in the text area, a value of `left-margin' means
     552             : display it in the left marginal area, a value of `right-margin'
     553             : means display it in the right marginal area.
     554             : The image is automatically split into ROWS x COLS slices."
     555           0 :   (unless string (setq string " "))
     556           0 :   (unless (eq (car-safe image) 'image)
     557           0 :     (error "Not an image: %s" image))
     558           0 :   (unless (or (null area) (memq area '(left-margin right-margin)))
     559           0 :     (error "Invalid area %s" area))
     560           0 :   (if area
     561           0 :       (setq image (list (list 'margin area) image))
     562             :     ;; Cons up a new spec equal but not eq to `image' so that
     563             :     ;; inserting it twice in a row (adjacently) displays two copies of
     564             :     ;; the image.  Don't try to avoid this by looking at the display
     565             :     ;; properties on either side so that we DTRT more often with
     566             :     ;; cut-and-paste.  (Yanking killed image text next to another copy
     567             :     ;; of it loses anyway.)
     568           0 :     (setq image (cons 'image (cdr image))))
     569           0 :   (let ((x 0.0) (dx (/ 1.0001 (or cols 1)))
     570           0 :          (y 0.0) (dy (/ 1.0001 (or rows 1))))
     571           0 :     (while (< y 1.0)
     572           0 :       (while (< x 1.0)
     573           0 :         (let ((start (point)))
     574           0 :           (insert string)
     575           0 :           (add-text-properties start (point)
     576           0 :                                `(display ,(list (list 'slice x y dx dy) image)
     577             :                                          rear-nonsticky (display)
     578           0 :                                          keymap ,image-map))
     579           0 :           (setq x (+ x dx))))
     580           0 :       (setq x 0.0
     581           0 :             y (+ y dy))
     582           0 :       (insert (propertize "\n" 'line-height t)))))
     583             : 
     584             : 
     585             : 
     586             : ;;;###autoload
     587             : (defun remove-images (start end &optional buffer)
     588             :   "Remove images between START and END in BUFFER.
     589             : Remove only images that were put in BUFFER with calls to `put-image'.
     590             : BUFFER nil or omitted means use the current buffer."
     591           0 :   (unless buffer
     592           0 :     (setq buffer (current-buffer)))
     593           0 :   (let ((overlays (overlays-in start end)))
     594           0 :     (while overlays
     595           0 :       (let ((overlay (car overlays)))
     596           0 :         (when (overlay-get overlay 'put-image)
     597           0 :           (delete-overlay overlay)))
     598           0 :       (setq overlays (cdr overlays)))))
     599             : 
     600             : (defun image-search-load-path (file &optional path)
     601           0 :   (unless path
     602           0 :     (setq path image-load-path))
     603           0 :   (let (element found filename)
     604           0 :     (while (and (not found) (consp path))
     605           0 :       (setq element (car path))
     606           0 :       (cond
     607           0 :        ((stringp element)
     608           0 :         (setq found
     609           0 :               (file-readable-p
     610           0 :                (setq filename (expand-file-name file element)))))
     611           0 :        ((and (symbolp element) (boundp element))
     612           0 :         (setq element (symbol-value element))
     613           0 :         (cond
     614           0 :          ((stringp element)
     615           0 :           (setq found
     616           0 :                 (file-readable-p
     617           0 :                  (setq filename (expand-file-name file element)))))
     618           0 :          ((consp element)
     619           0 :           (if (setq filename (image-search-load-path file element))
     620           0 :               (setq found t))))))
     621           0 :       (setq path (cdr path)))
     622           0 :     (if found filename)))
     623             : 
     624             : ;;;###autoload
     625             : (defun find-image (specs)
     626             :   "Find an image, choosing one of a list of image specifications.
     627             : 
     628             : SPECS is a list of image specifications.
     629             : 
     630             : Each image specification in SPECS is a property list.  The contents of
     631             : a specification are image type dependent.  All specifications must at
     632             : least contain the properties `:type TYPE' and either `:file FILE' or
     633             : `:data DATA', where TYPE is a symbol specifying the image type,
     634             : e.g. `xbm', FILE is the file to load the image from, and DATA is a
     635             : string containing the actual image data.  The specification whose TYPE
     636             : is supported, and FILE exists, is used to construct the image
     637             : specification to be returned.  Return nil if no specification is
     638             : satisfied.
     639             : 
     640             : The image is looked for in `image-load-path'.
     641             : 
     642             : Image files should not be larger than specified by `max-image-size'."
     643           0 :   (let (image)
     644           0 :     (while (and specs (null image))
     645           0 :       (let* ((spec (car specs))
     646           0 :              (type (plist-get spec :type))
     647           0 :              (data (plist-get spec :data))
     648           0 :              (file (plist-get spec :file))
     649             :              found)
     650           0 :         (when (image-type-available-p type)
     651           0 :           (cond ((stringp file)
     652           0 :                  (if (setq found (image-search-load-path file))
     653           0 :                      (setq image
     654           0 :                            (cons 'image (plist-put (copy-sequence spec)
     655           0 :                                                    :file found)))))
     656           0 :                 ((not (null data))
     657           0 :                  (setq image (cons 'image spec)))))
     658           0 :         (setq specs (cdr specs))))
     659           0 :     image))
     660             : 
     661             : 
     662             : ;;;###autoload
     663             : (defmacro defimage (symbol specs &optional doc)
     664             :   "Define SYMBOL as an image, and return SYMBOL.
     665             : 
     666             : SPECS is a list of image specifications.  DOC is an optional
     667             : documentation string.
     668             : 
     669             : Each image specification in SPECS is a property list.  The contents of
     670             : a specification are image type dependent.  All specifications must at
     671             : least contain the properties `:type TYPE' and either `:file FILE' or
     672             : `:data DATA', where TYPE is a symbol specifying the image type,
     673             : e.g. `xbm', FILE is the file to load the image from, and DATA is a
     674             : string containing the actual image data.  The first image
     675             : specification whose TYPE is supported, and FILE exists, is used to
     676             : define SYMBOL.
     677             : 
     678             : Example:
     679             : 
     680             :    (defimage test-image ((:type xpm :file \"~/test1.xpm\")
     681             :                          (:type xbm :file \"~/test1.xbm\")))"
     682             :   (declare (doc-string 3))
     683           0 :   `(defvar ,symbol (find-image ',specs) ,doc))
     684             : 
     685             : 
     686             : ;;; Animated image API
     687             : 
     688             : (defvar image-default-frame-delay 0.1
     689             :   "Default interval in seconds between frames of a multi-frame image.
     690             : Only used if the image does not specify a value.")
     691             : 
     692             : (defun image-multi-frame-p (image)
     693             :   "Return non-nil if IMAGE contains more than one frame.
     694             : The actual return value is a cons (NIMAGES . DELAY), where NIMAGES is
     695             : the number of frames (or sub-images) in the image and DELAY is the delay
     696             : in seconds that the image specifies between each frame.  DELAY may be nil,
     697             : in which case you might want to use `image-default-frame-delay'."
     698           0 :   (when (fboundp 'image-metadata)
     699           0 :     (let* ((metadata (image-metadata image))
     700           0 :            (images (plist-get metadata 'count))
     701           0 :            (delay (plist-get metadata 'delay)))
     702           0 :       (when (and images (> images 1))
     703           0 :         (and delay (or (not (numberp delay)) (< delay 0))
     704           0 :              (setq delay image-default-frame-delay))
     705           0 :         (cons images delay)))))
     706             : 
     707             : (defun image-animated-p (image)
     708             :   "Like `image-multi-frame-p', but returns nil if no delay is specified."
     709           0 :   (let ((multi (image-multi-frame-p image)))
     710           0 :     (and (cdr multi) multi)))
     711             : 
     712             : (make-obsolete 'image-animated-p 'image-multi-frame-p "24.4")
     713             : 
     714             : ;; "Destructively"?
     715             : (defun image-animate (image &optional index limit)
     716             :   "Start animating IMAGE.
     717             : Animation occurs by destructively altering the IMAGE spec list.
     718             : 
     719             : With optional INDEX, begin animating from that animation frame.
     720             : LIMIT specifies how long to animate the image.  If omitted or
     721             : nil, play the animation until the end.  If t, loop forever.  If a
     722             : number, play until that number of seconds has elapsed."
     723           0 :   (let ((animation (image-multi-frame-p image))
     724             :         timer)
     725           0 :     (when animation
     726           0 :       (if (setq timer (image-animate-timer image))
     727           0 :           (cancel-timer timer))
     728           0 :       (plist-put (cdr image) :animate-buffer (current-buffer))
     729           0 :       (run-with-timer 0.2 nil #'image-animate-timeout
     730           0 :                       image (or index 0) (car animation)
     731           0 :                       0 limit (+ (float-time) 0.2)))))
     732             : 
     733             : (defun image-animate-timer (image)
     734             :   "Return the animation timer for image IMAGE."
     735             :   ;; See cancel-function-timers
     736           0 :   (let ((tail timer-list) timer)
     737           0 :     (while tail
     738           0 :       (setq timer (car tail)
     739           0 :             tail (cdr tail))
     740           0 :       (if (and (eq (timer--function timer) #'image-animate-timeout)
     741           0 :                (eq (car-safe (timer--args timer)) image))
     742           0 :           (setq tail nil)
     743           0 :         (setq timer nil)))
     744           0 :     timer))
     745             : 
     746             : (defconst image-minimum-frame-delay 0.01
     747             :   "Minimum interval in seconds between frames of an animated image.")
     748             : 
     749             : (defun image-current-frame (image)
     750             :   "The current frame number of IMAGE, indexed from 0."
     751           0 :   (or (plist-get (cdr image) :index) 0))
     752             : 
     753             : (defun image-show-frame (image n &optional nocheck)
     754             :   "Show frame N of IMAGE.
     755             : Frames are indexed from 0.  Optional argument NOCHECK non-nil means
     756             : do not check N is within the range of frames present in the image."
     757           0 :   (unless nocheck
     758           0 :     (if (< n 0) (setq n 0)
     759           0 :       (setq n (min n (1- (car (image-multi-frame-p image)))))))
     760           0 :   (plist-put (cdr image) :index n)
     761           0 :   (force-window-update))
     762             : 
     763             : (defun image-animate-get-speed (image)
     764             :   "Return the speed factor for animating IMAGE."
     765           0 :   (or (plist-get (cdr image) :speed) 1))
     766             : 
     767             : (defun image-animate-set-speed (image value &optional multiply)
     768             :   "Set the speed factor for animating IMAGE to VALUE.
     769             : With optional argument MULTIPLY non-nil, treat VALUE as a
     770             : multiplication factor for the current value."
     771           0 :   (plist-put (cdr image) :speed
     772           0 :              (if multiply
     773           0 :                  (* value (image-animate-get-speed image))
     774           0 :                value)))
     775             : 
     776             : ;; FIXME? The delay may not be the same for different sub-images,
     777             : ;; hence we need to call image-multi-frame-p to return it.
     778             : ;; But it also returns count, so why do we bother passing that as an
     779             : ;; argument?
     780             : (defun image-animate-timeout (image n count time-elapsed limit target-time)
     781             :   "Display animation frame N of IMAGE.
     782             : N=0 refers to the initial animation frame.
     783             : COUNT is the total number of frames in the animation.
     784             : TIME-ELAPSED is the total time that has elapsed since
     785             : `image-animate-start' was called.
     786             : LIMIT determines when to stop.  If t, loop forever.  If nil, stop
     787             :  after displaying the last animation frame.  Otherwise, stop
     788             :  after LIMIT seconds have elapsed.
     789             : The minimum delay between successive frames is `image-minimum-frame-delay'.
     790             : 
     791             : If the image has a non-nil :speed property, it acts as a multiplier
     792             : for the animation speed.  A negative value means to animate in reverse."
     793           0 :   (when (and (buffer-live-p (plist-get (cdr image) :animate-buffer))
     794             :              ;; Delayed more than two seconds more than expected.
     795           0 :              (or (<= (- (float-time) target-time) 2)
     796           0 :                  (progn
     797           0 :                    (message "Stopping animation; animation possibly too big")
     798           0 :                    nil)))
     799           0 :     (image-show-frame image n t)
     800           0 :     (let* ((speed (image-animate-get-speed image))
     801           0 :            (time (float-time))
     802           0 :            (animation (image-multi-frame-p image))
     803             :            ;; Subtract off the time we took to load the image from the
     804             :            ;; stated delay time.
     805           0 :            (delay (max (+ (* (or (cdr animation) image-default-frame-delay)
     806           0 :                              (/ 1.0 (abs speed)))
     807           0 :                           time (- (float-time)))
     808           0 :                        image-minimum-frame-delay))
     809             :            done)
     810           0 :       (setq n (if (< speed 0)
     811           0 :                   (1- n)
     812           0 :                 (1+ n)))
     813           0 :       (if limit
     814           0 :           (cond ((>= n count) (setq n 0))
     815           0 :                 ((< n 0) (setq n (1- count))))
     816           0 :         (and (or (>= n count) (< n 0)) (setq done t)))
     817           0 :       (setq time-elapsed (+ delay time-elapsed))
     818           0 :       (if (numberp limit)
     819           0 :           (setq done (>= time-elapsed limit)))
     820           0 :       (unless done
     821           0 :         (run-with-timer delay nil #'image-animate-timeout
     822           0 :                         image n count time-elapsed limit
     823           0 :                         (+ (float-time) delay))))))
     824             : 
     825             : 
     826             : (defvar imagemagick-types-inhibit)
     827             : (defvar imagemagick-enabled-types)
     828             : 
     829             : (defun imagemagick-filter-types ()
     830             :   "Return a list of the ImageMagick types to be treated as images, or nil.
     831             : This is the result of `imagemagick-types', including only elements
     832             : that match `imagemagick-enabled-types' and do not match
     833             : `imagemagick-types-inhibit'."
     834           0 :   (when (fboundp 'imagemagick-types)
     835           0 :     (cond ((null imagemagick-enabled-types) nil)
     836           0 :           ((eq imagemagick-types-inhibit t) nil)
     837             :           (t
     838           0 :            (delq nil
     839           0 :                  (mapcar
     840             :                   (lambda (type)
     841           0 :                     (unless (memq type imagemagick-types-inhibit)
     842           0 :                       (if (eq imagemagick-enabled-types t) type
     843           0 :                         (catch 'found
     844           0 :                           (dolist (enable imagemagick-enabled-types nil)
     845           0 :                             (if (cond ((symbolp enable) (eq enable type))
     846           0 :                                       ((stringp enable)
     847           0 :                                        (string-match enable
     848           0 :                                                      (symbol-name type))))
     849           0 :                                 (throw 'found type)))))))
     850           0 :                   (imagemagick-types)))))))
     851             : 
     852             : (defvar imagemagick--file-regexp nil
     853             :   "File extension regexp for ImageMagick files, if any.
     854             : This is the extension installed into `auto-mode-alist' and
     855             : `image-type-file-name-regexps' by `imagemagick-register-types'.")
     856             : 
     857             : ;;;###autoload
     858             : (defun imagemagick-register-types ()
     859             :   "Register file types that can be handled by ImageMagick.
     860             : This function is called at startup, after loading the init file.
     861             : It registers the ImageMagick types returned by `imagemagick-filter-types'.
     862             : 
     863             : Registered image types are added to `auto-mode-alist', so that
     864             : Emacs visits them in Image mode.  They are also added to
     865             : `image-type-file-name-regexps', so that the `image-type' function
     866             : recognizes these files as having image type `imagemagick'.
     867             : 
     868             : If Emacs is compiled without ImageMagick support, this does nothing."
     869           1 :   (when (fboundp 'imagemagick-types)
     870           0 :     (let* ((types (mapcar (lambda (type) (downcase (symbol-name type)))
     871           0 :                           (imagemagick-filter-types)))
     872           0 :            (re (if types (concat "\\." (regexp-opt types) "\\'")))
     873           0 :            (ama-elt (car (member (cons imagemagick--file-regexp 'image-mode)
     874           0 :                                  auto-mode-alist)))
     875           0 :            (itfnr-elt (car (member (cons imagemagick--file-regexp 'imagemagick)
     876           0 :                                    image-type-file-name-regexps))))
     877           0 :       (if (not re)
     878           0 :           (setq auto-mode-alist (delete ama-elt auto-mode-alist)
     879             :                 image-type-file-name-regexps
     880           0 :                 (delete itfnr-elt image-type-file-name-regexps))
     881           0 :         (if ama-elt
     882           0 :             (setcar ama-elt re)
     883           0 :           (push (cons re 'image-mode) auto-mode-alist))
     884           0 :         (if itfnr-elt
     885           0 :             (setcar itfnr-elt re)
     886             :           ;; Append to `image-type-file-name-regexps', so that we
     887             :           ;; preferentially use specialized image libraries.
     888           0 :           (add-to-list 'image-type-file-name-regexps
     889           0 :                        (cons re 'imagemagick) t)))
     890           1 :       (setq imagemagick--file-regexp re))))
     891             : 
     892             : (defcustom imagemagick-types-inhibit
     893             :   '(C HTML HTM INFO M TXT PDF)
     894             :   "List of ImageMagick types that should never be treated as images.
     895             : This should be a list of symbols, each of which should be one of
     896             : the ImageMagick types listed by `imagemagick-types'.  The listed
     897             : image types are not registered by `imagemagick-register-types'.
     898             : 
     899             : If the value is t, inhibit the use of ImageMagick for images.
     900             : 
     901             : If you change this without using customize, you must call
     902             : `imagemagick-register-types' afterwards.
     903             : 
     904             : If Emacs is compiled without ImageMagick support, this variable
     905             : has no effect."
     906             :   :type '(choice (const :tag "Support all ImageMagick types" nil)
     907             :                  (const :tag "Disable all ImageMagick types" t)
     908             :                  (repeat symbol))
     909             :   :initialize #'custom-initialize-default
     910             :   :set (lambda (symbol value)
     911             :          (set-default symbol value)
     912             :          (imagemagick-register-types))
     913             :   :version "24.3")
     914             : 
     915             : (defcustom imagemagick-enabled-types
     916             :   '(3FR ART ARW AVS BMP BMP2 BMP3 CAL CALS CMYK CMYKA CR2 CRW
     917             :     CUR CUT DCM DCR DCX DDS DJVU DNG DPX EXR FAX FITS GBR GIF
     918             :     GIF87 GRB HRZ ICB ICO ICON J2C JNG JP2 JPC JPEG JPG JPX K25
     919             :     KDC MIFF MNG MRW MSL MSVG MTV NEF ORF OTB PBM PCD PCDS PCL
     920             :     PCT PCX PDB PEF PGM PICT PIX PJPEG PNG PNG24 PNG32 PNG8 PNM
     921             :     PPM PSD PTIF PWP RAF RAS RBG RGB RGBA RGBO RLA RLE SCR SCT
     922             :     SFW SGI SR2 SRF SUN SVG SVGZ TGA TIFF TIFF64 TILE TIM TTF
     923             :     UYVY VDA VICAR VID VIFF VST WBMP WPG X3F XBM XC XCF XPM XV
     924             :     XWD YCbCr YCbCrA YUV)
     925             :   "List of ImageMagick types to treat as images.
     926             : Each list element should be a string or symbol, representing one
     927             : of the image types returned by `imagemagick-types'.  If the
     928             : element is a string, it is handled as a regexp that enables all
     929             : matching types.
     930             : 
     931             : The value of `imagemagick-enabled-types' may also be t, meaning
     932             : to enable all types that ImageMagick supports.
     933             : 
     934             : The variable `imagemagick-types-inhibit' overrides this variable.
     935             : 
     936             : If you change this without using customize, you must call
     937             : `imagemagick-register-types' afterwards.
     938             : 
     939             : If Emacs is compiled without ImageMagick support, this variable
     940             : has no effect."
     941             :   :type '(choice (const :tag "Support all ImageMagick types" t)
     942             :                  (const :tag "Disable all ImageMagick types" nil)
     943             :                  (repeat :tag "List of types"
     944             :                          (choice (symbol :tag "type")
     945             :                                  (regexp :tag "regexp"))))
     946             :   :initialize #'custom-initialize-default
     947             :   :set (lambda (symbol value)
     948             :          (set-default symbol value)
     949             :          (imagemagick-register-types))
     950             :   :version "24.3")
     951             : 
     952             : (imagemagick-register-types)
     953             : 
     954             : (defun image-increase-size (n)
     955             :   "Increase the image size by a factor of N.
     956             : If N is 3, then the image size will be increased by 30%.  The
     957             : default is 20%."
     958             :   (interactive "P")
     959           0 :   (image--change-size (if n
     960           0 :                           (1+ (/ n 10.0))
     961           0 :                         1.2)))
     962             : 
     963             : (defun image-decrease-size (n)
     964             :   "Decrease the image size by a factor of N.
     965             : If N is 3, then the image size will be decreased by 30%.  The
     966             : default is 20%."
     967             :   (interactive "P")
     968           0 :   (image--change-size (if n
     969           0 :                           (- 1 (/ n 10.0))
     970           0 :                         0.8)))
     971             : 
     972             : (defun image--get-image ()
     973           0 :   (let ((image (get-text-property (point) 'display)))
     974           0 :     (unless (eq (car-safe image) 'image)
     975           0 :       (error "No image under point"))
     976           0 :     image))
     977             : 
     978             : (defun image--get-imagemagick-and-warn ()
     979           0 :   (unless (fboundp 'imagemagick-types)
     980           0 :     (error "Can't rescale images without ImageMagick support"))
     981           0 :   (let ((image (image--get-image)))
     982           0 :     (image-flush image)
     983           0 :     (plist-put (cdr image) :type 'imagemagick)
     984           0 :     image))
     985             : 
     986             : (defun image--change-size (factor)
     987           0 :   (let* ((image (image--get-imagemagick-and-warn))
     988           0 :          (new-image (image--image-without-parameters image))
     989           0 :          (scale (image--current-scaling image new-image)))
     990           0 :     (setcdr image (cdr new-image))
     991           0 :     (plist-put (cdr image) :scale (* scale factor))))
     992             : 
     993             : (defun image--image-without-parameters (image)
     994           0 :   (cons (pop image)
     995           0 :         (let ((new nil))
     996           0 :           (while image
     997           0 :             (let ((key (pop image))
     998           0 :                   (val (pop image)))
     999           0 :               (unless (memq key '(:scale :width :height :max-width :max-height))
    1000           0 :               (setq new (nconc new (list key val))))))
    1001           0 :           new)))
    1002             : 
    1003             : (defun image--current-scaling (image new-image)
    1004             :   ;; The image may be scaled due to many reasons (:scale, :max-width,
    1005             :   ;; etc), so find out what the current scaling is based on the
    1006             :   ;; original image size and the displayed size.
    1007           0 :   (let ((image-width (car (image-size new-image t)))
    1008           0 :         (display-width (car (image-size image t))))
    1009           0 :     (/ (float display-width) image-width)))
    1010             : 
    1011             : (defun image-rotate ()
    1012             :   "Rotate the image under point by 90 degrees clockwise."
    1013             :   (interactive)
    1014           0 :   (let ((image (image--get-imagemagick-and-warn)))
    1015           0 :     (plist-put (cdr image) :rotation
    1016           0 :                (float (mod (+ (or (plist-get (cdr image) :rotation) 0) 90)
    1017             :                            ;; We don't want to exceed 360 degrees
    1018             :                            ;; rotation, because it's not seen as valid
    1019             :                            ;; in exif data.
    1020           0 :                            360)))))
    1021             : 
    1022             : (defun image-save ()
    1023             :   "Save the image under point."
    1024             :   (interactive)
    1025           0 :   (let ((image (get-text-property (point) 'display)))
    1026           0 :     (when (or (not (consp image))
    1027           0 :               (not (eq (car image) 'image)))
    1028           0 :       (error "No image under point"))
    1029           0 :     (with-temp-buffer
    1030           0 :       (let ((file (plist-get (cdr image) :file)))
    1031           0 :         (if file
    1032           0 :             (if (not (file-exists-p file))
    1033           0 :                 (error "File %s no longer exists" file)
    1034           0 :               (insert-file-contents-literally file))
    1035           0 :           (insert (plist-get (cdr image) :data))))
    1036           0 :       (write-region (point-min) (point-max)
    1037           0 :                     (read-file-name "Write image to file: ")))))
    1038             : 
    1039             : (provide 'image)
    1040             : 
    1041             : ;;; image.el ends here

Generated by: LCOV version 1.12