X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=9fdeb9acdfbc63d15c87ad3ce214d18a0c6b89f8;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=2b373f59f09712bed570219afb17632468ffb4fe;hpb=71f7bf87345c515d437d8f74f1ec3f6e636aca85;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 2b373f5..9fdeb9a 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -106,7 +106,7 @@ the second with the current group name." :group 'gnus-message :type 'string) -(defcustom gnus-message-setup-hook '(gnus-maybe-setup-default-charset) +(defcustom gnus-message-setup-hook nil "Hook run after setting up a message buffer." :group 'gnus-message :type 'hook) @@ -216,7 +216,7 @@ use this option with care." "Variables that should not be reported in `gnus-bug'." :version "21.1" :group 'gnus-message - :type '(repeat (symbol :tab "Variable"))) + :type '(repeat (symbol :tag "Variable"))) (defcustom gnus-discouraged-post-methods '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir) @@ -224,7 +224,7 @@ use this option with care." This variable is used only when `gnus-post-method' is `current'." :version "21.3" :group 'gnus-group-foreign - :type '(repeat (symbol :tab "Back end"))) + :type '(repeat (symbol :tag "Back end"))) (defcustom gnus-message-replysign nil @@ -241,11 +241,18 @@ See also the `mml-default-encrypt-method' variable." :type 'boolean) (defcustom gnus-message-replysignencrypted - nil + t "Setting this causes automatically encryped messages to also be signed." :group 'gnus-message :type 'boolean) +(defcustom gnus-confirm-mail-reply-to-news nil + "If non-nil, Gnus requests confirmation when replying to news. +This is done because new users often reply by mistake when reading +news." + :group 'gnus-message + :type 'boolean) + ;;; Internal variables. (defvar gnus-inhibit-posting-styles nil @@ -374,6 +381,7 @@ Thank you for your help in stamping out bugs. (set (make-local-variable 'gnus-message-group-art) (cons ,group ,article)) (set (make-local-variable 'gnus-newsgroup-name) ,group) + (gnus-maybe-setup-default-charset) (gnus-run-hooks 'gnus-message-setup-hook)) (gnus-add-buffer) (gnus-configure-windows ,config t) @@ -491,6 +499,8 @@ If ARG is 1, prompt for a group name to find the posting style." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -520,6 +530,8 @@ network. The corresponding backend must have a 'request-post method." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -551,7 +563,9 @@ a news." (completing-read "Newsgroup: " gnus-active-hashtb nil (gnus-read-active-file-p)) (gnus-group-group-name)) - ""))) + "")) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy)) (gnus-post-news 'post gnus-newsgroup-name))) (defun gnus-summary-mail-other-window (&optional arg) @@ -563,6 +577,8 @@ posting style." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -592,6 +608,8 @@ network. The corresponding backend must have a 'request-post method." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -623,7 +641,9 @@ a news." (completing-read "Newsgroup: " gnus-active-hashtb nil (gnus-read-active-file-p)) "") - gnus-newsgroup-name))) + gnus-newsgroup-name)) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy)) (gnus-post-news 'post gnus-newsgroup-name))) @@ -649,7 +669,8 @@ yanked." ;; Send a followup. (gnus-post-news nil gnus-newsgroup-name headers gnus-article-buffer - yank nil force-news))) + yank nil force-news) + (gnus-summary-handle-replysign))) (defun gnus-summary-followup-with-original (n &optional force-news) "Compose a followup to an article and include the original article." @@ -698,7 +719,10 @@ yanked." (message-reply-headers ;; The headers are decoded. (with-current-buffer gnus-article-copy - (nnheader-parse-head t)))) + (save-restriction + (nnheader-narrow-to-headers) + (ietf-drums-unfold-fws) + (nnheader-parse-head t))))) (message-yank-original) (setq beg (or beg (mark t)))) (when articles @@ -752,8 +776,7 @@ post using the current select method." This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) - (let ((article (gnus-summary-article-number)) - (gnus-message-setup-hook '(gnus-maybe-setup-default-charset))) + (let ((article (gnus-summary-article-number))) (gnus-setup-message 'reply-yank (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) @@ -1091,51 +1114,59 @@ If VERY-WIDE, make a very wide reply." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) - (let* ((article - (if (listp (car yank)) - (caar yank) - (car yank))) - (gnus-article-reply (or article (gnus-summary-article-number))) - (headers "")) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (when yank - (gnus-summary-goto-subject article)) - (gnus-setup-message (if yank 'reply-yank 'reply) - (if (not very-wide) - (gnus-summary-select-article) - (dolist (article very-wide) - (gnus-summary-select-article nil nil nil article) - (save-excursion - (set-buffer (gnus-copy-article-buffer)) - (gnus-msg-treat-broken-reply-to) - (save-restriction - (message-narrow-to-head) - (setq headers (concat headers (buffer-string))))))) - (set-buffer (gnus-copy-article-buffer)) - (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) - (save-restriction - (message-narrow-to-head) - (when very-wide - (erase-buffer) - (insert headers)) - (goto-char (point-max))) - (message-reply nil wide) + ;; Allow user to require confirmation before replying by mail to the + ;; author of a news article. + (when (or (not (gnus-news-group-p gnus-newsgroup-name)) + (not gnus-confirm-mail-reply-to-news) + (y-or-n-p "Really reply by mail to article author? ")) + (let* ((article + (if (listp (car yank)) + (caar yank) + (car yank))) + (gnus-article-reply (or article (gnus-summary-article-number))) + (headers "")) + ;; Stripping headers should be specified with mail-yank-ignored-headers. (when yank - (gnus-inews-yank-articles yank)) -;; (when (or gnus-message-replysign gnus-message-replyencrypt) -;; (let (signed encrypted) -;; (save-excursion -;; (set-buffer (or gnus-article-buffer article-buffer)) -;; (setq signed (memq 'signed gnus-article-wash-types)) -;; (setq encrypted (memq 'encrypted gnus-article-wash-types))) -;; (cond ((and gnus-message-replysign signed) -;; (mml-secure-message mml-default-sign-method 'sign)) -;; ((and gnus-message-replyencrypt encrypted) -;; (mml-secure-message mml-default-encrypt-method -;; (if gnus-message-replysignencrypted -;; 'signencrypt -;; 'encrypt)))))) - ))) + (gnus-summary-goto-subject article)) + (gnus-setup-message (if yank 'reply-yank 'reply) + (if (not very-wide) + (gnus-summary-select-article) + (dolist (article very-wide) + (gnus-summary-select-article nil nil nil article) + (save-excursion + (set-buffer (gnus-copy-article-buffer)) + (gnus-msg-treat-broken-reply-to) + (save-restriction + (message-narrow-to-head) + (setq headers (concat headers (buffer-string))))))) + (set-buffer (gnus-copy-article-buffer)) + (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) + (save-restriction + (message-narrow-to-head) + (when very-wide + (erase-buffer) + (insert headers)) + (goto-char (point-max))) + (message-reply nil wide) + (when yank + (gnus-inews-yank-articles yank)) + (gnus-summary-handle-replysign))))) + +(defun gnus-summary-handle-replysign () + "Check the various replysign variables and take action accordingly." + (when nil;;(or gnus-message-replysign gnus-message-replyencrypt) + (let (signed encrypted) + (save-excursion + (set-buffer gnus-article-buffer) + (setq signed (memq 'signed gnus-article-wash-types)) + (setq encrypted (memq 'encrypted gnus-article-wash-types))) + (cond ((and gnus-message-replysign signed) + (mml-secure-message mml-default-sign-method 'sign)) + ((and gnus-message-replyencrypt encrypted) + (mml-secure-message mml-default-encrypt-method + (if gnus-message-replysignencrypted + 'signencrypt + 'encrypt))))))) (defun gnus-summary-reply-with-original (n &optional wide) "Start composing a reply mail to the current message. @@ -1332,6 +1363,7 @@ composing a new message." ;; Gnus will generate a new one when sending. (message-remove-header "Message-ID") + (message-remove-header message-ignored-resent-headers t) ;; Remove unwanted headers. (goto-char (point-max)) (insert mail-header-separator) @@ -1478,7 +1510,7 @@ If YANK is non-nil, include the original article." (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) (when address - (message-reply address) + (gnus-msg-mail address) (when yank (gnus-inews-yank-articles (list (cdr gnus-article-current))))))) @@ -1639,15 +1671,14 @@ this is a reply." (interactive "P") (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) - (let ((gnus-message-setup-hook '(gnus-maybe-setup-default-charset))) - (gnus-setup-message 'compose-bounce - (let* ((references (mail-fetch-field "references")) - (parent (and references (gnus-parent-id references)))) - (message-bounce) - ;; If there are references, we fetch the article we answered to. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers)))))) + (gnus-setup-message 'compose-bounce + (let* ((references (mail-fetch-field "references")) + (parent (and references (gnus-parent-id references)))) + (message-bounce) + ;; If there are references, we fetch the article we answered to. + (and fetch parent + (gnus-summary-refer-article parent) + (gnus-summary-show-all-headers))))) ;;; Gcc handling.