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

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