2016-05-23 19:12:24 +00:00
|
|
|
|
;;; image.el --- image API -*- lexical-binding:t -*-
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
2019-01-01 00:59:58 +00:00
|
|
|
|
;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
|
2001-12-25 11:03:46 +00:00
|
|
|
|
|
2019-05-25 20:43:06 +00:00
|
|
|
|
;; Maintainer: emacs-devel@gnu.org
|
1999-08-17 14:22:28 +00:00
|
|
|
|
;; Keywords: multimedia
|
2010-08-29 16:17:13 +00:00
|
|
|
|
;; Package: emacs
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
1999-07-21 21:43:52 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
|
;; (at your option) any later version.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 22:52:52 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
2000-10-05 07:46:30 +00:00
|
|
|
|
(defgroup image ()
|
|
|
|
|
|
"Image support."
|
|
|
|
|
|
:group 'multimedia)
|
|
|
|
|
|
|
2018-02-27 06:47:27 +00:00
|
|
|
|
(declare-function image-flush "image.c" (spec &optional frame))
|
2010-05-22 16:48:01 +00:00
|
|
|
|
(defalias 'image-refresh 'image-flush)
|
2000-10-05 07:46:30 +00:00
|
|
|
|
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(defconst image-type-header-regexps
|
2007-08-25 14:05:49 +00:00
|
|
|
|
`(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
|
2015-09-17 23:08:20 +00:00
|
|
|
|
("\\`P[1-6]\\(?:\
|
2017-10-16 08:23:32 +00:00
|
|
|
|
\\(?:\\(?:#[^\r\n]*[\r\n]\\)*[[:space:]]\\)+\
|
|
|
|
|
|
\\(?:\\(?:#[^\r\n]*[\r\n]\\)*[0-9]\\)+\
|
2013-11-01 09:10:13 +00:00
|
|
|
|
\\)\\{2\\}" . pbm)
|
2007-01-28 07:09:44 +00:00
|
|
|
|
("\\`GIF8[79]a" . gif)
|
2006-12-30 01:51:24 +00:00
|
|
|
|
("\\`\x89PNG\r\n\x1a\n" . png)
|
2008-11-24 17:21:57 +00:00
|
|
|
|
("\\`[\t\n\r ]*#define \\([a-z0-9_]+\\)_width [0-9]+\n\
|
|
|
|
|
|
#define \\1_height [0-9]+\n\\(\
|
|
|
|
|
|
#define \\1_x_hot [0-9]+\n\
|
|
|
|
|
|
#define \\1_y_hot [0-9]+\n\\)?\
|
|
|
|
|
|
static \\(unsigned \\)?char \\1_bits" . xbm)
|
2006-12-30 01:51:24 +00:00
|
|
|
|
("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff)
|
|
|
|
|
|
("\\`[\t\n\r ]*%!PS" . postscript)
|
2009-08-28 23:49:32 +00:00
|
|
|
|
("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg)
|
2007-08-25 14:05:49 +00:00
|
|
|
|
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
|
|
|
|
|
|
(comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
|
|
|
|
|
|
(concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<"
|
|
|
|
|
|
comment-re "*"
|
|
|
|
|
|
"\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
|
|
|
|
|
|
"[Ss][Vv][Gg]"))
|
|
|
|
|
|
. svg)
|
|
|
|
|
|
)
|
2006-12-30 01:51:24 +00:00
|
|
|
|
"Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
When the first bytes of an image file match REGEXP, it is assumed to
|
2006-12-30 01:51:24 +00:00
|
|
|
|
be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol,
|
|
|
|
|
|
IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called
|
|
|
|
|
|
with one argument, a string containing the image data. If PREDICATE returns
|
|
|
|
|
|
a non-nil value, TYPE is the image's type.")
|
2001-08-08 10:54:12 +00:00
|
|
|
|
|
2011-03-22 13:10:43 +00:00
|
|
|
|
(defvar image-type-file-name-regexps
|
2005-10-21 23:42:21 +00:00
|
|
|
|
'(("\\.png\\'" . png)
|
|
|
|
|
|
("\\.gif\\'" . gif)
|
|
|
|
|
|
("\\.jpe?g\\'" . jpeg)
|
|
|
|
|
|
("\\.bmp\\'" . bmp)
|
|
|
|
|
|
("\\.xpm\\'" . xpm)
|
|
|
|
|
|
("\\.pbm\\'" . pbm)
|
|
|
|
|
|
("\\.xbm\\'" . xbm)
|
|
|
|
|
|
("\\.ps\\'" . postscript)
|
2007-08-25 14:05:49 +00:00
|
|
|
|
("\\.tiff?\\'" . tiff)
|
|
|
|
|
|
("\\.svgz?\\'" . svg)
|
|
|
|
|
|
)
|
2005-10-21 23:42:21 +00:00
|
|
|
|
"Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
|
|
|
|
|
|
When the name of an image file match REGEXP, it is assumed to
|
|
|
|
|
|
be of image type IMAGE-TYPE.")
|
|
|
|
|
|
|
2007-02-09 16:50:16 +00:00
|
|
|
|
;; We rely on `auto-mode-alist' to detect xbm and xpm files, instead
|
|
|
|
|
|
;; of content autodetection. Their contents are just C code, so it is
|
|
|
|
|
|
;; easy to generate false matches.
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(defvar image-type-auto-detectable
|
|
|
|
|
|
'((pbm . t)
|
2007-02-09 16:50:16 +00:00
|
|
|
|
(xbm . nil)
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(bmp . maybe)
|
|
|
|
|
|
(gif . maybe)
|
|
|
|
|
|
(png . maybe)
|
2007-02-09 16:50:16 +00:00
|
|
|
|
(xpm . nil)
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(jpeg . maybe)
|
|
|
|
|
|
(tiff . maybe)
|
2007-08-25 14:05:49 +00:00
|
|
|
|
(svg . maybe)
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(postscript . nil))
|
|
|
|
|
|
"Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files.
|
|
|
|
|
|
\(See `image-type-auto-detected-p').
|
|
|
|
|
|
|
|
|
|
|
|
AUTODETECT can be
|
|
|
|
|
|
- t always auto-detect.
|
|
|
|
|
|
- nil never auto-detect.
|
|
|
|
|
|
- maybe auto-detect only if the image type is available
|
|
|
|
|
|
(see `image-type-available-p').")
|
2005-10-21 23:42:21 +00:00
|
|
|
|
|
2013-08-13 20:13:02 +00:00
|
|
|
|
(defvar image-format-suffixes
|
2016-12-02 10:09:31 +00:00
|
|
|
|
'((image/x-rgb "rgb") (image/x-icon "ico"))
|
2014-01-22 08:30:00 +00:00
|
|
|
|
"An alist associating image types with file name suffixes.
|
2013-08-13 17:45:34 +00:00
|
|
|
|
This is used as a hint by the ImageMagick library when detecting
|
2014-01-22 08:30:00 +00:00
|
|
|
|
the type of image data (that does not have an associated file name).
|
|
|
|
|
|
Each element has the form (MIME-CONTENT-TYPE EXTENSION).
|
|
|
|
|
|
If `create-image' is called with a :format attribute whose value
|
|
|
|
|
|
equals a content-type found in this list, the ImageMagick library is
|
|
|
|
|
|
told that the data would have the associated suffix if saved to a file.")
|
2013-08-13 17:45:34 +00:00
|
|
|
|
|
2009-09-12 03:55:46 +00:00
|
|
|
|
(defcustom image-load-path
|
|
|
|
|
|
(list (file-name-as-directory (expand-file-name "images" data-directory))
|
|
|
|
|
|
'data-directory 'load-path)
|
2005-09-15 14:00:09 +00:00
|
|
|
|
"List of locations in which to search for image files.
|
2018-04-12 12:44:06 +00:00
|
|
|
|
The images for icons shown in the tool bar are also looked up
|
|
|
|
|
|
in these locations.
|
|
|
|
|
|
|
2005-09-18 14:04:46 +00:00
|
|
|
|
If an element is a string, it defines a directory to search.
|
|
|
|
|
|
If an element is a variable symbol whose value is a string, that
|
|
|
|
|
|
value defines a directory to search.
|
|
|
|
|
|
If an element is a variable symbol whose value is a list, the
|
2013-10-27 23:04:16 +00:00
|
|
|
|
value is used as a list of directories to search.
|
|
|
|
|
|
|
|
|
|
|
|
Subdirectories are not automatically included in the search."
|
2009-09-12 03:55:46 +00:00
|
|
|
|
:type '(repeat (choice directory variable))
|
2016-05-23 19:12:24 +00:00
|
|
|
|
:initialize #'custom-initialize-delay)
|
2005-10-22 15:26:36 +00:00
|
|
|
|
|
2016-02-08 07:22:53 +00:00
|
|
|
|
(defcustom image-scaling-factor 'auto
|
|
|
|
|
|
"When displaying images, apply this scaling factor before displaying.
|
|
|
|
|
|
This is not supported for all image types, and is mostly useful
|
|
|
|
|
|
when you have a high-resolution monitor.
|
|
|
|
|
|
The value is either a floating point number (where numbers higher
|
|
|
|
|
|
than 1 means to increase the size and lower means to shrink the
|
|
|
|
|
|
size), or the symbol `auto', which will compute a scaling factor
|
|
|
|
|
|
based on the font pixel size."
|
|
|
|
|
|
:type '(choice number
|
|
|
|
|
|
(const :tag "Automatically compute" auto))
|
2016-11-16 15:39:43 +00:00
|
|
|
|
:version "26.1")
|
2006-03-14 19:16:24 +00:00
|
|
|
|
|
2019-09-28 23:26:02 +00:00
|
|
|
|
(defcustom convert-images-externally nil
|
|
|
|
|
|
"If non-nil, `create-image' will use external converters for exotic formats.
|
2019-09-29 07:09:56 +00:00
|
|
|
|
Emacs handles most of the common image formats (SVG, JPEG, PNG, GIF
|
|
|
|
|
|
and some others) internally, but images that don't have native
|
|
|
|
|
|
support in Emacs can still be displayed if an external conversion
|
|
|
|
|
|
program (like ImageMagick \"convert\", GraphicsMagick \"gm\"
|
|
|
|
|
|
or \"ffmpeg\") is installed."
|
2019-09-28 23:26:02 +00:00
|
|
|
|
:type 'bool
|
|
|
|
|
|
:version "27.1")
|
|
|
|
|
|
|
2016-02-10 01:03:55 +00:00
|
|
|
|
;; Map put into text properties on images.
|
|
|
|
|
|
(defvar image-map
|
2016-02-10 01:32:28 +00:00
|
|
|
|
(let ((map (make-sparse-keymap)))
|
2016-02-10 01:03:55 +00:00
|
|
|
|
(define-key map "-" 'image-decrease-size)
|
|
|
|
|
|
(define-key map "+" 'image-increase-size)
|
|
|
|
|
|
(define-key map "r" 'image-rotate)
|
|
|
|
|
|
(define-key map "o" 'image-save)
|
|
|
|
|
|
map))
|
|
|
|
|
|
|
2006-03-11 02:04:08 +00:00
|
|
|
|
(defun image-load-path-for-library (library image &optional path no-error)
|
2006-03-19 18:19:12 +00:00
|
|
|
|
"Return a suitable search path for images used by LIBRARY.
|
2006-03-10 22:52:26 +00:00
|
|
|
|
|
2006-03-17 17:26:58 +00:00
|
|
|
|
It searches for IMAGE in `image-load-path' (excluding
|
2006-03-16 16:55:26 +00:00
|
|
|
|
\"`data-directory'/images\") and `load-path', followed by a path
|
|
|
|
|
|
suitable for LIBRARY, which includes \"../../etc/images\" and
|
|
|
|
|
|
\"../etc/images\" relative to the library file itself, and then
|
|
|
|
|
|
in \"`data-directory'/images\".
|
2006-03-10 22:52:26 +00:00
|
|
|
|
|
2006-03-14 19:16:24 +00:00
|
|
|
|
Then this function returns a list of directories which contains
|
|
|
|
|
|
first the directory in which IMAGE was found, followed by the
|
2009-02-24 10:28:57 +00:00
|
|
|
|
value of `load-path'. If PATH is given, it is used instead of
|
2006-03-14 19:16:24 +00:00
|
|
|
|
`load-path'.
|
2006-03-11 02:04:08 +00:00
|
|
|
|
|
2006-03-14 19:16:24 +00:00
|
|
|
|
If NO-ERROR is non-nil and a suitable path can't be found, don't
|
2009-02-24 10:28:57 +00:00
|
|
|
|
signal an error. Instead, return a list of directories as before,
|
2006-03-14 19:16:24 +00:00
|
|
|
|
except that nil appears in place of the image directory.
|
2006-03-10 22:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
Here is an example that uses a common idiom to provide
|
|
|
|
|
|
compatibility with versions of Emacs that lack the variable
|
|
|
|
|
|
`image-load-path':
|
|
|
|
|
|
|
2006-03-15 17:06:16 +00:00
|
|
|
|
;; Shush compiler.
|
|
|
|
|
|
(defvar image-load-path)
|
2006-03-14 19:16:24 +00:00
|
|
|
|
|
|
|
|
|
|
(let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
|
2006-03-15 17:06:16 +00:00
|
|
|
|
(image-load-path (cons (car load-path)
|
2015-11-17 23:28:50 +00:00
|
|
|
|
(when (boundp \\='image-load-path)
|
2006-03-15 17:06:16 +00:00
|
|
|
|
image-load-path))))
|
2006-03-14 19:16:24 +00:00
|
|
|
|
(mh-tool-bar-folder-buttons-init))"
|
2006-03-10 22:52:26 +00:00
|
|
|
|
(unless library (error "No library specified"))
|
|
|
|
|
|
(unless image (error "No image specified"))
|
2006-03-16 16:55:26 +00:00
|
|
|
|
(let (image-directory image-directory-load-path)
|
|
|
|
|
|
;; Check for images in image-load-path or load-path.
|
|
|
|
|
|
(let ((img image)
|
|
|
|
|
|
(dir (or
|
|
|
|
|
|
;; Images in image-load-path.
|
|
|
|
|
|
(image-search-load-path image)
|
|
|
|
|
|
;; Images in load-path.
|
|
|
|
|
|
(locate-library image)))
|
|
|
|
|
|
parent)
|
|
|
|
|
|
;; Since the image might be in a nested directory (for
|
|
|
|
|
|
;; example, mail/attach.pbm), adjust `image-directory'
|
|
|
|
|
|
;; accordingly.
|
|
|
|
|
|
(when dir
|
|
|
|
|
|
(setq dir (file-name-directory dir))
|
|
|
|
|
|
(while (setq parent (file-name-directory img))
|
|
|
|
|
|
(setq img (directory-file-name parent)
|
|
|
|
|
|
dir (expand-file-name "../" dir))))
|
|
|
|
|
|
(setq image-directory-load-path dir))
|
|
|
|
|
|
|
2012-02-28 08:17:21 +00:00
|
|
|
|
;; If `image-directory-load-path' isn't Emacs's image directory,
|
2006-03-16 16:55:26 +00:00
|
|
|
|
;; it's probably a user preference, so use it. Then use a
|
|
|
|
|
|
;; relative setting if possible; otherwise, use
|
|
|
|
|
|
;; `image-directory-load-path'.
|
2006-03-10 22:52:26 +00:00
|
|
|
|
(cond
|
2006-03-16 16:55:26 +00:00
|
|
|
|
;; User-modified image-load-path?
|
|
|
|
|
|
((and image-directory-load-path
|
|
|
|
|
|
(not (equal image-directory-load-path
|
|
|
|
|
|
(file-name-as-directory
|
|
|
|
|
|
(expand-file-name "images" data-directory)))))
|
|
|
|
|
|
(setq image-directory image-directory-load-path))
|
2006-03-10 22:52:26 +00:00
|
|
|
|
;; Try relative setting.
|
|
|
|
|
|
((let (library-name d1ei d2ei)
|
|
|
|
|
|
;; First, find library in the load-path.
|
|
|
|
|
|
(setq library-name (locate-library library))
|
|
|
|
|
|
(if (not library-name)
|
|
|
|
|
|
(error "Cannot find library %s in load-path" library))
|
|
|
|
|
|
;; And then set image-directory relative to that.
|
|
|
|
|
|
(setq
|
|
|
|
|
|
;; Go down 2 levels.
|
2006-03-16 16:55:26 +00:00
|
|
|
|
d2ei (file-name-as-directory
|
|
|
|
|
|
(expand-file-name
|
|
|
|
|
|
(concat (file-name-directory library-name) "../../etc/images")))
|
2006-03-10 22:52:26 +00:00
|
|
|
|
;; Go down 1 level.
|
2006-03-16 16:55:26 +00:00
|
|
|
|
d1ei (file-name-as-directory
|
|
|
|
|
|
(expand-file-name
|
|
|
|
|
|
(concat (file-name-directory library-name) "../etc/images"))))
|
2006-03-10 22:52:26 +00:00
|
|
|
|
(setq image-directory
|
|
|
|
|
|
;; Set it to nil if image is not found.
|
|
|
|
|
|
(cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
|
|
|
|
|
|
((file-exists-p (expand-file-name image d1ei)) d1ei)))))
|
2012-02-28 08:17:21 +00:00
|
|
|
|
;; Use Emacs's image directory.
|
2006-03-16 16:55:26 +00:00
|
|
|
|
(image-directory-load-path
|
|
|
|
|
|
(setq image-directory image-directory-load-path))
|
2006-03-11 02:04:08 +00:00
|
|
|
|
(no-error
|
|
|
|
|
|
(message "Could not find image %s for library %s" image library))
|
2006-03-10 22:52:26 +00:00
|
|
|
|
(t
|
|
|
|
|
|
(error "Could not find image %s for library %s" image library)))
|
|
|
|
|
|
|
2006-03-14 19:16:24 +00:00
|
|
|
|
;; Return an augmented `path' or `load-path'.
|
|
|
|
|
|
(nconc (list image-directory)
|
|
|
|
|
|
(delete image-directory (copy-sequence (or path load-path))))))
|
|
|
|
|
|
|
2006-03-10 22:52:26 +00:00
|
|
|
|
|
2012-02-08 03:45:27 +00:00
|
|
|
|
;; Used to be in image-type-header-regexps, but now not used anywhere
|
|
|
|
|
|
;; (since 2009-08-28).
|
2001-08-08 10:54:12 +00:00
|
|
|
|
(defun image-jpeg-p (data)
|
2018-05-24 15:28:11 +00:00
|
|
|
|
(declare (obsolete "It is unused inside Emacs and will be removed." "27.1"))
|
2002-08-05 16:26:03 +00:00
|
|
|
|
"Value is non-nil if DATA, a string, consists of JFIF image data.
|
|
|
|
|
|
We accept the tag Exif because that is the same format."
|
2008-06-27 15:58:36 +00:00
|
|
|
|
(setq data (ignore-errors (string-to-unibyte data)))
|
|
|
|
|
|
(when (and data (string-match-p "\\`\xff\xd8" data))
|
2001-08-08 10:54:12 +00:00
|
|
|
|
(catch 'jfif
|
|
|
|
|
|
(let ((len (length data)) (i 2))
|
|
|
|
|
|
(while (< i len)
|
|
|
|
|
|
(when (/= (aref data i) #xff)
|
|
|
|
|
|
(throw 'jfif nil))
|
|
|
|
|
|
(setq i (1+ i))
|
|
|
|
|
|
(when (>= (+ i 2) len)
|
|
|
|
|
|
(throw 'jfif nil))
|
Audit use of lsh and fix glitches
I audited use of lsh in the Lisp source code, and fixed the
glitches that I found. While I was at it, I replaced uses of lsh
with ash when either will do. Replacement is OK when either
argument is known to be nonnegative, or when only the low-order
bits of the result matter, and is a (minor) win since ash is a bit
more solid than lsh nowadays, and is a bit faster.
* lisp/calc/calc-ext.el (math-check-fixnum):
Prefer most-positive-fixnum to (lsh -1 -1).
* lisp/vc/vc-hg.el (vc-hg-state-fast): When testing fixnum width,
prefer (zerop (ash most-positive-fixnum -32)) to (zerop (lsh -1
32)) (Bug#32485#11).
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode):
Tighten sanity-check for bytecode overflow, by checking that the
result of (ash pc -8) is nonnegative. Formerly this check was not
needed since lsh was used and the number overflowed differently.
* lisp/net/dns.el (dns-write): Fix some obvious sign typos in
shift counts. Evidently this part of the code has never been
exercised.
* lisp/progmodes/hideif.el (hif-shiftleft, hif-shiftright):
* lisp/term/common-win.el (x-setup-function-keys):
Simplify.
* admin/unidata/unidata-gen.el, admin/unidata/uvs.el:
* doc/lispref/keymaps.texi, doc/lispref/syntax.texi:
* doc/misc/calc.texi, doc/misc/cl.texi, etc/NEWS.19:
* lisp/arc-mode.el, lisp/calc/calc-bin.el, lisp/calc/calc-comb.el:
* lisp/calc/calc-ext.el, lisp/calc/calc-math.el:
* lisp/cedet/semantic/wisent/comp.el, lisp/composite.el:
* lisp/disp-table.el, lisp/dos-fns.el, lisp/edmacro.el:
* lisp/emacs-lisp/bindat.el, lisp/emacs-lisp/byte-opt.el:
* lisp/emacs-lisp/bytecomp.el, lisp/emacs-lisp/cl-extra.el:
* lisp/erc/erc-dcc.el, lisp/facemenu.el, lisp/gnus/message.el:
* lisp/gnus/nndoc.el, lisp/gnus/nnmaildir.el, lisp/image.el:
* lisp/international/ccl.el, lisp/international/fontset.el:
* lisp/international/mule-cmds.el, lisp/international/mule.el:
* lisp/json.el, lisp/mail/binhex.el, lisp/mail/rmail.el:
* lisp/mail/uudecode.el, lisp/md4.el, lisp/net/dns.el:
* lisp/net/ntlm.el, lisp/net/sasl.el, lisp/net/socks.el:
* lisp/net/tramp.el, lisp/obsolete/levents.el:
* lisp/obsolete/pgg-parse.el, lisp/org/org.el:
* lisp/org/ox-publish.el, lisp/progmodes/cc-defs.el:
* lisp/progmodes/ebnf2ps.el, lisp/progmodes/hideif.el:
* lisp/ps-bdf.el, lisp/ps-print.el, lisp/simple.el:
* lisp/tar-mode.el, lisp/term/common-win.el:
* lisp/term/tty-colors.el, lisp/term/xterm.el, lisp/vc/vc-git.el:
* lisp/vc/vc-hg.el, lisp/x-dnd.el, test/src/data-tests.el:
Prefer ash to lsh when either will do.
2018-08-21 20:44:03 +00:00
|
|
|
|
(let ((nbytes (+ (ash (aref data (+ i 1)) 8)
|
2001-08-10 10:59:06 +00:00
|
|
|
|
(aref data (+ i 2))))
|
|
|
|
|
|
(code (aref data i)))
|
|
|
|
|
|
(when (and (>= code #xe0) (<= code #xef))
|
2001-08-08 10:54:12 +00:00
|
|
|
|
;; APP0 LEN1 LEN2 "JFIF\0"
|
2003-02-04 11:26:42 +00:00
|
|
|
|
(throw 'jfif
|
2008-06-27 15:58:36 +00:00
|
|
|
|
(string-match-p "JFIF\\|Exif"
|
|
|
|
|
|
(substring data i (min (+ i nbytes) len)))))
|
2001-08-09 09:31:56 +00:00
|
|
|
|
(setq i (+ i 1 nbytes))))))))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2000-01-01 16:33:32 +00:00
|
|
|
|
(defun image-type-from-data (data)
|
|
|
|
|
|
"Determine the image type from image data DATA.
|
|
|
|
|
|
Value is a symbol specifying the image type or nil if type cannot
|
1999-07-21 21:43:52 +00:00
|
|
|
|
be determined."
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(let ((types image-type-header-regexps)
|
1999-07-21 21:43:52 +00:00
|
|
|
|
type)
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(while types
|
1999-07-21 21:43:52 +00:00
|
|
|
|
(let ((regexp (car (car types)))
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(image-type (cdr (car types))))
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(if (or (and (symbolp image-type)
|
2008-06-27 15:58:36 +00:00
|
|
|
|
(string-match-p regexp data))
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(and (consp image-type)
|
|
|
|
|
|
(funcall (car image-type) data)
|
|
|
|
|
|
(setq image-type (cdr image-type))))
|
|
|
|
|
|
(setq type image-type
|
|
|
|
|
|
types nil)
|
|
|
|
|
|
(setq types (cdr types)))))
|
|
|
|
|
|
type))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(defun image-type-from-buffer ()
|
2005-10-21 23:42:21 +00:00
|
|
|
|
"Determine the image type from data in the current buffer.
|
2006-12-30 01:51:24 +00:00
|
|
|
|
Value is a symbol specifying the image type or nil if type cannot
|
|
|
|
|
|
be determined."
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(let ((types image-type-header-regexps)
|
|
|
|
|
|
type
|
|
|
|
|
|
(opoint (point)))
|
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
|
(while types
|
|
|
|
|
|
(let ((regexp (car (car types)))
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(image-type (cdr (car types)))
|
2005-10-21 23:42:21 +00:00
|
|
|
|
data)
|
|
|
|
|
|
(if (or (and (symbolp image-type)
|
2008-06-27 15:58:36 +00:00
|
|
|
|
(looking-at-p regexp))
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(and (consp image-type)
|
|
|
|
|
|
(funcall (car image-type)
|
|
|
|
|
|
(or data
|
|
|
|
|
|
(setq data
|
|
|
|
|
|
(buffer-substring
|
|
|
|
|
|
(point-min)
|
|
|
|
|
|
(min (point-max)
|
2019-05-18 17:00:26 +00:00
|
|
|
|
(+ (point-min) 8192))))))
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(setq image-type (cdr image-type))))
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(setq type image-type
|
2005-10-21 23:42:21 +00:00
|
|
|
|
types nil)
|
|
|
|
|
|
(setq types (cdr types)))))
|
|
|
|
|
|
(goto-char opoint)
|
2012-04-26 08:43:20 +00:00
|
|
|
|
(and type
|
2013-09-18 04:24:14 +00:00
|
|
|
|
(boundp 'image-types)
|
2012-04-26 08:43:20 +00:00
|
|
|
|
(memq type image-types)
|
|
|
|
|
|
type)))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
|
2000-01-01 16:33:32 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
|
(defun image-type-from-file-header (file)
|
|
|
|
|
|
"Determine the type of image file FILE from its first few bytes.
|
|
|
|
|
|
Value is a symbol specifying the image type, or nil if type cannot
|
|
|
|
|
|
be determined."
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(unless (or (file-readable-p file)
|
|
|
|
|
|
(file-name-absolute-p file))
|
|
|
|
|
|
(setq file (image-search-load-path file)))
|
|
|
|
|
|
(and file
|
|
|
|
|
|
(file-readable-p file)
|
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
|
(set-buffer-multibyte nil)
|
2019-05-18 17:00:26 +00:00
|
|
|
|
(insert-file-contents-literally file nil 0 8192)
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(image-type-from-buffer))))
|
2005-10-21 23:42:21 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
|
(defun image-type-from-file-name (file)
|
|
|
|
|
|
"Determine the type of image file FILE from its name.
|
|
|
|
|
|
Value is a symbol specifying the image type, or nil if type cannot
|
|
|
|
|
|
be determined."
|
2016-09-04 02:09:31 +00:00
|
|
|
|
(let (type first (case-fold-search t))
|
2012-11-02 22:41:35 +00:00
|
|
|
|
(catch 'found
|
|
|
|
|
|
(dolist (elem image-type-file-name-regexps first)
|
|
|
|
|
|
(when (string-match-p (car elem) file)
|
|
|
|
|
|
(if (image-type-available-p (setq type (cdr elem)))
|
|
|
|
|
|
(throw 'found type)
|
|
|
|
|
|
;; If nothing seems to be supported, return first type that matched.
|
|
|
|
|
|
(or first (setq first type))))))))
|
2000-01-01 16:33:32 +00:00
|
|
|
|
|
2019-09-28 23:26:02 +00:00
|
|
|
|
(declare-function image-convert-p "image-converter.el" (file))
|
|
|
|
|
|
(declare-function image-convert "image-converter.el" (image))
|
|
|
|
|
|
|
1999-07-21 21:43:52 +00:00
|
|
|
|
;;;###autoload
|
2007-05-21 16:43:13 +00:00
|
|
|
|
(defun image-type (source &optional type data-p)
|
2006-04-21 20:56:06 +00:00
|
|
|
|
"Determine and return image type.
|
2007-05-21 16:43:13 +00:00
|
|
|
|
SOURCE is an image file name or image data.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
Optional TYPE is a symbol describing the image type. If TYPE is omitted
|
2000-01-01 16:33:32 +00:00
|
|
|
|
or nil, try to determine the image type from its first few bytes
|
2007-05-21 16:43:13 +00:00
|
|
|
|
of image data. If that doesn't work, and SOURCE is a file name,
|
2000-12-08 17:08:25 +00:00
|
|
|
|
use its file extension as image type.
|
2007-05-21 16:43:13 +00:00
|
|
|
|
Optional DATA-P non-nil means SOURCE is a string containing image data."
|
|
|
|
|
|
(when (and (not data-p) (not (stringp source)))
|
Go back to grave quoting in source-code docstrings etc.
This reverts almost all my recent changes to use curved quotes
in docstrings and/or strings used for error diagnostics.
There are a few exceptions, e.g., Bahá’í proper names.
* admin/unidata/unidata-gen.el (unidata-gen-table):
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/align.el (align-region):
* lisp/allout.el (allout-mode, allout-solicit-alternate-bullet)
(outlineify-sticky):
* lisp/apropos.el (apropos-library):
* lisp/bookmark.el (bookmark-default-annotation-text):
* lisp/button.el (button-category-symbol, button-put)
(make-text-button):
* lisp/calc/calc-aent.el (math-read-if, math-read-factor):
* lisp/calc/calc-embed.el (calc-do-embedded):
* lisp/calc/calc-ext.el (calc-user-function-list):
* lisp/calc/calc-graph.el (calc-graph-show-dumb):
* lisp/calc/calc-help.el (calc-describe-key)
(calc-describe-thing, calc-full-help):
* lisp/calc/calc-lang.el (calc-c-language)
(math-parse-fortran-vector-end, math-parse-tex-sum)
(math-parse-eqn-matrix, math-parse-eqn-prime)
(calc-yacas-language, calc-maxima-language, calc-giac-language)
(math-read-giac-subscr, math-read-math-subscr)
(math-read-big-rec, math-read-big-balance):
* lisp/calc/calc-misc.el (calc-help, report-calc-bug):
* lisp/calc/calc-mode.el (calc-auto-why, calc-save-modes)
(calc-auto-recompute):
* lisp/calc/calc-prog.el (calc-fix-token-name)
(calc-read-parse-table-part, calc-user-define-invocation)
(math-do-arg-check):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-vec.el (math-read-brackets):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calc/calc.el (calc, calc-do, calc-user-invocation):
* lisp/calendar/appt.el (appt-display-message):
* lisp/calendar/diary-lib.el (diary-check-diary-file)
(diary-mail-entries, diary-from-outlook):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--convert-float-to-ical)
(icalendar--convert-date-to-ical)
(icalendar--convert-ical-to-diary)
(icalendar--convert-recurring-to-diary)
(icalendar--add-diary-entry):
* lisp/calendar/time-date.el (format-seconds):
* lisp/calendar/timeclock.el (timeclock-mode-line-display)
(timeclock-make-hours-explicit, timeclock-log-data):
* lisp/calendar/todo-mode.el (todo-prefix, todo-delete-category)
(todo-item-mark, todo-check-format)
(todo-insert-item--next-param, todo-edit-item--next-key)
(todo-mode):
* lisp/cedet/ede/pmake.el (ede-proj-makefile-insert-dist-rules):
* lisp/cedet/mode-local.el (describe-mode-local-overload)
(mode-local-print-binding, mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-displayor-show-request):
* lisp/cedet/srecode/srt-mode.el (srecode-macro-help):
* lisp/cus-start.el (standard):
* lisp/cus-theme.el (describe-theme-1):
* lisp/custom.el (custom-add-dependencies, custom-check-theme)
(custom--sort-vars-1, load-theme):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dired-x.el (dired-do-run-mail):
* lisp/dired.el (dired-log):
* lisp/emacs-lisp/advice.el (ad-read-advised-function)
(ad-read-advice-class, ad-read-advice-name, ad-enable-advice)
(ad-disable-advice, ad-remove-advice, ad-set-argument)
(ad-set-arguments, ad--defalias-fset, ad-activate)
(ad-deactivate):
* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand)
(byte-compile-unfold-lambda, byte-optimize-form-code-walker)
(byte-optimize-while, byte-optimize-apply):
* lisp/emacs-lisp/byte-run.el (defun, defsubst):
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode)
(byte-compile-log-file, byte-compile-format-warn)
(byte-compile-nogroup-warn, byte-compile-arglist-warn)
(byte-compile-cl-warn)
(byte-compile-warn-about-unresolved-functions)
(byte-compile-file, byte-compile--declare-var)
(byte-compile-file-form-defmumble, byte-compile-form)
(byte-compile-normal-call, byte-compile-check-variable)
(byte-compile-variable-ref, byte-compile-variable-set)
(byte-compile-subr-wrong-args, byte-compile-setq-default)
(byte-compile-negation-optimizer)
(byte-compile-condition-case--old)
(byte-compile-condition-case--new, byte-compile-save-excursion)
(byte-compile-defvar, byte-compile-autoload)
(byte-compile-lambda-form)
(byte-compile-make-variable-buffer-local, display-call-tree)
(batch-byte-compile):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use):
* lisp/emacs-lisp/chart.el (chart-space-usage):
* lisp/emacs-lisp/check-declare.el (check-declare-scan)
(check-declare-warn, check-declare-file)
(check-declare-directory):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine)
(checkdoc-message-text-engine):
* lisp/emacs-lisp/cl-extra.el (cl-parse-integer)
(cl--describe-class):
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric)
(cl--generic-describe, cl-generic-generalizers):
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause, cl-tagbody)
(cl-symbol-macrolet):
* lisp/emacs-lisp/cl.el (cl-unload-function, flet):
* lisp/emacs-lisp/copyright.el (copyright)
(copyright-update-directory):
* lisp/emacs-lisp/edebug.el (edebug-read-list):
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-read):
* lisp/emacs-lisp/eieio-core.el (eieio--slot-override)
(eieio-oref):
* lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor):
* lisp/emacs-lisp/eieio-speedbar.el:
(eieio-speedbar-child-make-tag-lines)
(eieio-speedbar-child-description):
* lisp/emacs-lisp/eieio.el (defclass, change-class):
* lisp/emacs-lisp/elint.el (elint-file, elint-get-top-forms)
(elint-init-form, elint-check-defalias-form)
(elint-check-let-form):
* lisp/emacs-lisp/ert.el (ert-get-test, ert-results-mode-menu)
(ert-results-pop-to-backtrace-for-test-at-point)
(ert-results-pop-to-messages-for-test-at-point)
(ert-results-pop-to-should-forms-for-test-at-point)
(ert-describe-test):
* lisp/emacs-lisp/find-func.el (find-function-search-for-symbol)
(find-function-library):
* lisp/emacs-lisp/generator.el (iter-yield):
* lisp/emacs-lisp/gv.el (gv-define-simple-setter):
* lisp/emacs-lisp/lisp-mnt.el (lm-verify):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring)
(advice--make, define-advice):
* lisp/emacs-lisp/package-x.el (package-upload-file):
* lisp/emacs-lisp/package.el (package-version-join)
(package-disabled-p, package-activate-1, package-activate)
(package--download-one-archive)
(package--download-and-read-archives)
(package-compute-transaction, package-install-from-archive)
(package-install, package-install-selected-packages)
(package-delete, package-autoremove, describe-package-1)
(package-install-button-action, package-delete-button-action)
(package-menu-hide-package, package-menu--list-to-prompt)
(package-menu--perform-transaction)
(package-menu--find-and-notify-upgrades):
* lisp/emacs-lisp/pcase.el (pcase-exhaustive, pcase--u1):
* lisp/emacs-lisp/re-builder.el (reb-enter-subexp-mode):
* lisp/emacs-lisp/ring.el (ring-previous, ring-next):
* lisp/emacs-lisp/rx.el (rx-check, rx-anything)
(rx-check-any-string, rx-check-any, rx-check-not, rx-=)
(rx-repeat, rx-check-backref, rx-syntax, rx-check-category)
(rx-form):
* lisp/emacs-lisp/smie.el (smie-config-save):
* lisp/emacs-lisp/subr-x.el (internal--check-binding):
* lisp/emacs-lisp/tabulated-list.el (tabulated-list-put-tag):
* lisp/emacs-lisp/testcover.el (testcover-1value):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emulation/viper-cmd.el (viper-toggle-parse-sexp-ignore-comments)
(viper-toggle-search-style, viper-kill-buffer)
(viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/env.el (setenv):
* lisp/erc/erc-button.el (erc-nick-popup):
* lisp/erc/erc.el (erc-cmd-LOAD, erc-handle-login, english):
* lisp/eshell/em-dirs.el (eshell/cd):
* lisp/eshell/em-glob.el (eshell-glob-regexp)
(eshell-glob-entries):
* lisp/eshell/em-pred.el (eshell-parse-modifiers):
* lisp/eshell/esh-opt.el (eshell-show-usage):
* lisp/facemenu.el (facemenu-add-new-face)
(facemenu-add-new-color):
* lisp/faces.el (read-face-name, read-face-font, describe-face)
(x-resolve-font-name):
* lisp/files-x.el (modify-file-local-variable):
* lisp/files.el (locate-user-emacs-file, find-alternate-file)
(set-auto-mode, hack-one-local-variable--obsolete)
(dir-locals-set-directory-class, write-file, basic-save-buffer)
(delete-directory, copy-directory, recover-session)
(recover-session-finish, insert-directory)
(file-modes-char-to-who, file-modes-symbolic-to-number)
(move-file-to-trash):
* lisp/filesets.el (filesets-add-buffer, filesets-remove-buffer):
* lisp/find-cmd.el (find-generic, find-to-string):
* lisp/finder.el (finder-commentary):
* lisp/font-lock.el (font-lock-fontify-buffer):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/frame.el (get-device-terminal, select-frame-by-name):
* lisp/fringe.el (fringe--check-style):
* lisp/gnus/nnmairix.el (nnmairix-widget-create-query):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--parent-mode)
(help-fns--obsolete, help-fns--interactive-only)
(describe-function-1, describe-variable):
* lisp/help.el (describe-mode)
(describe-minor-mode-from-indicator):
* lisp/image.el (image-type):
* lisp/international/ccl.el (ccl-dump):
* lisp/international/fontset.el (x-must-resolve-font-name):
* lisp/international/mule-cmds.el (prefer-coding-system)
(select-safe-coding-system-interactively)
(select-safe-coding-system, activate-input-method)
(toggle-input-method, describe-current-input-method)
(describe-language-environment):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/mail/feedmail.el (feedmail-run-the-queue):
* lisp/mouse.el (minor-mode-menu-from-indicator):
* lisp/mpc.el (mpc-playlist-rename):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-shell-command):
* lisp/net/imap.el (imap-interactive-login):
* lisp/net/mairix.el (mairix-widget-create-query):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/rlogin.el (rlogin):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/obsolete/otodo-mode.el (todo-more-important-p):
* lisp/obsolete/pgg-gpg.el (pgg-gpg-process-region):
* lisp/obsolete/pgg-pgp.el (pgg-pgp-process-region):
* lisp/obsolete/pgg-pgp5.el (pgg-pgp5-process-region):
* lisp/org/ob-core.el (org-babel-goto-named-src-block)
(org-babel-goto-named-result):
* lisp/org/ob-fortran.el (org-babel-fortran-ensure-main-wrap):
* lisp/org/ob-ref.el (org-babel-ref-resolve):
* lisp/org/org-agenda.el (org-agenda-prepare):
* lisp/org/org-clock.el (org-clock-notify-once-if-expired)
(org-clock-resolve):
* lisp/org/org-ctags.el (org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/org/org-feed.el (org-feed-parse-atom-entry):
* lisp/org/org-habit.el (org-habit-parse-todo):
* lisp/org/org-mouse.el (org-mouse-popup-global-menu)
(org-mouse-context-menu):
* lisp/org/org-table.el (org-table-edit-formulas):
* lisp/org/ox.el (org-export-async-start):
* lisp/proced.el (proced-log):
* lisp/progmodes/ada-mode.el (ada-get-indent-case)
(ada-check-matching-start, ada-goto-matching-start):
* lisp/progmodes/ada-prj.el (ada-prj-display-page):
* lisp/progmodes/ada-xref.el (ada-find-executable):
* lisp/progmodes/ebrowse.el (ebrowse-tags-apropos):
* lisp/progmodes/etags.el (etags-tags-apropos-additional):
* lisp/progmodes/flymake.el (flymake-parse-err-lines)
(flymake-start-syntax-check-process):
* lisp/progmodes/python.el (python-shell-get-process-or-error)
(python-define-auxiliary-skeleton):
* lisp/progmodes/sql.el (sql-comint):
* lisp/progmodes/verilog-mode.el (verilog-load-file-at-point):
* lisp/progmodes/vhdl-mode.el (vhdl-widget-directory-validate):
* lisp/recentf.el (recentf-open-files):
* lisp/replace.el (query-replace-read-from)
(occur-after-change-function, occur-1):
* lisp/scroll-bar.el (scroll-bar-columns):
* lisp/server.el (server-get-auth-key):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, list-processes--refresh)
(compose-mail, set-variable, choose-completion-string)
(define-alternatives):
* lisp/startup.el (site-run-file, tty-handle-args, command-line)
(command-line-1):
* lisp/subr.el (noreturn, define-error, add-to-list)
(read-char-choice, version-to-list):
* lisp/term/common-win.el (x-handle-xrm-switch)
(x-handle-name-switch, x-handle-args):
* lisp/term/x-win.el (x-handle-parent-id, x-handle-smid):
* lisp/textmodes/reftex-ref.el (reftex-label):
* lisp/textmodes/reftex-toc.el (reftex-toc-rename-label):
* lisp/textmodes/two-column.el (2C-split):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* lisp/type-break.el (type-break-noninteractive-query):
* lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes)
(wdired-do-perm-changes):
* lisp/whitespace.el (whitespace-report-region):
Prefer grave quoting in source-code strings used to generate help
and diagnostics.
* lisp/faces.el (face-documentation):
No need to convert quotes, since the result is a docstring.
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
Simplify by generating only curved quotes, since info files are
typically that ways nowadays anyway.
* lisp/international/mule-diag.el (list-input-methods):
Don’t assume text quoting style is curved.
* lisp/org/org-bibtex.el (org-bibtex-fields):
Revert my recent changes, going back to the old quoting style.
2015-09-07 15:41:44 +00:00
|
|
|
|
(error "Invalid image file name `%s'" source))
|
2000-01-01 16:33:32 +00:00
|
|
|
|
(unless type
|
2007-05-21 16:43:13 +00:00
|
|
|
|
(setq type (if data-p
|
|
|
|
|
|
(image-type-from-data source)
|
|
|
|
|
|
(or (image-type-from-file-header source)
|
2019-09-28 23:26:02 +00:00
|
|
|
|
(image-type-from-file-name source)
|
|
|
|
|
|
(and convert-images-externally
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(require 'image-converter)
|
|
|
|
|
|
(image-convert-p source))))))
|
|
|
|
|
|
(unless type
|
|
|
|
|
|
(error "Cannot determine image type")))
|
|
|
|
|
|
(when (and (not (eq type 'image-convert))
|
|
|
|
|
|
(not (memq type (and (boundp 'image-types) image-types))))
|
|
|
|
|
|
(error "Invalid image type `%s'" type))
|
2006-04-21 20:56:06 +00:00
|
|
|
|
type)
|
|
|
|
|
|
|
2006-12-30 01:51:24 +00:00
|
|
|
|
|
2012-02-04 02:09:34 +00:00
|
|
|
|
(if (fboundp 'image-metadata) ; eg not --without-x
|
|
|
|
|
|
(define-obsolete-function-alias 'image-extension-data
|
2015-08-21 00:33:48 +00:00
|
|
|
|
'image-metadata "24.1"))
|
2012-02-04 02:09:34 +00:00
|
|
|
|
|
2010-10-13 14:50:06 +00:00
|
|
|
|
(define-obsolete-variable-alias
|
|
|
|
|
|
'image-library-alist
|
|
|
|
|
|
'dynamic-library-alist "24.1")
|
2008-06-12 03:56:20 +00:00
|
|
|
|
|
2006-04-21 20:56:06 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
|
(defun image-type-available-p (type)
|
|
|
|
|
|
"Return non-nil if image type TYPE is available.
|
|
|
|
|
|
Image types are symbols like `xbm' or `jpeg'."
|
|
|
|
|
|
(and (fboundp 'init-image-library)
|
2012-09-23 09:16:57 +00:00
|
|
|
|
(init-image-library type)))
|
2006-04-21 20:56:06 +00:00
|
|
|
|
|
|
|
|
|
|
|
2006-12-30 01:51:24 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
|
(defun image-type-auto-detected-p ()
|
2007-08-08 07:40:09 +00:00
|
|
|
|
"Return t if the current buffer contains an auto-detectable image.
|
2007-05-21 16:43:13 +00:00
|
|
|
|
This function is intended to be used from `magic-fallback-mode-alist'.
|
|
|
|
|
|
|
|
|
|
|
|
The buffer is considered to contain an auto-detectable image if
|
|
|
|
|
|
its beginning matches an image type in `image-type-header-regexps',
|
2007-09-27 06:38:29 +00:00
|
|
|
|
and that image type is present in `image-type-auto-detectable' with a
|
|
|
|
|
|
non-nil value. If that value is non-nil, but not t, then the image type
|
|
|
|
|
|
must be available."
|
2006-12-30 01:51:24 +00:00
|
|
|
|
(let* ((type (image-type-from-buffer))
|
|
|
|
|
|
(auto (and type (cdr (assq type image-type-auto-detectable)))))
|
2007-09-27 16:41:34 +00:00
|
|
|
|
(and auto
|
2007-05-21 16:43:13 +00:00
|
|
|
|
(or (eq auto t) (image-type-available-p type)))))
|
2006-12-30 01:51:24 +00:00
|
|
|
|
|
|
|
|
|
|
|
2006-04-21 20:56:06 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
|
(defun create-image (file-or-data &optional type data-p &rest props)
|
|
|
|
|
|
"Create an image.
|
|
|
|
|
|
FILE-OR-DATA is an image file name or image data.
|
2019-01-15 16:00:04 +00:00
|
|
|
|
|
2006-04-21 20:56:06 +00:00
|
|
|
|
Optional TYPE is a symbol describing the image type. If TYPE is omitted
|
|
|
|
|
|
or nil, try to determine the image type from its first few bytes
|
|
|
|
|
|
of image data. If that doesn't work, and FILE-OR-DATA is a file name,
|
|
|
|
|
|
use its file extension as image type.
|
2019-01-15 16:00:04 +00:00
|
|
|
|
|
2006-04-21 20:56:06 +00:00
|
|
|
|
Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
|
2019-01-15 16:00:04 +00:00
|
|
|
|
|
2006-04-21 20:56:06 +00:00
|
|
|
|
Optional PROPS are additional image attributes to assign to the image,
|
2019-01-15 16:00:04 +00:00
|
|
|
|
like, e.g. `:mask MASK'. If the property `:scale' is not given and the
|
|
|
|
|
|
display has a high resolution (more exactly, when the average width of a
|
|
|
|
|
|
character in the default font is more than 10 pixels), the image is
|
|
|
|
|
|
automatically scaled up in proportion to the default font.
|
|
|
|
|
|
|
2006-04-21 20:56:06 +00:00
|
|
|
|
Value is the image created, or nil if images of type TYPE are not supported.
|
|
|
|
|
|
|
2007-08-22 07:50:47 +00:00
|
|
|
|
Images should not be larger than specified by `max-image-size'.
|
|
|
|
|
|
|
|
|
|
|
|
Image file names that are not absolute are searched for in the
|
|
|
|
|
|
\"images\" sub-directory of `data-directory' and
|
|
|
|
|
|
`x-bitmap-file-path' (in that order)."
|
|
|
|
|
|
;; It is x_find_image_file in image.c that sets the search path.
|
2006-04-21 20:56:06 +00:00
|
|
|
|
(setq type (image-type file-or-data type data-p))
|
2019-09-28 23:26:02 +00:00
|
|
|
|
;; If we have external image conversion switched on (for exotic,
|
|
|
|
|
|
;; non-native image formats), then we convert the file.
|
|
|
|
|
|
(when (eq type 'image-convert)
|
|
|
|
|
|
(setq file-or-data (image-convert file-or-data)
|
|
|
|
|
|
type 'png
|
|
|
|
|
|
data-p t))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
(when (image-type-available-p type)
|
2000-01-01 16:33:32 +00:00
|
|
|
|
(append (list 'image :type type (if data-p :data :file) file-or-data)
|
2016-02-08 07:22:53 +00:00
|
|
|
|
(and (not (plist-get props :scale))
|
|
|
|
|
|
(list :scale
|
|
|
|
|
|
(image-compute-scaling-factor image-scaling-factor)))
|
2000-01-01 16:33:32 +00:00
|
|
|
|
props)))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
2016-02-22 01:50:40 +00:00
|
|
|
|
(defun image--set-property (image property value)
|
2016-02-20 06:54:05 +00:00
|
|
|
|
"Set PROPERTY in IMAGE to VALUE.
|
2016-02-22 01:50:40 +00:00
|
|
|
|
Internal use only."
|
2016-02-20 06:54:05 +00:00
|
|
|
|
(if (null value)
|
|
|
|
|
|
(while (cdr image)
|
|
|
|
|
|
;; IMAGE starts with the symbol `image', and the rest is a
|
|
|
|
|
|
;; plist. Decouple plist entries where the key matches
|
|
|
|
|
|
;; the property.
|
|
|
|
|
|
(if (eq (cadr image) property)
|
2019-04-17 13:24:31 +00:00
|
|
|
|
(setcdr image (cdddr image))
|
2016-02-20 06:54:05 +00:00
|
|
|
|
(setq image (cddr image))))
|
|
|
|
|
|
;; Just enter the new value.
|
2019-04-17 13:24:31 +00:00
|
|
|
|
(setcdr image (plist-put (cdr image) property value)))
|
2016-02-23 01:26:30 +00:00
|
|
|
|
value)
|
2016-02-20 06:54:05 +00:00
|
|
|
|
|
2016-02-22 01:50:40 +00:00
|
|
|
|
(defun image-property (image property)
|
|
|
|
|
|
"Return the value of PROPERTY in IMAGE.
|
|
|
|
|
|
Properties can be set with
|
|
|
|
|
|
|
|
|
|
|
|
(setf (image-property IMAGE PROPERTY) VALUE)
|
|
|
|
|
|
If VALUE is nil, PROPERTY is removed from IMAGE."
|
|
|
|
|
|
(declare (gv-setter image--set-property))
|
2016-02-20 06:54:05 +00:00
|
|
|
|
(plist-get (cdr image) property))
|
|
|
|
|
|
|
2016-02-08 07:22:53 +00:00
|
|
|
|
(defun image-compute-scaling-factor (scaling)
|
|
|
|
|
|
(cond
|
2016-05-23 19:12:24 +00:00
|
|
|
|
((numberp scaling) scaling)
|
|
|
|
|
|
((eq scaling 'auto)
|
2016-02-08 07:22:53 +00:00
|
|
|
|
(let ((width (/ (float (window-width nil t)) (window-width))))
|
|
|
|
|
|
;; If we assume that a typical character is 10 pixels in width,
|
|
|
|
|
|
;; then we should scale all images according to how wide they
|
|
|
|
|
|
;; are. But don't scale images down.
|
|
|
|
|
|
(if (< width 10)
|
|
|
|
|
|
1
|
|
|
|
|
|
(/ (float width) 10))))
|
|
|
|
|
|
(t
|
2016-05-23 19:12:24 +00:00
|
|
|
|
(error "Invalid scaling factor %s" scaling))))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2000-06-06 14:27:42 +00:00
|
|
|
|
(defun put-image (image pos &optional string area)
|
1999-09-09 14:54:25 +00:00
|
|
|
|
"Put image IMAGE in front of POS in the current buffer.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
IMAGE must be an image created with `create-image' or `defimage'.
|
1999-09-25 19:57:50 +00:00
|
|
|
|
IMAGE is displayed by putting an overlay into the current buffer with a
|
|
|
|
|
|
`before-string' STRING that has a `display' property whose value is the
|
2000-06-06 14:27:42 +00:00
|
|
|
|
image. STRING is defaulted if you omit it.
|
2011-07-17 15:57:47 +00:00
|
|
|
|
The overlay created will have the `put-image' property set to t.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
POS may be an integer or marker.
|
|
|
|
|
|
AREA is where to display the image. AREA nil or omitted means
|
|
|
|
|
|
display it in the text area, a value of `left-margin' means
|
|
|
|
|
|
display it in the left marginal area, a value of `right-margin'
|
1999-09-25 19:57:50 +00:00
|
|
|
|
means display it in the right marginal area."
|
2000-06-13 18:18:02 +00:00
|
|
|
|
(unless string (setq string "x"))
|
1999-09-09 14:54:25 +00:00
|
|
|
|
(let ((buffer (current-buffer)))
|
2000-06-06 14:27:42 +00:00
|
|
|
|
(unless (eq (car-safe image) 'image)
|
1999-09-09 14:54:25 +00:00
|
|
|
|
(error "Not an image: %s" image))
|
|
|
|
|
|
(unless (or (null area) (memq area '(left-margin right-margin)))
|
|
|
|
|
|
(error "Invalid area %s" area))
|
1999-09-25 19:57:50 +00:00
|
|
|
|
(setq string (copy-sequence string))
|
1999-09-09 14:54:25 +00:00
|
|
|
|
(let ((overlay (make-overlay pos pos buffer))
|
1999-09-25 19:57:50 +00:00
|
|
|
|
(prop (if (null area) image (list (list 'margin area) image))))
|
|
|
|
|
|
(put-text-property 0 (length string) 'display prop string)
|
1999-09-09 14:54:25 +00:00
|
|
|
|
(overlay-put overlay 'put-image t)
|
2012-04-10 02:34:57 +00:00
|
|
|
|
(overlay-put overlay 'before-string string)
|
2016-02-10 01:03:55 +00:00
|
|
|
|
(overlay-put overlay 'map image-map)
|
2012-04-10 02:34:57 +00:00
|
|
|
|
overlay)))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2004-04-20 22:23:08 +00:00
|
|
|
|
(defun insert-image (image &optional string area slice)
|
1999-07-21 21:43:52 +00:00
|
|
|
|
"Insert IMAGE into current buffer at point.
|
1999-09-25 19:57:50 +00:00
|
|
|
|
IMAGE is displayed by inserting STRING into the current buffer
|
2011-07-25 01:44:10 +00:00
|
|
|
|
with a `display' property whose value is the image. STRING
|
2012-11-18 01:43:32 +00:00
|
|
|
|
defaults to a single space if you omit it.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
AREA is where to display the image. AREA nil or omitted means
|
|
|
|
|
|
display it in the text area, a value of `left-margin' means
|
|
|
|
|
|
display it in the left marginal area, a value of `right-margin'
|
2004-04-20 22:23:08 +00:00
|
|
|
|
means display it in the right marginal area.
|
|
|
|
|
|
SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
|
|
|
|
|
|
means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
|
|
|
|
|
|
specifying the X and Y positions and WIDTH and HEIGHT of image area
|
|
|
|
|
|
to insert. A float value 0.0 - 1.0 means relative to the width or
|
|
|
|
|
|
height of the image; integer values are taken as pixel values."
|
2000-06-13 18:18:02 +00:00
|
|
|
|
;; Use a space as least likely to cause trouble when it's a hidden
|
|
|
|
|
|
;; character in the buffer.
|
|
|
|
|
|
(unless string (setq string " "))
|
2000-06-06 14:27:42 +00:00
|
|
|
|
(unless (eq (car-safe image) 'image)
|
1999-07-21 21:43:52 +00:00
|
|
|
|
(error "Not an image: %s" image))
|
|
|
|
|
|
(unless (or (null area) (memq area '(left-margin right-margin)))
|
|
|
|
|
|
(error "Invalid area %s" area))
|
2000-06-12 20:36:40 +00:00
|
|
|
|
(if area
|
|
|
|
|
|
(setq image (list (list 'margin area) image))
|
|
|
|
|
|
;; Cons up a new spec equal but not eq to `image' so that
|
|
|
|
|
|
;; inserting it twice in a row (adjacently) displays two copies of
|
|
|
|
|
|
;; the image. Don't try to avoid this by looking at the display
|
|
|
|
|
|
;; properties on either side so that we DTRT more often with
|
|
|
|
|
|
;; cut-and-paste. (Yanking killed image text next to another copy
|
|
|
|
|
|
;; of it loses anyway.)
|
|
|
|
|
|
(setq image (cons 'image (cdr image))))
|
1999-09-25 19:57:50 +00:00
|
|
|
|
(let ((start (point)))
|
|
|
|
|
|
(insert string)
|
|
|
|
|
|
(add-text-properties start (point)
|
2004-04-20 22:23:08 +00:00
|
|
|
|
`(display ,(if slice
|
|
|
|
|
|
(list (cons 'slice slice) image)
|
2016-02-10 01:03:55 +00:00
|
|
|
|
image)
|
2019-07-28 20:48:18 +00:00
|
|
|
|
rear-nonsticky t
|
2016-02-10 01:03:55 +00:00
|
|
|
|
keymap ,image-map))))
|
2004-04-20 22:23:08 +00:00
|
|
|
|
|
|
|
|
|
|
|
2005-03-17 23:56:15 +00:00
|
|
|
|
;;;###autoload
|
2004-04-20 22:23:08 +00:00
|
|
|
|
(defun insert-sliced-image (image &optional string area rows cols)
|
2004-09-22 23:12:38 +00:00
|
|
|
|
"Insert IMAGE into current buffer at point.
|
|
|
|
|
|
IMAGE is displayed by inserting STRING into the current buffer
|
2012-11-18 01:43:32 +00:00
|
|
|
|
with a `display' property whose value is the image. The default
|
|
|
|
|
|
STRING is a single space.
|
2004-09-22 23:12:38 +00:00
|
|
|
|
AREA is where to display the image. AREA nil or omitted means
|
|
|
|
|
|
display it in the text area, a value of `left-margin' means
|
|
|
|
|
|
display it in the left marginal area, a value of `right-margin'
|
|
|
|
|
|
means display it in the right marginal area.
|
2009-02-24 10:28:57 +00:00
|
|
|
|
The image is automatically split into ROWS x COLS slices."
|
2004-04-20 22:23:08 +00:00
|
|
|
|
(unless string (setq string " "))
|
|
|
|
|
|
(unless (eq (car-safe image) 'image)
|
|
|
|
|
|
(error "Not an image: %s" image))
|
|
|
|
|
|
(unless (or (null area) (memq area '(left-margin right-margin)))
|
|
|
|
|
|
(error "Invalid area %s" area))
|
|
|
|
|
|
(if area
|
|
|
|
|
|
(setq image (list (list 'margin area) image))
|
|
|
|
|
|
;; Cons up a new spec equal but not eq to `image' so that
|
|
|
|
|
|
;; inserting it twice in a row (adjacently) displays two copies of
|
|
|
|
|
|
;; the image. Don't try to avoid this by looking at the display
|
|
|
|
|
|
;; properties on either side so that we DTRT more often with
|
|
|
|
|
|
;; cut-and-paste. (Yanking killed image text next to another copy
|
|
|
|
|
|
;; of it loses anyway.)
|
|
|
|
|
|
(setq image (cons 'image (cdr image))))
|
|
|
|
|
|
(let ((x 0.0) (dx (/ 1.0001 (or cols 1)))
|
|
|
|
|
|
(y 0.0) (dy (/ 1.0001 (or rows 1))))
|
|
|
|
|
|
(while (< y 1.0)
|
|
|
|
|
|
(while (< x 1.0)
|
|
|
|
|
|
(let ((start (point)))
|
|
|
|
|
|
(insert string)
|
|
|
|
|
|
(add-text-properties start (point)
|
|
|
|
|
|
`(display ,(list (list 'slice x y dx dy) image)
|
2016-02-10 01:03:55 +00:00
|
|
|
|
rear-nonsticky (display)
|
|
|
|
|
|
keymap ,image-map))
|
2004-04-20 22:23:08 +00:00
|
|
|
|
(setq x (+ x dx))))
|
|
|
|
|
|
(setq x 0.0
|
|
|
|
|
|
y (+ y dy))
|
2005-01-01 13:08:33 +00:00
|
|
|
|
(insert (propertize "\n" 'line-height t)))))
|
2004-04-20 22:23:08 +00:00
|
|
|
|
|
1999-10-13 17:38:18 +00:00
|
|
|
|
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
|
(defun remove-images (start end &optional buffer)
|
|
|
|
|
|
"Remove images between START and END in BUFFER.
|
|
|
|
|
|
Remove only images that were put in BUFFER with calls to `put-image'.
|
|
|
|
|
|
BUFFER nil or omitted means use the current buffer."
|
|
|
|
|
|
(unless buffer
|
|
|
|
|
|
(setq buffer (current-buffer)))
|
|
|
|
|
|
(let ((overlays (overlays-in start end)))
|
|
|
|
|
|
(while overlays
|
|
|
|
|
|
(let ((overlay (car overlays)))
|
|
|
|
|
|
(when (overlay-get overlay 'put-image)
|
1999-10-03 19:25:32 +00:00
|
|
|
|
(delete-overlay overlay)))
|
|
|
|
|
|
(setq overlays (cdr overlays)))))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(defun image-search-load-path (file &optional path)
|
|
|
|
|
|
(unless path
|
|
|
|
|
|
(setq path image-load-path))
|
|
|
|
|
|
(let (element found filename)
|
2005-09-15 14:00:09 +00:00
|
|
|
|
(while (and (not found) (consp path))
|
2005-09-18 14:04:46 +00:00
|
|
|
|
(setq element (car path))
|
2005-09-15 14:00:09 +00:00
|
|
|
|
(cond
|
2005-09-18 14:04:46 +00:00
|
|
|
|
((stringp element)
|
2005-09-15 14:00:09 +00:00
|
|
|
|
(setq found
|
|
|
|
|
|
(file-readable-p
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(setq filename (expand-file-name file element)))))
|
2005-09-18 14:04:46 +00:00
|
|
|
|
((and (symbolp element) (boundp element))
|
|
|
|
|
|
(setq element (symbol-value element))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((stringp element)
|
|
|
|
|
|
(setq found
|
|
|
|
|
|
(file-readable-p
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(setq filename (expand-file-name file element)))))
|
2005-09-18 14:04:46 +00:00
|
|
|
|
((consp element)
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(if (setq filename (image-search-load-path file element))
|
2005-09-18 14:04:46 +00:00
|
|
|
|
(setq found t))))))
|
2005-09-15 14:00:09 +00:00
|
|
|
|
(setq path (cdr path)))
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(if found filename)))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2000-04-26 17:34:09 +00:00
|
|
|
|
(defun find-image (specs)
|
|
|
|
|
|
"Find an image, choosing one of a list of image specifications.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
2000-06-06 14:27:42 +00:00
|
|
|
|
SPECS is a list of image specifications.
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
|
|
|
|
|
Each image specification in SPECS is a property list. The contents of
|
|
|
|
|
|
a specification are image type dependent. All specifications must at
|
1999-12-31 15:54:44 +00:00
|
|
|
|
least contain the properties `:type TYPE' and either `:file FILE' or
|
|
|
|
|
|
`:data DATA', where TYPE is a symbol specifying the image type,
|
|
|
|
|
|
e.g. `xbm', FILE is the file to load the image from, and DATA is a
|
2000-06-06 14:27:42 +00:00
|
|
|
|
string containing the actual image data. The specification whose TYPE
|
|
|
|
|
|
is supported, and FILE exists, is used to construct the image
|
|
|
|
|
|
specification to be returned. Return nil if no specification is
|
|
|
|
|
|
satisfied.
|
|
|
|
|
|
|
2005-10-19 03:55:20 +00:00
|
|
|
|
The image is looked for in `image-load-path'.
|
|
|
|
|
|
|
|
|
|
|
|
Image files should not be larger than specified by `max-image-size'."
|
1999-07-21 21:43:52 +00:00
|
|
|
|
(let (image)
|
|
|
|
|
|
(while (and specs (null image))
|
|
|
|
|
|
(let* ((spec (car specs))
|
|
|
|
|
|
(type (plist-get spec :type))
|
2000-01-01 16:33:32 +00:00
|
|
|
|
(data (plist-get spec :data))
|
2000-03-01 12:47:15 +00:00
|
|
|
|
(file (plist-get spec :file))
|
|
|
|
|
|
found)
|
2000-01-01 16:33:32 +00:00
|
|
|
|
(when (image-type-available-p type)
|
|
|
|
|
|
(cond ((stringp file)
|
2005-10-21 23:42:21 +00:00
|
|
|
|
(if (setq found (image-search-load-path file))
|
2005-09-15 14:00:09 +00:00
|
|
|
|
(setq image
|
|
|
|
|
|
(cons 'image (plist-put (copy-sequence spec)
|
|
|
|
|
|
:file found)))))
|
2000-01-01 16:42:20 +00:00
|
|
|
|
((not (null data))
|
2000-01-01 16:33:32 +00:00
|
|
|
|
(setq image (cons 'image spec)))))
|
|
|
|
|
|
(setq specs (cdr specs))))
|
2000-04-26 17:34:09 +00:00
|
|
|
|
image))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
|
(defmacro defimage (symbol specs &optional doc)
|
2013-10-27 22:53:48 +00:00
|
|
|
|
"Define SYMBOL as an image, and return SYMBOL.
|
2000-04-26 17:34:09 +00:00
|
|
|
|
|
|
|
|
|
|
SPECS is a list of image specifications. DOC is an optional
|
|
|
|
|
|
documentation string.
|
|
|
|
|
|
|
|
|
|
|
|
Each image specification in SPECS is a property list. The contents of
|
|
|
|
|
|
a specification are image type dependent. All specifications must at
|
|
|
|
|
|
least contain the properties `:type TYPE' and either `:file FILE' or
|
|
|
|
|
|
`:data DATA', where TYPE is a symbol specifying the image type,
|
|
|
|
|
|
e.g. `xbm', FILE is the file to load the image from, and DATA is a
|
|
|
|
|
|
string containing the actual image data. The first image
|
|
|
|
|
|
specification whose TYPE is supported, and FILE exists, is used to
|
|
|
|
|
|
define SYMBOL.
|
|
|
|
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
|
|
|
|
|
|
|
(defimage test-image ((:type xpm :file \"~/test1.xpm\")
|
|
|
|
|
|
(:type xbm :file \"~/test1.xbm\")))"
|
2005-10-24 16:43:03 +00:00
|
|
|
|
(declare (doc-string 3))
|
2000-04-26 17:34:09 +00:00
|
|
|
|
`(defvar ,symbol (find-image ',specs) ,doc))
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
2010-03-07 19:02:20 +00:00
|
|
|
|
|
|
|
|
|
|
;;; Animated image API
|
1999-07-21 21:43:52 +00:00
|
|
|
|
|
2013-02-16 03:39:12 +00:00
|
|
|
|
(defvar image-default-frame-delay 0.1
|
|
|
|
|
|
"Default interval in seconds between frames of a multi-frame image.
|
|
|
|
|
|
Only used if the image does not specify a value.")
|
|
|
|
|
|
|
2013-02-16 19:56:50 +00:00
|
|
|
|
(defun image-multi-frame-p (image)
|
|
|
|
|
|
"Return non-nil if IMAGE contains more than one frame.
|
|
|
|
|
|
The actual return value is a cons (NIMAGES . DELAY), where NIMAGES is
|
|
|
|
|
|
the number of frames (or sub-images) in the image and DELAY is the delay
|
|
|
|
|
|
in seconds that the image specifies between each frame. DELAY may be nil,
|
|
|
|
|
|
in which case you might want to use `image-default-frame-delay'."
|
2013-09-18 04:26:19 +00:00
|
|
|
|
(when (fboundp 'image-metadata)
|
|
|
|
|
|
(let* ((metadata (image-metadata image))
|
|
|
|
|
|
(images (plist-get metadata 'count))
|
|
|
|
|
|
(delay (plist-get metadata 'delay)))
|
|
|
|
|
|
(when (and images (> images 1))
|
2014-09-14 23:59:57 +00:00
|
|
|
|
(and delay (or (not (numberp delay)) (< delay 0))
|
|
|
|
|
|
(setq delay image-default-frame-delay))
|
2013-09-18 04:26:19 +00:00
|
|
|
|
(cons images delay)))))
|
2013-02-16 19:56:50 +00:00
|
|
|
|
|
2013-05-30 03:24:30 +00:00
|
|
|
|
(defun image-animated-p (image)
|
|
|
|
|
|
"Like `image-multi-frame-p', but returns nil if no delay is specified."
|
|
|
|
|
|
(let ((multi (image-multi-frame-p image)))
|
|
|
|
|
|
(and (cdr multi) multi)))
|
|
|
|
|
|
|
|
|
|
|
|
(make-obsolete 'image-animated-p 'image-multi-frame-p "24.4")
|
2010-03-07 19:02:20 +00:00
|
|
|
|
|
2012-02-03 08:44:30 +00:00
|
|
|
|
;; "Destructively"?
|
2011-06-07 18:32:12 +00:00
|
|
|
|
(defun image-animate (image &optional index limit)
|
|
|
|
|
|
"Start animating IMAGE.
|
|
|
|
|
|
Animation occurs by destructively altering the IMAGE spec list.
|
|
|
|
|
|
|
|
|
|
|
|
With optional INDEX, begin animating from that animation frame.
|
|
|
|
|
|
LIMIT specifies how long to animate the image. If omitted or
|
|
|
|
|
|
nil, play the animation until the end. If t, loop forever. If a
|
|
|
|
|
|
number, play until that number of seconds has elapsed."
|
2013-02-16 19:56:50 +00:00
|
|
|
|
(let ((animation (image-multi-frame-p image))
|
2011-06-11 23:03:16 +00:00
|
|
|
|
timer)
|
|
|
|
|
|
(when animation
|
2011-06-07 18:32:12 +00:00
|
|
|
|
(if (setq timer (image-animate-timer image))
|
|
|
|
|
|
(cancel-timer timer))
|
2014-02-25 21:59:14 +00:00
|
|
|
|
(plist-put (cdr image) :animate-buffer (current-buffer))
|
2016-05-23 19:12:24 +00:00
|
|
|
|
(run-with-timer 0.2 nil #'image-animate-timeout
|
2011-06-11 23:03:16 +00:00
|
|
|
|
image (or index 0) (car animation)
|
2016-05-03 23:37:01 +00:00
|
|
|
|
0 limit (+ (float-time) 0.2)))))
|
2010-03-07 19:02:20 +00:00
|
|
|
|
|
|
|
|
|
|
(defun image-animate-timer (image)
|
|
|
|
|
|
"Return the animation timer for image IMAGE."
|
|
|
|
|
|
;; See cancel-function-timers
|
|
|
|
|
|
(let ((tail timer-list) timer)
|
|
|
|
|
|
(while tail
|
|
|
|
|
|
(setq timer (car tail)
|
|
|
|
|
|
tail (cdr tail))
|
2016-05-23 19:12:24 +00:00
|
|
|
|
(if (and (eq (timer--function timer) #'image-animate-timeout)
|
2012-09-13 06:09:45 +00:00
|
|
|
|
(eq (car-safe (timer--args timer)) image))
|
2010-03-07 19:02:20 +00:00
|
|
|
|
(setq tail nil)
|
|
|
|
|
|
(setq timer nil)))
|
|
|
|
|
|
timer))
|
|
|
|
|
|
|
2013-02-16 03:39:12 +00:00
|
|
|
|
(defconst image-minimum-frame-delay 0.01
|
|
|
|
|
|
"Minimum interval in seconds between frames of an animated image.")
|
|
|
|
|
|
|
2013-02-20 07:57:33 +00:00
|
|
|
|
(defun image-current-frame (image)
|
|
|
|
|
|
"The current frame number of IMAGE, indexed from 0."
|
|
|
|
|
|
(or (plist-get (cdr image) :index) 0))
|
2013-02-16 01:58:20 +00:00
|
|
|
|
|
2013-02-20 07:57:33 +00:00
|
|
|
|
(defun image-show-frame (image n &optional nocheck)
|
2013-02-16 03:29:39 +00:00
|
|
|
|
"Show frame N of IMAGE.
|
|
|
|
|
|
Frames are indexed from 0. Optional argument NOCHECK non-nil means
|
|
|
|
|
|
do not check N is within the range of frames present in the image."
|
|
|
|
|
|
(unless nocheck
|
|
|
|
|
|
(if (< n 0) (setq n 0)
|
2013-02-16 19:56:50 +00:00
|
|
|
|
(setq n (min n (1- (car (image-multi-frame-p image)))))))
|
2013-02-16 03:29:39 +00:00
|
|
|
|
(plist-put (cdr image) :index n)
|
|
|
|
|
|
(force-window-update))
|
|
|
|
|
|
|
2013-08-16 06:33:08 +00:00
|
|
|
|
(defun image-animate-get-speed (image)
|
|
|
|
|
|
"Return the speed factor for animating IMAGE."
|
|
|
|
|
|
(or (plist-get (cdr image) :speed) 1))
|
|
|
|
|
|
|
|
|
|
|
|
(defun image-animate-set-speed (image value &optional multiply)
|
|
|
|
|
|
"Set the speed factor for animating IMAGE to VALUE.
|
|
|
|
|
|
With optional argument MULTIPLY non-nil, treat VALUE as a
|
|
|
|
|
|
multiplication factor for the current value."
|
|
|
|
|
|
(plist-put (cdr image) :speed
|
|
|
|
|
|
(if multiply
|
|
|
|
|
|
(* value (image-animate-get-speed image))
|
|
|
|
|
|
value)))
|
|
|
|
|
|
|
2012-02-03 08:44:30 +00:00
|
|
|
|
;; FIXME? The delay may not be the same for different sub-images,
|
2013-02-16 19:56:50 +00:00
|
|
|
|
;; hence we need to call image-multi-frame-p to return it.
|
2012-02-03 08:44:30 +00:00
|
|
|
|
;; But it also returns count, so why do we bother passing that as an
|
|
|
|
|
|
;; argument?
|
2016-05-03 23:37:01 +00:00
|
|
|
|
(defun image-animate-timeout (image n count time-elapsed limit target-time)
|
2011-05-29 21:35:35 +00:00
|
|
|
|
"Display animation frame N of IMAGE.
|
|
|
|
|
|
N=0 refers to the initial animation frame.
|
|
|
|
|
|
COUNT is the total number of frames in the animation.
|
|
|
|
|
|
TIME-ELAPSED is the total time that has elapsed since
|
|
|
|
|
|
`image-animate-start' was called.
|
2011-06-07 18:32:12 +00:00
|
|
|
|
LIMIT determines when to stop. If t, loop forever. If nil, stop
|
2011-05-29 21:35:35 +00:00
|
|
|
|
after displaying the last animation frame. Otherwise, stop
|
2012-02-03 08:44:30 +00:00
|
|
|
|
after LIMIT seconds have elapsed.
|
2013-08-16 06:33:08 +00:00
|
|
|
|
The minimum delay between successive frames is `image-minimum-frame-delay'.
|
|
|
|
|
|
|
|
|
|
|
|
If the image has a non-nil :speed property, it acts as a multiplier
|
|
|
|
|
|
for the animation speed. A negative value means to animate in reverse."
|
2016-05-03 23:37:01 +00:00
|
|
|
|
(when (and (buffer-live-p (plist-get (cdr image) :animate-buffer))
|
|
|
|
|
|
;; Delayed more than two seconds more than expected.
|
Avoid some double-rounding of Lisp timestamps
Also, simplify some time-related Lisp timestamp code
while we’re in the neighborhood.
* lisp/battery.el (battery-linux-proc-acpi)
(battery-linux-sysfs, battery-upower, battery-bsd-apm):
* lisp/calendar/timeclock.el (timeclock-seconds-to-string)
(timeclock-log, timeclock-last-period)
(timeclock-entry-length, timeclock-entry-list-span)
(timeclock-find-discrep, timeclock-generate-report):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/completion.el (cmpl-hours-since-origin):
* lisp/ecomplete.el (ecomplete-decay-1):
* lisp/emacs-lisp/ert.el (ert--results-update-stats-display)
(ert--results-update-stats-display-maybe):
* lisp/emacs-lisp/timer-list.el (list-timers):
* lisp/emacs-lisp/timer.el (timer-until)
(timer-event-handler):
* lisp/erc/erc-backend.el (erc-server-send-ping)
(erc-server-send-queue, erc-handle-parsed-server-response)
(erc-handle-unknown-server-response):
* lisp/erc/erc-track.el (erc-buffer-visible):
* lisp/erc/erc.el (erc-lurker-cleanup, erc-lurker-p)
(erc-cmd-PING, erc-send-current-line):
* lisp/eshell/em-pred.el (eshell-pred-file-time):
* lisp/eshell/em-unix.el (eshell-show-elapsed-time):
* lisp/gnus/gnus-icalendar.el (gnus-icalendar-event:org-timestamp):
* lisp/gnus/gnus-int.el (gnus-backend-trace):
* lisp/gnus/gnus-sum.el (gnus-user-date):
* lisp/gnus/mail-source.el (mail-source-delete-crash-box):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/ibuf-ext.el (ibuffer-mark-old-buffers):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/mouse.el (mouse--down-1-maybe-follows-link)
(mouse--click-1-maybe-follows-link):
* lisp/mpc.el (mpc--faster-toggle):
* lisp/net/rcirc.el (rcirc-handler-ctcp-KEEPALIVE)
(rcirc-sentinel):
* lisp/net/tramp-cache.el (tramp-get-file-property):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-newer-than-file-p)
(tramp-maybe-open-connection):
* lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection):
* lisp/org/org-clock.el (org-clock-resolve):
(org-resolve-clocks, org-clock-in, org-clock-out, org-clock-sum):
* lisp/org/org-timer.el (org-timer-start)
(org-timer-pause-or-continue, org-timer-seconds):
* lisp/org/org.el (org-evaluate-time-range):
* lisp/org/ox-publish.el (org-publish-cache-ctime-of-src):
* lisp/pixel-scroll.el (pixel-scroll-in-rush-p):
* lisp/play/hanoi.el (hanoi-move-ring):
* lisp/proced.el (proced-format-time):
* lisp/progmodes/cpp.el (cpp-progress-message):
* lisp/progmodes/flymake.el (flymake--handle-report):
* lisp/progmodes/js.el (js--wait-for-matching-output):
* lisp/subr.el (progress-reporter-do-update):
* lisp/term/xterm.el (xterm--read-event-for-query):
* lisp/time.el (display-time-update, emacs-uptime):
* lisp/tooltip.el (tooltip-delay):
* lisp/url/url-cookie.el (url-cookie-parse-file-netscape):
* lisp/url/url-queue.el (url-queue-prune-old-entries):
* lisp/url/url.el (url-retrieve-synchronously):
* lisp/xt-mouse.el (xterm-mouse-event):
Avoid double-rounding of time-related values. Simplify.
* lisp/calendar/icalendar.el (icalendar--decode-isodatetime):
When hoping for the best (unlikely), use a better decoded time.
(icalendar--convert-sexp-to-ical): Avoid unnecessary encode-time.
* lisp/calendar/timeclock.el (timeclock-when-to-leave):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/desktop.el (desktop-create-buffer):
* lisp/emacs-lisp/benchmark.el (benchmark-elapse):
* lisp/gnus/gnus-art.el (article-lapsed-string):
* lisp/gnus/gnus-group.el (gnus-group-timestamp-delta):
* lisp/gnus/nnmail.el (nnmail-expired-article-p):
* lisp/gnus/nnmaildir.el (nnmaildir-request-expire-articles):
* lisp/nxml/rng-maint.el (rng-time-function):
* lisp/org/org-clock.el (org-clock-get-clocked-time)
(org-clock-resolve, org-resolve-clocks, org-resolve-clocks-if-idle):
* lisp/org/org-habit.el (org-habit-insert-consistency-graphs):
* lisp/progmodes/vhdl-mode.el (vhdl-update-progress-info)
(vhdl-fix-case-region-1):
Use time-since instead of open-coding most of it.
* lisp/erc/erc-dcc.el (erc-dcc-get-sentinel):
* lisp/erc/erc.el (erc-string-to-emacs-time, erc-time-gt):
Now obsolete. All uses changed.
(erc-time-diff): Accept all Lisp time values.
All uses changed.
* lisp/gnus/gnus-demon.el (gnus-demon-idle-since):
* lisp/gnus/gnus-score.el (gnus-score-headers):
* lisp/gnus/nneething.el (nneething-make-head):
* lisp/gnus/nnheader.el (nnheader-message-maybe):
* lisp/gnus/nnimap.el (nnimap-keepalive):
* lisp/image.el (image-animate-timeout):
* lisp/mail/feedmail.el (feedmail-rfc822-date):
* lisp/net/imap.el (imap-wait-for-tag):
* lisp/net/newst-backend.el (newsticker--image-get):
* lisp/net/rcirc.el (rcirc-handler-317, rcirc-handler-333):
* lisp/obsolete/xesam.el (xesam-refresh-entry):
* lisp/org/org-agenda.el (org-agenda-show-clocking-issues)
(org-agenda-check-clock-gap, org-agenda-to-appt):
* lisp/org/org-capture.el (org-capture-set-target-location):
* lisp/org/org-clock.el (org-clock-resolve-clock)
(org-clocktable-steps):
* lisp/org/org-colview.el (org-columns-edit-value)
(org-columns, org-agenda-columns):
* lisp/org/org-duration.el (org-duration-from-minutes):
* lisp/org/org-element.el (org-element-cache-sync-duration)
(org-element-cache-sync-break)
(org-element--cache-interrupt-p, org-element--cache-sync):
* lisp/org/org-habit.el (org-habit-get-faces)
* lisp/org/org-indent.el (org-indent-add-properties):
* lisp/org/org-table.el (org-table-sum):
* lisp/org/org-timer.el (org-timer-show-remaining-time)
(org-timer-set-timer):
* lisp/org/org.el (org-babel-load-file, org-today)
(org-auto-repeat-maybe, org-2ft, org-time-stamp)
(org-read-date-analyze, org-time-stamp-to-now)
(org-small-year-to-year, org-goto-calendar):
* lisp/org/ox.el (org-export-insert-default-template):
* lisp/ses.el (ses--time-check):
* lisp/type-break.el (type-break-time-warning)
(type-break-statistics, type-break-demo-boring):
* lisp/url/url-cache.el (url-cache-expired)
(url-cache-prune-cache):
* lisp/vc/vc-git.el (vc-git-stash-snapshot):
* lisp/erc/erc-match.el (erc-log-matches-come-back):
Simplify.
2019-02-23 02:32:31 +00:00
|
|
|
|
(or (time-less-p (time-since target-time) 2)
|
2016-07-19 07:34:54 +00:00
|
|
|
|
(progn
|
|
|
|
|
|
(message "Stopping animation; animation possibly too big")
|
|
|
|
|
|
nil)))
|
2014-02-25 21:59:14 +00:00
|
|
|
|
(image-show-frame image n t)
|
|
|
|
|
|
(let* ((speed (image-animate-get-speed image))
|
Avoid some double-rounding of Lisp timestamps
Also, simplify some time-related Lisp timestamp code
while we’re in the neighborhood.
* lisp/battery.el (battery-linux-proc-acpi)
(battery-linux-sysfs, battery-upower, battery-bsd-apm):
* lisp/calendar/timeclock.el (timeclock-seconds-to-string)
(timeclock-log, timeclock-last-period)
(timeclock-entry-length, timeclock-entry-list-span)
(timeclock-find-discrep, timeclock-generate-report):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/completion.el (cmpl-hours-since-origin):
* lisp/ecomplete.el (ecomplete-decay-1):
* lisp/emacs-lisp/ert.el (ert--results-update-stats-display)
(ert--results-update-stats-display-maybe):
* lisp/emacs-lisp/timer-list.el (list-timers):
* lisp/emacs-lisp/timer.el (timer-until)
(timer-event-handler):
* lisp/erc/erc-backend.el (erc-server-send-ping)
(erc-server-send-queue, erc-handle-parsed-server-response)
(erc-handle-unknown-server-response):
* lisp/erc/erc-track.el (erc-buffer-visible):
* lisp/erc/erc.el (erc-lurker-cleanup, erc-lurker-p)
(erc-cmd-PING, erc-send-current-line):
* lisp/eshell/em-pred.el (eshell-pred-file-time):
* lisp/eshell/em-unix.el (eshell-show-elapsed-time):
* lisp/gnus/gnus-icalendar.el (gnus-icalendar-event:org-timestamp):
* lisp/gnus/gnus-int.el (gnus-backend-trace):
* lisp/gnus/gnus-sum.el (gnus-user-date):
* lisp/gnus/mail-source.el (mail-source-delete-crash-box):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/ibuf-ext.el (ibuffer-mark-old-buffers):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/mouse.el (mouse--down-1-maybe-follows-link)
(mouse--click-1-maybe-follows-link):
* lisp/mpc.el (mpc--faster-toggle):
* lisp/net/rcirc.el (rcirc-handler-ctcp-KEEPALIVE)
(rcirc-sentinel):
* lisp/net/tramp-cache.el (tramp-get-file-property):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-newer-than-file-p)
(tramp-maybe-open-connection):
* lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection):
* lisp/org/org-clock.el (org-clock-resolve):
(org-resolve-clocks, org-clock-in, org-clock-out, org-clock-sum):
* lisp/org/org-timer.el (org-timer-start)
(org-timer-pause-or-continue, org-timer-seconds):
* lisp/org/org.el (org-evaluate-time-range):
* lisp/org/ox-publish.el (org-publish-cache-ctime-of-src):
* lisp/pixel-scroll.el (pixel-scroll-in-rush-p):
* lisp/play/hanoi.el (hanoi-move-ring):
* lisp/proced.el (proced-format-time):
* lisp/progmodes/cpp.el (cpp-progress-message):
* lisp/progmodes/flymake.el (flymake--handle-report):
* lisp/progmodes/js.el (js--wait-for-matching-output):
* lisp/subr.el (progress-reporter-do-update):
* lisp/term/xterm.el (xterm--read-event-for-query):
* lisp/time.el (display-time-update, emacs-uptime):
* lisp/tooltip.el (tooltip-delay):
* lisp/url/url-cookie.el (url-cookie-parse-file-netscape):
* lisp/url/url-queue.el (url-queue-prune-old-entries):
* lisp/url/url.el (url-retrieve-synchronously):
* lisp/xt-mouse.el (xterm-mouse-event):
Avoid double-rounding of time-related values. Simplify.
* lisp/calendar/icalendar.el (icalendar--decode-isodatetime):
When hoping for the best (unlikely), use a better decoded time.
(icalendar--convert-sexp-to-ical): Avoid unnecessary encode-time.
* lisp/calendar/timeclock.el (timeclock-when-to-leave):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/desktop.el (desktop-create-buffer):
* lisp/emacs-lisp/benchmark.el (benchmark-elapse):
* lisp/gnus/gnus-art.el (article-lapsed-string):
* lisp/gnus/gnus-group.el (gnus-group-timestamp-delta):
* lisp/gnus/nnmail.el (nnmail-expired-article-p):
* lisp/gnus/nnmaildir.el (nnmaildir-request-expire-articles):
* lisp/nxml/rng-maint.el (rng-time-function):
* lisp/org/org-clock.el (org-clock-get-clocked-time)
(org-clock-resolve, org-resolve-clocks, org-resolve-clocks-if-idle):
* lisp/org/org-habit.el (org-habit-insert-consistency-graphs):
* lisp/progmodes/vhdl-mode.el (vhdl-update-progress-info)
(vhdl-fix-case-region-1):
Use time-since instead of open-coding most of it.
* lisp/erc/erc-dcc.el (erc-dcc-get-sentinel):
* lisp/erc/erc.el (erc-string-to-emacs-time, erc-time-gt):
Now obsolete. All uses changed.
(erc-time-diff): Accept all Lisp time values.
All uses changed.
* lisp/gnus/gnus-demon.el (gnus-demon-idle-since):
* lisp/gnus/gnus-score.el (gnus-score-headers):
* lisp/gnus/nneething.el (nneething-make-head):
* lisp/gnus/nnheader.el (nnheader-message-maybe):
* lisp/gnus/nnimap.el (nnimap-keepalive):
* lisp/image.el (image-animate-timeout):
* lisp/mail/feedmail.el (feedmail-rfc822-date):
* lisp/net/imap.el (imap-wait-for-tag):
* lisp/net/newst-backend.el (newsticker--image-get):
* lisp/net/rcirc.el (rcirc-handler-317, rcirc-handler-333):
* lisp/obsolete/xesam.el (xesam-refresh-entry):
* lisp/org/org-agenda.el (org-agenda-show-clocking-issues)
(org-agenda-check-clock-gap, org-agenda-to-appt):
* lisp/org/org-capture.el (org-capture-set-target-location):
* lisp/org/org-clock.el (org-clock-resolve-clock)
(org-clocktable-steps):
* lisp/org/org-colview.el (org-columns-edit-value)
(org-columns, org-agenda-columns):
* lisp/org/org-duration.el (org-duration-from-minutes):
* lisp/org/org-element.el (org-element-cache-sync-duration)
(org-element-cache-sync-break)
(org-element--cache-interrupt-p, org-element--cache-sync):
* lisp/org/org-habit.el (org-habit-get-faces)
* lisp/org/org-indent.el (org-indent-add-properties):
* lisp/org/org-table.el (org-table-sum):
* lisp/org/org-timer.el (org-timer-show-remaining-time)
(org-timer-set-timer):
* lisp/org/org.el (org-babel-load-file, org-today)
(org-auto-repeat-maybe, org-2ft, org-time-stamp)
(org-read-date-analyze, org-time-stamp-to-now)
(org-small-year-to-year, org-goto-calendar):
* lisp/org/ox.el (org-export-insert-default-template):
* lisp/ses.el (ses--time-check):
* lisp/type-break.el (type-break-time-warning)
(type-break-statistics, type-break-demo-boring):
* lisp/url/url-cache.el (url-cache-expired)
(url-cache-prune-cache):
* lisp/vc/vc-git.el (vc-git-stash-snapshot):
* lisp/erc/erc-match.el (erc-log-matches-come-back):
Simplify.
2019-02-23 02:32:31 +00:00
|
|
|
|
(time (current-time))
|
2014-02-25 21:59:14 +00:00
|
|
|
|
(animation (image-multi-frame-p image))
|
Avoid some double-rounding of Lisp timestamps
Also, simplify some time-related Lisp timestamp code
while we’re in the neighborhood.
* lisp/battery.el (battery-linux-proc-acpi)
(battery-linux-sysfs, battery-upower, battery-bsd-apm):
* lisp/calendar/timeclock.el (timeclock-seconds-to-string)
(timeclock-log, timeclock-last-period)
(timeclock-entry-length, timeclock-entry-list-span)
(timeclock-find-discrep, timeclock-generate-report):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/completion.el (cmpl-hours-since-origin):
* lisp/ecomplete.el (ecomplete-decay-1):
* lisp/emacs-lisp/ert.el (ert--results-update-stats-display)
(ert--results-update-stats-display-maybe):
* lisp/emacs-lisp/timer-list.el (list-timers):
* lisp/emacs-lisp/timer.el (timer-until)
(timer-event-handler):
* lisp/erc/erc-backend.el (erc-server-send-ping)
(erc-server-send-queue, erc-handle-parsed-server-response)
(erc-handle-unknown-server-response):
* lisp/erc/erc-track.el (erc-buffer-visible):
* lisp/erc/erc.el (erc-lurker-cleanup, erc-lurker-p)
(erc-cmd-PING, erc-send-current-line):
* lisp/eshell/em-pred.el (eshell-pred-file-time):
* lisp/eshell/em-unix.el (eshell-show-elapsed-time):
* lisp/gnus/gnus-icalendar.el (gnus-icalendar-event:org-timestamp):
* lisp/gnus/gnus-int.el (gnus-backend-trace):
* lisp/gnus/gnus-sum.el (gnus-user-date):
* lisp/gnus/mail-source.el (mail-source-delete-crash-box):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/ibuf-ext.el (ibuffer-mark-old-buffers):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/mouse.el (mouse--down-1-maybe-follows-link)
(mouse--click-1-maybe-follows-link):
* lisp/mpc.el (mpc--faster-toggle):
* lisp/net/rcirc.el (rcirc-handler-ctcp-KEEPALIVE)
(rcirc-sentinel):
* lisp/net/tramp-cache.el (tramp-get-file-property):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-newer-than-file-p)
(tramp-maybe-open-connection):
* lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection):
* lisp/org/org-clock.el (org-clock-resolve):
(org-resolve-clocks, org-clock-in, org-clock-out, org-clock-sum):
* lisp/org/org-timer.el (org-timer-start)
(org-timer-pause-or-continue, org-timer-seconds):
* lisp/org/org.el (org-evaluate-time-range):
* lisp/org/ox-publish.el (org-publish-cache-ctime-of-src):
* lisp/pixel-scroll.el (pixel-scroll-in-rush-p):
* lisp/play/hanoi.el (hanoi-move-ring):
* lisp/proced.el (proced-format-time):
* lisp/progmodes/cpp.el (cpp-progress-message):
* lisp/progmodes/flymake.el (flymake--handle-report):
* lisp/progmodes/js.el (js--wait-for-matching-output):
* lisp/subr.el (progress-reporter-do-update):
* lisp/term/xterm.el (xterm--read-event-for-query):
* lisp/time.el (display-time-update, emacs-uptime):
* lisp/tooltip.el (tooltip-delay):
* lisp/url/url-cookie.el (url-cookie-parse-file-netscape):
* lisp/url/url-queue.el (url-queue-prune-old-entries):
* lisp/url/url.el (url-retrieve-synchronously):
* lisp/xt-mouse.el (xterm-mouse-event):
Avoid double-rounding of time-related values. Simplify.
* lisp/calendar/icalendar.el (icalendar--decode-isodatetime):
When hoping for the best (unlikely), use a better decoded time.
(icalendar--convert-sexp-to-ical): Avoid unnecessary encode-time.
* lisp/calendar/timeclock.el (timeclock-when-to-leave):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/desktop.el (desktop-create-buffer):
* lisp/emacs-lisp/benchmark.el (benchmark-elapse):
* lisp/gnus/gnus-art.el (article-lapsed-string):
* lisp/gnus/gnus-group.el (gnus-group-timestamp-delta):
* lisp/gnus/nnmail.el (nnmail-expired-article-p):
* lisp/gnus/nnmaildir.el (nnmaildir-request-expire-articles):
* lisp/nxml/rng-maint.el (rng-time-function):
* lisp/org/org-clock.el (org-clock-get-clocked-time)
(org-clock-resolve, org-resolve-clocks, org-resolve-clocks-if-idle):
* lisp/org/org-habit.el (org-habit-insert-consistency-graphs):
* lisp/progmodes/vhdl-mode.el (vhdl-update-progress-info)
(vhdl-fix-case-region-1):
Use time-since instead of open-coding most of it.
* lisp/erc/erc-dcc.el (erc-dcc-get-sentinel):
* lisp/erc/erc.el (erc-string-to-emacs-time, erc-time-gt):
Now obsolete. All uses changed.
(erc-time-diff): Accept all Lisp time values.
All uses changed.
* lisp/gnus/gnus-demon.el (gnus-demon-idle-since):
* lisp/gnus/gnus-score.el (gnus-score-headers):
* lisp/gnus/nneething.el (nneething-make-head):
* lisp/gnus/nnheader.el (nnheader-message-maybe):
* lisp/gnus/nnimap.el (nnimap-keepalive):
* lisp/image.el (image-animate-timeout):
* lisp/mail/feedmail.el (feedmail-rfc822-date):
* lisp/net/imap.el (imap-wait-for-tag):
* lisp/net/newst-backend.el (newsticker--image-get):
* lisp/net/rcirc.el (rcirc-handler-317, rcirc-handler-333):
* lisp/obsolete/xesam.el (xesam-refresh-entry):
* lisp/org/org-agenda.el (org-agenda-show-clocking-issues)
(org-agenda-check-clock-gap, org-agenda-to-appt):
* lisp/org/org-capture.el (org-capture-set-target-location):
* lisp/org/org-clock.el (org-clock-resolve-clock)
(org-clocktable-steps):
* lisp/org/org-colview.el (org-columns-edit-value)
(org-columns, org-agenda-columns):
* lisp/org/org-duration.el (org-duration-from-minutes):
* lisp/org/org-element.el (org-element-cache-sync-duration)
(org-element-cache-sync-break)
(org-element--cache-interrupt-p, org-element--cache-sync):
* lisp/org/org-habit.el (org-habit-get-faces)
* lisp/org/org-indent.el (org-indent-add-properties):
* lisp/org/org-table.el (org-table-sum):
* lisp/org/org-timer.el (org-timer-show-remaining-time)
(org-timer-set-timer):
* lisp/org/org.el (org-babel-load-file, org-today)
(org-auto-repeat-maybe, org-2ft, org-time-stamp)
(org-read-date-analyze, org-time-stamp-to-now)
(org-small-year-to-year, org-goto-calendar):
* lisp/org/ox.el (org-export-insert-default-template):
* lisp/ses.el (ses--time-check):
* lisp/type-break.el (type-break-time-warning)
(type-break-statistics, type-break-demo-boring):
* lisp/url/url-cache.el (url-cache-expired)
(url-cache-prune-cache):
* lisp/vc/vc-git.el (vc-git-stash-snapshot):
* lisp/erc/erc-match.el (erc-log-matches-come-back):
Simplify.
2019-02-23 02:32:31 +00:00
|
|
|
|
(time-to-load-image (time-since time))
|
|
|
|
|
|
(stated-delay-time (/ (or (cdr animation)
|
|
|
|
|
|
image-default-frame-delay)
|
|
|
|
|
|
(float (abs speed))))
|
2014-02-25 21:59:14 +00:00
|
|
|
|
;; Subtract off the time we took to load the image from the
|
|
|
|
|
|
;; stated delay time.
|
Avoid some double-rounding of Lisp timestamps
Also, simplify some time-related Lisp timestamp code
while we’re in the neighborhood.
* lisp/battery.el (battery-linux-proc-acpi)
(battery-linux-sysfs, battery-upower, battery-bsd-apm):
* lisp/calendar/timeclock.el (timeclock-seconds-to-string)
(timeclock-log, timeclock-last-period)
(timeclock-entry-length, timeclock-entry-list-span)
(timeclock-find-discrep, timeclock-generate-report):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/completion.el (cmpl-hours-since-origin):
* lisp/ecomplete.el (ecomplete-decay-1):
* lisp/emacs-lisp/ert.el (ert--results-update-stats-display)
(ert--results-update-stats-display-maybe):
* lisp/emacs-lisp/timer-list.el (list-timers):
* lisp/emacs-lisp/timer.el (timer-until)
(timer-event-handler):
* lisp/erc/erc-backend.el (erc-server-send-ping)
(erc-server-send-queue, erc-handle-parsed-server-response)
(erc-handle-unknown-server-response):
* lisp/erc/erc-track.el (erc-buffer-visible):
* lisp/erc/erc.el (erc-lurker-cleanup, erc-lurker-p)
(erc-cmd-PING, erc-send-current-line):
* lisp/eshell/em-pred.el (eshell-pred-file-time):
* lisp/eshell/em-unix.el (eshell-show-elapsed-time):
* lisp/gnus/gnus-icalendar.el (gnus-icalendar-event:org-timestamp):
* lisp/gnus/gnus-int.el (gnus-backend-trace):
* lisp/gnus/gnus-sum.el (gnus-user-date):
* lisp/gnus/mail-source.el (mail-source-delete-crash-box):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/ibuf-ext.el (ibuffer-mark-old-buffers):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/mouse.el (mouse--down-1-maybe-follows-link)
(mouse--click-1-maybe-follows-link):
* lisp/mpc.el (mpc--faster-toggle):
* lisp/net/rcirc.el (rcirc-handler-ctcp-KEEPALIVE)
(rcirc-sentinel):
* lisp/net/tramp-cache.el (tramp-get-file-property):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-newer-than-file-p)
(tramp-maybe-open-connection):
* lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection):
* lisp/org/org-clock.el (org-clock-resolve):
(org-resolve-clocks, org-clock-in, org-clock-out, org-clock-sum):
* lisp/org/org-timer.el (org-timer-start)
(org-timer-pause-or-continue, org-timer-seconds):
* lisp/org/org.el (org-evaluate-time-range):
* lisp/org/ox-publish.el (org-publish-cache-ctime-of-src):
* lisp/pixel-scroll.el (pixel-scroll-in-rush-p):
* lisp/play/hanoi.el (hanoi-move-ring):
* lisp/proced.el (proced-format-time):
* lisp/progmodes/cpp.el (cpp-progress-message):
* lisp/progmodes/flymake.el (flymake--handle-report):
* lisp/progmodes/js.el (js--wait-for-matching-output):
* lisp/subr.el (progress-reporter-do-update):
* lisp/term/xterm.el (xterm--read-event-for-query):
* lisp/time.el (display-time-update, emacs-uptime):
* lisp/tooltip.el (tooltip-delay):
* lisp/url/url-cookie.el (url-cookie-parse-file-netscape):
* lisp/url/url-queue.el (url-queue-prune-old-entries):
* lisp/url/url.el (url-retrieve-synchronously):
* lisp/xt-mouse.el (xterm-mouse-event):
Avoid double-rounding of time-related values. Simplify.
* lisp/calendar/icalendar.el (icalendar--decode-isodatetime):
When hoping for the best (unlikely), use a better decoded time.
(icalendar--convert-sexp-to-ical): Avoid unnecessary encode-time.
* lisp/calendar/timeclock.el (timeclock-when-to-leave):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/desktop.el (desktop-create-buffer):
* lisp/emacs-lisp/benchmark.el (benchmark-elapse):
* lisp/gnus/gnus-art.el (article-lapsed-string):
* lisp/gnus/gnus-group.el (gnus-group-timestamp-delta):
* lisp/gnus/nnmail.el (nnmail-expired-article-p):
* lisp/gnus/nnmaildir.el (nnmaildir-request-expire-articles):
* lisp/nxml/rng-maint.el (rng-time-function):
* lisp/org/org-clock.el (org-clock-get-clocked-time)
(org-clock-resolve, org-resolve-clocks, org-resolve-clocks-if-idle):
* lisp/org/org-habit.el (org-habit-insert-consistency-graphs):
* lisp/progmodes/vhdl-mode.el (vhdl-update-progress-info)
(vhdl-fix-case-region-1):
Use time-since instead of open-coding most of it.
* lisp/erc/erc-dcc.el (erc-dcc-get-sentinel):
* lisp/erc/erc.el (erc-string-to-emacs-time, erc-time-gt):
Now obsolete. All uses changed.
(erc-time-diff): Accept all Lisp time values.
All uses changed.
* lisp/gnus/gnus-demon.el (gnus-demon-idle-since):
* lisp/gnus/gnus-score.el (gnus-score-headers):
* lisp/gnus/nneething.el (nneething-make-head):
* lisp/gnus/nnheader.el (nnheader-message-maybe):
* lisp/gnus/nnimap.el (nnimap-keepalive):
* lisp/image.el (image-animate-timeout):
* lisp/mail/feedmail.el (feedmail-rfc822-date):
* lisp/net/imap.el (imap-wait-for-tag):
* lisp/net/newst-backend.el (newsticker--image-get):
* lisp/net/rcirc.el (rcirc-handler-317, rcirc-handler-333):
* lisp/obsolete/xesam.el (xesam-refresh-entry):
* lisp/org/org-agenda.el (org-agenda-show-clocking-issues)
(org-agenda-check-clock-gap, org-agenda-to-appt):
* lisp/org/org-capture.el (org-capture-set-target-location):
* lisp/org/org-clock.el (org-clock-resolve-clock)
(org-clocktable-steps):
* lisp/org/org-colview.el (org-columns-edit-value)
(org-columns, org-agenda-columns):
* lisp/org/org-duration.el (org-duration-from-minutes):
* lisp/org/org-element.el (org-element-cache-sync-duration)
(org-element-cache-sync-break)
(org-element--cache-interrupt-p, org-element--cache-sync):
* lisp/org/org-habit.el (org-habit-get-faces)
* lisp/org/org-indent.el (org-indent-add-properties):
* lisp/org/org-table.el (org-table-sum):
* lisp/org/org-timer.el (org-timer-show-remaining-time)
(org-timer-set-timer):
* lisp/org/org.el (org-babel-load-file, org-today)
(org-auto-repeat-maybe, org-2ft, org-time-stamp)
(org-read-date-analyze, org-time-stamp-to-now)
(org-small-year-to-year, org-goto-calendar):
* lisp/org/ox.el (org-export-insert-default-template):
* lisp/ses.el (ses--time-check):
* lisp/type-break.el (type-break-time-warning)
(type-break-statistics, type-break-demo-boring):
* lisp/url/url-cache.el (url-cache-expired)
(url-cache-prune-cache):
* lisp/vc/vc-git.el (vc-git-stash-snapshot):
* lisp/erc/erc-match.el (erc-log-matches-come-back):
Simplify.
2019-02-23 02:32:31 +00:00
|
|
|
|
(delay (max (float-time (time-subtract stated-delay-time
|
|
|
|
|
|
time-to-load-image))
|
2014-02-25 21:59:14 +00:00
|
|
|
|
image-minimum-frame-delay))
|
|
|
|
|
|
done)
|
|
|
|
|
|
(setq n (if (< speed 0)
|
|
|
|
|
|
(1- n)
|
|
|
|
|
|
(1+ n)))
|
|
|
|
|
|
(if limit
|
|
|
|
|
|
(cond ((>= n count) (setq n 0))
|
|
|
|
|
|
((< n 0) (setq n (1- count))))
|
|
|
|
|
|
(and (or (>= n count) (< n 0)) (setq done t)))
|
|
|
|
|
|
(setq time-elapsed (+ delay time-elapsed))
|
|
|
|
|
|
(if (numberp limit)
|
|
|
|
|
|
(setq done (>= time-elapsed limit)))
|
|
|
|
|
|
(unless done
|
2016-05-23 19:12:24 +00:00
|
|
|
|
(run-with-timer delay nil #'image-animate-timeout
|
2016-05-03 23:37:01 +00:00
|
|
|
|
image n count time-elapsed limit
|
|
|
|
|
|
(+ (float-time) delay))))))
|
2010-03-07 19:02:20 +00:00
|
|
|
|
|
|
|
|
|
|
|
2012-05-31 17:14:46 +00:00
|
|
|
|
(defvar imagemagick-types-inhibit)
|
2012-06-02 07:30:07 +00:00
|
|
|
|
(defvar imagemagick-enabled-types)
|
2012-05-31 17:14:46 +00:00
|
|
|
|
|
|
|
|
|
|
(defun imagemagick-filter-types ()
|
|
|
|
|
|
"Return a list of the ImageMagick types to be treated as images, or nil.
|
|
|
|
|
|
This is the result of `imagemagick-types', including only elements
|
2012-06-02 07:30:07 +00:00
|
|
|
|
that match `imagemagick-enabled-types' and do not match
|
2012-05-31 17:14:46 +00:00
|
|
|
|
`imagemagick-types-inhibit'."
|
|
|
|
|
|
(when (fboundp 'imagemagick-types)
|
2012-06-02 07:30:07 +00:00
|
|
|
|
(cond ((null imagemagick-enabled-types) nil)
|
2012-05-31 17:14:46 +00:00
|
|
|
|
((eq imagemagick-types-inhibit t) nil)
|
|
|
|
|
|
(t
|
|
|
|
|
|
(delq nil
|
|
|
|
|
|
(mapcar
|
|
|
|
|
|
(lambda (type)
|
|
|
|
|
|
(unless (memq type imagemagick-types-inhibit)
|
2012-06-02 07:30:07 +00:00
|
|
|
|
(if (eq imagemagick-enabled-types t) type
|
2012-05-31 17:21:31 +00:00
|
|
|
|
(catch 'found
|
2012-06-02 07:30:07 +00:00
|
|
|
|
(dolist (enable imagemagick-enabled-types nil)
|
2012-05-31 17:21:31 +00:00
|
|
|
|
(if (cond ((symbolp enable) (eq enable type))
|
|
|
|
|
|
((stringp enable)
|
|
|
|
|
|
(string-match enable
|
|
|
|
|
|
(symbol-name type))))
|
|
|
|
|
|
(throw 'found type)))))))
|
2012-05-31 17:14:46 +00:00
|
|
|
|
(imagemagick-types)))))))
|
|
|
|
|
|
|
2012-04-16 03:47:43 +00:00
|
|
|
|
(defvar imagemagick--file-regexp nil
|
|
|
|
|
|
"File extension regexp for ImageMagick files, if any.
|
|
|
|
|
|
This is the extension installed into `auto-mode-alist' and
|
|
|
|
|
|
`image-type-file-name-regexps' by `imagemagick-register-types'.")
|
2010-04-02 21:09:13 +00:00
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2010-05-13 13:13:52 +00:00
|
|
|
|
(defun imagemagick-register-types ()
|
2011-05-29 18:17:28 +00:00
|
|
|
|
"Register file types that can be handled by ImageMagick.
|
2012-04-16 03:47:43 +00:00
|
|
|
|
This function is called at startup, after loading the init file.
|
2012-05-31 17:14:46 +00:00
|
|
|
|
It registers the ImageMagick types returned by `imagemagick-filter-types'.
|
2012-03-30 16:31:24 +00:00
|
|
|
|
|
|
|
|
|
|
Registered image types are added to `auto-mode-alist', so that
|
|
|
|
|
|
Emacs visits them in Image mode. They are also added to
|
|
|
|
|
|
`image-type-file-name-regexps', so that the `image-type' function
|
|
|
|
|
|
recognizes these files as having image type `imagemagick'.
|
2011-05-29 18:17:28 +00:00
|
|
|
|
|
2012-05-31 07:22:33 +00:00
|
|
|
|
If Emacs is compiled without ImageMagick support, this does nothing."
|
2011-05-29 18:17:28 +00:00
|
|
|
|
(when (fboundp 'imagemagick-types)
|
2012-05-31 17:14:46 +00:00
|
|
|
|
(let* ((types (mapcar (lambda (type) (downcase (symbol-name type)))
|
|
|
|
|
|
(imagemagick-filter-types)))
|
|
|
|
|
|
(re (if types (concat "\\." (regexp-opt types) "\\'")))
|
2012-05-31 07:22:33 +00:00
|
|
|
|
(ama-elt (car (member (cons imagemagick--file-regexp 'image-mode)
|
|
|
|
|
|
auto-mode-alist)))
|
|
|
|
|
|
(itfnr-elt (car (member (cons imagemagick--file-regexp 'imagemagick)
|
|
|
|
|
|
image-type-file-name-regexps))))
|
|
|
|
|
|
(if (not re)
|
|
|
|
|
|
(setq auto-mode-alist (delete ama-elt auto-mode-alist)
|
|
|
|
|
|
image-type-file-name-regexps
|
|
|
|
|
|
(delete itfnr-elt image-type-file-name-regexps))
|
|
|
|
|
|
(if ama-elt
|
|
|
|
|
|
(setcar ama-elt re)
|
|
|
|
|
|
(push (cons re 'image-mode) auto-mode-alist))
|
|
|
|
|
|
(if itfnr-elt
|
|
|
|
|
|
(setcar itfnr-elt re)
|
2012-06-11 10:16:47 +00:00
|
|
|
|
;; Append to `image-type-file-name-regexps', so that we
|
|
|
|
|
|
;; preferentially use specialized image libraries.
|
|
|
|
|
|
(add-to-list 'image-type-file-name-regexps
|
|
|
|
|
|
(cons re 'imagemagick) t)))
|
2012-04-16 03:47:43 +00:00
|
|
|
|
(setq imagemagick--file-regexp re))))
|
|
|
|
|
|
|
2012-06-04 13:01:17 +00:00
|
|
|
|
(defcustom imagemagick-types-inhibit
|
|
|
|
|
|
'(C HTML HTM INFO M TXT PDF)
|
2012-06-02 07:30:07 +00:00
|
|
|
|
"List of ImageMagick types that should never be treated as images.
|
2012-04-16 03:47:43 +00:00
|
|
|
|
This should be a list of symbols, each of which should be one of
|
2012-06-02 07:30:07 +00:00
|
|
|
|
the ImageMagick types listed by `imagemagick-types'. The listed
|
2012-04-16 03:47:43 +00:00
|
|
|
|
image types are not registered by `imagemagick-register-types'.
|
|
|
|
|
|
|
|
|
|
|
|
If the value is t, inhibit the use of ImageMagick for images.
|
|
|
|
|
|
|
2012-05-25 20:24:58 +00:00
|
|
|
|
If you change this without using customize, you must call
|
|
|
|
|
|
`imagemagick-register-types' afterwards.
|
|
|
|
|
|
|
2012-04-16 03:47:43 +00:00
|
|
|
|
If Emacs is compiled without ImageMagick support, this variable
|
|
|
|
|
|
has no effect."
|
|
|
|
|
|
:type '(choice (const :tag "Support all ImageMagick types" nil)
|
|
|
|
|
|
(const :tag "Disable all ImageMagick types" t)
|
|
|
|
|
|
(repeat symbol))
|
2016-05-23 19:12:24 +00:00
|
|
|
|
:initialize #'custom-initialize-default
|
2012-04-16 03:47:43 +00:00
|
|
|
|
:set (lambda (symbol value)
|
|
|
|
|
|
(set-default symbol value)
|
|
|
|
|
|
(imagemagick-register-types))
|
2016-05-23 19:12:24 +00:00
|
|
|
|
:version "24.3")
|
2010-04-02 21:09:13 +00:00
|
|
|
|
|
2012-06-02 07:30:07 +00:00
|
|
|
|
(defcustom imagemagick-enabled-types
|
2019-02-20 06:04:19 +00:00
|
|
|
|
'(3FR ARW AVS BMP BMP2 BMP3 CAL CALS CMYK CMYKA CR2 CRW
|
2012-06-04 13:01:17 +00:00
|
|
|
|
CUR CUT DCM DCR DCX DDS DJVU DNG DPX EXR FAX FITS GBR GIF
|
|
|
|
|
|
GIF87 GRB HRZ ICB ICO ICON J2C JNG JP2 JPC JPEG JPG JPX K25
|
|
|
|
|
|
KDC MIFF MNG MRW MSL MSVG MTV NEF ORF OTB PBM PCD PCDS PCL
|
|
|
|
|
|
PCT PCX PDB PEF PGM PICT PIX PJPEG PNG PNG24 PNG32 PNG8 PNM
|
|
|
|
|
|
PPM PSD PTIF PWP RAF RAS RBG RGB RGBA RGBO RLA RLE SCR SCT
|
|
|
|
|
|
SFW SGI SR2 SRF SUN SVG SVGZ TGA TIFF TIFF64 TILE TIM TTF
|
|
|
|
|
|
UYVY VDA VICAR VID VIFF VST WBMP WPG X3F XBM XC XCF XPM XV
|
|
|
|
|
|
XWD YCbCr YCbCrA YUV)
|
2012-05-31 07:22:33 +00:00
|
|
|
|
"List of ImageMagick types to treat as images.
|
2012-06-02 07:30:07 +00:00
|
|
|
|
Each list element should be a string or symbol, representing one
|
|
|
|
|
|
of the image types returned by `imagemagick-types'. If the
|
|
|
|
|
|
element is a string, it is handled as a regexp that enables all
|
|
|
|
|
|
matching types.
|
2012-05-31 07:22:33 +00:00
|
|
|
|
|
2012-06-02 07:30:07 +00:00
|
|
|
|
The value of `imagemagick-enabled-types' may also be t, meaning
|
|
|
|
|
|
to enable all types that ImageMagick supports.
|
2012-05-31 07:22:33 +00:00
|
|
|
|
|
|
|
|
|
|
The variable `imagemagick-types-inhibit' overrides this variable.
|
|
|
|
|
|
|
2012-10-22 21:53:03 +00:00
|
|
|
|
If you change this without using customize, you must call
|
2012-05-31 07:22:33 +00:00
|
|
|
|
`imagemagick-register-types' afterwards.
|
|
|
|
|
|
|
|
|
|
|
|
If Emacs is compiled without ImageMagick support, this variable
|
|
|
|
|
|
has no effect."
|
|
|
|
|
|
:type '(choice (const :tag "Support all ImageMagick types" t)
|
|
|
|
|
|
(const :tag "Disable all ImageMagick types" nil)
|
|
|
|
|
|
(repeat :tag "List of types"
|
|
|
|
|
|
(choice (symbol :tag "type")
|
|
|
|
|
|
(regexp :tag "regexp"))))
|
2016-05-23 19:12:24 +00:00
|
|
|
|
:initialize #'custom-initialize-default
|
2012-05-31 07:22:33 +00:00
|
|
|
|
:set (lambda (symbol value)
|
|
|
|
|
|
(set-default symbol value)
|
|
|
|
|
|
(imagemagick-register-types))
|
2019-02-20 06:04:19 +00:00
|
|
|
|
:version "26.2") ; remove ART (bug#22289)
|
2012-05-31 07:22:33 +00:00
|
|
|
|
|
|
|
|
|
|
(imagemagick-register-types)
|
|
|
|
|
|
|
2016-02-09 01:44:32 +00:00
|
|
|
|
(defun image-increase-size (n)
|
|
|
|
|
|
"Increase the image size by a factor of N.
|
|
|
|
|
|
If N is 3, then the image size will be increased by 30%. The
|
|
|
|
|
|
default is 20%."
|
|
|
|
|
|
(interactive "P")
|
2016-02-10 02:47:58 +00:00
|
|
|
|
(image--change-size (if n
|
2016-09-04 01:59:07 +00:00
|
|
|
|
(1+ (/ n 10.0))
|
2016-02-10 02:47:58 +00:00
|
|
|
|
1.2)))
|
2016-02-09 01:44:32 +00:00
|
|
|
|
|
|
|
|
|
|
(defun image-decrease-size (n)
|
|
|
|
|
|
"Decrease the image size by a factor of N.
|
|
|
|
|
|
If N is 3, then the image size will be decreased by 30%. The
|
|
|
|
|
|
default is 20%."
|
|
|
|
|
|
(interactive "P")
|
2016-02-10 02:47:58 +00:00
|
|
|
|
(image--change-size (if n
|
2016-09-04 01:59:07 +00:00
|
|
|
|
(- 1 (/ n 10.0))
|
2016-02-10 02:47:58 +00:00
|
|
|
|
0.8)))
|
2016-02-09 01:44:32 +00:00
|
|
|
|
|
2016-02-10 01:03:55 +00:00
|
|
|
|
(defun image--get-image ()
|
2018-03-11 10:13:47 +00:00
|
|
|
|
"Return the image at point."
|
|
|
|
|
|
(let ((image (get-char-property (point) 'display)))
|
2016-05-23 19:12:24 +00:00
|
|
|
|
(unless (eq (car-safe image) 'image)
|
2016-02-09 01:44:32 +00:00
|
|
|
|
(error "No image under point"))
|
2016-02-10 01:03:55 +00:00
|
|
|
|
image))
|
|
|
|
|
|
|
|
|
|
|
|
(defun image--get-imagemagick-and-warn ()
|
2019-06-05 20:51:33 +00:00
|
|
|
|
(unless (or (fboundp 'imagemagick-types) (image-transforms-p))
|
2019-01-02 21:00:09 +00:00
|
|
|
|
(error "Cannot rescale images on this terminal"))
|
2016-02-10 01:03:55 +00:00
|
|
|
|
(let ((image (image--get-image)))
|
|
|
|
|
|
(image-flush image)
|
2019-06-05 20:51:33 +00:00
|
|
|
|
(when (and (fboundp 'imagemagick-types)
|
|
|
|
|
|
(not (image-transforms-p)))
|
2017-12-03 17:39:03 +00:00
|
|
|
|
(plist-put (cdr image) :type 'imagemagick))
|
2016-02-10 01:03:55 +00:00
|
|
|
|
image))
|
|
|
|
|
|
|
2016-02-10 02:47:58 +00:00
|
|
|
|
(defun image--change-size (factor)
|
|
|
|
|
|
(let* ((image (image--get-imagemagick-and-warn))
|
|
|
|
|
|
(new-image (image--image-without-parameters image))
|
|
|
|
|
|
(scale (image--current-scaling image new-image)))
|
|
|
|
|
|
(setcdr image (cdr new-image))
|
|
|
|
|
|
(plist-put (cdr image) :scale (* scale factor))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun image--image-without-parameters (image)
|
|
|
|
|
|
(cons (pop image)
|
|
|
|
|
|
(let ((new nil))
|
|
|
|
|
|
(while image
|
|
|
|
|
|
(let ((key (pop image))
|
|
|
|
|
|
(val (pop image)))
|
|
|
|
|
|
(unless (memq key '(:scale :width :height :max-width :max-height))
|
|
|
|
|
|
(setq new (nconc new (list key val))))))
|
|
|
|
|
|
new)))
|
|
|
|
|
|
|
2018-02-27 06:47:27 +00:00
|
|
|
|
(declare-function image-size "image.c" (spec &optional pixels frame))
|
|
|
|
|
|
|
2016-02-10 02:47:58 +00:00
|
|
|
|
(defun image--current-scaling (image new-image)
|
|
|
|
|
|
;; The image may be scaled due to many reasons (:scale, :max-width,
|
|
|
|
|
|
;; etc), so find out what the current scaling is based on the
|
|
|
|
|
|
;; original image size and the displayed size.
|
|
|
|
|
|
(let ((image-width (car (image-size new-image t)))
|
|
|
|
|
|
(display-width (car (image-size image t))))
|
|
|
|
|
|
(/ (float display-width) image-width)))
|
2016-02-09 01:44:32 +00:00
|
|
|
|
|
2019-07-16 21:51:27 +00:00
|
|
|
|
(defun image-rotate (&optional angle)
|
|
|
|
|
|
"Rotate the image under point by ANGLE degrees clockwise.
|
|
|
|
|
|
If nil, ANGLE defaults to 90. Interactively, rotate the image 90
|
|
|
|
|
|
degrees clockwise with no prefix argument, and counter-clockwise
|
|
|
|
|
|
with a prefix argument. Note that most image types support
|
|
|
|
|
|
rotations by only multiples of 90 degrees."
|
|
|
|
|
|
(interactive (and current-prefix-arg '(-90)))
|
2016-02-10 01:03:55 +00:00
|
|
|
|
(let ((image (image--get-imagemagick-and-warn)))
|
2019-07-16 21:51:27 +00:00
|
|
|
|
(setf (image-property image :rotation)
|
|
|
|
|
|
(float (mod (+ (or (image-property image :rotation) 0)
|
|
|
|
|
|
(or angle 90))
|
|
|
|
|
|
;; We don't want to exceed 360 degrees rotation,
|
|
|
|
|
|
;; because it's not seen as valid in Exif data.
|
|
|
|
|
|
360)))))
|
2016-02-10 01:03:55 +00:00
|
|
|
|
|
|
|
|
|
|
(defun image-save ()
|
|
|
|
|
|
"Save the image under point."
|
|
|
|
|
|
(interactive)
|
2018-03-11 10:13:47 +00:00
|
|
|
|
(let ((image (image--get-image)))
|
2016-02-10 01:03:55 +00:00
|
|
|
|
(with-temp-buffer
|
|
|
|
|
|
(let ((file (plist-get (cdr image) :file)))
|
|
|
|
|
|
(if file
|
|
|
|
|
|
(if (not (file-exists-p file))
|
|
|
|
|
|
(error "File %s no longer exists" file)
|
|
|
|
|
|
(insert-file-contents-literally file))
|
|
|
|
|
|
(insert (plist-get (cdr image) :data))))
|
|
|
|
|
|
(write-region (point-min) (point-max)
|
|
|
|
|
|
(read-file-name "Write image to file: ")))))
|
|
|
|
|
|
|
1999-07-21 21:43:52 +00:00
|
|
|
|
(provide 'image)
|
|
|
|
|
|
|
1999-10-05 18:41:17 +00:00
|
|
|
|
;;; image.el ends here
|