From 437ce4beb5d63696a18aa5d199320d6209f8f1f3 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Tue, 30 Oct 2007 23:28:28 +0000 Subject: [PATCH] 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 --- doc/misc/gnus.texi | 2 +- lisp/gnus/ChangeLog | 19 ++++++++++++ lisp/gnus/gnus-art.el | 17 +++++------ lisp/gnus/gnus-msg.el | 1 + lisp/gnus/message.el | 69 ++++++++++++++++++++++++++++++++++++++----- 5 files changed, 90 insertions(+), 18 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 61b1913081e..97e70c1cec2 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -28424,7 +28424,7 @@ Gnus will work. @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 --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index b6d03bcf218..fcf8fdb4cd6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -3,6 +3,20 @@ * message.el (message-check-news-body-syntax): Avoid mm-string-as-multibyte. (message-hide-headers): Don't assume (point-min)==1. +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. @@ -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 --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 9db4408e9d0..a2d34e65150 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1116,10 +1116,7 @@ predicate. See Info node `(gnus)Customizing Articles'." :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 @@ node `(gnus)Picons' for details." (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 @@ must return `mid', `mail', `invalid' or `ask'." (-20.0 . "\\.fsf@") ;; Gnus (-20.0 . "^slrn") (-20.0 . "^Pine") + (-20.0 . "^alpine\\.") (-20.0 . "_-_") ;; Subject change in thread ;; (-20.0 . "\\.ln@") ;; leafnode diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 001823b4021..941222adfd5 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -109,6 +109,7 @@ the second with the current group name." (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 --git a/lisp/gnus/message.el b/lisp/gnus/message.el index d14528ffe11..ddef099342d 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -188,8 +188,8 @@ To disable checking of long signatures, for instance, add 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 @@ To use this automatically, you may add this function to (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 @@ not have PROP." (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 @@ not have PROP." (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." -- 2.39.2