changeset 111482:0aa164743cb3

nnir.el (nnir-request-move-article): fix to provide original group and subject. nnir.el (nnir-warp-to-article): don't fail on articles whose headers haven't been retrieved. gnus-sum.el (gnus-summary-move-article): use original group and subject for virtual articles such as those in an nnir summary buffer.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Thu, 11 Nov 2010 02:10:07 +0000
parents 91870c82d547
children cb708cc9a9f4
files lisp/gnus/ChangeLog lisp/gnus/gnus-sum.el lisp/gnus/nnir.el
diffstat 3 files changed, 35 insertions(+), 11 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Thu Nov 11 01:45:05 2010 +0000
+++ b/lisp/gnus/ChangeLog	Thu Nov 11 02:10:07 2010 +0000
@@ -1,3 +1,13 @@
+2010-11-11  Andrew Cohen  <cohen@andy.bu.edu>
+
+	* nnir.el (nnir-request-move-article): fix to provide original group
+	and subject.
+	(nnir-warp-to-article): don't fail on articles whose headers haven't
+	been retrieved.
+
+	* gnus-sum.el (gnus-summary-move-article): use original group and
+	subject for virtual articles such as those in an nnir summary buffer.
+
 2010-11-11  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* gnus-art.el (article-treat-non-ascii): Make it work for XEmacs (at
--- a/lisp/gnus/gnus-sum.el	Thu Nov 11 01:45:05 2010 +0000
+++ b/lisp/gnus/gnus-sum.el	Thu Nov 11 02:10:07 2010 +0000
@@ -1310,6 +1310,7 @@
 (defvar gnus-article-decoded-p nil)
 (defvar gnus-article-charset nil)
 (defvar gnus-article-ignored-charsets nil)
+(defvar gnus-article-original-subject nil)
 (defvar gnus-scores-exclude-files nil)
 (defvar gnus-page-broken nil)
 
@@ -1335,6 +1336,7 @@
 (defvar gnus-current-copy-group nil)
 (defvar gnus-current-crosspost-group nil)
 (defvar gnus-newsgroup-display nil)
+(defvar gnus-newsgroup-original-name nil)
 
 (defvar gnus-newsgroup-dependencies nil)
 (defvar gnus-newsgroup-adaptive nil)
@@ -9703,6 +9705,10 @@
 		  articles)
     (while articles
       (setq article (pop articles))
+      (let ((gnus-newsgroup-original-name gnus-newsgroup-name)
+	    (gnus-article-original-subject
+	     (mail-header-subject
+	      (gnus-data-header (assoc article (gnus-data-list nil))))))
       (setq
        art-group
        (cond
@@ -9781,7 +9787,7 @@
 			      action
 			      (gnus-data-header
 			       (assoc article (gnus-data-list nil)))
-			      gnus-newsgroup-name nil
+			      gnus-newsgroup-original-name nil
 			      select-method)))
        (t
 	(let* ((pto-group (gnus-group-prefixed-name
@@ -9877,13 +9883,16 @@
 	       article gnus-newsgroup-name (current-buffer) t)))
 
 	  ;; run the move/copy/crosspost/respool hook
+	  (let ((header (gnus-data-header
+			 (assoc article (gnus-data-list nil)))))
+	    (mail-header-set-subject header gnus-article-original-subject)
 	  (run-hook-with-args 'gnus-summary-article-move-hook
 			      action
 			      (gnus-data-header
 			       (assoc article (gnus-data-list nil)))
-			      gnus-newsgroup-name
+			      gnus-newsgroup-original-name
 			      to-newsgroup
-			      select-method))
+			      select-method)))
 
 	;;;!!!Why is this necessary?
 	(set-buffer gnus-summary-buffer)
@@ -9903,7 +9912,7 @@
 
     (gnus-kill-buffer copy-buf)
     (gnus-summary-position-point)
-    (gnus-set-mode-line 'summary)))
+    (gnus-set-mode-line 'summary))))
 
 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
   "Copy the current article to some other group.
--- a/lisp/gnus/nnir.el	Thu Nov 11 01:45:05 2010 +0000
+++ b/lisp/gnus/nnir.el	Thu Nov 11 02:10:07 2010 +0000
@@ -548,8 +548,6 @@
         ;; in nnir group
 	(when novitem
 	  (mail-header-set-number novitem art)
-	  (mail-header-set-from novitem
-				(mail-header-from novitem))
 	  (mail-header-set-subject
 	   novitem
 	   (format "[%d: %s/%d] %s"
@@ -595,7 +593,13 @@
 	 (to-newsgroup (nth 1 accept-form))
 	 (to-method (gnus-find-method-for-group to-newsgroup))
 	 (from-method (gnus-find-method-for-group artfullgroup))
-	 (move-is-internal (gnus-server-equal from-method to-method)))
+	 (move-is-internal (gnus-server-equal from-method to-method))
+	 (artsubject (mail-header-subject
+		      (gnus-data-header
+		       (assoc article (gnus-data-list nil))))))
+    (setq gnus-newsgroup-original-name artfullgroup)
+    (string-match "^\\[[0-9]+:.+/[0-9]+\\] " artsubject)
+    (setq gnus-article-original-subject (substring artsubject (match-end 0)))
     (gnus-request-move-article
      artno
      artfullgroup
@@ -604,11 +608,12 @@
      last
      (and move-is-internal
 	  to-newsgroup		; Not respooling
-	  (gnus-group-real-name to-newsgroup))) ; Is this move internal
-    ))
+	  (gnus-group-real-name to-newsgroup)))))
 
 (deffoo nnir-warp-to-article ()
-  (let* ((cur (gnus-summary-article-number))
+  (let* ((cur (if (> (gnus-summary-article-number) 0)
+		  (gnus-summary-article-number)
+		(error "This is not a real article.")))
          (gnus-newsgroup-name (nnir-artlist-artitem-group nnir-artlist cur))
          (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
     (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer
@@ -1475,7 +1480,7 @@
       (let ((server (gnus-group-server var)))
 	(if (assoc server value)
 	    (nconc (cdr (assoc server value)) (list var))
-	  (push (cons (gnus-group-server var) (list var)) value))))
+	  (push (cons server (list var)) value))))
     value)
   nil))