From: yamaoka Date: Wed, 20 Jan 1999 10:51:35 +0000 (+0000) Subject: * message.el (message-yank-original): If `message-yank-add-new-references' is X-Git-Tag: pgnus-ichikawa-199901201900~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=6599329bd3a769d5c27e7ea2270e324957908c34;p=elisp%2Fgnus.git- * 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 --- 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. @@ -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 --- 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)