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.

3 files changed, 35 insertions, 11 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ef0d6037152..a9cb50e8036 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -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
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 97155100da3..9729480d902 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1310,6 +1310,7 @@ the normal Gnus MIME machinery."
 (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 @@ the normal Gnus MIME machinery."
 (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 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                   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 can be either `move' (the default), `crosspost' or `copy'."
                               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 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                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 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
 
     (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.
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index ae6b903c047..30ffea9dac9 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -548,8 +548,6 @@ result, `gnus-retrieve-headers' will be called instead.")
         ;; 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 @@ result, `gnus-retrieve-headers' will be called instead.")
          (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 @@ result, `gnus-retrieve-headers' will be called instead.")
      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 @@ artitem (counting from 1)."
       (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))