cgit.sxemacs.org Git - gnus/blob - lisp/nnmail.el

   1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news, mail
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'nnheader)
  28 (require 'rmail)
  29 (require 'timezone)
  30 (require 'sendmail)
  31
  32 (defvar nnmail-split-methods
  33   '(("mail.misc" ""))
  34   "*Incoming mail will be split according to this variable.
  35
  36 If you'd like, for instance, one mail group for mail from the
  37 \"4ad-l\" mailing list, one group for junk mail and one for everything
  38 else, you could do something like this:
  39
  40  (setq nnmail-split-methods
  41        '((\"mail.4ad\" \"From:.*4ad\")
  42          (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
  43          (\"mail.misc\" \"\")))
  44
  45 As you can see, this variable is a list of lists, where the first
  46 element in each \"rule\" is the name of the group (which, by the way,
  47 does not have to be called anything beginning with \"mail\",
  48 \"yonka.zow\" is a fine, fine name), and the second is a regexp that
  49 nnmail will try to match on the header to find a fit.
  50
  51 The second element can also be a function.  In that case, it will be
  52 called narrowed to the headers with the first element of the rule as
  53 the argument.  It should return a non-nil value if it thinks that the
  54 mail belongs in that group.
  55
  56 The last element should always have \"\" as the regexp.
  57
  58 This variable can also have a function as its value.")
  59
  60 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
  61 (defvar nnmail-crosspost t
  62   "*If non-nil, do crossposting if several split methods match the mail.
  63 If nil, the first match found will be used.")
  64
  65 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
  66 (defvar nnmail-keep-last-article nil
  67   "*If non-nil, nnmail will never delete the last expired article in a
  68 directory.  You may need to set this variable if other programs are putting
  69 new mail into folder numbers that Gnus has marked as expired.")
  70
  71 (defvar nnmail-expiry-wait 7
  72   "*Articles that are older than `nnmail-expiry-wait' days will be expired.")
  73
  74 (defvar nnmail-expiry-wait-function nil
  75   "*Variable that holds function to specify how old articles should be before they are expired.
  76   The function will be called with the name of the group that the
  77 expiry is to be performed in, and it should return an integer that
  78 says how many days an article can be stored before it is considered
  79 'old'.
  80
  81 Eg.:
  82
  83 (setq nnmail-expiry-wait-function
  84       (lambda (newsgroup)
  85         (cond ((string-match \"private\" newsgroup) 31)
  86               ((string-match \"junk\" newsgroup) 1)
  87               (t 7))))")
  88
  89 (defvar nnmail-spool-file
  90   (or (getenv "MAIL")
  91       (concat "/usr/spool/mail/" (user-login-name)))
  92   "Where the mail backends will look for incoming mail.
  93 This variable is \"/usr/spool/mail/$user\" by default.
  94 If this variable is nil, no mail backends will read incoming mail.
  95 If this variable is a list, all files mentioned in this list will be
  96 used as incoming mailboxes.")
  97
  98 (defvar nnmail-use-procmail nil
  99   "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
 100 The file(s) in `nnmail-spool-file' will also be read.")
 101
 102 (defvar nnmail-procmail-directory "~/incoming/"
 103   "*When using procmail (and the like), incoming mail is put in this directory.
 104 The Gnus mail backends will read the mail from this directory.")
 105
 106 (defvar nnmail-procmail-suffix ".spool"
 107   "*Suffix of files created by procmail (and the like).
 108 This variable might be a suffix-regexp to match the suffixes of
 109 several files - eg. \".spool[0-9]*\".")
 110
 111 (defvar nnmail-resplit-incoming nil
 112   "*If non-nil, re-split incoming procmail sorted mail.")
 113
 114 (defvar nnmail-delete-file-function 'delete-file
 115   "Function called to delete files in some mail backends.")
 116
 117 (defvar nnmail-movemail-program "movemail"
 118   "*A command to be executed to move mail from the inbox.
 119 The default is \"movemail\".")
 120
 121 (defvar nnmail-read-incoming-hook nil
 122   "*Hook that will be run after the incoming mail has been transferred.
 123 The incoming mail is moved from `nnmail-spool-file' (which normally is
 124 something like \"/usr/spool/mail/$user\") to the user's home
 125 directory. This hook is called after the incoming mail box has been
 126 emptied, and can be used to call any mail box programs you have
 127 running (\"xwatch\", etc.)
 128
 129 Eg.
 130
 131 \(add-hook 'nnmail-read-incoming-hook
 132            (lambda ()
 133              (start-process \"mailsend\" nil
 134                             \"/local/bin/mailsend\" \"read\" \"mbox\")))
 135
 136 If you have xwatch running, this will alert it that mail has been
 137 read.
 138
 139 If you use `display-time', you could use something like this:
 140
 141 \(add-hook 'nnmail-read-incoming-hook
 142           (lambda ()
 143             ;; Update the displayed time, since that will clear out
 144             ;; the flag that says you have mail.
 145             (if (eq (process-status \"display-time\") 'run)
 146                 (display-time-filter display-time-process \"\"))))")
 147
 148 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
 149 (defvar nnmail-prepare-incoming-hook nil
 150   "*Hook called before treating incoming mail.
 151 The hook is run in a buffer with all the new, incoming mail.")
 152
 153 ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
 154 (defvar nnmail-tmp-directory nil
 155   "*If non-nil, use this directory for temporary storage when reading incoming mail.")
 156
 157 (defvar nnmail-large-newsgroup 50
 158   "*The number of the articles which indicates a large newsgroup.
 159 If the number of the articles is greater than the value, verbose
 160 messages will be shown to indicate the current status.")
 161
 162 (defvar nnmail-split-fancy "mail.misc"
 163   "*Incoming mail can be split according to this fancy variable.
 164 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
 165
 166 The format is this variable is SPLIT, where SPLIT can be one of
 167 the following:
 168
 169 GROUP: Mail will be stored in GROUP (a string).
 170
 171 \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
 172   VALUE (a regexp), store the messages as specified by SPLIT.
 173
 174 \(| SPLIT...): Process each SPLIT expression until one of them matches.
 175   A SPLIT expression is said to match if it will cause the mail
 176   message to be stored in one or more groups.
 177
 178 \(& SPLIT...): Process each SPLIT expression.
 179
 180 FIELD must match a complete field name.  VALUE must match a complete
 181 word according to the fundamental mode syntax table.  You can use .*
 182 in the regexps to match partial field names or words.
 183
 184 FIELD and VALUE can also be lisp symbols, in that case they are expanded
 185 as specified in `nnmail-split-abbrev-alist'.
 186
 187 Example:
 188
 189 \(setq nnmail-split-methods 'nnmail-split-fancy
 190       nnmail-split-fancy
 191       ;; Messages from the mailer deamon are not crossposted to any of
 192       ;; the ordinary groups.  Warnings are put in a separate group
 193       ;; from real errors.
 194       '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
 195                           \"mail.misc\"))
 196           ;; Non-error messages are crossposted to all relevant
 197           ;; groups, but we don't crosspost between the group for the
 198           ;; (ding) list and the group for other (ding) related mail.
 199           (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
 200                 (\"subject\" \"ding\" \"ding.misc\"))
 201              ;; Other mailing lists...
 202              (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
 203              (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
 204              ;; People...
 205              (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
 206           ;; Unmatched mail goes to the catch all group.
 207           \"misc.misc\"))")
 208
 209 (defvar nnmail-split-abbrev-alist
 210   '((any . "from\\|to\\|cc\\|sender\\|apparently-to")
 211     (mail . "mailer-daemon\\|postmaster"))
 212   "*Alist of abbreviations allowed in `nnmail-split-fancy'.")
 213
 214 (defvar nnmail-delete-incoming nil
 215   "*If non-nil, the mail backends will delete incoming files after splitting.")
 216
 217 (defvar nnmail-message-id-cache-length 1000
 218   "*The approximate number of Message-IDs nnmail will keep in its cache.
 219 If this variable is nil, no checking on duplicate messages will be
 220 perfomed.")
 221
 222 (defvar nnmail-message-id-cache-file "~/.nnmail-cache"
 223   "*The file name of the nnmail Message-ID cache.")
 224
 225 (defvar nnmail-delete-duplicates nil
 226   "*If non-nil, nnmail will delete any duplicate mails it sees.")
 227
 228 \f
 229
 230 (defconst nnmail-version "nnmail 1.0"
 231   "nnmail version.")
 232
 233 \f
 234
 235 (defun nnmail-request-post (&optional server)
 236   (mail-send-and-exit nil))
 237
 238 (defun nnmail-find-file (file)
 239   "Insert FILE in server buffer safely."
 240   (set-buffer nntp-server-buffer)
 241   (erase-buffer)
 242   (condition-case ()
 243       (progn (insert-file-contents file) t)
 244     (file-error nil)))
 245
 246 (defun nnmail-article-pathname (group mail-dir)
 247   "Make pathname for GROUP."
 248   (concat (file-name-as-directory (expand-file-name mail-dir))
 249           (nnmail-replace-chars-in-string group ?. ?/) "/"))
 250
 251 (defun nnmail-replace-chars-in-string (string from to)
 252   "Replace characters in STRING from FROM to TO."
 253   (let ((string (substring string 0))   ;Copy string.
 254         (len (length string))
 255         (idx 0))
 256     ;; Replace all occurrences of FROM with TO.
 257     (while (< idx len)
 258       (if (= (aref string idx) from)
 259           (aset string idx to))
 260       (setq idx (1+ idx)))
 261     string))
 262
 263 (defun nnmail-days-between (date1 date2)
 264   ;; Return the number of days between date1 and date2.
 265   (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) )
 266                     (timezone-parse-date date1)))
 267         (d2 (mapcar (lambda (s) (and s (string-to-int s)) )
 268                     (timezone-parse-date date2))))
 269     (- (timezone-absolute-from-gregorian
 270         (nth 1 d1) (nth 2 d1) (car d1))
 271        (timezone-absolute-from-gregorian
 272         (nth 1 d2) (nth 2 d2) (car d2)))))
 273
 274 ;; Function taken from rmail.el.
 275 (defun nnmail-move-inbox (inbox tofile)
 276   (let ((inbox (file-truename
 277                 (expand-file-name (substitute-in-file-name inbox))))
 278         movemail popmail errors)
 279     ;; Check whether the inbox is to be moved to the special tmp dir.
 280     (if nnmail-tmp-directory
 281         (setq tofile (concat (file-name-as-directory nnmail-tmp-directory)
 282                              (file-name-nondirectory tofile))))
 283     ;; Make the filename unique.
 284     (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile)))
 285     ;; We create the directory the tofile is to reside in if it
 286     ;; doesn't exist.
 287     (or (file-exists-p (file-name-directory tofile))
 288         (make-directory tofile 'parents))
 289     ;; If getting from mail spool directory,
 290     ;; use movemail to move rather than just renaming,
 291     ;; so as to interlock with the mailer.
 292     (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
 293         (setq movemail t))
 294     (if popmail (setq inbox (file-name-nondirectory inbox)))
 295     (if movemail
 296         ;; On some systems, /usr/spool/mail/foo is a directory
 297         ;; and the actual inbox is /usr/spool/mail/foo/foo.
 298         (if (file-directory-p inbox)
 299             (setq inbox (expand-file-name (user-login-name) inbox))))
 300     (if popmail
 301         (message "Getting mail from post office ...")
 302       (if (or (and (file-exists-p tofile)
 303                    (/= 0 (nth 7 (file-attributes tofile))))
 304               (and (file-exists-p inbox)
 305                    (/= 0 (nth 7 (file-attributes inbox)))))
 306           (message "Getting mail from %s..." inbox)))
 307     ;; Set TOFILE if have not already done so, and
 308     ;; rename or copy the file INBOX to TOFILE if and as appropriate.
 309     (cond ((or (file-exists-p tofile) (and (not popmail)
 310                                            (not (file-exists-p inbox))))
 311            nil)
 312           ((and (not movemail) (not popmail))
 313            ;; Try copying.  If that fails (perhaps no space),
 314            ;; rename instead.
 315            (condition-case nil
 316                (copy-file inbox tofile nil)
 317              (error
 318               ;; Third arg is t so we can replace existing file TOFILE.
 319               (rename-file inbox tofile t)))
 320            ;; Make the real inbox file empty.
 321            ;; Leaving it deleted could cause lossage
 322            ;; because mailers often won't create the file.
 323            (condition-case ()
 324                (write-region (point) (point) inbox)
 325              (file-error nil)))
 326           (t
 327            (unwind-protect
 328                (save-excursion
 329                  (setq errors (generate-new-buffer " *nnmail loss*"))
 330                  (buffer-disable-undo errors)
 331                  (call-process
 332                   (expand-file-name nnmail-movemail-program exec-directory)
 333                   nil errors nil inbox tofile)
 334                  (if (not (buffer-modified-p errors))
 335                      ;; No output => movemail won
 336                      nil
 337                    (set-buffer errors)
 338                    (subst-char-in-region (point-min) (point-max) ?\n ?\  )
 339                    (goto-char (point-max))
 340                    (skip-chars-backward " \t")
 341                    (delete-region (point) (point-max))
 342                    (goto-char (point-min))
 343                    (if (looking-at "movemail: ")
 344                        (delete-region (point-min) (match-end 0)))
 345                    (beep t)
 346                    (message (concat "movemail: "
 347                                     (buffer-substring (point-min)
 348                                                       (point-max))))
 349                    (sit-for 3)
 350                    nil)))))
 351     (and errors
 352          (buffer-name errors)
 353          (kill-buffer errors))
 354     tofile))
 355
 356
 357 (defun nnmail-get-active ()
 358   "Returns an assoc of group names and active ranges.
 359 nn*-request-list should have been called before calling this function."
 360   (let (group-assoc)
 361     ;; Go through all groups from the active list.
 362     (save-excursion
 363       (set-buffer nntp-server-buffer)
 364       (goto-char (point-min))
 365       (while (re-search-forward
 366               "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
 367         (setq group-assoc
 368               (cons (list (buffer-substring (match-beginning 1)
 369                                             (match-end 1))
 370                           (cons (string-to-int
 371                                  (buffer-substring (match-beginning 3)
 372                                                    (match-end 3)))
 373                                 (string-to-int
 374                                  (buffer-substring (match-beginning 2)
 375                                                    (match-end 2)))))
 376                     group-assoc))))
 377
 378     ;;    ;; In addition, add all groups mentioned in `nnmail-split-methods'.
 379     ;;    (let ((methods (and (not (symbolp nnmail-split-methods))
 380     ;;                  nnmail-split-methods)))
 381     ;;      (while methods
 382     ;;  (if (not (assoc (car (car methods)) group-assoc))
 383     ;;      (setq group-assoc
 384     ;;            (cons (list (car (car methods)) (cons 1 0))
 385     ;;                  group-assoc)))
 386     ;;  (setq methods (cdr methods)))
 387
 388     group-assoc))
 389
 390 (defun nnmail-save-active (group-assoc file-name)
 391   (let (group)
 392     (save-excursion
 393       (set-buffer (get-buffer-create " *nnmail active*"))
 394       (buffer-disable-undo (current-buffer))
 395       (erase-buffer)
 396       (while group-assoc
 397         (setq group (car group-assoc))
 398         (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) )
 399                         (car (car (cdr group)))))
 400         (setq group-assoc (cdr group-assoc)))
 401       (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
 402       (kill-buffer (current-buffer)))))
 403
 404 (defun nnmail-get-split-group (file group)
 405   (if (or (eq nnmail-spool-file 'procmail)
 406           nnmail-use-procmail)
 407       (cond (group group)
 408             ((string-match (concat "^" (expand-file-name
 409                                         (file-name-as-directory
 410                                          nnmail-procmail-directory))
 411                                    "\\(.*\\)" nnmail-procmail-suffix "$")
 412                            (expand-file-name file))
 413              (substring (expand-file-name file)
 414                         (match-beginning 1) (match-end 1)))
 415             (t
 416              group))
 417     group))
 418
 419 (defun nnmail-split-incoming (incoming func &optional exit-func group)
 420   "Go through the entire INCOMING file and pick out each individual mail.
 421 FUNC will be called with the buffer narrowed to each mail."
 422   (let ((delim (concat "^" rmail-unix-mail-delimiter))
 423         ;; If this is a group-specific split, we bind the split
 424         ;; methods to just this group.
 425         (nnmail-split-methods (if (and group
 426                                        (or (eq nnmail-spool-file 'procmail)
 427                                            nnmail-use-procmail)
 428                                        (not nnmail-resplit-incoming))
 429                                   (list (list group ""))
 430                                 nnmail-split-methods))
 431         start end content-length do-search message-id)
 432     (save-excursion
 433       ;; Open the message-id cache.
 434       (nnmail-cache-open)
 435       ;; Insert the incoming file.
 436       (set-buffer (get-buffer-create " *nnmail incoming*"))
 437       (buffer-disable-undo (current-buffer))
 438       (erase-buffer)
 439       (insert-file-contents incoming)
 440       (goto-char (point-min))
 441       (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
 442       ;; Go to the beginning of the first mail...
 443       (if (and (re-search-forward delim nil t)
 444                (goto-char (match-beginning 0)))
 445           ;; and then carry on until the bitter end.
 446           (while (not (eobp))
 447             (setq start (point))
 448             ;; Skip all the headers in case there are more "From "s...
 449             (if (not (search-forward "\n\n" nil t))
 450                 (forward-line 1))
 451             ;; Find the Message-ID header.
 452             (save-excursion
 453               (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
 454                   (setq message-id (buffer-substring (match-beginning 1)
 455                                                      (match-end 1)))
 456                 ;; There is no Message-ID here, so we create one.
 457                 (forward-line -1)
 458                 (insert "Message-ID: " (setq message-id (nnmail-message-id))
 459                         "\n")))
 460             ;; Look for a Content-Length header.
 461             (if (not (save-excursion
 462                        (and (re-search-backward
 463                              "^Content-Length: \\([0-9]+\\)" start t)
 464                             (setq content-length (string-to-int
 465                                                   (buffer-substring
 466                                                    (match-beginning 1)
 467                                                    (match-end 1))))
 468                             ;; We destroy the header, since none of
 469                             ;; the backends ever use it, and we do not
 470                             ;; want to confuse other mailers by having
 471                             ;; a (possibly) faulty header.
 472                             (progn (insert "X-") t))))
 473                 (setq do-search t)
 474               (if (or (= (+ (point) content-length) (point-max))
 475                       (save-excursion
 476                         (goto-char (+ (point) content-length))
 477                         (looking-at delim)))
 478                   (progn
 479                     (goto-char (+ (point) content-length))
 480                     (setq do-search nil))
 481                 (setq do-search t)))
 482             ;; Go to the beginning of the next article - or to the end
 483             ;; of the buffer.
 484             (if do-search
 485                 (if (re-search-forward delim nil t)
 486                     (goto-char (match-beginning 0))
 487                   (goto-char (point-max))))
 488             (save-excursion
 489               (save-restriction
 490                 (narrow-to-region start (point))
 491                 (goto-char (point-min))
 492                 ;; If this is a duplicate message, then we do not save it.
 493                 (if (nnmail-cache-id-exists-p message-id)
 494                     (delete-region (point-min) (point-max))
 495                   (nnmail-cache-insert message-id)
 496                   (funcall func))
 497                 (setq end (point-max))))
 498             (goto-char end)))
 499       ;; Close the message-id cache.
 500       (nnmail-cache-close)
 501       (if exit-func (funcall exit-func))
 502       (kill-buffer (current-buffer)))))
 503
 504 ;; Mail crossposts syggested by Brian Edmonds <edmonds@cs.ubc.ca>.
 505 (defun nnmail-article-group (func)
 506   "Look at the headers and return an alist of groups that match.
 507 FUNC will be called with the group name to determine the article number."
 508   (let ((methods nnmail-split-methods)
 509         (obuf (current-buffer))
 510         (beg (point-min))
 511         end group-art)
 512     (if (and (sequencep methods) (= (length methods) 1))
 513         ;; If there is only just one group to put everything in, we
 514         ;; just return a list with just this one method in.
 515         (setq group-art
 516               (list (cons (car (car methods))
 517                           (funcall func (car (car methods))))))
 518       ;; We do actual comparison.
 519       (save-excursion
 520         ;; Find headers.
 521         (goto-char beg)
 522         (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
 523         (set-buffer (get-buffer-create " *nnmail work*"))
 524         (buffer-disable-undo (current-buffer))
 525         (erase-buffer)
 526         ;; Copy the headers into the work buffer.
 527         (insert-buffer-substring obuf beg end)
 528         ;; Fold continuation lines.
 529         (goto-char (point-min))
 530         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 531           (replace-match " " t t))
 532         (if (and (symbolp nnmail-split-methods)
 533                  (fboundp nnmail-split-methods))
 534             (setq group-art
 535                   (mapcar
 536                    (lambda (group) (cons group (funcall func group)))
 537                    (condition-case nil
 538                        (funcall nnmail-split-methods)
 539                      (error
 540                       (message "\
 541 Problems with `nnmail-split-methods', using `bogus' mail group")
 542                       (sit-for 1)
 543                       '("bogus")))))
 544           ;; Go throught the split methods to find a match.
 545           (while (and methods (or nnmail-crosspost (not group-art)))
 546             (goto-char (point-max))
 547             (if (or (cdr methods)
 548                     (not (equal "" (nth 1 (car methods)))))
 549                 (if (and (condition-case ()
 550                              (if (stringp (nth 1 (car methods)))
 551                                  (re-search-backward
 552                                   (car (cdr (car methods))) nil t)
 553                                ;; Suggested by Brian Edmonds
 554                                ;; <edmonds@cs.ubc.ca>.
 555                                (funcall (nth 1 (car methods))
 556                                         (car (car methods))))
 557                            (error nil))
 558                          ;; Don't enter the article into the same group twice.
 559                          (not (assoc (car (car methods)) group-art)))
 560                     (setq group-art
 561                           (cons (cons (car (car methods))
 562                                       (funcall func (car (car methods))))
 563                                 group-art)))
 564               (or group-art
 565                   (setq group-art
 566                         (list (cons (car (car methods))
 567                                     (funcall func (car (car methods))))))))
 568             (setq methods (cdr methods))))
 569         (kill-buffer (current-buffer))
 570         group-art))))
 571
 572 (defun nnmail-insert-lines ()
 573   "Insert how many lines and chars there are in the body of the mail."
 574   (let (lines chars)
 575     (save-excursion
 576       (goto-char (point-min))
 577       (if (search-forward "\n\n" nil t)
 578           (progn
 579             (setq chars (- (point-max) (point)))
 580             (setq lines (- (count-lines (point) (point-max)) 1))
 581             (forward-char -1)
 582             (save-excursion
 583               (if (re-search-backward "^Lines: " nil t)
 584                   (delete-region (point) (progn (forward-line 1) (point)))))
 585             (insert (format "Lines: %d\n" lines))
 586             chars)))))
 587
 588 (defun nnmail-insert-xref (group-alist)
 589   "Insert an Xref line based on the (group . article) alist."
 590   (save-excursion
 591     (goto-char (point-min))
 592     (if (search-forward "\n\n" nil t)
 593         (progn
 594           (forward-char -1)
 595           (if (re-search-backward "^Xref: " nil t)
 596               (delete-region (match-beginning 0)
 597                              (progn (forward-line 1) (point))))
 598           (insert (format "Xref: %s" (system-name)))
 599           (while group-alist
 600             (insert (format " %s:%d" (car (car group-alist))
 601                             (cdr (car group-alist))))
 602             (setq group-alist (cdr group-alist)))
 603           (insert "\n")))))
 604
 605 ;; Written by byer@mv.us.adobe.com (Scott Byer).
 606 (defun nnmail-make-complex-temp-name (prefix)
 607   (let ((newname (make-temp-name prefix))
 608         (newprefix prefix))
 609     (while (file-exists-p newname)
 610       (setq newprefix (concat newprefix "x"))
 611       (setq newname (make-temp-name newprefix)))
 612     newname))
 613
 614 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
 615
 616 (defun nnmail-split-fancy ()
 617   "Fancy splitting method.
 618 See the documentation for the variable `nnmail-split-fancy' for documentation."
 619   (nnmail-split-it nnmail-split-fancy))
 620
 621 (defvar nnmail-split-cache nil)
 622 ;; Alist of split expresions their equivalent regexps.
 623
 624 (defun nnmail-split-it (split)
 625   ;; Return a list of groups matching SPLIT.
 626   (cond ((stringp split)
 627          ;; A group.
 628          (list split))
 629         ((eq (car split) '&)
 630          (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
 631         ((eq (car split) '|)
 632          (let (done)
 633            (while (and (not done) (cdr split))
 634              (setq split (cdr split)
 635                    done (nnmail-split-it (car split))))
 636            done))       ((assq split nnmail-split-cache)
 637                          ;; A compiled match expression.
 638          (goto-char (point-max))
 639          (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
 640              (nnmail-split-it (nth 2 split))))
 641         (t
 642          ;; An uncompiled match.
 643          (let* ((field (nth 0 split))
 644                 (value (nth 1 split))
 645                 (regexp (concat "^\\("
 646                                 (if (symbolp field)
 647                                     (cdr (assq field
 648                                                nnmail-split-abbrev-alist))
 649                                   field)
 650                                 "\\):.*\\<\\("
 651                                 (if (symbolp value)
 652                                     (cdr (assq value
 653                                                nnmail-split-abbrev-alist))
 654                                   value)
 655                                 "\\>\\)")))
 656            (setq nnmail-split-cache
 657                  (cons (cons split regexp) nnmail-split-cache))
 658            (goto-char (point-max))
 659            (if (re-search-backward regexp nil t)
 660                (nnmail-split-it (nth 2 split)))))))
 661
 662 ;; Get a list of spool files to read.
 663 (defun nnmail-get-spool-files (&optional group)
 664   (if (null nnmail-spool-file)
 665       ;; No spool file whatsoever.
 666       nil)
 667   (let* ((procmails
 668           ;; If procmail is used to get incoming mail, the files
 669           ;; are stored in this directory.
 670           (and (file-exists-p nnmail-procmail-directory)
 671                (directory-files
 672                 nnmail-procmail-directory
 673                 t (concat (if group group "")
 674                           nnmail-procmail-suffix "$") t)))
 675          (p procmails))
 676     ;; Remove any directories that inadvertantly match the procmail
 677     ;; suffix, which might happen if the suffix is "".
 678     (while p
 679       (and (or (file-directory-p (car p))
 680                (file-symlink-p (car p)))
 681            (setq procmails (delete (car p) procmails)))
 682       (setq p (cdr p)))
 683     (cond ((listp nnmail-spool-file)
 684            (append nnmail-spool-file procmails))
 685           ((stringp nnmail-spool-file)
 686            (cons nnmail-spool-file procmails))
 687           (t
 688            procmails))))
 689
 690 ;; Activate a backend only if it isn't already activated.
 691 ;; If FORCE, re-read the active file even if the backend is
 692 ;; already activated.
 693 (defun nnmail-activate (backend &optional force)
 694   (let (file timestamp file-time)
 695     (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
 696             force
 697             (and (setq file (condition-case ()
 698                                 (symbol-value (intern (format "%s-active-file"
 699                                                               backend)))
 700                               (error nil)))
 701                  (setq file-time (nth 5 (file-attributes file)))
 702                  (or (not
 703                       (setq timestamp
 704                             (condition-case ()
 705                                 (symbol-value (intern
 706                                                (format "%s-active-timestamp"
 707                                                        backend)))
 708                               (error 'none))))
 709                      (not (consp timestamp))
 710                      (equal timestamp '(0 0))
 711                      (> (nth 0 file-time) (nth 0 timestamp))
 712                      (and (= (nth 0 file-time) (nth 0 timestamp))
 713                           (> (nth 1 file-time) (nth 1 timestamp))))))
 714         (save-excursion
 715           (or (eq timestamp 'none)
 716               (set (intern (format "%s-active-timestamp" backend))
 717                    (current-time)))
 718           (funcall (intern (format "%s-request-list" backend)))
 719           (set (intern (format "%s-group-alist" backend))
 720                (nnmail-get-active))))
 721     t))
 722
 723 (defun nnmail-message-id ()
 724   (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>"))
 725
 726 (defvar nnmail-unique-id-char nil)
 727
 728 (defun nnmail-number-base36 (num len)
 729   (if (if (< len 0) (<= num 0) (= len 0))
 730       ""
 731     (concat (nnmail-number-base36 (/ num 36) (1- len))
 732             (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
 733                                   (% num 36))))))
 734
 735 (defun nnmail-unique-id ()
 736   (setq nnmail-unique-id-char
 737         (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20)))))
 738            ;; (current-time) returns 16-bit ints,
 739            ;; and 2^16*25 just fits into 4 digits i base 36.
 740            (* 25 25)))
 741   (let ((tm (if (fboundp 'current-time)
 742                 (current-time) '(12191 46742 287898))))
 743     (concat
 744      (nnmail-number-base36 (+ (car   tm)
 745                               (lsh (% nnmail-unique-id-char 25) 16)) 4)
 746      (nnmail-number-base36 (+ (nth 1 tm)
 747                               (lsh (/ nnmail-unique-id-char 25) 16)) 4))))
 748
 749 ;;;
 750 ;;; nnmail duplicate handling
 751 ;;;
 752
 753 (defvar nnmail-cache-buffer nil)
 754
 755 (defun nnmail-cache-open ()
 756   (if (or (not nnmail-delete-duplicates)
 757           (and nnmail-cache-buffer
 758                (buffer-name nnmail-cache-buffer)))
 759       ()                                ; The buffer is open.
 760     (save-excursion
 761       (set-buffer
 762        (setq nnmail-cache-buffer
 763              (get-buffer-create " *nnmail message-id cache*")))
 764       (buffer-disable-undo (current-buffer))
 765       (and (file-exists-p nnmail-message-id-cache-file)
 766            (insert-file-contents nnmail-message-id-cache-file))
 767       (current-buffer))))
 768
 769 (defun nnmail-cache-close ()
 770   (if (or (not nnmail-cache-buffer)
 771           (not nnmail-delete-duplicates)
 772           (not (buffer-name nnmail-cache-buffer))
 773           (not (buffer-modified-p nnmail-cache-buffer)))
 774       ()                                ; The buffer is closed.
 775     (save-excursion
 776       (set-buffer nnmail-cache-buffer)
 777       ;; Weed out the excess number of Message-IDs.
 778       (goto-char (point-max))
 779       (and (search-backward "\n" nil t nnmail-message-id-cache-length)
 780            (progn
 781              (beginning-of-line)
 782              (delete-region (point-min) (point))))
 783       ;; Save the buffer.
 784       (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
 785           (make-directory (file-name-directory nnmail-message-id-cache-file)
 786                           t))
 787       (write-region (point-min) (point-max)
 788                     nnmail-message-id-cache-file nil 'silent)
 789       (set-buffer-modified-p nil))))
 790
 791 (defun nnmail-cache-insert (id)
 792   (and nnmail-delete-duplicates
 793        (save-excursion
 794          (set-buffer nnmail-cache-buffer)
 795          (goto-char (point-max))
 796          (insert id "\n"))))
 797
 798 (defun nnmail-cache-id-exists-p (id)
 799   (and nnmail-delete-duplicates
 800        (save-excursion
 801          (set-buffer nnmail-cache-buffer)
 802          (goto-char (point-max))
 803          (search-backward id nil t))))
 804
 805 (defun nnmail-get-value (&rest args)
 806   (let ((sym (intern (apply 'format args))))
 807     (and (boundp sym)
 808          (symbol-value sym))))
 809
 810 (defun nnmail-get-new-mail (method exit-func temp
 811                                    &optional group spool-func)
 812   "Read new incoming mail."
 813   (let* ((spools (nnmail-get-spool-files group))
 814          (group-in group)
 815          incoming incomings)
 816     (if (or (not (nnmail-get-value "%s-get-new-mail" method))
 817             (not nnmail-spool-file))
 818         () ; We don't want to look for new mail.
 819       ;; We first activate all the groups.
 820       (nnmail-activate method)
 821       ;; The we go through all the existing spool files and split the
 822       ;; mail from each.
 823       (while spools
 824         (and
 825          (file-exists-p (car spools))
 826          (> (nth 7 (file-attributes (car spools))) 0)
 827          (progn
 828            (and gnus-verbose-backends
 829                 (message "%s: Reading incoming mail..." method))
 830            (if (not (setq incoming
 831                           (nnmail-move-inbox
 832                            (car spools)
 833                            (concat temp "Incoming"))))
 834                () ; There is no new mail.
 835              (setq group (nnmail-get-split-group (car spools) group-in))
 836              (nnmail-split-incoming
 837               incoming (intern (format "%s-save-mail" method))
 838               spool-func group)
 839              (setq incomings (cons incoming incomings)))))
 840         (setq spools (cdr spools)))
 841       ;; If we did indeed read any incoming spools, we save all info.
 842       (when incomings
 843         (nnmail-save-active
 844          (nnmail-get-value "%s-group-alist" method)
 845          (nnmail-get-value "%s-active-file" method))
 846         (and exit-func (funcall exit-func))
 847         (run-hooks 'nnmail-read-incoming-hook)
 848         (and gnus-verbose-backends
 849              (message "%s: Reading incoming mail...done" method)))
 850       (while incomings
 851         (setq incoming (car incomings))
 852         (and nnmail-delete-incoming
 853              (file-exists-p incoming)
 854              (file-writable-p incoming)
 855              (delete-file incoming))
 856         (setq incomings (cdr incomings))))))
 857
 858 (provide 'nnmail)
 859
 860 ;;; nnmail.el ends here