X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=a348dde52b06ecdc98ab19bf80be20b8745c827f;hb=refs%2Ftags%2Ft-gnus-6_15_4-04-quimby;hp=1627f279fbc1681aee089db58069acb6bfb64c6e;hpb=30c12502af1a1da8c50dbf27f1f1f1a552de9f7c;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 1627f27..a348dde 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -152,6 +152,8 @@ use this option with care." (defvar gnus-last-posting-server nil) (defvar gnus-message-group-art nil) +(defvar gnus-msg-force-broken-reply-to nil) + (defconst gnus-bug-message (format "Sending a bug report to the Gnus Towers. ======================================== @@ -213,6 +215,8 @@ Thank you for your help in stamping out bugs. "m" gnus-summary-mail-other-window "u" gnus-uu-post-news "\M-c" gnus-summary-mail-crosspost-complaint + "Br" gnus-summary-reply-broken-reply-to + "BR" gnus-summary-reply-broken-reply-to-with-original "om" gnus-summary-mail-forward "op" gnus-summary-post-forward "Om" gnus-summary-digest-mail-forward @@ -578,11 +582,11 @@ header line with the old Message-ID." (while (looking-at message-unix-mail-delimiter) (forward-line 1)) (setq beg (point)) - (setq end (or (search-forward "\n\n" nil t) (point))) + (setq end (or (message-goto-body) beg)) ;; Delete the headers from the displayed articles. (set-buffer gnus-article-copy) (delete-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) + (or (message-goto-body) (point-max))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) (article-decode-encoded-words)))) @@ -651,10 +655,11 @@ header line with the old Message-ID." (when yank (gnus-inews-yank-articles yank)))))) -(defun gnus-msg-treat-broken-reply-to () +(defun gnus-msg-treat-broken-reply-to (&optional force) "Remove the Reply-to header iff broken-reply-to." - (when (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to) + (when (or force + (gnus-group-find-parameter + gnus-newsgroup-name 'broken-reply-to)) (save-restriction (message-narrow-to-head) (message-remove-header "reply-to")))) @@ -808,7 +813,7 @@ If VERY-WIDE, make a very wide reply." (message-narrow-to-head) (setq headers (concat headers (buffer-string))))))) (set-buffer (gnus-copy-article-buffer)) - (gnus-msg-treat-broken-reply-to) + (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) (save-restriction (message-narrow-to-head) (when very-wide @@ -825,6 +830,24 @@ The original article will be yanked." (interactive "P") (gnus-summary-reply (gnus-summary-work-articles n) wide)) +(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide) + "Like `gnus-summary-reply' except removing reply-to field. +If prefix argument YANK is non-nil, the original article is yanked +automatically. +If WIDE, make a wide reply. +If VERY-WIDE, make a very wide reply." + (interactive + (list (and current-prefix-arg + (gnus-summary-work-articles 1)))) + (let ((gnus-msg-force-broken-reply-to t)) + (gnus-summary-reply yank wide very-wide))) + +(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide) + "Like `gnus-summary-reply-with-original' except removing reply-to field. +The original article will be yanked." + (interactive "P") + (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide)) + (defun gnus-summary-wide-reply (&optional yank) "Start composing a wide reply mail to the current message. If prefix argument YANK is non-nil, the original article is yanked @@ -1277,42 +1300,41 @@ this is a reply." ;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) (interactive) - (when (gnus-alive-p) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (coding-system-for-write 'raw-text) - (output-coding-system 'raw-text) - groups group method group-art) - (when gcc - (message-remove-header "gcc") - (widen) - (setq groups (message-unquote-tokens - (message-tokenize-header gcc " ,"))) - ;; Copy the article over to some group(s). - (while (setq group (pop groups)) - (gnus-check-server - (setq method (gnus-inews-group-method group))) - (unless (gnus-request-group group nil method) - (gnus-request-create-group group method)) - (save-excursion - (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring message-encoding-buffer) - (gnus-run-hooks 'gnus-before-do-gcc-hook) - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (replace-match "" t t )) - (unless (setq group-art - (gnus-request-accept-article group method t t)) - (gnus-message 1 "Couldn't store article in group %s: %s" - group (gnus-status-message method)) - (sit-for 2)) - (when (and group-art gnus-inews-mark-gcc-as-read) - (gnus-group-mark-article-read group (cdr group-art))) - (kill-buffer (current-buffer)))))))))) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) + (coding-system-for-write 'raw-text) + (output-coding-system 'raw-text) + groups group method group-art) + (when gcc + (message-remove-header "gcc") + (widen) + (setq groups (message-unquote-tokens + (message-tokenize-header gcc " ,"))) + ;; Copy the article over to some group(s). + (while (setq group (pop groups)) + (gnus-check-server + (setq method (gnus-inews-group-method group))) + (unless (gnus-request-group group nil method) + (gnus-request-create-group group method)) + (save-excursion + (nnheader-set-temp-buffer " *acc*") + (insert-buffer-substring message-encoding-buffer) + (gnus-run-hooks 'gnus-before-do-gcc-hook) + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (replace-match "" t t )) + (unless (setq group-art + (gnus-request-accept-article group method t t)) + (gnus-message 1 "Couldn't store article in group %s: %s" + group (gnus-status-message method)) + (sit-for 2)) + (when (and group-art gnus-inews-mark-gcc-as-read) + (gnus-group-mark-article-read group (cdr group-art))) + (kill-buffer (current-buffer))))))))) (defun gnus-inews-insert-gcc () "Insert Gcc headers based on `gnus-outgoing-message-group'."