comparison lisp/nnmail.el @ 15511:530d0d516a42

New version.
author Lars Magne Ingebrigtsen <larsi@gnus.org>
date Tue, 25 Jun 1996 22:21:39 +0000
parents 1e407d249337
children 8d8bf85d356a
comparison
equal deleted inserted replaced
15510:db0f45c7f885 15511:530d0d516a42
1 ;;; nnmail.el --- mail support functions for the Gnus mail backends 1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
2 2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 3
5 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news, mail 5 ;; Keywords: news, mail
7 6
8 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
25 ;;; Commentary: 24 ;;; Commentary:
26 25
27 ;;; Code: 26 ;;; Code:
28 27
29 (require 'nnheader) 28 (require 'nnheader)
30 (require 'rmail)
31 (require 'timezone) 29 (require 'timezone)
32 (require 'sendmail) 30 (require 'message)
31 (eval-when-compile (require 'cl))
33 32
34 (defvar nnmail-split-methods 33 (defvar nnmail-split-methods
35 '(("mail.misc" "")) 34 '(("mail.misc" ""))
36 "*Incoming mail will be split according to this variable. 35 "*Incoming mail will be split according to this variable.
37 36
64 "*If non-nil, do crossposting if several split methods match the mail. 63 "*If non-nil, do crossposting if several split methods match the mail.
65 If nil, the first match found will be used.") 64 If nil, the first match found will be used.")
66 65
67 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). 66 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
68 (defvar nnmail-keep-last-article nil 67 (defvar nnmail-keep-last-article nil
69 "*If non-nil, nnmail will never delete the last expired article in a 68 "*If non-nil, nnmail will never delete the last expired article in a directory.
70 directory. You may need to set this variable if other programs are putting 69 You may need to set this variable if other programs are putting
71 new mail into folder numbers that Gnus has marked as expired.") 70 new mail into folder numbers that Gnus has marked as expired.")
72 71
72 (defvar nnmail-use-long-file-names nil
73 "*If non-nil the mail backends will use long file and directory names.
74 If nil, groups like \"mail.misc\" will end up in directories like
75 \"mail/misc/\".")
76
73 (defvar nnmail-expiry-wait 7 77 (defvar nnmail-expiry-wait 7
74 "*Articles that are older than `nnmail-expiry-wait' days will be expired.") 78 "*Expirable articles that are older than this will be expired.
79 This variable can either be a number (which will be interpreted as a
80 number of days) -- this doesn't have to be an integer. This variable
81 can also be `immediate' and `never'.")
75 82
76 (defvar nnmail-expiry-wait-function nil 83 (defvar nnmail-expiry-wait-function nil
77 "*Variable that holds function to specify how old articles should be before they are expired. 84 "*Variable that holds function to specify how old articles should be before they are expired.
78 The function will be called with the name of the group that the 85 The function will be called with the name of the group that the
79 expiry is to be performed in, and it should return an integer that 86 expiry is to be performed in, and it should return an integer that
80 says how many days an article can be stored before it is considered 87 says how many days an article can be stored before it is considered
81 'old'. 88 \"old\". It can also return the values `never' and `immediate'.
82 89
83 Eg.: 90 Eg.:
84 91
85 (setq nnmail-expiry-wait-function 92 (setq nnmail-expiry-wait-function
86 (lambda (newsgroup) 93 (lambda (newsgroup)
87 (cond ((string-match \"private\" newsgroup) 31) 94 (cond ((string-match \"private\" newsgroup) 31)
88 ((string-match \"junk\" newsgroup) 1) 95 ((string-match \"junk\" newsgroup) 1)
96 ((string-match \"important\" newsgroup) 'never)
89 (t 7))))") 97 (t 7))))")
90 98
91 (defvar nnmail-spool-file 99 (defvar nnmail-spool-file
92 (or (getenv "MAIL") 100 (or (getenv "MAIL")
93 (concat "/usr/spool/mail/" (user-login-name))) 101 (concat "/usr/spool/mail/" (user-login-name)))
95 This variable is \"/usr/spool/mail/$user\" by default. 103 This variable is \"/usr/spool/mail/$user\" by default.
96 If this variable is nil, no mail backends will read incoming mail. 104 If this variable is nil, no mail backends will read incoming mail.
97 If this variable is a list, all files mentioned in this list will be 105 If this variable is a list, all files mentioned in this list will be
98 used as incoming mailboxes.") 106 used as incoming mailboxes.")
99 107
108 (defvar nnmail-crash-box "~/.gnus-crash-box"
109 "*File where Gnus will store mail while processing it.")
110
100 (defvar nnmail-use-procmail nil 111 (defvar nnmail-use-procmail nil
101 "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. 112 "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
102 The file(s) in `nnmail-spool-file' will also be read.") 113 The file(s) in `nnmail-spool-file' will also be read.")
103 114
104 (defvar nnmail-procmail-directory "~/incoming/" 115 (defvar nnmail-procmail-directory "~/incoming/"
105 "*When using procmail (and the like), incoming mail is put in this directory. 116 "*When using procmail (and the like), incoming mail is put in this directory.
106 The Gnus mail backends will read the mail from this directory.") 117 The Gnus mail backends will read the mail from this directory.")
107 118
108 (defvar nnmail-procmail-suffix ".spool" 119 (defvar nnmail-procmail-suffix "\\.spool"
109 "*Suffix of files created by procmail (and the like). 120 "*Suffix of files created by procmail (and the like).
110 This variable might be a suffix-regexp to match the suffixes of 121 This variable might be a suffix-regexp to match the suffixes of
111 several files - eg. \".spool[0-9]*\".") 122 several files - eg. \".spool[0-9]*\".")
112 123
113 (defvar nnmail-resplit-incoming nil 124 (defvar nnmail-resplit-incoming nil
114 "*If non-nil, re-split incoming procmail sorted mail.") 125 "*If non-nil, re-split incoming procmail sorted mail.")
115 126
127 (defvar nnmail-delete-file-function 'delete-file
128 "Function called to delete files in some mail backends.")
129
130 (defvar nnmail-crosspost-link-function 'add-name-to-file
131 "Function called to create a copy of a file.
132 This is `add-name-to-file' by default, which means that crossposts
133 will use hard links. If your file system doesn't allow hard
134 links, you could set this variable to `copy-file' instead.")
135
116 (defvar nnmail-movemail-program "movemail" 136 (defvar nnmail-movemail-program "movemail"
117 "*A command to be executed to move mail from the inbox. 137 "*A command to be executed to move mail from the inbox.
118 The default is \"movemail\".") 138 The default is \"movemail\".")
139
140 (defvar nnmail-pop-password-required nil
141 "*Non-nil if a password is required when reading mail using POP.")
119 142
120 (defvar nnmail-read-incoming-hook nil 143 (defvar nnmail-read-incoming-hook nil
121 "*Hook that will be run after the incoming mail has been transferred. 144 "*Hook that will be run after the incoming mail has been transferred.
122 The incoming mail is moved from `nnmail-spool-file' (which normally is 145 The incoming mail is moved from `nnmail-spool-file' (which normally is
123 something like \"/usr/spool/mail/$user\") to the user's home 146 something like \"/usr/spool/mail/$user\") to the user's home
125 emptied, and can be used to call any mail box programs you have 148 emptied, and can be used to call any mail box programs you have
126 running (\"xwatch\", etc.) 149 running (\"xwatch\", etc.)
127 150
128 Eg. 151 Eg.
129 152
130 (add-hook 'nnmail-read-incoming-hook 153 \(add-hook 'nnmail-read-incoming-hook
131 (lambda () 154 (lambda ()
132 (start-process \"mailsend\" nil 155 (start-process \"mailsend\" nil
133 \"/local/bin/mailsend\" \"read\" \"mbox\")))") 156 \"/local/bin/mailsend\" \"read\" \"mbox\")))
157
158 If you have xwatch running, this will alert it that mail has been
159 read.
160
161 If you use `display-time', you could use something like this:
162
163 \(add-hook 'nnmail-read-incoming-hook
164 (lambda ()
165 ;; Update the displayed time, since that will clear out
166 ;; the flag that says you have mail.
167 (if (eq (process-status \"display-time\") 'run)
168 (display-time-filter display-time-process \"\"))))")
169
170 (when (eq system-type 'windows-nt)
171 (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr))
134 172
135 ;; Suggested by Erik Selberg <speed@cs.washington.edu>. 173 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
136 (defvar nnmail-prepare-incoming-hook nil 174 (defvar nnmail-prepare-incoming-hook nil
137 "*Hook called before treating incoming mail. 175 "*Hook called before treating incoming mail.
138 The hook is run in a buffer with all the new, incoming mail.") 176 The hook is run in a buffer with all the new, incoming mail.")
139 177
178 (defvar nnmail-pre-get-new-mail-hook nil
179 "Hook called just before starting to handle new incoming mail.")
180
181 (defvar nnmail-post-get-new-mail-hook nil
182 "Hook called just after finishing handling new incoming mail.")
183
140 ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>. 184 ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
141 (defvar nnmail-tmp-directory nil 185 (defvar nnmail-tmp-directory nil
142 "*If non-nil, use this directory for temporary storage when reading incoming mail.") 186 "*If non-nil, use this directory for temporary storage when reading incoming mail.")
143 187
144 (defvar nnmail-large-newsgroup 50 188 (defvar nnmail-large-newsgroup 50
163 message to be stored in one or more groups. 207 message to be stored in one or more groups.
164 208
165 \(& SPLIT...): Process each SPLIT expression. 209 \(& SPLIT...): Process each SPLIT expression.
166 210
167 FIELD must match a complete field name. VALUE must match a complete 211 FIELD must match a complete field name. VALUE must match a complete
168 word according to the fundamental mode syntax table. You can use .* 212 word according to the `nnmail-split-fancy-syntax-table' syntax table.
169 in the regexps to match partial field names or words. 213 You can use .* in the regexps to match partial field names or words.
170 214
171 FIELD and VALUE can also be lisp symbols, in that case they are expanded 215 FIELD and VALUE can also be lisp symbols, in that case they are expanded
172 as specified in `nnmail-split-abbrev-alist'. 216 as specified in `nnmail-split-abbrev-alist'.
173 217
174 Example: 218 Example:
207 performed.") 251 performed.")
208 252
209 (defvar nnmail-message-id-cache-file "~/.nnmail-cache" 253 (defvar nnmail-message-id-cache-file "~/.nnmail-cache"
210 "*The file name of the nnmail Message-ID cache.") 254 "*The file name of the nnmail Message-ID cache.")
211 255
212 (defvar nnmail-delete-duplicates nil 256 (defvar nnmail-treat-duplicates 'warn
213 "*If non-nil, nnmail will delete any duplicate mails it sees.") 257 "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
258 Three values are legal: nil, which means that nnmail is not to keep a
259 Message-ID cache; `warn', which means that nnmail should insert extra
260 headers to warn the user about the duplication (this is the default);
261 and `delete', which means that nnmail will delete duplicated mails.
262
263 This variable can also be a function. It will be called from a buffer
264 narrowed to the article in question with the Message-ID as a
265 parameter. It should return nil, `warn' or `delete'.")
266
267 ;;; Internal variables.
268
269 (defvar nnmail-pop-password nil
270 "*Password to use when reading mail from a POP server, if required.")
271
272 (defvar nnmail-split-fancy-syntax-table
273 (copy-syntax-table (standard-syntax-table))
274 "Syntax table used by `nnmail-split-fancy'.")
275
276 (defvar nnmail-prepare-save-mail-hook nil
277 "Hook called before saving mail.")
278
279 (defvar nnmail-moved-inboxes nil
280 "List of inboxes that have been moved.")
281
282 (defvar nnmail-internal-password nil)
214 283
215 284
216 285
217 (defconst nnmail-version "nnmail 1.0" 286 (defconst nnmail-version "nnmail 1.0"
218 "nnmail version.") 287 "nnmail version.")
219 288
220 289
221 290
222 (defun nnmail-request-post (&optional server) 291 (defun nnmail-request-post (&optional server)
223 (mail-send-and-exit nil)) 292 (mail-send-and-exit nil))
224
225 (defun nnmail-request-post-buffer (post group subject header article-buffer
226 info follow-to respect-poster)
227 (let ((method-address (cdr (assq 'to-address (nth 5 info))))
228 from date to reply-to message-of
229 references message-id cc new-cc sendto elt)
230 (setq method-address
231 (if (and (stringp method-address)
232 (string= method-address ""))
233 nil method-address))
234 (save-excursion
235 (set-buffer (get-buffer-create "*mail*"))
236 (mail-mode)
237 (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
238 (if (and (buffer-modified-p)
239 (> (buffer-size) 0)
240 (not (y-or-n-p "Unsent mail being composed; erase it? ")))
241 ()
242 (erase-buffer)
243 (if post
244 (progn
245 (mail-setup method-address subject nil nil nil nil)
246 (auto-save-mode auto-save-default))
247 (save-excursion
248 (set-buffer article-buffer)
249 (goto-char (point-min))
250 (narrow-to-region (point-min)
251 (progn (search-forward "\n\n") (point)))
252 (let ((buffer-read-only nil))
253 (set-text-properties (point-min) (point-max) nil))
254 (setq from (mail-header-from header))
255 (setq date (mail-header-date header))
256 (and from
257 (let ((stop-pos
258 (string-match " *at \\| *@ \\| *(\\| *<" from)))
259 (setq message-of
260 (concat (if stop-pos (substring from 0 stop-pos) from)
261 "'s message of " date))))
262 (setq cc (mail-strip-quoted-names (or (mail-fetch-field "cc") "")))
263 (setq to (mail-strip-quoted-names (or (mail-fetch-field "to") "")))
264 (setq new-cc (rmail-dont-reply-to
265 (concat (or to "")
266 (if cc (concat (if to ", " "") cc) ""))))
267 (let ((rmail-dont-reply-to-names
268 (regexp-quote (mail-strip-quoted-names
269 (or method-address reply-to from "")))))
270 (setq new-cc (rmail-dont-reply-to new-cc)))
271 (setq subject (mail-header-subject header))
272 (or (string-match "^[Rr][Ee]:" subject)
273 (setq subject (concat "Re: " subject)))
274 (setq reply-to (mail-fetch-field "reply-to"))
275 (setq references (mail-header-references header))
276 (setq message-id (mail-header-id header))
277 (widen))
278 (setq news-reply-yank-from from)
279 (setq news-reply-yank-message-id message-id)
280
281 ;; Gather the "to" addresses out of the follow-to list and remove
282 ;; them as we go.
283 (if (and follow-to (listp follow-to))
284 (while (setq elt (assoc "To" follow-to))
285 (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
286 (setq follow-to (delq elt follow-to))))
287 (mail-setup (if (and follow-to (listp follow-to))
288 sendto
289 (or method-address reply-to from ""))
290 subject message-of
291 (if (zerop (length new-cc)) nil new-cc)
292 article-buffer nil)
293 (auto-save-mode auto-save-default)
294 ;; Note that "To" elements should already be in the message.
295 (if (and follow-to (listp follow-to))
296 (progn
297 (goto-char (point-min))
298 (re-search-forward "^To:" nil t)
299 (beginning-of-line)
300 (forward-line 1)
301 (while follow-to
302 (insert
303 (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
304 (setq follow-to (cdr follow-to)))))
305 (nnheader-insert-references references message-id)))
306 (current-buffer))))
307 293
308 (defun nnmail-find-file (file) 294 (defun nnmail-find-file (file)
309 "Insert FILE in server buffer safely." 295 "Insert FILE in server buffer safely."
310 (set-buffer nntp-server-buffer) 296 (set-buffer nntp-server-buffer)
311 (erase-buffer) 297 (erase-buffer)
312 (condition-case () 298 (let ((format-alist nil)
313 (progn (insert-file-contents file) t) 299 (after-insert-file-functions nil))
314 (file-error nil))) 300 (condition-case ()
315 301 (progn (insert-file-contents file) t)
316 (defun nnmail-article-pathname (group mail-dir) 302 (file-error nil))))
303
304 (defun nnmail-group-pathname (group dir &optional file)
317 "Make pathname for GROUP." 305 "Make pathname for GROUP."
318 (concat (file-name-as-directory (expand-file-name mail-dir)) 306 (concat
319 (nnmail-replace-chars-in-string group ?. ?/) "/")) 307 (let ((dir (file-name-as-directory (expand-file-name dir))))
320 308 ;; If this directory exists, we use it directly.
321 (defun nnmail-replace-chars-in-string (string from to) 309 (if (or nnmail-use-long-file-names
322 "Replace characters in STRING from FROM to TO." 310 (file-directory-p (concat dir group)))
323 (let ((string (substring string 0)) ;Copy string. 311 (concat dir group "/")
324 (len (length string)) 312 ;; If not, we translate dots into slashes.
325 (idx 0)) 313 (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/")))
326 ;; Replace all occurrences of FROM with TO. 314 (or file "")))
327 (while (< idx len) 315
328 (if (= (aref string idx) from) 316 (defun nnmail-date-to-time (date)
329 (aset string idx to)) 317 "Convert DATE into time."
330 (setq idx (1+ idx))) 318 (let* ((d1 (timezone-parse-date date))
331 string)) 319 (t1 (timezone-parse-time (aref d1 3))))
332 320 (apply 'encode-time
333 (defun nnmail-days-between (date1 date2) 321 (mapcar (lambda (el)
334 ;; Return the number of days between date1 and date2. 322 (and el (string-to-number el)))
335 (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) ) 323 (list
336 (timezone-parse-date date1))) 324 (aref t1 2) (aref t1 1) (aref t1 0)
337 (d2 (mapcar (lambda (s) (and s (string-to-int s)) ) 325 (aref d1 2) (aref d1 1) (aref d1 0)
338 (timezone-parse-date date2)))) 326 (aref d1 4))))))
339 (- (timezone-absolute-from-gregorian 327
340 (nth 1 d1) (nth 2 d1) (car d1)) 328 (defun nnmail-time-less (t1 t2)
341 (timezone-absolute-from-gregorian 329 "Say whether time T1 is less than time T2."
342 (nth 1 d2) (nth 2 d2) (car d2))))) 330 (or (< (car t1) (car t2))
343 331 (and (= (car t1) (car t2))
344 ;; Function taken from rmail.el. 332 (< (nth 1 t1) (nth 1 t2)))))
345 (defun nnmail-move-inbox (inbox tofile) 333
334 (defun nnmail-days-to-time (days)
335 "Convert DAYS into time."
336 (let* ((seconds (* 1.0 days 60 60 24))
337 (rest (expt 2 16))
338 (ms (condition-case nil (round (/ seconds rest))
339 (range-error (expt 2 16)))))
340 (list ms (condition-case nil (round (- seconds (* ms rest)))
341 (range-error (expt 2 16))))))
342
343 (defun nnmail-time-since (time)
344 "Return the time since TIME, which is either an internal time or a date."
345 (when (stringp time)
346 ;; Convert date strings to internal time.
347 (setq time (nnmail-date-to-time time)))
348 (let* ((current (current-time))
349 (rest (if (< (nth 1 current) (nth 1 time)) (expt 2 16))))
350 (list (- (+ (car current) (if rest -1 0)) (car time))
351 (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
352
353 ;; Function rewritten from rmail.el.
354 (defun nnmail-move-inbox (inbox)
355 "Move INBOX to `nnmail-crash-box'."
346 (let ((inbox (file-truename 356 (let ((inbox (file-truename
347 (expand-file-name (substitute-in-file-name inbox)))) 357 (expand-file-name (substitute-in-file-name inbox))))
348 movemail popmail errors) 358 (tofile (file-truename (expand-file-name
349 ;; Check whether the inbox is to be moved to the special tmp dir. 359 (substitute-in-file-name nnmail-crash-box))))
350 (if nnmail-tmp-directory 360 movemail popmail errors password)
351 (setq tofile (concat (file-name-as-directory nnmail-tmp-directory)
352 (file-name-nondirectory tofile))))
353 ;; Make the filename unique.
354 (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile)))
355 ;; We create the directory the tofile is to reside in if it
356 ;; doesn't exist.
357 (or (file-exists-p (file-name-directory tofile))
358 (make-directory tofile 'parents))
359 ;; If getting from mail spool directory, 361 ;; If getting from mail spool directory,
360 ;; use movemail to move rather than just renaming, 362 ;; use movemail to move rather than just renaming,
361 ;; so as to interlock with the mailer. 363 ;; so as to interlock with the mailer.
362 (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox))) 364 (unless (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
363 (setq movemail t)) 365 (setq movemail t))
364 (if popmail (setq inbox (file-name-nondirectory inbox))) 366 (when popmail
365 (if movemail 367 (setq inbox (file-name-nondirectory inbox)))
366 ;; On some systems, /usr/spool/mail/foo is a directory 368 (when (and movemail
367 ;; and the actual inbox is /usr/spool/mail/foo/foo. 369 ;; On some systems, /usr/spool/mail/foo is a directory
368 (if (file-directory-p inbox) 370 ;; and the actual inbox is /usr/spool/mail/foo/foo.
369 (setq inbox (expand-file-name (user-login-name) inbox)))) 371 (file-directory-p inbox))
370 (cond 372 (setq inbox (expand-file-name (user-login-name) inbox)))
371 (popmail 373 (if (member inbox nnmail-moved-inboxes)
372 (if (and rmail-pop-password-required (not rmail-pop-password)) 374 nil
373 (setq rmail-pop-password 375 (if popmail
374 (rmail-read-passwd 376 (progn
375 (format "Password for %s: " 377 (setq nnmail-internal-password nnmail-pop-password)
376 (substring tofile (+ popmail 3)))))) 378 (when (and nnmail-pop-password-required (not nnmail-pop-password))
377 (message "Getting mail from post office ...")) 379 (setq nnmail-internal-password
378 ((or (and (file-exists-p tofile) 380 (nnmail-read-passwd
379 (/= 0 (nth 7 (file-attributes tofile)))) 381 (format "Password for %s: "
380 (and (file-exists-p inbox) 382 (substring inbox (+ popmail 3))))))
381 (/= 0 (nth 7 (file-attributes inbox))))) 383 (message "Getting mail from post office ..."))
382 (message "Getting mail from %s..." inbox))) 384 (when (or (and (file-exists-p tofile)
383 ;; Set TOFILE if have not already done so, and 385 (/= 0 (nth 7 (file-attributes tofile))))
384 ;; rename or copy the file INBOX to TOFILE if and as appropriate. 386 (and (file-exists-p inbox)
385 (cond ((or (file-exists-p tofile) (and (not popmail) 387 (/= 0 (nth 7 (file-attributes inbox)))))
386 (not (file-exists-p inbox)))) 388 (message "Getting mail from %s..." inbox)))
387 nil) 389 ;; Set TOFILE if have not already done so, and
388 ((and (not movemail) (not popmail)) 390 ;; rename or copy the file INBOX to TOFILE if and as appropriate.
389 ;; Try copying. If that fails (perhaps no space), 391 (cond
390 ;; rename instead. 392 ((file-exists-p tofile)
391 (condition-case nil 393 ;; The crash box exists already.
392 (copy-file inbox tofile nil) 394 t)
393 (error 395 ((and (not popmail)
394 ;; Third arg is t so we can replace existing file TOFILE. 396 (not (file-exists-p inbox)))
395 (rename-file inbox tofile t))) 397 ;; There is no inbox.
396 ;; Make the real inbox file empty. 398 (setq tofile nil))
397 ;; Leaving it deleted could cause lossage 399 ((and (not movemail) (not popmail))
398 ;; because mailers often won't create the file. 400 ;; Try copying. If that fails (perhaps no space),
399 (condition-case () 401 ;; rename instead.
400 (write-region (point) (point) inbox) 402 (condition-case nil
401 (file-error nil))) 403 (copy-file inbox tofile nil)
402 (t 404 (error
403 (unwind-protect 405 ;; Third arg is t so we can replace existing file TOFILE.
404 (save-excursion 406 (rename-file inbox tofile t)))
405 (setq errors (generate-new-buffer " *nnmail loss*")) 407 (push inbox nnmail-moved-inboxes)
406 (buffer-disable-undo errors) 408 ;; Make the real inbox file empty.
407 (if rmail-pop-password 409 ;; Leaving it deleted could cause lossage
408 (call-process 410 ;; because mailers often won't create the file.
409 (expand-file-name nnmail-movemail-program exec-directory) 411 (condition-case ()
410 nil errors nil inbox tofile rmail-pop-password) 412 (write-region (point) (point) inbox)
411 (call-process 413 (file-error nil)))
412 (expand-file-name nnmail-movemail-program exec-directory) 414 (t
413 nil errors nil inbox tofile)) 415 ;; Use movemail.
414 (if (not (buffer-modified-p errors)) 416 (unwind-protect
415 ;; No output => movemail won 417 (save-excursion
416 nil 418 (setq errors (generate-new-buffer " *nnmail loss*"))
417 (set-buffer errors) 419 (buffer-disable-undo errors)
418 (subst-char-in-region (point-min) (point-max) ?\n ?\ ) 420 (let ((default-directory "/"))
419 (goto-char (point-max)) 421 (apply
420 (skip-chars-backward " \t") 422 'call-process
421 (delete-region (point) (point-max)) 423 (append
422 (goto-char (point-min)) 424 (list
423 (if (looking-at "movemail: ") 425 (expand-file-name nnmail-movemail-program exec-directory)
424 (delete-region (point-min) (match-end 0))) 426 nil errors nil inbox tofile)
425 (beep t) 427 (when nnmail-internal-password
426 (message "movemail: %s" 428 (list nnmail-internal-password)))))
427 (buffer-substring (point-min) 429 (if (not (buffer-modified-p errors))
428 (point-max))) 430 ;; No output => movemail won
429 (sit-for 3) 431 (push inbox nnmail-moved-inboxes)
430 nil))))) 432 (set-buffer errors)
431 (and errors 433 (subst-char-in-region (point-min) (point-max) ?\n ?\ )
432 (buffer-name errors) 434 (goto-char (point-max))
433 (kill-buffer errors)) 435 (skip-chars-backward " \t")
434 tofile)) 436 (delete-region (point) (point-max))
435 437 (goto-char (point-min))
438 (if (looking-at "movemail: ")
439 (delete-region (point-min) (match-end 0)))
440 (beep t)
441 (message (concat "movemail: "
442 (buffer-substring (point-min)
443 (point-max))))
444 (sit-for 3)
445 (setq tofile nil))))))
446 (and errors
447 (buffer-name errors)
448 (kill-buffer errors))
449 tofile)))
436 450
437 (defun nnmail-get-active () 451 (defun nnmail-get-active ()
438 "Returns an assoc of group names and active ranges. 452 "Returns an assoc of group names and active ranges.
439 nn*-request-list should have been called before calling this function." 453 nn*-request-list should have been called before calling this function."
440 (let (group-assoc) 454 (let (group-assoc)
442 (save-excursion 456 (save-excursion
443 (set-buffer nntp-server-buffer) 457 (set-buffer nntp-server-buffer)
444 (goto-char (point-min)) 458 (goto-char (point-min))
445 (while (re-search-forward 459 (while (re-search-forward
446 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) 460 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
447 (setq group-assoc 461 ;; We create an alist with `(GROUP (LOW . HIGH))' elements.
448 (cons (list (buffer-substring (match-beginning 1) 462 (push (list (match-string 1)
449 (match-end 1)) 463 (cons (string-to-int (match-string 3))
450 (cons (string-to-int 464 (string-to-int (match-string 2))))
451 (buffer-substring (match-beginning 3) 465 group-assoc)))
452 (match-end 3)))
453 (string-to-int
454 (buffer-substring (match-beginning 2)
455 (match-end 2)))))
456 group-assoc))))
457
458 ;; ;; In addition, add all groups mentioned in `nnmail-split-methods'.
459 ;; (let ((methods (and (not (symbolp nnmail-split-methods))
460 ;; nnmail-split-methods)))
461 ;; (while methods
462 ;; (if (not (assoc (car (car methods)) group-assoc))
463 ;; (setq group-assoc
464 ;; (cons (list (car (car methods)) (cons 1 0))
465 ;; group-assoc)))
466 ;; (setq methods (cdr methods)))
467
468 group-assoc)) 466 group-assoc))
469 467
470 (defun nnmail-save-active (group-assoc file-name) 468 (defun nnmail-save-active (group-assoc file-name)
471 (let (group) 469 "Save GROUP-ASSOC in ACTIVE-FILE."
472 (save-excursion 470 (when file-name
473 (set-buffer (get-buffer-create " *nnmail active*")) 471 (let (group)
474 (buffer-disable-undo (current-buffer)) 472 (save-excursion
475 (erase-buffer) 473 (set-buffer (get-buffer-create " *nnmail active*"))
476 (while group-assoc 474 (buffer-disable-undo (current-buffer))
477 (setq group (car group-assoc)) 475 (erase-buffer)
478 (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) ) 476 (while group-assoc
479 (car (car (cdr group))))) 477 (setq group (pop group-assoc))
480 (setq group-assoc (cdr group-assoc))) 478 (insert (format "%s %d %d y\n" (car group) (cdadr group)
481 (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg) 479 (caadr group))))
482 (kill-buffer (current-buffer))))) 480 (unless (file-exists-p (file-name-directory file-name))
481 (make-directory (file-name-directory file-name) t))
482 (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
483 (kill-buffer (current-buffer))))))
483 484
484 (defun nnmail-get-split-group (file group) 485 (defun nnmail-get-split-group (file group)
485 (if (or (eq nnmail-spool-file 'procmail) 486 (if (or (eq nnmail-spool-file 'procmail)
486 nnmail-use-procmail) 487 nnmail-use-procmail)
487 (cond (group group) 488 (cond (group group)
488 ((string-match (concat "^" (expand-file-name 489 ((string-match (concat "^" (expand-file-name
489 (file-name-as-directory 490 (file-name-as-directory
490 nnmail-procmail-directory)) 491 nnmail-procmail-directory))
491 "\\(.*\\)" nnmail-procmail-suffix "$") 492 "\\([^/]*\\)" nnmail-procmail-suffix "$")
492 (expand-file-name file)) 493 (expand-file-name file))
493 (substring (expand-file-name file) 494 (substring (expand-file-name file)
494 (match-beginning 1) (match-end 1))) 495 (match-beginning 1) (match-end 1)))
495 (t 496 (t
496 group)) 497 group))
497 group)) 498 group))
498 499
499 (defun nnmail-split-incoming (incoming func &optional dont-kill group) 500 (defun nnmail-process-babyl-mail-format (func)
501 (let ((case-fold-search t)
502 start message-id content-length do-search end)
503 (while (not (eobp))
504 (goto-char (point-min))
505 (re-search-forward
506 " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
507 (goto-char (match-end 0))
508 (delete-region (match-beginning 0) (match-end 0))
509 (setq start (point))
510 ;; Skip all the headers in case there are more "From "s...
511 (or (search-forward "\n\n" nil t)
512 (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
513 (search-forward " "))
514 ;; Find the Message-ID header.
515 (save-excursion
516 (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
517 (setq message-id (buffer-substring (match-beginning 1)
518 (match-end 1)))
519 ;; There is no Message-ID here, so we create one.
520 (save-excursion
521 (when (re-search-backward "^Message-ID:" nil t)
522 (beginning-of-line)
523 (insert "Original-")))
524 (forward-line -1)
525 (insert "Message-ID: " (setq message-id (nnmail-message-id))
526 "\n")))
527 ;; Look for a Content-Length header.
528 (if (not (save-excursion
529 (and (re-search-backward
530 "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
531 (setq content-length (string-to-int
532 (buffer-substring
533 (match-beginning 1)
534 (match-end 1))))
535 ;; We destroy the header, since none of
536 ;; the backends ever use it, and we do not
537 ;; want to confuse other mailers by having
538 ;; a (possibly) faulty header.
539 (progn (insert "X-") t))))
540 (setq do-search t)
541 (if (or (= (+ (point) content-length) (point-max))
542 (save-excursion
543 (goto-char (+ (point) content-length))
544 (looking-at "")))
545 (progn
546 (goto-char (+ (point) content-length))
547 (setq do-search nil))
548 (setq do-search t)))
549 ;; Go to the beginning of the next article - or to the end
550 ;; of the buffer.
551 (if do-search
552 (if (re-search-forward "^" nil t)
553 (goto-char (match-beginning 0))
554 (goto-char (1- (point-max)))))
555 (delete-char 1) ; delete ^_
556 (save-excursion
557 (save-restriction
558 (narrow-to-region start (point))
559 (goto-char (point-min))
560 (nnmail-check-duplication message-id func)
561 (setq end (point-max))))
562 (goto-char end))))
563
564 (defun nnmail-search-unix-mail-delim ()
565 "Put point at the beginning of the next message."
566 (let ((case-fold-search t)
567 (delim (concat "^" message-unix-mail-delimiter))
568 found)
569 (while (not found)
570 (if (re-search-forward delim nil t)
571 (when (or (looking-at "[^\n :]+ *:")
572 (looking-at delim)
573 (looking-at (concat ">" message-unix-mail-delimiter)))
574 (forward-line -1)
575 (setq found 'yes))
576 (setq found 'no)))
577 (eq found 'yes)))
578
579 (defun nnmail-process-unix-mail-format (func)
580 (let ((case-fold-search t)
581 (delim (concat "^" message-unix-mail-delimiter))
582 start message-id content-length end skip head-end)
583 (goto-char (point-min))
584 (if (not (and (re-search-forward delim nil t)
585 (goto-char (match-beginning 0))))
586 ;; Possibly wrong format?
587 (error "Error, unknown mail format! (Possibly corrupted.)")
588 ;; Carry on until the bitter end.
589 (while (not (eobp))
590 (setq start (point)
591 end nil)
592 ;; Find the end of the head.
593 (narrow-to-region
594 start
595 (if (search-forward "\n\n" nil t)
596 (1- (point))
597 ;; This will never happen, but just to be on the safe side --
598 ;; if there is no head-body delimiter, we search a bit manually.
599 (while (and (looking-at "From \\|[^ \t]+:")
600 (not (eobp)))
601 (forward-line 1)
602 (point))))
603 ;; Find the Message-ID header.
604 (goto-char (point-min))
605 (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
606 (setq message-id (match-string 1))
607 (save-excursion
608 (when (re-search-forward "^Message-ID:" nil t)
609 (beginning-of-line)
610 (insert "Original-")))
611 ;; There is no Message-ID here, so we create one.
612 (forward-line 1)
613 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
614 ;; Look for a Content-Length header.
615 (goto-char (point-min))
616 (if (not (re-search-forward
617 "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
618 (setq content-length nil)
619 (setq content-length (string-to-int (match-string 1)))
620 ;; We destroy the header, since none of the backends ever
621 ;; use it, and we do not want to confuse other mailers by
622 ;; having a (possibly) faulty header.
623 (beginning-of-line)
624 (insert "X-"))
625 ;; Find the end of this article.
626 (goto-char (point-max))
627 (widen)
628 (setq head-end (point))
629 ;; We try the Content-Length value. The idea: skip over the header
630 ;; separator, then check what happens content-length bytes into the
631 ;; message body. This should be either the end ot the buffer, the
632 ;; message separator or a blank line followed by the separator.
633 ;; The blank line should probably be deleted. If neither of the
634 ;; three is met, the content-length header is probably invalid.
635 (when content-length
636 (forward-line 1)
637 (setq skip (+ (point) content-length))
638 (goto-char skip)
639 (cond ((or (= skip (point-max))
640 (= (1+ skip) (point-max)))
641 (setq end (point-max)))
642 ((looking-at delim)
643 (setq end skip))
644 ((looking-at
645 (concat "[ \t]*\n\\(" delim "\\)"))
646 (setq end (match-beginning 1)))
647 (t (setq end nil))))
648 (if end
649 (goto-char end)
650 ;; No Content-Length, so we find the beginning of the next
651 ;; article or the end of the buffer.
652 (goto-char head-end)
653 (or (nnmail-search-unix-mail-delim)
654 (goto-char (point-max))))
655 ;; Allow the backend to save the article.
656 (save-excursion
657 (save-restriction
658 (narrow-to-region start (point))
659 (goto-char (point-min))
660 (nnmail-check-duplication message-id func)
661 (setq end (point-max))))
662 (goto-char end)))))
663
664 (defun nnmail-process-mmdf-mail-format (func)
665 (let ((delim "^\^A\^A\^A\^A$")
666 (case-fold-search t)
667 start message-id end)
668 (goto-char (point-min))
669 (if (not (and (re-search-forward delim nil t)
670 (forward-line 1)))
671 ;; Possibly wrong format?
672 (error "Error, unknown mail format! (Possibly corrupted.)")
673 ;; Carry on until the bitter end.
674 (while (not (eobp))
675 (setq start (point))
676 ;; Find the end of the head.
677 (narrow-to-region
678 start
679 (if (search-forward "\n\n" nil t)
680 (1- (point))
681 ;; This will never happen, but just to be on the safe side --
682 ;; if there is no head-body delimiter, we search a bit manually.
683 (while (and (looking-at "From \\|[^ \t]+:")
684 (not (eobp)))
685 (forward-line 1)
686 (point))))
687 ;; Find the Message-ID header.
688 (goto-char (point-min))
689 (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
690 (setq message-id (match-string 1))
691 ;; There is no Message-ID here, so we create one.
692 (save-excursion
693 (when (re-search-backward "^Message-ID:" nil t)
694 (beginning-of-line)
695 (insert "Original-")))
696 (forward-line 1)
697 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
698 ;; Find the end of this article.
699 (goto-char (point-max))
700 (widen)
701 (if (re-search-forward delim nil t)
702 (beginning-of-line)
703 (goto-char (point-max)))
704 ;; Allow the backend to save the article.
705 (save-excursion
706 (save-restriction
707 (narrow-to-region start (point))
708 (goto-char (point-min))
709 (nnmail-check-duplication message-id func)
710 (setq end (point-max))))
711 (goto-char end)
712 (forward-line 2)))))
713
714 (defun nnmail-split-incoming (incoming func &optional exit-func group)
500 "Go through the entire INCOMING file and pick out each individual mail. 715 "Go through the entire INCOMING file and pick out each individual mail.
501 FUNC will be called with the buffer narrowed to each mail." 716 FUNC will be called with the buffer narrowed to each mail."
502 (let ((delim (concat "^" rmail-unix-mail-delimiter)) 717 (let (;; If this is a group-specific split, we bind the split
503 ;; If this is a group-specific split, we bind the split
504 ;; methods to just this group. 718 ;; methods to just this group.
505 (nnmail-split-methods (if (and group 719 (nnmail-split-methods (if (and group
506 (or (eq nnmail-spool-file 'procmail) 720 (or (eq nnmail-spool-file 'procmail)
507 nnmail-use-procmail) 721 nnmail-use-procmail)
508 (not nnmail-resplit-incoming)) 722 (not nnmail-resplit-incoming))
509 (list (list group "")) 723 (list (list group ""))
510 nnmail-split-methods)) 724 nnmail-split-methods)))
511 start end content-length do-search message-id)
512 (save-excursion 725 (save-excursion
513 ;; Open the message-id cache.
514 (nnmail-cache-open)
515 ;; Insert the incoming file. 726 ;; Insert the incoming file.
516 (set-buffer (get-buffer-create " *nnmail incoming*")) 727 (set-buffer (get-buffer-create " *nnmail incoming*"))
517 (buffer-disable-undo (current-buffer)) 728 (buffer-disable-undo (current-buffer))
518 (erase-buffer) 729 (erase-buffer)
519 (insert-file-contents incoming) 730 (nnheader-insert-file-contents-literally incoming)
520 (goto-char (point-min)) 731 (unless (zerop (buffer-size))
521 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) 732 (goto-char (point-min))
522 ;; Go to the beginning of the first mail... 733 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
523 (if (and (re-search-forward delim nil t) 734 ;; Handle both babyl, MMDF and unix mail formats, since movemail will
524 (goto-char (match-beginning 0))) 735 ;; use the former when fetching from a mailbox, the latter when
525 ;; and then carry on until the bitter end. 736 ;; fetches from a file.
526 (while (not (eobp)) 737 (cond ((or (looking-at "\^L")
527 (setq start (point)) 738 (looking-at "BABYL OPTIONS:"))
528 ;; Skip all the headers in case there are more "From "s... 739 (nnmail-process-babyl-mail-format func))
529 (if (not (search-forward "\n\n" nil t)) 740 ((looking-at "\^A\^A\^A\^A")
530 (forward-line 1)) 741 (nnmail-process-mmdf-mail-format func))
531 ;; Find the Message-ID header. 742 (t
532 (save-excursion 743 (nnmail-process-unix-mail-format func))))
533 (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) 744 (if exit-func (funcall exit-func))
534 (setq message-id (buffer-substring (match-beginning 1) 745 (kill-buffer (current-buffer)))))
535 (match-end 1)))
536 ;; There is no Message-ID here, so we create one.
537 (forward-line -1)
538 (insert "Message-ID: " (setq message-id (nnmail-message-id))
539 "\n")))
540 ;; Look for a Content-Length header.
541 (if (not (save-excursion
542 (and (re-search-backward
543 "^Content-Length: \\([0-9]+\\)" start t)
544 (setq content-length (string-to-int
545 (buffer-substring
546 (match-beginning 1)
547 (match-end 1))))
548 ;; We destroy the header, since none of
549 ;; the backends ever use it, and we do not
550 ;; want to confuse other mailers by having
551 ;; a (possibly) faulty header.
552 (progn (insert "X-") t))))
553 (setq do-search t)
554 (if (or (= (+ (point) content-length) (point-max))
555 (save-excursion
556 (goto-char (+ (point) content-length))
557 (looking-at delim)))
558 (progn
559 (goto-char (+ (point) content-length))
560 (setq do-search nil))
561 (setq do-search t)))
562 ;; Go to the beginning of the next article - or to the end
563 ;; of the buffer.
564 (if do-search
565 (if (re-search-forward delim nil t)
566 (goto-char (match-beginning 0))
567 (goto-char (point-max))))
568 (save-excursion
569 (save-restriction
570 (narrow-to-region start (point))
571 (goto-char (point-min))
572 ;; If this is a duplicate message, then we do not save it.
573 (if (nnmail-cache-id-exists-p message-id)
574 (delete-region (point-min) (point-max))
575 (nnmail-cache-insert message-id)
576 (funcall func))
577 (setq end (point-max))))
578 (goto-char end)))
579 ;; Close the message-id cache.
580 (nnmail-cache-close)
581 (if dont-kill
582 (current-buffer)
583 (kill-buffer (current-buffer))))))
584 746
585 ;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>. 747 ;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
586 (defun nnmail-article-group (func) 748 (defun nnmail-article-group (func)
587 "Look at the headers and return an alist of groups that match. 749 "Look at the headers and return an alist of groups that match.
588 FUNC will be called with the group name to determine the article number." 750 FUNC will be called with the group name to determine the article number."
589 (let ((methods nnmail-split-methods) 751 (let ((methods nnmail-split-methods)
590 (obuf (current-buffer)) 752 (obuf (current-buffer))
591 (beg (point-min)) 753 (beg (point-min))
592 end group-art) 754 end group-art method)
593 (if (and (sequencep methods) (= (length methods) 1)) 755 (if (and (sequencep methods) (= (length methods) 1))
594 ;; If there is only just one group to put everything in, we 756 ;; If there is only just one group to put everything in, we
595 ;; just return a list with just this one method in. 757 ;; just return a list with just this one method in.
596 (setq group-art 758 (setq group-art
597 (list (cons (car (car methods)) 759 (list (cons (caar methods) (funcall func (caar methods)))))
598 (funcall func (car (car methods))))))
599 ;; We do actual comparison. 760 ;; We do actual comparison.
600 (save-excursion 761 (save-excursion
601 ;; Find headers. 762 ;; Find headers.
602 (goto-char beg) 763 (goto-char beg)
603 (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) 764 (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
604 (set-buffer (get-buffer-create " *nnmail work*")) 765 (set-buffer nntp-server-buffer)
605 (buffer-disable-undo (current-buffer))
606 (erase-buffer) 766 (erase-buffer)
607 ;; Copy the headers into the work buffer. 767 ;; Copy the headers into the work buffer.
608 (insert-buffer-substring obuf beg end) 768 (insert-buffer-substring obuf beg end)
609 ;; Fold continuation lines. 769 ;; Fold continuation lines.
610 (goto-char (point-min)) 770 (goto-char (point-min))
611 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) 771 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
612 (replace-match " " t t)) 772 (replace-match " " t t))
613 (if (and (symbolp nnmail-split-methods) 773 (if (and (symbolp nnmail-split-methods)
614 (fboundp nnmail-split-methods)) 774 (fboundp nnmail-split-methods))
775 ;; `nnmail-split-methods' is a function, so we just call
776 ;; this function here and use the result.
615 (setq group-art 777 (setq group-art
616 (mapcar 778 (mapcar
617 (lambda (group) (cons group (funcall func group))) 779 (lambda (group) (cons group (funcall func group)))
618 (condition-case nil 780 (condition-case nil
619 (funcall nnmail-split-methods) 781 (or (funcall nnmail-split-methods)
782 '("bogus"))
620 (error 783 (error
621 (message "\ 784 (message
622 Problems with `nnmail-split-methods', using `bogus' mail group") 785 "Error in `nnmail-split-methods'; using `bogus' mail group")
623 (sit-for 1) 786 (sit-for 1)
624 '("bogus"))))) 787 '("bogus")))))
625 ;; Go through the split methods to find a match. 788 ;; Go through the split methods to find a match.
626 (while (and methods (or nnmail-crosspost (not group-art))) 789 (while (and methods (or nnmail-crosspost (not group-art)))
627 (goto-char (point-max)) 790 (goto-char (point-max))
628 (if (or (cdr methods) 791 (setq method (pop methods))
629 (not (equal "" (nth 1 (car methods))))) 792 (if (or methods
630 (if (and (condition-case () 793 (not (equal "" (nth 1 method))))
631 (if (stringp (nth 1 (car methods))) 794 (when (and
632 (re-search-backward 795 (condition-case ()
633 (car (cdr (car methods))) nil t) 796 (if (stringp (nth 1 method))
634 ;; Suggested by Brian Edmonds 797 (re-search-backward (cadr method) nil t)
635 ;; <edmonds@cs.ubc.ca>. 798 ;; Function to say whether this is a match.
636 (funcall (nth 1 (car methods)) 799 (funcall (nth 1 method) (car method)))
637 (car (car methods)))) 800 (error nil))
638 (error nil)) 801 ;; Don't enter the article into the same
639 ;; Don't enter the article into the same group twice. 802 ;; group twice.
640 (not (assoc (car (car methods)) group-art))) 803 (not (assoc (car method) group-art)))
641 (setq group-art 804 (push (cons (car method) (funcall func (car method)))
642 (cons (cons (car (car methods)) 805 group-art))
643 (funcall func (car (car methods)))) 806 ;; This is the final group, which is used as a
644 group-art))) 807 ;; catch-all.
645 (or group-art 808 (unless group-art
646 (setq group-art 809 (setq group-art
647 (list (cons (car (car methods)) 810 (list (cons (car method)
648 (funcall func (car (car methods)))))))) 811 (funcall func (car method)))))))))
649 (setq methods (cdr methods))))
650 (kill-buffer (current-buffer))
651 group-art)))) 812 group-art))))
652 813
653 (defun nnmail-insert-lines () 814 (defun nnmail-insert-lines ()
654 "Insert how many lines and chars there are in the body of the mail." 815 "Insert how many lines there are in the body of the mail.
816 Return the number of characters in the body."
655 (let (lines chars) 817 (let (lines chars)
656 (save-excursion 818 (save-excursion
657 (goto-char (point-min)) 819 (goto-char (point-min))
658 (if (search-forward "\n\n" nil t) 820 (when (search-forward "\n\n" nil t)
659 (progn 821 (setq chars (- (point-max) (point)))
660 (setq chars (- (point-max) (point))) 822 (setq lines (count-lines (point) (point-max)))
661 (setq lines (- (count-lines (point) (point-max)) 1)) 823 (forward-char -1)
662 (forward-char -1) 824 (save-excursion
663 (save-excursion 825 (when (re-search-backward "^Lines: " nil t)
664 (if (re-search-backward "^Lines: " nil t) 826 (delete-region (point) (progn (forward-line 1) (point)))))
665 (delete-region (point) (progn (forward-line 1) (point))))) 827 (beginning-of-line)
666 (insert (format "Lines: %d\n" lines)) 828 (insert (format "Lines: %d\n" (max lines 0)))
667 chars))))) 829 chars))))
668 830
669 (defun nnmail-insert-xref (group-alist) 831 (defun nnmail-insert-xref (group-alist)
670 "Insert an Xref line based on the (group . article) alist." 832 "Insert an Xref line based on the (group . article) alist."
671 (save-excursion 833 (save-excursion
672 (goto-char (point-min)) 834 (goto-char (point-min))
673 (if (search-forward "\n\n" nil t) 835 (when (search-forward "\n\n" nil t)
674 (progn 836 (forward-char -1)
675 (forward-char -1) 837 (when (re-search-backward "^Xref: " nil t)
676 (if (re-search-backward "^Xref: " nil t) 838 (delete-region (match-beginning 0)
677 (delete-region (match-beginning 0) 839 (progn (forward-line 1) (point))))
678 (progn (forward-line 1) (point)))) 840 (insert (format "Xref: %s" (system-name)))
679 (insert (format "Xref: %s" (system-name))) 841 (while group-alist
680 (while group-alist 842 (insert (format " %s:%d" (caar group-alist) (cdar group-alist)))
681 (insert (format " %s:%d" (car (car group-alist)) 843 (setq group-alist (cdr group-alist)))
682 (cdr (car group-alist)))) 844 (insert "\n"))))
683 (setq group-alist (cdr group-alist)))
684 (insert "\n")))))
685 845
686 ;; Written by byer@mv.us.adobe.com (Scott Byer). 846 ;; Written by byer@mv.us.adobe.com (Scott Byer).
687 (defun nnmail-make-complex-temp-name (prefix) 847 (defun nnmail-make-complex-temp-name (prefix)
688 (let ((newname (make-temp-name prefix)) 848 (let ((newname (make-temp-name prefix))
689 (newprefix prefix)) 849 (newprefix prefix))
695 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>. 855 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
696 856
697 (defun nnmail-split-fancy () 857 (defun nnmail-split-fancy ()
698 "Fancy splitting method. 858 "Fancy splitting method.
699 See the documentation for the variable `nnmail-split-fancy' for documentation." 859 See the documentation for the variable `nnmail-split-fancy' for documentation."
700 (nnmail-split-it nnmail-split-fancy)) 860 (let ((syntab (syntax-table)))
861 (unwind-protect
862 (progn
863 (set-syntax-table nnmail-split-fancy-syntax-table)
864 (nnmail-split-it nnmail-split-fancy))
865 (set-syntax-table syntab))))
701 866
702 (defvar nnmail-split-cache nil) 867 (defvar nnmail-split-cache nil)
703 ;; Alist of split expressions their equivalent regexps. 868 ;; Alist of split expressions their equivalent regexps.
704 869
705 (defun nnmail-split-it (split) 870 (defun nnmail-split-it (split)
712 ((eq (car split) '|) 877 ((eq (car split) '|)
713 (let (done) 878 (let (done)
714 (while (and (not done) (cdr split)) 879 (while (and (not done) (cdr split))
715 (setq split (cdr split) 880 (setq split (cdr split)
716 done (nnmail-split-it (car split)))) 881 done (nnmail-split-it (car split))))
717 done)) ((assq split nnmail-split-cache) 882 done))
718 ;; A compiled match expression. 883 ((assq split nnmail-split-cache)
884 ;; A compiled match expression.
719 (goto-char (point-max)) 885 (goto-char (point-max))
720 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) 886 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
721 (nnmail-split-it (nth 2 split)))) 887 (nnmail-split-it (nth 2 split))))
722 (t 888 (t
723 ;; An uncompiled match. 889 ;; An uncompiled match.
731 "\\):.*\\<\\(" 897 "\\):.*\\<\\("
732 (if (symbolp value) 898 (if (symbolp value)
733 (cdr (assq value 899 (cdr (assq value
734 nnmail-split-abbrev-alist)) 900 nnmail-split-abbrev-alist))
735 value) 901 value)
736 "\\>\\)"))) 902 "\\)\\>")))
737 (setq nnmail-split-cache 903 (setq nnmail-split-cache
738 (cons (cons split regexp) nnmail-split-cache)) 904 (cons (cons split regexp) nnmail-split-cache))
739 (goto-char (point-max)) 905 (goto-char (point-max))
740 (if (re-search-backward regexp nil t) 906 (if (re-search-backward regexp nil t)
741 (nnmail-split-it (nth 2 split))))))) 907 (nnmail-split-it (nth 2 split)))))))
742 908
743 ;; Get a list of spool files to read. 909 ;; Get a list of spool files to read.
744 (defun nnmail-get-spool-files (&optional group) 910 (defun nnmail-get-spool-files (&optional group)
745 (if (null nnmail-spool-file) 911 (if (null nnmail-spool-file)
746 ;; No spool file whatsoever. 912 ;; No spool file whatsoever.
747 nil) 913 nil
748 (let* ((procmails 914 (let* ((procmails
749 ;; If procmail is used to get incoming mail, the files 915 ;; If procmail is used to get incoming mail, the files
750 ;; are stored in this directory. 916 ;; are stored in this directory.
751 (and (file-exists-p nnmail-procmail-directory) 917 (and (file-exists-p nnmail-procmail-directory)
752 (directory-files 918 (or (eq nnmail-spool-file 'procmail)
753 nnmail-procmail-directory 919 nnmail-use-procmail)
754 t (concat (if group group "") 920 (directory-files
755 nnmail-procmail-suffix "$") t))) 921 nnmail-procmail-directory
756 (p procmails)) 922 t (concat (if group (concat "^" group) "")
757 ;; Remove any directories that inadvertently match the procmail 923 nnmail-procmail-suffix "$") t)))
758 ;; suffix, which might happen if the suffix is "". 924 (p procmails)
759 (while p 925 (crash (when (and (file-exists-p nnmail-crash-box)
760 (and (or (file-directory-p (car p)) 926 (> (nth 7 (file-attributes
761 (file-symlink-p (car p))) 927 (file-truename nnmail-crash-box))) 0))
762 (setq procmails (delete (car p) procmails))) 928 (list nnmail-crash-box))))
763 (setq p (cdr p))) 929 ;; Remove any directories that inadvertantly match the procmail
764 (cond ((listp nnmail-spool-file) 930 ;; suffix, which might happen if the suffix is "".
765 (append nnmail-spool-file procmails)) 931 (while p
766 ((stringp nnmail-spool-file) 932 (when (file-directory-p (car p))
767 (cons nnmail-spool-file procmails)) 933 (setq procmails (delete (car p) procmails)))
768 (t 934 (setq p (cdr p)))
769 procmails)))) 935 ;; Return the list of spools.
936 (append
937 crash
938 (cond ((and group
939 (or (eq nnmail-spool-file 'procmail)
940 nnmail-use-procmail))
941 procmails)
942 ((listp nnmail-spool-file)
943 (append nnmail-spool-file procmails))
944 ((stringp nnmail-spool-file)
945 (cons nnmail-spool-file procmails))
946 ((eq nnmail-spool-file 'pop)
947 (cons (format "po:%s" (user-login-name)) procmails))
948 (t
949 procmails))))))
770 950
771 ;; Activate a backend only if it isn't already activated. 951 ;; Activate a backend only if it isn't already activated.
772 ;; If FORCE, re-read the active file even if the backend is 952 ;; If FORCE, re-read the active file even if the backend is
773 ;; already activated. 953 ;; already activated.
774 (defun nnmail-activate (backend &optional force) 954 (defun nnmail-activate (backend &optional force)
800 (set (intern (format "%s-group-alist" backend)) 980 (set (intern (format "%s-group-alist" backend))
801 (nnmail-get-active)))) 981 (nnmail-get-active))))
802 t)) 982 t))
803 983
804 (defun nnmail-message-id () 984 (defun nnmail-message-id ()
805 (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>")) 985 (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
806
807 (defvar nnmail-unique-id-char nil)
808
809 (defun nnmail-number-base36 (num len)
810 (if (if (< len 0) (<= num 0) (= len 0))
811 ""
812 (concat (nnmail-number-base36 (/ num 36) (1- len))
813 (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
814 (% num 36))))))
815
816 (defun nnmail-unique-id ()
817 (setq nnmail-unique-id-char
818 (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20)))))
819 ;; (current-time) returns 16-bit ints,
820 ;; and 2^16*25 just fits into 4 digits i base 36.
821 (* 25 25)))
822 (let ((tm (if (fboundp 'current-time)
823 (current-time) '(12191 46742 287898))))
824 (concat
825 (nnmail-number-base36 (+ (car tm)
826 (lsh (% nnmail-unique-id-char 25) 16)) 4)
827 (nnmail-number-base36 (+ (nth 1 tm)
828 (lsh (/ nnmail-unique-id-char 25) 16)) 4))))
829 986
830 ;;; 987 ;;;
831 ;;; nnmail duplicate handling 988 ;;; nnmail duplicate handling
832 ;;; 989 ;;;
833 990
834 (defvar nnmail-cache-buffer nil) 991 (defvar nnmail-cache-buffer nil)
835 992
836 (defun nnmail-cache-open () 993 (defun nnmail-cache-open ()
837 (if (or (not nnmail-delete-duplicates) 994 (if (or (not nnmail-treat-duplicates)
838 (and nnmail-cache-buffer 995 (and nnmail-cache-buffer
839 (buffer-name nnmail-cache-buffer))) 996 (buffer-name nnmail-cache-buffer)))
840 () ; The buffer is open. 997 () ; The buffer is open.
841 (save-excursion 998 (save-excursion
842 (set-buffer 999 (set-buffer
843 (setq nnmail-cache-buffer 1000 (setq nnmail-cache-buffer
844 (get-buffer-create " *nnmail message-id cache*"))) 1001 (get-buffer-create " *nnmail message-id cache*")))
845 (buffer-disable-undo (current-buffer)) 1002 (buffer-disable-undo (current-buffer))
846 (and (file-exists-p nnmail-message-id-cache-file) 1003 (and (file-exists-p nnmail-message-id-cache-file)
847 (insert-file-contents nnmail-message-id-cache-file)) 1004 (insert-file-contents nnmail-message-id-cache-file))
1005 (set-buffer-modified-p nil)
848 (current-buffer)))) 1006 (current-buffer))))
849 1007
850 (defun nnmail-cache-close () 1008 (defun nnmail-cache-close ()
851 (if (or (not nnmail-cache-buffer) 1009 (when (and nnmail-cache-buffer
852 (not nnmail-delete-duplicates) 1010 nnmail-treat-duplicates
853 (not (buffer-name nnmail-cache-buffer)) 1011 (buffer-name nnmail-cache-buffer)
854 (not (buffer-modified-p nnmail-cache-buffer))) 1012 (buffer-modified-p nnmail-cache-buffer))
855 () ; The buffer is closed.
856 (save-excursion 1013 (save-excursion
857 (set-buffer nnmail-cache-buffer) 1014 (set-buffer nnmail-cache-buffer)
858 ;; Weed out the excess number of Message-IDs. 1015 ;; Weed out the excess number of Message-IDs.
859 (goto-char (point-max)) 1016 (goto-char (point-max))
860 (and (search-backward "\n" nil t nnmail-message-id-cache-length) 1017 (and (search-backward "\n" nil t nnmail-message-id-cache-length)
865 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file)) 1022 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
866 (make-directory (file-name-directory nnmail-message-id-cache-file) 1023 (make-directory (file-name-directory nnmail-message-id-cache-file)
867 t)) 1024 t))
868 (write-region (point-min) (point-max) 1025 (write-region (point-min) (point-max)
869 nnmail-message-id-cache-file nil 'silent) 1026 nnmail-message-id-cache-file nil 'silent)
870 (set-buffer-modified-p nil)))) 1027 (set-buffer-modified-p nil)
1028 (setq nnmail-cache-buffer nil)
1029 ;;(kill-buffer (current-buffer))
1030 )))
871 1031
872 (defun nnmail-cache-insert (id) 1032 (defun nnmail-cache-insert (id)
873 (and nnmail-delete-duplicates 1033 (when nnmail-treat-duplicates
874 (save-excursion 1034 (save-excursion
875 (set-buffer nnmail-cache-buffer) 1035 (set-buffer nnmail-cache-buffer)
876 (goto-char (point-max)) 1036 (goto-char (point-max))
877 (insert id "\n")))) 1037 (insert id "\n"))))
878 1038
879 (defun nnmail-cache-id-exists-p (id) 1039 (defun nnmail-cache-id-exists-p (id)
880 (and nnmail-delete-duplicates 1040 (when nnmail-treat-duplicates
881 (save-excursion 1041 (save-excursion
882 (set-buffer nnmail-cache-buffer) 1042 (set-buffer nnmail-cache-buffer)
883 (goto-char (point-max)) 1043 (goto-char (point-max))
884 (search-backward id nil t)))) 1044 (search-backward id nil t))))
885 1045
886 1046 (defun nnmail-check-duplication (message-id func)
1047 ;; If this is a duplicate message, then we do not save it.
1048 (let* ((duplication (nnmail-cache-id-exists-p message-id))
1049 (action (when duplication
1050 (cond
1051 ((memq nnmail-treat-duplicates '(warn delete))
1052 nnmail-treat-duplicates)
1053 ((nnheader-functionp nnmail-treat-duplicates)
1054 (funcall nnmail-treat-duplicates message-id))
1055 (t
1056 nnmail-treat-duplicates)))))
1057 (cond
1058 ((not duplication)
1059 (nnmail-cache-insert message-id)
1060 (funcall func))
1061 ((eq action 'delete)
1062 (delete-region (point-min) (point-max)))
1063 ((eq action 'warn)
1064 ;; We insert a warning.
1065 (let ((case-fold-search t)
1066 (newid (nnmail-message-id)))
1067 (goto-char (point-min))
1068 (when (re-search-forward "^message-id:" nil t)
1069 (beginning-of-line)
1070 (insert "Original-"))
1071 (beginning-of-line)
1072 (insert
1073 "Message-ID: " newid "\n"
1074 "Gnus-Warning: This is a duplicate of message " message-id "\n")
1075 (nnmail-cache-insert newid)
1076 (funcall func)))
1077 (t
1078 (funcall func)))))
1079
1080 ;;; Get new mail.
1081
1082 (defun nnmail-get-value (&rest args)
1083 (let ((sym (intern (apply 'format args))))
1084 (when (boundp sym)
1085 (symbol-value sym))))
1086
1087 (defun nnmail-get-new-mail (method exit-func temp
1088 &optional group spool-func)
1089 "Read new incoming mail."
1090 (let* ((spools (nnmail-get-spool-files group))
1091 (group-in group)
1092 incoming incomings spool)
1093 (when (and (nnmail-get-value "%s-get-new-mail" method)
1094 nnmail-spool-file)
1095 ;; We first activate all the groups.
1096 (nnmail-activate method)
1097 ;; Allow the user to hook.
1098 (run-hooks 'nnmail-pre-get-new-mail-hook)
1099 ;; Open the message-id cache.
1100 (nnmail-cache-open)
1101 ;; The we go through all the existing spool files and split the
1102 ;; mail from each.
1103 (while spools
1104 (setq spool (pop spools))
1105 ;; We read each spool file if either the spool is a POP-mail
1106 ;; spool, or the file exists. We can't check for the
1107 ;; existance of POPped mail.
1108 (when (or (string-match "^po:" spool)
1109 (and (file-exists-p spool)
1110 (> (nth 7 (file-attributes (file-truename spool))) 0)))
1111 (nnheader-message 3 "%s: Reading incoming mail..." method)
1112 (when (and (nnmail-move-inbox spool)
1113 (file-exists-p nnmail-crash-box))
1114 ;; There is new mail. We first find out if all this mail
1115 ;; is supposed to go to some specific group.
1116 (setq group (nnmail-get-split-group spool group-in))
1117 ;; We split the mail
1118 (nnmail-split-incoming
1119 nnmail-crash-box (intern (format "%s-save-mail" method))
1120 spool-func group)
1121 ;; Check whether the inbox is to be moved to the special tmp dir.
1122 (setq incoming
1123 (nnmail-make-complex-temp-name
1124 (expand-file-name
1125 (if nnmail-tmp-directory
1126 (concat
1127 (file-name-as-directory nnmail-tmp-directory)
1128 (file-name-nondirectory (concat temp "Incoming")))
1129 (concat temp "Incoming")))))
1130 (rename-file nnmail-crash-box incoming t)
1131 (push incoming incomings))))
1132 ;; If we did indeed read any incoming spools, we save all info.
1133 (when incomings
1134 (nnmail-save-active
1135 (nnmail-get-value "%s-group-alist" method)
1136 (nnmail-get-value "%s-active-file" method))
1137 (when exit-func
1138 (funcall exit-func))
1139 (run-hooks 'nnmail-read-incoming-hook)
1140 (nnheader-message 3 "%s: Reading incoming mail...done" method))
1141 ;; Close the message-id cache.
1142 (nnmail-cache-close)
1143 ;; Allow the user to hook.
1144 (run-hooks 'nnmail-post-get-new-mail-hook)
1145 ;; Delete all the temporary files.
1146 (while incomings
1147 (setq incoming (pop incomings))
1148 (and nnmail-delete-incoming
1149 (file-exists-p incoming)
1150 (file-writable-p incoming)
1151 (delete-file incoming))))))
1152
1153 (defun nnmail-expired-article-p (group time force &optional inhibit)
1154 "Say whether an article that is TIME old in GROUP should be expired."
1155 (if force
1156 t
1157 (let ((days (or (and nnmail-expiry-wait-function
1158 (funcall nnmail-expiry-wait-function group))
1159 nnmail-expiry-wait)))
1160 (cond ((or (eq days 'never)
1161 (and (not force)
1162 inhibit))
1163 ;; This isn't an expirable group.
1164 nil)
1165 ((eq days 'immediate)
1166 ;; We expire all articles on sight.
1167 t)
1168 ((equal time '(0 0))
1169 ;; This is an ange-ftp group, and we don't have any dates.
1170 nil)
1171 ((numberp days)
1172 (setq days (nnmail-days-to-time days))
1173 ;; Compare the time with the current time.
1174 (nnmail-time-less days (nnmail-time-since time)))))))
1175
1176 (defvar nnmail-read-passwd nil)
1177 (defun nnmail-read-passwd (prompt)
1178 (unless nnmail-read-passwd
1179 (if (load "passwd" t)
1180 (setq nnmail-read-passwd 'read-passwd)
1181 (autoload 'ange-ftp-read-passwd "ange-ftp")
1182 (setq nnmail-read-passwd 'ange-ftp-read-passwd)))
1183 (funcall nnmail-read-passwd prompt))
1184
1185 (defun nnmail-check-syntax ()
1186 "Check (and modify) the syntax of the message in the current buffer."
1187 (save-restriction
1188 (message-narrow-to-head)
1189 (let ((case-fold-search t))
1190 (unless (re-search-forward "^Message-Id:" nil t)
1191 (insert "Message-ID: " (nnmail-message-id) "\n")))))
1192
1193 (run-hooks 'nnmail-load-hook)
1194
887 (provide 'nnmail) 1195 (provide 'nnmail)
888 1196
889 ;;; nnmail.el ends here 1197 ;;; nnmail.el ends here