X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=7f3ab5e27b151c88d208da2c531b1efda6c5b211;hp=f215b84551499cee6de7a0f67beac8251a9e2ce2;hb=997404c721a1de533aa9f82d4d5bbc5447bfc23d;hpb=f6b456bf14e4638970fbe61de6be8ccd525b0b5a

diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index f215b8455..7f3ab5e27 100644
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -1,6 +1,6 @@
 ;;; gnus-score.el --- scoring code for Gnus
 
-;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
 ;;	Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -33,6 +33,7 @@
 (require 'gnus-win)
 (require 'message)
 (require 'score-mode)
+(require 'gmm-utils)
 
 (defcustom gnus-global-score-files nil
   "List of global score files and directories.
@@ -1070,10 +1071,15 @@ EXTRA is the possible non-standard header."
 	(push (cons article n) gnus-newsgroup-scored)))
     (gnus-summary-update-line)))
 
-(defun gnus-summary-current-score ()
-  "Return the score of the current article."
-  (interactive)
-  (gnus-message 1 "%s" (gnus-summary-article-score)))
+(defun gnus-summary-current-score (arg)
+  "Return the score of the current article.
+  With prefix ARG, return the total score of the current (sub)thread."
+  (interactive "P")
+  (gnus-message 1 "%s" (if arg
+			   (gnus-thread-total-score
+			    (gnus-id-to-thread
+			     (mail-header-id (gnus-summary-article-header))))
+			   (gnus-summary-article-score))))
 
 (defun gnus-score-change-score-file (file)
   "Change current score alist."
@@ -1718,33 +1724,37 @@ score in `gnus-newsgroup-scored' by SCORE."
   nil)
 
 (defun gnus-score-decode-text-parts ()
-  (labels ((mm-text-parts (handle)
-                        (cond ((stringp (car handle))
-                               (let ((parts (mapcan #'mm-text-parts (cdr handle))))
-                                 (if (equal "multipart/alternative" (car handle))
-                                     ;; pick the first supported alternative
-                                     (list (car parts))
-                                   parts)))
-
-                              ((bufferp (car handle))
-                               (when (string-match "^text/" (mm-handle-media-type handle))
-                                 (list handle)))
-
-                              (t (mapcan #'mm-text-parts handle))))
-           (my-mm-display-part (handle)
-                               (when handle
-                                 (save-restriction
-                                   (narrow-to-region (point) (point))
-                                   (mm-display-inline handle)
-                                   (goto-char (point-max))))))
+  (gmm-labels
+      ((mm-text-parts
+	(handle)
+	(cond ((stringp (car handle))
+	       (let ((parts (apply #'append
+				   (mapcar #'mm-text-parts (cdr handle)))))
+		 (if (equal "multipart/alternative" (car handle))
+		     ;; pick the first supported alternative
+		     (list (car parts))
+		   parts)))
+
+	      ((bufferp (car handle))
+	       (when (string-match "^text/" (mm-handle-media-type handle))
+		 (list handle)))
+
+	      (t (apply #'append (mapcar #'mm-text-parts handle)))))
+       (my-mm-display-part
+	(handle)
+	(when handle
+	  (save-restriction
+	    (narrow-to-region (point) (point))
+	    (mm-display-inline handle)
+	    (goto-char (point-max))))))
 
     (let (;(mm-text-html-renderer 'w3m-standalone)
-          (handles (mm-dissect-buffer t)))
+	  (handles (mm-dissect-buffer t)))
       (save-excursion
-        (article-goto-body)
-        (delete-region (point) (point-max))
-        (mapc #'my-mm-display-part (mm-text-parts handles))
-        handles))))
+	(article-goto-body)
+	(delete-region (point) (point-max))
+	(mapc #'my-mm-display-part (mm-text-parts handles))
+	handles))))
 
 (defun gnus-score-body (scores header now expire &optional trace)
     (if gnus-agent-fetching
@@ -1762,21 +1772,22 @@ score in `gnus-newsgroup-scored' by SCORE."
                 (all-scores scores)
                 (request-func (cond ((string= "head" header)
                                      'gnus-request-head)
-                                    ;; We need to peek at the headers to detect
-                                    ;; the content encoding
                                     ((string= "body" header)
-                                     'gnus-request-article)
+                                     'gnus-request-body)
                                     (t 'gnus-request-article)))
                 entries alist ofunc article last)
            (when articles
              (setq last (mail-header-number (caar (last articles))))
              ;; Not all backends support partial fetching.  In that case,
              ;; we just fetch the entire article.
-             (unless (gnus-check-backend-function
-                      (and (string-match "^gnus-" (symbol-name request-func))
-                           (intern (substring (symbol-name request-func)
-                                              (match-end 0))))
-                      gnus-newsgroup-name)
+             ;; When scoring by body, we need to peek at the headers to detect
+             ;; the content encoding
+             (unless (or (gnus-check-backend-function
+                          (and (string-match "^gnus-" (symbol-name request-func))
+                               (intern (substring (symbol-name request-func)
+                                                  (match-end 0))))
+                          gnus-newsgroup-name)
+                         (string= "body" header))
                (setq ofunc request-func)
                (setq request-func 'gnus-request-article))
              (while articles