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

   1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
   2 ;; Copyright (C) 1995-2000 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   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 the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile (require 'cl))
  29
  30 (require 'nnheader)
  31 (require 'message)
  32 (require 'custom)
  33 (require 'gnus-util)
  34 (require 'mail-source)
  35 (require 'mm-util)
  36
  37 (eval-and-compile
  38   (autoload 'gnus-error "gnus-util")
  39   (autoload 'gnus-buffer-live-p "gnus-util"))
  40
  41 (defgroup nnmail nil
  42   "Reading mail with Gnus."
  43   :group 'gnus)
  44
  45 (defgroup nnmail-retrieve nil
  46   "Retrieving new mail."
  47   :group 'nnmail)
  48
  49 (defgroup nnmail-prepare nil
  50   "Preparing (or mangling) new mail after retrival."
  51   :group 'nnmail)
  52
  53 (defgroup nnmail-duplicate nil
  54   "Handling of duplicate mail messages."
  55   :group 'nnmail)
  56
  57 (defgroup nnmail-split nil
  58   "Organizing the incomming mail in folders."
  59   :group 'nnmail)
  60
  61 (defgroup nnmail-files nil
  62   "Mail files."
  63   :group 'gnus-files
  64   :group 'nnmail)
  65
  66 (defgroup nnmail-expire nil
  67   "Expiring old mail."
  68   :group 'nnmail)
  69
  70 (defgroup nnmail-procmail nil
  71   "Interfacing with procmail and other mail agents."
  72   :group 'nnmail)
  73
  74 (defgroup nnmail-various nil
  75   "Various mail options."
  76   :group 'nnmail)
  77
  78 (defcustom nnmail-split-methods
  79   '(("mail.misc" ""))
  80   "*Incoming mail will be split according to this variable.
  81
  82 If you'd like, for instance, one mail group for mail from the
  83 \"4ad-l\" mailing list, one group for junk mail and one for everything
  84 else, you could do something like this:
  85
  86  (setq nnmail-split-methods
  87        '((\"mail.4ad\" \"From:.*4ad\")
  88          (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
  89          (\"mail.misc\" \"\")))
  90
  91 As you can see, this variable is a list of lists, where the first
  92 element in each \"rule\" is the name of the group (which, by the way,
  93 does not have to be called anything beginning with \"mail\",
  94 \"yonka.zow\" is a fine, fine name), and the second is a regexp that
  95 nnmail will try to match on the header to find a fit.
  96
  97 The second element can also be a function.  In that case, it will be
  98 called narrowed to the headers with the first element of the rule as
  99 the argument.  It should return a non-nil value if it thinks that the
 100 mail belongs in that group.
 101
 102 The last element should always have \"\" as the regexp.
 103
 104 This variable can also have a function as its value."
 105   :group 'nnmail-split
 106   :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
 107                  (function-item nnmail-split-fancy)
 108                  (function :tag "Other")))
 109
 110 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
 111 (defcustom nnmail-crosspost t
 112   "If non-nil, do crossposting if several split methods match the mail.
 113 If nil, the first match found will be used."
 114   :group 'nnmail-split
 115   :type 'boolean)
 116
 117 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
 118 (defcustom nnmail-keep-last-article nil
 119   "If non-nil, nnmail will never delete/move a group's last article.
 120 It can be marked expirable, so it will be deleted when it is no longer last.
 121
 122 You may need to set this variable if other programs are putting
 123 new mail into folder numbers that Gnus has marked as expired."
 124   :group 'nnmail-procmail
 125   :group 'nnmail-various
 126   :type 'boolean)
 127
 128 (defcustom nnmail-use-long-file-names nil
 129   "If non-nil the mail backends will use long file and directory names.
 130 If nil, groups like \"mail.misc\" will end up in directories like
 131 \"mail/misc/\"."
 132   :group 'nnmail-files
 133   :type 'boolean)
 134
 135 (defcustom nnmail-default-file-modes 384
 136   "Set the mode bits of all new mail files to this integer."
 137   :group 'nnmail-files
 138   :type 'integer)
 139
 140 (defcustom nnmail-expiry-wait 7
 141   "*Expirable articles that are older than this will be expired.
 142 This variable can either be a number (which will be interpreted as a
 143 number of days) -- this doesn't have to be an integer.  This variable
 144 can also be `immediate' and `never'."
 145   :group 'nnmail-expire
 146   :type '(choice (const immediate)
 147                  (integer :tag "days")
 148                  (const never)))
 149
 150 (defcustom nnmail-expiry-wait-function nil
 151   "Variable that holds function to specify how old articles should be before they are expired.
 152   The function will be called with the name of the group that the
 153 expiry is to be performed in, and it should return an integer that
 154 says how many days an article can be stored before it is considered
 155 \"old\".  It can also return the values `never' and `immediate'.
 156
 157 Eg.:
 158
 159 \(setq nnmail-expiry-wait-function
 160       (lambda (newsgroup)
 161         (cond ((string-match \"private\" newsgroup) 31)
 162               ((string-match \"junk\" newsgroup) 1)
 163               ((string-match \"important\" newsgroup) 'never)
 164               (t 7))))"
 165   :group 'nnmail-expire
 166   :type '(choice (const :tag "nnmail-expiry-wait" nil)
 167                  (function :format "%v" nnmail-)))
 168
 169 (defcustom nnmail-expiry-target 'delete
 170   "*Variable that says where expired messages should end up."
 171     :group 'nnmail-expire
 172     :type '(choice (const delete)
 173                    (function :format "%v" nnmail-)
 174                    string))
 175
 176 (defcustom nnmail-cache-accepted-message-ids nil
 177   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
 178   :group 'nnmail
 179   :type 'boolean)
 180
 181 (defcustom nnmail-spool-file '((file))
 182   "*Where the mail backends will look for incoming mail.
 183 This variable is a list of mail source specifiers.
 184 This variable is obsolete; `mail-sources' should be used instead."
 185   :group 'nnmail-files
 186   :type 'sexp)
 187
 188 (defcustom nnmail-resplit-incoming nil
 189   "*If non-nil, re-split incoming procmail sorted mail."
 190   :group 'nnmail-procmail
 191   :type 'boolean)
 192
 193 (defcustom nnmail-delete-file-function 'delete-file
 194   "Function called to delete files in some mail backends."
 195   :group 'nnmail-files
 196   :type 'function)
 197
 198 (defcustom nnmail-crosspost-link-function
 199   (if (string-match "windows-nt\\|emx" (symbol-name system-type))
 200       'copy-file
 201     'add-name-to-file)
 202   "*Function called to create a copy of a file.
 203 This is `add-name-to-file' by default, which means that crossposts
 204 will use hard links.  If your file system doesn't allow hard
 205 links, you could set this variable to `copy-file' instead."
 206   :group 'nnmail-files
 207   :type '(radio (function-item add-name-to-file)
 208                 (function-item copy-file)
 209                 (function :tag "Other")))
 210
 211 (defcustom nnmail-read-incoming-hook
 212   (if (eq system-type 'windows-nt)
 213       '(nnheader-ms-strip-cr)
 214     nil)
 215   "*Hook that will be run after the incoming mail has been transferred.
 216 The incoming mail is moved from `nnmail-spool-file' (which normally is
 217 something like \"/usr/spool/mail/$user\") to the user's home
 218 directory.  This hook is called after the incoming mail box has been
 219 emptied, and can be used to call any mail box programs you have
 220 running (\"xwatch\", etc.)
 221
 222 Eg.
 223
 224 \(add-hook 'nnmail-read-incoming-hook
 225            (lambda ()
 226              (start-process \"mailsend\" nil
 227                             \"/local/bin/mailsend\" \"read\" \"mbox\")))
 228
 229 If you have xwatch running, this will alert it that mail has been
 230 read.
 231
 232 If you use `display-time', you could use something like this:
 233
 234 \(add-hook 'nnmail-read-incoming-hook
 235           (lambda ()
 236             ;; Update the displayed time, since that will clear out
 237             ;; the flag that says you have mail.
 238             (when (eq (process-status \"display-time\") 'run)
 239               (display-time-filter display-time-process \"\"))))"
 240   :group 'nnmail-prepare
 241   :type 'hook)
 242
 243 (defcustom nnmail-prepare-incoming-hook nil
 244   "Hook called before treating incoming mail.
 245 The hook is run in a buffer with all the new, incoming mail."
 246   :group 'nnmail-prepare
 247   :type 'hook)
 248
 249 (defcustom nnmail-prepare-incoming-header-hook nil
 250   "Hook called narrowed to the headers of each message.
 251 This can be used to remove excessive spaces (and stuff like
 252 that) from the headers before splitting and saving the messages."
 253   :group 'nnmail-prepare
 254   :type 'hook)
 255
 256 (defcustom nnmail-prepare-incoming-message-hook nil
 257   "Hook called narrowed to each message."
 258   :group 'nnmail-prepare
 259   :type 'hook)
 260
 261 (defcustom nnmail-list-identifiers nil
 262   "Regexp that matches list identifiers to be removed.
 263 This can also be a list of regexps."
 264   :group 'nnmail-prepare
 265   :type '(choice (const :tag "none" nil)
 266                  (regexp :value ".*")
 267                  (repeat :value (".*") regexp)))
 268
 269 (defcustom nnmail-pre-get-new-mail-hook nil
 270   "Hook called just before starting to handle new incoming mail."
 271   :group 'nnmail-retrieve
 272   :type 'hook)
 273
 274 (defcustom nnmail-post-get-new-mail-hook nil
 275   "Hook called just after finishing handling new incoming mail."
 276   :group 'nnmail-retrieve
 277   :type 'hook)
 278
 279 (defcustom nnmail-split-hook nil
 280   "Hook called before deciding where to split an article.
 281 The functions in this hook are free to modify the buffer
 282 contents in any way they choose -- the buffer contents are
 283 discarded after running the split process."
 284   :group 'nnmail-split
 285   :type 'hook)
 286
 287 (defcustom nnmail-large-newsgroup 50
 288   "*The number of the articles which indicates a large newsgroup.
 289 If the number of the articles is greater than the value, verbose
 290 messages will be shown to indicate the current status."
 291   :group 'nnmail-various
 292   :type 'integer)
 293
 294 (defcustom nnmail-split-fancy "mail.misc"
 295   "Incoming mail can be split according to this fancy variable.
 296 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
 297
 298 The format of this variable is SPLIT, where SPLIT can be one of
 299 the following:
 300
 301 GROUP: Mail will be stored in GROUP (a string).
 302
 303 \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
 304   field FIELD (a regexp) contains VALUE (a regexp), store the messages
 305   as specified by SPLIT.  If RESTRICT (a regexp) matches some string
 306   after FIELD and before the end of the matched VALUE, return NIL,
 307   otherwise process SPLIT.  Multiple RESTRICTs add up, further
 308   restricting the possibility of processing SPLIT.
 309
 310 \(| SPLIT...): Process each SPLIT expression until one of them matches.
 311   A SPLIT expression is said to match if it will cause the mail
 312   message to be stored in one or more groups.
 313
 314 \(& SPLIT...): Process each SPLIT expression.
 315
 316 \(: FUNCTION optional args): Call FUNCTION with the optional args, in
 317   the buffer containing the message headers.  The return value FUNCTION
 318   should be a split, which is then recursively processed.
 319
 320 \(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT.  The
 321   return value FUNCTION should be a split, which is then recursively
 322   processed.
 323
 324 FIELD must match a complete field name.  VALUE must match a complete
 325 word according to the `nnmail-split-fancy-syntax-table' syntax table.
 326 You can use \".*\" in the regexps to match partial field names or words.
 327
 328 FIELD and VALUE can also be lisp symbols, in that case they are expanded
 329 as specified in `nnmail-split-abbrev-alist'.
 330
 331 GROUP can contain \\& and \\N which will substitute from matching
 332 \\(\\) patterns in the previous VALUE.
 333
 334 Example:
 335
 336 \(setq nnmail-split-methods 'nnmail-split-fancy
 337       nnmail-split-fancy
 338       ;; Messages from the mailer daemon are not crossposted to any of
 339       ;; the ordinary groups.  Warnings are put in a separate group
 340       ;; from real errors.
 341       '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
 342                           \"mail.misc\"))
 343           ;; Non-error messages are crossposted to all relevant
 344           ;; groups, but we don't crosspost between the group for the
 345           ;; (ding) list and the group for other (ding) related mail.
 346           (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
 347                 (\"subject\" \"ding\" \"ding.misc\"))
 348              ;; Other mailing lists...
 349              (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
 350              (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
 351              ;; Both lists below have the same suffix, so prevent
 352              ;; cross-posting to mkpkg.list of messages posted only to
 353              ;; the bugs- list, but allow cross-posting when the
 354              ;; message was really cross-posted.
 355              (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
 356              (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
 357              ;;
 358              ;; People...
 359              (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
 360           ;; Unmatched mail goes to the catch all group.
 361           \"misc.misc\"))"
 362   :group 'nnmail-split
 363   ;; Sigh!
 364   :type 'sexp)
 365
 366 (defcustom nnmail-split-abbrev-alist
 367   '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
 368     (mail . "mailer-daemon\\|postmaster\\|uucp")
 369     (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
 370     (from . "from\\|sender\\|resent-from")
 371     (nato . "to\\|cc\\|resent-to\\|resent-cc")
 372     (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
 373   "*Alist of abbreviations allowed in `nnmail-split-fancy'."
 374   :group 'nnmail-split
 375   :type '(repeat (cons :format "%v" symbol regexp)))
 376
 377 (defcustom nnmail-message-id-cache-length 1000
 378   "*The approximate number of Message-IDs nnmail will keep in its cache.
 379 If this variable is nil, no checking on duplicate messages will be
 380 performed."
 381   :group 'nnmail-duplicate
 382   :type '(choice (const :tag "disable" nil)
 383                  (integer :format "%v")))
 384
 385 (defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
 386   "*The file name of the nnmail Message-ID cache."
 387   :group 'nnmail-duplicate
 388   :group 'nnmail-files
 389   :type 'file)
 390
 391 (defcustom nnmail-treat-duplicates 'warn
 392   "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
 393 Three values are valid: nil, which means that nnmail is not to keep a
 394 Message-ID cache; `warn', which means that nnmail should insert extra
 395 headers to warn the user about the duplication (this is the default);
 396 and `delete', which means that nnmail will delete duplicated mails.
 397
 398 This variable can also be a function.  It will be called from a buffer
 399 narrowed to the article in question with the Message-ID as a
 400 parameter.  It should return nil, `warn' or `delete'."
 401   :group 'nnmail-duplicate
 402   :type '(choice (const :tag "off" nil)
 403                  (const warn)
 404                  (const delete)))
 405
 406 (defcustom nnmail-extra-headers nil
 407   "*Extra headers to parse."
 408   :group 'nnmail
 409   :type '(repeat symbol))
 410
 411 (defcustom nnmail-split-header-length-limit 512
 412   "Header lines longer than this limit are excluded from the split function."
 413   :group 'nnmail
 414   :type 'integer)
 415
 416 ;;; Internal variables.
 417
 418 (defvar nnmail-split-history nil
 419   "List of group/article elements that say where the previous split put messages.")
 420
 421 (defvar nnmail-split-fancy-syntax-table nil
 422   "Syntax table used by `nnmail-split-fancy'.")
 423 (unless (syntax-table-p nnmail-split-fancy-syntax-table)
 424   (setq nnmail-split-fancy-syntax-table
 425         (copy-syntax-table (standard-syntax-table)))
 426   ;; support the %-hack
 427   (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table))
 428
 429 (defvar nnmail-prepare-save-mail-hook nil
 430   "Hook called before saving mail.")
 431
 432 (defvar nnmail-split-tracing nil)
 433 (defvar nnmail-split-trace nil)
 434
 435 \f
 436
 437 (defconst nnmail-version "nnmail 1.0"
 438   "nnmail version.")
 439
 440 \f
 441
 442 (defun nnmail-request-post (&optional server)
 443   (mail-send-and-exit nil))
 444
 445 (defvar nnmail-file-coding-system 'raw-text
 446   "Coding system used in nnmail.")
 447
 448 (defvar nnmail-incoming-coding-system
 449   mm-text-coding-system
 450   "Coding system used in reading inbox")
 451
 452 (defvar nnmail-pathname-coding-system 'binary
 453   "*Coding system for pathname.")
 454
 455 (defun nnmail-find-file (file)
 456   "Insert FILE in server buffer safely."
 457   (set-buffer nntp-server-buffer)
 458   (delete-region (point-min) (point-max))
 459   (let ((format-alist nil)
 460         (after-insert-file-functions nil))
 461     (condition-case ()
 462         (let ((coding-system-for-read nnmail-file-coding-system)
 463               (auto-mode-alist (mm-auto-mode-alist))
 464               (pathname-coding-system nnmail-pathname-coding-system))
 465           (insert-file-contents file)
 466           t)
 467       (file-error nil))))
 468
 469 (defun nnmail-group-pathname (group dir &optional file)
 470   "Make pathname for GROUP."
 471   (concat
 472    (let ((dir (file-name-as-directory (expand-file-name dir))))
 473      (setq group (nnheader-replace-duplicate-chars-in-string
 474                   (nnheader-replace-chars-in-string group ?/ ?_)
 475                   ?. ?_))
 476      (setq group (nnheader-translate-file-chars group))
 477      ;; If this directory exists, we use it directly.
 478      (file-name-as-directory
 479       (if (or nnmail-use-long-file-names
 480               (file-directory-p (concat dir group)))
 481           (expand-file-name group dir)
 482         ;; If not, we translate dots into slashes.
 483         (expand-file-name
 484          (mm-encode-coding-string
 485           (nnheader-replace-chars-in-string group ?. ?/)
 486           nnmail-pathname-coding-system)
 487          dir))))
 488    (or file "")))
 489
 490 (defun nnmail-get-active ()
 491   "Returns an assoc of group names and active ranges.
 492 nn*-request-list should have been called before calling this function."
 493   ;; Go through all groups from the active list.
 494   (save-excursion
 495     (set-buffer nntp-server-buffer)
 496     (nnmail-parse-active)))
 497
 498 (defun nnmail-parse-active ()
 499   "Parse the active file in the current buffer and return an alist."
 500   (goto-char (point-min))
 501   (unless (re-search-forward "[\\\"]" nil t)
 502     (goto-char (point-max))
 503     (while (re-search-backward "[][';?()#]" nil t)
 504       (insert ?\\)))
 505   (goto-char (point-min))
 506   (let ((buffer (current-buffer))
 507         group-assoc group max min)
 508     (while (not (eobp))
 509       (condition-case err
 510           (progn
 511             (narrow-to-region (point) (gnus-point-at-eol))
 512             (setq group (read buffer))
 513             (unless (stringp group)
 514               (setq group (symbol-name group)))
 515             (if (and (numberp (setq max (read nntp-server-buffer)))
 516                      (numberp (setq min (read nntp-server-buffer))))
 517                 (push (list group (cons min max))
 518                       group-assoc)))
 519         (error nil))
 520       (widen)
 521       (forward-line 1))
 522     group-assoc))
 523
 524 (defvar nnmail-active-file-coding-system 'raw-text
 525   "*Coding system for active file.")
 526
 527 (defun nnmail-save-active (group-assoc file-name)
 528   "Save GROUP-ASSOC in ACTIVE-FILE."
 529   (let ((coding-system-for-write nnmail-active-file-coding-system))
 530     (when file-name
 531       (with-temp-file file-name
 532         (nnmail-generate-active group-assoc)))))
 533
 534 (defun nnmail-generate-active (alist)
 535   "Generate an active file from group-alist ALIST."
 536   (erase-buffer)
 537   (let (group)
 538     (while (setq group (pop alist))
 539       (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
 540                       (caadr group))))
 541     (goto-char (point-max))
 542     (while (search-backward "\\." nil t)
 543       (delete-char 1))))
 544
 545 (defun nnmail-get-split-group (file source)
 546   "Find out whether this FILE is to be split into GROUP only.
 547 If SOURCE is a directory spec, try to return the group name component."
 548   (if (eq (car source) 'directory)
 549       (let ((file (file-name-nondirectory file)))
 550         (mail-source-bind (directory source)
 551           (if (string-match (concat (regexp-quote suffix) "$") file)
 552               (substring file 0 (match-beginning 0))
 553             nil)))
 554     nil))
 555
 556 (defun nnmail-process-babyl-mail-format (func artnum-func)
 557   (let ((case-fold-search t)
 558         (count 0)
 559         start message-id content-length do-search end)
 560     (while (not (eobp))
 561       (goto-char (point-min))
 562       (re-search-forward
 563        "\f\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
 564       (goto-char (match-end 0))
 565       (delete-region (match-beginning 0) (match-end 0))
 566       (narrow-to-region
 567        (setq start (point))
 568        (progn
 569          ;; Skip all the headers in case there are more "From "s...
 570          (or (search-forward "\n\n" nil t)
 571              (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
 572              (search-forward "\1f\f"))
 573          (point)))
 574       ;; Unquote the ">From " line, if any.
 575       (goto-char (point-min))
 576       (when (looking-at ">From ")
 577         (replace-match "X-From-Line: ") )
 578       (run-hooks 'nnmail-prepare-incoming-header-hook)
 579       (goto-char (point-max))
 580       ;; Find the Message-ID header.
 581       (save-excursion
 582         (if (re-search-backward
 583              "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
 584             (setq message-id (buffer-substring (match-beginning 1)
 585                                                (match-end 1)))
 586           ;; There is no Message-ID here, so we create one.
 587           (save-excursion
 588             (when (re-search-backward "^Message-ID[ \t]*:" nil t)
 589               (beginning-of-line)
 590               (insert "Original-")))
 591           (forward-line -1)
 592           (insert "Message-ID: " (setq message-id (nnmail-message-id))
 593                   "\n")))
 594       ;; Look for a Content-Length header.
 595       (if (not (save-excursion
 596                  (and (re-search-backward
 597                        "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
 598                       (setq content-length (string-to-int
 599                                             (buffer-substring
 600                                              (match-beginning 1)
 601                                              (match-end 1))))
 602                       ;; We destroy the header, since none of
 603                       ;; the backends ever use it, and we do not
 604                       ;; want to confuse other mailers by having
 605                       ;; a (possibly) faulty header.
 606                       (progn (insert "X-") t))))
 607           (setq do-search t)
 608         (widen)
 609         (if (or (= (+ (point) content-length) (point-max))
 610                 (save-excursion
 611                   (goto-char (+ (point) content-length))
 612                   (looking-at "\1f")))
 613             (progn
 614               (goto-char (+ (point) content-length))
 615               (setq do-search nil))
 616           (setq do-search t)))
 617       (widen)
 618       ;; Go to the beginning of the next article - or to the end
 619       ;; of the buffer.
 620       (when do-search
 621         (if (re-search-forward "^\1f" nil t)
 622             (goto-char (match-beginning 0))
 623           (goto-char (1- (point-max)))))
 624       (delete-char 1)                   ; delete ^_
 625       (save-excursion
 626         (save-restriction
 627           (narrow-to-region start (point))
 628           (goto-char (point-min))
 629           (nnmail-check-duplication message-id func artnum-func)
 630           (incf count)
 631           (setq end (point-max))))
 632       (goto-char end))
 633     count))
 634
 635 (defsubst nnmail-search-unix-mail-delim ()
 636   "Put point at the beginning of the next Unix mbox message."
 637   ;; Algorithm used to find the the next article in the
 638   ;; brain-dead Unix mbox format:
 639   ;;
 640   ;; 1) Search for "^From ".
 641   ;; 2) If we find it, then see whether the previous
 642   ;;    line is blank and the next line looks like a header.
 643   ;; Then it's possible that this is a mail delim, and we use it.
 644   (let ((case-fold-search nil)
 645         found)
 646     (while (not found)
 647       (if (not (re-search-forward "^From " nil t))
 648           (setq found 'no)
 649         (save-excursion
 650           (beginning-of-line)
 651           (when (and (or (bobp)
 652                          (save-excursion
 653                            (forward-line -1)
 654                            (eq (char-after) ?\n)))
 655                      (save-excursion
 656                        (forward-line 1)
 657                        (while (looking-at ">From \\|From ")
 658                          (forward-line 1))
 659                        (looking-at "[^ \n\t:]+[ \n\t]*:")))
 660             (setq found 'yes)))))
 661     (beginning-of-line)
 662     (eq found 'yes)))
 663
 664 (defun nnmail-search-unix-mail-delim-backward ()
 665   "Put point at the beginning of the current Unix mbox message."
 666   ;; Algorithm used to find the the next article in the
 667   ;; brain-dead Unix mbox format:
 668   ;;
 669   ;; 1) Search for "^From ".
 670   ;; 2) If we find it, then see whether the previous
 671   ;;    line is blank and the next line looks like a header.
 672   ;; Then it's possible that this is a mail delim, and we use it.
 673   (let ((case-fold-search nil)
 674         found)
 675     (while (not found)
 676       (if (not (re-search-backward "^From " nil t))
 677           (setq found 'no)
 678         (save-excursion
 679           (beginning-of-line)
 680           (when (and (or (bobp)
 681                          (save-excursion
 682                            (forward-line -1)
 683                            (eq (char-after) ?\n)))
 684                      (save-excursion
 685                        (forward-line 1)
 686                        (while (looking-at ">From \\|From ")
 687                          (forward-line 1))
 688                        (looking-at "[^ \n\t:]+[ \n\t]*:")))
 689             (setq found 'yes)))))
 690     (beginning-of-line)
 691     (eq found 'yes)))
 692
 693 (defun nnmail-process-unix-mail-format (func artnum-func)
 694   (let ((case-fold-search t)
 695         (count 0)
 696         start message-id content-length end skip head-end)
 697     (goto-char (point-min))
 698     (if (not (and (re-search-forward "^From " nil t)
 699                   (goto-char (match-beginning 0))))
 700         ;; Possibly wrong format?
 701         (error "Error, unknown mail format! (Possibly corrupted.)")
 702       ;; Carry on until the bitter end.
 703       (while (not (eobp))
 704         (setq start (point)
 705               end nil)
 706         ;; Find the end of the head.
 707         (narrow-to-region
 708          start
 709          (if (search-forward "\n\n" nil t)
 710              (1- (point))
 711            ;; This will never happen, but just to be on the safe side --
 712            ;; if there is no head-body delimiter, we search a bit manually.
 713            (while (and (looking-at "From \\|[^ \t]+:")
 714                        (not (eobp)))
 715              (forward-line 1))
 716            (point)))
 717         ;; Find the Message-ID header.
 718         (goto-char (point-min))
 719         (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
 720             (setq message-id (match-string 1))
 721           (save-excursion
 722             (when (re-search-forward "^Message-ID[ \t]*:" nil t)
 723               (beginning-of-line)
 724               (insert "Original-")))
 725           ;; There is no Message-ID here, so we create one.
 726           (forward-line 1)
 727           (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
 728         ;; Look for a Content-Length header.
 729         (goto-char (point-min))
 730         (if (not (re-search-forward
 731                   "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
 732             (setq content-length nil)
 733           (setq content-length (string-to-int (match-string 1)))
 734           ;; We destroy the header, since none of the backends ever
 735           ;; use it, and we do not want to confuse other mailers by
 736           ;; having a (possibly) faulty header.
 737           (beginning-of-line)
 738           (insert "X-"))
 739         (run-hooks 'nnmail-prepare-incoming-header-hook)
 740         ;; Find the end of this article.
 741         (goto-char (point-max))
 742         (widen)
 743         (setq head-end (point))
 744         ;; We try the Content-Length value.  The idea: skip over the header
 745         ;; separator, then check what happens content-length bytes into the
 746         ;; message body.  This should be either the end ot the buffer, the
 747         ;; message separator or a blank line followed by the separator.
 748         ;; The blank line should probably be deleted.  If neither of the
 749         ;; three is met, the content-length header is probably invalid.
 750         (when content-length
 751           (forward-line 1)
 752           (setq skip (+ (point) content-length))
 753           (goto-char skip)
 754           (cond ((or (= skip (point-max))
 755                      (= (1+ skip) (point-max)))
 756                  (setq end (point-max)))
 757                 ((looking-at "From ")
 758                  (setq end skip))
 759                 ((looking-at "[ \t]*\n\\(From \\)")
 760                  (setq end (match-beginning 1)))
 761                 (t (setq end nil))))
 762         (if end
 763             (goto-char end)
 764           ;; No Content-Length, so we find the beginning of the next
 765           ;; article or the end of the buffer.
 766           (goto-char head-end)
 767           (or (nnmail-search-unix-mail-delim)
 768               (goto-char (point-max))))
 769         ;; Allow the backend to save the article.
 770         (save-excursion
 771           (save-restriction
 772             (narrow-to-region start (point))
 773             (goto-char (point-min))
 774             (incf count)
 775             (nnmail-check-duplication message-id func artnum-func)
 776             (setq end (point-max))))
 777         (goto-char end)))
 778     count))
 779
 780 (defun nnmail-process-mmdf-mail-format (func artnum-func)
 781   (let ((delim "^\^A\^A\^A\^A$")
 782         (case-fold-search t)
 783         (count 0)
 784         start message-id end)
 785     (goto-char (point-min))
 786     (if (not (and (re-search-forward delim nil t)
 787                   (forward-line 1)))
 788         ;; Possibly wrong format?
 789         (error "Error, unknown mail format! (Possibly corrupted.)")
 790       ;; Carry on until the bitter end.
 791       (while (not (eobp))
 792         (setq start (point))
 793         ;; Find the end of the head.
 794         (narrow-to-region
 795          start
 796          (if (search-forward "\n\n" nil t)
 797              (1- (point))
 798            ;; This will never happen, but just to be on the safe side --
 799            ;; if there is no head-body delimiter, we search a bit manually.
 800            (while (and (looking-at "From \\|[^ \t]+:")
 801                        (not (eobp)))
 802              (forward-line 1))
 803            (point)))
 804         ;; Find the Message-ID header.
 805         (goto-char (point-min))
 806         (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
 807             (setq message-id (match-string 1))
 808           ;; There is no Message-ID here, so we create one.
 809           (save-excursion
 810             (when (re-search-backward "^Message-ID[ \t]*:" nil t)
 811               (beginning-of-line)
 812               (insert "Original-")))
 813           (forward-line 1)
 814           (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
 815         (run-hooks 'nnmail-prepare-incoming-header-hook)
 816         ;; Find the end of this article.
 817         (goto-char (point-max))
 818         (widen)
 819         (if (re-search-forward delim nil t)
 820             (beginning-of-line)
 821           (goto-char (point-max)))
 822         ;; Allow the backend to save the article.
 823         (save-excursion
 824           (save-restriction
 825             (narrow-to-region start (point))
 826             (goto-char (point-min))
 827             (incf count)
 828             (nnmail-check-duplication message-id func artnum-func)
 829             (setq end (point-max))))
 830         (goto-char end)
 831         (forward-line 2)))
 832     count))
 833
 834 (defun nnmail-process-maildir-mail-format (func artnum-func)
 835   ;; In a maildir, every file contains exactly one mail.
 836   (let ((case-fold-search t)
 837         message-id)
 838     (goto-char (point-min))
 839     ;; Find the end of the head.
 840     (narrow-to-region
 841      (point-min)
 842      (if (search-forward "\n\n" nil t)
 843          (1- (point))
 844        ;; This will never happen, but just to be on the safe side --
 845        ;; if there is no head-body delimiter, we search a bit manually.
 846        (while (and (looking-at "From \\|[^ \t]+:")
 847                    (not (eobp)))
 848          (forward-line 1))
 849        (point)))
 850     ;; Find the Message-ID header.
 851     (goto-char (point-min))
 852     (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
 853         (setq message-id (match-string 1))
 854       ;; There is no Message-ID here, so we create one.
 855       (save-excursion
 856         (when (re-search-backward "^Message-ID[ \t]*:" nil t)
 857           (beginning-of-line)
 858           (insert "Original-")))
 859       (forward-line 1)
 860       (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
 861     (run-hooks 'nnmail-prepare-incoming-header-hook)
 862     ;; Allow the backend to save the article.
 863     (widen)
 864     (save-excursion
 865       (goto-char (point-min))
 866       (nnmail-check-duplication message-id func artnum-func))
 867     1))
 868
 869 (defun nnmail-split-incoming (incoming func &optional exit-func
 870                                        group artnum-func)
 871   "Go through the entire INCOMING file and pick out each individual mail.
 872 FUNC will be called with the buffer narrowed to each mail."
 873   (let (;; If this is a group-specific split, we bind the split
 874         ;; methods to just this group.
 875         (nnmail-split-methods (if (and group
 876                                        (not nnmail-resplit-incoming))
 877                                   (list (list group ""))
 878                                 nnmail-split-methods)))
 879     (save-excursion
 880       ;; Insert the incoming file.
 881       (set-buffer (get-buffer-create " *nnmail incoming*"))
 882       (erase-buffer)
 883       (let ((coding-system-for-read nnmail-incoming-coding-system))
 884         (mm-insert-file-contents incoming))
 885       (prog1
 886           (if (zerop (buffer-size))
 887               0
 888             (goto-char (point-min))
 889             (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
 890             ;; Handle both babyl, MMDF and unix mail formats, since
 891             ;; movemail will use the former when fetching from a
 892             ;; mailbox, the latter when fetching from a file.
 893             (cond ((or (looking-at "\^L")
 894                        (looking-at "BABYL OPTIONS:"))
 895                    (nnmail-process-babyl-mail-format func artnum-func))
 896                   ((looking-at "\^A\^A\^A\^A")
 897                    (nnmail-process-mmdf-mail-format func artnum-func))
 898                   ((looking-at "Return-Path:")
 899                    (nnmail-process-maildir-mail-format func artnum-func))
 900                   (t
 901                    (nnmail-process-unix-mail-format func artnum-func))))
 902         (when exit-func
 903           (funcall exit-func))
 904         (kill-buffer (current-buffer))))))
 905
 906 (defun nnmail-article-group (func &optional trace)
 907   "Look at the headers and return an alist of groups that match.
 908 FUNC will be called with the group name to determine the article number."
 909   (let ((methods nnmail-split-methods)
 910         (obuf (current-buffer))
 911         (beg (point-min))
 912         end group-art method grp)
 913     (if (and (sequencep methods)
 914              (= (length methods) 1))
 915         ;; If there is only just one group to put everything in, we
 916         ;; just return a list with just this one method in.
 917         (setq group-art
 918               (list (cons (caar methods) (funcall func (caar methods)))))
 919       ;; We do actual comparison.
 920       (save-excursion
 921         ;; Find headers.
 922         (goto-char beg)
 923         (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
 924         (set-buffer nntp-server-buffer)
 925         (erase-buffer)
 926         ;; Copy the headers into the work buffer.
 927         (insert-buffer-substring obuf beg end)
 928         ;; Fold continuation lines.
 929         (goto-char (point-min))
 930         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 931           (replace-match " " t t))
 932         ;; Nuke pathologically long headers.  Since Gnus applies
 933         ;; pathologically complex regexps to the buffer, lines
 934         ;; that are looong will take longer than the Universe's
 935         ;; existence to process.
 936         (goto-char (point-min))
 937         (while (not (eobp))
 938           (unless (< (move-to-column nnmail-split-header-length-limit)
 939                      nnmail-split-header-length-limit)
 940             (delete-region (point) (progn (end-of-line) (point))))
 941           (forward-line 1))
 942         ;; Allow washing.
 943         (goto-char (point-min))
 944         (run-hooks 'nnmail-split-hook)
 945         (when (setq nnmail-split-tracing trace)
 946           (setq nnmail-split-trace nil))
 947         (if (and (symbolp nnmail-split-methods)
 948                  (fboundp nnmail-split-methods))
 949             (let ((split
 950                    (condition-case nil
 951                        ;; `nnmail-split-methods' is a function, so we
 952                        ;; just call this function here and use the
 953                        ;; result.
 954                        (or (funcall nnmail-split-methods)
 955                            '("bogus"))
 956                      (error
 957                       (nnheader-message 5
 958                                         "Error in `nnmail-split-methods'; using `bogus' mail group")
 959                       (sit-for 1)
 960                       '("bogus")))))
 961               (setq split (gnus-remove-duplicates split))
 962               ;; The article may be "cross-posted" to `junk'.  What
 963               ;; to do?  Just remove the `junk' spec.  Don't really
 964               ;; see anything else to do...
 965               (let (elem)
 966                 (while (setq elem (car (memq 'junk split)))
 967                   (setq split (delq elem split))))
 968               (when split
 969                 (setq group-art
 970                       (mapcar
 971                        (lambda (group) (cons group (funcall func group)))
 972                        split))))
 973           ;; Go through the split methods to find a match.
 974           (while (and methods
 975                       (or nnmail-crosspost
 976                           (not group-art)))
 977             (goto-char (point-max))
 978             (setq method (pop methods)
 979                   grp (car method))
 980             (if (or methods
 981                     (not (equal "" (nth 1 method))))
 982                 (when (and
 983                        (ignore-errors
 984                          (if (stringp (nth 1 method))
 985                              (let ((expand (string-match "\\\\[0-9&]" grp))
 986                                    (pos (re-search-backward (cadr method)
 987                                                             nil t)))
 988                                (and expand
 989                                     (setq grp (nnmail-expand-newtext grp)))
 990                                pos)
 991                            ;; Function to say whether this is a match.
 992                            (funcall (nth 1 method) grp)))
 993                        ;; Don't enter the article into the same
 994                        ;; group twice.
 995                        (not (assoc grp group-art)))
 996                   (push (cons grp (funcall func grp))
 997                         group-art))
 998               ;; This is the final group, which is used as a
 999               ;; catch-all.
1000               (unless group-art
1001                 (setq group-art
1002                       (list (cons (car method)
1003                                   (funcall func (car method)))))))))
1004         ;; Produce a trace if non-empty.
1005         (when (and trace nnmail-split-trace)
1006           (let ((trace (nreverse nnmail-split-trace))
1007                 (restore (current-buffer)))
1008             (nnheader-set-temp-buffer "*Split Trace*")
1009             (gnus-add-buffer)
1010             (while trace
1011               (insert (car trace) "\n")
1012               (setq trace (cdr trace)))
1013             (goto-char (point-min))
1014             (gnus-configure-windows 'split-trace)
1015             (set-buffer restore)))
1016         ;; See whether the split methods returned `junk'.
1017         (if (equal group-art '(junk))
1018             nil
1019           ;; The article may be "cross-posted" to `junk'.  What
1020           ;; to do?  Just remove the `junk' spec.  Don't really
1021           ;; see anything else to do...
1022           (let (elem)
1023             (while (setq elem (car (memq 'junk group-art)))
1024               (setq group-art (delq elem group-art)))
1025             (nreverse group-art)))))))
1026
1027 (defun nnmail-insert-lines ()
1028   "Insert how many lines there are in the body of the mail.
1029 Return the number of characters in the body."
1030   (let (lines chars)
1031     (save-excursion
1032       (goto-char (point-min))
1033       (unless (search-forward "\n\n" nil t)
1034         (goto-char (point-max))
1035         (insert "\n"))
1036       (setq chars (- (point-max) (point)))
1037       (setq lines (count-lines (point) (point-max)))
1038       (forward-char -1)
1039       (save-excursion
1040         (when (re-search-backward "^Lines: " nil t)
1041           (delete-region (point) (progn (forward-line 1) (point)))))
1042       (beginning-of-line)
1043       (insert (format "Lines: %d\n" (max lines 0)))
1044       chars)))
1045
1046 (defun nnmail-insert-xref (group-alist)
1047   "Insert an Xref line based on the (group . article) alist."
1048   (save-excursion
1049     (goto-char (point-min))
1050     (unless (search-forward "\n\n" nil t)
1051       (goto-char (point-max))
1052       (insert "\n"))
1053     (forward-char -1)
1054     (when (re-search-backward "^Xref: " nil t)
1055       (delete-region (match-beginning 0)
1056                      (progn (forward-line 1) (point))))
1057     (insert (format "Xref: %s" (system-name)))
1058     (while group-alist
1059       (insert (format " %s:%d"
1060                       (mm-encode-coding-string
1061                        (caar group-alist)
1062                        nnmail-pathname-coding-system)
1063                       (cdar group-alist)))
1064       (setq group-alist (cdr group-alist)))
1065     (insert "\n")))
1066
1067 ;;; Message washing functions
1068
1069 (defun nnmail-remove-leading-whitespace ()
1070   "Remove excessive whitespace from all headers."
1071   (goto-char (point-min))
1072   (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
1073     (replace-match "\\1" t)))
1074
1075 (defun nnmail-remove-list-identifiers ()
1076   "Remove list identifiers from Subject headers."
1077   (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers
1078                   (mapconcat 'identity nnmail-list-identifiers " *\\|"))))
1079     (when regexp
1080       (goto-char (point-min))
1081       (when (re-search-forward
1082              (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)")
1083              nil t)
1084         (delete-region (match-beginning 2) (match-end 0))))))
1085
1086 (defun nnmail-remove-tabs ()
1087   "Translate TAB characters into SPACE characters."
1088   (subst-char-in-region (point-min) (point-max) ?\t ?  t))
1089
1090 (defun nnmail-fix-eudora-headers ()
1091   "Eudora has a broken References line, but an OK In-Reply-To."
1092   (goto-char (point-min))
1093   (when (re-search-forward "^X-Mailer:.*Eudora" nil t)
1094     (goto-char (point-min))
1095     (when (re-search-forward "^References:" nil t)
1096       (beginning-of-line)
1097       (insert "X-Gnus-Broken-Eudora-"))
1098     (goto-char (point-min))
1099     (when (re-search-forward "^In-Reply-To:[^\n]+\\(\n[ \t]+\\)" nil t)
1100       (replace-match "" t t nil 1))))
1101
1102 (custom-add-option 'nnmail-prepare-incoming-header-hook
1103                    'nnmail-fix-eudora-headers)
1104
1105 ;;; Utility functions
1106
1107 (defun nnmail-split-fancy ()
1108   "Fancy splitting method.
1109 See the documentation for the variable `nnmail-split-fancy' for documentation."
1110   (let ((syntab (syntax-table)))
1111     (unwind-protect
1112         (progn
1113           (set-syntax-table nnmail-split-fancy-syntax-table)
1114           (nnmail-split-it nnmail-split-fancy))
1115       (set-syntax-table syntab))))
1116
1117 (defvar nnmail-split-cache nil)
1118 ;; Alist of split expressions their equivalent regexps.
1119
1120 (defun nnmail-split-it (split)
1121   ;; Return a list of groups matching SPLIT.
1122   (let (cached-pair)
1123     (cond
1124      ;; nil split
1125      ((null split)
1126       nil)
1127
1128      ;; A group name.  Do the \& and \N subs into the string.
1129      ((stringp split)
1130       (when nnmail-split-tracing
1131         (push (format "\"%s\"" split) nnmail-split-trace))
1132       (list (nnmail-expand-newtext split)))
1133
1134      ;; Junk the message.
1135      ((eq split 'junk)
1136       (when nnmail-split-tracing
1137         (push "junk" nnmail-split-trace))
1138       (list 'junk))
1139
1140      ;; Builtin & operation.
1141      ((eq (car split) '&)
1142       (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
1143
1144      ;; Builtin | operation.
1145      ((eq (car split) '|)
1146       (let (done)
1147         (while (and (not done) (cdr split))
1148           (setq split (cdr split)
1149                 done (nnmail-split-it (car split))))
1150         done))
1151
1152      ;; Builtin : operation.
1153      ((eq (car split) ':)
1154       (nnmail-split-it (save-excursion (eval (cdr split)))))
1155
1156      ;; Builtin ! operation.
1157      ((eq (car split) '!)
1158       (funcall (cadr split) (nnmail-split-it (caddr split))))
1159
1160      ;; Check the cache for the regexp for this split.
1161      ((setq cached-pair (assq split nnmail-split-cache))
1162       (let (split-result
1163             (end-point (point-max))
1164             (value (nth 1 split)))
1165         (if (symbolp value)
1166             (setq value (cdr (assq value nnmail-split-abbrev-alist))))
1167         (while (and (goto-char end-point)
1168                     (re-search-backward (cdr cached-pair) nil t))
1169           (when nnmail-split-tracing
1170             (push (cdr cached-pair) nnmail-split-trace))
1171           (let ((split-rest (cddr split))
1172                 (end (match-end 0))
1173                 ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).  So,
1174                 ;; start-of-value is the the point just before the
1175                 ;; beginning of the value, whereas after-header-name is
1176                 ;; the point just after the field name.
1177                 (start-of-value (match-end 1))
1178                 (after-header-name (match-end 2)))
1179             ;; Start the next search just before the beginning of the
1180             ;; VALUE match.
1181             (setq end-point (1- start-of-value))
1182             ;; Handle - RESTRICTs
1183             (while (eq (car split-rest) '-)
1184               ;; RESTRICT must start after-header-name and
1185               ;; end after start-of-value, so that, for
1186               ;; (any "foo" - "x-foo" "foo.list")
1187               ;; we do not exclude foo.list just because
1188               ;; the header is: ``To: x-foo, foo''
1189               (goto-char end)
1190               (if (and (re-search-backward (cadr split-rest)
1191                                            after-header-name t)
1192                        (> (match-end 0) start-of-value))
1193                   (setq split-rest nil)
1194                 (setq split-rest (cddr split-rest))))
1195             (when split-rest
1196               (goto-char end)
1197               (let ((value (nth 1 split)))
1198                 (if (symbolp value)
1199                     (setq value (cdr (assq value nnmail-split-abbrev-alist))))
1200                 ;; Someone might want to do a \N sub on this match, so get the
1201                 ;; correct match positions.
1202                 (re-search-backward value start-of-value))
1203               (dolist (sp (nnmail-split-it (car split-rest)))
1204                 (unless (memq sp split-result)
1205                   (push sp split-result))))))
1206         split-result))
1207
1208      ;; Not in cache, compute a regexp for the field/value pair.
1209      (t
1210       (let* ((field (nth 0 split))
1211              (value (nth 1 split))
1212              partial regexp)
1213         (if (symbolp value)
1214             (setq value (cdr (assq value nnmail-split-abbrev-alist))))
1215         (if (and (>= (length value) 2)
1216                  (string= ".*" (substring value 0 2)))
1217             (setq value (substring value 2)
1218                   partial ""))
1219         (setq regexp (concat "^\\(\\("
1220                              (if (symbolp field)
1221                                  (cdr (assq field nnmail-split-abbrev-alist))
1222                                field)
1223                              "\\):.*\\)"
1224                              (or partial "\\<")
1225                              "\\("
1226                              value
1227                              "\\)\\>"))
1228         (push (cons split regexp) nnmail-split-cache)
1229         ;; Now that it's in the cache, just call nnmail-split-it again
1230         ;; on the same split, which will find it immediately in the cache.
1231         (nnmail-split-it split))))))
1232
1233 (defun nnmail-expand-newtext (newtext)
1234   (let ((len (length newtext))
1235         (pos 0)
1236         c expanded beg N did-expand)
1237     (while (< pos len)
1238       (setq beg pos)
1239       (while (and (< pos len)
1240                   (not (= (aref newtext pos) ?\\)))
1241         (setq pos (1+ pos)))
1242       (unless (= beg pos)
1243         (push (substring newtext beg pos) expanded))
1244       (when (< pos len)
1245         ;; We hit a \; expand it.
1246         (setq did-expand t
1247               pos (1+ pos)
1248               c (aref newtext pos))
1249         (if (not (or (= c ?\&)
1250                      (and (>= c ?1)
1251                           (<= c ?9))))
1252             ;; \ followed by some character we don't expand.
1253             (push (char-to-string c) expanded)
1254           ;; \& or \N
1255           (if (= c ?\&)
1256               (setq N 0)
1257             (setq N (- c ?0)))
1258           (when (match-beginning N)
1259             (push (buffer-substring (match-beginning N) (match-end N))
1260                   expanded))))
1261       (setq pos (1+ pos)))
1262     (if did-expand
1263         (apply 'concat (nreverse expanded))
1264       newtext)))
1265
1266 ;; Activate a backend only if it isn't already activated.
1267 ;; If FORCE, re-read the active file even if the backend is
1268 ;; already activated.
1269 (defun nnmail-activate (backend &optional force)
1270   (nnheader-init-server-buffer)
1271   (let (file timestamp file-time)
1272     (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
1273             force
1274             (and (setq file (ignore-errors
1275                               (symbol-value (intern (format "%s-active-file"
1276                                                             backend)))))
1277                  (setq file-time (nth 5 (file-attributes file)))
1278                  (or (not
1279                       (setq timestamp
1280                             (condition-case ()
1281                                 (symbol-value (intern
1282                                                (format "%s-active-timestamp"
1283                                                        backend)))
1284                               (error 'none))))
1285                      (not (consp timestamp))
1286                      (equal timestamp '(0 0))
1287                      (> (nth 0 file-time) (nth 0 timestamp))
1288                      (and (= (nth 0 file-time) (nth 0 timestamp))
1289                           (> (nth 1 file-time) (nth 1 timestamp))))))
1290         (save-excursion
1291           (or (eq timestamp 'none)
1292               (set (intern (format "%s-active-timestamp" backend))
1293                    file-time))
1294           (funcall (intern (format "%s-request-list" backend)))))
1295     t))
1296
1297 (defun nnmail-message-id ()
1298   (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
1299
1300 ;;;
1301 ;;; nnmail duplicate handling
1302 ;;;
1303
1304 (defvar nnmail-cache-buffer nil)
1305
1306 (defun nnmail-cache-open ()
1307   (if (or (not nnmail-treat-duplicates)
1308           (and nnmail-cache-buffer
1309                (buffer-name nnmail-cache-buffer)))
1310       ()                                ; The buffer is open.
1311     (save-excursion
1312       (set-buffer
1313        (setq nnmail-cache-buffer
1314              (get-buffer-create " *nnmail message-id cache*")))
1315       (when (file-exists-p nnmail-message-id-cache-file)
1316         (nnheader-insert-file-contents nnmail-message-id-cache-file))
1317       (set-buffer-modified-p nil)
1318       (current-buffer))))
1319
1320 (defun nnmail-cache-close ()
1321   (when (and nnmail-cache-buffer
1322              nnmail-treat-duplicates
1323              (buffer-name nnmail-cache-buffer)
1324              (buffer-modified-p nnmail-cache-buffer))
1325     (save-excursion
1326       (set-buffer nnmail-cache-buffer)
1327       ;; Weed out the excess number of Message-IDs.
1328       (goto-char (point-max))
1329       (when (search-backward "\n" nil t nnmail-message-id-cache-length)
1330         (progn
1331           (beginning-of-line)
1332           (delete-region (point-min) (point))))
1333       ;; Save the buffer.
1334       (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
1335           (make-directory (file-name-directory nnmail-message-id-cache-file)
1336                           t))
1337       (nnmail-write-region (point-min) (point-max)
1338                            nnmail-message-id-cache-file nil 'silent)
1339       (set-buffer-modified-p nil)
1340       (setq nnmail-cache-buffer nil)
1341       (kill-buffer (current-buffer)))))
1342
1343 (defun nnmail-cache-insert (id)
1344   (when nnmail-treat-duplicates
1345     ;; Store some information about the group this message is written
1346     ;; to.  This function might have been called from various places.
1347     ;; Sometimes, a function up in the calling sequence has an
1348     ;; argument GROUP which is bound to a string, the group name.  At
1349     ;; other times, there is a function up in the calling sequence
1350     ;; which has an argument GROUP-ART which is a list of pairs, and
1351     ;; the car of a pair is a group name.  Should we check that the
1352     ;; length of the list is equal to 1? -- kai
1353     (let ((g nil))
1354       (cond ((and (boundp 'group) group)
1355              (setq g group))
1356             ((and (boundp 'group-art-list) group-art-list
1357                   (listp group-art-list))
1358              (setq g (caar group-art-list)))
1359             ((and (boundp 'group-art) group-art (listp group-art))
1360              (setq g (caar group-art)))
1361             (t (setq g "")))
1362       (unless (gnus-buffer-live-p nnmail-cache-buffer)
1363         (nnmail-cache-open))
1364       (save-excursion
1365         (set-buffer nnmail-cache-buffer)
1366         (goto-char (point-max))
1367         (if (and g (not (string= "" g))
1368                  (gnus-methods-equal-p gnus-command-method
1369                                        (nnmail-cache-primary-mail-backend)))
1370             (insert id "\t" g "\n")
1371           (insert id "\n"))))))
1372
1373 (defun nnmail-cache-primary-mail-backend ()
1374   (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
1375         (be nil)
1376         (res nil))
1377     (while (and (null res) be-list)
1378       (setq be (car be-list))
1379       (setq be-list (cdr be-list))
1380       (when (and (gnus-method-option-p be 'respool)
1381                  (eval (intern (format "%s-get-new-mail" (car be)))))
1382         (setq res be)))
1383     res))
1384
1385 ;; Fetch the group name corresponding to the message id stored in the
1386 ;; cache.
1387 (defun nnmail-cache-fetch-group (id)
1388   (when (and nnmail-treat-duplicates nnmail-cache-buffer)
1389     (save-excursion
1390       (set-buffer nnmail-cache-buffer)
1391       (goto-char (point-max))
1392       (when (search-backward id nil t)
1393         (beginning-of-line)
1394         (skip-chars-forward "^\n\r\t")
1395         (unless (eolp)
1396           (forward-char 1)
1397           (buffer-substring (point)
1398                             (progn (end-of-line) (point))))))))
1399
1400 ;; Function for nnmail-split-fancy: look up all references in the
1401 ;; cache and if a match is found, return that group.
1402 (defun nnmail-split-fancy-with-parent ()
1403   (let* ((refstr (or (message-fetch-field "references")
1404                      (message-fetch-field "in-reply-to")))
1405          (references nil)
1406          (res nil))
1407     (when refstr
1408       (setq references (nreverse (gnus-split-references refstr)))
1409       (unless (gnus-buffer-live-p nnmail-cache-buffer)
1410         (nnmail-cache-open))
1411       (mapcar (lambda (x)
1412                 (setq res (or (nnmail-cache-fetch-group x) res))
1413                 (when (string= "drafts" res)
1414                   (setq res nil)))
1415               references)
1416       res)))
1417
1418 (defun nnmail-cache-id-exists-p (id)
1419   (when nnmail-treat-duplicates
1420     (save-excursion
1421       (set-buffer nnmail-cache-buffer)
1422       (goto-char (point-max))
1423       (search-backward id nil t))))
1424
1425 (defun nnmail-fetch-field (header)
1426   (save-excursion
1427     (save-restriction
1428       (message-narrow-to-head)
1429       (message-fetch-field header))))
1430
1431 (defun nnmail-check-duplication (message-id func artnum-func)
1432   (run-hooks 'nnmail-prepare-incoming-message-hook)
1433   ;; If this is a duplicate message, then we do not save it.
1434   (let* ((duplication (nnmail-cache-id-exists-p message-id))
1435          (case-fold-search t)
1436          (action (when duplication
1437                    (cond
1438                     ((memq nnmail-treat-duplicates '(warn delete))
1439                      nnmail-treat-duplicates)
1440                     ((nnheader-functionp nnmail-treat-duplicates)
1441                      (funcall nnmail-treat-duplicates message-id))
1442                     (t
1443                      nnmail-treat-duplicates))))
1444          group-art)
1445     ;; We insert a line that says what the mail source is.
1446     (let ((case-fold-search t))
1447       (goto-char (point-min))
1448       (re-search-forward "^message-id[ \t]*:" nil t)
1449       (beginning-of-line)
1450       (insert (format "X-Gnus-Mail-Source: %s\n" mail-source-string)))
1451
1452     ;; Let the backend save the article (or not).
1453     (cond
1454      ((not duplication)
1455       (funcall func (setq group-art
1456                           (nreverse (nnmail-article-group artnum-func))))
1457       (nnmail-cache-insert message-id))
1458      ((eq action 'delete)
1459       (setq group-art nil))
1460      ((eq action 'warn)
1461       ;; We insert a warning.
1462       (let ((case-fold-search t))
1463         (goto-char (point-min))
1464         (re-search-forward "^message-id[ \t]*:" nil t)
1465         (beginning-of-line)
1466         (insert
1467          "Gnus-Warning: This is a duplicate of message " message-id "\n")
1468         (funcall func (setq group-art
1469                             (nreverse (nnmail-article-group artnum-func))))))
1470      (t
1471       (funcall func (setq group-art
1472                           (nreverse (nnmail-article-group artnum-func))))))
1473     ;; Add the group-art list to the history list.
1474     (if group-art
1475         (push group-art nnmail-split-history)
1476       (delete-region (point-min) (point-max)))))
1477
1478 ;;; Get new mail.
1479
1480 (defvar nnmail-fetched-sources nil)
1481
1482 (defun nnmail-get-value (&rest args)
1483   (let ((sym (intern (apply 'format args))))
1484     (when (boundp sym)
1485       (symbol-value sym))))
1486
1487 (defun nnmail-get-new-mail (method exit-func temp
1488                                    &optional group spool-func)
1489   "Read new incoming mail."
1490   (let* ((sources (or mail-sources
1491                       (if (listp nnmail-spool-file) nnmail-spool-file
1492                         (list nnmail-spool-file))))
1493          fetching-sources
1494          (group-in group)
1495          (i 0)
1496          (new 0)
1497          (total 0)
1498          incoming incomings source)
1499     (when (and (nnmail-get-value "%s-get-new-mail" method)
1500                nnmail-spool-file)
1501       (while (setq source (pop sources))
1502         ;; Be compatible with old values.
1503         (cond
1504          ((stringp source)
1505           (setq source
1506                 (cond
1507                  ((string-match "^po:" source)
1508                   (list 'pop :user (substring source (match-end 0))))
1509                  ((file-directory-p source)
1510                   (list 'directory :path source))
1511                  (t
1512                   (list 'file :path source)))))
1513          ((eq source 'procmail)
1514           (message "Invalid value for nnmail-spool-file: `procmail'")
1515           nil))
1516         ;; Hack to only fetch the contents of a single group's spool file.
1517         (when (and (eq (car source) 'directory)
1518                    group)
1519           (mail-source-bind (directory source)
1520             (setq source (append source
1521                                  (list
1522                                   :predicate
1523                                   `(lambda (file)
1524                                      (string-match
1525                                       ,(concat
1526                                         (regexp-quote (concat group suffix))
1527                                         "$")
1528                                       file)))))))
1529         (when nnmail-fetched-sources
1530           (if (member source nnmail-fetched-sources)
1531               (setq source nil)
1532             (push source nnmail-fetched-sources)
1533             (push source fetching-sources)))))
1534     (when fetching-sources
1535       ;; We first activate all the groups.
1536       (nnmail-activate method)
1537       ;; Allow the user to hook.
1538       (run-hooks 'nnmail-pre-get-new-mail-hook)
1539       ;; Open the message-id cache.
1540       (nnmail-cache-open)
1541       ;; The we go through all the existing mail source specification
1542       ;; and fetch the mail from each.
1543       (while (setq source (pop fetching-sources))
1544         (nnheader-message 4 "%s: Reading incoming mail from %s..."
1545                           method (car source))
1546         (when (setq new
1547                     (mail-source-fetch
1548                      source
1549                      `(lambda (file orig-file)
1550                         (nnmail-split-incoming
1551                          file ',(intern (format "%s-save-mail" method))
1552                          ',spool-func
1553                          (nnmail-get-split-group orig-file source)
1554                          ',(intern (format "%s-active-number" method))))))
1555           (incf total new)
1556           (incf i)))
1557       ;; If we did indeed read any incoming spools, we save all info.
1558       (if (zerop total)
1559           (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
1560                             method (car source))
1561         (nnmail-save-active
1562          (nnmail-get-value "%s-group-alist" method)
1563          (nnmail-get-value "%s-active-file" method))
1564         (when exit-func
1565           (funcall exit-func))
1566         (run-hooks 'nnmail-read-incoming-hook)
1567         (nnheader-message 4 "%s: Reading incoming mail (%d new)...done" method
1568                           total))
1569       ;; Close the message-id cache.
1570       (nnmail-cache-close)
1571       ;; Allow the user to hook.
1572       (run-hooks 'nnmail-post-get-new-mail-hook))))
1573
1574 (defun nnmail-expired-article-p (group time force &optional inhibit)
1575   "Say whether an article that is TIME old in GROUP should be expired."
1576   (if force
1577       t
1578     (let ((days (or (and nnmail-expiry-wait-function
1579                          (funcall nnmail-expiry-wait-function group))
1580                     nnmail-expiry-wait)))
1581       (cond ((or (eq days 'never)
1582                  (and (not force)
1583                       inhibit))
1584              ;; This isn't an expirable group.
1585              nil)
1586             ((eq days 'immediate)
1587              ;; We expire all articles on sight.
1588              t)
1589             ((equal time '(0 0))
1590              ;; This is an ange-ftp group, and we don't have any dates.
1591              nil)
1592             ((numberp days)
1593              (setq days (days-to-time days))
1594              ;; Compare the time with the current time.
1595              (ignore-errors (time-less-p days (time-since time))))))))
1596
1597 (defun nnmail-expiry-target-group (target group)
1598   (when (nnheader-functionp target)
1599     (setq target (funcall target group)))
1600   (unless (eq target 'delete)
1601     (gnus-request-accept-article target)))
1602
1603 (defun nnmail-check-syntax ()
1604   "Check (and modify) the syntax of the message in the current buffer."
1605   (save-restriction
1606     (message-narrow-to-head)
1607     (let ((case-fold-search t))
1608       (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
1609         (insert "Message-ID: " (nnmail-message-id) "\n")))))
1610
1611 (defun nnmail-write-region (start end filename &optional append visit lockname)
1612   "Do a `write-region', and then set the file modes."
1613   (let ((coding-system-for-write nnmail-file-coding-system)
1614         (pathname-coding-system nnmail-pathname-coding-system))
1615     (write-region start end filename append visit lockname)
1616     (set-file-modes filename nnmail-default-file-modes)))
1617
1618 ;;;
1619 ;;; Status functions
1620 ;;;
1621
1622 (defun nnmail-replace-status (name value)
1623   "Make status NAME and VALUE part of the current status line."
1624   (save-restriction
1625     (message-narrow-to-head)
1626     (let ((status (nnmail-decode-status)))
1627       (setq status (delq (member name status) status))
1628       (when value
1629         (push (cons name value) status))
1630       (message-remove-header "status")
1631       (goto-char (point-max))
1632       (insert "Status: " (nnmail-encode-status status) "\n"))))
1633
1634 (defun nnmail-decode-status ()
1635   "Return a status-value alist from STATUS."
1636   (goto-char (point-min))
1637   (when (re-search-forward "^Status: " nil t)
1638     (let (name value status)
1639       (save-restriction
1640         ;; Narrow to the status.
1641         (narrow-to-region
1642          (point)
1643          (if (re-search-forward "^[^ \t]" nil t)
1644              (1- (point))
1645            (point-max)))
1646         ;; Go through all elements and add them to the list.
1647         (goto-char (point-min))
1648         (while (re-search-forward "[^ \t=]+" nil t)
1649           (setq name (match-string 0))
1650           (if (not (eq (char-after) ?=))
1651               ;; Implied "yes".
1652               (setq value "yes")
1653             (forward-char 1)
1654             (if (not (eq (char-after) ?\"))
1655                 (if (not (looking-at "[^ \t]"))
1656                     ;; Implied "no".
1657                     (setq value "no")
1658                   ;; Unquoted value.
1659                   (setq value (match-string 0))
1660                   (goto-char (match-end 0)))
1661               ;; Quoted value.
1662               (setq value (read (current-buffer)))))
1663           (push (cons name value) status)))
1664       status)))
1665
1666 (defun nnmail-encode-status (status)
1667   "Return a status string from STATUS."
1668   (mapconcat
1669    (lambda (elem)
1670      (concat
1671       (car elem) "="
1672       (if (string-match "[ \t]" (cdr elem))
1673           (prin1-to-string (cdr elem))
1674         (cdr elem))))
1675    status " "))
1676
1677 (defun nnmail-split-history ()
1678   "Generate an overview of where the last mail split put articles."
1679   (interactive)
1680   (unless nnmail-split-history
1681     (error "No current split history"))
1682   (with-output-to-temp-buffer "*nnmail split history*"
1683     (with-current-buffer standard-output
1684       (fundamental-mode))               ; for Emacs 20.4+
1685     (let ((history nnmail-split-history)
1686           elem)
1687       (while (setq elem (pop history))
1688         (princ (mapconcat (lambda (ga)
1689                             (concat (car ga) ":" (int-to-string (cdr ga))))
1690                           elem
1691                           ", "))
1692         (princ "\n")))))
1693
1694 (defun nnmail-purge-split-history (group)
1695   "Remove all instances of GROUP from `nnmail-split-history'."
1696   (let ((history nnmail-split-history))
1697     (while history
1698       (setcar history (gnus-delete-if (lambda (e) (string= (car e) group))
1699                                       (car history)))
1700       (pop history))
1701     (setq nnmail-split-history (delq nil nnmail-split-history))))
1702
1703 (defun nnmail-new-mail-p (group)
1704   "Say whether GROUP has new mail."
1705   (let ((his nnmail-split-history)
1706         found)
1707     (while his
1708       (when (assoc group (pop his))
1709         (setq found t
1710               his nil)))
1711     found))
1712
1713 (defun nnmail-within-headers-p ()
1714   "Check to see if point is within the headers of a unix mail message.
1715 Doesn't change point."
1716   (let ((pos (point)))
1717     (save-excursion
1718       (and (nnmail-search-unix-mail-delim-backward)
1719            (not (search-forward "\n\n" pos t))))))
1720
1721 (run-hooks 'nnmail-load-hook)
1722
1723 (provide 'nnmail)
1724
1725 ;;; nnmail.el ends here