;;; uce.el --- facilitate reply to unsolicited commercial email
-;; Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2000, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: stanislav shalunov <shalunov@mccme.ru>
;; Created: 10 Dec 1996
;; 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
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
+(defvar gnus-original-article-buffer)
+(defvar mail-reply-buffer)
+(defvar rmail-current-message)
+
(require 'sendmail)
;; Those sections of code which are dependent upon
;; RMAIL are only evaluated if we have received a message with RMAIL...
-;;(require 'rmail)
+;;(require 'rmail)
(defgroup uce nil
"Facilitate reply to unsolicited commercial email."
: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.
----------------------------------------------------
:group 'uce)
(defcustom uce-signature mail-signature
-"Text to put as your signature after the note to UCE sender.
+"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."
(let ((message-buffer
(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)
((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))
(re-search-forward "^Lines:")
(beginning-of-line))
((eq uce-mail-reader 'rmail)
- (beginning-of-buffer)
+ (goto-char (point-min))
(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?
(if (file-exists-p "~/.signature")
(progn
(insert "\n\n-- \n")
- (insert-file "~/.signature")
- ;; Function insert-file leaves point where it was,
- ;; while we want to place signature in the ``middle''
- ;; of the message.
- (exchange-point-and-mark))))
+ (forward-char (cadr (insert-file-contents "~/.signature"))))))
(uce-signature
(insert "\n\n-- \n" uce-signature)))
;; And text of the original message.
;; 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")
(provide 'uce)
+;;; arch-tag: 44b68c87-9b29-47bd-822c-3feee3883221
;;; uce.el ends here