[Emacs-diffs] emacs/lisp/mail uce.el

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       09/01/31 02:50:28

Modified files:
        lisp/mail      : uce.el 

Log message:
        Tidy up commentary.
        (rmail-current-message): Remove unneeded declaration.
        (uce-message-text, uce-default-headers): Fix custom type.
        (rmail-buffer, rmail-msg-is-pruned): Declare.
        (uce-reply-to-uce): Add autoload cookie.  Doc fix.  Update for mbox 
Rmail.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/mail/uce.el?cvsroot=emacs&r1=1.29&r2=1.30

Patches:
Index: uce.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mail/uce.el,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -b -r1.29 -r1.30
--- uce.el      23 Jan 2009 04:57:07 -0000      1.29
+++ uce.el      31 Jan 2009 02:50:28 -0000      1.30
@@ -1,11 +1,11 @@
 ;;; uce.el --- facilitate reply to unsolicited commercial email
 
-;; Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;   2007, 2008, 2009  Free Software Foundation, Inc.
 
 ;; Author: stanislav shalunov <address@hidden>
 ;; Created: 10 Dec 1996
-;; Keywords: uce, unsolicited commercial email
+;; Keywords: mail, uce, unsolicited commercial email
 
 ;; This file is part of GNU Emacs.
 
@@ -24,43 +24,68 @@
 
 ;;; Commentary:
 
-;; Code in this file provides semi-automatic means of replying to
-;; UCE's you might get.  It works currently only with Rmail and Gnus.
-;; If you would like to make it work with other mail readers,
-;; Rmail-specific section is marked below.  If you want to play with
-;; code, please let me know about your changes so I can incorporate
-;; them.  I'd appreciate it.
-
-;; Function uce-reply-to-uce, if called when current message in RMAIL
-;; buffer is a UCE, will setup *mail* buffer in the following way: it
-;; scans full headers of message for 1) normal return address of
-;; sender (From, Reply-To lines); and puts these addresses into To:
-;; header, it also puts address@hidden address there 2) mailhub
-;; that first saw this message; and puts address of its postmaster
-;; into To: header 3) finally, it looks at Message-Id and adds
-;; posmaster of that host to the list of addresses.
+;; The code in this file provides a semi-automatic means of replying
+;; to unsolicited commercial email (UCE) you might get.  Currently, it
+;; only works with Rmail and Gnus.  If you would like to make it work
+;; with other mail readers, see the mail-client dependent section of
+;; uce-reply-to-uce.  Please let me know about your changes so I can
+;; incorporate them.  I'd appreciate it.
+
+;; The command uce-reply-to-uce, if called when the current message
+;; buffer is a UCE, will setup a reply *mail* buffer as follows.  It
+;; scans the full headers of the message for: 1) the normal return
+;; address of the sender (From, Reply-To lines), and puts these
+;; addresses into the To: header, along with address@hidden; 2)
+;; the mailhub that first saw this message, and adds the address of
+;; its postmaster into the To: header; and 3), finally, it looks at
+;; the Message-Id and adds the postmaster of that host to the list of
+;; addresses.
 
-;; Then, we add "Errors-To: address@hidden" header, so that if some
-;; of these addresses are not actually correct, we will never see
+;; Then, we add an "Errors-To: address@hidden" header, so that if
+;; some of these addresses are not actually correct, we will never see
 ;; bounced mail.  Also, mail-self-blind and mail-archive-file-name
 ;; take no effect: the ideology is that we don't want to save junk or
 ;; replies to junk.
 
-;; Then we put template into buffer (customizable message that
-;; explains what has happened), customizable signature, and the
+;; Then we insert a template into the buffer (a customizable message
+;; that explains what has happened), customizable signature, and the
 ;; original message with full headers and envelope for postmasters.
-;; Then buffer is left for editing.
+;; Then the buffer is left for editing.
 
-;; The reason that function uce-reply-to-uce is Rmail dependant is
-;; that we want full headers of the original message, nothing
-;; stripped.  If we use normal means of inserting of the original
-;; message into *mail* buffer headers like Received: (not really
-;; headers, but envelope lines) will be stripped while they bear
-;; valuable for us and postmasters information.  I do wish that there
-;; would be some way to write this function in some portable way, but
-;; I am not aware of any.
+;; The reason that the function uce-reply-to-uce is mail-client
+;; dependent is that we want the full headers of the original message,
+;; nothing stripped.  If we use the normal means of inserting the
+;; original message into the *mail* buffer, headers like Received:
+;; (not really headers, but envelope lines) will be stripped, while
+;; they bear valuable information for us and postmasters.  I do wish
+;; that there would be some portable way to write this function, but I
+;; am not aware of any.
 
