* lisp/erc/erc.el: Fix comment.

[bpt/emacs.git] / lisp / gnus / gnus-art.el

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index e03c787..7e2d213 100644 (file)
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4418,6 +4418,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
     (gnus-run-hooks 'gnus-article-menu-hook)))
 
 (defvar bookmark-make-record-function)
+(defvar shr-put-image-function)
 
 (defun gnus-article-mode ()
   "Major mode for displaying an article.
@@ -4461,6 +4462,8 @@ commands:
   ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space'
   ;; face.
   (set (make-local-variable 'nobreak-char-display) nil)
+  ;; Enable `gnus-article-remove-images' to delete images shr.el renders.
+  (set (make-local-variable 'shr-put-image-function) 'gnus-shr-put-image)
   (setq cursor-in-non-selected-windows nil)
   (gnus-set-default-directory)
   (buffer-disable-undo)
@@ -4506,6 +4509,7 @@ commands:
                 t)))
        (with-current-buffer name
          (set (make-local-variable 'gnus-article-edit-mode) nil)
+         (gnus-article-stop-animations)
          (when gnus-article-mime-handles
            (mm-destroy-parts gnus-article-mime-handles)
            (setq gnus-article-mime-handles nil))
@@ -4530,6 +4534,12 @@ commands:
          (gnus-start-date-timer gnus-article-update-date-headers))
        (current-buffer)))))
 
+(defun gnus-article-stop-animations ()
+  (dolist (timer (and (boundp 'timer-list)
+                     timer-list))
+    (when (eq (aref timer 5) 'image-animate-timeout)
+      (cancel-timer timer))))
+
 ;; Set article window start at LINE, where LINE is the number of lines
 ;; from the head of the article.
 (defun gnus-article-set-window-start (&optional line)
@@ -5045,7 +5055,7 @@ Deleting parts may malfunction or destroy the article; continue? "))
            (let ((desc (mm-handle-description data)))
              (when desc
                (mail-decode-encoded-word-string desc))))
-          (filename (or (mm-handle-filename (mm-handle-disposition data)) "(none)"))
+          (filename (or (mm-handle-filename data) "(none)"))
           (type (mm-handle-media-type data)))
       (unless data
        (error "No MIME part under point"))
@@ -6139,6 +6149,15 @@ Provided for backwards compatibility."
             (not gnus-inhibit-hiding))
     (gnus-article-hide-headers)))
 
+(declare-function shr-put-image "shr" (data alt))
+
+(defun gnus-shr-put-image (data alt)
+  "Put image DATA with a string ALT.  Enable image to be deleted."
+  (let ((image (shr-put-image data (propertize (or alt "*")
+                                              'gnus-image-category 'shr))))
+    (when image
+      (gnus-add-image 'shr image))))
+
 ;;; Article savers.
 
 (defun gnus-output-to-file (file-name)
@@ -6813,23 +6832,16 @@ If given a prefix, show the hidden text instead."
                (numberp article))
            (let ((gnus-override-method gnus-override-method)
                  (methods (and (stringp article)
-                               gnus-refer-article-method))
+                               (with-current-buffer gnus-summary-buffer
+                                 (gnus-refer-article-methods))))
                  (backend (car (gnus-find-method-for-group
                                 gnus-newsgroup-name)))
                  result
                  (inhibit-read-only t))
-             (if (or (not (listp methods))
-                     (and (symbolp (car methods))
-                          (assq (car methods) nnoo-definition-alist)))
-                 (setq methods (list methods)))
              (when (and (null gnus-override-method)
                         methods)
                (setq gnus-override-method (pop methods)))
              (while (not result)
-               (when (eq gnus-override-method 'current)
-                 (setq gnus-override-method
-                       (with-current-buffer gnus-summary-buffer
-                         gnus-current-select-method)))
                (erase-buffer)
                (gnus-kill-all-overlays)
                (let ((gnus-newsgroup-name group))
@@ -6841,7 +6853,10 @@ If given a prefix, show the hidden text instead."
                                              gnus-summary-buffer)
                    (when gnus-keep-backlog
                      (gnus-backlog-enter-article
-                      group article (current-buffer))))
+                      group article (current-buffer)))
+                   (when (and gnus-agent
+                              (gnus-agent-group-covered-p group))
+                     (gnus-agent-store-article article group)))
                  (setq result 'article))
                 (methods
                  (setq gnus-override-method (pop methods)))