Mercurial > emacs
annotate lisp/mail/uce.el @ 105829:328150f0cf76
* url-util.el (url-insert-entities-in-string):
* url-nfs.el (url-nfs-unescape):
* url-ldap.el (url-ldap):
* url-imap.el (url-imap):
* url-cid.el (url-cid-gnus, url-cid): Use with-current-buffer.
* erc.el (erc-display-line-1, erc-process-away):
* erc-truncate.el (erc-truncate-buffer-to-size):
Use with-current-buffer.
* term/ns-win.el (ns-scroll-bar-move, ns-face-at-pos):
* play/mpuz.el (mpuz-create-buffer):
* play/landmark.el (lm-prompt-for-move, lm-print-wts, lm-print-smell)
(lm-print-y,s,noise, lm-print-w0, lm-init):
* play/gomoku.el (gomoku-prompt-for-move):
* play/fortune.el (fortune-in-buffer):
* play/dissociate.el (dissociated-press):
* play/decipher.el (decipher-adjacency-list, decipher-display-regexp)
(decipher-analyze-buffer, decipher-stats-buffer,decipher-stats-buffer):
* mail/supercite.el (sc-eref-show):
* mail/smtpmail.el (smtpmail-send-it):
* mail/rmailsum.el (rmail-summary-next-labeled-message)
(rmail-summary-previous-labeled-message, rmail-summary-wipe)
(rmail-summary-undelete-many, rmail-summary-rmail-update)
(rmail-summary-goto-msg, rmail-summary-expunge)
(rmail-summary-get-new-mail, rmail-summary-search-backward)
(rmail-summary-add-label, rmail-summary-output-menu)
(rmail-summary-output-body):
* mail/rfc822.el (rfc822-addresses):
* mail/reporter.el (reporter-dump-variable, reporter-dump-state):
* mail/mailpost.el (post-mail-send-it):
* mail/hashcash.el (hashcash-generate-payment):
* mail/feedmail.el (feedmail-run-the-queue)
(feedmail-queue-send-edit-prompt-help-first)
(feedmail-send-it-immediately, feedmail-give-it-to-buffer-eater)
(feedmail-deduce-address-list):
* eshell/esh-ext.el (eshell-remote-command):
* eshell/em-unix.el (eshell-occur-mode-mouse-goto):
* emulation/viper-util.el (viper-glob-unix-files, viper-save-setting)
(viper-wildcard-to-regexp, viper-glob-mswindows-files)
(viper-save-string-in-file, viper-valid-marker):
* emulation/viper-keym.el (viper-toggle-key):
* emulation/viper-ex.el (ex-expand-filsyms, viper-get-ex-file)
(ex-edit, ex-global, ex-mark, ex-next-related-buffer, ex-quit)
(ex-get-inline-cmd-args, ex-tag, ex-command, ex-compile):
* emulation/viper-cmd.el (viper-exec-form-in-vi)
(viper-exec-form-in-emacs, viper-brac-function):
* emulation/viper.el (viper-delocalize-var):
* emulation/vip.el (vip-mode, vip-get-ex-token, vip-ex, vip-get-ex-pat)
(vip-get-ex-command, vip-get-ex-opt-gc, vip-get-ex-buffer)
(vip-get-ex-count, vip-get-ex-file, ex-edit, ex-global, ex-mark)
(ex-map, ex-unmap, ex-quit, ex-read, ex-tag, ex-command):
* emulation/vi.el (vi-switch-mode, vi-ex-cmd):
* emulation/edt.el (edt-electric-helpify):
* emulation/cua-rect.el (cua--rectangle-aux-replace):
* emulation/cua-gmrk.el (cua--insert-at-global-mark)
(cua--delete-at-global-mark, cua--copy-rectangle-to-global-mark)
(cua-indent-to-global-mark-column):
* calendar/diary-lib.el (calendar-mark-1):
* calendar/cal-hebrew.el (calendar-hebrew-mark-date-pattern):
Use with-current-buffer.
* emulation/viper.el (viper-delocalize-var): Use dolist.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 03 Nov 2009 02:04:29 +0000 |
parents | 4c610ec5ed40 |
children | 1d1d5d9bd884 |
rev | line source |
---|---|
17450 | 1 ;;; uce.el --- facilitate reply to unsolicited commercial email |
2 | |
101694 | 3 ;; Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, |
4 ;; 2007, 2008, 2009 Free Software Foundation, Inc. | |
17450 | 5 |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
6 ;; Author: stanislav shalunov <shalunov@mccme.ru> |
17450 | 7 ;; Created: 10 Dec 1996 |
101694 | 8 ;; Keywords: mail, uce, unsolicited commercial email |
17450 | 9 |
10 ;; This file is part of GNU Emacs. | |
11 | |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
38401 | 13 ;; it under the terms of the GNU General Public License as published by |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; (at your option) any later version. |
17450 | 16 |
38401 | 17 ;; GNU Emacs is distributed in the hope that it will be useful, |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
17450 | 21 |
22 ;; You should have received a copy of the GNU General Public License | |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17450 | 24 |
25 ;;; Commentary: | |
26 | |
101694 | 27 ;; The code in this file provides a semi-automatic means of replying |
28 ;; to unsolicited commercial email (UCE) you might get. Currently, it | |
29 ;; only works with Rmail and Gnus. If you would like to make it work | |
30 ;; with other mail readers, see the mail-client dependent section of | |
31 ;; uce-reply-to-uce. Please let me know about your changes so I can | |
32 ;; incorporate them. I'd appreciate it. | |
17450 | 33 |
101694 | 34 ;; The command uce-reply-to-uce, if called when the current message |
35 ;; buffer is a UCE, will setup a reply *mail* buffer as follows. It | |
36 ;; scans the full headers of the message for: 1) the normal return | |
37 ;; address of the sender (From, Reply-To lines), and puts these | |
38 ;; addresses into the To: header, along with abuse@offenders.host; 2) | |
39 ;; the mailhub that first saw this message, and adds the address of | |
40 ;; its postmaster into the To: header; and 3), finally, it looks at | |
41 ;; the Message-Id and adds the postmaster of that host to the list of | |
42 ;; addresses. | |
17450 | 43 |
101694 | 44 ;; Then, we add an "Errors-To: nobody@localhost" header, so that if |
45 ;; some of these addresses are not actually correct, we will never see | |
17450 | 46 ;; bounced mail. Also, mail-self-blind and mail-archive-file-name |
47 ;; take no effect: the ideology is that we don't want to save junk or | |
48 ;; replies to junk. | |
49 | |
101694 | 50 ;; Then we insert a template into the buffer (a customizable message |
51 ;; that explains what has happened), customizable signature, and the | |
17450 | 52 ;; original message with full headers and envelope for postmasters. |
101694 | 53 ;; Then the buffer is left for editing. |
54 | |
55 ;; The reason that the function uce-reply-to-uce is mail-client | |
56 ;; dependent is that we want the full headers of the original message, | |
57 ;; nothing stripped. If we use the normal means of inserting the | |
58 ;; original message into the *mail* buffer, headers like Received: | |
59 ;; (not really headers, but envelope lines) will be stripped, while | |
60 ;; they bear valuable information for us and postmasters. I do wish | |
61 ;; that there would be some portable way to write this function, but I | |
62 ;; am not aware of any. | |
63 | |
64 ;; Usage: | |
17450 | 65 |
101694 | 66 ;; Place uce.el in your load-path (and optionally byte-compile it). |
67 ;; Add the following line to your ~/.emacs: | |
68 ;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil) | |
69 ;; If you want to use it with Gnus rather than Rmail: | |
70 ;; (setq uce-mail-reader 'gnus) | |
71 | |
72 ;; Options: | |
73 | |
74 ;; uce-message-text is a template that will be inserted into buffer. | |
75 ;; It has a reasonable default. If you want to write some scarier | |
76 ;; one, please do so and send it to me. Please keep it polite. | |
17450 | 77 |
101694 | 78 ;; uce-signature behaves just like mail-signature. If nil, nothing is |
79 ;; inserted, if t, file ~/.signature is used, if a string, its | |
80 ;; contents are inserted into buffer. | |
81 | |
82 ;; uce-uce-separator is a line that separates your message from the | |
83 ;; UCE that you enclose. | |
84 | |
85 ;; uce-subject-line will be used as the subject of the outgoing message. | |
86 | |
87 | |
88 ;;; Change Log: | |
17450 | 89 |
90 ;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs | |
91 | |
92 ;; Dec 11, 1996 -- fixed some typos, and Francesco Potorti` | |
93 ;; <F.Potorti@cnuce.cnr.it> pointed out that my use of defvar was | |
94 ;; weird, suggested fix, and added let form. | |
95 | |
96 ;; Dec 17, 1996 -- made scanning for host names little bit more clever | |
97 ;; (obviously bogus stuff like localhost is now ignored). | |
98 | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
99 ;; Nov 11, 1997 -- incorporated changes from Mikael Djurfeldt |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
100 ;; <mdj@nada.kth.se> to make uce.el work with Gnus. Changed the text |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
101 ;; of message that is sent. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
102 |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
103 ;; Dec 3, 1997 -- changes from Gareth Jones <gdj1@gdjones.demon.co.uk> |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
104 ;; handling Received headers following some line like `From:'. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
105 |
31224
fa7a79afcbf7
(uce-reply-to-uce): Remove hard-coded "*Article*" from
Gerd Moellmann <gerd@gnu.org>
parents:
23458
diff
changeset
|
106 ;; Aug 16, 2000 -- changes from Detlev Zundel |
fa7a79afcbf7
(uce-reply-to-uce): Remove hard-coded "*Article*" from
Gerd Moellmann <gerd@gnu.org>
parents:
23458
diff
changeset
|
107 ;; <detlev.zundel@stud.uni-karlsruhe.de> to make uce.el work with the |
fa7a79afcbf7
(uce-reply-to-uce): Remove hard-coded "*Article*" from
Gerd Moellmann <gerd@gnu.org>
parents:
23458
diff
changeset
|
108 ;; latest Gnus. Lars told him it should work for all versions of Gnus |
fa7a79afcbf7
(uce-reply-to-uce): Remove hard-coded "*Article*" from
Gerd Moellmann <gerd@gnu.org>
parents:
23458
diff
changeset
|
109 ;; younger than three years. |
17450 | 110 |
111 | |
112 ;;; Code: | |
113 | |
65205
98f74806263a
(gnus-original-article-buffer, mail-reply-buffer, rmail-current-message):
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
114 (defvar gnus-original-article-buffer) |
98f74806263a
(gnus-original-article-buffer, mail-reply-buffer, rmail-current-message):
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
115 (defvar mail-reply-buffer) |
98f74806263a
(gnus-original-article-buffer, mail-reply-buffer, rmail-current-message):
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
116 |
17450 | 117 (require 'sendmail) |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
118 ;; Those sections of code which are dependent upon |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
119 ;; RMAIL are only evaluated if we have received a message with RMAIL... |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
120 ;;(require 'rmail) |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
121 |
20962 | 122 (defgroup uce nil |
123 "Facilitate reply to unsolicited commercial email." | |
124 :prefix "uce-" | |
125 :group 'mail) | |
126 | |
22462
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
127 (defcustom uce-mail-reader 'rmail |
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
128 "A symbol indicating which mail reader you are using. |
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
129 Choose from: `gnus', `rmail'." |
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
130 :type '(choice (const gnus) (const rmail)) |
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
131 :version "20.3" |
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
132 :group 'uce) |
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
133 |
20962 | 134 (defcustom uce-setup-hook nil |
17450 | 135 "Hook to run after UCE rant message is composed. |
22462
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
136 This hook is run after `mail-setup-hook', which is run as well." |
20962 | 137 :type 'hook |
138 :group 'uce) | |
17450 | 139 |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
140 (defcustom uce-message-text |
17450 | 141 "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 | |
143 unsolicited messages to someone while he or she may have to pay for | |
144 reading your message may be illegal. Anyway, it is highly annoying | |
145 and not welcome by anyone. It is rude, after all. | |
146 | |
147 If you think that this is a good way to advertise your products or | |
148 services you are mistaken. Spamming will only make people hate you, not | |
149 buy from you. | |
150 | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
151 If you have any list of people you send unsolicited commercial emails to, |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
152 REMOVE me from such list immediately. I suggest that you make this list |
17450 | 153 just empty. |
154 | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
155 ---------------------------------------------------- |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
156 |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
157 If you are not an administrator of any site and still have received |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
158 this message then your email address is being abused by some spammer. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
159 They fake your address in From: or Reply-To: header. In this case, |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
160 you might want to show this message to your system administrator, and |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
161 ask him/her to investigate this matter. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
162 |
17450 | 163 Note to the postmaster(s): I append the text of UCE in question to |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
164 this message; I would like to hear from you about action(s) taken. |
17450 | 165 This message has been sent to postmasters at the host that is |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
166 mentioned as original sender's host (I do realize that it may be |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
167 faked, but I think that if your domain name is being abused this way |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
168 you might want to learn about it, and take actions) and to the |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
169 postmaster whose host was used as mail relay for this message. If |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
170 message was sent not by your user, could you please compare time when |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
171 this message was sent (use time in Received: field of the envelope |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
172 rather than Date: field) with your sendmail logs and see what host was |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
173 using your sendmail at this moment of time. |
17450 | 174 |
175 Thank you." | |
176 | |
22462
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
177 "This is the text that `uce-reply-to-uce' command will put in reply buffer. |
17450 | 178 Some of spamming programs in use will be set up to read all incoming |
179 to spam address email, and will remove people who put the word `remove' | |
180 on beginning of some line from the spamming list. So, when you set it | |
181 up, it might be a good idea to actually use this feature. | |
182 | |
20962 | 183 Value nil means insert no text by default, lets you type it in." |
101694 | 184 :type '(choice (const nil) string) |
20962 | 185 :group 'uce) |
17450 | 186 |
20962 | 187 (defcustom uce-uce-separator |
17450 | 188 "----- original unsolicited commercial email follows -----" |
189 "Line that will begin quoting of the UCE. | |
20962 | 190 Value nil means use no separator." |
191 :type '(choice (const nil) string) | |
192 :group 'uce) | |
17450 | 193 |
20962 | 194 (defcustom uce-signature mail-signature |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
195 "Text to put as your signature after the note to UCE sender. |
22462
198054d3498c
Several fixes in doc string style.
Richard M. Stallman <rms@gnu.org>
parents:
22416
diff
changeset
|
196 Value nil means none, t means insert `~/.signature' file (if it happens |
17450 | 197 to exist), if this variable is a string this string will be inserted |
20962 | 198 as your signature." |
199 :type '(choice (const nil) (const t) string) | |
200 :group 'uce) | |
17450 | 201 |
20962 | 202 (defcustom uce-default-headers |
17450 | 203 "Errors-To: nobody@localhost\nPrecedence: bulk\n" |
204 "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce]. | |
20962 | 205 These are mostly meant for headers that prevent delivery errors reporting." |
101694 | 206 :type '(choice (const nil) string) |
20962 | 207 :group 'uce) |
17450 | 208 |
20962 | 209 (defcustom uce-subject-line |
17450 | 210 "Spam alert: unsolicited commercial e-mail" |
20962 | 211 "Subject of the message that will be sent in response to a UCE." |
212 :type 'string | |
213 :group 'uce) | |
17450 | 214 |
101694 | 215 ;; End of user options. |
216 | |
217 | |
218 (defvar rmail-buffer) | |
219 (declare-function rmail-msg-is-pruned "rmail" ()) | |
86440
4aedd218aad1
* mail/mspools.el (rmail-get-new-mail):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
78232
diff
changeset
|
220 (declare-function mail-strip-quoted-names "mail-utils" (address)) |
86503
2c08ad76fc1f
* progmodes/cperl-mode.el (compilation-error-regexp-alist): Pacify
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86440
diff
changeset
|
221 (declare-function rmail-maybe-set-message-counters "rmail" ()) |
2c08ad76fc1f
* progmodes/cperl-mode.el (compilation-error-regexp-alist): Pacify
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86440
diff
changeset
|
222 (declare-function rmail-toggle-header "rmail" (&optional arg)) |
2c08ad76fc1f
* progmodes/cperl-mode.el (compilation-error-regexp-alist): Pacify
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86440
diff
changeset
|
223 |
101694 | 224 ;;;###autoload |
17450 | 225 (defun uce-reply-to-uce (&optional ignored) |
101694 | 226 "Compose a reply to unsolicited commercial email (UCE). |
227 Sets up a reply buffer addressed to: the sender, his postmaster, | |
228 his abuse@ address, and the postmaster of the mail relay used. | |
229 You might need to set `uce-mail-reader' before using this." | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
230 (interactive) |
101694 | 231 ;; Start of mail-client dependent section. |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
232 (let ((message-buffer |
31224
fa7a79afcbf7
(uce-reply-to-uce): Remove hard-coded "*Article*" from
Gerd Moellmann <gerd@gnu.org>
parents:
23458
diff
changeset
|
233 (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer) |
101694 | 234 ((eq uce-mail-reader 'rmail) (bound-and-true-p rmail-buffer)) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
235 (t (error |
43067
858e5cbf508c
(uce-reply-to-uce): Prune the headers before copying
Eli Zaretskii <eliz@gnu.org>
parents:
38401
diff
changeset
|
236 "Variable uce-mail-reader set to unrecognized value")))) |
101694 | 237 pruned) |
238 (or (and message-buffer (get-buffer message-buffer)) | |
239 (error "No mail buffer, cannot find UCE")) | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
240 (switch-to-buffer message-buffer) |
43067
858e5cbf508c
(uce-reply-to-uce): Prune the headers before copying
Eli Zaretskii <eliz@gnu.org>
parents:
38401
diff
changeset
|
241 ;; We need the message with headers pruned. |
101694 | 242 ;; Why? All we do is get the from and reply-to headers. ? |
243 (and (eq uce-mail-reader 'rmail) | |
244 (not (setq pruned (rmail-msg-is-pruned))) | |
245 (rmail-toggle-header 1)) | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
246 (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
247 (reply-to (mail-fetch-field "reply-to")) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
248 temp) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
249 ;; Initial setting of the list of recipients of our message; that's |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
250 ;; what they are pretending to be. |
101694 | 251 (setq to (if to |
252 (format "%s" (mail-strip-quoted-names to)) | |
253 "")) | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
254 (if reply-to |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
255 (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to)))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
256 (let (first-at-sign end-of-hostname sender-host) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
257 (setq first-at-sign (string-match "@" to) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
258 end-of-hostname (string-match "[ ,>]" to first-at-sign) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
259 sender-host (substring to first-at-sign end-of-hostname)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
260 (if (string-match "\\." sender-host) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
261 (setq to (format "%s, postmaster%s, abuse%s" |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
262 to sender-host sender-host)))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
263 (setq mail-send-actions nil) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
264 (setq mail-reply-buffer nil) |
101694 | 265 (when (eq uce-mail-reader 'rmail) |
266 (rmail-toggle-header 0) | |
267 (rmail-maybe-set-message-counters)) ; why? | |
268 (copy-region-as-kill (point-min) (point-max)) | |
269 ;; Restore the initial header state we found. | |
270 (and pruned (rmail-toggle-header 1)) | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
271 (switch-to-buffer "*mail*") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
272 (erase-buffer) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
273 (yank) |
101694 | 274 (goto-char (point-min)) |
275 ;; Delete any internal Rmail headers. | |
276 (when (eq uce-mail-reader 'rmail) | |
277 (search-forward "\n\n") | |
278 (while (re-search-backward "^X-RMAIL" nil t) | |
279 (delete-region (point) (line-beginning-position 2))) | |
280 (goto-char (point-min))) | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
281 ;; Now find the mail hub that first accepted this message. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
282 ;; This should try to find the last Received: header. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
283 ;; Sometimes there may be other headers inbetween Received: headers. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
284 (cond ((eq uce-mail-reader 'gnus) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
285 ;; Does Gnus always have Lines: in the end? |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
286 (re-search-forward "^Lines:") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
287 (beginning-of-line)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
288 ((eq uce-mail-reader 'rmail) |
101694 | 289 (search-forward "\n\n"))) |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
290 (re-search-backward "^Received:") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
291 ;; Is this always good? It's the only thing I saw when I checked |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
292 ;; a few messages. |
101694 | 293 ;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t)) |
294 (unless (re-search-forward "\\(from\\|by\\) " (line-end-position) 'move) | |
295 (if (looking-at "[ \t\n]+\\(from\\|by\\) ") | |
296 (goto-char (match-end 0)) | |
297 (error "Failed to extract hub address"))) | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
298 (setq temp (point)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
299 (search-forward " ") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
300 (forward-char -1) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
301 ;; And add its postmaster to the list of addresses. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
302 (if (string-match "\\." (buffer-substring temp (point))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
303 (setq to (format "%s, postmaster@%s" |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
304 to (buffer-substring temp (point))))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
305 ;; Also look at the message-id, it helps *very* often. |
101694 | 306 (and (search-forward "\nMessage-Id: " nil t) |
307 ;; Not all Message-Id:'s have an `@' sign. | |
308 (search-forward "@" (line-end-position) t) | |
309 (progn | |
310 (setq temp (point)) | |
311 (search-forward ">") | |
312 (forward-char -1) | |
313 (if (string-match "\\." (buffer-substring temp (point))) | |
314 (setq to (format "%s, postmaster@%s" | |
315 to (buffer-substring temp (point))))))) | |
316 (when (eq uce-mail-reader 'gnus) | |
317 ;; Does Gnus always have Lines: in the end? | |
318 (re-search-forward "^Lines:") | |
319 (beginning-of-line) | |
320 (setq temp (point)) | |
321 (search-forward "\n\n" nil t) | |
322 (forward-line -1) | |
323 (delete-region temp (point))) | |
324 ;; End of mail-client dependent section. | |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
325 (auto-save-mode auto-save-default) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
326 (mail-mode) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
327 (goto-char (point-min)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
328 (insert "To: ") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
329 (save-excursion |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
330 (if to |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
331 (let ((fill-prefix "\t") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
332 (address-start (point))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
333 (insert to "\n") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
334 (fill-region-as-paragraph address-start (point))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
335 (newline)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
336 (insert "Subject: " uce-subject-line "\n") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
337 (if uce-default-headers |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
338 (insert uce-default-headers)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
339 (if mail-default-headers |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
340 (insert mail-default-headers)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
341 (if mail-default-reply-to |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
342 (insert "Reply-to: " mail-default-reply-to "\n")) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
343 (insert mail-header-separator "\n") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
344 ;; Insert all our text. Then go back to the place where we started. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
345 (if to (setq to (point))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
346 ;; Text of ranting. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
347 (if uce-message-text |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
348 (insert uce-message-text)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
349 ;; Signature. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
350 (cond ((eq uce-signature t) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
351 (if (file-exists-p "~/.signature") |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
352 (progn |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
353 (insert "\n\n-- \n") |
64386
d24c0f192f20
(uce-reply-to-uce): Replace beginning-of-buffer and insert-file.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
354 (forward-char (cadr (insert-file-contents "~/.signature")))))) |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
355 (uce-signature |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
356 (insert "\n\n-- \n" uce-signature))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
357 ;; And text of the original message. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
358 (if uce-uce-separator |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
359 (insert "\n\n" uce-uce-separator "\n")) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
360 ;; If message doesn't end with a newline, insert it. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
361 (goto-char (point-max)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
362 (or (bolp) (newline))) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
363 ;; And go back to the beginning of text. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
364 (if to (goto-char to)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
365 (or to (set-buffer-modified-p nil)) |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
366 ;; Run hooks before we leave buffer for editing. Reasonable usage |
101694 | 367 ;; might be to set up special key bindings, replace standard |
22416
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
368 ;; functions in mail-mode, etc. |
a517da228cb9
(uce-message-text): Change the text of message that is sent.
Richard M. Stallman <rms@gnu.org>
parents:
21918
diff
changeset
|
369 (run-hooks 'mail-setup-hook 'uce-setup-hook)))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43387
diff
changeset
|
370 |
17450 | 371 (defun uce-insert-ranting (&optional ignored) |
372 "Insert text of the usual reply to UCE into current buffer." | |
373 (interactive "P") | |
374 (insert uce-message-text)) | |
375 | |
376 (provide 'uce) | |
377 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
378 ;; arch-tag: 44b68c87-9b29-47bd-822c-3feee3883221 |
17450 | 379 ;;; uce.el ends here |