From 8fd1bb5a7559dfee155b167dcc605db47504b038 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 20 Jan 1999 10:50:41 +0000 Subject: [PATCH] * gnus.el (gnus-version-number): Update to 6.10.2. * gnus-draft.el: Add Ichikawa-san to authors. * message.el: Likewise. * 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-ignored-resent-headers): Default to "^Return-Receipt". * gnus-msg.el (gnus-inews-yank-articles): Replace `References' field with the gathered Message-IDs and References if more than one articles are given. --- lisp/gnus-draft.el | 1 + lisp/gnus-msg.el | 51 ++++++++++++++++++++++++++++++++++++++++++------ lisp/gnus.el | 2 +- lisp/message.el | 55 ++++++++++++++++++++++++++++++++++++++++++++++++---- 4 files changed, 98 insertions(+), 11 deletions(-) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 1b9b333..423b871 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -3,6 +3,7 @@ ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko +;; Tatsuya Ichikawa ;; Keywords: mail, news, MIME, offline ;; This file is part of GNU Emacs. diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 2da2e13..59752ab 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -6,6 +6,7 @@ ;; MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Katsumi Yamaoka +;; Kiyokazu SUTO ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -307,10 +308,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 @@ -319,7 +321,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) @@ -327,6 +341,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-fill-references))) + (list (cons 'References + (mapconcat 'identity references " ")))) + (backward-delete-char 1))) + (goto-char beg))) (defun gnus-summary-cancel-article (&optional n symp) @@ -689,7 +728,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/gnus.el b/lisp/gnus.el index e36f1e6..2cf74d8 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -253,7 +253,7 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "Semi-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.1" +(defconst gnus-version-number "6.10.2" "Version number for this version of gnus.") (defconst gnus-version diff --git a/lisp/message.el b/lisp/message.el index 21576e3..7913af8 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -5,6 +5,7 @@ ;; MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Keiichi Suzuki +;; Tatsuya Ichikawa ;; Katsumi Yamaoka ;; Keywords: mail, news, MIME @@ -360,7 +361,7 @@ The provided functions are: :group 'message-forwarding :type 'boolean) -(defcustom message-ignored-resent-headers "^Return-receipt" +(defcustom message-ignored-resent-headers "^Return-Receipt" "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :type 'regexp) @@ -534,6 +535,12 @@ nil means use indentation." :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'." @@ -1830,14 +1837,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-fill-references))) + (list (cons 'References + (mapconcat 'identity references " ")))) + (backward-delete-char 1)))))) + (funcall message-cite-function) (message-exchange-point-and-mark) (unless (bolp) -- 1.7.10.4