Allow stopping animations automatically when the image disappears

* lisp/image.el (image-animate): Allow the animation to be stopped
automatically when the image is removed from the buffer.
(image-animate-timeout): Stop the animation if the image is
removed (and that has been requested).

* lisp/net/shr.el (shr-put-image): Stop animations if the image is
removed.

2 files changed, 65 insertions, 44 deletions

diff --git a/lisp/image.el b/lisp/image.el
index a149caa1a97..edbf6c54df6 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -836,15 +836,18 @@ in which case you might want to use `image-default-frame-delay'."
 
 (make-obsolete 'image-animated-p 'image-multi-frame-p "24.4")
 
-;; "Destructively"?
-(defun image-animate (image &optional index limit)
+(defun image-animate (image &optional index limit position)
   "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."
+number, play until that number of seconds has elapsed.
+
+If POSITION (which should be buffer position where the image is
+displayed), stop the animation if the image is no longer
+displayed."
   (let ((animation (image-multi-frame-p image))
         timer)
     (when animation
@@ -852,6 +855,9 @@ number, play until that number of seconds has elapsed."
           (cancel-timer timer))
       (plist-put (cdr image) :animate-buffer (current-buffer))
       (plist-put (cdr image) :animate-tardiness 0)
+      (when position
+        (plist-put (cdr image) :animate-position
+                   (set-marker (make-marker) position (current-buffer))))
       ;; Stash the data about the animation here so that we don't
       ;; trigger image recomputation unnecessarily later.
       (plist-put (cdr image) :animate-multi-frame-data animation)
@@ -925,40 +931,54 @@ for the animation speed.  A negative value means to animate in reverse."
   (plist-put (cdr image) :animate-tardiness
              (+ (* (plist-get (cdr image) :animate-tardiness) 0.9)
                 (float-time (time-since target-time))))
-  (when (and (buffer-live-p (plist-get (cdr image) :animate-buffer))
-             ;; Cumulatively delayed two seconds more than expected.
-             (or (< (plist-get (cdr image) :animate-tardiness) 2)
-                 (progn
-                   (message "Stopping animation; animation possibly too big")
-                   nil)))
-    (image-show-frame image n t)
-    (let* ((speed (image-animate-get-speed image))
-           (time (current-time))
-           (time-to-load-image (time-since time))
-           (stated-delay-time
-            (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data))
-                   image-default-frame-delay)
-               (float (abs speed))))
-           ;; Subtract off the time we took to load the image from the
-           ;; stated delay time.
-           (delay (max (float-time (time-subtract stated-delay-time
-                                                  time-to-load-image))
-                       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
-                        (+ (float-time) delay))))))
+  (let ((buffer (plist-get (cdr image) :animate-buffer))
+        (position (plist-get (cdr image) :animate-position)))
+    (when (and (buffer-live-p buffer)
+               ;; If we have a :animate-position setting, the caller
+               ;; has requested that the animation be stopped if the
+               ;; image is no longer displayed in the buffer.
+               (or (null position)
+                   (with-current-buffer buffer
+                     (let ((disp (get-text-property position 'display)))
+                       (and (consp disp)
+                            (eq (car disp) 'image)
+                            ;; We can't check `eq'-ness of the image
+                            ;; itself, since that may change.
+                            (eq position
+                                (plist-get (cdr disp) :animate-position))))))
+               ;; Cumulatively delayed two seconds more than expected.
+               (or (< (plist-get (cdr image) :animate-tardiness) 2)
+                   (progn
+                     (message "Stopping animation; animation possibly too big")
+                     nil)))
+      (image-show-frame image n t)
+      (let* ((speed (image-animate-get-speed image))
+             (time (current-time))
+             (time-to-load-image (time-since time))
+             (stated-delay-time
+              (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data))
+                     image-default-frame-delay)
+                 (float (abs speed))))
+             ;; Subtract off the time we took to load the image from the
+             ;; stated delay time.
+             (delay (max (float-time (time-subtract stated-delay-time
+                                                    time-to-load-image))
+                         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
+                          (+ (float-time) delay)))))))
 
 
 (defvar imagemagick-types-inhibit)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 71c18ff9947..19d324b16f2 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1174,13 +1174,14 @@ element is the data blob and the second element is the content-type."
           (when (and (> (current-column) 0)
                      (> (car (image-size image t)) 400))
             (insert "\n"))
-          (if (eq size 'original)
-              (insert-sliced-image image (or alt "*") nil 20 1)
-            (insert-image image (or alt "*")))
-          (put-text-property start (point) 'image-size size)
-          (when (and shr-image-animate
-                     (cdr (image-multi-frame-p image)))
-            (image-animate image nil 60)))
+          (let ((image-pos (point)))
+            (if (eq size 'original)
+                (insert-sliced-image image (or alt "*") nil 20 1)
+              (insert-image image (or alt "*")))
+            (put-text-property start (point) 'image-size size)
+            (when (and shr-image-animate
+                       (cdr (image-multi-frame-p image)))
+              (image-animate image nil 60 image-pos))))
         image)
     (insert (or alt ""))))