* message.el (message-yank-original): If `message-yank-add-new-references' is

non-nil and this command is called interactively, new IDs from the yanked
article will be added to `References' field.
(message-yank-add-new-references): New user option.
(message-header-format-alist): Use `message-shorten-reference' for `References'
in default.
* gnus-msg.el (gnus-inews-yank-articles): Replace `References' field with the
gathered Message-IDs and References if more than one articles are given.

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index e8788c8..f72d759 100644 (file)
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -6,6 +6,7 @@
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;     Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
 ;;     Katsumi Yamaoka  <yamaoka@jpl.org>
+;;     Kiyokazu SUTO    <suto@merry.xmath.ous.ac.jp>
 ;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
@@ -351,10 +352,11 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
   (gnus-summary-followup (gnus-summary-work-articles arg) t))
 
 (defun gnus-inews-yank-articles (articles)
-  (let ((frame (when (and message-use-multi-frames
-                         (> (length articles) 1))
-                (window-frame (get-buffer-window (current-buffer)))))
-       beg article)
+  (let* ((more-than-one (> (length articles) 1))
+        (frame (when (and message-use-multi-frames more-than-one)
+                 (window-frame (get-buffer-window (current-buffer)))))
+        (refs "")
+        beg article references)
     (message-goto-body)
     (while (setq article (pop articles))
       (save-window-excursion
@@ -363,7 +365,19 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
        (gnus-summary-remove-process-mark article))
       (when frame
        (select-frame frame))
-      (gnus-copy-article-buffer)
+
+      ;; Gathering references.
+      (when more-than-one
+       (save-current-buffer
+         (set-buffer (gnus-copy-article-buffer))
+         (save-restriction
+           (message-narrow-to-head)
+           (setq refs (concat refs
+                              (or (message-fetch-field "references") "")
+                              " "
+                              (or (message-fetch-field "message-id") "")
+                              " ")))))
+
       (let ((message-reply-buffer gnus-article-copy)
            (message-reply-headers gnus-current-headers))
        (message-yank-original)
@@ -371,6 +385,31 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
       (when articles
        (insert "\n")))
     (push-mark)
+
+    ;; Eliminate duplicated references.
+    (unless (string-match "^ *$" refs)
+      (mapcar
+       (lambda (ref)
+        (or (zerop (length ref))
+            (member ref references)
+            (setq references (append references (list ref)))))
+       (split-string refs)))
+
+    ;; Replace with the gathered references.
+    (when references
+      (save-restriction
+       (message-narrow-to-headers)
+       (let ((case-fold-search t))
+         (if (re-search-forward "^References:\\([\t ]+.+\n\\)+" nil t)
+             (replace-match "")
+           (goto-char (point-max))))
+       (mail-header-format
+        (list (or (assq 'References message-header-format-alist)
+                  '(References . message-shorten-references)))
+        (list (cons 'References
+                    (mapconcat 'identity references " "))))
+       (backward-delete-char 1)))
+
     (goto-char beg)))
 
 (defun gnus-summary-cancel-article (&optional n symp)
@@ -728,7 +767,7 @@ If FULL-HEADERS (the prefix), include full headers when forwarding."
   "Digest and forwards all articles in this series to a newsgroup."
   (interactive "P")
   (gnus-summary-mail-digest n t))
- 
+
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
   (interactive "sResend message(s) to: \nP")

diff --git a/lisp/message.el b/lisp/message.el
index e254289..34fa4fc 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -625,6 +625,12 @@ The function `message-supersede' runs this hook."
   :type 'string
   :group 'message-insertion)
 
+(defcustom message-yank-add-new-references t
+  "*Non-nil means new IDs will be added to \"References\" field when an
+article is yanked by the command `message-yank-original' interactively."
+  :type 'boolean
+  :group 'message-insertion)
+
 (defcustom message-indentation-spaces 3
   "*Number of spaces to insert at the beginning of each cited line.
 Used by `message-yank-original' via `message-yank-cite'."
@@ -1136,7 +1142,7 @@ The cdr of ech entry is a function for applying the face to a region.")
     (Lines)
     (Expires)
     (Message-ID)
-    (References . message-fill-header)
+    (References . message-shorten-reference)
     (User-Agent))
   "Alist used for formatting headers.")
 
@@ -2027,14 +2033,54 @@ if `message-yank-prefix' is non-nil, insert that prefix on each line.
 This function uses `message-cite-function' to do the actual citing.
 
 Just \\[universal-argument] as argument means don't indent, insert no
-prefix, and don't delete any headers."
+prefix, and don't delete any headers.
+
+In addition, if `message-yank-add-new-references' is non-nil and this
+command is called interactively, new IDs from the yanked article will
+be added to \"References\" field."
   (interactive "P")
   (let ((modified (buffer-modified-p))
-       (buffer (message-eval-parameter message-reply-buffer)))
+       (buffer (message-eval-parameter message-reply-buffer))
+       refs references)
     (when (and buffer
               message-cite-function)
       (delete-windows-on buffer t)
-      (insert-buffer buffer)
+      (insert-buffer buffer) ; mark will be set at the end of article.
+
+      ;; Add new IDs to References field.
+      (when (and message-yank-add-new-references (interactive-p))
+       (save-excursion
+         (save-restriction
+           (narrow-to-region (point) (mark t))
+           (message-narrow-to-head)
+           (setq refs (concat (or (message-fetch-field "References") "")
+                              " "
+                              (or (message-fetch-field "Message-ID") "")))
+           (unless (string-match "^ +$" refs)
+             (widen)
+             (message-narrow-to-headers)
+             (setq references (message-fetch-field "References"))
+             (when references
+               (setq references (split-string references)))
+             (mapcar
+              (lambda (ref)
+                (or (zerop (length ref))
+                    (member ref references)
+                    (setq references (append references (list ref)))))
+              (split-string refs))
+             (when references
+               (goto-char (point-min))
+               (let ((case-fold-search t))
+                 (if (re-search-forward "^References:\\([\t ]+.+\n\\)+" nil t)
+                     (replace-match "")
+                   (goto-char (point-max))))
+               (mail-header-format
+                (list (or (assq 'References message-header-format-alist)
+                          '(References . message-shorten-references)))
+                (list (cons 'References
+                            (mapconcat 'identity references " "))))
+               (backward-delete-char 1))))))
+
       (funcall message-cite-function)
       (message-exchange-point-and-mark)
       (unless (bolp)