[Emacs-diffs] /srv/bzr/emacs/trunk r102330: nnir.el (nnir-request-move-article): fix to provide original group and subject.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 102330
author: Andrew Cohen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Thu 2010-11-11 02:10:07 +0000
message:
  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.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/gnus-sum.el
  lisp/gnus/nnir.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-11-11 01:45:05 +0000
+++ b/lisp/gnus/ChangeLog       2010-11-11 02:10:07 +0000
@@ -1,3 +1,13 @@
+2010-11-11  Andrew Cohen  <address@hidden>
+
+       * 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  <address@hidden>
 
        * gnus-art.el (article-treat-non-ascii): Make it work for XEmacs (at

=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el     2010-11-09 22:17:36 +0000
+++ b/lisp/gnus/gnus-sum.el     2010-11-11 02:10:07 +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.

=== modified file 'lisp/gnus/nnir.el'
--- a/lisp/gnus/nnir.el 2010-11-07 00:22:06 +0000
+++ b/lisp/gnus/nnir.el 2010-11-11 02:10:07 +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))