of names)."
:group 'gnus-message
:type '(choice (string :tag "Group")
- (function)))
+ (function)))
(defcustom gnus-mailing-list-groups nil
"*Regexp matching groups that are really mailing lists.
"*Alist of styles to use when posting.
See Info node `(gnus)Posting Styles'."
:group 'gnus-message
+ :link '(custom-manual "(gnus)Posting Styles")
:type '(repeat (cons (choice (regexp)
(variable)
(list (const header)
(defvar gnus-inews-mark-gcc-as-read nil
"Obsolete variable. Use `gnus-gcc-mark-as-read' instead.")
-(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
+(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
'gnus-gcc-mark-as-read)
(defcustom gnus-gcc-externalize-attachments nil
(const all :tag "Any")
(string :tag "Regexp")))
-(defcustom gnus-group-posting-charset-alist
+(gnus-define-group-parameter
+ posting-charset-alist
+ :type list
+ :function-document
+ "Return the permitted unencoded charsets for posting of GROUP."
+ :variable gnus-group-posting-charset-alist
+ :variable-default
'(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
(message-this-is-mail nil nil)
(message-this-is-news nil t))
+ :variable-document
"Alist of regexps and permitted unencoded charsets for posting.
Each element of the alist has the form (TEST HEADER BODY-LIST), where
TEST is either a regular expression matching the newsgroup header or a
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
- :type '(repeat (list :tag "Permitted unencoded charsets"
- (choice :tag "Where"
- (regexp :tag "Group")
- (const :tag "Mail message" :value message-this-is-mail)
- (const :tag "News article" :value message-this-is-news))
- (choice :tag "Header"
- (const :tag "None" nil)
- (symbol :tag "Charset"))
- (choice :tag "Body"
- (const :tag "Any" :value t)
- (const :tag "None" :value nil)
- (repeat :tag "Charsets"
- (symbol :tag "Charset")))))
- :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type
+ '(repeat (list :tag "Permitted unencoded charsets"
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message" :value message-this-is-mail)
+ (const :tag "News article" :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
+ :parameter-type '(choice :tag "Permitted unencoded charsets"
+ :value nil
+ (repeat (symbol)))
+ :parameter-document "\
+List of charsets that are permitted to be unencoded.")
(defcustom gnus-debug-files
'("gnus.el" "gnus-sum.el" "gnus-group.el"
:group 'gnus-message
:type '(repeat (string :tag "File")))
-(defcustom gnus-debug-exclude-variables
- '(mm-mime-mule-charset-alist
+(defcustom gnus-debug-exclude-variables
+ '(mm-mime-mule-charset-alist
nnmail-split-fancy message-minibuffer-local-map)
"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
+(defcustom gnus-discouraged-post-methods
'(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
"A list of back ends that are not used in \"real\" newsgroups.
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
+ "Automatically sign replys to signed messages.
+See also the `mml-default-sign-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replyencrypt
+ nil
+ "Automatically encrypt replys to encrypted messages.
+See also the `mml-default-encrypt-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replysignencrypted
+ 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)
+
+(defcustom gnus-summary-resend-default-address t
+ "If non-nil, Gnus tries to suggest a default address to resend to.
+If nil, the address field will always be empty after invoking
+`gnus-summary-resend-message'."
+ :group 'gnus-message
+ :type 'boolean)
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
"Inhibit the use of posting styles.")
+(defvar gnus-article-yanked-articles nil)
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
(defvar gnus-check-before-posting nil)
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
;; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message)
+ "r" gnus-summary-resend-message
+ "e" gnus-summary-resend-message-edit)
;;; Internal functions.
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,buffer (buffer-name (current-buffer)))
(,article gnus-article-reply)
+ (,yanked gnus-article-yanked-articles)
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(add-hook 'message-mode-hook
(lambda ()
(gnus-configure-posting-styles ,group)))
+ (gnus-pull ',(intern gnus-draft-meta-information-header)
+ message-required-headers)
+ (when (and ,group
+ (not (string= ,group "")))
+ (push '(,(intern gnus-draft-meta-information-header)
+ . (lambda ()
+ (gnus-inews-make-draft-meta-information
+ ,gnus-newsgroup-name ,gnus-article-reply)))
+ message-required-headers))
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config)
- (gnus-inews-insert-draft-meta-information ,group ,article)
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ ,yanked)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(run-hooks 'post-command-hook)
(set-buffer-modified-p nil))))
-(defun gnus-inews-insert-draft-meta-information (group article)
- (save-excursion
- (when (and group
- (not (string= group ""))
- (not (message-fetch-field gnus-draft-meta-information-header)))
- (goto-char (point-min))
- (insert gnus-draft-meta-information-header ": (\"" group "\" "
- (if article (number-to-string
- (if (listp article)
- (car article)
- article)) "\"\"")
- ")\n"))))
+(defun gnus-inews-make-draft-meta-information (group article)
+ (concat "(\"" group "\" "
+ (if article (number-to-string
+ (if (listp article)
+ (car article)
+ article)) "\"\"")
+ ")"))
;;;###autoload
(defun gnus-msg-mail (&optional to subject other-headers continue
(symbol-value (car elem))))
(throw 'found (cons (cadr elem) (caddr elem)))))))))
-(defun gnus-inews-add-send-actions (winconf buffer article &optional config)
+(defun gnus-inews-add-send-actions (winconf buffer article
+ &optional config yanked)
(make-local-hook 'message-sent-hook)
(add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
'gnus-inews-do-gcc) nil t)
(set-buffer ,buffer)
,(when article
(if (eq config 'forward)
- `(gnus-summary-mark-article-as-forwarded ',article)
- `(gnus-summary-mark-article-as-replied ',article)))))
+ `(gnus-summary-mark-article-as-forwarded ',yanked)
+ `(gnus-summary-mark-article-as-replied ',yanked)))))
'send))
(put 'gnus-setup-message 'lisp-indent-function 1)
;; 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
;; 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
(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)
;; 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
;; 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
(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)))
;; 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."
(message-reply-headers
;; The headers are decoded.
(with-current-buffer gnus-article-copy
- (nnheader-parse-head t))))
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (nnheader-parse-naked-head)))))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
(let ((articles (gnus-summary-work-articles n))
(message-post-method
`(lambda (arg)
- (gnus-post-method (eq ,symp 'a) ,gnus-newsgroup-name)))
+ (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
(goto-char (point-min))
(while (looking-at message-unix-mail-delimiter)
(forward-line 1))
- (setq beg (point)
- end (or (message-goto-body) beg))
+ (let ((mail-header-separator ""))
+ (setq beg (point)
+ 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 (message-goto-body) (point-max)))
+ (let ((mail-header-separator ""))
+ (delete-region (goto-char (point-min))
+ (or (message-goto-body) (point-max))))
;; Insert the original article headers.
(insert-buffer-substring gnus-original-article-buffer beg end)
;; Decode charsets.
(when article-buffer
(gnus-copy-article-buffer))
(let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
(gnus-inews-yank-articles yank))))))
(defun gnus-msg-treat-broken-reply-to (&optional force)
- "Remove the Reply-to header iff broken-reply-to."
+ "Remove the Reply-to header if broken-reply-to."
(when (or force
(gnus-group-find-parameter
gnus-newsgroup-name 'broken-reply-to))
(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)))
- (mml-quote-region (point) (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)))
+ (gnus-article-yanked-articles yank)
+ (headers ""))
+ ;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
- (gnus-inews-yank-articles 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)))
+ (mml-quote-region (point) (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 (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-replyencrypt encrypted)
+ (mml-secure-message mml-default-encrypt-method
+ (if gnus-message-replysignencrypted
+ 'signencrypt
+ 'encrypt)))
+ ((and gnus-message-replysign signed)
+ (mml-secure-message mml-default-sign-method 'sign))))))
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
(interactive "P")
(if (null (cdr (gnus-summary-work-articles nil)))
(let ((message-forward-as-mime message-forward-as-mime)
- (message-forward-show-mml message-forward-show-mml))
- (cond
- ((null arg))
- ((eq arg 1)
- (setq message-forward-as-mime nil
- message-forward-show-mml t))
- ((eq arg 2)
- (setq message-forward-as-mime t
- message-forward-show-mml nil))
- ((eq arg 3)
- (setq message-forward-as-mime t
- message-forward-show-mml t))
- ((eq arg 4)
- (setq message-forward-as-mime nil
- message-forward-show-mml nil))
- (t
- (setq message-forward-as-mime (not message-forward-as-mime))))
- (let ((gnus-article-reply (gnus-summary-article-number)))
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let ((mail-parse-charset
+ (message-forward-show-mml message-forward-show-mml))
+ (cond
+ ((null arg))
+ ((eq arg 1)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml t))
+ ((eq arg 2)
+ (setq message-forward-as-mime t
+ message-forward-show-mml nil))
+ ((eq arg 3)
+ (setq message-forward-as-mime t
+ message-forward-show-mml t))
+ ((eq arg 4)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml nil))
+ (t
+ (setq message-forward-as-mime (not message-forward-as-mime))))
+ (let* ((gnus-article-reply (gnus-summary-article-number))
+ (gnus-article-yanked-articles (list (list gnus-article-reply))))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (let ((mail-parse-charset
(or (and (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
gnus-article-charset))
gnus-newsgroup-charset))
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
- (set-buffer gnus-original-article-buffer)
- (message-forward post)))))
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
+ (set-buffer gnus-original-article-buffer)
+ (message-forward post)))))
(gnus-uu-digest-mail-forward arg post)))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(interactive
- (list (message-read-from-minibuffer
+ (list (message-read-from-minibuffer
"Resend message(s) to: "
- (when (gnus-buffer-live-p gnus-original-article-buffer)
+ (when (and gnus-summary-resend-default-address
+ (gnus-buffer-live-p gnus-original-article-buffer))
;; If some other article is currently selected, the
;; initial-contents is wrong. Whatever, it is just the
;; initial-contents.
(message-resend address))
(gnus-summary-mark-article-as-forwarded article))))
+;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
+(defun gnus-summary-resend-message-edit ()
+ "Resend an article that has already been sent.
+A new buffer will be created to allow the user to modify body and
+contents of the message, and then, everything will happen as when
+composing a new message."
+ (interactive)
+ (let ((article (gnus-summary-article-number)))
+ (gnus-setup-message 'reply-yank
+ (gnus-summary-select-article t)
+ (set-buffer gnus-original-article-buffer)
+ (let ((cur (current-buffer))
+ (to (message-fetch-field "to")))
+ ;; Get a normal message buffer.
+ (message-pop-to-buffer (message-buffer-name "Resend" to))
+ (insert-buffer-substring cur)
+ (mime-to-mml)
+ (message-narrow-to-head-1)
+ ;; 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)
+ (goto-char (point-min))
+ (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
+ (forward-char 1)
+ (widen)))))
+
(defun gnus-summary-post-forward (&optional arg)
"Forward the current article to a newsgroup.
See `gnus-summary-mail-forward' for ARG."
message-required-news-headers
message-required-mail-headers)))
(goto-char (point-max))
- (insert "Gcc: " group "\n")
+ (if (string-match " " group)
+ (insert "Gcc: \"" group "\"\n")
+ (insert "Gcc: " group "\n"))
(widen)))
(gnus-inews-do-gcc)
(when (and (get-buffer gnus-group-buffer)
(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)))))))
(gnus-message 1 "Couldn't store article in group %s: %s"
group (gnus-status-message method))
(sit-for 2))
- (when (and group-art
+ (when (and group-art
(or gnus-gcc-mark-as-read
gnus-inews-mark-gcc-as-read))
(gnus-group-mark-article-read group (cdr group-art)))
group))))
(when gcc
(insert "Gcc: "
- (if (stringp gcc) gcc
- (mapconcat 'identity gcc " "))
+ (if (stringp gcc)
+ (if (string-match " " gcc)
+ (concat "\"" gcc "\"")
+ gcc)
+ (mapconcat (lambda (group)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group))
+ gcc " "))
"\n"))))))
(defun gnus-inews-insert-archive-gcc (&optional group)
(progn
(insert
(if (stringp gcc-self-val)
- gcc-self-val
- group))
+ (if (string-match " " gcc-self-val)
+ (concat "\"" gcc-self-val "\"")
+ gcc-self-val)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group)))
(if (not (eq gcc-self-val 'none))
(insert "\n")
(progn
(kill-line))))
;; Use the list of groups.
(while (setq name (pop groups))
- (insert (if (string-match ":" name)
- name
- (gnus-group-prefixed-name
- name gnus-message-archive-method)))
+ (let ((str (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method))))
+ (insert (if (string-match " " str)
+ (concat "\"" str "\"")
+ str)))
(when groups
(insert " ")))
(insert "\n")))))))
(setq results (delq name (delq address results)))
;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
(make-local-hook 'message-setup-hook)
+ (setq results (sort results (lambda (x y)
+ (string-lessp (car x) (car y)))))
(dolist (result results)
(add-hook 'message-setup-hook
(cond
projects / gnus / blobdiff