# HG changeset patch # User Miles Bader # Date 1193786908 0 # Node ID a3af441f643152cb8b77c909e8c1dfcafbc87254 # Parent 0fca3c9fc445d6db4444e32e681d57449c7c7601 Merge from gnus--devo--0 Patches applied: * gnus--devo--0 (patch 401-403) - Update from CVS Revision: emacs@sv.gnu.org/emacs--devo--0--patch-916 diff -r 0fca3c9fc445 -r a3af441f6431 doc/misc/gnus.texi --- a/doc/misc/gnus.texi Tue Oct 30 23:28:20 2007 +0000 +++ b/doc/misc/gnus.texi Tue Oct 30 23:28:28 2007 +0000 @@ -28424,7 +28424,7 @@ @item Try doing an @kbd{M-x gnus-version}. If you get something that looks like @c -@samp{Gnus v5.10.8} @c Adjust ../Makefile.in if you change this line! +@samp{Gnus v5.13} @c Adjust ../Makefile.in if you change this line! @c you have the right files loaded. Otherwise you have some old @file{.el} files lying around. Delete these. diff -r 0fca3c9fc445 -r a3af441f6431 lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Tue Oct 30 23:28:20 2007 +0000 +++ b/lisp/gnus/ChangeLog Tue Oct 30 23:28:28 2007 +0000 @@ -5,6 +5,20 @@ 2007-10-28 Reiner Steib + * message.el (message-remove-blank-cited-lines): Fix if remove is + given. + (message-bogus-address-regexp): New variable. + (message-bogus-recipient-p): New function. + (message-check-recipients): New command. + (message-syntax-checks): Add `bogus-recipient'. + (message-fix-before-sending): Add `bogus-recipient'. + + * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Add "alpine". + (gnus-treat-emphasize, gnus-treat-body-boundary): Don't test + window-system. + +2007-10-28 Reiner Steib + * gnus.el: Bump version to Gnus v5.13. 2007-10-28 Miles Bader @@ -12,6 +26,11 @@ * nnheader.el (nnheader-uniquify-message-id): Make sure this is defined at compile-time too. +2007-10-27 Reiner Steib + + * gnus-msg.el (gnus-message-setup-hook): Add + `message-remove-blank-cited-lines' to options. + 2007-10-26 Reiner Steib * message.el (message-remove-blank-cited-lines): New function. diff -r 0fca3c9fc445 -r a3af441f6431 lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Tue Oct 30 23:28:20 2007 +0000 +++ b/lisp/gnus/gnus-art.el Tue Oct 30 23:28:28 2007 +0000 @@ -1116,10 +1116,7 @@ :type gnus-article-treat-head-custom) (put 'gnus-treat-buttonize-head 'highlight t) -(defcustom gnus-treat-emphasize - (and (or window-system - (featurep 'xemacs)) - 50000) +(defcustom gnus-treat-emphasize 50000 "Emphasize text. Valid values are nil, t, `head', `first', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles'." @@ -1518,11 +1515,12 @@ (put 'gnus-treat-newsgroups-picon 'highlight t) (defcustom gnus-treat-body-boundary - (if (and (eq window-system 'x) - (or gnus-treat-newsgroups-picon - gnus-treat-mail-picon - gnus-treat-from-picon)) - 'head nil) + (if (or gnus-treat-newsgroups-picon + gnus-treat-mail-picon + gnus-treat-from-picon) + ;; If there's much decoration, the user might prefer a boundery. + 'head + nil) "Draw a boundary at the end of the headers. Valid values are nil and `head'. See Info node `(gnus)Customizing Articles' for details." @@ -6779,6 +6777,7 @@ (-20.0 . "\\.fsf@") ;; Gnus (-20.0 . "^slrn") (-20.0 . "^Pine") + (-20.0 . "^alpine\\.") (-20.0 . "_-_") ;; Subject change in thread ;; (-20.0 . "\\.ln@") ;; leafnode diff -r 0fca3c9fc445 -r a3af441f6431 lisp/gnus/gnus-msg.el --- a/lisp/gnus/gnus-msg.el Tue Oct 30 23:28:20 2007 +0000 +++ b/lisp/gnus/gnus-msg.el Tue Oct 30 23:28:28 2007 +0000 @@ -109,6 +109,7 @@ (defcustom gnus-message-setup-hook nil "Hook run after setting up a message buffer." :group 'gnus-message + :options '(message-remove-blank-cited-lines) :type 'hook) (defcustom gnus-bug-create-help-buffer t diff -r 0fca3c9fc445 -r a3af441f6431 lisp/gnus/message.el --- a/lisp/gnus/message.el Tue Oct 30 23:28:20 2007 +0000 +++ b/lisp/gnus/message.el Tue Oct 30 23:28:28 2007 +0000 @@ -188,8 +188,8 @@ Don't touch this variable unless you really know what you're doing. -Checks include `approved', `continuation-headers', `control-chars', -`empty', `existing-newsgroups', `from', `illegible-text', +Checks include `approved', `bogus-recipient', `continuation-headers', +`control-chars', `empty', `existing-newsgroups', `from', `illegible-text', `invisible-text', `long-header-lines', `long-lines', `message-id', `multiple-headers', `new-text', `newsgroups', `quoting-style', `repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot', @@ -3530,16 +3530,16 @@ (let ((citexp (concat "^\\(" - (if (boundp 'message-yank-cited-prefix) - (concat message-yank-cited-prefix "\\|")) + (when (boundp 'message-yank-cited-prefix) + (concat message-yank-cited-prefix "\\|")) message-yank-prefix - "\\)+ *$" - (if remove "\n" "")))) + "\\)+ *\n" + ))) (gnus-message 8 "removing `%s'" citexp) (save-excursion (message-goto-body) (while (re-search-forward citexp nil t) - (replace-match ""))))) + (replace-match (if remove "" "\n")))))) (defvar message-cite-reply-above nil "If non-nil, start own text above the quote. @@ -4020,6 +4020,12 @@ (setq start next))) (nreverse regions))) +(defcustom message-bogus-address-regexp nil ;; "noreply\\|nospam\\|invalid" + "Regexp of potentially bogus mail addresses." + :version "23.0" ;; No Gnus + :group 'message-headers + :type 'regexp) + (defun message-fix-before-sending () "Do various things to make the message nice before sending it." ;; Make sure there's a newline at the end of the message. @@ -4102,7 +4108,54 @@ (when (eq choice ?r) (insert message-replacement-char)))) (forward-char) - (skip-chars-forward mm-7bit-chars)))))) + (skip-chars-forward mm-7bit-chars))))) + (message-check 'bogus-recipient + ;; Warn before composing or sending a mail to an invalid address. + (message-check-recipients))) + +(defun message-bogus-recipient-p (recipients) + "Check if a mail address in RECIPIENTS looks bogus. + +RECIPIENTS is a mail header. Return a list of potentially bogus +addresses. If none is found, return nil. + +An addresses might be bogus if the domain part is not fully +qualified, see `message-valid-fqdn-regexp', or if it matches +`message-bogus-address-regexp'." + ;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"? + (let (found) + (mapc (lambda (address) + (setq address (cadr address)) + (when + (or (not + (or + (not (string-match "@" address)) + (string-match + (concat ".@.*\\(" + message-valid-fqdn-regexp "\\)\\'") address))) + (and (stringp message-bogus-address-regexp) + (string-match message-bogus-address-regexp address))) + (push address found))) + ;; + (mail-extract-address-components recipients t)) + found)) + +(defun message-check-recipients () + "Warn before composing or sending a mail to an invalid address. + +This function could be useful in `message-setup-hook'." + (interactive) + (save-restriction + (message-narrow-to-headers) + (dolist (hdr '("To" "Cc" "Bcc")) + (let ((addr (message-fetch-field hdr))) + (when (stringp addr) + (dolist (bog (message-bogus-recipient-p addr)) + (and bog + (not (y-or-n-p + (format + "Address `%s' might be bogus. Continue? " bog))) + (error "Bogus address.")))))))) (defun message-add-action (action &rest types) "Add ACTION to be performed when doing an exit of type TYPES."