/[emacs]/emacs/lisp/mail/uce.el
ViewVC logotype

Diff of /emacs/lisp/mail/uce.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by rms, Sun Feb 17 17:00:33 2002 UTC revision 1.10.4.1 by miles, Fri Apr 4 06:20:27 2003 UTC
# Line 117  Line 117 
117  (require 'sendmail)  (require 'sendmail)
118  ;; Those sections of code which are dependent upon  ;; Those sections of code which are dependent upon
119  ;; RMAIL are only evaluated if we have received a message with RMAIL...  ;; RMAIL are only evaluated if we have received a message with RMAIL...
120  ;;(require 'rmail)  ;;(require 'rmail)
121    
122  (defgroup uce nil  (defgroup uce nil
123    "Facilitate reply to unsolicited commercial email."    "Facilitate reply to unsolicited commercial email."
# Line 137  This hook is run after `mail-setup-hook' Line 137  This hook is run after `mail-setup-hook'
137    :type 'hook    :type 'hook
138    :group 'uce)    :group 'uce)
139    
140  (defcustom uce-message-text  (defcustom uce-message-text
141    "Recently, I have received an Unsolicited Commercial E-mail from you.    "Recently, I have received an Unsolicited Commercial E-mail from you.
142  I do not like UCE's and I would like to inform you that sending  I do not like UCE's and I would like to inform you that sending
143  unsolicited messages to someone while he or she may have to pay for  unsolicited messages to someone while he or she may have to pay for
# Line 148  If you think that this is a good way to Line 148  If you think that this is a good way to
148  services you are mistaken.  Spamming will only make people hate you, not  services you are mistaken.  Spamming will only make people hate you, not
149  buy from you.  buy from you.
150    
151  If you have any list of people you send unsolicited commercial emails to,  If you have any list of people you send unsolicited commercial emails to,
152  REMOVE me from such list immediately.  I suggest that you make this list  REMOVE me from such list immediately.  I suggest that you make this list
153  just empty.  just empty.
154    
155          ----------------------------------------------------          ----------------------------------------------------
# Line 192  Value nil means use no separator." Line 192  Value nil means use no separator."
192    :group 'uce)    :group 'uce)
193    
194  (defcustom uce-signature mail-signature  (defcustom uce-signature mail-signature
195  "Text to put as your signature after the note to UCE sender.    "Text to put as your signature after the note to UCE sender.
196  Value nil means none, t means insert `~/.signature' file (if it happens  Value nil means none, t means insert `~/.signature' file (if it happens
197  to exist), if this variable is a string this string will be inserted  to exist), if this variable is a string this string will be inserted
198  as your signature."  as your signature."
# Line 221  address, and postmaster of the mail rela Line 221  address, and postmaster of the mail rela
221    (let ((message-buffer    (let ((message-buffer
222           (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)           (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)
223                 ((eq uce-mail-reader 'rmail) "RMAIL")                 ((eq uce-mail-reader 'rmail) "RMAIL")
224                 (t (error                 (t (error
225                     "Variable uce-mail-reader set to unrecognized value"))))                     "Variable uce-mail-reader set to unrecognized value"))))
226          (full-header-p (and (eq uce-mail-reader 'rmail)          (full-header-p (and (eq uce-mail-reader 'rmail)
227                              (not (rmail-msg-is-pruned)))))                              (not (rmail-msg-is-pruned)))))
# Line 246  address, and postmaster of the mail rela Line 246  address, and postmaster of the mail rela
246                end-of-hostname (string-match "[ ,>]" to first-at-sign)                end-of-hostname (string-match "[ ,>]" to first-at-sign)
247                sender-host (substring to first-at-sign end-of-hostname))                sender-host (substring to first-at-sign end-of-hostname))
248          (if (string-match "\\." sender-host)          (if (string-match "\\." sender-host)
249              (setq to (format "%s, postmaster%s, abuse%s"              (setq to (format "%s, postmaster%s, abuse%s"
250                               to sender-host sender-host))))                               to sender-host sender-host))))
251        (setq mail-send-actions nil)        (setq mail-send-actions nil)
252        (setq mail-reply-buffer nil)        (setq mail-reply-buffer nil)
# Line 258  address, and postmaster of the mail rela Line 258  address, and postmaster of the mail rela
258                   (rmail-toggle-header 1)                   (rmail-toggle-header 1)
259                   (widen)                   (widen)
260                   (rmail-maybe-set-message-counters)                   (rmail-maybe-set-message-counters)
261                   (copy-region-as-kill (rmail-msgbeg rmail-current-message)                   (copy-region-as-kill (rmail-msgbeg rmail-current-message)
262                                        (rmail-msgend rmail-current-message))))))                                        (rmail-msgend rmail-current-message))))))
263        ;; Restore the pruned header state we found.        ;; Restore the pruned header state we found.
264        (if full-header-p        (if full-header-p
# Line 286  address, and postmaster of the mail rela Line 286  address, and postmaster of the mail rela
286               (beginning-of-buffer)               (beginning-of-buffer)
287               (search-forward "*** EOOH ***\n")               (search-forward "*** EOOH ***\n")
288               (beginning-of-line)               (beginning-of-line)
289               (forward-line -1)))                     (forward-line -1)))
290        (re-search-backward "^Received:")        (re-search-backward "^Received:")
291        (beginning-of-line)        (beginning-of-line)
292        ;; Is this always good?  It's the only thing I saw when I checked        ;; Is this always good?  It's the only thing I saw when I checked
# Line 304  address, and postmaster of the mail rela Line 304  address, and postmaster of the mail rela
304        (forward-char -1)        (forward-char -1)
305        ;; And add its postmaster to the list of addresses.        ;; And add its postmaster to the list of addresses.
306        (if (string-match "\\." (buffer-substring temp (point)))        (if (string-match "\\." (buffer-substring temp (point)))
307            (setq to (format "%s, postmaster@%s"            (setq to (format "%s, postmaster@%s"
308                             to (buffer-substring temp (point)))))                             to (buffer-substring temp (point)))))
309        ;; Also look at the message-id, it helps *very* often.        ;; Also look at the message-id, it helps *very* often.
310        (if (and (search-forward "\nMessage-Id: " nil t)        (if (and (search-forward "\nMessage-Id: " nil t)
# Line 320  address, and postmaster of the mail rela Line 320  address, and postmaster of the mail rela
320              (search-forward ">")              (search-forward ">")
321              (forward-char -1)              (forward-char -1)
322              (if (string-match "\\." (buffer-substring temp (point)))              (if (string-match "\\." (buffer-substring temp (point)))
323                  (setq to (format "%s, postmaster@%s"                  (setq to (format "%s, postmaster@%s"
324                                   to (buffer-substring temp (point)))))))                                   to (buffer-substring temp (point)))))))
325        (cond ((eq uce-mail-reader 'gnus)        (cond ((eq uce-mail-reader 'gnus)
326               ;; Does Gnus always have Lines: in the end?               ;; Does Gnus always have Lines: in the end?
# Line 384  address, and postmaster of the mail rela Line 384  address, and postmaster of the mail rela
384        ;; might be to set up special key bindings, replace standart        ;; might be to set up special key bindings, replace standart
385        ;; functions in mail-mode, etc.        ;; functions in mail-mode, etc.
386        (run-hooks 'mail-setup-hook 'uce-setup-hook))))        (run-hooks 'mail-setup-hook 'uce-setup-hook))))
387      
388  (defun uce-insert-ranting (&optional ignored)  (defun uce-insert-ranting (&optional ignored)
389    "Insert text of the usual reply to UCE into current buffer."    "Insert text of the usual reply to UCE into current buffer."
390    (interactive "P")    (interactive "P")

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.10.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26