;;; image.el --- image API
-;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: multimedia
;; Package: emacs
(defconst image-type-header-regexps
`(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
- ("\\`P[1-6][[:space:]]+\\(?:#.*[[:space:]]+\\)*[0-9]+[[:space:]]+[0-9]+" . pbm)
+ ("\\`P[1-6]\\(?:\
+\\(?:\\(?:#[^\r\n]*[\r\n]\\)?[[:space:]]\\)+\
+\\(?:\\(?:#[^\r\n]*[\r\n]\\)?[0-9]\\)+\
+\\)\\{2\\}" . pbm)
("\\`GIF8[79]a" . gif)
("\\`\x89PNG\r\n\x1a\n" . png)
("\\`[\t\n\r ]*#define \\([a-z0-9_]+\\)_width [0-9]+\n\
- maybe auto-detect only if the image type is available
(see `image-type-available-p').")
+(defvar image-format-suffixes
+ '((image/x-icon "ico"))
+ "An alist associating image types with file name suffixes.
+This is used as a hint by the ImageMagick library when detecting
+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.")
+
(defcustom image-load-path
(list (file-name-as-directory (expand-file-name "images" data-directory))
'data-directory 'load-path)
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
-value is used as a list of directories to search."
+value is used as a list of directories to search.
+
+Subdirectories are not automatically included in the search."
:type '(repeat (choice directory variable))
:initialize 'custom-initialize-delay)
(let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
(image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
+ (when (boundp \\='image-load-path)
image-load-path))))
(mh-tool-bar-folder-buttons-init))"
(unless library (error "No library specified"))
types nil)
(setq types (cdr types)))))
(goto-char opoint)
- type))
+ (and type
+ (boundp 'image-types)
+ (memq type image-types)
+ type)))
;;;###autoload
"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."
- (assoc-default file image-type-file-name-regexps 'string-match-p))
-
+ (let (type first)
+ (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))))))))
;;;###autoload
(defun image-type (source &optional type data-p)
(if (fboundp 'image-metadata) ; eg not --without-x
(define-obsolete-function-alias 'image-extension-data
- 'image-metadata' "24.1"))
+ 'image-metadata "24.1"))
(define-obsolete-variable-alias
'image-library-alist
"Return non-nil if image type TYPE is available.
Image types are symbols like `xbm' or `jpeg'."
(and (fboundp 'init-image-library)
- (init-image-library type dynamic-library-alist)))
+ (init-image-library type)))
;;;###autoload
"Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
with a `display' property whose value is the image. STRING
-defaults to the empty string if you omit it.
+defaults to a single space if you omit it.
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'
(defun insert-sliced-image (image &optional string area rows cols)
"Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
-with a `display' property whose value is the image. STRING is
-defaulted if you omit it.
+with a `display' property whose value is the image. The default
+STRING is a single space.
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'
;;;###autoload
(defmacro defimage (symbol specs &optional doc)
- "Define SYMBOL as an image.
+ "Define SYMBOL as an image, and return SYMBOL.
SPECS is a list of image specifications. DOC is an optional
documentation string.
\f
;;; Animated image API
-(defconst image-animated-types '(gif)
- "List of supported animated image types.")
-
-(defun image-animated-p (image)
- "Return non-nil if IMAGE can be animated.
-To be capable of being animated, an image must be of a type
-listed in `image-animated-types', and contain more than one
-sub-image, with a specified animation delay. The actual return
-value is a cons (NIMAGES . DELAY), where NIMAGES is the number
-of sub-images in the animated image and DELAY is the delay in
-seconds until the next sub-image should be displayed."
- (cond
- ((memq (plist-get (cdr image) :type) image-animated-types)
+(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.")
+
+(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'."
+ (when (fboundp 'image-metadata)
(let* ((metadata (image-metadata image))
(images (plist-get metadata 'count))
(delay (plist-get metadata 'delay)))
- (when (and images (> images 1) (numberp delay))
- (if (< delay 0) (setq delay 0.1))
- (cons images delay))))))
+ (when (and images (> images 1))
+ (and delay (or (not (numberp delay)) (< delay 0))
+ (setq delay image-default-frame-delay))
+ (cons images delay)))))
+
+(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")
;; "Destructively"?
(defun image-animate (image &optional index limit)
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."
- (let ((animation (image-animated-p image))
+ (let ((animation (image-multi-frame-p image))
timer)
(when animation
(if (setq timer (image-animate-timer image))
(cancel-timer timer))
+ (plist-put (cdr image) :animate-buffer (current-buffer))
(run-with-timer 0.2 nil 'image-animate-timeout
image (or index 0) (car animation)
0 limit))))
(while tail
(setq timer (car tail)
tail (cdr tail))
- (if (and (eq (aref timer 5) 'image-animate-timeout)
- (eq (car-safe (aref timer 6)) image))
+ (if (and (eq (timer--function timer) 'image-animate-timeout)
+ (eq (car-safe (timer--args timer)) image))
(setq tail nil)
(setq timer nil)))
timer))
+(defconst image-minimum-frame-delay 0.01
+ "Minimum interval in seconds between frames of an animated image.")
+
+(defun image-current-frame (image)
+ "The current frame number of IMAGE, indexed from 0."
+ (or (plist-get (cdr image) :index) 0))
+
+(defun image-show-frame (image n &optional nocheck)
+ "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)
+ (setq n (min n (1- (car (image-multi-frame-p image)))))))
+ (plist-put (cdr image) :index n)
+ (force-window-update))
+
+(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)))
+
;; FIXME? The delay may not be the same for different sub-images,
-;; hence we need to call image-animated-p to return it.
+;; hence we need to call image-multi-frame-p to return it.
;; But it also returns count, so why do we bother passing that as an
;; argument?
(defun image-animate-timeout (image n count time-elapsed limit)
LIMIT determines when to stop. If t, loop forever. If nil, stop
after displaying the last animation frame. Otherwise, stop
after LIMIT seconds have elapsed.
-The minimum delay between successive frames is 0.01s."
- (plist-put (cdr image) :index n)
- (force-window-update)
- (setq n (1+ n))
- (let* ((time (float-time))
- (animation (image-animated-p image))
- ;; Subtract off the time we took to load the image from the
- ;; stated delay time.
- (delay (max (+ (cdr animation) time (- (float-time)))
- 0.01))
- done)
- (if (>= n count)
- (if limit
- (setq n 0)
- (setq done t)))
- (setq time-elapsed (+ delay time-elapsed))
- (if (numberp limit)
- (setq done (>= time-elapsed limit)))
- (unless done
- (run-with-timer delay nil 'image-animate-timeout
- image n count time-elapsed limit))))
+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."
+ (when (buffer-live-p (plist-get (cdr image) :animate-buffer))
+ (image-show-frame image n t)
+ (let* ((speed (image-animate-get-speed image))
+ (time (float-time))
+ (animation (image-multi-frame-p image))
+ ;; Subtract off the time we took to load the image from the
+ ;; stated delay time.
+ (delay (max (+ (* (or (cdr animation) image-default-frame-delay)
+ (/ 1.0 (abs speed)))
+ time (- (float-time)))
+ 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
+ (run-with-timer delay nil 'image-animate-timeout
+ image n count time-elapsed limit)))))
\f
+(defvar imagemagick-types-inhibit)
+(defvar imagemagick-enabled-types)
+
+(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
+that match `imagemagick-enabled-types' and do not match
+`imagemagick-types-inhibit'."
+ (when (fboundp 'imagemagick-types)
+ (cond ((null imagemagick-enabled-types) nil)
+ ((eq imagemagick-types-inhibit t) nil)
+ (t
+ (delq nil
+ (mapcar
+ (lambda (type)
+ (unless (memq type imagemagick-types-inhibit)
+ (if (eq imagemagick-enabled-types t) type
+ (catch 'found
+ (dolist (enable imagemagick-enabled-types nil)
+ (if (cond ((symbolp enable) (eq enable type))
+ ((stringp enable)
+ (string-match enable
+ (symbol-name type))))
+ (throw 'found type)))))))
+ (imagemagick-types)))))))
+
(defvar imagemagick--file-regexp nil
"File extension regexp for ImageMagick files, if any.
This is the extension installed into `auto-mode-alist' and
(defun imagemagick-register-types ()
"Register file types that can be handled by ImageMagick.
This function is called at startup, after loading the init file.
-It registers the ImageMagick types listed in `imagemagick-types',
-excluding those listed in `imagemagick-types-inhibit'.
+It registers the ImageMagick types returned by `imagemagick-filter-types'.
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'.
-If Emacs is compiled without ImageMagick support, do nothing."
+If Emacs is compiled without ImageMagick support, this does nothing."
(when (fboundp 'imagemagick-types)
- (let ((re (if (eq imagemagick-types-inhibit t)
- ;; Use a bogus regexp to inhibit matches.
- "\\'a"
- (let ((types))
- (dolist (type (imagemagick-types))
- (unless (memq type imagemagick-types-inhibit)
- (push (downcase (symbol-name type)) types)))
- (concat "\\." (regexp-opt types) "\\'"))))
- (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 ama-elt
- (setcar ama-elt re)
- (push (cons re 'image-mode) auto-mode-alist))
- (if itfnr-elt
- (setcar itfnr-elt re)
- (push (cons re 'imagemagick) image-type-file-name-regexps))
+ (let* ((types (mapcar (lambda (type) (downcase (symbol-name type)))
+ (imagemagick-filter-types)))
+ (re (if types (concat "\\." (regexp-opt types) "\\'")))
+ (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)
+ ;; 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)))
(setq imagemagick--file-regexp re))))
(defcustom imagemagick-types-inhibit
- '(C HTML HTM TXT PDF)
- "List of ImageMagick types that should not be treated as images.
+ '(C HTML HTM INFO M TXT PDF)
+ "List of ImageMagick types that should never be treated as images.
This should be a list of symbols, each of which should be one of
-the ImageMagick types listed in `imagemagick-types'. The listed
+the ImageMagick types listed by `imagemagick-types'. The listed
image types are not registered by `imagemagick-register-types'.
If the value is t, inhibit the use of ImageMagick for images.
+If you change this without using customize, you must call
+`imagemagick-register-types' afterwards.
+
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))
+ :initialize 'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(imagemagick-register-types))
- :version "24.1"
+ :version "24.3"
:group 'image)
+(defcustom imagemagick-enabled-types
+ '(3FR ART ARW AVS BMP BMP2 BMP3 CAL CALS CMYK CMYKA CR2 CRW
+ 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)
+ "List of ImageMagick types to treat as images.
+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.
+
+The value of `imagemagick-enabled-types' may also be t, meaning
+to enable all types that ImageMagick supports.
+
+The variable `imagemagick-types-inhibit' overrides this variable.
+
+If you change this without using customize, you must call
+`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"))))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (imagemagick-register-types))
+ :version "24.3"
+ :group 'image)
+
+(imagemagick-register-types)
+
(provide 'image)
;;; image.el ends here