X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5fd6245244e1ec0720a8236a90f352bc8921fa38..758c81e87ded2bad9f5a5a6683fb498965eb508c:/lisp/image.el diff --git a/lisp/image.el b/lisp/image.el index 3b90ac46bd..27e41a57ef 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1,6 +1,6 @@ ;;; image.el --- image API -;; Copyright (C) 1998-2011 Free Software Foundation, Inc. +;; Copyright (C) 1998-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: multimedia @@ -163,7 +163,7 @@ compatibility with versions of Emacs that lack the variable dir (expand-file-name "../" dir)))) (setq image-directory-load-path dir)) - ;; If `image-directory-load-path' isn't Emacs' image directory, + ;; If `image-directory-load-path' isn't Emacs's image directory, ;; it's probably a user preference, so use it. Then use a ;; relative setting if possible; otherwise, use ;; `image-directory-load-path'. @@ -194,7 +194,7 @@ compatibility with versions of Emacs that lack the variable ;; 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))))) - ;; Use Emacs' image directory. + ;; Use Emacs's image directory. (image-directory-load-path (setq image-directory image-directory-load-path)) (no-error @@ -207,6 +207,8 @@ compatibility with versions of Emacs that lack the variable (delete image-directory (copy-sequence (or path load-path)))))) +;; Used to be in image-type-header-regexps, but now not used anywhere +;; (since 2009-08-28). (defun image-jpeg-p (data) "Value is non-nil if DATA, a string, consists of JFIF image data. We accept the tag Exif because that is the same format." @@ -280,7 +282,9 @@ be determined." types nil) (setq types (cdr types))))) (goto-char opoint) - type)) + (and type + (memq type image-types) + type))) ;;;###autoload @@ -329,6 +333,10 @@ Optional DATA-P non-nil means SOURCE is a string containing image data." type) +(if (fboundp 'image-metadata) ; eg not --without-x + (define-obsolete-function-alias 'image-extension-data + 'image-metadata' "24.1")) + (define-obsolete-variable-alias 'image-library-alist 'dynamic-library-alist "24.1") @@ -389,6 +397,7 @@ IMAGE must be an image created with `create-image' or `defimage'. 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 image. STRING is defaulted if you omit it. +The overlay created will have the `put-image' property set to t. 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 @@ -405,15 +414,16 @@ means display it in the right marginal area." (prop (if (null area) image (list (list 'margin area) image)))) (put-text-property 0 (length string) 'display prop string) (overlay-put overlay 'put-image t) - (overlay-put overlay 'before-string string)))) + (overlay-put overlay 'before-string string) + overlay))) ;;;###autoload (defun insert-image (image &optional string area slice) "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. STRING +defaults to the empty string 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' @@ -590,39 +600,43 @@ Example: ;;; Animated image API -(defcustom image-animate-max-time 30 - "Time in seconds to animate images." - :type 'integer - :version "24.1" - :group 'image) - (defconst image-animated-types '(gif) "List of supported animated image types.") -;;;###autoload -(defun create-animated-image (file-or-data &optional type data-p &rest props) - "Create an animated image. -FILE-OR-DATA is an image file name or image data. -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. -Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. -Optional PROPS are additional image attributes to assign to the image, -like, e.g. `:mask MASK'. -Value is the image created, or nil if images of type TYPE are not supported. - -Images should not be larger than specified by `max-image-size'." - (setq type (image-type file-or-data type data-p)) - (when (image-type-available-p type) - (let* ((animate (memq type image-animated-types)) - (image - (append (list 'image :type type (if data-p :data :file) file-or-data) - (if animate '(:index 0)) - props))) - (if animate - (image-animate-start image)) - image))) +(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) + (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)))))) + +;; "Destructively"? +(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." + (let ((animation (image-animated-p image)) + timer) + (when animation + (if (setq timer (image-animate-timer image)) + (cancel-timer timer)) + (run-with-timer 0.2 nil 'image-animate-timeout + image (or index 0) (car animation) + 0 limit)))) (defun image-animate-timer (image) "Return the animation timer for image IMAGE." @@ -631,99 +645,107 @@ Images should not be larger than specified by `max-image-size'." (while tail (setq timer (car tail) tail (cdr tail)) - (if (and (eq (aref timer 5) #'image-animate-timeout) - (consp (aref timer 6)) - (eq (car (aref timer 6)) image)) + (if (and (eq (aref timer 5) 'image-animate-timeout) + (eq (car-safe (aref timer 6)) image)) (setq tail nil) (setq timer nil))) timer)) -(defun image-animate-start (image &optional max-time) - "Start animation of image IMAGE. -Optional second arg MAX-TIME is number of seconds to animate image, -or t to animate infinitely." - (let ((anim (image-animated-p image)) - timer tmo) - (when anim - (if (setq timer (image-animate-timer image)) - (setcar (nthcdr 3 (aref timer 6)) max-time) - (setq tmo (* (cdr anim) 0.01)) - (setq max-time (or max-time image-animate-max-time)) - (run-with-timer tmo nil #'image-animate-timeout - image 1 (car anim) - (if (numberp max-time) - (- max-time tmo) - max-time)))))) - -(defun image-animate-stop (image) - "Stop animation of image." - (let ((timer (image-animate-timer image))) - (when timer - (cancel-timer timer)))) - -(defun image-animate-timeout (image ino count time-left) - (if (>= ino count) - (setq ino 0)) - (plist-put (cdr image) :index ino) +;; FIXME? The delay may not be the same for different sub-images, +;; hence we need to call image-animated-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) + "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. +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) - (let ((anim (image-animated-p image)) tmo) - (when anim - (setq tmo (* (cdr anim) 0.01)) - (unless (and (= ino 0) (numberp time-left) (< time-left tmo)) - (run-with-timer tmo nil #'image-animate-timeout - image (1+ ino) count - (if (numberp time-left) - (- time-left tmo) - time-left)))))) - -(defun image-animated-p (image) - "Return non-nil if image is animated. -Actually, return value is a cons (IMAGES . DELAY) where IMAGES -is the number of sub-images in the animated image, and DELAY -is the delay in 100ths of a second until the next sub-image -shall be displayed." - (cond - ((eq (plist-get (cdr image) :type) 'gif) - (let* ((metadata (image-metadata image)) - (images (plist-get metadata 'count)) - (extdata (plist-get metadata 'extension-data)) - (anim (plist-get extdata #xF9)) - (tmo (and (integerp images) (> images 1) - (stringp anim) (>= (length anim) 4) - (+ (aref anim 1) (* (aref anim 2) 256))))) - (when tmo - (if (eq tmo 0) (setq tmo 10)) - (cons images tmo)))))) + (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)))) +(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'.") + +;;;###autoload +(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'. + +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." + (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)) + (setq imagemagick--file-regexp re)))) + (defcustom imagemagick-types-inhibit '(C HTML HTM TXT PDF) - ;; FIXME what are the possible options? - ;; Are these actually file-name extensions? - ;; Why are these upper-case when eg image-types is lower-case? - "Types the ImageMagick loader should not try to handle." - :type '(choice (const :tag "Let ImageMagick handle all the types it can" nil) + "List of ImageMagick types that should not 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 +image types are not registered by `imagemagick-register-types'. + +If the value is t, inhibit the use of ImageMagick for images. + +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)) + :set (lambda (symbol value) + (set-default symbol value) + (imagemagick-register-types)) :version "24.1" :group 'image) -;;;###autoload -(defun imagemagick-register-types () - "Register the file types that ImageMagick is able to handle." - (if (fboundp 'imagemagick-types) - (let ((im-types (imagemagick-types))) - (dolist (im-inhibit imagemagick-types-inhibit) - (setq im-types (remove im-inhibit im-types))) - (dolist (im-type im-types) - (let ((extension (downcase (symbol-name im-type)))) - (push - (cons (concat "\\." extension "\\'") 'image-mode) - auto-mode-alist) - (push - (cons (concat "\\." extension "\\'") 'imagemagick) - image-type-file-name-regexps)))) - (error "Emacs was not built with ImageMagick support"))) - (provide 'image) ;;; image.el ends here