-;;; Change log:
+;; Usage:
+
+;; Place uce.el in your load-path (and optionally byte-compile it).
+;; Add the following line to your ~/.emacs:
+;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
+;; If you want to use it with Gnus rather than Rmail:
+;; (setq uce-mail-reader 'gnus)
+
+;; Options:
+
+;; uce-message-text is a template that will be inserted into buffer.
+;; It has a reasonable default.  If you want to write some scarier
+;; one, please do so and send it to me.  Please keep it polite.
+
+;; uce-signature behaves just like mail-signature.  If nil, nothing is
+;; inserted, if t, file ~/.signature is used, if a string, its
+;; contents are inserted into buffer.
+
+;; uce-uce-separator is a line that separates your message from the
+;; UCE that you enclose.
+
+;; uce-subject-line will be used as the subject of the outgoing message.
+
+
+;;; Change Log:
 
 ;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs
 
@@ -83,39 +108,11 @@
 ;; latest Gnus.  Lars told him it should work for all versions of Gnus
 ;; younger than three years.
 
-;; Setup:
-
-;; Add the following line to your ~/.emacs:
-
-;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
-
-;; If you want to use it with Gnus also use
-
-;; (setq uce-mail-reader 'gnus)
-
-;; store this file (uce.el) somewhere in load-path and byte-compile it.
-
-;;; Variables:
-
-;; uce-message-text is template that will be inserted into buffer.  It
-;; has reasonable default.  If you want to write some scarier one,
-;; please do so and send it to me.  Please keep it polite.
-
-;; uce-signature behaves just like mail-signature.  If nil, nothing is
-;; inserted, if t, file ~/.signature is used, if a string, its
-;; contents are inserted into buffer.
-
-;; uce-uce-separator is line that separates your message from the UCE
-;; that you enclose.
-
-;; uce-subject-line will be used as subject of outgoing message.  If
-;; nil, left blank.
 
 ;;; Code:
 
 (defvar gnus-original-article-buffer)
 (defvar mail-reply-buffer)
-(defvar rmail-current-message)
 
 (require 'sendmail)
 ;; Those sections of code which are dependent upon
@@ -184,7 +181,7 @@
 up, it might be a good idea to actually use this feature.
 
 Value nil means insert no text by default, lets you type it in."
-  :type 'string
+  :type '(choice (const nil) string)
   :group 'uce)
 
 (defcustom uce-uce-separator
@@ -206,7 +203,7 @@
   "Errors-To: address@hidden: bulk\n"
   "Additional headers to use when responding to a UCE with 
\\[uce-reply-to-uce].
 These are mostly meant for headers that prevent delivery errors reporting."
-  :type 'string
+  :type '(choice (const nil) string)
   :group 'uce)
 
 (defcustom uce-subject-line
@@ -215,40 +212,47 @@
   :type 'string
   :group 'uce)
 
+;; End of user options.
+
+
+(defvar rmail-buffer)
+(declare-function rmail-msg-is-pruned "rmail" ())
 (declare-function mail-strip-quoted-names "mail-utils" (address))
 (declare-function rmail-maybe-set-message-counters "rmail" ())
 (declare-function rmail-msgbeg "rmail" (n))
 (declare-function rmail-msgend "rmail" (n))
 (declare-function rmail-toggle-header "rmail" (&optional arg))
 
-
+;;;###autoload
 (defun uce-reply-to-uce (&optional ignored)
-  "Send reply to UCE in Rmail.
-UCE stands for unsolicited commercial email.  Function will set up reply
-buffer with default To: to the sender, his postmaster, his abuse@
-address, and postmaster of the mail relay used."
+  "Compose a reply to unsolicited commercial email (UCE).
+Sets up a reply buffer addressed to: the sender, his postmaster,
+his abuse@ address, and the postmaster of the mail relay used.
+You might need to set `uce-mail-reader' before using this."
   (interactive)
+  ;; Start of mail-client dependent section.
   (let ((message-buffer
         (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)
-              ((eq uce-mail-reader 'rmail) "RMAIL")
+              ((eq uce-mail-reader 'rmail) (bound-and-true-p rmail-buffer))
               (t (error
                   "Variable uce-mail-reader set to unrecognized value"))))
-       (full-header-p (and (eq uce-mail-reader 'rmail)
-                           (not (rmail-msg-is-pruned)))))
-    (or (get-buffer message-buffer)
-       (error "No buffer %s, cannot find UCE" message-buffer))
+       pruned)
+    (or (and message-buffer (get-buffer message-buffer))
+       (error "No mail buffer, cannot find UCE"))
     (switch-to-buffer message-buffer)
     ;; We need the message with headers pruned.
-    (if full-header-p
+    ;; Why?  All we do is get the from and reply-to headers.  ?
+    (and (eq uce-mail-reader 'rmail)
+        (not (setq pruned (rmail-msg-is-pruned)))
        (rmail-toggle-header 1))
     (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
          (reply-to (mail-fetch-field "reply-to"))
          temp)
       ;; Initial setting of the list of recipients of our message; that's
       ;; what they are pretending to be.
-      (if to
-         (setq to (format "%s" (mail-strip-quoted-names to)))
-       (setq to ""))
+      (setq to (if to
+                  (format "%s" (mail-strip-quoted-names to))
+                ""))
       (if reply-to
          (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
       (let (first-at-sign end-of-hostname sender-host)
@@ -260,31 +264,22 @@
                             to sender-host sender-host))))
       (setq mail-send-actions nil)
       (setq mail-reply-buffer nil)
-      (cond ((eq uce-mail-reader 'gnus)
-            (copy-region-as-kill (point-min) (point-max)))
-           ((eq uce-mail-reader 'rmail)
-            (save-excursion
-              (save-restriction
-                (rmail-toggle-header 1)
-                (widen)
-                (rmail-maybe-set-message-counters)
-                (copy-region-as-kill (rmail-msgbeg rmail-current-message)
-                                     (rmail-msgend rmail-current-message))))))
-      ;; Restore the pruned header state we found.
-      (if full-header-p
-         (rmail-toggle-header 0))
+      (when (eq uce-mail-reader 'rmail)
+       (rmail-toggle-header 0)
+       (rmail-maybe-set-message-counters)) ; why?
+      (copy-region-as-kill (point-min) (point-max))
+      ;; Restore the initial header state we found.
+      (and pruned (rmail-toggle-header 1))
       (switch-to-buffer "*mail*")
       (erase-buffer)
-      (setq temp (point))
       (yank)
-      (goto-char temp)
-      (if (eq uce-mail-reader 'rmail)
-         (progn
-           (forward-line 2)
-           (let ((case-fold-search t))
-             (while (looking-at "Summary-Line:\\|Mail-From:")
-               (forward-line 1)))
-           (delete-region temp (point))))
+      (goto-char (point-min))
+      ;; Delete any internal Rmail headers.
+      (when (eq uce-mail-reader 'rmail)
+       (search-forward "\n\n")
+       (while (re-search-backward "^X-RMAIL" nil t)
+         (delete-region (point) (line-beginning-position 2)))
+       (goto-char (point-min)))
       ;; Now find the mail hub that first accepted this message.
       ;; This should try to find the last Received: header.
       ;; Sometimes there may be other headers inbetween Received: headers.
@@ -293,22 +288,15 @@
             (re-search-forward "^Lines:")
             (beginning-of-line))
            ((eq uce-mail-reader 'rmail)
-            (goto-char (point-min))
-            (search-forward "*** EOOH ***\n")
-            (beginning-of-line)
-            (forward-line -1)))
+            (search-forward "\n\n")))
       (re-search-backward "^Received:")
-      (beginning-of-line)
       ;; Is this always good?  It's the only thing I saw when I checked
       ;; a few messages.
-      (let ((eol (save-excursion (end-of-line) (point))))
        ;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t))
-       (if (not (re-search-forward "\\(from\\|by\\) " eol t))
-           (progn
-             (goto-char eol)
+      (unless (re-search-forward "\\(from\\|by\\) " (line-end-position) 'move)
              (if (looking-at "[ \t\n]+\\(from\\|by\\) ")
                  (goto-char (match-end 0))
-               (error "Failed to extract hub address")))))
+         (error "Failed to extract hub address")))
       (setq temp (point))
       (search-forward " ")
       (forward-char -1)
@@ -317,14 +305,9 @@
          (setq to (format "%s, address@hidden"
                           to (buffer-substring temp (point)))))
       ;; Also look at the message-id, it helps *very* often.
-      (if (and (search-forward "\nMessage-Id: " nil t)
+      (and (search-forward "\nMessage-Id: " nil t)
               ;; Not all Message-Id:'s have an `@' sign.
-              (let ((bol (point))
-                    eol)
-                (end-of-line)
-                (setq eol (point))
-                (goto-char bol)
-                (search-forward "@" eol t)))
+          (search-forward "@" (line-end-position) t)
          (progn
            (setq temp (point))
            (search-forward ">")
@@ -332,19 +315,15 @@
            (if (string-match "\\." (buffer-substring temp (point)))
                (setq to (format "%s, address@hidden"
                                 to (buffer-substring temp (point)))))))
-      (cond ((eq uce-mail-reader 'gnus)
+      (when (eq uce-mail-reader 'gnus)
             ;; Does Gnus always have Lines: in the end?
             (re-search-forward "^Lines:")
-            (beginning-of-line))
-           ((eq uce-mail-reader 'rmail)
-            (search-forward "\n*** EOOH ***\n")
-            (forward-line -1)))
+       (beginning-of-line)
       (setq temp (point))
       (search-forward "\n\n" nil t)
-      (if (eq uce-mail-reader 'gnus)
-         (forward-line -1))
-      (delete-region temp (point))
-      ;; End of Rmail dependent section.
+       (forward-line -1)
+       (delete-region temp (point)))
+      ;; End of mail-client dependent section.
       (auto-save-mode auto-save-default)
       (mail-mode)
       (goto-char (point-min))
@@ -387,7 +366,7 @@
       (if to (goto-char to))
       (or to (set-buffer-modified-p nil))
       ;; Run hooks before we leave buffer for editing.  Reasonable usage
-      ;; might be to set up special key bindings, replace standart
+      ;; might be to set up special key bindings, replace standard
       ;; functions in mail-mode, etc.
       (run-hooks 'mail-setup-hook 'uce-setup-hook))))