1 |
;;; rmail.el --- main code of "RMAIL" mail reader for Emacs |
2 |
|
3 |
;; Copyright (C) 1985,86,87,88,93,94,95,96,97,98,2000, 01, 2004 |
4 |
;; Free Software Foundation, Inc. |
5 |
|
6 |
;; Maintainer: FSF |
7 |
;; Keywords: mail |
8 |
|
9 |
;; This file is part of GNU Emacs. |
10 |
|
11 |
;; GNU Emacs is free software; you can redistribute it and/or modify |
12 |
;; it under the terms of the GNU General Public License as published by |
13 |
;; the Free Software Foundation; either version 2, or (at your option) |
14 |
;; any later version. |
15 |
|
16 |
;; GNU Emacs is distributed in the hope that it will be useful, |
17 |
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
18 |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
19 |
;; GNU General Public License for more details. |
20 |
|
21 |
;; You should have received a copy of the GNU General Public License |
22 |
;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 |
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
24 |
;; Boston, MA 02111-1307, USA. |
25 |
|
26 |
;;; Commentary: |
27 |
|
28 |
;;; Code: |
29 |
|
30 |
;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu |
31 |
;; New features include attribute and keyword support, message |
32 |
;; selection by dispatch table, summary by attributes and keywords, |
33 |
;; expunging by dispatch table, sticky options for file commands. |
34 |
|
35 |
;; Extended by Bob Weiner of Motorola |
36 |
;; New features include: rmail and rmail-summary buffers remain |
37 |
;; synchronized and key bindings basically operate the same way in both |
38 |
;; buffers, summary by topic or by regular expression, rmail-reply-prefix |
39 |
;; variable, and a bury rmail buffer (wipe) command. |
40 |
;; |
41 |
|
42 |
(require 'mail-utils) |
43 |
(eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority |
44 |
|
45 |
; These variables now declared in paths.el. |
46 |
;(defvar rmail-spool-directory "/usr/spool/mail/" |
47 |
; "This is the name of the directory used by the system mailer for\n\ |
48 |
;delivering new mail. Its name should end with a slash.") |
49 |
;(defvar rmail-file-name |
50 |
; (expand-file-name "~/RMAIL") |
51 |
; "") |
52 |
|
53 |
(defgroup rmail nil |
54 |
"Mail reader for Emacs." |
55 |
:group 'mail) |
56 |
|
57 |
(defgroup rmail-retrieve nil |
58 |
"Rmail retrieval options." |
59 |
:prefix "rmail-" |
60 |
:group 'rmail) |
61 |
|
62 |
(defgroup rmail-files nil |
63 |
"Rmail files." |
64 |
:prefix "rmail-" |
65 |
:group 'rmail) |
66 |
|
67 |
(defgroup rmail-headers nil |
68 |
"Rmail header options." |
69 |
:prefix "rmail-" |
70 |
:group 'rmail) |
71 |
|
72 |
(defgroup rmail-reply nil |
73 |
"Rmail reply options." |
74 |
:prefix "rmail-" |
75 |
:group 'rmail) |
76 |
|
77 |
(defgroup rmail-summary nil |
78 |
"Rmail summary options." |
79 |
:prefix "rmail-" |
80 |
:prefix "rmail-summary-" |
81 |
:group 'rmail) |
82 |
|
83 |
(defgroup rmail-output nil |
84 |
"Output message to a file." |
85 |
:prefix "rmail-output-" |
86 |
:prefix "rmail-" |
87 |
:group 'rmail) |
88 |
|
89 |
(defgroup rmail-edit nil |
90 |
"Rmail editing." |
91 |
:prefix "rmail-edit-" |
92 |
:group 'rmail) |
93 |
|
94 |
|
95 |
(defcustom rmail-movemail-program nil |
96 |
"If non-nil, name of program for fetching new mail." |
97 |
:group 'rmail-retrieve |
98 |
:type '(choice (const nil) string)) |
99 |
|
100 |
(defcustom rmail-pop-password nil |
101 |
"*Password to use when reading mail from a POP server, if required." |
102 |
:type '(choice (string :tag "Password") |
103 |
(const :tag "Not Required" nil)) |
104 |
:group 'rmail-retrieve) |
105 |
|
106 |
(defcustom rmail-pop-password-required nil |
107 |
"*Non-nil if a password is required when reading mail using POP." |
108 |
:type 'boolean |
109 |
:group 'rmail-retrieve) |
110 |
|
111 |
(defcustom rmail-movemail-flags nil |
112 |
"*List of flags to pass to movemail. |
113 |
Most commonly used to specify `-g' to enable GSS-API authentication |
114 |
or `-k' to enable Kerberos authentication." |
115 |
:type '(repeat string) |
116 |
:group 'rmail-retrieve |
117 |
:version "20.3") |
118 |
|
119 |
(defvar rmail-pop-password-error "invalid usercode or password\\| |
120 |
unknown user name or bad password" |
121 |
"Regular expression matching incorrect-password POP server error messages. |
122 |
If you get an incorrect-password error that this expression does not match, |
123 |
please report it with \\[report-emacs-bug].") |
124 |
|
125 |
(defvar rmail-encoded-pop-password nil) |
126 |
|
127 |
(defcustom rmail-preserve-inbox nil |
128 |
"*Non-nil if incoming mail should be left in the user's inbox, |
129 |
rather than deleted, after it is retrieved." |
130 |
:type 'boolean |
131 |
:group 'rmail-retrieve) |
132 |
|
133 |
;;;###autoload |
134 |
(defcustom rmail-dont-reply-to-names nil "\ |
135 |
*A regexp specifying addresses to prune from a reply message. |
136 |
A value of nil means exclude your own email address as an address |
137 |
plus whatever is specified by `rmail-default-dont-reply-to-names'." |
138 |
:type '(choice regexp (const :tag "Your Name" nil)) |
139 |
:group 'rmail-reply) |
140 |
|
141 |
;;;###autoload |
142 |
(defvar rmail-default-dont-reply-to-names "\\`info-" "\ |
143 |
A regular expression specifying part of the default value of the |
144 |
variable `rmail-dont-reply-to-names', for when the user does not set |
145 |
`rmail-dont-reply-to-names' explicitly. (The other part of the default |
146 |
value is the user's email address and name.) |
147 |
It is useful to set this variable in the site customization file.") |
148 |
|
149 |
;;;###autoload |
150 |
(defcustom rmail-ignored-headers |
151 |
(concat "^via:\\|^mail-from:\\|^origin:\\|^references:" |
152 |
"\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" |
153 |
"\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" |
154 |
"\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" |
155 |
"\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:" |
156 |
"\\|^x-mailer:\\|^delivered-to:\\|^lines:\\|^mime-version:" |
157 |
"\\|^content-transfer-encoding:\\|^x-coding-system:" |
158 |
"\\|^return-path:\\|^errors-to:\\|^return-receipt-to:" |
159 |
"\\|^x-sign:\\|^x-beenthere:\\|^x-mailman-version:" |
160 |
"\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:" |
161 |
"\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" |
162 |
"\\|^content-type:\\|^content-length:" |
163 |
"\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:" |
164 |
"\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent" |
165 |
"\\|^importance:\\|^envelope-to:\\|^delivery-date" |
166 |
"\\|^x.*-priority:\\|^x-mimeole:") |
167 |
"*Regexp to match header fields that Rmail should normally hide. |
168 |
This variable is used for reformatting the message header, |
169 |
which normally happens once for each message, |
170 |
when you view the message for the first time in Rmail. |
171 |
To make a change in this variable take effect |
172 |
for a message that you have already viewed, |
173 |
go to that message and type \\[rmail-toggle-header] twice." |
174 |
:type 'regexp |
175 |
:group 'rmail-headers) |
176 |
|
177 |
;;;###autoload |
178 |
(defcustom rmail-displayed-headers nil |
179 |
"*Regexp to match Header fields that Rmail should display. |
180 |
If nil, display all header fields except those matched by |
181 |
`rmail-ignored-headers'." |
182 |
:type '(choice regexp (const :tag "All")) |
183 |
:group 'rmail-headers) |
184 |
|
185 |
;;;###autoload |
186 |
(defcustom rmail-retry-ignored-headers "^x-authentication-warning:" "\ |
187 |
*Headers that should be stripped when retrying a failed message." |
188 |
:type '(choice regexp (const nil :tag "None")) |
189 |
:group 'rmail-headers) |
190 |
|
191 |
;;;###autoload |
192 |
(defcustom rmail-highlighted-headers "^From:\\|^Subject:" "\ |
193 |
*Regexp to match Header fields that Rmail should normally highlight. |
194 |
A value of nil means don't highlight. |
195 |
See also `rmail-highlight-face'." |
196 |
:type 'regexp |
197 |
:group 'rmail-headers) |
198 |
|
199 |
;;;###autoload |
200 |
(defcustom rmail-highlight-face nil "\ |
201 |
*Face used by Rmail for highlighting headers." |
202 |
:type '(choice (const :tag "Default" nil) |
203 |
face) |
204 |
:group 'rmail-headers) |
205 |
|
206 |
;;;###autoload |
207 |
(defcustom rmail-delete-after-output nil "\ |
208 |
*Non-nil means automatically delete a message that is copied to a file." |
209 |
:type 'boolean |
210 |
:group 'rmail-files) |
211 |
|
212 |
;;;###autoload |
213 |
(defcustom rmail-primary-inbox-list nil "\ |
214 |
*List of files which are inboxes for user's primary mail file `~/RMAIL'. |
215 |
nil means the default, which is (\"/usr/spool/mail/$USER\") |
216 |
\(the name varies depending on the operating system, |
217 |
and the value of the environment variable MAIL overrides it)." |
218 |
;; Don't use backquote here, because we don't want to need it |
219 |
;; at load time. |
220 |
:type (list 'choice '(const :tag "Default" nil) |
221 |
(list 'repeat ':value (list (or (getenv "MAIL") |
222 |
(concat "/var/spool/mail/" |
223 |
(getenv "USER")))) |
224 |
'file)) |
225 |
:group 'rmail-retrieve |
226 |
:group 'rmail-files) |
227 |
|
228 |
;;;###autoload |
229 |
(defcustom rmail-mail-new-frame nil |
230 |
"*Non-nil means Rmail makes a new frame for composing outgoing mail. |
231 |
This is handy if you want to preserve the window configuration of |
232 |
the frame where you have the RMAIL buffer displayed." |
233 |
:type 'boolean |
234 |
:group 'rmail-reply) |
235 |
|
236 |
;;;###autoload |
237 |
(defcustom rmail-secondary-file-directory "~/" |
238 |
"*Directory for additional secondary Rmail files." |
239 |
:type 'directory |
240 |
:group 'rmail-files) |
241 |
;;;###autoload |
242 |
(defcustom rmail-secondary-file-regexp "\\.xmail$" |
243 |
"*Regexp for which files are secondary Rmail files." |
244 |
:type 'regexp |
245 |
:group 'rmail-files) |
246 |
|
247 |
;;;###autoload |
248 |
(defcustom rmail-confirm-expunge 'y-or-n-p |
249 |
"*Whether and how to ask for confirmation before expunging deleted messages." |
250 |
:type '(choice (const :tag "No confirmation" nil) |
251 |
(const :tag "Confirm with y-or-n-p" y-or-n-p) |
252 |
(const :tag "Confirm with yes-or-no-p" yes-or-no-p)) |
253 |
:version "21.1" |
254 |
:group 'rmail-files) |
255 |
|
256 |
;;;###autoload |
257 |
(defvar rmail-mode-hook nil |
258 |
"List of functions to call when Rmail is invoked.") |
259 |
|
260 |
;;;###autoload |
261 |
(defvar rmail-get-new-mail-hook nil |
262 |
"List of functions to call when Rmail has retrieved new mail.") |
263 |
|
264 |
;;;###autoload |
265 |
(defcustom rmail-show-message-hook nil |
266 |
"List of functions to call when Rmail displays a message." |
267 |
:type 'hook |
268 |
:options '(goto-address) |
269 |
:group 'rmail) |
270 |
|
271 |
;;;###autoload |
272 |
(defvar rmail-quit-hook nil |
273 |
"List of functions to call when quitting out of Rmail.") |
274 |
|
275 |
;;;###autoload |
276 |
(defvar rmail-delete-message-hook nil |
277 |
"List of functions to call when Rmail deletes a message. |
278 |
When the hooks are called, the message has been marked deleted but is |
279 |
still the current message in the Rmail buffer.") |
280 |
|
281 |
;; These may be altered by site-init.el to match the format of mmdf files |
282 |
;; delimiting used on a given host (delim1 and delim2 from the config |
283 |
;; files). |
284 |
|
285 |
(defvar rmail-mmdf-delim1 "^\001\001\001\001\n" |
286 |
"Regexp marking the start of an mmdf message.") |
287 |
(defvar rmail-mmdf-delim2 "^\001\001\001\001\n" |
288 |
"Regexp marking the end of an mmdf message.") |
289 |
|
290 |
(defcustom rmail-message-filter nil |
291 |
"If non-nil, a filter function for new messages in RMAIL. |
292 |
Called with region narrowed to the message, including headers, |
293 |
before obeying `rmail-ignored-headers'." |
294 |
:group 'rmail-headers |
295 |
:type 'function) |
296 |
|
297 |
(defcustom rmail-automatic-folder-directives nil |
298 |
"List of directives specifying where to put a message. |
299 |
Each element of the list is of the form: |
300 |
|
301 |
(FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) |
302 |
|
303 |
Where FOLDERNAME is the name of a BABYL format folder to put the |
304 |
message. If any of the field regexp's are nil, then it is ignored. |
305 |
|
306 |
If FOLDERNAME is \"/dev/null\", it is deleted. |
307 |
If FOLDERNAME is nil then it is deleted, and skipped. |
308 |
|
309 |
FIELD is the plain text name of a field in the message, such as |
310 |
\"subject\" or \"from\". A FIELD of \"to\" will automatically include |
311 |
all text from the \"cc\" field as well. |
312 |
|
313 |
REGEXP is an expression to match in the preceeding specified FIELD. |
314 |
FIELD/REGEXP pairs continue in the list. |
315 |
|
316 |
examples: |
317 |
(\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com |
318 |
(\"RMS\" \"from\" \"rms@\") ; save all mail from RMS." |
319 |
:group 'rmail |
320 |
:version "21.1" |
321 |
:type '(repeat (sexp :tag "Directive"))) |
322 |
|
323 |
(defvar rmail-reply-prefix "Re: " |
324 |
"String to prepend to Subject line when replying to a message.") |
325 |
|
326 |
;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:". |
327 |
;; This pattern should catch all the common variants. |
328 |
(defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*" |
329 |
"Regexp to delete from Subject line before inserting `rmail-reply-prefix'.") |
330 |
|
331 |
(defcustom rmail-display-summary nil |
332 |
"*If non-nil, Rmail always displays the summary buffer." |
333 |
:group 'rmail-summary |
334 |
:type 'boolean) |
335 |
|
336 |
(defvar rmail-inbox-list nil) |
337 |
(put 'rmail-inbox-list 'permanent-local t) |
338 |
|
339 |
(defvar rmail-keywords nil) |
340 |
(put 'rmail-keywords 'permanent-local t) |
341 |
|
342 |
(defvar rmail-buffer nil |
343 |
"The RMAIL buffer related to the current buffer. |
344 |
In an RMAIL buffer, this holds the RMAIL buffer itself. |
345 |
In a summary buffer, this holds the RMAIL buffer it is a summary for.") |
346 |
(put 'rmail-buffer 'permanent-local t) |
347 |
|
348 |
;; Message counters and markers. Deleted flags. |
349 |
|
350 |
(defvar rmail-current-message nil) |
351 |
(put 'rmail-current-message 'permanent-local t) |
352 |
|
353 |
(defvar rmail-total-messages nil) |
354 |
(put 'rmail-total-messages 'permanent-local t) |
355 |
|
356 |
(defvar rmail-message-vector nil) |
357 |
(put 'rmail-message-vector 'permanent-local t) |
358 |
|
359 |
(defvar rmail-deleted-vector nil) |
360 |
(put 'rmail-deleted-vector 'permanent-local t) |
361 |
|
362 |
(defvar rmail-msgref-vector nil |
363 |
"In an Rmail buffer, a vector whose Nth element is a list (N). |
364 |
When expunging renumbers messages, these lists are modified |
365 |
by substituting the new message number into the existing list.") |
366 |
(put 'rmail-msgref-vector 'permanent-local t) |
367 |
|
368 |
(defvar rmail-overlay-list nil) |
369 |
(put 'rmail-overlay-list 'permanent-local t) |
370 |
|
371 |
;; These are used by autoloaded rmail-summary. |
372 |
|
373 |
(defvar rmail-summary-buffer nil) |
374 |
(put 'rmail-summary-buffer 'permanent-local t) |
375 |
(defvar rmail-summary-vector nil) |
376 |
(put 'rmail-summary-vector 'permanent-local t) |
377 |
|
378 |
(defvar rmail-view-buffer nil |
379 |
"Buffer which holds RMAIL message for MIME displaying.") |
380 |
(put 'rmail-view-buffer 'permanent-local t) |
381 |
|
382 |
;; `Sticky' default variables. |
383 |
|
384 |
;; Last individual label specified to a or k. |
385 |
(defvar rmail-last-label nil) |
386 |
(put 'rmail-last-label 'permanent-local t) |
387 |
|
388 |
;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l. |
389 |
(defvar rmail-last-multi-labels nil) |
390 |
|
391 |
(defvar rmail-last-regexp nil) |
392 |
(put 'rmail-last-regexp 'permanent-local t) |
393 |
|
394 |
(defcustom rmail-default-file "~/xmail" |
395 |
"*Default file name for \\[rmail-output]." |
396 |
:type 'file |
397 |
:group 'rmail-files) |
398 |
(defcustom rmail-default-rmail-file "~/XMAIL" |
399 |
"*Default file name for \\[rmail-output-to-rmail-file]." |
400 |
:type 'file |
401 |
:group 'rmail-files) |
402 |
(defcustom rmail-default-body-file "~/mailout" |
403 |
"*Default file name for \\[rmail-output-body-to-file]." |
404 |
:type 'file |
405 |
:group 'rmail-files |
406 |
:version "20.3") |
407 |
|
408 |
;; Mule and MIME related variables. |
409 |
|
410 |
;;;###autoload |
411 |
(defvar rmail-file-coding-system nil |
412 |
"Coding system used in RMAIL file. |
413 |
|
414 |
This is set to nil by default.") |
415 |
|
416 |
;;;###autoload |
417 |
(defcustom rmail-enable-mime nil |
418 |
"*If non-nil, RMAIL uses MIME feature. |
419 |
If the value is t, RMAIL automatically shows MIME decoded message. |
420 |
If the value is neither t nor nil, RMAIL does not show MIME decoded message |
421 |
until a user explicitly requires it." |
422 |
:type '(choice (const :tag "on" t) |
423 |
(const :tag "off" nil) |
424 |
(other :tag "when asked" ask)) |
425 |
:group 'rmail) |
426 |
|
427 |
(defvar rmail-enable-mime-composing nil |
428 |
"*If non-nil, RMAIL uses `rmail-insert-mime-forwarded-message-function' to forward.") |
429 |
|
430 |
;;;###autoload |
431 |
(defvar rmail-show-mime-function nil |
432 |
"Function to show MIME decoded message of RMAIL file. |
433 |
This function is called when `rmail-enable-mime' is non-nil. |
434 |
It is called with no argument.") |
435 |
|
436 |
;;;###autoload |
437 |
(defvar rmail-insert-mime-forwarded-message-function nil |
438 |
"Function to insert a message in MIME format so it can be forwarded. |
439 |
This function is called if `rmail-enable-mime' or |
440 |
`rmail-enable-mime-composing' is non-nil. |
441 |
It is called with one argument FORWARD-BUFFER, which is a |
442 |
buffer containing the message to forward. The current buffer |
443 |
is the outgoing mail buffer.") |
444 |
|
445 |
;;;###autoload |
446 |
(defvar rmail-insert-mime-resent-message-function nil |
447 |
"Function to insert a message in MIME format so it can be resent. |
448 |
This function is called if `rmail-enable-mime' is non-nil. |
449 |
It is called with one argument FORWARD-BUFFER, which is a |
450 |
buffer containing the message to forward. The current buffer |
451 |
is the outgoing mail buffer.") |
452 |
|
453 |
;;;###autoload |
454 |
(defvar rmail-search-mime-message-function nil |
455 |
"Function to check if a regexp matches a MIME message. |
456 |
This function is called if `rmail-enable-mime' is non-nil. |
457 |
It is called with two arguments MSG and REGEXP, where |
458 |
MSG is the message number, REGEXP is the regular expression.") |
459 |
|
460 |
;;;###autoload |
461 |
(defvar rmail-search-mime-header-function nil |
462 |
"Function to check if a regexp matches a header of MIME message. |
463 |
This function is called if `rmail-enable-mime' is non-nil. |
464 |
It is called with three arguments MSG, REGEXP, and LIMIT, where |
465 |
MSG is the message number, |
466 |
REGEXP is the regular expression, |
467 |
LIMIT is the position specifying the end of header.") |
468 |
|
469 |
;;;###autoload |
470 |
(defvar rmail-mime-feature 'rmail-mime |
471 |
"Feature to require to load MIME support in Rmail. |
472 |
When starting Rmail, if `rmail-enable-mime' is non-nil, |
473 |
this feature is required with `require'.") |
474 |
|
475 |
;;;###autoload |
476 |
(defvar rmail-decode-mime-charset t |
477 |
"*Non-nil means a message is decoded by MIME's charset specification. |
478 |
If this variable is nil, or the message has not MIME specification, |
479 |
the message is decoded as normal way. |
480 |
|
481 |
If the variable `rmail-enable-mime' is non-nil, this variables is |
482 |
ignored, and all the decoding work is done by a feature specified by |
483 |
the variable `rmail-mime-feature'.") |
484 |
|
485 |
;;;###autoload |
486 |
(defvar rmail-mime-charset-pattern |
487 |
"^content-type:[ ]*text/plain;[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?" |
488 |
"Regexp to match MIME-charset specification in a header of message. |
489 |
The first parenthesized expression should match the MIME-charset name.") |
490 |
|
491 |
|
492 |
;;; Regexp matching the delimiter of messages in UNIX mail format |
493 |
;;; (UNIX From lines), minus the initial ^. Note that if you change |
494 |
;;; this expression, you must change the code in rmail-nuke-pinhead-header |
495 |
;;; that knows the exact ordering of the \\( \\) subexpressions. |
496 |
(defvar rmail-unix-mail-delimiter |
497 |
(let ((time-zone-regexp |
498 |
(concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" |
499 |
"\\|[-+]?[0-9][0-9][0-9][0-9]" |
500 |
"\\|" |
501 |
"\\) *"))) |
502 |
(concat |
503 |
"From " |
504 |
|
505 |
;; Many things can happen to an RFC 822 mailbox before it is put into |
506 |
;; a `From' line. The leading phrase can be stripped, e.g. |
507 |
;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. |
508 |
;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF |
509 |
;; can be removed, e.g. |
510 |
;; From: joe@y.z (Joe K |
511 |
;; User) |
512 |
;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and |
513 |
;; From: Joe User |
514 |
;; <joe@y.z> |
515 |
;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. |
516 |
;; The mailbox can be removed or be replaced by white space, e.g. |
517 |
;; From: "Joe User"{space}{tab} |
518 |
;; <joe@y.z> |
519 |
;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996', |
520 |
;; where {space} and {tab} represent the Ascii space and tab characters. |
521 |
;; We want to match the results of any of these manglings. |
522 |
;; The following regexp rejects names whose first characters are |
523 |
;; obviously bogus, but after that anything goes. |
524 |
"\\([^\0-\b\n-\r\^?].*\\)? " |
525 |
|
526 |
;; The time the message was sent. |
527 |
"\\([^\0-\r \^?]+\\) +" ; day of the week |
528 |
"\\([^\0-\r \^?]+\\) +" ; month |
529 |
"\\([0-3]?[0-9]\\) +" ; day of month |
530 |
"\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day |
531 |
|
532 |
;; Perhaps a time zone, specified by an abbreviation, or by a |
533 |
;; numeric offset. |
534 |
time-zone-regexp |
535 |
|
536 |
;; The year. |
537 |
" \\([0-9][0-9]+\\) *" |
538 |
|
539 |
;; On some systems the time zone can appear after the year, too. |
540 |
time-zone-regexp |
541 |
|
542 |
;; Old uucp cruft. |
543 |
"\\(remote from .*\\)?" |
544 |
|
545 |
"\n")) |
546 |
nil) |
547 |
|
548 |
(defvar rmail-font-lock-keywords |
549 |
;; These are all matched case-insensitively. |
550 |
(eval-when-compile |
551 |
(let* ((cite-chars "[>|}]") |
552 |
(cite-prefix "a-z") |
553 |
(cite-suffix (concat cite-prefix "0-9_.@-`'\""))) |
554 |
(list '("^\\(From\\|Sender\\|Resent-From\\):" |
555 |
. font-lock-function-name-face) |
556 |
'("^Reply-To:.*$" . font-lock-function-name-face) |
557 |
'("^Subject:" . font-lock-comment-face) |
558 |
'("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" |
559 |
. font-lock-keyword-face) |
560 |
;; Use MATCH-ANCHORED to effectively anchor the regexp left side. |
561 |
`(,cite-chars |
562 |
(,(concat "\\=[ \t]*" |
563 |
"\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" |
564 |
"\\(" cite-chars "[ \t]*\\)\\)+" |
565 |
"\\(.*\\)") |
566 |
(beginning-of-line) (end-of-line) |
567 |
(2 font-lock-constant-face nil t) |
568 |
(4 font-lock-comment-face nil t))) |
569 |
'("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$" |
570 |
. font-lock-string-face)))) |
571 |
"Additional expressions to highlight in Rmail mode.") |
572 |
|
573 |
;; Perform BODY in the summary buffer |
574 |
;; in such a way that its cursor is properly updated in its own window. |
575 |
(defmacro rmail-select-summary (&rest body) |
576 |
`(let ((total rmail-total-messages)) |
577 |
(if (rmail-summary-displayed) |
578 |
(let ((window (selected-window))) |
579 |
(save-excursion |
580 |
(unwind-protect |
581 |
(progn |
582 |
(pop-to-buffer rmail-summary-buffer) |
583 |
;; rmail-total-messages is a buffer-local var |
584 |
;; in the rmail buffer. |
585 |
;; This way we make it available for the body |
586 |
;; even tho the rmail buffer is not current. |
587 |
(let ((rmail-total-messages total)) |
588 |
,@body)) |
589 |
(select-window window)))) |
590 |
(save-excursion |
591 |
(set-buffer rmail-summary-buffer) |
592 |
(let ((rmail-total-messages total)) |
593 |
,@body))) |
594 |
(rmail-maybe-display-summary))) |
595 |
|
596 |
;;;; *** Rmail Mode *** |
597 |
|
598 |
;; This variable is dynamically bound. The defvar is here to placate |
599 |
;; the byte compiler. |
600 |
|
601 |
(defvar rmail-enable-multibyte nil) |
602 |
|
603 |
|
604 |
(defun rmail-require-mime-maybe () |
605 |
"Require `rmail-mime-feature' if that is non-nil. |
606 |
Signal an error and set `rmail-mime-feature' to nil if the feature |
607 |
isn't provided." |
608 |
(when rmail-enable-mime |
609 |
(condition-case err |
610 |
(require rmail-mime-feature) |
611 |
(error |
612 |
(message "Feature `%s' not provided" rmail-mime-feature) |
613 |
(sit-for 1) |
614 |
(setq rmail-enable-mime nil))))) |
615 |
|
616 |
|
617 |
;;;###autoload |
618 |
(defun rmail (&optional file-name-arg) |
619 |
"Read and edit incoming mail. |
620 |
Moves messages into file named by `rmail-file-name' (a babyl format file) |
621 |
and edits that file in RMAIL Mode. |
622 |
Type \\[describe-mode] once editing that file, for a list of RMAIL commands. |
623 |
|
624 |
May be called with file name as argument; then performs rmail editing on |
625 |
that file, but does not copy any new mail into the file. |
626 |
Interactively, if you supply a prefix argument, then you |
627 |
have a chance to specify a file name with the minibuffer. |
628 |
|
629 |
If `rmail-display-summary' is non-nil, make a summary for this RMAIL file." |
630 |
(interactive (if current-prefix-arg |
631 |
(list (read-file-name "Run rmail on RMAIL file: ")))) |
632 |
(rmail-require-mime-maybe) |
633 |
(let* ((file-name (expand-file-name (or file-name-arg rmail-file-name))) |
634 |
;; Use find-buffer-visiting, not get-file-buffer, for those users |
635 |
;; who have find-file-visit-truename set to t. |
636 |
(existed (find-buffer-visiting file-name)) |
637 |
;; This binding is necessary because we must decide if we |
638 |
;; need code conversion while the buffer is unibyte |
639 |
;; (i.e. enable-multibyte-characters is nil). |
640 |
(rmail-enable-multibyte |
641 |
(if existed |
642 |
(with-current-buffer existed enable-multibyte-characters) |
643 |
(default-value 'enable-multibyte-characters))) |
644 |
;; Since the file may contain messages of different encodings |
645 |
;; at the tail (non-BYBYL part), we can't decode them at once |
646 |
;; on reading. So, at first, we read the file without text |
647 |
;; code conversion, then decode the messages one by one by |
648 |
;; rmail-decode-babyl-format or |
649 |
;; rmail-convert-to-babyl-format. |
650 |
(coding-system-for-read (and rmail-enable-multibyte 'raw-text)) |
651 |
run-mail-hook msg-shown) |
652 |
;; Like find-file, but in the case where a buffer existed |
653 |
;; and the file was reverted, recompute the message-data. |
654 |
;; We used to bind enable-local-variables to nil here, |
655 |
;; but that should not be needed now that rmail-mode |
656 |
;; sets it locally to nil. |
657 |
;; (Binding a variable locally with let is not safe if it has |
658 |
;; buffer-local bindings.) |
659 |
(if (and existed (not (verify-visited-file-modtime existed))) |
660 |
(progn |
661 |
(find-file file-name) |
662 |
(if (and (verify-visited-file-modtime existed) |
663 |
(eq major-mode 'rmail-mode)) |
664 |
(progn (rmail-forget-messages) |
665 |
(rmail-set-message-counters)))) |
666 |
(switch-to-buffer |
667 |
(let ((enable-local-variables nil)) |
668 |
(find-file-noselect file-name)))) |
669 |
(if (eq major-mode 'rmail-edit-mode) |
670 |
(error "Exit Rmail Edit mode before getting new mail")) |
671 |
(if (and existed (> (buffer-size) 0)) |
672 |
;; Buffer not new and not empty; ensure in proper mode, but that's all. |
673 |
(or (eq major-mode 'rmail-mode) |
674 |
(progn (rmail-mode-2) |
675 |
(setq run-mail-hook t))) |
676 |
(setq run-mail-hook t) |
677 |
(rmail-mode-2) |
678 |
;; Convert all or part to Babyl file if possible. |
679 |
(rmail-convert-file) |
680 |
(goto-char (point-max))) |
681 |
;; As we have read a file by raw-text, the buffer is set to |
682 |
;; unibyte. We must make it multibyte if necessary. |
683 |
(if (and rmail-enable-multibyte |
684 |
(not enable-multibyte-characters)) |
685 |
(set-buffer-multibyte t)) |
686 |
;; If necessary, scan to find all the messages. |
687 |
(rmail-maybe-set-message-counters) |
688 |
(unwind-protect |
689 |
(unless (and (not file-name-arg) |
690 |
(rmail-get-new-mail)) |
691 |
(rmail-show-message (rmail-first-unseen-message))) |
692 |
(progn |
693 |
(if rmail-display-summary (rmail-summary)) |
694 |
(rmail-construct-io-menu) |
695 |
(if run-mail-hook |
696 |
(run-hooks 'rmail-mode-hook)))))) |
697 |
|
698 |
;; Given the value of MAILPATH, return a list of inbox file names. |
699 |
;; This is turned off because it is not clear that the user wants |
700 |
;; all these inboxes to feed into the primary rmail file. |
701 |
; (defun rmail-convert-mailpath (string) |
702 |
; (let (idx list) |
703 |
; (while (setq idx (string-match "[%:]" string)) |
704 |
; (let ((this (substring string 0 idx))) |
705 |
; (setq string (substring string (1+ idx))) |
706 |
; (setq list (cons (if (string-match "%" this) |
707 |
; (substring this 0 (string-match "%" this)) |
708 |
; this) |
709 |
; list)))) |
710 |
; list)) |
711 |
|
712 |
; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line |
713 |
; will not cause emacs 18.55 problems. |
714 |
|
715 |
;; This calls rmail-decode-babyl-format if the file is already Babyl. |
716 |
|
717 |
(defun rmail-convert-file () |
718 |
(let (convert) |
719 |
(widen) |
720 |
(goto-char (point-min)) |
721 |
;; If file doesn't start like a Babyl file, |
722 |
;; convert it to one, by adding a header and converting each message. |
723 |
(cond ((looking-at "BABYL OPTIONS:")) |
724 |
((looking-at "Version: 5\n") |
725 |
;; Losing babyl file made by old version of Rmail. |
726 |
;; Just fix the babyl file header; don't make a new one, |
727 |
;; so we don't lose the Labels: file attribute, etc. |
728 |
(let ((buffer-read-only nil)) |
729 |
(insert "BABYL OPTIONS: -*- rmail -*-\n"))) |
730 |
((equal (point-min) (point-max)) |
731 |
;; Empty RMAIL file. Just insert the header. |
732 |
(rmail-insert-rmail-file-header)) |
733 |
(t |
734 |
;; Non-empty file in non-RMAIL format. Add header and convert. |
735 |
(setq convert t) |
736 |
(rmail-insert-rmail-file-header))) |
737 |
;; If file was not a Babyl file or if there are |
738 |
;; Unix format messages added at the end, |
739 |
;; convert file as necessary. |
740 |
(if (or convert |
741 |
(save-excursion |
742 |
(goto-char (point-max)) |
743 |
(search-backward "\n\^_") |
744 |
(forward-char 2) |
745 |
(looking-at "\n*From "))) |
746 |
(let ((buffer-read-only nil)) |
747 |
(message "Converting to Babyl format...") |
748 |
;; If file needs conversion, convert it all, |
749 |
;; except for the BABYL header. |
750 |
;; (rmail-convert-to-babyl-format would delete the header.) |
751 |
(goto-char (point-min)) |
752 |
(search-forward "\n\^_" nil t) |
753 |
(narrow-to-region (point) (point-max)) |
754 |
(rmail-convert-to-babyl-format) |
755 |
(message "Converting to Babyl format...done")) |
756 |
(if (and (not rmail-enable-mime) |
757 |
rmail-enable-multibyte) |
758 |
;; We still have to decode BABYL part. |
759 |
(rmail-decode-babyl-format))))) |
760 |
|
761 |
(defun rmail-insert-rmail-file-header () |
762 |
(let ((buffer-read-only nil)) |
763 |
;; -*-rmail-*- is here so that visiting the file normally |
764 |
;; recognizes it as an Rmail file. |
765 |
(insert "BABYL OPTIONS: -*- rmail -*- |
766 |
Version: 5 |
767 |
Labels: |
768 |
Note: This is the header of an rmail file. |
769 |
Note: If you are seeing it in rmail, |
770 |
Note: it means the file has no messages in it.\n\^_"))) |
771 |
|
772 |
;; Decode Babyl formatted part at the head of current buffer by |
773 |
;; rmail-file-coding-system, or if it is nil, do auto conversion. |
774 |
|
775 |
(defun rmail-decode-babyl-format () |
776 |
(let ((modifiedp (buffer-modified-p)) |
777 |
(buffer-read-only nil) |
778 |
(coding-system rmail-file-coding-system) |
779 |
from to) |
780 |
(goto-char (point-min)) |
781 |
(search-forward "\n\^_" nil t) ; Skip BABYL header. |
782 |
(setq from (point)) |
783 |
(goto-char (point-max)) |
784 |
(search-backward "\n\^_" from 'mv) |
785 |
(setq to (point)) |
786 |
(unless (and coding-system |
787 |
(coding-system-p coding-system)) |
788 |
(setq coding-system |
789 |
;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but |
790 |
;; earlier versions did that with the current buffer's encoding. |
791 |
;; So we want to favor detection of emacs-mule (whose normal |
792 |
;; priority is quite low), but still allow detection of other |
793 |
;; encodings if emacs-mule won't fit. The call to |
794 |
;; detect-coding-with-priority below achieves that. |
795 |
(car (detect-coding-with-priority |
796 |
from to |
797 |
'((coding-category-emacs-mule . emacs-mule)))))) |
798 |
(unless (memq coding-system |
799 |
'(undecided undecided-unix)) |
800 |
(set-buffer-modified-p t) ; avoid locking when decoding |
801 |
(let ((buffer-undo-list t)) |
802 |
(decode-coding-region from to coding-system)) |
803 |
(setq coding-system last-coding-system-used)) |
804 |
(set-buffer-modified-p modifiedp) |
805 |
(setq buffer-file-coding-system nil) |
806 |
(setq save-buffer-coding-system |
807 |
(or coding-system 'undecided)))) |
808 |
|
809 |
(defvar rmail-mode-map nil) |
810 |
(if rmail-mode-map |
811 |
nil |
812 |
(setq rmail-mode-map (make-keymap)) |
813 |
(suppress-keymap rmail-mode-map) |
814 |
(define-key rmail-mode-map "a" 'rmail-add-label) |
815 |
(define-key rmail-mode-map "b" 'rmail-bury) |
816 |
(define-key rmail-mode-map "c" 'rmail-continue) |
817 |
(define-key rmail-mode-map "d" 'rmail-delete-forward) |
818 |
(define-key rmail-mode-map "\C-d" 'rmail-delete-backward) |
819 |
(define-key rmail-mode-map "e" 'rmail-edit-current-message) |
820 |
(define-key rmail-mode-map "f" 'rmail-forward) |
821 |
(define-key rmail-mode-map "g" 'rmail-get-new-mail) |
822 |
(define-key rmail-mode-map "h" 'rmail-summary) |
823 |
(define-key rmail-mode-map "i" 'rmail-input) |
824 |
(define-key rmail-mode-map "j" 'rmail-show-message) |
825 |
(define-key rmail-mode-map "k" 'rmail-kill-label) |
826 |
(define-key rmail-mode-map "l" 'rmail-summary-by-labels) |
827 |
(define-key rmail-mode-map "\e\C-h" 'rmail-summary) |
828 |
(define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels) |
829 |
(define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients) |
830 |
(define-key rmail-mode-map "\e\C-s" 'rmail-summary-by-regexp) |
831 |
(define-key rmail-mode-map "\e\C-t" 'rmail-summary-by-topic) |
832 |
(define-key rmail-mode-map "m" 'rmail-mail) |
833 |
(define-key rmail-mode-map "\em" 'rmail-retry-failure) |
834 |
(define-key rmail-mode-map "n" 'rmail-next-undeleted-message) |
835 |
(define-key rmail-mode-map "\en" 'rmail-next-message) |
836 |
(define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) |
837 |
(define-key rmail-mode-map "o" 'rmail-output-to-rmail-file) |
838 |
(define-key rmail-mode-map "\C-o" 'rmail-output) |
839 |
(define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) |
840 |
(define-key rmail-mode-map "\ep" 'rmail-previous-message) |
841 |
(define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message) |
842 |
(define-key rmail-mode-map "q" 'rmail-quit) |
843 |
(define-key rmail-mode-map "r" 'rmail-reply) |
844 |
;; I find I can't live without the default M-r command -- rms. |
845 |
;; (define-key rmail-mode-map "\er" 'rmail-search-backwards) |
846 |
(define-key rmail-mode-map "s" 'rmail-expunge-and-save) |
847 |
(define-key rmail-mode-map "\es" 'rmail-search) |
848 |
(define-key rmail-mode-map "t" 'rmail-toggle-header) |
849 |
(define-key rmail-mode-map "u" 'rmail-undelete-previous-message) |
850 |
(define-key rmail-mode-map "w" 'rmail-output-body-to-file) |
851 |
(define-key rmail-mode-map "x" 'rmail-expunge) |
852 |
(define-key rmail-mode-map "." 'rmail-beginning-of-message) |
853 |
(define-key rmail-mode-map "<" 'rmail-first-message) |
854 |
(define-key rmail-mode-map ">" 'rmail-last-message) |
855 |
(define-key rmail-mode-map " " 'scroll-up) |
856 |
(define-key rmail-mode-map "\177" 'scroll-down) |
857 |
(define-key rmail-mode-map "?" 'describe-mode) |
858 |
(define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date) |
859 |
(define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject) |
860 |
(define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author) |
861 |
(define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) |
862 |
(define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) |
863 |
(define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines) |
864 |
(define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels) |
865 |
(define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject) |
866 |
(define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject) |
867 |
) |
868 |
|
869 |
(define-key rmail-mode-map [menu-bar] (make-sparse-keymap)) |
870 |
|
871 |
(define-key rmail-mode-map [menu-bar classify] |
872 |
(cons "Classify" (make-sparse-keymap "Classify"))) |
873 |
|
874 |
(define-key rmail-mode-map [menu-bar classify input-menu] |
875 |
nil) |
876 |
|
877 |
(define-key rmail-mode-map [menu-bar classify output-menu] |
878 |
nil) |
879 |
|
880 |
(define-key rmail-mode-map [menu-bar classify output-body] |
881 |
'("Output body to file..." . rmail-output-body-to-file)) |
882 |
|
883 |
(define-key rmail-mode-map [menu-bar classify output-inbox] |
884 |
'("Output (inbox)..." . rmail-output)) |
885 |
|
886 |
(define-key rmail-mode-map [menu-bar classify output] |
887 |
'("Output (Rmail)..." . rmail-output-to-rmail-file)) |
888 |
|
889 |
(define-key rmail-mode-map [menu-bar classify kill-label] |
890 |
'("Kill Label..." . rmail-kill-label)) |
891 |
|
892 |
(define-key rmail-mode-map [menu-bar classify add-label] |
893 |
'("Add Label..." . rmail-add-label)) |
894 |
|
895 |
(define-key rmail-mode-map [menu-bar summary] |
896 |
(cons "Summary" (make-sparse-keymap "Summary"))) |
897 |
|
898 |
(define-key rmail-mode-map [menu-bar summary senders] |
899 |
'("By Senders..." . rmail-summary-by-senders)) |
900 |
|
901 |
(define-key rmail-mode-map [menu-bar summary labels] |
902 |
'("By Labels..." . rmail-summary-by-labels)) |
903 |
|
904 |
(define-key rmail-mode-map [menu-bar summary recipients] |
905 |
'("By Recipients..." . rmail-summary-by-recipients)) |
906 |
|
907 |
(define-key rmail-mode-map [menu-bar summary topic] |
908 |
'("By Topic..." . rmail-summary-by-topic)) |
909 |
|
910 |
(define-key rmail-mode-map [menu-bar summary regexp] |
911 |
'("By Regexp..." . rmail-summary-by-regexp)) |
912 |
|
913 |
(define-key rmail-mode-map [menu-bar summary all] |
914 |
'("All" . rmail-summary)) |
915 |
|
916 |
(define-key rmail-mode-map [menu-bar mail] |
917 |
(cons "Mail" (make-sparse-keymap "Mail"))) |
918 |
|
919 |
(define-key rmail-mode-map [menu-bar mail rmail-get-new-mail] |
920 |
'("Get New Mail" . rmail-get-new-mail)) |
921 |
|
922 |
(define-key rmail-mode-map [menu-bar mail lambda] |
923 |
'("----")) |
924 |
|
925 |
(define-key rmail-mode-map [menu-bar mail continue] |
926 |
'("Continue" . rmail-continue)) |
927 |
|
928 |
(define-key rmail-mode-map [menu-bar mail resend] |
929 |
'("Re-send..." . rmail-resend)) |
930 |
|
931 |
(define-key rmail-mode-map [menu-bar mail forward] |
932 |
'("Forward" . rmail-forward)) |
933 |
|
934 |
(define-key rmail-mode-map [menu-bar mail retry] |
935 |
'("Retry" . rmail-retry-failure)) |
936 |
|
937 |
(define-key rmail-mode-map [menu-bar mail reply] |
938 |
'("Reply" . rmail-reply)) |
939 |
|
940 |
(define-key rmail-mode-map [menu-bar mail mail] |
941 |
'("Mail" . rmail-mail)) |
942 |
|
943 |
(define-key rmail-mode-map [menu-bar delete] |
944 |
(cons "Delete" (make-sparse-keymap "Delete"))) |
945 |
|
946 |
(define-key rmail-mode-map [menu-bar delete expunge/save] |
947 |
'("Expunge/Save" . rmail-expunge-and-save)) |
948 |
|
949 |
(define-key rmail-mode-map [menu-bar delete expunge] |
950 |
'("Expunge" . rmail-expunge)) |
951 |
|
952 |
(define-key rmail-mode-map [menu-bar delete undelete] |
953 |
'("Undelete" . rmail-undelete-previous-message)) |
954 |
|
955 |
(define-key rmail-mode-map [menu-bar delete delete] |
956 |
'("Delete" . rmail-delete-forward)) |
957 |
|
958 |
(define-key rmail-mode-map [menu-bar move] |
959 |
(cons "Move" (make-sparse-keymap "Move"))) |
960 |
|
961 |
(define-key rmail-mode-map [menu-bar move search-back] |
962 |
'("Search Back..." . rmail-search-backwards)) |
963 |
|
964 |
(define-key rmail-mode-map [menu-bar move search] |
965 |
'("Search..." . rmail-search)) |
966 |
|
967 |
(define-key rmail-mode-map [menu-bar move previous] |
968 |
'("Previous Nondeleted" . rmail-previous-undeleted-message)) |
969 |
|
970 |
(define-key rmail-mode-map [menu-bar move next] |
971 |
'("Next Nondeleted" . rmail-next-undeleted-message)) |
972 |
|
973 |
(define-key rmail-mode-map [menu-bar move last] |
974 |
'("Last" . rmail-last-message)) |
975 |
|
976 |
(define-key rmail-mode-map [menu-bar move first] |
977 |
'("First" . rmail-first-message)) |
978 |
|
979 |
(define-key rmail-mode-map [menu-bar move previous] |
980 |
'("Previous" . rmail-previous-message)) |
981 |
|
982 |
(define-key rmail-mode-map [menu-bar move next] |
983 |
'("Next" . rmail-next-message)) |
984 |
|
985 |
;; Rmail mode is suitable only for specially formatted data. |
986 |
(put 'rmail-mode 'mode-class 'special) |
987 |
|
988 |
(defun rmail-mode-kill-summary () |
989 |
(if rmail-summary-buffer (kill-buffer rmail-summary-buffer))) |
990 |
|
991 |
;;;###autoload |
992 |
(defun rmail-mode () |
993 |
"Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files. |
994 |
All normal editing commands are turned off. |
995 |
Instead, these commands are available: |
996 |
|
997 |
\\[rmail-beginning-of-message] Move point to front of this message (same as \\[beginning-of-buffer]). |
998 |
\\[scroll-up] Scroll to next screen of this message. |
999 |
\\[scroll-down] Scroll to previous screen of this message. |
1000 |
\\[rmail-next-undeleted-message] Move to Next non-deleted message. |
1001 |
\\[rmail-previous-undeleted-message] Move to Previous non-deleted message. |
1002 |
\\[rmail-next-message] Move to Next message whether deleted or not. |
1003 |
\\[rmail-previous-message] Move to Previous message whether deleted or not. |
1004 |
\\[rmail-first-message] Move to the first message in Rmail file. |
1005 |
\\[rmail-last-message] Move to the last message in Rmail file. |
1006 |
\\[rmail-show-message] Jump to message specified by numeric position in file. |
1007 |
\\[rmail-search] Search for string and show message it is found in. |
1008 |
\\[rmail-delete-forward] Delete this message, move to next nondeleted. |
1009 |
\\[rmail-delete-backward] Delete this message, move to previous nondeleted. |
1010 |
\\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages |
1011 |
till a deleted message is found. |
1012 |
\\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail. |
1013 |
\\[rmail-expunge] Expunge deleted messages. |
1014 |
\\[rmail-expunge-and-save] Expunge and save the file. |
1015 |
\\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer. |
1016 |
\\[save-buffer] Save without expunging. |
1017 |
\\[rmail-get-new-mail] Move new mail from system spool directory into this file. |
1018 |
\\[rmail-mail] Mail a message (same as \\[mail-other-window]). |
1019 |
\\[rmail-continue] Continue composing outgoing message started before. |
1020 |
\\[rmail-reply] Reply to this message. Like \\[rmail-mail] but initializes some fields. |
1021 |
\\[rmail-retry-failure] Send this message again. Used on a mailer failure message. |
1022 |
\\[rmail-forward] Forward this message to another user. |
1023 |
\\[rmail-output-to-rmail-file] Output this message to an Rmail file (append it). |
1024 |
\\[rmail-output] Output this message to a Unix-format mail file (append it). |
1025 |
\\[rmail-output-body-to-file] Save message body to a file. Default filename comes from Subject line. |
1026 |
\\[rmail-input] Input Rmail file. Run Rmail on that file. |
1027 |
\\[rmail-add-label] Add label to message. It will be displayed in the mode line. |
1028 |
\\[rmail-kill-label] Kill label. Remove a label from current message. |
1029 |
\\[rmail-next-labeled-message] Move to Next message with specified label |
1030 |
(label defaults to last one specified). |
1031 |
Standard labels: filed, unseen, answered, forwarded, deleted. |
1032 |
Any other label is present only if you add it with \\[rmail-add-label]. |
1033 |
\\[rmail-previous-labeled-message] Move to Previous message with specified label |
1034 |
\\[rmail-summary] Show headers buffer, with a one line summary of each message. |
1035 |
\\[rmail-summary-by-labels] Summarize only messages with particular label(s). |
1036 |
\\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s). |
1037 |
\\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s). |
1038 |
\\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s). |
1039 |
\\[rmail-toggle-header] Toggle display of complete header." |
1040 |
(interactive) |
1041 |
(let ((finding-rmail-file (not (eq major-mode 'rmail-mode)))) |
1042 |
(rmail-mode-2) |
1043 |
(when (and finding-rmail-file |
1044 |
(null coding-system-for-read) |
1045 |
default-enable-multibyte-characters) |
1046 |
(let ((rmail-enable-multibyte t)) |
1047 |
(rmail-require-mime-maybe) |
1048 |
(rmail-convert-file) |
1049 |
(goto-char (point-max)) |
1050 |
(set-buffer-multibyte t))) |
1051 |
(rmail-set-message-counters) |
1052 |
(rmail-show-message rmail-total-messages) |
1053 |
(when finding-rmail-file |
1054 |
(when rmail-display-summary |
1055 |
(rmail-summary)) |
1056 |
(rmail-construct-io-menu)) |
1057 |
(run-hooks 'rmail-mode-hook))) |
1058 |
|
1059 |
(defun rmail-mode-2 () |
1060 |
(kill-all-local-variables) |
1061 |
(rmail-mode-1) |
1062 |
(rmail-perm-variables) |
1063 |
(rmail-variables)) |
1064 |
|
1065 |
(defun rmail-mode-1 () |
1066 |
(setq major-mode 'rmail-mode) |
1067 |
(setq mode-name "RMAIL") |
1068 |
(setq buffer-read-only t) |
1069 |
;; No need to auto save RMAIL files in normal circumstances |
1070 |
;; because they contain no info except attribute changes |
1071 |
;; and deletion of messages. |
1072 |
;; The one exception is when messages are copied into an Rmail mode buffer. |
1073 |
;; rmail-output-to-rmail-file enables auto save when you do that. |
1074 |
(setq buffer-auto-save-file-name nil) |
1075 |
(setq mode-line-modified "--") |
1076 |
(use-local-map rmail-mode-map) |
1077 |
(set-syntax-table text-mode-syntax-table) |
1078 |
(setq local-abbrev-table text-mode-abbrev-table)) |
1079 |
|
1080 |
;; Set up the permanent locals associated with an Rmail file. |
1081 |
(defun rmail-perm-variables () |
1082 |
(make-local-variable 'rmail-last-label) |
1083 |
(make-local-variable 'rmail-last-regexp) |
1084 |
(make-local-variable 'rmail-deleted-vector) |
1085 |
(make-local-variable 'rmail-buffer) |
1086 |
(setq rmail-buffer (current-buffer)) |
1087 |
(make-local-variable 'rmail-view-buffer) |
1088 |
(setq rmail-view-buffer rmail-buffer) |
1089 |
(make-local-variable 'rmail-summary-buffer) |
1090 |
(make-local-variable 'rmail-summary-vector) |
1091 |
(make-local-variable 'rmail-current-message) |
1092 |
(make-local-variable 'rmail-total-messages) |
1093 |
(make-local-variable 'rmail-overlay-list) |
1094 |
(setq rmail-overlay-list nil) |
1095 |
(make-local-variable 'rmail-message-vector) |
1096 |
(make-local-variable 'rmail-msgref-vector) |
1097 |
(make-local-variable 'rmail-inbox-list) |
1098 |
(setq rmail-inbox-list (rmail-parse-file-inboxes)) |
1099 |
;; Provide default set of inboxes for primary mail file ~/RMAIL. |
1100 |
(and (null rmail-inbox-list) |
1101 |
(or (equal buffer-file-name (expand-file-name rmail-file-name)) |
1102 |
(equal buffer-file-truename |
1103 |
(abbreviate-file-name (file-truename rmail-file-name)))) |
1104 |
(setq rmail-inbox-list |
1105 |
(or rmail-primary-inbox-list |
1106 |
(list (or (getenv "MAIL") |
1107 |
(concat rmail-spool-directory |
1108 |
(user-login-name))))))) |
1109 |
(make-local-variable 'rmail-keywords) |
1110 |
;; this gets generated as needed |
1111 |
(setq rmail-keywords nil)) |
1112 |
|
1113 |
;; Set up the non-permanent locals associated with Rmail mode. |
1114 |
(defun rmail-variables () |
1115 |
(make-local-variable 'save-buffer-coding-system) |
1116 |
;; If we don't already have a value for save-buffer-coding-system, |
1117 |
;; get it from buffer-file-coding-system, and clear that |
1118 |
;; because it should be determined in rmail-show-message. |
1119 |
(unless save-buffer-coding-system |
1120 |
(setq save-buffer-coding-system (or buffer-file-coding-system 'undecided)) |
1121 |
(setq buffer-file-coding-system nil)) |
1122 |
;; Don't let a local variables list in a message cause confusion. |
1123 |
(make-local-variable 'local-enable-local-variables) |
1124 |
(setq local-enable-local-variables nil) |
1125 |
(make-local-variable 'revert-buffer-function) |
1126 |
(setq revert-buffer-function 'rmail-revert) |
1127 |
(make-local-variable 'font-lock-defaults) |
1128 |
(setq font-lock-defaults |
1129 |
'(rmail-font-lock-keywords |
1130 |
t t nil nil |
1131 |
(font-lock-maximum-size . nil) |
1132 |
(font-lock-fontify-buffer-function . rmail-fontify-buffer-function) |
1133 |
(font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function) |
1134 |
(font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) |
1135 |
(make-local-variable 'require-final-newline) |
1136 |
(setq require-final-newline nil) |
1137 |
(make-local-variable 'version-control) |
1138 |
(setq version-control 'never) |
1139 |
(make-local-variable 'kill-buffer-hook) |
1140 |
(add-hook 'kill-buffer-hook 'rmail-mode-kill-summary) |
1141 |
(make-local-variable 'file-precious-flag) |
1142 |
(setq file-precious-flag t) |
1143 |
(make-local-variable 'desktop-save-buffer) |
1144 |
(setq desktop-save-buffer t)) |
1145 |
|
1146 |
;; Handle M-x revert-buffer done in an rmail-mode buffer. |
1147 |
(defun rmail-revert (arg noconfirm) |
1148 |
(set-buffer rmail-buffer) |
1149 |
(let* ((revert-buffer-function (default-value 'revert-buffer-function)) |
1150 |
(rmail-enable-multibyte enable-multibyte-characters) |
1151 |
;; See similar code in `rmail'. |
1152 |
(coding-system-for-read (and rmail-enable-multibyte 'raw-text))) |
1153 |
;; Call our caller again, but this time it does the default thing. |
1154 |
(if (revert-buffer arg noconfirm) |
1155 |
;; If the user said "yes", and we changed something, |
1156 |
;; reparse the messages. |
1157 |
(progn |
1158 |
(set-buffer rmail-buffer) |
1159 |
(rmail-mode-2) |
1160 |
;; Convert all or part to Babyl file if possible. |
1161 |
(rmail-convert-file) |
1162 |
;; We have read the file as raw-text, so the buffer is set to |
1163 |
;; unibyte. Make it multibyte if necessary. |
1164 |
(if (and rmail-enable-multibyte |
1165 |
(not enable-multibyte-characters)) |
1166 |
(set-buffer-multibyte t)) |
1167 |
(goto-char (point-max)) |
1168 |
(rmail-set-message-counters) |
1169 |
(rmail-show-message rmail-total-messages) |
1170 |
(run-hooks 'rmail-mode-hook))))) |
1171 |
|
1172 |
;; Return a list of files from this buffer's Mail: option. |
1173 |
;; Does not assume that messages have been parsed. |
1174 |
;; Just returns nil if buffer does not look like Babyl format. |
1175 |
(defun rmail-parse-file-inboxes () |
1176 |
(save-excursion |
1177 |
(save-restriction |
1178 |
(widen) |
1179 |
(goto-char 1) |
1180 |
(cond ((looking-at "BABYL OPTIONS:") |
1181 |
(search-forward "\n\^_" nil 'move) |
1182 |
(narrow-to-region 1 (point)) |
1183 |
(goto-char 1) |
1184 |
(if (search-forward "\nMail:" nil t) |
1185 |
(progn |
1186 |
(narrow-to-region (point) (progn (end-of-line) (point))) |
1187 |
(goto-char (point-min)) |
1188 |
(mail-parse-comma-list)))))))) |
1189 |
|
1190 |
(defun rmail-expunge-and-save () |
1191 |
"Expunge and save RMAIL file." |
1192 |
(interactive) |
1193 |
(rmail-expunge) |
1194 |
(set-buffer rmail-buffer) |
1195 |
(save-buffer) |
1196 |
(if (rmail-summary-exists) |
1197 |
(rmail-select-summary (set-buffer-modified-p nil)))) |
1198 |
|
1199 |
(defun rmail-quit () |
1200 |
"Quit out of RMAIL. |
1201 |
Hook `rmail-quit-hook' is run after expunging." |
1202 |
(interactive) |
1203 |
(rmail-expunge-and-save) |
1204 |
(when (boundp 'rmail-quit-hook) |
1205 |
(run-hooks 'rmail-quit-hook)) |
1206 |
;; Don't switch to the summary buffer even if it was recently visible. |
1207 |
(when rmail-summary-buffer |
1208 |
(replace-buffer-in-windows rmail-summary-buffer) |
1209 |
(bury-buffer rmail-summary-buffer)) |
1210 |
(if rmail-enable-mime |
1211 |
(let ((obuf rmail-buffer) |
1212 |
(ovbuf rmail-view-buffer)) |
1213 |
(set-buffer rmail-view-buffer) |
1214 |
(quit-window) |
1215 |
(replace-buffer-in-windows ovbuf) |
1216 |
(replace-buffer-in-windows obuf) |
1217 |
(bury-buffer obuf)) |
1218 |
(let ((obuf (current-buffer))) |
1219 |
(quit-window) |
1220 |
(replace-buffer-in-windows obuf)))) |
1221 |
|
1222 |
(defun rmail-bury () |
1223 |
"Bury current Rmail buffer and its summary buffer." |
1224 |
(interactive) |
1225 |
;; This let var was called rmail-buffer, but that interfered |
1226 |
;; with the buffer-local var used in summary buffers. |
1227 |
(let ((buffer-to-bury (current-buffer))) |
1228 |
(if (rmail-summary-exists) |
1229 |
(let (window) |
1230 |
(while (setq window (get-buffer-window rmail-summary-buffer)) |
1231 |
(quit-window nil window)) |
1232 |
(bury-buffer rmail-summary-buffer))) |
1233 |
(quit-window))) |
1234 |
|
1235 |
(defun rmail-duplicate-message () |
1236 |
"Create a duplicated copy of the current message. |
1237 |
The duplicate copy goes into the Rmail file just after the |
1238 |
original copy." |
1239 |
(interactive) |
1240 |
(widen) |
1241 |
(let ((buffer-read-only nil) |
1242 |
(number rmail-current-message) |
1243 |
(string (buffer-substring (rmail-msgbeg rmail-current-message) |
1244 |
(rmail-msgend rmail-current-message)))) |
1245 |
(goto-char (rmail-msgend rmail-current-message)) |
1246 |
(insert string) |
1247 |
(rmail-forget-messages) |
1248 |
(rmail-show-message number) |
1249 |
(message "Message duplicated"))) |
1250 |
|
1251 |
;;;###autoload |
1252 |
(defun rmail-input (filename) |
1253 |
"Run Rmail on file FILENAME." |
1254 |
(interactive "FRun rmail on RMAIL file: ") |
1255 |
(rmail filename)) |
1256 |
|
1257 |
|
1258 |
;; This used to scan subdirectories recursively, but someone pointed out |
1259 |
;; that if the user wants that, person can put all the files in one dir. |
1260 |
;; And the recursive scan was slow. So I took it out. |
1261 |
;; rms, Sep 1996. |
1262 |
(defun rmail-find-all-files (start) |
1263 |
"Return list of file in dir START that match `rmail-secondary-file-regexp'." |
1264 |
(if (file-accessible-directory-p start) |
1265 |
;; Don't sort here. |
1266 |
(let* ((case-fold-search t) |
1267 |
(files (directory-files start t rmail-secondary-file-regexp))) |
1268 |
;; Sort here instead of in directory-files |
1269 |
;; because this list is usually much shorter. |
1270 |
(sort files 'string<)))) |
1271 |
|
1272 |
(defun rmail-list-to-menu (menu-name l action &optional full-name) |
1273 |
(let ((menu (make-sparse-keymap menu-name))) |
1274 |
(mapcar |
1275 |
(function (lambda (item) |
1276 |
(let (command) |
1277 |
(if (consp item) |
1278 |
(progn |
1279 |
(setq command |
1280 |
(rmail-list-to-menu (car item) (cdr item) |
1281 |
action |
1282 |
(if full-name |
1283 |
(concat full-name "/" |
1284 |
(car item)) |
1285 |
(car item)))) |
1286 |
(setq name (car item))) |
1287 |
(progn |
1288 |
(setq name item) |
1289 |
(setq command |
1290 |
(list 'lambda () '(interactive) |
1291 |
(list action |
1292 |
(expand-file-name |
1293 |
(if full-name |
1294 |
(concat full-name "/" item) |
1295 |
item) |
1296 |
rmail-secondary-file-directory)))))) |
1297 |
(define-key menu (vector (intern name)) |
1298 |
(cons name command))))) |
1299 |
(reverse l)) |
1300 |
menu)) |
1301 |
|
1302 |
;; This command is always "disabled" when it appears in a menu. |
1303 |
(put 'rmail-disable-menu 'menu-enable ''nil) |
1304 |
|
1305 |
(defun rmail-construct-io-menu () |
1306 |
(let ((files (rmail-find-all-files rmail-secondary-file-directory))) |
1307 |
(if files |
1308 |
(progn |
1309 |
(define-key rmail-mode-map [menu-bar classify input-menu] |
1310 |
(cons "Input Rmail File" |
1311 |
(rmail-list-to-menu "Input Rmail File" |
1312 |
files |
1313 |
'rmail-input))) |
1314 |
(define-key rmail-mode-map [menu-bar classify output-menu] |
1315 |
(cons "Output Rmail File" |
1316 |
(rmail-list-to-menu "Output Rmail File" |
1317 |
files |
1318 |
'rmail-output-to-rmail-file)))) |
1319 |
|
1320 |
(define-key rmail-mode-map [menu-bar classify input-menu] |
1321 |
'("Input Rmail File" . rmail-disable-menu)) |
1322 |
(define-key rmail-mode-map [menu-bar classify output-menu] |
1323 |
'("Output Rmail File" . rmail-disable-menu))))) |
1324 |
|
1325 |
|
1326 |
;;;; *** Rmail input *** |
1327 |
|
1328 |
;; RLK feature not added in this version: |
1329 |
;; argument specifies inbox file or files in various ways. |
1330 |
|
1331 |
(defun rmail-get-new-mail (&optional file-name) |
1332 |
"Move any new mail from this RMAIL file's inbox files. |
1333 |
The inbox files can be specified with the file's Mail: option. The |
1334 |
variable `rmail-primary-inbox-list' specifies the inboxes for your |
1335 |
primary RMAIL file if it has no Mail: option. By default, this is |
1336 |
your /usr/spool/mail/$USER. |
1337 |
|
1338 |
You can also specify the file to get new mail from. In this case, the |
1339 |
file of new mail is not changed or deleted. Noninteractively, you can |
1340 |
pass the inbox file name as an argument. Interactively, a prefix |
1341 |
argument causes us to read a file name and use that file as the inbox. |
1342 |
|
1343 |
If the variable `rmail-preserve-inbox' is non-nil, new mail will |
1344 |
always be left in inbox files rather than deleted. |
1345 |
|
1346 |
This function runs `rmail-get-new-mail-hook' before saving the updated file. |
1347 |
It returns t if it got any new messages." |
1348 |
(interactive |
1349 |
(list (if current-prefix-arg |
1350 |
(read-file-name "Get new mail from file: ")))) |
1351 |
(run-hooks 'rmail-before-get-new-mail-hook) |
1352 |
;; If the disk file has been changed from under us, |
1353 |
;; revert to it before we get new mail. |
1354 |
(or (verify-visited-file-modtime (current-buffer)) |
1355 |
(find-file (buffer-file-name))) |
1356 |
(set-buffer rmail-buffer) |
1357 |
(rmail-maybe-set-message-counters) |
1358 |
(widen) |
1359 |
;; Get rid of all undo records for this buffer. |
1360 |
(or (eq buffer-undo-list t) |
1361 |
(setq buffer-undo-list nil)) |
1362 |
(let ((all-files (if file-name (list file-name) |
1363 |
rmail-inbox-list)) |
1364 |
(rmail-enable-multibyte (default-value 'enable-multibyte-characters)) |
1365 |
found) |
1366 |
(unwind-protect |
1367 |
(progn |
1368 |
(while all-files |
1369 |
(let ((opoint (point)) |
1370 |
(new-messages 0) |
1371 |
(rsf-number-of-spam 0) |
1372 |
(delete-files ()) |
1373 |
;; If buffer has not changed yet, and has not been saved yet, |
1374 |
;; don't replace the old backup file now. |
1375 |
(make-backup-files (and make-backup-files (buffer-modified-p))) |
1376 |
(buffer-read-only nil) |
1377 |
;; Don't make undo records for what we do in getting mail. |
1378 |
(buffer-undo-list t) |
1379 |
success |
1380 |
;; Files to insert this time around. |
1381 |
files |
1382 |
;; Last names of those files. |
1383 |
file-last-names) |
1384 |
;; Pull files off all-files onto files |
1385 |
;; as long as there is no name conflict. |
1386 |
;; A conflict happens when two inbox file names |
1387 |
;; have the same last component. |
1388 |
(while (and all-files |
1389 |
(not (member (file-name-nondirectory (car all-files)) |
1390 |
file-last-names))) |
1391 |
(setq files (cons (car all-files) files) |
1392 |
file-last-names |
1393 |
(cons (file-name-nondirectory (car all-files)) files)) |
1394 |
(setq all-files (cdr all-files))) |
1395 |
;; Put them back in their original order. |
1396 |
(setq files (nreverse files)) |
1397 |
|
1398 |
(goto-char (point-max)) |
1399 |
(skip-chars-backward " \t\n") ; just in case of brain damage |
1400 |
(delete-region (point) (point-max)) ; caused by require-final-newline |
1401 |
(save-excursion |
1402 |
(save-restriction |
1403 |
(narrow-to-region (point) (point)) |
1404 |
;; Read in the contents of the inbox files, |
1405 |
;; renaming them as necessary, |
1406 |
;; and adding to the list of files to delete eventually. |
1407 |
(if file-name |
1408 |
(rmail-insert-inbox-text files nil) |
1409 |
(setq delete-files (rmail-insert-inbox-text files t))) |
1410 |
;; Scan the new text and convert each message to babyl format. |
1411 |
(goto-char (point-min)) |
1412 |
(unwind-protect |
1413 |
(save-excursion |
1414 |
(setq new-messages (rmail-convert-to-babyl-format) |
1415 |
success t)) |
1416 |
;; Try to delete the garbage just inserted. |
1417 |
(or success (delete-region (point-min) (point-max))) |
1418 |
;; If we could not convert the file's inboxes, |
1419 |
;; rename the files we tried to read |
1420 |
;; so we won't over and over again. |
1421 |
(if (and (not file-name) (not success)) |
1422 |
(let ((delfiles delete-files) |
1423 |
(count 0)) |
1424 |
(while delfiles |
1425 |
(while (file-exists-p (format "RMAILOSE.%d" count)) |
1426 |
(setq count (1+ count))) |
1427 |
(rename-file (car delfiles) |
1428 |
(format "RMAILOSE.%d" count)) |
1429 |
(setq delfiles (cdr delfiles)))))) |
1430 |
(or (zerop new-messages) |
1431 |
(let (success) |
1432 |
(widen) |
1433 |
(search-backward "\n\^_" nil t) |
1434 |
(narrow-to-region (point) (point-max)) |
1435 |
(goto-char (1+ (point-min))) |
1436 |
(rmail-count-new-messages) |
1437 |
(run-hooks 'rmail-get-new-mail-hook) |
1438 |
(save-buffer))) |
1439 |
;; Delete the old files, now that babyl file is saved. |
1440 |
(while delete-files |
1441 |
(condition-case () |
1442 |
;; First, try deleting. |
1443 |
(condition-case () |
1444 |
(delete-file (car delete-files)) |
1445 |
(file-error |
1446 |
;; If we can't delete it, truncate it. |
1447 |
(write-region (point) (point) (car delete-files)))) |
1448 |
(file-error nil)) |
1449 |
(setq delete-files (cdr delete-files))))) |
1450 |
(if (= new-messages 0) |
1451 |
(progn (goto-char opoint) |
1452 |
(if (or file-name rmail-inbox-list) |
1453 |
(message "(No new mail has arrived)"))) |
1454 |
;; check new messages to see if any of them is spam: |
1455 |
(if (and (featurep 'rmail-spam-filter) |
1456 |
rmail-use-spam-filter) |
1457 |
(let* |
1458 |
((old-messages (- rmail-total-messages new-messages)) |
1459 |
(rsf-scanned-message-number (1+ old-messages)) |
1460 |
;; save deletion flags of old messages: vector starts |
1461 |
;; at zero (is one longer that no of messages), |
1462 |
;; therefore take 1+ old-messages |
1463 |
(save-deleted |
1464 |
(substring rmail-deleted-vector 0 (1+ |
1465 |
old-messages)))) |
1466 |
;; set all messages to undeleted |
1467 |
(setq rmail-deleted-vector |
1468 |
(make-string (1+ rmail-total-messages) ?\ )) |
1469 |
(while (<= rsf-scanned-message-number |
1470 |
rmail-total-messages) |
1471 |
(progn |
1472 |
(if (not (rmail-spam-filter rsf-scanned-message-number)) |
1473 |
(progn (setq rsf-number-of-spam (1+ rsf-number-of-spam))) |
1474 |
) |
1475 |
(setq rsf-scanned-message-number (1+ rsf-scanned-message-number)) |
1476 |
)) |
1477 |
(if (> rsf-number-of-spam 0) |
1478 |
(progn |
1479 |
(when (rmail-expunge-confirmed) |
1480 |
(rmail-only-expunge t)) |
1481 |
)) |
1482 |
(setq rmail-deleted-vector |
1483 |
(concat |
1484 |
save-deleted |
1485 |
(make-string (- rmail-total-messages old-messages) |
1486 |
?\ ))) |
1487 |
)) |
1488 |
(if (rmail-summary-exists) |
1489 |
(rmail-select-summary |
1490 |
(rmail-update-summary))) |
1491 |
(message "%d new message%s read%s" |
1492 |
new-messages (if (= 1 new-messages) "" "s") |
1493 |
;; print out a message on number of spam messages found: |
1494 |
(if (and (featurep 'rmail-spam-filter) |
1495 |
rmail-use-spam-filter |
1496 |
(> rsf-number-of-spam 0)) |
1497 |
(if (= 1 new-messages) |
1498 |
", and found to be a spam message" |
1499 |
(if (> rsf-number-of-spam 1) |
1500 |
(format ", %d of which found to be spam messages" |
1501 |
rsf-number-of-spam) |
1502 |
", one of which found to be a spam message")) |
1503 |
"")) |
1504 |
(if (and (featurep 'rmail-spam-filter) |
1505 |
rmail-use-spam-filter |
1506 |
(> rsf-number-of-spam 0)) |
1507 |
(progn (if rsf-beep (beep t)) |
1508 |
(sleep-for rsf-sleep-after-message))) |
1509 |
|
1510 |
;; Move to the first new message |
1511 |
;; unless we have other unseen messages before it. |
1512 |
(rmail-show-message (rmail-first-unseen-message)) |
1513 |
(run-hooks 'rmail-after-get-new-mail-hook) |
1514 |
(setq found t)))) |
1515 |
found) |
1516 |
;; Don't leave the buffer screwed up if we get a disk-full error. |
1517 |
(or found (rmail-show-message))))) |
1518 |
|
1519 |
(defun rmail-insert-inbox-text (files renamep) |
1520 |
;; Detect a locked file now, so that we avoid moving mail |
1521 |
;; out of the real inbox file. (That could scare people.) |
1522 |
(or (memq (file-locked-p buffer-file-name) '(nil t)) |
1523 |
(error "RMAIL file %s is locked" |
1524 |
(file-name-nondirectory buffer-file-name))) |
1525 |
(let (file tofile delete-files movemail popmail got-password password) |
1526 |
(while files |
1527 |
;; Handle POP mailbox names specially; don't expand as filenames |
1528 |
;; in case the userid contains a directory separator. |
1529 |
(setq file (car files)) |
1530 |
(setq popmail (string-match "^po:" file)) |
1531 |
(if popmail |
1532 |
(setq renamep t) |
1533 |
(setq file (file-truename |
1534 |
(substitute-in-file-name (expand-file-name file))))) |
1535 |
(setq tofile (expand-file-name |
1536 |
;; Generate name to move to from inbox name, |
1537 |
;; in case of multiple inboxes that need moving. |
1538 |
(concat ".newmail-" (file-name-nondirectory file)) |
1539 |
;; Use the directory of this rmail file |
1540 |
;; because it's a nuisance to use the homedir |
1541 |
;; if that is on a full disk and this rmail |
1542 |
;; file isn't. |
1543 |
(file-name-directory |
1544 |
(expand-file-name buffer-file-name)))) |
1545 |
;; Always use movemail to rename the file, |
1546 |
;; since there can be mailboxes in various directories. |
1547 |
(setq movemail t) |
1548 |
;;; ;; If getting from mail spool directory, |
1549 |
;;; ;; use movemail to move rather than just renaming, |
1550 |
;;; ;; so as to interlock with the mailer. |
1551 |
;;; (setq movemail (string= file |
1552 |
;;; (file-truename |
1553 |
;;; (concat rmail-spool-directory |
1554 |
;;; (file-name-nondirectory file))))) |
1555 |
(if (and movemail (not popmail)) |
1556 |
(progn |
1557 |
;; On some systems, /usr/spool/mail/foo is a directory |
1558 |
;; and the actual inbox is /usr/spool/mail/foo/foo. |
1559 |
(if (file-directory-p file) |
1560 |
(setq file (expand-file-name (user-login-name) |
1561 |
file))))) |
1562 |
(cond (popmail |
1563 |
(if rmail-pop-password-required |
1564 |
(progn (setq got-password (not (rmail-have-password))) |
1565 |
(setq password (rmail-get-pop-password)))) |
1566 |
(if (memq system-type '(windows-nt cygwin)) |
1567 |
;; cannot have "po:" in file name |
1568 |
(setq tofile |
1569 |
(expand-file-name |
1570 |
(concat ".newmail-pop-" |
1571 |
(file-name-nondirectory (substring file 3))) |
1572 |
(file-name-directory |
1573 |
(expand-file-name buffer-file-name))))) |
1574 |
(message "Getting mail from post office ...")) |
1575 |
((and (file-exists-p tofile) |
1576 |
(/= 0 (nth 7 (file-attributes tofile)))) |
1577 |
(message "Getting mail from %s..." tofile)) |
1578 |
((and (file-exists-p file) |
1579 |
(/= 0 (nth 7 (file-attributes file)))) |
1580 |
(message "Getting mail from %s..." file))) |
1581 |
;; Set TOFILE if have not already done so, and |
1582 |
;; rename or copy the file FILE to TOFILE if and as appropriate. |
1583 |
(cond ((not renamep) |
1584 |
(setq tofile file)) |
1585 |
((or (file-exists-p tofile) (and (not popmail) |
1586 |
(not (file-exists-p file)))) |
1587 |
nil) |
1588 |
((and (not movemail) (not popmail)) |
1589 |
;; Try copying. If that fails (perhaps no space) and |
1590 |
;; we're allowed to blow away the inbox, rename instead. |
1591 |
(if rmail-preserve-inbox |
1592 |
(copy-file file tofile nil) |
1593 |
(condition-case nil |
1594 |
(copy-file file tofile nil) |
1595 |
(error |
1596 |
;; Third arg is t so we can replace existing file TOFILE. |
1597 |
(rename-file file tofile t)))) |
1598 |
;; Make the real inbox file empty. |
1599 |
;; Leaving it deleted could cause lossage |
1600 |
;; because mailers often won't create the file. |
1601 |
(if (not rmail-preserve-inbox) |
1602 |
(condition-case () |
1603 |
(write-region (point) (point) file) |
1604 |
(file-error nil)))) |
1605 |
(t |
1606 |
(let ((errors nil)) |
1607 |
(unwind-protect |
1608 |
(save-excursion |
1609 |
(setq errors (generate-new-buffer " *rmail loss*")) |
1610 |
(buffer-disable-undo errors) |
1611 |
(let ((args |
1612 |
(append |
1613 |
(list (or rmail-movemail-program |
1614 |
(expand-file-name "movemail" |
1615 |
exec-directory)) |
1616 |
nil errors nil) |
1617 |
(if rmail-preserve-inbox |
1618 |
(list "-p") |
1619 |
nil) |
1620 |
rmail-movemail-flags |
1621 |
(list file tofile) |
1622 |
(if password (list password) nil)))) |
1623 |
(apply 'call-process args)) |
1624 |
(if (not (buffer-modified-p errors)) |
1625 |
;; No output => movemail won |
1626 |
nil |
1627 |
(set-buffer errors) |
1628 |
(subst-char-in-region (point-min) (point-max) |
1629 |
?\n ?\ ) |
1630 |
(goto-char (point-max)) |
1631 |
(skip-chars-backward " \t") |
1632 |
(delete-region (point) (point-max)) |
1633 |
(goto-char (point-min)) |
1634 |
(if (looking-at "movemail: ") |
1635 |
(delete-region (point-min) (match-end 0))) |
1636 |
(beep t) |
1637 |
(message "movemail: %s" |
1638 |
(buffer-substring (point-min) |
1639 |
(point-max))) |
1640 |
;; If we just read the password, most likely it is |
1641 |
;; wrong. Otherwise, see if there is a specific |
1642 |
;; reason to think that the problem is a wrong passwd. |
1643 |
(if (or got-password |
1644 |
(re-search-forward rmail-pop-password-error |
1645 |
nil t)) |
1646 |
(rmail-set-pop-password nil)) |
1647 |
(sit-for 3) |
1648 |
nil)) |
1649 |
(if errors (kill-buffer errors)))))) |
1650 |
;; At this point, TOFILE contains the name to read: |
1651 |
;; Either the alternate name (if we renamed) |
1652 |
;; or the actual inbox (if not renaming). |
1653 |
(if (file-exists-p tofile) |
1654 |
(let ((coding-system-for-read 'no-conversion) |
1655 |
size) |
1656 |
(goto-char (point-max)) |
1657 |
(setq size (nth 1 (insert-file-contents tofile))) |
1658 |
(goto-char (point-max)) |
1659 |
(or (= (preceding-char) ?\n) |
1660 |
(zerop size) |
1661 |
(insert ?\n)) |
1662 |
(if (not (and rmail-preserve-inbox (string= file tofile))) |
1663 |
(setq delete-files (cons tofile delete-files))))) |
1664 |
(message "") |
1665 |
(setq files (cdr files))) |
1666 |
delete-files)) |
1667 |
|
1668 |
;; Decode the region specified by FROM and TO by CODING. |
1669 |
;; If CODING is nil or an invalid coding system, decode by `undecided'. |
1670 |
(defun rmail-decode-region (from to coding) |
1671 |
(if (or (not coding) (not (coding-system-p coding))) |
1672 |
(setq coding 'undecided)) |
1673 |
;; Use -dos decoding, to remove ^M characters left from base64 or |
1674 |
;; rogue qp-encoded text. |
1675 |
(decode-coding-region from to |
1676 |
(coding-system-change-eol-conversion coding 1)) |
1677 |
;; Don't reveal the fact we used -dos decoding, as users generally |
1678 |
;; will not expect the RMAIL buffer to use DOS EOL format. |
1679 |
(setq buffer-file-coding-system |
1680 |
(setq last-coding-system-used |
1681 |
(coding-system-change-eol-conversion coding 0)))) |
1682 |
|
1683 |
;; the rmail-break-forwarded-messages feature is not implemented |
1684 |
(defun rmail-convert-to-babyl-format () |
1685 |
(let ((count 0) start |
1686 |
(case-fold-search nil) |
1687 |
(invalid-input-resync |
1688 |
(function (lambda () |
1689 |
(message "Invalid Babyl format in inbox!") |
1690 |
(sit-for 3) |
1691 |
;; Try to get back in sync with a real message. |
1692 |
(if (re-search-forward |
1693 |
(concat rmail-mmdf-delim1 "\\|^From") nil t) |
1694 |
(beginning-of-line) |
1695 |
(goto-char (point-max))))))) |
1696 |
(goto-char (point-min)) |
1697 |
(save-restriction |
1698 |
(while (not (eobp)) |
1699 |
(setq start (point)) |
1700 |
(cond ((looking-at "BABYL OPTIONS:");Babyl header |
1701 |
(if (search-forward "\n\^_" nil t) |
1702 |
;; If we find the proper terminator, delete through there. |
1703 |
(delete-region (point-min) (point)) |
1704 |
(funcall invalid-input-resync) |
1705 |
(delete-region (point-min) (point)))) |
1706 |
;; Babyl format message |
1707 |
((looking-at "\^L") |
1708 |
(or (search-forward "\n\^_" nil t) |
1709 |
(funcall invalid-input-resync)) |
1710 |
(setq count (1+ count)) |
1711 |
;; Make sure there is no extra white space after the ^_ |
1712 |
;; at the end of the message. |
1713 |
;; Narrowing will make sure that whatever follows the junk |
1714 |
;; will be treated properly. |
1715 |
(delete-region (point) |
1716 |
(save-excursion |
1717 |
(skip-chars-forward " \t\n") |
1718 |
(point))) |
1719 |
(save-excursion |
1720 |
(let* ((header-end |
1721 |
(progn |
1722 |
(save-excursion |
1723 |
(goto-char start) |
1724 |
(forward-line 1) |
1725 |
(if (looking-at "0") |
1726 |
(forward-line 1) |
1727 |
(forward-line 2)) |
1728 |
(save-restriction |
1729 |
(narrow-to-region (point) (point-max)) |
1730 |
(rfc822-goto-eoh) |
1731 |
(point))))) |
1732 |
(case-fold-search t) |
1733 |
(quoted-printable-header-field-end |
1734 |
(save-excursion |
1735 |
(goto-char start) |
1736 |
(re-search-forward |
1737 |
"^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" |
1738 |
header-end t))) |
1739 |
(base64-header-field-end |
1740 |
(save-excursion |
1741 |
(goto-char start) |
1742 |
(re-search-forward |
1743 |
"^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" |
1744 |
header-end t)))) |
1745 |
(if quoted-printable-header-field-end |
1746 |
(save-excursion |
1747 |
(unless |
1748 |
(mail-unquote-printable-region header-end (point) nil t t) |
1749 |
(message "Malformed MIME quoted-printable message")) |
1750 |
;; Change "quoted-printable" to "8bit", |
1751 |
;; to reflect the decoding we just did. |
1752 |
(goto-char quoted-printable-header-field-end) |
1753 |
(delete-region (point) (search-backward ":")) |
1754 |
(insert ": 8bit"))) |
1755 |
(if base64-header-field-end |
1756 |
(save-excursion |
1757 |
(when |
1758 |
(condition-case nil |
1759 |
(progn |
1760 |
(base64-decode-region (1+ header-end) |
1761 |
(- (point) 2)) |
1762 |
t) |
1763 |
(error nil)) |
1764 |
;; Change "base64" to "8bit", to reflect the |
1765 |
;; decoding we just did. |
1766 |
(goto-char base64-header-field-end) |
1767 |
(delete-region (point) (search-backward ":")) |
1768 |
(insert ": 8bit")))) |
1769 |
(setq last-coding-system-used nil) |
1770 |
(or rmail-enable-mime |
1771 |
(not rmail-enable-multibyte) |
1772 |
(let ((mime-charset |
1773 |
(if (and rmail-decode-mime-charset |
1774 |
(save-excursion |
1775 |
(goto-char start) |
1776 |
(search-forward "\n\n" nil t) |
1777 |
(let ((case-fold-search t)) |
1778 |
(re-search-backward |
1779 |
rmail-mime-charset-pattern |
1780 |
start t)))) |
1781 |
(intern (downcase (match-string 1)))))) |
1782 |
(rmail-decode-region start (point) mime-charset))))) |
1783 |
;; Add an X-Coding-System: header if we don't have one. |
1784 |
(save-excursion |
1785 |
(goto-char start) |
1786 |
(forward-line 1) |
1787 |
(if (looking-at "0") |
1788 |
(forward-line 1) |
1789 |
(forward-line 2)) |
1790 |
(or (save-restriction |
1791 |
(narrow-to-region (point) (point-max)) |
1792 |
(rfc822-goto-eoh) |
1793 |
(goto-char (point-min)) |
1794 |
(re-search-forward "^X-Coding-System:" nil t)) |
1795 |
(insert "X-Coding-System: " |
1796 |
(symbol-name last-coding-system-used) |
1797 |
"\n"))) |
1798 |
(narrow-to-region (point) (point-max)) |
1799 |
(and (= 0 (% count 10)) |
1800 |
(message "Converting to Babyl format...%d" count))) |
1801 |
;;*** MMDF format |
1802 |
((let ((case-fold-search t)) |
1803 |
(looking-at rmail-mmdf-delim1)) |
1804 |
(let ((case-fold-search t)) |
1805 |
(replace-match "\^L\n0, unseen,,\n*** EOOH ***\n") |
1806 |
(re-search-forward rmail-mmdf-delim2 nil t) |
1807 |
(replace-match "\^_")) |
1808 |
(save-excursion |
1809 |
(save-restriction |
1810 |
(narrow-to-region start (1- (point))) |
1811 |
(goto-char (point-min)) |
1812 |
(while (search-forward "\n\^_" nil t); single char "\^_" |
1813 |
(replace-match "\n^_")))); 2 chars: "^" and "_" |
1814 |
(setq last-coding-system-used nil) |
1815 |
(or rmail-enable-mime |
1816 |
(not rmail-enable-multibyte) |
1817 |
(decode-coding-region start (point) 'undecided)) |
1818 |
(save-excursion |
1819 |
(goto-char start) |
1820 |
(forward-line 3) |
1821 |
(insert "X-Coding-System: " |
1822 |
(symbol-name last-coding-system-used) |
1823 |
"\n")) |
1824 |
(narrow-to-region (point) (point-max)) |
1825 |
(setq count (1+ count)) |
1826 |
(and (= 0 (% count 10)) |
1827 |
(message "Converting to Babyl format...%d" count))) |
1828 |
;;*** Mail format |
1829 |
((looking-at "^From ") |
1830 |
(insert "\^L\n0, unseen,,\n*** EOOH ***\n") |
1831 |
(rmail-nuke-pinhead-header) |
1832 |
;; If this message has a Content-Length field, |
1833 |
;; skip to the end of the contents. |
1834 |
(let* ((header-end (save-excursion |
1835 |
(and (re-search-forward "\n\n" nil t) |
1836 |
(1- (point))))) |
1837 |
(case-fold-search t) |
1838 |
(quoted-printable-header-field-end |
1839 |
(save-excursion |
1840 |
(re-search-forward |
1841 |
"^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" |
1842 |
header-end t))) |
1843 |
(base64-header-field-end |
1844 |
(save-excursion |
1845 |
(re-search-forward |
1846 |
"^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" |
1847 |
header-end t))) |
1848 |
(size |
1849 |
;; Get the numeric value from the Content-Length field. |
1850 |
(save-excursion |
1851 |
;; Back up to end of prev line, |
1852 |
;; in case the Content-Length field comes first. |
1853 |
(forward-char -1) |
1854 |
(and (search-forward "\ncontent-length: " |
1855 |
header-end t) |
1856 |
(let ((beg (point)) |
1857 |
(eol (progn (end-of-line) (point)))) |
1858 |
(string-to-int (buffer-substring beg eol))))))) |
1859 |
(and size |
1860 |
(if (and (natnump size) |
1861 |
(<= (+ header-end size) (point-max)) |
1862 |
;; Make sure this would put us at a position |
1863 |
;; that we could continue from. |
1864 |
(save-excursion |
1865 |
(goto-char (+ header-end size)) |
1866 |
(skip-chars-forward "\n") |
1867 |
(or (eobp) |
1868 |
(and (looking-at "BABYL OPTIONS:") |
1869 |
(search-forward "\n\^_" nil t)) |
1870 |
(and (looking-at "\^L") |
1871 |
(search-forward "\n\^_" nil t)) |
1872 |
(let ((case-fold-search t)) |
1873 |
(looking-at rmail-mmdf-delim1)) |
1874 |
(looking-at "From ")))) |
1875 |
(goto-char (+ header-end size)) |
1876 |
(message "Ignoring invalid Content-Length field") |
1877 |
(sit-for 1 0 t))) |
1878 |
(if (let ((case-fold-search nil)) |
1879 |
(re-search-forward |
1880 |
(concat "^[\^_]?\\(" |
1881 |
rmail-unix-mail-delimiter |
1882 |
"\\|" |
1883 |
rmail-mmdf-delim1 "\\|" |
1884 |
"^BABYL OPTIONS:\\|" |
1885 |
"\^L\n[01],\\)") nil t)) |
1886 |
(goto-char (match-beginning 1)) |
1887 |
(goto-char (point-max))) |
1888 |
(setq count (1+ count)) |
1889 |
(if quoted-printable-header-field-end |
1890 |
(save-excursion |
1891 |
(unless |
1892 |
(mail-unquote-printable-region header-end (point) nil t t) |
1893 |
(message "Malformed MIME quoted-printable message")) |
1894 |
;; Change "quoted-printable" to "8bit", |
1895 |
;; to reflect the decoding we just did. |
1896 |
(goto-char quoted-printable-header-field-end) |
1897 |
(delete-region (point) (search-backward ":")) |
1898 |
(insert ": 8bit"))) |
1899 |
(if base64-header-field-end |
1900 |
(save-excursion |
1901 |
(when |
1902 |
(condition-case nil |
1903 |
(progn |
1904 |
(base64-decode-region |
1905 |
(1+ header-end) |
1906 |
(save-excursion |
1907 |
;; Prevent base64-decode-region |
1908 |
;; from removing newline characters. |
1909 |
(skip-chars-backward "\n\t ") |
1910 |
(point))) |
1911 |
t) |
1912 |
(error nil)) |
1913 |
;; Change "base64" to "8bit", to reflect the |
1914 |
;; decoding we just did. |
1915 |
(goto-char base64-header-field-end) |
1916 |
(delete-region (point) (search-backward ":")) |
1917 |
(insert ": 8bit"))))) |
1918 |
|
1919 |
(save-excursion |
1920 |
(save-restriction |
1921 |
(narrow-to-region start (point)) |
1922 |
(goto-char (point-min)) |
1923 |
(while (search-forward "\n\^_" nil t); single char |
1924 |
(replace-match "\n^_")))); 2 chars: "^" and "_" |
1925 |
;; This is for malformed messages that don't end in newline. |
1926 |
;; There shouldn't be any, but some users say occasionally |
1927 |
;; there are some. |
1928 |
(or (bolp) (newline)) |
1929 |
(insert ?\^_) |
1930 |
(setq last-coding-system-used nil) |
1931 |
(or rmail-enable-mime |
1932 |
(not rmail-enable-multibyte) |
1933 |
(let ((mime-charset |
1934 |
(if (and rmail-decode-mime-charset |
1935 |
(save-excursion |
1936 |
(goto-char start) |
1937 |
(search-forward "\n\n" nil t) |
1938 |
(let ((case-fold-search t)) |
1939 |
(re-search-backward |
1940 |
rmail-mime-charset-pattern |
1941 |
start t)))) |
1942 |
(intern (downcase (match-string 1)))))) |
1943 |
(rmail-decode-region start (point) mime-charset))) |
1944 |
(save-excursion |
1945 |
(goto-char start) |
1946 |
(forward-line 3) |
1947 |
(insert "X-Coding-System: " |
1948 |
(symbol-name last-coding-system-used) |
1949 |
"\n")) |
1950 |
(narrow-to-region (point) (point-max)) |
1951 |
(and (= 0 (% count 10)) |
1952 |
(message "Converting to Babyl format...%d" count))) |
1953 |
;; |
1954 |
;; This kludge is because some versions of sendmail.el |
1955 |
;; insert an extra newline at the beginning that shouldn't |
1956 |
;; be there. sendmail.el has been fixed, but old versions |
1957 |
;; may still be in use. -- rms, 7 May 1993. |
1958 |
((eolp) (delete-char 1)) |
1959 |
(t (error "Cannot convert to babyl format"))))) |
1960 |
count)) |
1961 |
|
1962 |
;; Delete the "From ..." line, creating various other headers with |
1963 |
;; information from it if they don't already exist. Now puts the |
1964 |
;; original line into a mail-from: header line for debugging and for |
1965 |
;; use by the rmail-output function. |
1966 |
(defun rmail-nuke-pinhead-header () |
1967 |
(save-excursion |
1968 |
(save-restriction |
1969 |
(let ((start (point)) |
1970 |
(end (progn |
1971 |
(condition-case () |
1972 |
(search-forward "\n\n") |
1973 |
(error |
1974 |
(goto-char (point-max)) |
1975 |
(insert "\n\n"))) |
1976 |
(point))) |
1977 |
has-from has-date) |
1978 |
(narrow-to-region start end) |
1979 |
(let ((case-fold-search t)) |
1980 |
(goto-char start) |
1981 |
(setq has-from (search-forward "\nFrom:" nil t)) |
1982 |
(goto-char start) |
1983 |
(setq has-date (and (search-forward "\nDate:" nil t) (point))) |
1984 |
(goto-char start)) |
1985 |
(let ((case-fold-search nil)) |
1986 |
(if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) |
1987 |
(replace-match |
1988 |
(concat |
1989 |
"Mail-from: \\&" |
1990 |
;; Keep and reformat the date if we don't |
1991 |
;; have a Date: field. |
1992 |
(if has-date |
1993 |
"" |
1994 |
(concat |
1995 |
"Date: \\2, \\4 \\3 \\9 \\5 " |
1996 |
|
1997 |
;; The timezone could be matched by group 7 or group 10. |
1998 |
;; If neither of them matched, assume EST, since only |
1999 |
;; Easterners would be so sloppy. |
2000 |
;; It's a shame the substitution can't use "\\10". |
2001 |
(cond |
2002 |
((/= (match-beginning 7) (match-end 7)) "\\7") |
2003 |
((/= (match-beginning 10) (match-end 10)) |
2004 |
(buffer-substring (match-beginning 10) |
2005 |
(match-end 10))) |
2006 |
(t "EST")) |
2007 |
"\n")) |
2008 |
;; Keep and reformat the sender if we don't |
2009 |
;; have a From: field. |
2010 |
(if has-from |
2011 |
"" |
2012 |
"From: \\1\n")) |
2013 |
t))))))) |
2014 |
|
2015 |
;;;; *** Rmail Message Formatting and Header Manipulation *** |
2016 |
|
2017 |
(defun rmail-reformat-message (beg end) |
2018 |
(goto-char beg) |
2019 |
(forward-line 1) |
2020 |
(if (/= (following-char) ?0) |
2021 |
(error "Bad format in RMAIL file")) |
2022 |
(let ((inhibit-read-only t) |
2023 |
(delta (- (buffer-size) end))) |
2024 |
(delete-char 1) |
2025 |
(insert ?1) |
2026 |
(forward-line 1) |
2027 |
(let ((case-fold-search t)) |
2028 |
(while (looking-at "Summary-line:\\|Mail-From:") |
2029 |
(forward-line 1))) |
2030 |
(if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n") |
2031 |
(delete-region (point) |
2032 |
(progn (forward-line 1) (point)))) |
2033 |
(let ((str (buffer-substring (point) |
2034 |
(save-excursion (search-forward "\n\n" end 'move) |
2035 |
(point))))) |
2036 |
(insert str "*** EOOH ***\n") |
2037 |
(narrow-to-region (point) (- (buffer-size) delta))) |
2038 |
(goto-char (point-min)) |
2039 |
(if rmail-message-filter (funcall rmail-message-filter)) |
2040 |
(if (or rmail-displayed-headers rmail-ignored-headers) |
2041 |
(rmail-clear-headers)))) |
2042 |
|
2043 |
(defun rmail-clear-headers (&optional ignored-headers) |
2044 |
"Delete all header fields that Rmail should not show. |
2045 |
If the optional argument IGNORED-HEADERS is non-nil, |
2046 |
delete all header fields whose names match that regexp. |
2047 |
Otherwise, if `rmail-displayed-headers' is non-nil, |
2048 |
delete all header fields *except* those whose names match that regexp. |
2049 |
Otherwise, delete all header fields whose names match `rmail-ignored-headers'." |
2050 |
(when (search-forward "\n\n" nil t) |
2051 |
(forward-char -1) |
2052 |
(let ((case-fold-search t) |
2053 |
(buffer-read-only nil)) |
2054 |
(if (and rmail-displayed-headers (null ignored-headers)) |
2055 |
(save-restriction |
2056 |
(narrow-to-region (point-min) (point)) |
2057 |
(let (lim next) |
2058 |
(goto-char (point-min)) |
2059 |
(while (and (not (eobp)) |
2060 |
(save-excursion |
2061 |
(if (re-search-forward "\n[^ \t]" nil t) |
2062 |
(setq lim (match-beginning 0) |
2063 |
next (1+ lim)) |
2064 |
(setq lim nil next (point-max))))) |
2065 |
(if (save-excursion |
2066 |
(re-search-forward rmail-displayed-headers lim t)) |
2067 |
(goto-char next) |
2068 |
(delete-region (point) next)))) |
2069 |
(goto-char (point-min))) |
2070 |
(or ignored-headers (setq ignored-headers rmail-ignored-headers)) |
2071 |
(save-restriction |
2072 |
(narrow-to-region (point-min) (point)) |
2073 |
(while (and ignored-headers |
2074 |
(progn |
2075 |
(goto-char (point-min)) |
2076 |
(re-search-forward ignored-headers nil t))) |
2077 |
(beginning-of-line) |
2078 |
(delete-region (point) |
2079 |
(if (re-search-forward "\n[^ \t]" nil t) |
2080 |
(1- (point)) |
2081 |
(point-max))))))))) |
2082 |
|
2083 |
(defun rmail-msg-is-pruned () |
2084 |
(rmail-maybe-set-message-counters) |
2085 |
(save-restriction |
2086 |
(narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
2087 |
(save-excursion |
2088 |
(goto-char (point-min)) |
2089 |
(forward-line 1) |
2090 |
(= (following-char) ?1)))) |
2091 |
|
2092 |
(defun rmail-msg-restore-non-pruned-header () |
2093 |
(let ((old-point (point)) |
2094 |
new-point |
2095 |
new-start |
2096 |
(inhibit-read-only t)) |
2097 |
(save-excursion |
2098 |
(narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
2099 |
(goto-char (point-min)) |
2100 |
(forward-line 1) |
2101 |
;; Change 1 to 0. |
2102 |
(delete-char 1) |
2103 |
(insert ?0) |
2104 |
;; Insert new EOOH line at the proper place. |
2105 |
(forward-line 1) |
2106 |
(let ((case-fold-search t)) |
2107 |
(while (looking-at "Summary-Line:\\|Mail-From:") |
2108 |
(forward-line 1))) |
2109 |
(insert "*** EOOH ***\n") |
2110 |
(setq new-start (point)) |
2111 |
;; Delete the old reformatted header. |
2112 |
(forward-char -1) |
2113 |
(search-forward "\n*** EOOH ***\n") |
2114 |
(forward-line -1) |
2115 |
(let ((start (point))) |
2116 |
(search-forward "\n\n") |
2117 |
(if (and (<= start old-point) |
2118 |
(<= old-point (point))) |
2119 |
(setq new-point new-start)) |
2120 |
(delete-region start (point))) |
2121 |
;; Narrow to after the new EOOH line. |
2122 |
(narrow-to-region new-start (point-max))) |
2123 |
(if new-point |
2124 |
(goto-char new-point)))) |
2125 |
|
2126 |
(defun rmail-msg-prune-header () |
2127 |
(let ((new-point |
2128 |
(= (point) (point-min)))) |
2129 |
(save-excursion |
2130 |
(narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
2131 |
(rmail-reformat-message (point-min) (point-max))) |
2132 |
(if new-point |
2133 |
(goto-char (point-min))))) |
2134 |
|
2135 |
(defun rmail-toggle-header (&optional arg) |
2136 |
"Show original message header if pruned header currently shown, or vice versa. |
2137 |
With argument ARG, show the message header pruned if ARG is greater than zero; |
2138 |
otherwise, show it in full." |
2139 |
(interactive "P") |
2140 |
(let* ((pruned (with-current-buffer rmail-buffer |
2141 |
(rmail-msg-is-pruned))) |
2142 |
(prune (if arg |
2143 |
(> (prefix-numeric-value arg) 0) |
2144 |
(not pruned)))) |
2145 |
(if (eq pruned prune) |
2146 |
t |
2147 |
(set-buffer rmail-buffer) |
2148 |
(rmail-maybe-set-message-counters) |
2149 |
(if rmail-enable-mime |
2150 |
(let ((buffer-read-only nil)) |
2151 |
(if pruned |
2152 |
(rmail-msg-restore-non-pruned-header) |
2153 |
(rmail-msg-prune-header)) |
2154 |
(funcall rmail-show-mime-function)) |
2155 |
(let* ((buffer-read-only nil) |
2156 |
(window (get-buffer-window (current-buffer))) |
2157 |
(at-point-min (= (point) (point-min))) |
2158 |
(all-headers-visible (= (window-start window) (point-min))) |
2159 |
(on-header |
2160 |
(save-excursion |
2161 |
(and (not (search-backward "\n\n" nil t)) |
2162 |
(progn |
2163 |
(end-of-line) |
2164 |
(re-search-backward "^[-A-Za-z0-9]+:" nil t)) |
2165 |
(match-string 0)))) |
2166 |
(old-screen-line |
2167 |
(rmail-count-screen-lines (window-start window) (point)))) |
2168 |
(if pruned |
2169 |
(rmail-msg-restore-non-pruned-header) |
2170 |
(rmail-msg-prune-header)) |
2171 |
(cond (at-point-min |
2172 |
(goto-char (point-min))) |
2173 |
(on-header |
2174 |
(goto-char (point-min)) |
2175 |
(search-forward "\n\n") |
2176 |
(or (re-search-backward |
2177 |
(concat "^" (regexp-quote on-header)) nil t) |
2178 |
(goto-char (point-min)))) |
2179 |
(t |
2180 |
(save-selected-window |
2181 |
(select-window window) |
2182 |
(recenter old-screen-line) |
2183 |
(if (and all-headers-visible |
2184 |
(not (= (window-start) (point-min)))) |
2185 |
(recenter (- (window-height) 2)))))))) |
2186 |
(rmail-highlight-headers)))) |
2187 |
|
2188 |
(defun rmail-narrow-to-non-pruned-header () |
2189 |
"Narrow to the whole (original) header of the current message." |
2190 |
(let (start end) |
2191 |
(narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
2192 |
(goto-char (point-min)) |
2193 |
(forward-line 1) |
2194 |
(if (= (following-char) ?1) |
2195 |
(progn |
2196 |
(forward-line 1) |
2197 |
(setq start (point)) |
2198 |
(search-forward "*** EOOH ***\n") |
2199 |
(setq end (match-beginning 0))) |
2200 |
(forward-line 2) |
2201 |
(setq start (point)) |
2202 |
(search-forward "\n\n") |
2203 |
(setq end (1- (point)))) |
2204 |
(narrow-to-region start end) |
2205 |
(goto-char start))) |
2206 |
|
2207 |
;; Lifted from repos-count-screen-lines. |
2208 |
;; Return number of screen lines between START and END. |
2209 |
(defun rmail-count-screen-lines (start end) |
2210 |
(save-excursion |
2211 |
(save-restriction |
2212 |
(narrow-to-region start end) |
2213 |
(goto-char (point-min)) |
2214 |
(vertical-motion (- (point-max) (point-min)))))) |
2215 |
|
2216 |
;;;; *** Rmail Attributes and Keywords *** |
2217 |
|
2218 |
;; Make a string describing current message's attributes and keywords |
2219 |
;; and set it up as the name of a minor mode |
2220 |
;; so it will appear in the mode line. |
2221 |
(defun rmail-display-labels () |
2222 |
(let ((blurb "") (beg (point-min-marker)) (end (point-max-marker))) |
2223 |
(save-excursion |
2224 |
(unwind-protect |
2225 |
(progn |
2226 |
(widen) |
2227 |
(goto-char (rmail-msgbeg rmail-current-message)) |
2228 |
(forward-line 1) |
2229 |
(if (looking-at "[01],") |
2230 |
(progn |
2231 |
(narrow-to-region (point) (progn (end-of-line) (point))) |
2232 |
;; Truly valid BABYL format requires a space before each |
2233 |
;; attribute or keyword name. Put them in if missing. |
2234 |
(let (buffer-read-only) |
2235 |
(goto-char (point-min)) |
2236 |
(while (search-forward "," nil t) |
2237 |
(or (looking-at "[ ,]") (eobp) |
2238 |
(insert " ")))) |
2239 |
(goto-char (point-max)) |
2240 |
(if (search-backward ",," nil 'move) |
2241 |
(progn |
2242 |
(if (> (point) (1+ (point-min))) |
2243 |
(setq blurb (buffer-substring (+ 1 (point-min)) (point)))) |
2244 |
(if (> (- (point-max) (point)) 2) |
2245 |
(setq blurb |
2246 |
(concat blurb |
2247 |
";" |
2248 |
(buffer-substring (+ (point) 3) |
2249 |
(1- (point-max))))))))))) |
2250 |
;; Note: we don't use save-restriction because that does not work right |
2251 |
;; if changes are made outside the saved restriction |
2252 |
;; before that restriction is restored. |
2253 |
(narrow-to-region beg end) |
2254 |
(set-marker beg nil) |
2255 |
(set-marker end nil))) |
2256 |
(while (string-match " +," blurb) |
2257 |
(setq blurb (concat (substring blurb 0 (match-beginning 0)) "," |
2258 |
(substring blurb (match-end 0))))) |
2259 |
(while (string-match ", +" blurb) |
2260 |
(setq blurb (concat (substring blurb 0 (match-beginning 0)) "," |
2261 |
(substring blurb (match-end 0))))) |
2262 |
(setq mode-line-process |
2263 |
(format " %d/%d%s" |
2264 |
rmail-current-message rmail-total-messages blurb)) |
2265 |
;; If rmail-enable-mime is non-nil, we may have to update |
2266 |
;; `mode-line-process' of rmail-view-buffer too. |
2267 |
(if (and rmail-enable-mime |
2268 |
(not (eq (current-buffer) rmail-view-buffer)) |
2269 |
(buffer-live-p rmail-view-buffer)) |
2270 |
(let ((mlp mode-line-process)) |
2271 |
(with-current-buffer rmail-view-buffer |
2272 |
(setq mode-line-process mlp)))))) |
2273 |
|
2274 |
;; Turn an attribute of a message on or off according to STATE. |
2275 |
;; ATTR is the name of the attribute, as a string. |
2276 |
;; MSGNUM is message number to change; nil means current message. |
2277 |
(defun rmail-set-attribute (attr state &optional msgnum) |
2278 |
(set-buffer rmail-buffer) |
2279 |
(let ((omax (point-max-marker)) |
2280 |
(omin (point-min-marker)) |
2281 |
(buffer-read-only nil)) |
2282 |
(or msgnum (setq msgnum rmail-current-message)) |
2283 |
(if (> msgnum 0) |
2284 |
(unwind-protect |
2285 |
(save-excursion |
2286 |
(widen) |
2287 |
(goto-char (+ 3 (rmail-msgbeg msgnum))) |
2288 |
(let ((curstate |
2289 |
(not |
2290 |
(null (search-backward (concat ", " attr ",") |
2291 |
(prog1 (point) (end-of-line)) t))))) |
2292 |
(or (eq curstate (not (not state))) |
2293 |
(if curstate |
2294 |
(delete-region (point) (1- (match-end 0))) |
2295 |
(beginning-of-line) |
2296 |
(forward-char 2) |
2297 |
(insert " " attr ",")))) |
2298 |
(if (string= attr "deleted") |
2299 |
(rmail-set-message-deleted-p msgnum state))) |
2300 |
;; Note: we don't use save-restriction because that does not work right |
2301 |
;; if changes are made outside the saved restriction |
2302 |
;; before that restriction is restored. |
2303 |
(narrow-to-region omin omax) |
2304 |
(set-marker omin nil) |
2305 |
(set-marker omax nil) |
2306 |
(if (= msgnum rmail-current-message) |
2307 |
(rmail-display-labels)))))) |
2308 |
|
2309 |
;; Return t if the attributes/keywords line of msg number MSG |
2310 |
;; contains a match for the regexp LABELS. |
2311 |
(defun rmail-message-labels-p (msg labels) |
2312 |
(save-excursion |
2313 |
(save-restriction |
2314 |
(widen) |
2315 |
(goto-char (rmail-msgbeg msg)) |
2316 |
(forward-char 3) |
2317 |
(re-search-backward labels (prog1 (point) (end-of-line)) t)))) |
2318 |
|
2319 |
;;;; *** Rmail Message Selection And Support *** |
2320 |
|
2321 |
(defun rmail-msgend (n) |
2322 |
(marker-position (aref rmail-message-vector (1+ n)))) |
2323 |
|
2324 |
(defun rmail-msgbeg (n) |
2325 |
(marker-position (aref rmail-message-vector n))) |
2326 |
|
2327 |
(defun rmail-widen-to-current-msgbeg (function) |
2328 |
"Call FUNCTION with point at start of internal data of current message. |
2329 |
Assumes that bounds were previously narrowed to display the message in Rmail. |
2330 |
The bounds are widened enough to move point where desired, then narrowed |
2331 |
again afterward. |
2332 |
|
2333 |
FUNCTION may not change the visible text of the message, but it may |
2334 |
change the invisible header text." |
2335 |
(save-excursion |
2336 |
(unwind-protect |
2337 |
(progn |
2338 |
(narrow-to-region (rmail-msgbeg rmail-current-message) |
2339 |
(point-max)) |
2340 |
(goto-char (point-min)) |
2341 |
(funcall function)) |
2342 |
;; Note: we don't use save-restriction because that does not work right |
2343 |
;; if changes are made outside the saved restriction |
2344 |
;; before that restriction is restored. |
2345 |
(narrow-to-region (rmail-msgbeg rmail-current-message) |
2346 |
(rmail-msgend rmail-current-message))))) |
2347 |
|
2348 |
(defun rmail-forget-messages () |
2349 |
(unwind-protect |
2350 |
(if (vectorp rmail-message-vector) |
2351 |
(let* ((i 0) |
2352 |
(v rmail-message-vector) |
2353 |
(n (length v))) |
2354 |
(while (< i n) |
2355 |
(move-marker (aref v i) nil) |
2356 |
(setq i (1+ i))))) |
2357 |
(setq rmail-message-vector nil) |
2358 |
(setq rmail-msgref-vector nil) |
2359 |
(setq rmail-deleted-vector nil))) |
2360 |
|
2361 |
(defun rmail-maybe-set-message-counters () |
2362 |
(if (not (and rmail-deleted-vector |
2363 |
rmail-message-vector |
2364 |
rmail-current-message |
2365 |
rmail-total-messages)) |
2366 |
(rmail-set-message-counters))) |
2367 |
|
2368 |
(defun rmail-count-new-messages (&optional nomsg) |
2369 |
(let* ((case-fold-search nil) |
2370 |
(total-messages 0) |
2371 |
(messages-head nil) |
2372 |
(deleted-head nil)) |
2373 |
(or nomsg (message "Counting new messages...")) |
2374 |
(goto-char (point-max)) |
2375 |
;; Put at the end of messages-head |
2376 |
;; the entry for message N+1, which marks |
2377 |
;; the end of message N. (N = number of messages). |
2378 |
(search-backward "\n\^_") |
2379 |
(forward-char 1) |
2380 |
(setq messages-head (list (point-marker))) |
2381 |
(rmail-set-message-counters-counter (point-min)) |
2382 |
(setq rmail-current-message (1+ rmail-total-messages)) |
2383 |
(setq rmail-total-messages |
2384 |
(+ rmail-total-messages total-messages)) |
2385 |
(setq rmail-message-vector |
2386 |
(vconcat rmail-message-vector (cdr messages-head))) |
2387 |
(aset rmail-message-vector |
2388 |
rmail-current-message (car messages-head)) |
2389 |
(setq rmail-deleted-vector |
2390 |
(concat rmail-deleted-vector deleted-head)) |
2391 |
(setq rmail-summary-vector |
2392 |
(vconcat rmail-summary-vector (make-vector total-messages nil))) |
2393 |
(setq rmail-msgref-vector |
2394 |
(vconcat rmail-msgref-vector (make-vector total-messages nil))) |
2395 |
;; Fill in the new elements of rmail-msgref-vector. |
2396 |
(let ((i (1+ (- rmail-total-messages total-messages)))) |
2397 |
(while (<= i rmail-total-messages) |
2398 |
(aset rmail-msgref-vector i (list i)) |
2399 |
(setq i (1+ i)))) |
2400 |
(goto-char (point-min)) |
2401 |
(or nomsg (message "Counting new messages...done (%d)" total-messages)))) |
2402 |
|
2403 |
(defun rmail-set-message-counters () |
2404 |
(rmail-forget-messages) |
2405 |
(save-excursion |
2406 |
(save-restriction |
2407 |
(widen) |
2408 |
(let* ((point-save (point)) |
2409 |
(total-messages 0) |
2410 |
(messages-after-point) |
2411 |
(case-fold-search nil) |
2412 |
(messages-head nil) |
2413 |
(deleted-head nil)) |
2414 |
(message "Counting messages...") |
2415 |
(goto-char (point-max)) |
2416 |
;; Put at the end of messages-head |
2417 |
;; the entry for message N+1, which marks |
2418 |
;; the end of message N. (N = number of messages). |
2419 |
(search-backward "\n\^_" nil t) |
2420 |
(if (/= (point) (point-max)) (forward-char 1)) |
2421 |
(setq messages-head (list (point-marker))) |
2422 |
(rmail-set-message-counters-counter (min (point) point-save)) |
2423 |
(setq messages-after-point total-messages) |
2424 |
(rmail-set-message-counters-counter) |
2425 |
(setq rmail-total-messages total-messages) |
2426 |
(setq rmail-current-message |
2427 |
(min total-messages |
2428 |
(max 1 (- total-messages messages-after-point)))) |
2429 |
(setq rmail-message-vector |
2430 |
(apply 'vector (cons (point-min-marker) messages-head)) |
2431 |
rmail-deleted-vector (concat "0" deleted-head) |
2432 |
rmail-summary-vector (make-vector rmail-total-messages nil) |
2433 |
rmail-msgref-vector (make-vector (1+ rmail-total-messages) nil)) |
2434 |
(let ((i 0)) |
2435 |
(while (<= i rmail-total-messages) |
2436 |
(aset rmail-msgref-vector i (list i)) |
2437 |
(setq i (1+ i)))) |
2438 |
(message "Counting messages...done"))))) |
2439 |
|
2440 |
(defun rmail-set-message-counters-counter (&optional stop) |
2441 |
(let ((start (point)) |
2442 |
next) |
2443 |
(while (search-backward "\n\^_\^L" stop t) |
2444 |
;; Detect messages that have been added with DOS line endings and |
2445 |
;; convert the line endings for such messages. |
2446 |
(setq next (point)) |
2447 |
(if (looking-at "\n\^_\^L\r\n") |
2448 |
(let ((buffer-read-only nil) |
2449 |
(buffer-undo t)) |
2450 |
(message "Counting messages...(converting line endings)") |
2451 |
(save-excursion |
2452 |
(goto-char start) |
2453 |
(while (search-backward "\r\n" next t) |
2454 |
(delete-char 1))))) |
2455 |
(setq start next) |
2456 |
(forward-char 1) |
2457 |
(setq messages-head (cons (point-marker) messages-head)) |
2458 |
(save-excursion |
2459 |
(setq deleted-head |
2460 |
(cons (if (search-backward ", deleted," |
2461 |
(prog1 (point) |
2462 |
(forward-line 2)) |
2463 |
t) |
2464 |
?D ?\ ) |
2465 |
deleted-head))) |
2466 |
(if (zerop (% (setq total-messages (1+ total-messages)) 20)) |
2467 |
(message "Counting messages...%d" total-messages))))) |
2468 |
|
2469 |
(defun rmail-beginning-of-message () |
2470 |
"Show current message starting from the beginning." |
2471 |
(interactive) |
2472 |
(rmail-show-message rmail-current-message)) |
2473 |
|
2474 |
(defun rmail-show-message (&optional n no-summary) |
2475 |
"Show message number N (prefix argument), counting from start of file. |
2476 |
If summary buffer is currently displayed, update current message there also." |
2477 |
(interactive "p") |
2478 |
(or (eq major-mode 'rmail-mode) |
2479 |
(switch-to-buffer rmail-buffer)) |
2480 |
(rmail-maybe-set-message-counters) |
2481 |
(widen) |
2482 |
(if (zerop rmail-total-messages) |
2483 |
(progn (narrow-to-region (point-min) (1- (point-max))) |
2484 |
(goto-char (point-min)) |
2485 |
(setq mode-line-process nil)) |
2486 |
(let (blurb coding-system) |
2487 |
(if (not n) |
2488 |
(setq n rmail-current-message) |
2489 |
(cond ((<= n 0) |
2490 |
(setq n 1 |
2491 |
rmail-current-message 1 |
2492 |
blurb "No previous message")) |
2493 |
((> n rmail-total-messages) |
2494 |
(setq n rmail-total-messages |
2495 |
rmail-current-message rmail-total-messages |
2496 |
blurb "No following message")) |
2497 |
(t |
2498 |
(setq rmail-current-message n)))) |
2499 |
(let ((beg (rmail-msgbeg n))) |
2500 |
(goto-char beg) |
2501 |
(forward-line 1) |
2502 |
(save-excursion |
2503 |
(let ((end (rmail-msgend n))) |
2504 |
(save-restriction |
2505 |
(if (prog1 (= (following-char) ?0) |
2506 |
(forward-line 2) |
2507 |
;; If there's a Summary-line in the (otherwise empty) |
2508 |
;; header, we didn't yet get past the EOOH line. |
2509 |
(if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") |
2510 |
(forward-line 1)) |
2511 |
(narrow-to-region (point) end)) |
2512 |
(rfc822-goto-eoh) |
2513 |
(search-forward "\n*** EOOH ***\n" end t)) |
2514 |
(narrow-to-region beg (point)) |
2515 |
(goto-char (point-min)) |
2516 |
(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
2517 |
(let ((coding-system (intern (match-string 1)))) |
2518 |
(condition-case nil |
2519 |
(progn |
2520 |
(check-coding-system coding-system) |
2521 |
(setq buffer-file-coding-system coding-system)) |
2522 |
(error |
2523 |
(setq buffer-file-coding-system nil)))) |
2524 |
(setq buffer-file-coding-system nil))))) |
2525 |
;; Clear the "unseen" attribute when we show a message. |
2526 |
(rmail-set-attribute "unseen" nil) |
2527 |
(let ((end (rmail-msgend n))) |
2528 |
;; Reformat the header, or else find the reformatted header. |
2529 |
(if (= (following-char) ?0) |
2530 |
(rmail-reformat-message beg end) |
2531 |
(search-forward "\n*** EOOH ***\n" end t) |
2532 |
(narrow-to-region (point) end))) |
2533 |
(goto-char (point-min)) |
2534 |
(walk-windows |
2535 |
(function (lambda (window) |
2536 |
(if (eq (window-buffer window) (current-buffer)) |
2537 |
(set-window-point window (point))))) |
2538 |
nil t) |
2539 |
(rmail-display-labels) |
2540 |
(if (eq rmail-enable-mime t) |
2541 |
(funcall rmail-show-mime-function) |
2542 |
(setq rmail-view-buffer rmail-buffer) |
2543 |
) |
2544 |
(rmail-highlight-headers) |
2545 |
(if transient-mark-mode (deactivate-mark)) |
2546 |
(run-hooks 'rmail-show-message-hook) |
2547 |
;; If there is a summary buffer, try to move to this message |
2548 |
;; in that buffer. But don't complain if this message |
2549 |
;; is not mentioned in the summary. |
2550 |
;; Don't do this at all if we were called on behalf |
2551 |
;; of cursor motion in the summary buffer. |
2552 |
(and (rmail-summary-exists) (not no-summary) |
2553 |
(let ((curr-msg rmail-current-message)) |
2554 |
(rmail-select-summary |
2555 |
(rmail-summary-goto-msg curr-msg t t)))) |
2556 |
(with-current-buffer rmail-buffer |
2557 |
(rmail-auto-file)) |
2558 |
(if blurb |
2559 |
(message blurb)))))) |
2560 |
|
2561 |
(defun rmail-redecode-body (coding) |
2562 |
"Decode the body of the current message using coding system CODING. |
2563 |
This is useful with mail messages that have malformed or missing |
2564 |
charset= headers. |
2565 |
|
2566 |
This function assumes that the current message is already decoded |
2567 |
and displayed in the RMAIL buffer, but the coding system used to |
2568 |
decode it was incorrect. It then encodes the message back to its |
2569 |
original form, and decodes it again, using the coding system CODING. |
2570 |
|
2571 |
Note that if Emacs erroneously auto-detected one of the iso-2022 |
2572 |
encodings in the message, this function might fail because the escape |
2573 |
sequences that switch between character sets and also single-shift and |
2574 |
locking-shift codes are impossible to recover. This function is meant |
2575 |
to be used to fix messages encoded with 8-bit encodings, such as |
2576 |
iso-8859, koi8-r, etc." |
2577 |
(interactive "zCoding system for re-decoding this message: ") |
2578 |
(when (not rmail-enable-mime) |
2579 |
(or (eq major-mode 'rmail-mode) |
2580 |
(switch-to-buffer rmail-buffer)) |
2581 |
(save-excursion |
2582 |
(let ((pruned (rmail-msg-is-pruned))) |
2583 |
(unwind-protect |
2584 |
(let ((msgbeg (rmail-msgbeg rmail-current-message)) |
2585 |
(msgend (rmail-msgend rmail-current-message)) |
2586 |
x-coding-header) |
2587 |
;; We need the message headers pruned (we later restore |
2588 |
;; the pruned stat to what it was, see the end of |
2589 |
;; unwind-protect form). |
2590 |
(or pruned |
2591 |
(rmail-toggle-header 1)) |
2592 |
(narrow-to-region msgbeg msgend) |
2593 |
(goto-char (point-min)) |
2594 |
(when (search-forward "\n*** EOOH ***\n" (point-max) t) |
2595 |
(narrow-to-region msgbeg (point))) |
2596 |
(goto-char (point-min)) |
2597 |
(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
2598 |
(let ((old-coding (intern (match-string 1))) |
2599 |
(buffer-read-only nil)) |
2600 |
(check-coding-system old-coding) |
2601 |
;; Make sure the new coding system uses the same EOL |
2602 |
;; conversion, to prevent ^M characters from popping |
2603 |
;; up all over the place. |
2604 |
(setq coding |
2605 |
(coding-system-change-eol-conversion |
2606 |
coding |
2607 |
(coding-system-eol-type old-coding))) |
2608 |
(setq x-coding-header (point-marker)) |
2609 |
(narrow-to-region msgbeg msgend) |
2610 |
(encode-coding-region (point) msgend old-coding) |
2611 |
(decode-coding-region (point) msgend coding) |
2612 |
(setq last-coding-system-used coding) |
2613 |
;; Rewrite the coding-system header according |
2614 |
;; to what we did. |
2615 |
(goto-char x-coding-header) |
2616 |
(delete-region (point) |
2617 |
(save-excursion |
2618 |
(beginning-of-line) |
2619 |
(point))) |
2620 |
(insert "X-Coding-System: " |
2621 |
(symbol-name last-coding-system-used)) |
2622 |
(set-marker x-coding-header nil) |
2623 |
(rmail-show-message)) |
2624 |
(error "No X-Coding-System header found"))) |
2625 |
(or pruned |
2626 |
(rmail-toggle-header 0))))))) |
2627 |
|
2628 |
;; Find all occurrences of certain fields, and highlight them. |
2629 |
(defun rmail-highlight-headers () |
2630 |
;; Do this only if the system supports faces. |
2631 |
(if (and (fboundp 'internal-find-face) |
2632 |
rmail-highlighted-headers) |
2633 |
(save-excursion |
2634 |
(search-forward "\n\n" nil 'move) |
2635 |
(save-restriction |
2636 |
(narrow-to-region (point-min) (point)) |
2637 |
(let ((case-fold-search t) |
2638 |
(inhibit-read-only t) |
2639 |
;; Highlight with boldface if that is available. |
2640 |
;; Otherwise use the `highlight' face. |
2641 |
(face (or rmail-highlight-face |
2642 |
(if (face-differs-from-default-p 'bold) |
2643 |
'bold 'highlight))) |
2644 |
;; List of overlays to reuse. |
2645 |
(overlays rmail-overlay-list)) |
2646 |
(goto-char (point-min)) |
2647 |
(while (re-search-forward rmail-highlighted-headers nil t) |
2648 |
(skip-chars-forward " \t") |
2649 |
(let ((beg (point)) |
2650 |
overlay) |
2651 |
(while (progn (forward-line 1) |
2652 |
(looking-at "[ \t]"))) |
2653 |
;; Back up over newline, then trailing spaces or tabs |
2654 |
(forward-char -1) |
2655 |
(while (member (preceding-char) '(? ?\t)) |
2656 |
(forward-char -1)) |
2657 |
(if overlays |
2658 |
;; Reuse an overlay we already have. |
2659 |
(progn |
2660 |
(setq overlay (car overlays) |
2661 |
overlays (cdr overlays)) |
2662 |
(overlay-put overlay 'face face) |
2663 |
(move-overlay overlay beg (point))) |
2664 |
;; Make a new overlay and add it to |
2665 |
;; rmail-overlay-list. |
2666 |
(setq overlay (make-overlay beg (point))) |
2667 |
(overlay-put overlay 'face face) |
2668 |
(setq rmail-overlay-list |
2669 |
(cons overlay rmail-overlay-list)))))))))) |
2670 |
|
2671 |
(defun rmail-auto-file () |
2672 |
"Automatically move a message into a sub-folder based on criteria. |
2673 |
Called when a new message is displayed." |
2674 |
(if (or (rmail-message-labels-p rmail-current-message "filed") |
2675 |
(not (string= (buffer-file-name) |
2676 |
(expand-file-name rmail-file-name)))) |
2677 |
;; Do nothing if it's already been filed. |
2678 |
nil |
2679 |
;; Find out some basics (common fields) |
2680 |
(let ((from (mail-fetch-field "from")) |
2681 |
(subj (mail-fetch-field "subject")) |
2682 |
(to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) |
2683 |
(d rmail-automatic-folder-directives) |
2684 |
(directive-loop nil) |
2685 |
(folder nil)) |
2686 |
(while d |
2687 |
(setq folder (car (car d)) |
2688 |
directive-loop (cdr (car d))) |
2689 |
(while (and (car directive-loop) |
2690 |
(let ((f (cond |
2691 |
((string= (car directive-loop) "from") from) |
2692 |
((string= (car directive-loop) "to") to) |
2693 |
((string= (car directive-loop) "subject") subj) |
2694 |
(t (mail-fetch-field (car directive-loop)))))) |
2695 |
(and f (string-match (car (cdr directive-loop)) f)))) |
2696 |
(setq directive-loop (cdr (cdr directive-loop)))) |
2697 |
;; If there are no directives left, then it was a complete match. |
2698 |
(if (null directive-loop) |
2699 |
(if (null folder) |
2700 |
(rmail-delete-forward) |
2701 |
(if (string= "/dev/null" folder) |
2702 |
(rmail-delete-message) |
2703 |
(rmail-output-to-rmail-file folder 1 t) |
2704 |
(setq d nil)))) |
2705 |
(setq d (cdr d)))))) |
2706 |
|
2707 |
(defun rmail-next-message (n) |
2708 |
"Show following message whether deleted or not. |
2709 |
With prefix arg N, moves forward N messages, or backward if N is negative." |
2710 |
(interactive "p") |
2711 |
(set-buffer rmail-buffer) |
2712 |
(rmail-maybe-set-message-counters) |
2713 |
(rmail-show-message (+ rmail-current-message n))) |
2714 |
|
2715 |
(defun rmail-previous-message (n) |
2716 |
"Show previous message whether deleted or not. |
2717 |
With prefix arg N, moves backward N messages, or forward if N is negative." |
2718 |
(interactive "p") |
2719 |
(rmail-next-message (- n))) |
2720 |
|
2721 |
(defun rmail-next-undeleted-message (n) |
2722 |
"Show following non-deleted message. |
2723 |
With prefix arg N, moves forward N non-deleted messages, |
2724 |
or backward if N is negative. |
2725 |
|
2726 |
Returns t if a new message is being shown, nil otherwise." |
2727 |
(interactive "p") |
2728 |
(set-buffer rmail-buffer) |
2729 |
(rmail-maybe-set-message-counters) |
2730 |
(let ((lastwin rmail-current-message) |
2731 |
(current rmail-current-message)) |
2732 |
(while (and (> n 0) (< current rmail-total-messages)) |
2733 |
(setq current (1+ current)) |
2734 |
(if (not (rmail-message-deleted-p current)) |
2735 |
(setq lastwin current n (1- n)))) |
2736 |
(while (and (< n 0) (> current 1)) |
2737 |
(setq current (1- current)) |
2738 |
(if (not (rmail-message-deleted-p current)) |
2739 |
(setq lastwin current n (1+ n)))) |
2740 |
(if (/= lastwin rmail-current-message) |
2741 |
(progn (rmail-show-message lastwin) |
2742 |
t) |
2743 |
(if (< n 0) |
2744 |
(message "No previous nondeleted message")) |
2745 |
(if (> n 0) |
2746 |
(message "No following nondeleted message")) |
2747 |
nil))) |
2748 |
|
2749 |
(defun rmail-previous-undeleted-message (n) |
2750 |
"Show previous non-deleted message. |
2751 |
With prefix argument N, moves backward N non-deleted messages, |
2752 |
or forward if N is negative." |
2753 |
(interactive "p") |
2754 |
(rmail-next-undeleted-message (- n))) |
2755 |
|
2756 |
(defun rmail-first-message () |
2757 |
"Show first message in file." |
2758 |
(interactive) |
2759 |
(rmail-maybe-set-message-counters) |
2760 |
(rmail-show-message 1)) |
2761 |
|
2762 |
(defun rmail-last-message () |
2763 |
"Show last message in file." |
2764 |
(interactive) |
2765 |
(rmail-maybe-set-message-counters) |
2766 |
(rmail-show-message rmail-total-messages)) |
2767 |
|
2768 |
(defun rmail-what-message () |
2769 |
(let ((where (point)) |
2770 |
(low 1) |
2771 |
(high rmail-total-messages) |
2772 |
(mid (/ rmail-total-messages 2))) |
2773 |
(while (> (- high low) 1) |
2774 |
(if (>= where (rmail-msgbeg mid)) |
2775 |
(setq low mid) |
2776 |
(setq high mid)) |
2777 |
(setq mid (+ low (/ (- high low) 2)))) |
2778 |
(if (>= where (rmail-msgbeg high)) high low))) |
2779 |
|
2780 |
(defun rmail-message-recipients-p (msg recipients &optional primary-only) |
2781 |
(save-restriction |
2782 |
(goto-char (rmail-msgbeg msg)) |
2783 |
(search-forward "\n*** EOOH ***\n") |
2784 |
(narrow-to-region (point) (progn (search-forward "\n\n") (point))) |
2785 |
(or (string-match recipients (or (mail-fetch-field "To") "")) |
2786 |
(string-match recipients (or (mail-fetch-field "From") "")) |
2787 |
(if (not primary-only) |
2788 |
(string-match recipients (or (mail-fetch-field "Cc") "")))))) |
2789 |
|
2790 |
(defun rmail-message-regexp-p (n regexp) |
2791 |
"Return t, if for message number N, regexp REGEXP matches in the header." |
2792 |
(let ((beg (rmail-msgbeg n)) |
2793 |
(end (rmail-msgend n))) |
2794 |
(goto-char beg) |
2795 |
(forward-line 1) |
2796 |
(save-excursion |
2797 |
(save-restriction |
2798 |
(if (prog1 (= (following-char) ?0) |
2799 |
(forward-line 2) |
2800 |
;; If there's a Summary-line in the (otherwise empty) |
2801 |
;; header, we didn't yet get past the EOOH line. |
2802 |
(when (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") |
2803 |
(forward-line 1)) |
2804 |
(setq beg (point)) |
2805 |
(narrow-to-region (point) end)) |
2806 |
(progn |
2807 |
(rfc822-goto-eoh) |
2808 |
(setq end (point))) |
2809 |
(setq beg (point)) |
2810 |
(search-forward "\n*** EOOH ***\n" end t) |
2811 |
(setq end (1+ (match-beginning 0))))) |
2812 |
(goto-char beg) |
2813 |
(if rmail-enable-mime |
2814 |
(funcall rmail-search-mime-header-function n regexp end) |
2815 |
(re-search-forward regexp end t))))) |
2816 |
|
2817 |
(defun rmail-search-message (msg regexp) |
2818 |
"Return non-nil, if for message number MSG, regexp REGEXP matches." |
2819 |
(goto-char (rmail-msgbeg msg)) |
2820 |
(if rmail-enable-mime |
2821 |
(funcall rmail-search-mime-message-function msg regexp) |
2822 |
(re-search-forward regexp (rmail-msgend msg) t))) |
2823 |
|
2824 |
(defvar rmail-search-last-regexp nil) |
2825 |
(defun rmail-search (regexp &optional n) |
2826 |
"Show message containing next match for REGEXP (but not the current msg). |
2827 |
Prefix argument gives repeat count; negative argument means search |
2828 |
backwards (through earlier messages). |
2829 |
Interactively, empty argument means use same regexp used last time." |
2830 |
(interactive |
2831 |
(let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) |
2832 |
(prompt |
2833 |
(concat (if reversep "Reverse " "") "Rmail search (regexp): ")) |
2834 |
regexp) |
2835 |
(if rmail-search-last-regexp |
2836 |
(setq prompt (concat prompt |
2837 |
"(default " |
2838 |
rmail-search-last-regexp |
2839 |
") "))) |
2840 |
(setq regexp (read-string prompt)) |
2841 |
(cond ((not (equal regexp "")) |
2842 |
(setq rmail-search-last-regexp regexp)) |
2843 |
((not rmail-search-last-regexp) |
2844 |
(error "No previous Rmail search string"))) |
2845 |
(list rmail-search-last-regexp |
2846 |
(prefix-numeric-value current-prefix-arg)))) |
2847 |
(or n (setq n 1)) |
2848 |
(message "%sRmail search for %s..." |
2849 |
(if (< n 0) "Reverse " "") |
2850 |
regexp) |
2851 |
(set-buffer rmail-buffer) |
2852 |
(rmail-maybe-set-message-counters) |
2853 |
(let ((omin (point-min)) |
2854 |
(omax (point-max)) |
2855 |
(opoint (point)) |
2856 |
win |
2857 |
(reversep (< n 0)) |
2858 |
(msg rmail-current-message)) |
2859 |
(unwind-protect |
2860 |
(progn |
2861 |
(widen) |
2862 |
(while (/= n 0) |
2863 |
;; Check messages one by one, advancing message number up or down |
2864 |
;; but searching forward through each message. |
2865 |
(if reversep |
2866 |
(while (and (null win) (> msg 1)) |
2867 |
(setq msg (1- msg) |
2868 |
win (rmail-search-message msg regexp))) |
2869 |
(while (and (null win) (< msg rmail-total-messages)) |
2870 |
(setq msg (1+ msg) |
2871 |
win (rmail-search-message msg regexp)))) |
2872 |
(setq n (+ n (if reversep 1 -1))))) |
2873 |
(if win |
2874 |
(progn |
2875 |
(rmail-show-message msg) |
2876 |
;; Search forward (if this is a normal search) or backward |
2877 |
;; (if this is a reverse search) through this message to |
2878 |
;; position point. This search may fail because REGEXP |
2879 |
;; was found in the hidden portion of this message. In |
2880 |
;; that case, move point to the beginning of visible |
2881 |
;; portion. |
2882 |
(if reversep |
2883 |
(progn |
2884 |
(goto-char (point-max)) |
2885 |
(re-search-backward regexp nil 'move)) |
2886 |
(goto-char (point-min)) |
2887 |
(re-search-forward regexp nil t)) |
2888 |
(message "%sRmail search for %s...done" |
2889 |
(if reversep "Reverse " "") |
2890 |
regexp)) |
2891 |
(goto-char opoint) |
2892 |
(narrow-to-region omin omax) |
2893 |
(ding) |
2894 |
(message "Search failed: %s" regexp))))) |
2895 |
|
2896 |
(defun rmail-search-backwards (regexp &optional n) |
2897 |
"Show message containing previous match for REGEXP. |
2898 |
Prefix argument gives repeat count; negative argument means search |
2899 |
forward (through later messages). |
2900 |
Interactively, empty argument means use same regexp used last time." |
2901 |
(interactive |
2902 |
(let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0)) |
2903 |
(prompt |
2904 |
(concat (if reversep "Reverse " "") "Rmail search (regexp): ")) |
2905 |
regexp) |
2906 |
(if rmail-search-last-regexp |
2907 |
(setq prompt (concat prompt |
2908 |
"(default " |
2909 |
rmail-search-last-regexp |
2910 |
") "))) |
2911 |
(setq regexp (read-string prompt)) |
2912 |
(cond ((not (equal regexp "")) |
2913 |
(setq rmail-search-last-regexp regexp)) |
2914 |
((not rmail-search-last-regexp) |
2915 |
(error "No previous Rmail search string"))) |
2916 |
(list rmail-search-last-regexp |
2917 |
(prefix-numeric-value current-prefix-arg)))) |
2918 |
(rmail-search regexp (- (or n 1)))) |
2919 |
|
2920 |
;; Show the first message which has the `unseen' attribute. |
2921 |
(defun rmail-first-unseen-message () |
2922 |
(rmail-maybe-set-message-counters) |
2923 |
(let ((current 1) |
2924 |
found) |
2925 |
(save-restriction |
2926 |
(widen) |
2927 |
(while (and (not found) (<= current rmail-total-messages)) |
2928 |
(if (rmail-message-labels-p current ", ?\\(unseen\\),") |
2929 |
(setq found current)) |
2930 |
(setq current (1+ current)))) |
2931 |
;; Let the caller show the message. |
2932 |
;; (if found |
2933 |
;; (rmail-show-message found)) |
2934 |
found)) |
2935 |
|
2936 |
(defun rmail-next-same-subject (n) |
2937 |
"Go to the next mail message having the same subject header. |
2938 |
With prefix argument N, do this N times. |
2939 |
If N is negative, go backwards instead." |
2940 |
(interactive "p") |
2941 |
(let ((subject (mail-fetch-field "Subject")) |
2942 |
(forward (> n 0)) |
2943 |
(i rmail-current-message) |
2944 |
(case-fold-search t) |
2945 |
search-regexp found) |
2946 |
(if (string-match "\\`[ \t]+" subject) |
2947 |
(setq subject (substring subject (match-end 0)))) |
2948 |
(if (string-match "Re:[ \t]*" subject) |
2949 |
(setq subject (substring subject (match-end 0)))) |
2950 |
(if (string-match "[ \t]+\\'" subject) |
2951 |
(setq subject (substring subject 0 (match-beginning 0)))) |
2952 |
(setq search-regexp (concat "^Subject: *\\(Re:[ \t]*\\)?" |
2953 |
(regexp-quote subject) |
2954 |
"[ \t]*\n")) |
2955 |
(save-excursion |
2956 |
(save-restriction |
2957 |
(widen) |
2958 |
(while (and (/= n 0) |
2959 |
(if forward |
2960 |
(< i rmail-total-messages) |
2961 |
(> i 1))) |
2962 |
(let (done) |
2963 |
(while (and (not done) |
2964 |
(if forward |
2965 |
(< i rmail-total-messages) |
2966 |
(> i 1))) |
2967 |
(setq i (if forward (1+ i) (1- i))) |
2968 |
(goto-char (rmail-msgbeg i)) |
2969 |
(search-forward "\n*** EOOH ***\n") |
2970 |
(let ((beg (point)) end) |
2971 |
(search-forward "\n\n") |
2972 |
(setq end (point)) |
2973 |
(goto-char beg) |
2974 |
(setq done (re-search-forward search-regexp end t)))) |
2975 |
(if done (setq found i))) |
2976 |
(setq n (if forward (1- n) (1+ n)))))) |
2977 |
(if found |
2978 |
(rmail-show-message found) |
2979 |
(error "No %s message with same subject" |
2980 |
(if forward "following" "previous"))))) |
2981 |
|
2982 |
(defun rmail-previous-same-subject (n) |
2983 |
"Go to the previous mail message having the same subject header. |
2984 |
With prefix argument N, do this N times. |
2985 |
If N is negative, go forwards instead." |
2986 |
(interactive "p") |
2987 |
(rmail-next-same-subject (- n))) |
2988 |
|
2989 |
;;;; *** Rmail Message Deletion Commands *** |
2990 |
|
2991 |
(defun rmail-message-deleted-p (n) |
2992 |
(= (aref rmail-deleted-vector n) ?D)) |
2993 |
|
2994 |
(defun rmail-set-message-deleted-p (n state) |
2995 |
(aset rmail-deleted-vector n (if state ?D ?\ ))) |
2996 |
|
2997 |
(defun rmail-delete-message () |
2998 |
"Delete this message and stay on it." |
2999 |
(interactive) |
3000 |
(rmail-set-attribute "deleted" t) |
3001 |
(run-hooks 'rmail-delete-message-hook)) |
3002 |
|
3003 |
(defun rmail-undelete-previous-message () |
3004 |
"Back up to deleted message, select it, and undelete it." |
3005 |
(interactive) |
3006 |
(set-buffer rmail-buffer) |
3007 |
(let ((msg rmail-current-message)) |
3008 |
(while (and (> msg 0) |
3009 |
(not (rmail-message-deleted-p msg))) |
3010 |
(setq msg (1- msg))) |
3011 |
(if (= msg 0) |
3012 |
(error "No previous deleted message") |
3013 |
(if (/= msg rmail-current-message) |
3014 |
(rmail-show-message msg)) |
3015 |
(rmail-set-attribute "deleted" nil) |
3016 |
(if (rmail-summary-exists) |
3017 |
(save-excursion |
3018 |
(set-buffer rmail-summary-buffer) |
3019 |
(rmail-summary-mark-undeleted msg))) |
3020 |
(rmail-maybe-display-summary)))) |
3021 |
|
3022 |
(defun rmail-delete-forward (&optional backward) |
3023 |
"Delete this message and move to next nondeleted one. |
3024 |
Deleted messages stay in the file until the \\[rmail-expunge] command is given. |
3025 |
With prefix argument, delete and move backward. |
3026 |
|
3027 |
Returns t if a new message is displayed after the delete, or nil otherwise." |
3028 |
(interactive "P") |
3029 |
(rmail-set-attribute "deleted" t) |
3030 |
(run-hooks 'rmail-delete-message-hook) |
3031 |
(let ((del-msg rmail-current-message)) |
3032 |
(if (rmail-summary-exists) |
3033 |
(rmail-select-summary |
3034 |
(rmail-summary-mark-deleted del-msg))) |
3035 |
(prog1 (rmail-next-undeleted-message (if backward -1 1)) |
3036 |
(rmail-maybe-display-summary)))) |
3037 |
|
3038 |
(defun rmail-delete-backward () |
3039 |
"Delete this message and move to previous nondeleted one. |
3040 |
Deleted messages stay in the file until the \\[rmail-expunge] command is given." |
3041 |
(interactive) |
3042 |
(rmail-delete-forward t)) |
3043 |
|
3044 |
;; Compute the message number a given message would have after expunging. |
3045 |
;; The present number of the message is OLDNUM. |
3046 |
;; DELETEDVEC should be rmail-deleted-vector. |
3047 |
;; The value is nil for a message that would be deleted. |
3048 |
(defun rmail-msg-number-after-expunge (deletedvec oldnum) |
3049 |
(if (or (null oldnum) (= (aref deletedvec oldnum) ?D)) |
3050 |
nil |
3051 |
(let ((i 0) |
3052 |
(newnum 0)) |
3053 |
(while (< i oldnum) |
3054 |
(if (/= (aref deletedvec i) ?D) |
3055 |
(setq newnum (1+ newnum))) |
3056 |
(setq i (1+ i))) |
3057 |
newnum))) |
3058 |
|
3059 |
(defun rmail-expunge-confirmed () |
3060 |
"Return t if deleted message should be expunged. If necessary, ask the user. |
3061 |
See also user-option `rmail-confirm-expunge'." |
3062 |
(set-buffer rmail-buffer) |
3063 |
(or (not (stringp rmail-deleted-vector)) |
3064 |
(not (string-match "D" rmail-deleted-vector)) |
3065 |
(null rmail-confirm-expunge) |
3066 |
(funcall rmail-confirm-expunge |
3067 |
"Erase deleted messages from Rmail file? "))) |
3068 |
|
3069 |
(defun rmail-only-expunge (&optional dont-show) |
3070 |
"Actually erase all deleted messages in the file." |
3071 |
(interactive) |
3072 |
(set-buffer rmail-buffer) |
3073 |
(message "Expunging deleted messages...") |
3074 |
;; Discard all undo records for this buffer. |
3075 |
(or (eq buffer-undo-list t) |
3076 |
(setq buffer-undo-list nil)) |
3077 |
(rmail-maybe-set-message-counters) |
3078 |
(let* ((omax (- (buffer-size) (point-max))) |
3079 |
(omin (- (buffer-size) (point-min))) |
3080 |
(opoint (if (and (> rmail-current-message 0) |
3081 |
(rmail-message-deleted-p rmail-current-message)) |
3082 |
0 |
3083 |
(if rmail-enable-mime |
3084 |
(with-current-buffer rmail-view-buffer |
3085 |
(- (point)(point-min))) |
3086 |
(- (point) (point-min))))) |
3087 |
(messages-head (cons (aref rmail-message-vector 0) nil)) |
3088 |
(messages-tail messages-head) |
3089 |
;; Don't make any undo records for the expunging. |
3090 |
(buffer-undo-list t) |
3091 |
(win)) |
3092 |
(unwind-protect |
3093 |
(save-excursion |
3094 |
(widen) |
3095 |
(goto-char (point-min)) |
3096 |
(let ((counter 0) |
3097 |
(number 1) |
3098 |
(total rmail-total-messages) |
3099 |
(new-message-number rmail-current-message) |
3100 |
(new-summary nil) |
3101 |
(new-msgref (list (list 0))) |
3102 |
(rmailbuf (current-buffer)) |
3103 |
(buffer-read-only nil) |
3104 |
(messages rmail-message-vector) |
3105 |
(deleted rmail-deleted-vector) |
3106 |
(summary rmail-summary-vector)) |
3107 |
(setq rmail-total-messages nil |
3108 |
rmail-current-message nil |
3109 |
rmail-message-vector nil |
3110 |
rmail-deleted-vector nil |
3111 |
rmail-summary-vector nil) |
3112 |
|
3113 |
(while (<= number total) |
3114 |
(if (= (aref deleted number) ?D) |
3115 |
(progn |
3116 |
(delete-region |
3117 |
(marker-position (aref messages number)) |
3118 |
(marker-position (aref messages (1+ number)))) |
3119 |
(move-marker (aref messages number) nil) |
3120 |
(if (> new-message-number counter) |
3121 |
(setq new-message-number (1- new-message-number)))) |
3122 |
(setq counter (1+ counter)) |
3123 |
(setq messages-tail |
3124 |
(setcdr messages-tail |
3125 |
(cons (aref messages number) nil))) |
3126 |
(setq new-summary |
3127 |
(cons (if (= counter number) (aref summary (1- number))) |
3128 |
new-summary)) |
3129 |
(setq new-msgref |
3130 |
(cons (aref rmail-msgref-vector number) |
3131 |
new-msgref)) |
3132 |
(setcar (car new-msgref) counter)) |
3133 |
(if (zerop (% (setq number (1+ number)) 20)) |
3134 |
(message "Expunging deleted messages...%d" number))) |
3135 |
(setq messages-tail |
3136 |
(setcdr messages-tail |
3137 |
(cons (aref messages number) nil))) |
3138 |
(setq rmail-current-message new-message-number |
3139 |
rmail-total-messages counter |
3140 |
rmail-message-vector (apply 'vector messages-head) |
3141 |
rmail-deleted-vector (make-string (1+ counter) ?\ ) |
3142 |
rmail-summary-vector (vconcat (nreverse new-summary)) |
3143 |
rmail-msgref-vector (apply 'vector (nreverse new-msgref)) |
3144 |
win t))) |
3145 |
(message "Expunging deleted messages...done") |
3146 |
(if (not win) |
3147 |
(narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) |
3148 |
(if (not dont-show) |
3149 |
(rmail-show-message |
3150 |
(if (zerop rmail-current-message) 1 nil) |
3151 |
(if rmail-enable-mime |
3152 |
(goto-char (+ (point-min) opoint)) |
3153 |
(goto-char (+ (point) opoint)))))))) |
3154 |
|
3155 |
(defun rmail-expunge () |
3156 |
"Erase deleted messages from Rmail file and summary buffer." |
3157 |
(interactive) |
3158 |
(when (rmail-expunge-confirmed) |
3159 |
(rmail-only-expunge) |
3160 |
(if (rmail-summary-exists) |
3161 |
(rmail-select-summary (rmail-update-summary))))) |
3162 |
|
3163 |
;;;; *** Rmail Mailing Commands *** |
3164 |
|
3165 |
(defun rmail-start-mail (&optional noerase to subject in-reply-to cc |
3166 |
replybuffer sendactions same-window others) |
3167 |
(let (yank-action) |
3168 |
(if replybuffer |
3169 |
(setq yank-action (list 'insert-buffer replybuffer))) |
3170 |
(setq others (cons (cons "cc" cc) others)) |
3171 |
(setq others (cons (cons "in-reply-to" in-reply-to) others)) |
3172 |
(if same-window |
3173 |
(compose-mail to subject others |
3174 |
noerase nil |
3175 |
yank-action sendactions) |
3176 |
(if rmail-mail-new-frame |
3177 |
(prog1 |
3178 |
(compose-mail to subject others |
3179 |
noerase 'switch-to-buffer-other-frame |
3180 |
yank-action sendactions) |
3181 |
;; This is not a standard frame parameter; |
3182 |
;; nothing except sendmail.el looks at it. |
3183 |
(modify-frame-parameters (selected-frame) |
3184 |
'((mail-dedicated-frame . t)))) |
3185 |
(compose-mail to subject others |
3186 |
noerase 'switch-to-buffer-other-window |
3187 |
yank-action sendactions))))) |
3188 |
|
3189 |
(defun rmail-mail () |
3190 |
"Send mail in another window. |
3191 |
While composing the message, use \\[mail-yank-original] to yank the |
3192 |
original message into it." |
3193 |
(interactive) |
3194 |
(rmail-start-mail nil nil nil nil nil rmail-view-buffer)) |
3195 |
|
3196 |
(defun rmail-continue () |
3197 |
"Continue composing outgoing message previously being composed." |
3198 |
(interactive) |
3199 |
(rmail-start-mail t)) |
3200 |
|
3201 |
(defun rmail-reply (just-sender) |
3202 |
"Reply to the current message. |
3203 |
Normally include CC: to all other recipients of original message; |
3204 |
prefix argument means ignore them. While composing the reply, |
3205 |
use \\[mail-yank-original] to yank the original message into it." |
3206 |
(interactive "P") |
3207 |
(let (from reply-to cc subject date to message-id references |
3208 |
resent-to resent-cc resent-reply-to |
3209 |
(msgnum rmail-current-message)) |
3210 |
(save-excursion |
3211 |
(save-restriction |
3212 |
(if rmail-enable-mime |
3213 |
(narrow-to-region |
3214 |
(goto-char (point-min)) |
3215 |
(if (search-forward "\n\n" nil 'move) |
3216 |
(1+ (match-beginning 0)) |
3217 |
(point))) |
3218 |
(widen) |
3219 |
(goto-char (rmail-msgbeg rmail-current-message)) |
3220 |
(forward-line 1) |
3221 |
(if (= (following-char) ?0) |
3222 |
(narrow-to-region |
3223 |
(progn (forward-line 2) |
3224 |
(point)) |
3225 |
(progn (search-forward "\n\n" (rmail-msgend rmail-current-message) |
3226 |
'move) |
3227 |
(point))) |
3228 |
(narrow-to-region (point) |
3229 |
(progn (search-forward "\n*** EOOH ***\n") |
3230 |
(beginning-of-line) (point))))) |
3231 |
(setq from (mail-fetch-field "from") |
3232 |
reply-to (or (mail-fetch-field "reply-to" nil t) |
3233 |
from) |
3234 |
cc (and (not just-sender) |
3235 |
(mail-fetch-field "cc" nil t)) |
3236 |
subject (mail-fetch-field "subject") |
3237 |
date (mail-fetch-field "date") |
3238 |
to (or (mail-fetch-field "to" nil t) "") |
3239 |
message-id (mail-fetch-field "message-id") |
3240 |
references (mail-fetch-field "references" nil nil t) |
3241 |
resent-reply-to (mail-fetch-field "resent-reply-to" nil t) |
3242 |
resent-cc (and (not just-sender) |
3243 |
(mail-fetch-field "resent-cc" nil t)) |
3244 |
resent-to (or (mail-fetch-field "resent-to" nil t) "") |
3245 |
;;; resent-subject (mail-fetch-field "resent-subject") |
3246 |
;;; resent-date (mail-fetch-field "resent-date") |
3247 |
;;; resent-message-id (mail-fetch-field "resent-message-id") |
3248 |
))) |
3249 |
;; Merge the resent-to and resent-cc into the to and cc. |
3250 |
(if (and resent-to (not (equal resent-to ""))) |
3251 |
(if (not (equal to "")) |
3252 |
(setq to (concat to ", " resent-to)) |
3253 |
(setq to resent-to))) |
3254 |
(if (and resent-cc (not (equal resent-cc ""))) |
3255 |
(if (not (equal cc "")) |
3256 |
(setq cc (concat cc ", " resent-cc)) |
3257 |
(setq cc resent-cc))) |
3258 |
;; Add `Re: ' to subject if not there already. |
3259 |
(and (stringp subject) |
3260 |
(setq subject |
3261 |
(concat rmail-reply-prefix |
3262 |
(if (let ((case-fold-search t)) |
3263 |
(string-match rmail-reply-regexp subject)) |
3264 |
(substring subject (match-end 0)) |
3265 |
subject)))) |
3266 |
(rmail-start-mail |
3267 |
nil |
3268 |
;; Using mail-strip-quoted-names is undesirable with newer mailers |
3269 |
;; since they can handle the names unstripped. |
3270 |
;; I don't know whether there are other mailers that still |
3271 |
;; need the names to be stripped. |
3272 |
;;; (mail-strip-quoted-names reply-to) |
3273 |
reply-to |
3274 |
subject |
3275 |
(rmail-make-in-reply-to-field from date message-id) |
3276 |
(if just-sender |
3277 |
nil |
3278 |
;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to |
3279 |
;; to do its job. |
3280 |
(let* ((cc-list (rmail-dont-reply-to |
3281 |
(mail-strip-quoted-names |
3282 |
(if (null cc) to (concat to ", " cc)))))) |
3283 |
(if (string= cc-list "") nil cc-list))) |
3284 |
rmail-view-buffer |
3285 |
(list (list 'rmail-mark-message |
3286 |
rmail-buffer |
3287 |
(with-current-buffer rmail-buffer |
3288 |
(aref rmail-msgref-vector msgnum)) |
3289 |
"answered")) |
3290 |
nil |
3291 |
(list (cons "References" (concat (mapconcat 'identity references " ") |
3292 |
" " message-id)))))) |
3293 |
|
3294 |
(defun rmail-mark-message (buffer msgnum-list attribute) |
3295 |
"Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE. |
3296 |
This is use in the send-actions for message buffers. |
3297 |
MSGNUM-LIST is a list of the form (MSGNUM) |
3298 |
which is an element of rmail-msgref-vector." |
3299 |
(save-excursion |
3300 |
(set-buffer buffer) |
3301 |
(if (car msgnum-list) |
3302 |
(rmail-set-attribute attribute t (car msgnum-list))))) |
3303 |
|
3304 |
(defun rmail-make-in-reply-to-field (from date message-id) |
3305 |
(cond ((not from) |
3306 |
(if message-id |
3307 |
message-id |
3308 |
nil)) |
3309 |
(mail-use-rfc822 |
3310 |
(require 'rfc822) |
3311 |
(let ((tem (car (rfc822-addresses from)))) |
3312 |
(if message-id |
3313 |
(if (or (not tem) |
3314 |
(string-match |
3315 |
(regexp-quote (if (string-match "@[^@]*\\'" tem) |
3316 |
(substring tem 0 |
3317 |
(match-beginning 0)) |
3318 |
tem)) |
3319 |
message-id)) |
3320 |
;; missing From, or Message-ID is sufficiently informative |
3321 |
message-id |
3322 |
(concat message-id " (" tem ")")) |
3323 |
;; Copy TEM, discarding text properties. |
3324 |
(setq tem (copy-sequence tem)) |
3325 |
(set-text-properties 0 (length tem) nil tem) |
3326 |
(setq tem (copy-sequence tem)) |
3327 |
;; Use prin1 to fake RFC822 quoting |
3328 |
(let ((field (prin1-to-string tem))) |
3329 |
(if date |
3330 |
(concat field "'s message of " date) |
3331 |
field))))) |
3332 |
((let* ((foo "[^][\000-\037()<>@,;:\\\" ]+") |
3333 |
(bar "[^][\000-\037()<>@,;:\\\"]+")) |
3334 |
;; These strings both match all non-ASCII characters. |
3335 |
(or (string-match (concat "\\`[ \t]*\\(" bar |
3336 |
"\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'") |
3337 |
;; "Unix Loser <Foo@bar.edu>" => "Unix Loser" |
3338 |
from) |
3339 |
(string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\(" |
3340 |
bar "\\))[ \t]*\\'") |
3341 |
;; "<Bugs@bar.edu>" (Losing Unix) => "Losing Unix" |
3342 |
from))) |
3343 |
(let ((start (match-beginning 1)) |
3344 |
(end (match-end 1))) |
3345 |
;; Trim whitespace which above regexp match allows |
3346 |
(while (and (< start end) |
3347 |
(memq (aref from start) '(?\t ?\ ))) |
3348 |
(setq start (1+ start))) |
3349 |
(while (and (< start end) |
3350 |
(memq (aref from (1- end)) '(?\t ?\ ))) |
3351 |
(setq end (1- end))) |
3352 |
(let ((field (substring from start end))) |
3353 |
(if date (setq field (concat "message from " field " on " date))) |
3354 |
(if message-id |
3355 |
;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)" |
3356 |
(concat message-id " (" field ")") |
3357 |
field)))) |
3358 |
(t |
3359 |
;; If we can't kludge it simply, do it correctly |
3360 |
(let ((mail-use-rfc822 t)) |
3361 |
(rmail-make-in-reply-to-field from date message-id))))) |
3362 |
|
3363 |
(defun rmail-forward (resend) |
3364 |
"Forward the current message to another user. |
3365 |
With prefix argument, \"resend\" the message instead of forwarding it; |
3366 |
see the documentation of `rmail-resend'." |
3367 |
(interactive "P") |
3368 |
(if resend |
3369 |
(call-interactively 'rmail-resend) |
3370 |
(let ((forward-buffer rmail-buffer) |
3371 |
(msgnum rmail-current-message) |
3372 |
(subject (concat "[" |
3373 |
(let ((from (or (mail-fetch-field "From") |
3374 |
(mail-fetch-field ">From")))) |
3375 |
(if from |
3376 |
(concat (mail-strip-quoted-names from) ": ") |
3377 |
"")) |
3378 |
(or (mail-fetch-field "Subject") "") |
3379 |
"]"))) |
3380 |
(if (rmail-start-mail |
3381 |
nil nil subject nil nil nil |
3382 |
(list (list 'rmail-mark-message |
3383 |
forward-buffer |
3384 |
(with-current-buffer rmail-buffer |
3385 |
(aref rmail-msgref-vector msgnum)) |
3386 |
"forwarded")) |
3387 |
;; If only one window, use it for the mail buffer. |
3388 |
;; Otherwise, use another window for the mail buffer |
3389 |
;; so that the Rmail buffer remains visible |
3390 |
;; and sending the mail will get back to it. |
3391 |
(and (not rmail-mail-new-frame) (one-window-p t))) |
3392 |
;; The mail buffer is now current. |
3393 |
(save-excursion |
3394 |
;; Insert after header separator--before signature if any. |
3395 |
(goto-char (mail-text-start)) |
3396 |
(if (or rmail-enable-mime rmail-enable-mime-composing) |
3397 |
(funcall rmail-insert-mime-forwarded-message-function |
3398 |
forward-buffer) |
3399 |
(insert "------- Start of forwarded message -------\n") |
3400 |
;; Quote lines with `- ' if they start with `-'. |
3401 |
(let ((beg (point)) end) |
3402 |
(setq end (point-marker)) |
3403 |
(set-marker-insertion-type end t) |
3404 |
(insert-buffer-substring forward-buffer) |
3405 |
(goto-char beg) |
3406 |
(while (re-search-forward "^-" end t) |
3407 |
(beginning-of-line) |
3408 |
(insert "- ") |
3409 |
(forward-line 1)) |
3410 |
(goto-char end) |
3411 |
(skip-chars-backward "\n") |
3412 |
(if (< (point) end) |
3413 |
(forward-char 1)) |
3414 |
(delete-region (point) end) |
3415 |
(set-marker end nil)) |
3416 |
(insert "------- End of forwarded message -------\n")) |
3417 |
(push-mark)))))) |
3418 |
|
3419 |
(defun rmail-resend (address &optional from comment mail-alias-file) |
3420 |
"Resend current message to ADDRESSES. |
3421 |
ADDRESSES should be a single address, a string consisting of several |
3422 |
addresses separated by commas, or a list of addresses. |
3423 |
|
3424 |
Optional FROM is the address to resend the message from, and |
3425 |
defaults from the value of `user-mail-address'. |
3426 |
Optional COMMENT is a string to insert as a comment in the resent message. |
3427 |
Optional ALIAS-FILE is alternate aliases file to be used by sendmail, |
3428 |
typically for purposes of moderating a list." |
3429 |
(interactive "sResend to: ") |
3430 |
(require 'sendmail) |
3431 |
(require 'mailalias) |
3432 |
(unless (or (eq rmail-view-buffer (current-buffer)) |
3433 |
(eq rmail-buffer (current-buffer))) |
3434 |
(error "Not an Rmail buffer")) |
3435 |
(if (not from) (setq from user-mail-address)) |
3436 |
(let ((tembuf (generate-new-buffer " sendmail temp")) |
3437 |
(case-fold-search nil) |
3438 |
(mailbuf rmail-buffer)) |
3439 |
(unwind-protect |
3440 |
(with-current-buffer tembuf |
3441 |
;;>> Copy message into temp buffer |
3442 |
(if rmail-enable-mime |
3443 |
(funcall rmail-insert-mime-resent-message-function mailbuf) |
3444 |
(insert-buffer-substring mailbuf)) |
3445 |
(goto-char (point-min)) |
3446 |
;; Delete any Sender field, since that's not specifiable. |
3447 |
; Only delete Sender fields in the actual header. |
3448 |
(re-search-forward "^$" nil 'move) |
3449 |
; Using "while" here rather than "if" because some buggy mail |
3450 |
; software may have inserted multiple Sender fields. |
3451 |
(while (re-search-backward "^Sender:" nil t) |
3452 |
(let (beg) |
3453 |
(setq beg (point)) |
3454 |
(forward-line 1) |
3455 |
(while (looking-at "[ \t]") |
3456 |
(forward-line 1)) |
3457 |
(delete-region beg (point)))) |
3458 |
; Go back to the beginning of the buffer so the Resent- fields |
3459 |
; are inserted there. |
3460 |
(goto-char (point-min)) |
3461 |
;;>> Insert resent-from: |
3462 |
(insert "Resent-From: " from "\n") |
3463 |
(insert "Resent-Date: " (mail-rfc822-date) "\n") |
3464 |
;;>> Insert resent-to: and bcc if need be. |
3465 |
(let ((before (point))) |
3466 |
(if mail-self-blind |
3467 |
(insert "Resent-Bcc: " (user-login-name) "\n")) |
3468 |
(insert "Resent-To: " (if (stringp address) |
3469 |
address |
3470 |
(mapconcat 'identity address ",\n\t")) |
3471 |
"\n") |
3472 |
;; Expand abbrevs in the recipients. |
3473 |
(save-excursion |
3474 |
(if (featurep 'mailabbrev) |
3475 |
(let ((end (point-marker)) |
3476 |
(local-abbrev-table mail-abbrevs) |
3477 |
(old-syntax-table (syntax-table))) |
3478 |
(if (and (not (vectorp mail-abbrevs)) |
3479 |
(file-exists-p mail-personal-alias-file)) |
3480 |
(build-mail-abbrevs)) |
3481 |
(unless mail-abbrev-syntax-table |
3482 |
(mail-abbrev-make-syntax-table)) |
3483 |
(set-syntax-table mail-abbrev-syntax-table) |
3484 |
(goto-char before) |
3485 |
(while (and (< (point) end) |
3486 |
(progn (forward-word 1) |
3487 |
(<= (point) end))) |
3488 |
(expand-abbrev)) |
3489 |
(set-syntax-table old-syntax-table)) |
3490 |
(expand-mail-aliases before (point))))) |
3491 |
;;>> Set up comment, if any. |
3492 |
(if (and (sequencep comment) (not (zerop (length comment)))) |
3493 |
(let ((before (point)) |
3494 |
after) |
3495 |
(insert comment) |
3496 |
(or (eolp) (insert "\n")) |
3497 |
(setq after (point)) |
3498 |
(goto-char before) |
3499 |
(while (< (point) after) |
3500 |
(insert "Resent-Comment: ") |
3501 |
(forward-line 1)))) |
3502 |
;; Don't expand aliases in the destination fields |
3503 |
;; of the original message. |
3504 |
(let (mail-aliases) |
3505 |
(funcall send-mail-function))) |
3506 |
(kill-buffer tembuf)) |
3507 |
(with-current-buffer rmail-buffer |
3508 |
(rmail-set-attribute "resent" t rmail-current-message)))) |
3509 |
|
3510 |
(defvar mail-unsent-separator |
3511 |
(concat "^ *---+ +Unsent message follows +---+ *$\\|" |
3512 |
"^ *---+ +Returned message +---+ *$\\|" |
3513 |
"^ *---+ *Returned mail follows *---+ *$\\|" |
3514 |
"^Start of returned message$\\|" |
3515 |
"^---+ Below this line is a copy of the message.$\\|" |
3516 |
"^ *---+ +Original message +---+ *$\\|" |
3517 |
"^ *--+ +begin message +--+ *$\\|" |
3518 |
"^ *---+ +Original message follows +---+ *$\\|" |
3519 |
"^ *---+ +Your message follows +---+ *$\\|" |
3520 |
"^|? *---+ +Message text follows: +---+ *|?$\\|" |
3521 |
"^ *---+ +This is a copy of \\w+ message, including all the headers.*---+ *$") |
3522 |
"A regexp that matches the separator before the text of a failed message.") |
3523 |
|
3524 |
(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$" |
3525 |
"A regexp that matches the header of a MIME body part with a failed message.") |
3526 |
|
3527 |
(defun rmail-retry-failure () |
3528 |
"Edit a mail message which is based on the contents of the current message. |
3529 |
For a message rejected by the mail system, extract the interesting headers and |
3530 |
the body of the original message. |
3531 |
If the failed message is a MIME multipart message, it is searched for a |
3532 |
body part with a header which matches the variable `mail-mime-unsent-header'. |
3533 |
Otherwise, the variable `mail-unsent-separator' should match the string that |
3534 |
delimits the returned original message. |
3535 |
The variable `rmail-retry-ignored-headers' is a regular expression |
3536 |
specifying headers which should not be copied into the new message." |
3537 |
(interactive) |
3538 |
(require 'mail-utils) |
3539 |
(let ((rmail-this-buffer (current-buffer)) |
3540 |
(msgnum rmail-current-message) |
3541 |
bounce-start bounce-end bounce-indent resending |
3542 |
;; Fetch any content-type header in current message |
3543 |
;; Must search thru the whole unpruned header. |
3544 |
(content-type |
3545 |
(save-excursion |
3546 |
(save-restriction |
3547 |
(rmail-narrow-to-non-pruned-header) |
3548 |
(mail-fetch-field "Content-Type") )))) |
3549 |
(save-excursion |
3550 |
(goto-char (point-min)) |
3551 |
(let ((case-fold-search t)) |
3552 |
(if (and content-type |
3553 |
(string-match |
3554 |
";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?" |
3555 |
content-type)) |
3556 |
;; Handle a MIME multipart bounce message. |
3557 |
(let ((codestring |
3558 |
(concat "\n--" |
3559 |
(substring content-type (match-beginning 1) |
3560 |
(match-end 1))))) |
3561 |
(unless (re-search-forward mail-mime-unsent-header nil t) |
3562 |
(error "Cannot find beginning of header in failed message")) |
3563 |
(unless (search-forward "\n\n" nil t) |
3564 |
(error "Cannot find start of Mime data in failed message")) |
3565 |
(setq bounce-start (point)) |
3566 |
(if (search-forward codestring nil t) |
3567 |
(setq bounce-end (match-beginning 0)) |
3568 |
(setq bounce-end (point-max)))) |
3569 |
;; Non-MIME bounce. |
3570 |
(or (re-search-forward mail-unsent-separator nil t) |
3571 |
(error "Cannot parse this as a failure message")) |
3572 |
(skip-chars-forward "\n") |
3573 |
;; Support a style of failure message in which the original |
3574 |
;; message is indented, and included within lines saying |
3575 |
;; `Start of returned message' and `End of returned message'. |
3576 |
(if (looking-at " +Received:") |
3577 |
(progn |
3578 |
(setq bounce-start (point)) |
3579 |
(skip-chars-forward " ") |
3580 |
(setq bounce-indent (- (current-column))) |
3581 |
(goto-char (point-max)) |
3582 |
(re-search-backward "^End of returned message$" nil t) |
3583 |
(setq bounce-end (point))) |
3584 |
;; One message contained a few random lines before |
3585 |
;; the old message header. The first line of the |
3586 |
;; message started with two hyphens. A blank line |
3587 |
;; followed these random lines. The same line |
3588 |
;; beginning with two hyphens was possibly marking |
3589 |
;; the end of the message. |
3590 |
(if (looking-at "^--") |
3591 |
(let ((boundary (buffer-substring-no-properties |
3592 |
(point) |
3593 |
(progn (end-of-line) (point))))) |
3594 |
(search-forward "\n\n") |
3595 |
(skip-chars-forward "\n") |
3596 |
(setq bounce-start (point)) |
3597 |
(goto-char (point-max)) |
3598 |
(search-backward (concat "\n\n" boundary) bounce-start t) |
3599 |
(setq bounce-end (point))) |
3600 |
(setq bounce-start (point) |
3601 |
bounce-end (point-max))) |
3602 |
(unless (search-forward "\n\n" nil t) |
3603 |
(error "Cannot find end of header in failed message")))))) |
3604 |
;; We have found the message that bounced, within the current message. |
3605 |
;; Now start sending new message; default header fields from original. |
3606 |
;; Turn off the usual actions for initializing the message body |
3607 |
;; because we want to get only the text from the failure message. |
3608 |
(let (mail-signature mail-setup-hook) |
3609 |
(if (rmail-start-mail nil nil nil nil nil rmail-this-buffer |
3610 |
(list (list 'rmail-mark-message |
3611 |
rmail-this-buffer |
3612 |
(aref rmail-msgref-vector msgnum) |
3613 |
"retried"))) |
3614 |
;; Insert original text as initial text of new draft message. |
3615 |
;; Bind inhibit-read-only since the header delimiter |
3616 |
;; of the previous message was probably read-only. |
3617 |
(let ((inhibit-read-only t) |
3618 |
rmail-displayed-headers |
3619 |
rmail-ignored-headers) |
3620 |
(erase-buffer) |
3621 |
(insert-buffer-substring rmail-this-buffer |
3622 |
bounce-start bounce-end) |
3623 |
(goto-char (point-min)) |
3624 |
(if bounce-indent |
3625 |
(indent-rigidly (point-min) (point-max) bounce-indent)) |
3626 |
(rmail-clear-headers rmail-retry-ignored-headers) |
3627 |
(rmail-clear-headers "^sender:\\|^return-path:\\|^received:") |
3628 |
(mail-sendmail-delimit-header) |
3629 |
(save-restriction |
3630 |
(narrow-to-region (point-min) (mail-header-end)) |
3631 |
(setq resending (mail-fetch-field "resent-to")) |
3632 |
(if mail-self-blind |
3633 |
(if resending |
3634 |
(insert "Resent-Bcc: " (user-login-name) "\n") |
3635 |
(insert "BCC: " (user-login-name) "\n")))) |
3636 |
(goto-char (point-min)) |
3637 |
(mail-position-on-field (if resending "Resent-To" "To") t)))))) |
3638 |
|
3639 |
(defun rmail-summary-exists () |
3640 |
"Non-nil iff in an RMAIL buffer and an associated summary buffer exists. |
3641 |
In fact, the non-nil value returned is the summary buffer itself." |
3642 |
(and rmail-summary-buffer (buffer-name rmail-summary-buffer) |
3643 |
rmail-summary-buffer)) |
3644 |
|
3645 |
(defun rmail-summary-displayed () |
3646 |
"t iff in RMAIL buffer and an associated summary buffer is displayed." |
3647 |
(and rmail-summary-buffer (get-buffer-window rmail-summary-buffer))) |
3648 |
|
3649 |
(defcustom rmail-redisplay-summary nil |
3650 |
"*Non-nil means Rmail should show the summary when it changes. |
3651 |
This has an effect only if a summary buffer exists." |
3652 |
:type 'boolean |
3653 |
:group 'rmail-summary) |
3654 |
|
3655 |
(defcustom rmail-summary-window-size nil |
3656 |
"*Non-nil means specify the height for an Rmail summary window." |
3657 |
:type '(choice (const :tag "Disabled" nil) integer) |
3658 |
:group 'rmail-summary) |
3659 |
|
3660 |
;; Put the summary buffer back on the screen, if user wants that. |
3661 |
(defun rmail-maybe-display-summary () |
3662 |
(let ((selected (selected-window)) |
3663 |
window) |
3664 |
;; If requested, make sure the summary is displayed. |
3665 |
(and rmail-summary-buffer (buffer-name rmail-summary-buffer) |
3666 |
rmail-redisplay-summary |
3667 |
(if (get-buffer-window rmail-summary-buffer 0) |
3668 |
;; It's already in some frame; show that one. |
3669 |
(let ((frame (window-frame |
3670 |
(get-buffer-window rmail-summary-buffer 0)))) |
3671 |
(make-frame-visible frame) |
3672 |
(raise-frame frame)) |
3673 |
(display-buffer rmail-summary-buffer))) |
3674 |
;; If requested, set the height of the summary window. |
3675 |
(and rmail-summary-buffer (buffer-name rmail-summary-buffer) |
3676 |
rmail-summary-window-size |
3677 |
(setq window (get-buffer-window rmail-summary-buffer)) |
3678 |
;; Don't try to change the size if just one window in frame. |
3679 |
(not (eq window (frame-root-window (window-frame window)))) |
3680 |
(unwind-protect |
3681 |
(progn |
3682 |
(select-window window) |
3683 |
(enlarge-window (- rmail-summary-window-size (window-height)))) |
3684 |
(select-window selected))))) |
3685 |
|
3686 |
;;;; *** Rmail Local Fontification *** |
3687 |
|
3688 |
(defun rmail-fontify-buffer-function () |
3689 |
;; This function's symbol is bound to font-lock-fontify-buffer-function. |
3690 |
(add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t) |
3691 |
;; If we're already showing a message, fontify it now. |
3692 |
(if rmail-current-message (rmail-fontify-message)) |
3693 |
;; Prevent Font Lock mode from kicking in. |
3694 |
(setq font-lock-fontified t)) |
3695 |
|
3696 |
(defun rmail-unfontify-buffer-function () |
3697 |
;; This function's symbol is bound to font-lock-fontify-unbuffer-function. |
3698 |
(let ((modified (buffer-modified-p)) |
3699 |
(buffer-undo-list t) (inhibit-read-only t) |
3700 |
before-change-functions after-change-functions |
3701 |
buffer-file-name buffer-file-truename) |
3702 |
(save-restriction |
3703 |
(widen) |
3704 |
(remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) |
3705 |
(remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) |
3706 |
(font-lock-default-unfontify-buffer) |
3707 |
(and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) |
3708 |
|
3709 |
(defun rmail-fontify-message () |
3710 |
;; Fontify the current message if it is not already fontified. |
3711 |
(if (text-property-any (point-min) (point-max) 'rmail-fontified nil) |
3712 |
(let ((modified (buffer-modified-p)) |
3713 |
(buffer-undo-list t) (inhibit-read-only t) |
3714 |
before-change-functions after-change-functions |
3715 |
buffer-file-name buffer-file-truename) |
3716 |
(save-excursion |
3717 |
(save-match-data |
3718 |
(add-text-properties (point-min) (point-max) '(rmail-fontified t)) |
3719 |
(font-lock-fontify-region (point-min) (point-max)) |
3720 |
(and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))))) |
3721 |
|
3722 |
;;; Speedbar support for RMAIL files. |
3723 |
(eval-when-compile (require 'speedbar)) |
3724 |
|
3725 |
(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$" |
3726 |
"*This regex is used to match folder names to be displayed in speedbar. |
3727 |
Enabling this will permit speedbar to display your folders for easy |
3728 |
browsing, and moving of messages.") |
3729 |
|
3730 |
(defvar rmail-speedbar-last-user nil |
3731 |
"The last user to be displayed in the speedbar.") |
3732 |
|
3733 |
(defvar rmail-speedbar-key-map nil |
3734 |
"Keymap used when in rmail display mode.") |
3735 |
|
3736 |
(defun rmail-install-speedbar-variables () |
3737 |
"Install those variables used by speedbar to enhance rmail." |
3738 |
(if rmail-speedbar-key-map |
3739 |
nil |
3740 |
(setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) |
3741 |
|
3742 |
(define-key rmail-speedbar-key-map "e" 'speedbar-edit-line) |
3743 |
(define-key rmail-speedbar-key-map "r" 'speedbar-edit-line) |
3744 |
(define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line) |
3745 |
(define-key rmail-speedbar-key-map "M" |
3746 |
'rmail-speedbar-move-message-to-folder-on-line))) |
3747 |
|
3748 |
(defvar rmail-speedbar-menu-items |
3749 |
'(["Read Folder" speedbar-edit-line t] |
3750 |
["Move message to folder" rmail-speedbar-move-message-to-folder-on-line |
3751 |
(save-excursion (beginning-of-line) |
3752 |
(looking-at "<M> "))]) |
3753 |
"Additional menu-items to add to speedbar frame.") |
3754 |
|
3755 |
;; Make sure our special speedbar major mode is loaded |
3756 |
(if (featurep 'speedbar) |
3757 |
(rmail-install-speedbar-variables) |
3758 |
(add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables)) |
3759 |
|
3760 |
(defun rmail-speedbar-buttons (buffer) |
3761 |
"Create buttons for BUFFER containing rmail messages. |
3762 |
Click on the address under Reply to: to reply to this person. |
3763 |
Under Folders: Click a name to read it, or on the <M> to move the |
3764 |
current message into that RMAIL folder." |
3765 |
(let ((from nil)) |
3766 |
(save-excursion |
3767 |
(set-buffer buffer) |
3768 |
(goto-char (point-min)) |
3769 |
(if (not (re-search-forward "^Reply-To: " nil t)) |
3770 |
(if (not (re-search-forward "^From:? " nil t)) |
3771 |
(setq from t))) |
3772 |
(if from |
3773 |
nil |
3774 |
(setq from (buffer-substring (point) (save-excursion |
3775 |
(end-of-line) |
3776 |
(point)))))) |
3777 |
(goto-char (point-min)) |
3778 |
(if (and (looking-at "Reply to:") |
3779 |
(equal from rmail-speedbar-last-user)) |
3780 |
nil |
3781 |
(setq rmail-speedbar-last-user from) |
3782 |
(erase-buffer) |
3783 |
(insert "Reply To:\n") |
3784 |
(if (stringp from) |
3785 |
(speedbar-insert-button from 'speedbar-directory-face 'highlight |
3786 |
'rmail-speedbar-button 'rmail-reply)) |
3787 |
(insert "Folders:\n") |
3788 |
(let* ((case-fold-search nil) |
3789 |
(df (directory-files (save-excursion (set-buffer buffer) |
3790 |
default-directory) |
3791 |
nil rmail-speedbar-match-folder-regexp))) |
3792 |
(while df |
3793 |
(speedbar-insert-button "<M>" 'speedbar-button-face 'highlight |
3794 |
'rmail-speedbar-move-message (car df)) |
3795 |
(speedbar-insert-button (car df) 'speedbar-file-face 'highlight |
3796 |
'rmail-speedbar-find-file nil t) |
3797 |
(setq df (cdr df))))))) |
3798 |
|
3799 |
(defun rmail-speedbar-button (text token indent) |
3800 |
"Execute an rmail command specified by TEXT. |
3801 |
The command used is TOKEN. INDENT is not used." |
3802 |
(speedbar-with-attached-buffer |
3803 |
(funcall token t))) |
3804 |
|
3805 |
(defun rmail-speedbar-find-file (text token indent) |
3806 |
"Load in the rmail file TEXT. |
3807 |
TOKEN and INDENT are not used." |
3808 |
(speedbar-with-attached-buffer |
3809 |
(message "Loading in RMAIL file %s..." text) |
3810 |
(find-file text))) |
3811 |
|
3812 |
(defun rmail-speedbar-move-message-to-folder-on-line () |
3813 |
"If the current line is a folder, move current message to it." |
3814 |
(interactive) |
3815 |
(save-excursion |
3816 |
(beginning-of-line) |
3817 |
(if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t) |
3818 |
(progn |
3819 |
(forward-char -2) |
3820 |
(speedbar-do-function-pointer))))) |
3821 |
|
3822 |
(defun rmail-speedbar-move-message (text token indent) |
3823 |
"From button TEXT, copy current message to the rmail file specified by TOKEN. |
3824 |
TEXT and INDENT are not used." |
3825 |
(speedbar-with-attached-buffer |
3826 |
(message "Moving message to %s" token) |
3827 |
(rmail-output-to-rmail-file token))) |
3828 |
|
3829 |
; Functions for setting, getting and encoding the POP password. |
3830 |
; The password is encoded to prevent it from being easily accessible |
3831 |
; to "prying eyes." Obviously, this encoding isn't "real security," |
3832 |
; nor is it meant to be. |
3833 |
|
3834 |
;;;###autoload |
3835 |
(defun rmail-set-pop-password (password) |
3836 |
"Set PASSWORD to be used for retrieving mail from a POP server." |
3837 |
(interactive "sPassword: ") |
3838 |
(if password |
3839 |
(setq rmail-encoded-pop-password |
3840 |
(rmail-encode-string password (emacs-pid))) |
3841 |
(setq rmail-pop-password nil) |
3842 |
(setq rmail-encoded-pop-password nil))) |
3843 |
|
3844 |
(defun rmail-get-pop-password () |
3845 |
"Get the password for retrieving mail from a POP server. If none |
3846 |
has been set, then prompt the user for one." |
3847 |
(if (not rmail-encoded-pop-password) |
3848 |
(progn (if (not rmail-pop-password) |
3849 |
(setq rmail-pop-password (read-passwd "POP password: "))) |
3850 |
(rmail-set-pop-password rmail-pop-password) |
3851 |
(setq rmail-pop-password nil))) |
3852 |
(rmail-encode-string rmail-encoded-pop-password (emacs-pid))) |
3853 |
|
3854 |
(defun rmail-have-password () |
3855 |
(or rmail-pop-password rmail-encoded-pop-password)) |
3856 |
|
3857 |
(defun rmail-encode-string (string mask) |
3858 |
"Encode STRING with integer MASK, by taking the exclusive OR of the |
3859 |
lowest byte in the mask with the first character of string, the |
3860 |
second-lowest-byte with the second character of the string, etc., |
3861 |
restarting at the lowest byte of the mask whenever it runs out. |
3862 |
Returns the encoded string. Calling the function again with an |
3863 |
encoded string (and the same mask) will decode the string." |
3864 |
(setq mask (abs mask)) ; doesn't work if negative |
3865 |
(let* ((string-vector (string-to-vector string)) (i 0) |
3866 |
(len (length string-vector)) (curmask mask) charmask) |
3867 |
(while (< i len) |
3868 |
(if (= curmask 0) |
3869 |
(setq curmask mask)) |
3870 |
(setq charmask (% curmask 256)) |
3871 |
(setq curmask (lsh curmask -8)) |
3872 |
(aset string-vector i (logxor charmask (aref string-vector i))) |
3873 |
(setq i (1+ i))) |
3874 |
(concat string-vector))) |
3875 |
|
3876 |
;;;; Desktop support |
3877 |
|
3878 |
;;;###autoload |
3879 |
(defun rmail-restore-desktop-buffer (desktop-buffer-file-name |
3880 |
desktop-buffer-name |
3881 |
desktop-buffer-misc) |
3882 |
"Restore an rmail buffer specified in a desktop file." |
3883 |
(condition-case error |
3884 |
(progn |
3885 |
(rmail-input desktop-buffer-file-name) |
3886 |
(if (eq major-mode 'rmail-mode) |
3887 |
(current-buffer) |
3888 |
rmail-buffer)) |
3889 |
(file-locked |
3890 |
(kill-buffer (current-buffer)) |
3891 |
nil))) |
3892 |
|
3893 |
(provide 'rmail) |
3894 |
|
3895 |
;;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c |
3896 |
;;; rmail.el ends here |