Bump version to 24.0.94
[bpt/emacs.git] / lisp / image.el
index f93fd03..ab3f437 100644 (file)
@@ -1,7 +1,6 @@
 ;;; image.el --- image API
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012  Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: multimedia
@@ -61,7 +60,7 @@ 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.")
 
-(defconst image-type-file-name-regexps
+(defvar image-type-file-name-regexps
   '(("\\.png\\'" . png)
     ("\\.gif\\'" . gif)
     ("\\.jpe?g\\'" . jpeg)
@@ -208,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."
@@ -330,6 +331,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")
@@ -390,6 +395,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
@@ -413,8 +419,8 @@ means display it in the right marginal area."
 (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'
@@ -591,39 +597,43 @@ Example:
 \f
 ;;; 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."
@@ -632,98 +642,84 @@ 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))))
 
 \f
 (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)
+  "ImageMagick types that Emacs should not use ImageMagick to handle.
+This should be a list of symbols, each of which has the same
+name as one of the format tags used internally by ImageMagick;
+see `imagemagick-types'.  Entries in this list are excluded from
+being registered by `imagemagick-register-types', so if you change
+this variable you must do so before you call that function.
+
+If Emacs is compiled without ImageMagick, this variable has no effect."
+  :type '(choice (const :tag "Let ImageMagick handle all types it can" nil)
                 (repeat symbol))
+  ;; Ideally, would have a :set function that checks if we already did
+  ;; imagemagick-register-types, and if so undoes it, then redoes it.
   :version "24.1"
   :group 'image)
 
 ;;;###autoload
 (defun imagemagick-register-types ()
-  "Register the file types that ImageMagick is able to handle."
-  (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)))))
+  "Register file types that can be handled by ImageMagick.
+This adds the file types returned by `imagemagick-types'
+\(excluding the ones in `imagemagick-types-inhibit') to
+`auto-mode-alist' and `image-type-file-name-regexps', so that
+Emacs visits them in Image mode.
+
+If Emacs is compiled without ImageMagick support, do nothing."
+  (when (fboundp 'imagemagick-types)
+    (let ((im-types '()))
+      (dolist (im-type (imagemagick-types))
+        (unless (memq im-type imagemagick-types-inhibit)
+          (push (downcase (symbol-name im-type)) im-types)))
+      (let ((extension (concat "\\." (regexp-opt im-types) "\\'")))
+        (push (cons extension 'image-mode) auto-mode-alist)
+        (push (cons extension 'imagemagick)
+              image-type-file-name-regexps)))))
 
 (provide 'image)
 
-;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3
 ;;; image.el ends here