Fixups when displaying certain attachments

[gnus] / lisp / gnus-logic.el

diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el
index 0f93173..6321821 100644 (file)
--- a/lisp/gnus-logic.el
+++ b/lisp/gnus-logic.el
@@ -1,7 +1,6 @@
 ;;; gnus-logic.el --- advanced scoring code for Gnus
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -179,51 +178,55 @@
 (defun gnus-advanced-body (header match type)
   (when (string= header "all")
     (setq header "article"))
-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer
     (let* ((request-func (cond ((string= "head" header)
-                               'gnus-request-head)
-                              ((string= "body" header)
-                               'gnus-request-body)
-                              (t 'gnus-request-article)))
-          ofunc article)
+                                'gnus-request-head)
+                               ((string= "body" header)
+                                'gnus-request-body)
+                               (t 'gnus-request-article)))
+           ofunc article handles)
       ;; Not all backends support partial fetching.  In that case, we
       ;; just fetch the entire article.
-      (unless (gnus-check-backend-function
-              (intern (concat "request-" header))
-              gnus-newsgroup-name)
-       (setq ofunc request-func)
-       (setq request-func 'gnus-request-article))
+      ;; When scoring by body, we need to peek at the headers to detect the
+      ;; content encoding
+      (unless (or (gnus-check-backend-function
+                   (intern (concat "request-" header))
+                   gnus-newsgroup-name)
+                  (string= "body" header))
+        (setq ofunc request-func)
+        (setq request-func 'gnus-request-article))
       (setq article (mail-header-number gnus-advanced-headers))
       (gnus-message 7 "Scoring article %s..." article)
       (when (funcall request-func article gnus-newsgroup-name)
-       (goto-char (point-min))
-       ;; If just parts of the article is to be searched and the
-       ;; backend didn't support partial fetching, we just narrow to
-       ;; the relevant parts.
-       (when ofunc
-         (if (eq ofunc 'gnus-request-head)
-             (narrow-to-region
-              (point)
-              (or (search-forward "\n\n" nil t) (point-max)))
-           (narrow-to-region
-            (or (search-forward "\n\n" nil t) (point))
-            (point-max))))
-       (let* ((case-fold-search (not (eq (downcase (symbol-name type))
-                                         (symbol-name type))))
-              (search-func
-               (cond ((memq type '(r R regexp Regexp))
-                      're-search-forward)
-                     ((memq type '(s S string String))
-                      'search-forward)
-                     (t
-                      (error "Invalid match type: %s" type)))))
-         (goto-char (point-min))
-         (prog1
-             (funcall search-func match nil t)
-           (widen)))))))
+        (when (string= "body" header)
+          (setq handles (gnus-score-decode-text-parts)))
+        (goto-char (point-min))
+        ;; If just parts of the article is to be searched and the
+        ;; backend didn't support partial fetching, we just narrow to
+        ;; the relevant parts.
+        (when ofunc
+          (if (eq ofunc 'gnus-request-head)
+              (narrow-to-region
+               (point)
+               (or (search-forward "\n\n" nil t) (point-max)))
+            (narrow-to-region
+             (or (search-forward "\n\n" nil t) (point))
+             (point-max))))
+        (let* ((case-fold-search (not (eq (downcase (symbol-name type))
+                                          (symbol-name type))))
+               (search-func
+                (cond ((memq type '(r R regexp Regexp))
+                       're-search-forward)
+                      ((memq type '(s S string String))
+                       'search-forward)
+                      (t
+                       (error "Invalid match type: %s" type)))))
+          (goto-char (point-min))
+          (prog1
+              (funcall search-func match nil t)
+            (widen)))
+        (when handles (mm-destroy-parts handles))))))
 
 (provide 'gnus-logic)
 
-;; arch-tag: 9651a100-4a59-4b69-a55b-e511e67c0f8d
 ;;; gnus-logic.el ends here