git.chise.org Git - elisp/gnus.git-/blob - lisp/nnmail.el

   1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
   2 ;; Copyright (C) 1995,96,97,98 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 'timezone)
  32 (require 'message)
  33 (require 'custom)
  34 (require 'gnus-util)
  35
  36 (eval-and-compile
  37   (autoload 'gnus-error "gnus-util")
  38   (autoload 'gnus-buffer-live-p "gnus-util")
  39   (autoload 'gnus-encode-coding-string "gnus-ems"))
  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-cache-accepted-message-ids nil
 170   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
 171   :group 'nnmail
 172   :type 'boolean)
 173
 174 (defcustom nnmail-spool-file
 175   (or (getenv "MAIL")
 176       (concat "/usr/spool/mail/" (user-login-name)))
 177   "*Where the mail backends will look for incoming mail.
 178 This variable is \"/usr/spool/mail/$user\" by default.
 179 If this variable is nil, no mail backends will read incoming mail.
 180 If this variable is a directory (i. e., it's name ends with a \"/\"),
 181 treat all files in that directory as incoming spool files.
 182 If this valiable is a POP3 account (\"po:ACCOUNT\": use
 183 \`nnmail-default-mail-host\' as POP3 server host.
 184 \"po:ACCOUNT@HOST.DOMAIN\": use \`HOST.DOMAIN\' as POP3 server host.
 185 If this variable is a list, all files mentioned in this list will be
 186 used as incoming mailboxes."
 187   :group 'nnmail-files
 188   :type '(choice (file :tag "File")
 189                  (repeat :tag "Files" file)))
 190
 191 (defcustom nnmail-default-mail-host (getenv "MAILHOST")
 192   "*Default mail POP server address.
 193 This variable gets from environment variable \"MAILHOST\" by default."
 194   :group 'nnmail-files
 195   :type 'string)
 196
 197 (defcustom nnmail-crash-box "~/.gnus-crash-box"
 198   "File where Gnus will store mail while processing it."
 199   :group 'nnmail-files
 200   :type 'file)
 201
 202 (defcustom nnmail-use-procmail nil
 203   "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
 204 The file(s) in `nnmail-spool-file' will also be read."
 205   :group 'nnmail-procmail
 206   :type 'boolean)
 207
 208 (defcustom nnmail-procmail-directory "~/incoming/"
 209   "*When using procmail (and the like), incoming mail is put in this directory.
 210 The Gnus mail backends will read the mail from this directory."
 211   :group 'nnmail-procmail
 212   :type 'directory)
 213
 214 (defcustom nnmail-procmail-suffix "\\.spool"
 215   "*Suffix of files created by procmail (and the like).
 216 This variable might be a suffix-regexp to match the suffixes of
 217 several files - eg. \".spool[0-9]*\"."
 218   :group 'nnmail-procmail
 219   :type 'regexp)
 220
 221 (defcustom nnmail-resplit-incoming nil
 222   "*If non-nil, re-split incoming procmail sorted mail."
 223   :group 'nnmail-procmail
 224   :type 'boolean)
 225
 226 (defcustom nnmail-delete-file-function 'delete-file
 227   "Function called to delete files in some mail backends."
 228   :group 'nnmail-files
 229   :type 'function)
 230
 231 (defcustom nnmail-crosspost-link-function
 232   (if (string-match "windows-nt\\|emx" (symbol-name system-type))
 233       'copy-file
 234     'add-name-to-file)
 235   "*Function called to create a copy of a file.
 236 This is `add-name-to-file' by default, which means that crossposts
 237 will use hard links.  If your file system doesn't allow hard
 238 links, you could set this variable to `copy-file' instead."
 239   :group 'nnmail-files
 240   :type '(radio (function-item add-name-to-file)
 241                 (function-item copy-file)
 242                 (function :tag "Other")))
 243
 244 (defcustom nnmail-movemail-program "movemail"
 245   "*A command to be executed to move mail from the inbox.
 246 The default is \"movemail\".
 247
 248 This can also be a function.  In that case, the function will be
 249 called with two parameters -- the name of the INBOX file, and the file
 250 to be moved to."
 251   :group 'nnmail-files
 252   :group 'nnmail-retrieve
 253   :type 'string)
 254
 255 (defcustom nnmail-pop-password-required nil
 256   "*Non-nil if a password is required when reading mail using POP."
 257   :group 'nnmail-retrieve
 258   :type 'boolean)
 259
 260 (defcustom nnmail-read-incoming-hook
 261   (if (eq system-type 'windows-nt)
 262       '(nnheader-ms-strip-cr)
 263     nil)
 264   "*Hook that will be run after the incoming mail has been transferred.
 265 The incoming mail is moved from `nnmail-spool-file' (which normally is
 266 something like \"/usr/spool/mail/$user\") to the user's home
 267 directory.  This hook is called after the incoming mail box has been
 268 emptied, and can be used to call any mail box programs you have
 269 running (\"xwatch\", etc.)
 270
 271 Eg.
 272
 273 \(add-hook 'nnmail-read-incoming-hook
 274            (lambda ()
 275              (start-process \"mailsend\" nil
 276                             \"/local/bin/mailsend\" \"read\" \"mbox\")))
 277
 278 If you have xwatch running, this will alert it that mail has been
 279 read.
 280
 281 If you use `display-time', you could use something like this:
 282
 283 \(add-hook 'nnmail-read-incoming-hook
 284           (lambda ()
 285             ;; Update the displayed time, since that will clear out
 286             ;; the flag that says you have mail.
 287             (when (eq (process-status \"display-time\") 'run)
 288               (display-time-filter display-time-process \"\"))))"
 289   :group 'nnmail-prepare
 290   :type 'hook)
 291
 292 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
 293 (defcustom nnmail-prepare-incoming-hook nil
 294   "Hook called before treating incoming mail.
 295 The hook is run in a buffer with all the new, incoming mail."
 296   :group 'nnmail-prepare
 297   :type 'hook)
 298
 299 (defcustom nnmail-prepare-incoming-header-hook nil
 300   "Hook called narrowed to the headers of each message.
 301 This can be used to remove excessive spaces (and stuff like
 302 that) from the headers before splitting and saving the messages."
 303   :group 'nnmail-prepare
 304   :type 'hook)
 305
 306 (defcustom nnmail-prepare-incoming-message-hook nil
 307   "Hook called narrowed to each message."
 308   :group 'nnmail-prepare
 309   :type 'hook)
 310
 311 (defcustom nnmail-list-identifiers nil
 312   "Regexp that matches list identifiers to be removed.
 313 This can also be a list of regexps."
 314   :group 'nnmail-prepare
 315   :type '(choice (const :tag "none" nil)
 316                  (regexp :value ".*")
 317                  (repeat :value (".*") regexp)))
 318
 319 (defcustom nnmail-pre-get-new-mail-hook nil
 320   "Hook called just before starting to handle new incoming mail."
 321   :group 'nnmail-retrieve
 322   :type 'hook)
 323
 324 (defcustom nnmail-post-get-new-mail-hook nil
 325   "Hook called just after finishing handling new incoming mail."
 326   :group 'nnmail-retrieve
 327   :type 'hook)
 328
 329 (defcustom nnmail-split-hook nil
 330   "Hook called before deciding where to split an article.
 331 The functions in this hook are free to modify the buffer
 332 contents in any way they choose -- the buffer contents are
 333 discarded after running the split process."
 334   :group 'nnmail-split
 335   :type 'hook)
 336
 337 ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
 338 (defcustom nnmail-tmp-directory nil
 339   "*If non-nil, use this directory for temporary storage.
 340 Used when reading incoming mail."
 341   :group 'nnmail-files
 342   :group 'nnmail-retrieve
 343   :type '(choice (const :tag "default" nil)
 344                  (directory :format "%v")))
 345
 346 (defcustom nnmail-large-newsgroup 50
 347   "*The number of the articles which indicates a large newsgroup.
 348 If the number of the articles is greater than the value, verbose
 349 messages will be shown to indicate the current status."
 350   :group 'nnmail-various
 351   :type 'integer)
 352
 353 (defcustom nnmail-split-fancy "mail.misc"
 354   "Incoming mail can be split according to this fancy variable.
 355 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
 356
 357 The format of this variable is SPLIT, where SPLIT can be one of
 358 the following:
 359
 360 GROUP: Mail will be stored in GROUP (a string).
 361
 362 \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
 363   VALUE (a regexp), store the messages as specified by SPLIT.
 364
 365 \(| SPLIT...): Process each SPLIT expression until one of them matches.
 366   A SPLIT expression is said to match if it will cause the mail
 367   message to be stored in one or more groups.
 368
 369 \(& SPLIT...): Process each SPLIT expression.
 370
 371 \(: FUNCTION optional args): Call FUNCTION with the optional args, in
 372   the buffer containing the message headers.  The return value FUNCTION
 373   should be a split, which is then recursively processed.
 374
 375 FIELD must match a complete field name.  VALUE must match a complete
 376 word according to the `nnmail-split-fancy-syntax-table' syntax table.
 377 You can use \".*\" in the regexps to match partial field names or words.
 378
 379 FIELD and VALUE can also be lisp symbols, in that case they are expanded
 380 as specified in `nnmail-split-abbrev-alist'.
 381
 382 GROUP can contain \\& and \\N which will substitute from matching
 383 \\(\\) patterns in the previous VALUE.
 384
 385 Example:
 386
 387 \(setq nnmail-split-methods 'nnmail-split-fancy
 388       nnmail-split-fancy
 389       ;; Messages from the mailer daemon are not crossposted to any of
 390       ;; the ordinary groups.  Warnings are put in a separate group
 391       ;; from real errors.
 392       '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
 393                           \"mail.misc\"))
 394           ;; Non-error messages are crossposted to all relevant
 395           ;; groups, but we don't crosspost between the group for the
 396           ;; (ding) list and the group for other (ding) related mail.
 397           (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
 398                 (\"subject\" \"ding\" \"ding.misc\"))
 399              ;; Other mailing lists...
 400              (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
 401              (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
 402              ;; People...
 403              (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
 404           ;; Unmatched mail goes to the catch all group.
 405           \"misc.misc\"))"
 406   :group 'nnmail-split
 407   ;; Sigh!
 408   :type 'sexp)
 409
 410 (defcustom nnmail-split-abbrev-alist
 411   '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
 412     (mail . "mailer-daemon\\|postmaster\\|uucp")
 413     (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
 414     (from . "from\\|sender\\|resent-from")
 415     (nato . "to\\|cc\\|resent-to\\|resent-cc")
 416     (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
 417   "*Alist of abbreviations allowed in `nnmail-split-fancy'."
 418   :group 'nnmail-split
 419   :type '(repeat (cons :format "%v" symbol regexp)))
 420
 421 (defcustom nnmail-delete-incoming t
 422   "*If non-nil, the mail backends will delete incoming files after
 423 splitting."
 424   :group 'nnmail-retrieve
 425   :type 'boolean)
 426
 427 (defcustom nnmail-message-id-cache-length 1000
 428   "*The approximate number of Message-IDs nnmail will keep in its cache.
 429 If this variable is nil, no checking on duplicate messages will be
 430 performed."
 431   :group 'nnmail-duplicate
 432   :type '(choice (const :tag "disable" nil)
 433                  (integer :format "%v")))
 434
 435 (defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
 436   "*The file name of the nnmail Message-ID cache."
 437   :group 'nnmail-duplicate
 438   :group 'nnmail-files
 439   :type 'file)
 440
 441 (defcustom nnmail-treat-duplicates 'warn
 442   "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
 443 Three values are legal: nil, which means that nnmail is not to keep a
 444 Message-ID cache; `warn', which means that nnmail should insert extra
 445 headers to warn the user about the duplication (this is the default);
 446 and `delete', which means that nnmail will delete duplicated mails.
 447
 448 This variable can also be a function.  It will be called from a buffer
 449 narrowed to the article in question with the Message-ID as a
 450 parameter.  It should return nil, `warn' or `delete'."
 451   :group 'nnmail-duplicate
 452   :type '(choice (const :tag "off" nil)
 453                  (const warn)
 454                  (const delete)))
 455
 456 (defcustom nnmail-split-header-length-limit 1024
 457   "Header lines longer than this limit are excluded from the split function."
 458   :group 'nnmail
 459   :type 'integer)
 460
 461 ;;; Internal variables.
 462
 463 (defvar nnmail-split-history nil
 464   "List of group/article elements that say where the previous split put messages.")
 465
 466 (defvar nnmail-current-spool nil)
 467
 468 (defvar nnmail-pop-password nil
 469   "*Password to use when reading mail from a POP server, if required.
 470 If this variable is `t', do not use password cache.")
 471
 472 (defvar nnmail-split-fancy-syntax-table nil
 473   "Syntax table used by `nnmail-split-fancy'.")
 474 (unless (syntax-table-p nnmail-split-fancy-syntax-table)
 475   (setq nnmail-split-fancy-syntax-table
 476         (copy-syntax-table (standard-syntax-table)))
 477   ;; support the %-hack
 478   (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table))
 479
 480 (defvar nnmail-prepare-save-mail-hook nil
 481   "Hook called before saving mail.")
 482
 483 (defvar nnmail-moved-inboxes nil
 484   "List of inboxes that have been moved.")
 485
 486 (defvar nnmail-internal-password nil)
 487 (defvar nnmail-internal-password-cache nil)
 488
 489 (defvar nnmail-split-tracing nil)
 490 (defvar nnmail-split-trace nil)
 491
 492 \f
 493
 494 (defconst nnmail-version "nnmail 1.0"
 495   "nnmail version.")
 496
 497 \f
 498
 499 (defun nnmail-parse-spool-file-name (inbox)
 500   (let (cooked-inbox mail-host)
 501     (if (string-match "^po:\\([^@]*\\)\\(@\\(.*$\\)\\|$\\)" inbox)
 502         (setq cooked-inbox (match-string 1 inbox)
 503               mail-host (match-string 3 inbox))
 504       (setq cooked-inbox inbox))
 505     (cons cooked-inbox
 506           (or (and mail-host
 507                    (not (string-equal mail-host ""))
 508                    mail-host)
 509               (or nnmail-default-mail-host
 510                   (setq nnmail-default-mail-host (getenv "MAILHOST")))))))
 511
 512 (defmacro nnmail-spool-maildrop (inbox-info)
 513   `(car ,inbox-info))
 514
 515 (defmacro nnmail-spool-mailhost (inbox-info)
 516   `(cdr ,inbox-info))
 517
 518 (defun nnmail-request-post (&optional server)
 519   (mail-send-and-exit nil))
 520
 521 (defvar nnmail-file-coding-system-for-write
 522   nnheader-message-coding-system-for-write
 523   "Wriring file coding system used in nnmail.")
 524
 525 (defvar nnmail-file-coding-system-for-read
 526   nnheader-message-coding-system-for-read
 527   "Reading file coding system used in nnmail.")
 528
 529 (defvar nnmail-active-coding-system-for-read
 530   nnheader-pathname-coding-system
 531   "Coding system for reading active file.")
 532
 533 (defvar nnmail-active-coding-system-for-write
 534   nnheader-pathname-coding-system
 535   "Coding system for wrinting active file.")
 536
 537 (defun nnmail-find-file (file)
 538   "Insert FILE in server buffer safely."
 539   (set-buffer nntp-server-buffer)
 540   (erase-buffer)
 541   (let ((format-alist nil)
 542         (after-insert-file-functions nil))
 543     (condition-case ()
 544         (let ((pathname-coding-system nnheader-pathname-coding-system))
 545           (insert-file-contents-as-coding-system
 546            nnmail-file-coding-system-for-read file)
 547           t)
 548       (file-error nil))))
 549
 550 (defun nnmail-find-active-file (file)
 551   "Insert active FILE in server buffer safely."
 552   (let ((nnmail-file-coding-system-for-read
 553          nnmail-active-coding-system-for-read))
 554     (nnmail-find-file file)))
 555
 556 (defun nnmail-group-pathname (group dir &optional file)
 557   "Make pathname for GROUP."
 558   (concat
 559    (let ((dir (file-name-as-directory (expand-file-name dir))))
 560      (setq group (nnheader-translate-file-chars group))
 561      ;; If this directory exists, we use it directly.
 562      (if (or nnmail-use-long-file-names
 563              (file-directory-p (concat dir group)))
 564          (concat dir group "/")
 565        ;; If not, we translate dots into slashes.
 566        (concat dir
 567                (gnus-encode-coding-string
 568                 (nnheader-replace-chars-in-string group ?. ?/)
 569                 nnheader-pathname-coding-system)
 570                "/")))
 571    (or file "")))
 572
 573 (defun nnmail-date-to-time (date)
 574   "Convert DATE into time."
 575   (condition-case ()
 576       (let* ((d1 (timezone-parse-date date))
 577              (t1 (timezone-parse-time (aref d1 3))))
 578         (apply 'encode-time
 579                (mapcar (lambda (el)
 580                          (and el (string-to-number el)))
 581                        (list
 582                         (aref t1 2) (aref t1 1) (aref t1 0)
 583                         (aref d1 2) (aref d1 1) (aref d1 0)
 584                         (number-to-string
 585                          (* 60 (timezone-zone-to-minute
 586                                 (or (aref d1 4) (current-time-zone)))))))))
 587     ;; If we get an error, then we just return a 0 time.
 588     (error (list 0 0))))
 589
 590 (defun nnmail-time-less (t1 t2)
 591   "Say whether time T1 is less than time T2."
 592   (or (< (car t1) (car t2))
 593       (and (= (car t1) (car t2))
 594            (< (nth 1 t1) (nth 1 t2)))))
 595
 596 (defun nnmail-days-to-time (days)
 597   "Convert DAYS into time."
 598   (let* ((seconds (* 1.0 days 60 60 24))
 599          (rest (expt 2 16))
 600          (ms (condition-case nil (floor (/ seconds rest))
 601                (range-error (expt 2 16)))))
 602     (list ms (condition-case nil (round (- seconds (* ms rest)))
 603                (range-error (expt 2 16))))))
 604
 605 (defun nnmail-time-since (time)
 606   "Return the time since TIME, which is either an internal time or a date."
 607   (when (stringp time)
 608     ;; Convert date strings to internal time.
 609     (setq time (nnmail-date-to-time time)))
 610   (let* ((current (current-time))
 611          (rest (when (< (nth 1 current) (nth 1 time))
 612                  (expt 2 16))))
 613     (list (- (+ (car current) (if rest -1 0)) (car time))
 614           (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
 615
 616 (defun nnmail-get-password (inbox)
 617   (let (password)
 618     (unless (eq nnmail-internal-password-cache t)
 619       (when (stringp nnmail-internal-password-cache)
 620         (setq nnmail-internal-password-cache
 621               (cons nil nnmail-internal-password-cache)))
 622       (setq password (cdr (or (assoc inbox nnmail-internal-password-cache)
 623                               (assq nil nnmail-internal-password-cache)))))
 624     (or password
 625         (and nnmail-pop-password-required
 626              (nnmail-read-passwd (format "Password for %s: " inbox))))))
 627
 628 (defun nnmail-set-password (inbox password)
 629   (unless (eq nnmail-internal-password-cache t)
 630     (set-modified-alist 'nnmail-internal-password-cache
 631                         (list (cons inbox password)))))
 632
 633 ;; Function rewritten from rmail.el.
 634 (defun nnmail-move-inbox (inbox)
 635   "Move INBOX to `nnmail-crash-box'."
 636   (if (not (file-writable-p nnmail-crash-box))
 637       (gnus-error 1 "Can't write to crash box %s.  Not moving mail"
 638                   nnmail-crash-box)
 639     ;; If the crash box exists and is empty, we delete it.
 640     (when (and (file-exists-p nnmail-crash-box)
 641                (zerop (nnheader-file-size (file-truename nnmail-crash-box))))
 642       (delete-file nnmail-crash-box))
 643     (let ((tofile (file-truename (expand-file-name nnmail-crash-box)))
 644           (popmail (string-match "^po:" inbox))
 645           movemail errors result)
 646       (unless popmail
 647         (setq inbox (file-truename (expand-file-name inbox)))
 648         (setq movemail t)
 649         ;; On some systems, /usr/spool/mail/foo is a directory
 650         ;; and the actual inbox is /usr/spool/mail/foo/foo.
 651         (when (file-directory-p inbox)
 652           (setq inbox (expand-file-name (user-login-name) inbox))))
 653       (if (member inbox nnmail-moved-inboxes)
 654           ;; We don't try to move an already moved inbox.
 655           nil
 656         (if popmail
 657             (progn
 658               (when (and nnmail-pop-password
 659                          (not nnmail-internal-password-cache))
 660                 (setq nnmail-internal-password-cache nnmail-pop-password))
 661               (setq nnmail-internal-password (nnmail-get-password inbox))
 662               (nnheader-message 5 "Getting mail from the post office %s..."
 663                                 inbox))
 664           (when (or (and (file-exists-p tofile)
 665                          (/= 0 (nnheader-file-size tofile)))
 666                     (and (file-exists-p inbox)
 667                          (/= 0 (nnheader-file-size inbox))))
 668             (nnheader-message 5 "Getting mail from %s..." inbox)))
 669         ;; Set TOFILE if have not already done so, and
 670         ;; rename or copy the file INBOX to TOFILE if and as appropriate.
 671         (cond
 672          ((file-exists-p tofile)
 673           ;; The crash box exists already.
 674           t)
 675          ((and (not popmail)
 676                (not (file-exists-p inbox)))
 677           ;; There is no inbox.
 678           (setq tofile nil))
 679          (t
 680           ;; If getting from mail spool directory, use movemail to move
 681           ;; rather than just renaming, so as to interlock with the
 682           ;; mailer.
 683           (unwind-protect
 684               (save-excursion
 685                 (setq errors (generate-new-buffer " *nnmail loss*"))
 686                 (buffer-disable-undo errors)
 687                 (if (nnheader-functionp nnmail-movemail-program)
 688                     (condition-case err
 689                         (progn
 690                           (funcall nnmail-movemail-program inbox tofile)
 691                           (setq result 0))
 692                       (error
 693                        (save-excursion
 694                          (set-buffer errors)
 695                          (insert (prin1-to-string err))
 696                          (setq result 255))))
 697                   (let ((default-directory "/")
 698                         (inbox-info (nnmail-parse-spool-file-name inbox)))
 699                     (setenv "MAILHOST" (nnmail-spool-mailhost inbox-info))
 700                     (setq result
 701                           (apply
 702                            'call-process
 703                            (append
 704                             (list
 705                              (expand-file-name
 706                               nnmail-movemail-program exec-directory)
 707                              nil errors nil
 708                              (concat "po:" (nnmail-spool-maildrop inbox-info))
 709                              tofile)
 710                             (when nnmail-internal-password
 711                               (list nnmail-internal-password)))))))
 712                 (push inbox nnmail-moved-inboxes)
 713                 (if (and (not (buffer-modified-p errors))
 714                          (zerop result))
 715                     ;; No output => movemail won
 716                     (progn
 717                       (unless popmail
 718                         (when (file-exists-p tofile)
 719                           (set-file-modes tofile nnmail-default-file-modes))))
 720                   (set-buffer errors)
 721                   ;; There may be a warning about older revisions.  We
 722                   ;; ignore those.
 723                   (goto-char (point-min))
 724                   (if (search-forward "older revision" nil t)
 725                       (progn
 726                         (unless popmail
 727                           (when (file-exists-p tofile)
 728                             (set-file-modes
 729                              tofile nnmail-default-file-modes))))
 730                     ;; Probably a real error.
 731                     ;; We nix out the password in case the error
 732                     ;; was because of a wrong password being given.
 733                     (setq nnmail-internal-password nil)
 734                     (subst-char-in-region (point-min) (point-max) ?\n ?\  )
 735                     (goto-char (point-max))
 736                     (skip-chars-backward " \t")
 737                     (delete-region (point) (point-max))
 738                     (goto-char (point-min))
 739                     (when (looking-at "movemail: ")
 740                       (delete-region (point-min) (match-end 0)))
 741                     (unless (yes-or-no-p
 742                              (format "movemail: %s (%d return).  Continue? "
 743                                      (buffer-string)))
 744                              (error "%s" (buffer-string)))
 745                     (setq tofile nil)))
 746                 ))))
 747         (nnmail-set-password inbox nnmail-internal-password)
 748         (nnheader-message 5 "Getting mail from %s...done" inbox)
 749         (and errors
 750              (buffer-name errors)
 751              (kill-buffer errors))
 752         tofile))))
 753
 754 (defun nnmail-get-active ()
 755   "Returns an assoc of group names and active ranges.
 756 nn*-request-list should have been called before calling this function."
 757   (let (group-assoc)
 758     ;; Go through all groups from the active list.
 759     (save-excursion
 760       (set-buffer nntp-server-buffer)
 761       (goto-char (point-min))
 762       (while (re-search-forward
 763               "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
 764         ;; We create an alist with `(GROUP (LOW . HIGH))' elements.
 765         (push (list (match-string 1)
 766                     (cons (string-to-int (match-string 3))
 767                           (string-to-int (match-string 2))))
 768               group-assoc)))
 769     group-assoc))
 770
 771 (defun nnmail-save-active (group-assoc file-name)
 772   "Save GROUP-ASSOC in ACTIVE-FILE."
 773   (let ((coding-system-for-write nnmail-active-coding-system-for-write))
 774     (when file-name
 775       (nnheader-temp-write file-name
 776         (nnmail-generate-active group-assoc)))))
 777
 778 (defun nnmail-generate-active (alist)
 779   "Generate an active file from group-alist ALIST."
 780   (erase-buffer)
 781   (let (group)
 782     (while (setq group (pop alist))
 783       (insert (format "%s %d %d y\n" (car group) (cdadr group)
 784                       (caadr group))))))
 785
 786 (defun nnmail-get-split-group (file group)
 787   "Find out whether this FILE is to be split into GROUP only.
 788 If GROUP is non-nil and we are using procmail, return the group name
 789 only when the file is the correct procmail file.  When GROUP is nil,
 790 return nil if FILE is a spool file or the procmail group for which it
 791 is a spool.  If not using procmail, return GROUP."
 792   (if (or (eq nnmail-spool-file 'procmail)
 793           nnmail-use-procmail)
 794       (if (string-match (concat "^" (regexp-quote
 795                                      (expand-file-name
 796                                       (file-name-as-directory
 797                                        nnmail-procmail-directory)))
 798                                 "\\([^/]*\\)"
 799                                 nnmail-procmail-suffix "$")
 800                         (expand-file-name file))
 801           (let ((procmail-group (substring (expand-file-name file)
 802                                            (match-beginning 1)
 803                                            (match-end 1))))
 804             (if group
 805                 (if (string-equal group procmail-group)
 806                     group
 807                   nil)
 808               procmail-group))
 809         nil)
 810     group))
 811
 812 (defun nnmail-process-babyl-mail-format (func artnum-func)
 813   (let ((case-fold-search t)
 814         start message-id content-length do-search end)
 815     (while (not (eobp))
 816       (goto-char (point-min))
 817       (re-search-forward
 818        "\f\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
 819       (goto-char (match-end 0))
 820       (delete-region (match-beginning 0) (match-end 0))
 821       (narrow-to-region
 822        (setq start (point))
 823        (progn
 824          ;; Skip all the headers in case there are more "From "s...
 825          (or (search-forward "\n\n" nil t)
 826              (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
 827              (search-forward "\1f\f"))
 828          (point)))
 829       ;; Unquote the ">From " line, if any.
 830       (goto-char (point-min))
 831       (when (looking-at ">From ")
 832         (replace-match "X-From-Line: ") )
 833       (run-hooks 'nnmail-prepare-incoming-header-hook)
 834       (goto-char (point-max))
 835       ;; Find the Message-ID header.
 836       (save-excursion
 837         (if (re-search-backward
 838              "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
 839             (setq message-id (buffer-substring (match-beginning 1)
 840                                                (match-end 1)))
 841           ;; There is no Message-ID here, so we create one.
 842           (save-excursion
 843             (when (re-search-backward "^Message-ID[ \t]*:" nil t)
 844               (beginning-of-line)
 845               (insert "Original-")))
 846           (forward-line -1)
 847           (insert "Message-ID: " (setq message-id (nnmail-message-id))
 848                   "\n")))
 849       ;; Look for a Content-Length header.
 850       (if (not (save-excursion
 851                  (and (re-search-backward
 852                        "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
 853                       (setq content-length (string-to-int
 854                                             (buffer-substring
 855                                              (match-beginning 1)
 856                                              (match-end 1))))
 857                       ;; We destroy the header, since none of
 858                       ;; the backends ever use it, and we do not
 859                       ;; want to confuse other mailers by having
 860                       ;; a (possibly) faulty header.
 861                       (progn (insert "X-") t))))
 862           (setq do-search t)
 863         (widen)
 864         (if (or (= (+ (point) content-length) (point-max))
 865                 (save-excursion
 866                   (goto-char (+ (point) content-length))
 867                   (looking-at "\1f")))
 868             (progn
 869               (goto-char (+ (point) content-length))
 870               (setq do-search nil))
 871           (setq do-search t)))
 872       (widen)
 873       ;; Go to the beginning of the next article - or to the end
 874       ;; of the buffer.
 875       (when do-search
 876         (if (re-search-forward "^\1f" nil t)
 877             (goto-char (match-beginning 0))
 878           (goto-char (1- (point-max)))))
 879       (delete-char 1)                   ; delete ^_
 880       (save-excursion
 881         (save-restriction
 882           (narrow-to-region start (point))
 883           (goto-char (point-min))
 884           (nnmail-check-duplication message-id func artnum-func)
 885           (setq end (point-max))))
 886       (goto-char end))))
 887
 888 (defsubst nnmail-search-unix-mail-delim ()
 889   "Put point at the beginning of the next Unix mbox message."
 890   ;; Algorithm used to find the the next article in the
 891   ;; brain-dead Unix mbox format:
 892   ;;
 893   ;; 1) Search for "^From ".
 894   ;; 2) If we find it, then see whether the previous
 895   ;;    line is blank and the next line looks like a header.
 896   ;; Then it's possible that this is a mail delim, and we use it.
 897   (let ((case-fold-search nil)
 898         found)
 899     (while (not found)
 900       (if (not (re-search-forward "^From " nil t))
 901           (setq found 'no)
 902         (save-excursion
 903           (beginning-of-line)
 904           (when (and (or (bobp)
 905                          (save-excursion
 906                            (forward-line -1)
 907                            (eq (char-after) ?\n)))
 908                      (save-excursion
 909                        (forward-line 1)
 910                        (while (looking-at ">From \\|From ")
 911                          (forward-line 1))
 912                        (looking-at "[^ \n\t:]+[ \n\t]*:")))
 913             (setq found 'yes)))))
 914     (beginning-of-line)
 915     (eq found 'yes)))
 916
 917 (defun nnmail-search-unix-mail-delim-backward ()
 918   "Put point at the beginning of the current Unix mbox message."
 919   ;; Algorithm used to find the the next article in the
 920   ;; brain-dead Unix mbox format:
 921   ;;
 922   ;; 1) Search for "^From ".
 923   ;; 2) If we find it, then see whether the previous
 924   ;;    line is blank and the next line looks like a header.
 925   ;; Then it's possible that this is a mail delim, and we use it.
 926   (let ((case-fold-search nil)
 927         found)
 928     (while (not found)
 929       (if (not (re-search-backward "^From " nil t))
 930           (setq found 'no)
 931         (save-excursion
 932           (beginning-of-line)
 933           (when (and (or (bobp)
 934                          (save-excursion
 935                            (forward-line -1)
 936                            (eq (char-after) ?\n)))
 937                      (save-excursion
 938                        (forward-line 1)
 939                        (while (looking-at ">From \\|From ")
 940                          (forward-line 1))
 941                        (looking-at "[^ \n\t:]+[ \n\t]*:")))
 942             (setq found 'yes)))))
 943     (beginning-of-line)
 944     (eq found 'yes)))
 945
 946 (defun nnmail-process-unix-mail-format (func artnum-func)
 947   (let ((case-fold-search t)
 948         start message-id content-length end skip head-end)
 949     (goto-char (point-min))
 950     (if (not (and (re-search-forward "^From " nil t)
 951                   (goto-char (match-beginning 0))))
 952         ;; Possibly wrong format?
 953         (progn
 954           (pop-to-buffer (nnheader-find-file-noselect nnmail-current-spool))
 955           (error "Error, unknown mail format! (Possibly corrupted.)"))
 956       ;; Carry on until the bitter end.
 957       (while (not (eobp))
 958         (setq start (point)
 959               end nil)
 960         ;; Find the end of the head.
 961         (narrow-to-region
 962          start
 963          (if (search-forward "\n\n" nil t)
 964              (1- (point))
 965            ;; This will never happen, but just to be on the safe side --
 966            ;; if there is no head-body delimiter, we search a bit manually.
 967            (while (and (looking-at "From \\|[^ \t]+:")
 968                        (not (eobp)))
 969              (forward-line 1))
 970            (point)))
 971         ;; Find the Message-ID header.
 972         (goto-char (point-min))
 973         (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
 974             (setq message-id (match-string 1))
 975           (save-excursion
 976             (when (re-search-forward "^Message-ID[ \t]*:" nil t)
 977               (beginning-of-line)
 978               (insert "Original-")))
 979           ;; There is no Message-ID here, so we create one.
 980           (forward-line 1)
 981           (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
 982         ;; Look for a Content-Length header.
 983         (goto-char (point-min))
 984         (if (not (re-search-forward
 985                   "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
 986             (setq content-length nil)
 987           (setq content-length (string-to-int (match-string 1)))
 988           ;; We destroy the header, since none of the backends ever
 989           ;; use it, and we do not want to confuse other mailers by
 990           ;; having a (possibly) faulty header.
 991           (beginning-of-line)
 992           (insert "X-"))
 993         (run-hooks 'nnmail-prepare-incoming-header-hook)
 994         ;; Find the end of this article.
 995         (goto-char (point-max))
 996         (widen)
 997         (setq head-end (point))
 998         ;; We try the Content-Length value.  The idea: skip over the header
 999         ;; separator, then check what happens content-length bytes into the
1000         ;; message body.  This should be either the end ot the buffer, the
1001         ;; message separator or a blank line followed by the separator.
1002         ;; The blank line should probably be deleted.  If neither of the
1003         ;; three is met, the content-length header is probably invalid.
1004         (when content-length
1005           (forward-line 1)
1006           (setq skip (+ (point) content-length))
1007           (goto-char skip)
1008           (cond ((or (= skip (point-max))
1009                      (= (1+ skip) (point-max)))
1010                  (setq end (point-max)))
1011                 ((looking-at "From ")
1012                  (setq end skip))
1013                 ((looking-at "[ \t]*\n\\(From \\)")
1014                  (setq end (match-beginning 1)))
1015                 (t (setq end nil))))
1016         (if end
1017             (goto-char end)
1018           ;; No Content-Length, so we find the beginning of the next
1019           ;; article or the end of the buffer.
1020           (goto-char head-end)
1021           (or (nnmail-search-unix-mail-delim)
1022               (goto-char (point-max))))
1023         ;; Allow the backend to save the article.
1024         (save-excursion
1025           (save-restriction
1026             (narrow-to-region start (point))
1027             (goto-char (point-min))
1028             (nnmail-check-duplication message-id func artnum-func)
1029             (setq end (point-max))))
1030         (goto-char end)))))
1031
1032 (defun nnmail-process-mmdf-mail-format (func artnum-func)
1033   (let ((delim "^\^A\^A\^A\^A$")
1034         (case-fold-search t)
1035         start message-id end)
1036     (goto-char (point-min))
1037     (if (not (and (re-search-forward delim nil t)
1038                   (forward-line 1)))
1039         ;; Possibly wrong format?
1040         (progn
1041           (pop-to-buffer (nnheader-find-file-noselect nnmail-current-spool))
1042           (error "Error, unknown mail format! (Possibly corrupted.)"))
1043       ;; Carry on until the bitter end.
1044       (while (not (eobp))
1045         (setq start (point))
1046         ;; Find the end of the head.
1047         (narrow-to-region
1048          start
1049          (if (search-forward "\n\n" nil t)
1050              (1- (point))
1051            ;; This will never happen, but just to be on the safe side --
1052            ;; if there is no head-body delimiter, we search a bit manually.
1053            (while (and (looking-at "From \\|[^ \t]+:")
1054                        (not (eobp)))
1055              (forward-line 1))
1056            (point)))
1057         ;; Find the Message-ID header.
1058         (goto-char (point-min))
1059         (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
1060             (setq message-id (match-string 1))
1061           ;; There is no Message-ID here, so we create one.
1062           (save-excursion
1063             (when (re-search-backward "^Message-ID[ \t]*:" nil t)
1064               (beginning-of-line)
1065               (insert "Original-")))
1066           (forward-line 1)
1067           (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
1068         (run-hooks 'nnmail-prepare-incoming-header-hook)
1069         ;; Find the end of this article.
1070         (goto-char (point-max))
1071         (widen)
1072         (if (re-search-forward delim nil t)
1073             (beginning-of-line)
1074           (goto-char (point-max)))
1075         ;; Allow the backend to save the article.
1076         (save-excursion
1077           (save-restriction
1078             (narrow-to-region start (point))
1079             (goto-char (point-min))
1080             (nnmail-check-duplication message-id func artnum-func)
1081             (setq end (point-max))))
1082         (goto-char end)
1083         (forward-line 2)))))
1084
1085 (defun nnmail-split-incoming (incoming func &optional exit-func
1086                                        group artnum-func)
1087   "Go through the entire INCOMING file and pick out each individual mail.
1088 FUNC will be called with the buffer narrowed to each mail."
1089   (let (;; If this is a group-specific split, we bind the split
1090         ;; methods to just this group.
1091         (nnmail-split-methods (if (and group
1092                                        (or (eq nnmail-spool-file 'procmail)
1093                                            nnmail-use-procmail)
1094                                        (not nnmail-resplit-incoming))
1095                                   (list (list group ""))
1096                                 nnmail-split-methods)))
1097     (save-excursion
1098       ;; Insert the incoming file.
1099       (set-buffer (get-buffer-create " *nnmail incoming*"))
1100       (buffer-disable-undo (current-buffer))
1101       (erase-buffer)
1102       (nnheader-insert-file-contents incoming)
1103       (unless (zerop (buffer-size))
1104         (goto-char (point-min))
1105         (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
1106         ;; Handle both babyl, MMDF and unix mail formats, since movemail will
1107         ;; use the former when fetching from a mailbox, the latter when
1108         ;; fetching from a file.
1109         (cond ((or (looking-at "\^L")
1110                    (looking-at "BABYL OPTIONS:"))
1111                (nnmail-process-babyl-mail-format func artnum-func))
1112               ((looking-at "\^A\^A\^A\^A")
1113                (nnmail-process-mmdf-mail-format func artnum-func))
1114               (t
1115                (nnmail-process-unix-mail-format func artnum-func))))
1116       (when exit-func
1117         (funcall exit-func))
1118       (kill-buffer (current-buffer)))))
1119
1120 (defun nnmail-article-group (func &optional trace)
1121   "Look at the headers and return an alist of groups that match.
1122 FUNC will be called with the group name to determine the article number."
1123   (let ((methods nnmail-split-methods)
1124         (obuf (current-buffer))
1125         (beg (point-min))
1126         end group-art method regrepp)
1127     (if (and (sequencep methods)
1128              (= (length methods) 1))
1129         ;; If there is only just one group to put everything in, we
1130         ;; just return a list with just this one method in.
1131         (setq group-art
1132               (list (cons (caar methods) (funcall func (caar methods)))))
1133       ;; We do actual comparison.
1134       (save-excursion
1135         ;; Find headers.
1136         (goto-char beg)
1137         (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
1138         (set-buffer nntp-server-buffer)
1139         (erase-buffer)
1140         ;; Copy the headers into the work buffer.
1141         (insert-buffer-substring obuf beg end)
1142         ;; Fold continuation lines.
1143         (goto-char (point-min))
1144         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
1145           (replace-match " " t t))
1146         ;; Nuke pathologically long headers.  Since Gnus applies
1147         ;; pathologically complex regexps to the buffer, lines
1148         ;; that are looong will take longer than the Universe's
1149         ;; existence to process.
1150         (goto-char (point-min))
1151         (while (not (eobp))
1152           (unless (< (move-to-column nnmail-split-header-length-limit)
1153                      nnmail-split-header-length-limit)
1154             (delete-region (point) (progn (end-of-line) (point))))
1155           (forward-line 1))
1156         ;; Allow washing.
1157         (goto-char (point-min))
1158         (run-hooks 'nnmail-split-hook)
1159         (when (setq nnmail-split-tracing trace)
1160           (setq nnmail-split-trace nil))
1161         (if (and (symbolp nnmail-split-methods)
1162                  (fboundp nnmail-split-methods))
1163             (let ((split
1164                    (condition-case nil
1165                        ;; `nnmail-split-methods' is a function, so we
1166                        ;; just call this function here and use the
1167                        ;; result.
1168                        (or (funcall nnmail-split-methods)
1169                            '("bogus"))
1170                      (error
1171                       (nnheader-message 5
1172                        "Error in `nnmail-split-methods'; using `bogus' mail group")
1173                       (sit-for 1)
1174                       '("bogus")))))
1175               (setq split (gnus-remove-duplicates split))
1176               ;; The article may be "cross-posted" to `junk'.  What
1177               ;; to do?  Just remove the `junk' spec.  Don't really
1178               ;; see anything else to do...
1179               (let (elem)
1180                 (while (setq elem (car (memq 'junk split)))
1181                   (setq split (delq elem split))))
1182               (when split
1183                 (setq group-art
1184                       (mapcar
1185                        (lambda (group) (cons group (funcall func group)))
1186                        split))))
1187           ;; Go through the split methods to find a match.
1188           (while (and methods
1189                       (or nnmail-crosspost
1190                           (not group-art)))
1191             (goto-char (point-max))
1192             (setq method (pop methods)
1193                   regrepp nil)
1194             (if (or methods
1195                     (not (equal "" (nth 1 method))))
1196                 (when (and
1197                        (ignore-errors
1198                          (if (stringp (nth 1 method))
1199                              (progn
1200                                (setq regrepp
1201                                      (string-match "\\\\[0-9&]" (car method)))
1202                                (re-search-backward (cadr method) nil t))
1203                            ;; Function to say whether this is a match.
1204                            (funcall (nth 1 method) (car method))))
1205                        ;; Don't enter the article into the same
1206                        ;; group twice.
1207                        (not (assoc (car method) group-art)))
1208                   (push (cons (if regrepp
1209                                   (nnmail-expand-newtext (car method))
1210                                 (car method))
1211                               (funcall func (car method)))
1212                         group-art))
1213               ;; This is the final group, which is used as a
1214               ;; catch-all.
1215               (unless group-art
1216                 (setq group-art
1217                       (list (cons (car method)
1218                                   (funcall func (car method)))))))))
1219         ;; Produce a trace if non-empty.
1220         (when (and trace nnmail-split-trace)
1221           (let ((trace (nreverse nnmail-split-trace))
1222                 (restore (current-buffer)))
1223             (nnheader-set-temp-buffer "*Split Trace*")
1224             (gnus-add-buffer)
1225             (while trace
1226               (insert (car trace) "\n")
1227               (setq trace (cdr trace)))
1228             (goto-char (point-min))
1229             (gnus-configure-windows 'split-trace)
1230             (set-buffer restore)))
1231         ;; See whether the split methods returned `junk'.
1232         (if (equal group-art '(junk))
1233             nil
1234           ;; The article may be "cross-posted" to `junk'.  What
1235           ;; to do?  Just remove the `junk' spec.  Don't really
1236           ;; see anything else to do...
1237           (let (elem)
1238             (while (setq elem (car (memq 'junk group-art)))
1239               (setq group-art (delq elem group-art)))
1240             (nreverse group-art)))))))
1241
1242 (defun nnmail-insert-lines ()
1243   "Insert how many lines there are in the body of the mail.
1244 Return the number of characters in the body."
1245   (let (lines chars)
1246     (save-excursion
1247       (goto-char (point-min))
1248       (when (search-forward "\n\n" nil t)
1249         (setq chars (- (point-max) (point)))
1250         (setq lines (count-lines (point) (point-max)))
1251         (forward-char -1)
1252         (save-excursion
1253           (when (re-search-backward "^Lines: " nil t)
1254             (delete-region (point) (progn (forward-line 1) (point)))))
1255         (beginning-of-line)
1256         (insert (format "Lines: %d\n" (max lines 0)))
1257         chars))))
1258
1259 (defun nnmail-insert-xref (group-alist)
1260   "Insert an Xref line based on the (group . article) alist."
1261   (save-excursion
1262     (goto-char (point-min))
1263     (when (search-forward "\n\n" nil t)
1264       (forward-char -1)
1265       (when (re-search-backward "^Xref: " nil t)
1266         (delete-region (match-beginning 0)
1267                        (progn (forward-line 1) (point))))
1268       (insert (format "Xref: %s" (system-name)))
1269       (while group-alist
1270         (insert
1271          (format " %s:%d"
1272                  (gnus-encode-coding-string (caar group-alist)
1273                                             nnheader-pathname-coding-system)
1274                  (cdar group-alist)))
1275         (setq group-alist (cdr group-alist)))
1276       (insert "\n"))))
1277
1278 ;;; Message washing functions
1279
1280 (defun nnmail-remove-leading-whitespace ()
1281   "Remove excessive whitespace from all headers."
1282   (goto-char (point-min))
1283   (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
1284     (replace-match "\\1" t)))
1285
1286 (defun nnmail-remove-list-identifiers ()
1287   "Remove list identifiers from Subject headers."
1288   (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers
1289                   (mapconcat 'identity nnmail-list-identifiers "\\|"))))
1290     (when regexp
1291       (goto-char (point-min))
1292       (when (re-search-forward
1293              (concat "^Subject: +\\(Re: +\\)?\\(" regexp "\\) *")
1294              nil t)
1295         (delete-region (match-beginning 2) (match-end 0))))))
1296
1297 (defun nnmail-remove-tabs ()
1298   "Translate TAB characters into SPACE characters."
1299   (subst-char-in-region (point-min) (point-max) ?\t ?  t))
1300
1301 ;;; Utility functions
1302
1303 (defun nnmail-make-complex-temp-name (prefix)
1304   (let ((newname (make-temp-name prefix))
1305         (newprefix prefix))
1306     (while (file-exists-p newname)
1307       (setq newprefix (concat newprefix "x"))
1308       (setq newname (make-temp-name newprefix)))
1309     newname))
1310
1311 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
1312
1313 (defun nnmail-split-fancy ()
1314   "Fancy splitting method.
1315 See the documentation for the variable `nnmail-split-fancy' for documentation."
1316   (let ((syntab (syntax-table)))
1317     (unwind-protect
1318         (progn
1319           (set-syntax-table nnmail-split-fancy-syntax-table)
1320           (nnmail-split-it nnmail-split-fancy))
1321       (set-syntax-table syntab))))
1322
1323 (defvar nnmail-split-cache nil)
1324 ;; Alist of split expressions their equivalent regexps.
1325
1326 (defun nnmail-split-it (split)
1327   ;; Return a list of groups matching SPLIT.
1328   (let (cached-pair)
1329     (cond
1330      ;; nil split
1331      ((null split)
1332       nil)
1333
1334      ;; A group name.  Do the \& and \N subs into the string.
1335      ((stringp split)
1336       (when nnmail-split-tracing
1337         (push (format "\"%s\"" split) nnmail-split-trace))
1338       (list (nnmail-expand-newtext split)))
1339
1340      ;; Junk the message.
1341      ((eq split 'junk)
1342       (when nnmail-split-tracing
1343         (push "junk" nnmail-split-trace))
1344       (list 'junk))
1345
1346      ;; Builtin & operation.
1347      ((eq (car split) '&)
1348       (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
1349
1350      ;; Builtin | operation.
1351      ((eq (car split) '|)
1352       (let (done)
1353         (while (and (not done) (cdr split))
1354           (setq split (cdr split)
1355                 done (nnmail-split-it (car split))))
1356         done))
1357
1358      ;; Builtin : operation.
1359      ((eq (car split) ':)
1360       (nnmail-split-it (save-excursion (eval (cdr split)))))
1361
1362      ;; Check the cache for the regexp for this split.
1363      ((setq cached-pair (assq split nnmail-split-cache))
1364       (goto-char (point-max))
1365       ;; FIX FIX FIX problem with re-search-backward is that if you have
1366       ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1")
1367       ;; and someone mails a message with 'To: foo-bar@gnus.org' and
1368       ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group
1369       ;; if the cc line is a later header, even though the other choice
1370       ;; is probably better.  Also, this routine won't do a crosspost
1371       ;; when there are two different matches.
1372       ;; I guess you could just make this more determined, and it could
1373       ;; look for still more matches prior to this one, and recurse
1374       ;; on each of the multiple matches hit.  Of course, then you'd
1375       ;; want to make sure that nnmail-article-group or nnmail-split-fancy
1376       ;; removed duplicates, since there might be more of those.
1377       ;; I guess we could also remove duplicates in the & split case, since
1378       ;; that's the only thing that can introduce them.
1379       (when (re-search-backward (cdr cached-pair) nil t)
1380         (when nnmail-split-tracing
1381           (push (cdr cached-pair) nnmail-split-trace))
1382         ;; Someone might want to do a \N sub on this match, so get the
1383         ;; correct match positions.
1384         (goto-char (match-end 0))
1385         (let ((value (nth 1 split)))
1386           (re-search-backward (if (symbolp value)
1387                                   (cdr (assq value nnmail-split-abbrev-alist))
1388                                 value)
1389                               (match-end 1)))
1390         (nnmail-split-it (nth 2 split))))
1391
1392      ;; Not in cache, compute a regexp for the field/value pair.
1393      (t
1394       (let* ((field (nth 0 split))
1395              (value (nth 1 split))
1396              (regexp (concat "^\\(\\("
1397                              (if (symbolp field)
1398                                  (cdr (assq field nnmail-split-abbrev-alist))
1399                                field)
1400                              "\\):.*\\)\\<\\("
1401                              (if (symbolp value)
1402                                  (cdr (assq value nnmail-split-abbrev-alist))
1403                                value)
1404                              "\\)\\>")))
1405         (push (cons split regexp) nnmail-split-cache)
1406         ;; Now that it's in the cache, just call nnmail-split-it again
1407         ;; on the same split, which will find it immediately in the cache.
1408         (nnmail-split-it split))))))
1409
1410 (defun nnmail-expand-newtext (newtext)
1411   (let ((len (length newtext))
1412         (pos 0)
1413         c expanded beg N did-expand)
1414     (while (< pos len)
1415       (setq beg pos)
1416       (while (and (< pos len)
1417                   (not (= (aref newtext pos) ?\\)))
1418         (setq pos (1+ pos)))
1419       (unless (= beg pos)
1420         (push (substring newtext beg pos) expanded))
1421       (when (< pos len)
1422         ;; We hit a \; expand it.
1423         (setq did-expand t
1424               pos (1+ pos)
1425               c (aref newtext pos))
1426         (if (not (or (= c ?\&)
1427                      (and (>= c ?1)
1428                           (<= c ?9))))
1429             ;; \ followed by some character we don't expand.
1430             (push (char-to-string c) expanded)
1431           ;; \& or \N
1432           (if (= c ?\&)
1433               (setq N 0)
1434             (setq N (- c ?0)))
1435           (when (match-beginning N)
1436             (push (buffer-substring (match-beginning N) (match-end N))
1437                   expanded))))
1438       (setq pos (1+ pos)))
1439     (if did-expand
1440         (apply 'concat (nreverse expanded))
1441       newtext)))
1442
1443 ;; Get a list of spool files to read.
1444 (defun nnmail-get-spool-files (&optional group)
1445   (if (null nnmail-spool-file)
1446       ;; No spool file whatsoever.
1447       nil
1448     (let* ((procmails
1449             ;; If procmail is used to get incoming mail, the files
1450             ;; are stored in this directory.
1451             (and (file-exists-p nnmail-procmail-directory)
1452                  (or (eq nnmail-spool-file 'procmail)
1453                      nnmail-use-procmail)
1454                  (directory-files
1455                   nnmail-procmail-directory
1456                   t (concat (if group (concat "^" (regexp-quote group)) "")
1457                             nnmail-procmail-suffix "$"))))
1458            (p procmails)
1459            (crash (when (and (file-exists-p nnmail-crash-box)
1460                              (> (nnheader-file-size
1461                                  (file-truename nnmail-crash-box))
1462                                 0))
1463                     (list nnmail-crash-box))))
1464       ;; Remove any directories that inadvertently match the procmail
1465       ;; suffix, which might happen if the suffix is "".
1466       (while p
1467         (when (file-directory-p (car p))
1468           (setq procmails (delete (car p) procmails)))
1469         (setq p (cdr p)))
1470       ;; Return the list of spools.
1471       (append
1472        crash
1473        (cond ((and group
1474                    (or (eq nnmail-spool-file 'procmail)
1475                        nnmail-use-procmail)
1476                    procmails)
1477               procmails)
1478              ((and group
1479                    (eq nnmail-spool-file 'procmail))
1480               nil)
1481              ((listp nnmail-spool-file)
1482               (nconc
1483                (apply
1484                 'nconc
1485                 (mapcar
1486                  (lambda (file)
1487                    (if (and (not (string-match "^po:" file))
1488                             (file-directory-p file))
1489                        (nnheader-directory-regular-files file)
1490                      (list file)))
1491                  nnmail-spool-file))
1492                procmails))
1493              ((stringp nnmail-spool-file)
1494               (if (and (not (string-match "^po:" nnmail-spool-file))
1495                        (file-directory-p nnmail-spool-file))
1496                   (nconc
1497                    (nnheader-directory-regular-files nnmail-spool-file)
1498                    procmails)
1499                 (cons nnmail-spool-file procmails)))
1500              ((eq nnmail-spool-file 'pop)
1501               (cons (format "po:%s" (user-login-name)) procmails))
1502              (t
1503               procmails))))))
1504
1505 ;; Activate a backend only if it isn't already activated.
1506 ;; If FORCE, re-read the active file even if the backend is
1507 ;; already activated.
1508 (defun nnmail-activate (backend &optional force)
1509   (nnheader-init-server-buffer)
1510   (let (file timestamp file-time)
1511     (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
1512             force
1513             (and (setq file (ignore-errors
1514                               (symbol-value (intern (format "%s-active-file"
1515                                                             backend)))))
1516                  (setq file-time (nth 5 (file-attributes file)))
1517                  (or (not
1518                       (setq timestamp
1519                             (condition-case ()
1520                                 (symbol-value (intern
1521                                                (format "%s-active-timestamp"
1522                                                        backend)))
1523                               (error 'none))))
1524                      (not (consp timestamp))
1525                      (equal timestamp '(0 0))
1526                      (> (nth 0 file-time) (nth 0 timestamp))
1527                      (and (= (nth 0 file-time) (nth 0 timestamp))
1528                           (> (nth 1 file-time) (nth 1 timestamp))))))
1529         (save-excursion
1530           (or (eq timestamp 'none)
1531               (set (intern (format "%s-active-timestamp" backend))
1532                    file-time))
1533           (funcall (intern (format "%s-request-list" backend)))))
1534     t))
1535
1536 (defun nnmail-message-id ()
1537   (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
1538
1539 ;;;
1540 ;;; nnmail duplicate handling
1541 ;;;
1542
1543 (defvar nnmail-cache-buffer nil)
1544
1545 (defun nnmail-cache-open ()
1546   (if (or (not nnmail-treat-duplicates)
1547           (and nnmail-cache-buffer
1548                (buffer-name nnmail-cache-buffer)))
1549       ()                                ; The buffer is open.
1550     (save-excursion
1551       (set-buffer
1552        (setq nnmail-cache-buffer
1553              (get-buffer-create " *nnmail message-id cache*")))
1554       (buffer-disable-undo (current-buffer))
1555       (when (file-exists-p nnmail-message-id-cache-file)
1556         (nnheader-insert-file-contents nnmail-message-id-cache-file))
1557       (set-buffer-modified-p nil)
1558       (current-buffer))))
1559
1560 (defun nnmail-cache-close ()
1561   (when (and nnmail-cache-buffer
1562              nnmail-treat-duplicates
1563              (buffer-name nnmail-cache-buffer)
1564              (buffer-modified-p nnmail-cache-buffer))
1565     (save-excursion
1566       (set-buffer nnmail-cache-buffer)
1567       ;; Weed out the excess number of Message-IDs.
1568       (goto-char (point-max))
1569       (when (search-backward "\n" nil t nnmail-message-id-cache-length)
1570         (progn
1571           (beginning-of-line)
1572           (delete-region (point-min) (point))))
1573       ;; Save the buffer.
1574       (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
1575           (make-directory (file-name-directory nnmail-message-id-cache-file)
1576                           t))
1577       (nnmail-write-region (point-min) (point-max)
1578                            nnmail-message-id-cache-file nil 'silent)
1579       (set-buffer-modified-p nil)
1580       (setq nnmail-cache-buffer nil)
1581       (kill-buffer (current-buffer)))))
1582
1583 (defun nnmail-cache-insert (id)
1584   (when nnmail-treat-duplicates
1585     (unless (gnus-buffer-live-p nnmail-cache-buffer)
1586       (nnmail-cache-open))
1587     (save-excursion
1588       (set-buffer nnmail-cache-buffer)
1589       (goto-char (point-max))
1590       (insert id "\n"))))
1591
1592 (defun nnmail-cache-id-exists-p (id)
1593   (when nnmail-treat-duplicates
1594     (save-excursion
1595       (set-buffer nnmail-cache-buffer)
1596       (goto-char (point-max))
1597       (search-backward id nil t))))
1598
1599 (defun nnmail-fetch-field (header)
1600   (save-excursion
1601     (save-restriction
1602       (message-narrow-to-head)
1603       (message-fetch-field header))))
1604
1605 (defun nnmail-check-duplication (message-id func artnum-func)
1606   (run-hooks 'nnmail-prepare-incoming-message-hook)
1607   ;; If this is a duplicate message, then we do not save it.
1608   (let* ((duplication (nnmail-cache-id-exists-p message-id))
1609          (case-fold-search t)
1610          (action (when duplication
1611                    (cond
1612                     ((memq nnmail-treat-duplicates '(warn delete))
1613                      nnmail-treat-duplicates)
1614                     ((nnheader-functionp nnmail-treat-duplicates)
1615                      (funcall nnmail-treat-duplicates message-id))
1616                     (t
1617                      nnmail-treat-duplicates))))
1618          group-art)
1619     ;; Let the backend save the article (or not).
1620     (cond
1621      ((not duplication)
1622       (nnmail-cache-insert message-id)
1623       (funcall func (setq group-art
1624                           (nreverse (nnmail-article-group artnum-func)))))
1625      ((eq action 'delete)
1626       (setq group-art nil))
1627      ((eq action 'warn)
1628       ;; We insert a warning.
1629       (let ((case-fold-search t))
1630         (goto-char (point-min))
1631         (re-search-forward "^message-id[ \t]*:" nil t)
1632         (beginning-of-line)
1633         (insert
1634          "Gnus-Warning: This is a duplicate of message " message-id "\n")
1635         (funcall func (setq group-art
1636                             (nreverse (nnmail-article-group artnum-func))))))
1637      (t
1638       (funcall func (setq group-art
1639                           (nreverse (nnmail-article-group artnum-func))))))
1640     ;; Add the group-art list to the history list.
1641     (if group-art
1642         (push group-art nnmail-split-history)
1643       (delete-region (point-min) (point-max)))))
1644
1645 ;;; Get new mail.
1646
1647 (defun nnmail-get-value (&rest args)
1648   (let ((sym (intern (apply 'format args))))
1649     (when (boundp sym)
1650       (symbol-value sym))))
1651
1652 (defun nnmail-get-new-mail (method exit-func temp
1653                                    &optional group spool-func)
1654   "Read new incoming mail."
1655   (let* ((spools (nnmail-get-spool-files group))
1656          (group-in group)
1657          nnmail-current-spool incoming incomings spool)
1658     (when (and (nnmail-get-value "%s-get-new-mail" method)
1659                nnmail-spool-file)
1660       ;; We first activate all the groups.
1661       (nnmail-activate method)
1662       ;; Allow the user to hook.
1663       (run-hooks 'nnmail-pre-get-new-mail-hook)
1664       ;; Open the message-id cache.
1665       (nnmail-cache-open)
1666       ;; The we go through all the existing spool files and split the
1667       ;; mail from each.
1668       (while spools
1669         (setq spool (pop spools))
1670         ;; We read each spool file if either the spool is a POP-mail
1671         ;; spool, or the file exists.  We can't check for the
1672         ;; existence of POPped mail.
1673         (when (or (string-match "^po:" spool)
1674                   (and (file-exists-p (file-truename spool))
1675                        (> (nnheader-file-size (file-truename spool)) 0)))
1676           (nnheader-message 3 "%s: Reading incoming mail..." method)
1677           (when (and (nnmail-move-inbox spool)
1678                      (file-exists-p nnmail-crash-box))
1679             (setq nnmail-current-spool spool)
1680             ;; There is new mail.  We first find out if all this mail
1681             ;; is supposed to go to some specific group.
1682             (setq group (nnmail-get-split-group spool group-in))
1683             ;; We split the mail
1684             (nnmail-split-incoming
1685              nnmail-crash-box (intern (format "%s-save-mail" method))
1686              spool-func group (intern (format "%s-active-number" method)))
1687             ;; Check whether the inbox is to be moved to the special tmp dir.
1688             (setq incoming
1689                   (nnmail-make-complex-temp-name
1690                    (expand-file-name
1691                     (if nnmail-tmp-directory
1692                         (concat
1693                          (file-name-as-directory nnmail-tmp-directory)
1694                          (file-name-nondirectory
1695                           (concat (file-name-as-directory temp) "Incoming")))
1696                       (concat (file-name-as-directory temp) "Incoming")))))
1697             (unless (file-exists-p (file-name-directory incoming))
1698               (make-directory (file-name-directory incoming) t))
1699             (rename-file nnmail-crash-box incoming t)
1700             (push incoming incomings))))
1701       ;; If we did indeed read any incoming spools, we save all info.
1702       (when incomings
1703         (nnmail-save-active
1704          (nnmail-get-value "%s-group-alist" method)
1705          (nnmail-get-value "%s-active-file" method))
1706         (when exit-func
1707           (funcall exit-func))
1708         (run-hooks 'nnmail-read-incoming-hook)
1709         (nnheader-message 3 "%s: Reading incoming mail...done" method))
1710       ;; Close the message-id cache.
1711       (nnmail-cache-close)
1712       ;; Allow the user to hook.
1713       (run-hooks 'nnmail-post-get-new-mail-hook)
1714       ;; Delete all the temporary files.
1715       (while incomings
1716         (setq incoming (pop incomings))
1717         (and nnmail-delete-incoming
1718              (file-exists-p incoming)
1719              (file-writable-p incoming)
1720              (delete-file incoming))))))
1721
1722 (defun nnmail-expired-article-p (group time force &optional inhibit)
1723   "Say whether an article that is TIME old in GROUP should be expired."
1724   (if force
1725       t
1726     (let ((days (or (and nnmail-expiry-wait-function
1727                          (funcall nnmail-expiry-wait-function group))
1728                     nnmail-expiry-wait)))
1729       (cond ((or (eq days 'never)
1730                  (and (not force)
1731                       inhibit))
1732              ;; This isn't an expirable group.
1733              nil)
1734             ((eq days 'immediate)
1735              ;; We expire all articles on sight.
1736              t)
1737             ((equal time '(0 0))
1738              ;; This is an ange-ftp group, and we don't have any dates.
1739              nil)
1740             ((numberp days)
1741              (setq days (nnmail-days-to-time days))
1742              ;; Compare the time with the current time.
1743              (nnmail-time-less days (nnmail-time-since time)))))))
1744
1745 (defvar nnmail-read-passwd nil)
1746 (defun nnmail-read-passwd (prompt &rest args)
1747   "Read a password using PROMPT.
1748 If ARGS, PROMPT is used as an argument to `format'."
1749   (let ((prompt
1750          (if args
1751              (apply 'format prompt args)
1752            prompt)))
1753     (unless nnmail-read-passwd
1754       (if (functionp 'read-passwd)
1755           (setq nnmail-read-passwd 'read-passwd)
1756         (if (load "passwd" t)
1757             (setq nnmail-read-passwd 'read-passwd)
1758           (unless (fboundp 'ange-ftp-read-passwd)
1759             (autoload 'ange-ftp-read-passwd "ange-ftp"))
1760           (setq nnmail-read-passwd 'ange-ftp-read-passwd))))
1761     (funcall nnmail-read-passwd prompt)))
1762
1763 (defun nnmail-check-syntax ()
1764   "Check (and modify) the syntax of the message in the current buffer."
1765   (save-restriction
1766     (message-narrow-to-head)
1767     (let ((case-fold-search t))
1768       (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
1769         (insert "Message-ID: " (nnmail-message-id) "\n")))))
1770
1771 (defun nnmail-write-region (start end filename &optional append visit lockname)
1772   "Do a `write-region', and then set the file modes."
1773   (let ((pathname-coding-system nnheader-pathname-coding-system))
1774     (write-region-as-coding-system
1775      nnmail-file-coding-system-for-write
1776      start end filename append visit lockname)
1777     (set-file-modes filename nnmail-default-file-modes)))
1778
1779 ;;;
1780 ;;; Status functions
1781 ;;;
1782
1783 (defun nnmail-replace-status (name value)
1784   "Make status NAME and VALUE part of the current status line."
1785   (save-restriction
1786     (message-narrow-to-head)
1787     (let ((status (nnmail-decode-status)))
1788       (setq status (delq (member name status) status))
1789       (when value
1790         (push (cons name value) status))
1791       (message-remove-header "status")
1792       (goto-char (point-max))
1793       (insert "Status: " (nnmail-encode-status status) "\n"))))
1794
1795 (defun nnmail-decode-status ()
1796   "Return a status-value alist from STATUS."
1797   (goto-char (point-min))
1798   (when (re-search-forward "^Status: " nil t)
1799     (let (name value status)
1800       (save-restriction
1801         ;; Narrow to the status.
1802         (narrow-to-region
1803          (point)
1804          (if (re-search-forward "^[^ \t]" nil t)
1805              (1- (point))
1806            (point-max)))
1807         ;; Go through all elements and add them to the list.
1808         (goto-char (point-min))
1809         (while (re-search-forward "[^ \t=]+" nil t)
1810           (setq name (match-string 0))
1811           (if (not (eq (char-after) ?=))
1812               ;; Implied "yes".
1813               (setq value "yes")
1814             (forward-char 1)
1815             (if (not (eq (char-after) ?\"))
1816                 (if (not (looking-at "[^ \t]"))
1817                     ;; Implied "no".
1818                     (setq value "no")
1819                   ;; Unquoted value.
1820                   (setq value (match-string 0))
1821                   (goto-char (match-end 0)))
1822               ;; Quoted value.
1823               (setq value (read (current-buffer)))))
1824           (push (cons name value) status)))
1825       status)))
1826
1827 (defun nnmail-encode-status (status)
1828   "Return a status string from STATUS."
1829   (mapconcat
1830    (lambda (elem)
1831      (concat
1832       (car elem) "="
1833       (if (string-match "[ \t]" (cdr elem))
1834           (prin1-to-string (cdr elem))
1835         (cdr elem))))
1836    status " "))
1837
1838 (defun nnmail-split-history ()
1839   "Generate an overview of where the last mail split put articles."
1840   (interactive)
1841   (unless nnmail-split-history
1842     (error "No current split history"))
1843   (with-output-to-temp-buffer "*nnmail split history*"
1844     (let ((history nnmail-split-history)
1845           elem)
1846       (while (setq elem (pop history))
1847         (princ (mapconcat (lambda (ga)
1848                             (concat (car ga) ":" (int-to-string (cdr ga))))
1849                           elem
1850                           ", "))
1851         (princ "\n")))))
1852
1853 (defun nnmail-purge-split-history (group)
1854   "Remove all instances of GROUP from `nnmail-split-history'."
1855   (let ((history nnmail-split-history))
1856     (while history
1857       (setcar history (gnus-delete-if (lambda (e) (string= (car e) group))
1858                                       (car history)))
1859       (pop history))
1860     (setq nnmail-split-history (delq nil nnmail-split-history))))
1861
1862 (defun nnmail-new-mail-p (group)
1863   "Say whether GROUP has new mail."
1864   (let ((his nnmail-split-history)
1865         found)
1866     (while his
1867       (when (assoc group (pop his))
1868         (setq found t
1869               his nil)))
1870     found))
1871
1872 (eval-and-compile
1873   (autoload 'pop3-movemail "pop3"))
1874
1875 (defun nnmail-pop3-movemail (inbox crashbox)
1876   "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
1877   (let* ((inbox-info (nnmail-parse-spool-file-name inbox))
1878          (pop3-maildrop (nnmail-spool-maildrop inbox-info))
1879          (pop3-mailhost (nnmail-spool-mailhost inbox-info))
1880          (pop3-password nnmail-internal-password))
1881     (pop3-movemail crashbox)))
1882
1883 (defun nnmail-within-headers-p ()
1884   "Check to see if point is within the headers of a unix mail message.
1885 Doesn't change point."
1886   (let ((pos (point)))
1887     (save-excursion
1888       (and (nnmail-search-unix-mail-delim-backward)
1889            (not (search-forward "\n\n" pos t))))))
1890
1891 (run-hooks 'nnmail-load-hook)
1892
1893 (provide 'nnmail)
1894
1895 ;;; nnmail.el ends here