;;; uce.el --- facilitate reply to unsolicited commercial email
-;; Copyright (C) 1996, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc.
;; Author: stanislav shalunov <shalunov@mccme.ru>
;; Created: 10 Dec 1996
;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
-;; This program is distributed in the hope that it will be useful, but
-;; without any warranty; without even the implied warranty of
-;; merchantability or fitness for a particular purpose. See the GNU
-;; General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Dec 3, 1997 -- changes from Gareth Jones <gdj1@gdjones.demon.co.uk>
;; handling Received headers following some line like `From:'.
-;;; Setup:
+;; Aug 16, 2000 -- changes from Detlev Zundel
+;; <detlev.zundel@stud.uni-karlsruhe.de> to make uce.el work with the
+;; latest Gnus. Lars told him it should work for all versions of Gnus
+;; younger than three years.
-;; put in your ~./emacs the following line:
+;; Setup:
+
+;; Add the following line to your ~/.emacs:
;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
(require 'sendmail)
;; Those sections of code which are dependent upon
;; RMAIL are only evaluated if we have received a message with RMAIL...
-;;(require 'rmail)
-
-(defvar uce-mail-reader 'rmail
- "A symbol indicating which mail reader you are using.
-Choose from: gnus, rmail.")
+;;(require 'rmail)
(defgroup uce nil
"Facilitate reply to unsolicited commercial email."
:prefix "uce-"
:group 'mail)
+(defcustom uce-mail-reader 'rmail
+ "A symbol indicating which mail reader you are using.
+Choose from: `gnus', `rmail'."
+ :type '(choice (const gnus) (const rmail))
+ :version "20.3"
+ :group 'uce)
+
(defcustom uce-setup-hook nil
"Hook to run after UCE rant message is composed.
-This hook is run after mail-setup-hook, which is run as well."
+This hook is run after `mail-setup-hook', which is run as well."
:type 'hook
:group 'uce)
-(defcustom uce-message-text
+(defcustom uce-message-text
"Recently, I have received an Unsolicited Commercial E-mail from you.
I do not like UCE's and I would like to inform you that sending
unsolicited messages to someone while he or she may have to pay for
services you are mistaken. Spamming will only make people hate you, not
buy from you.
-If you have any list of people you send unsolicited commercial emails to,
-REMOVE me from such list immediately. I suggest that you make this list
+If you have any list of people you send unsolicited commercial emails to,
+REMOVE me from such list immediately. I suggest that you make this list
just empty.
----------------------------------------------------
Thank you."
- "This is the text that uce-reply-to-uce command will put in reply buffer.
+ "This is the text that `uce-reply-to-uce' command will put in reply buffer.
Some of spamming programs in use will be set up to read all incoming
to spam address email, and will remove people who put the word `remove'
on beginning of some line from the spamming list. So, when you set it
:group 'uce)
(defcustom uce-signature mail-signature
-"Text to put as your signature after the note to UCE sender.
-Value nil means none, t means insert ~/.signature file (if it happens
+"Text to put as your signature after the note to UCE sender.
+Value nil means none, t means insert `~/.signature' file (if it happens
to exist), if this variable is a string this string will be inserted
as your signature."
:type '(choice (const nil) (const t) string)
address, and postmaster of the mail relay used."
(interactive)
(let ((message-buffer
- (cond ((eq uce-mail-reader 'gnus) "*Article*")
+ (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)
((eq uce-mail-reader 'rmail) "RMAIL")
- (t (error
- "Variable uce-mail-reader set to unrecognized value")))))
+ (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 (concat "No buffer " message-buffer ", cannot find UCE")))
(switch-to-buffer message-buffer)
+ ;; We need the message with headers pruned.
+ (if full-header-p
+ (rmail-toggle-header 1))
(let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
(reply-to (mail-fetch-field "reply-to"))
temp)
end-of-hostname (string-match "[ ,>]" to first-at-sign)
sender-host (substring to first-at-sign end-of-hostname))
(if (string-match "\\." sender-host)
- (setq to (format "%s, postmaster%s, abuse%s"
+ (setq to (format "%s, postmaster%s, abuse%s"
to sender-host sender-host))))
(setq mail-send-actions nil)
(setq mail-reply-buffer nil)
(cond ((eq uce-mail-reader 'gnus)
- (article-hide-headers -1)
- (copy-region-as-kill (point-min) (point-max))
- (article-hide-headers))
+ (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)
+ (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))
(switch-to-buffer "*mail*")
(erase-buffer)
(setq temp (point))
(if (eq uce-mail-reader 'rmail)
(progn
(forward-line 2)
- (while (looking-at "Summary-Line:\\|Mail-From:")
- (forward-line 1))
+ (let ((case-fold-search t))
+ (while (looking-at "Summary-Line:\\|Mail-From:")
+ (forward-line 1)))
(delete-region temp (point))))
;; Now find the mail hub that first accepted this message.
;; This should try to find the last Received: header.
(beginning-of-buffer)
(search-forward "*** EOOH ***\n")
(beginning-of-line)
- (forward-line -1)))
+ (forward-line -1)))
(re-search-backward "^Received:")
(beginning-of-line)
;; Is this always good? It's the only thing I saw when I checked
(forward-char -1)
;; And add its postmaster to the list of addresses.
(if (string-match "\\." (buffer-substring temp (point)))
- (setq to (format "%s, postmaster@%s"
+ (setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))
;; Also look at the message-id, it helps *very* often.
(if (and (search-forward "\nMessage-Id: " nil t)
(search-forward ">")
(forward-char -1)
(if (string-match "\\." (buffer-substring temp (point)))
- (setq to (format "%s, postmaster@%s"
+ (setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))))
(cond ((eq uce-mail-reader 'gnus)
;; Does Gnus always have Lines: in the end?
;; might be to set up special key bindings, replace standart
;; functions in mail-mode, etc.
(run-hooks 'mail-setup-hook 'uce-setup-hook))))
-
+
(defun uce-insert-ranting (&optional ignored)
"Insert text of the usual reply to UCE into current buffer."
(interactive "P")