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, 2001, 2002, 2003
   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 'gnus)                         ; for macro gnus-kill-buffer, at least
  32 (require 'nnheader)
  33 (require 'message)
  34 (require 'gnus-util)
  35 (require 'mail-source)
  36 (require 'mm-util)
  37
  38 (eval-and-compile
  39   (autoload 'gnus-add-buffer "gnus")
  40   (autoload 'gnus-kill-buffer "gnus"))
  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 incoming 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 '(("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")
 107                                              (choice regexp function)))
 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 (defcustom nnmail-split-fancy-with-parent-ignore-groups nil
 119   "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
 120 This can also be a list of regexps."
 121   :group 'nnmail-split
 122   :type '(choice (const :tag "none" nil)
 123                  (regexp :value ".*")
 124                  (repeat :value (".*") regexp)))
 125
 126 (defcustom nnmail-cache-ignore-groups nil
 127   "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
 128 This can also be a list of regexps."
 129   :group 'nnmail-split
 130   :type '(choice (const :tag "none" nil)
 131                  (regexp :value ".*")
 132                  (repeat :value (".*") regexp)))
 133
 134 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
 135 (defcustom nnmail-keep-last-article nil
 136   "If non-nil, nnmail will never delete/move a group's last article.
 137 It can be marked expirable, so it will be deleted when it is no longer last.
 138
 139 You may need to set this variable if other programs are putting
 140 new mail into folder numbers that Gnus has marked as expired."
 141   :group 'nnmail-procmail
 142   :group 'nnmail-various
 143   :type 'boolean)
 144
 145 (defcustom nnmail-use-long-file-names nil
 146   "If non-nil the mail backends will use long file and directory names.
 147 If nil, groups like \"mail.misc\" will end up in directories like
 148 \"mail/misc/\"."
 149   :group 'nnmail-files
 150   :type 'boolean)
 151
 152 (defcustom nnmail-default-file-modes 384
 153   "Set the mode bits of all new mail files to this integer."
 154   :group 'nnmail-files
 155   :type 'integer)
 156
 157 (defcustom nnmail-expiry-wait 7
 158   "*Expirable articles that are older than this will be expired.
 159 This variable can either be a number (which will be interpreted as a
 160 number of days) -- this doesn't have to be an integer.  This variable
 161 can also be `immediate' and `never'."
 162   :group 'nnmail-expire
 163   :type '(choice (const immediate)
 164                  (number :tag "days")
 165                  (const never)))
 166
 167 (defcustom nnmail-expiry-wait-function nil
 168   "Variable that holds function to specify how old articles should be before they are expired.
 169 The function will be called with the name of the group that the expiry
 170 is to be performed in, and it should return an integer that says how
 171 many days an article can be stored before it is considered \"old\".
 172 It can also return the values `never' and `immediate'.
 173
 174 Eg.:
 175
 176 \(setq nnmail-expiry-wait-function
 177       (lambda (newsgroup)
 178         (cond ((string-match \"private\" newsgroup) 31)
 179               ((string-match \"junk\" newsgroup) 1)
 180               ((string-match \"important\" newsgroup) 'never)
 181               (t 7))))"
 182   :group 'nnmail-expire
 183   :type '(choice (const :tag "nnmail-expiry-wait" nil)
 184                  (function :format "%v" nnmail-)))
 185
 186 (defcustom nnmail-expiry-target 'delete
 187   "*Variable that says where expired messages should end up.
 188 The default value is `delete' (which says to delete the messages),
 189 but it can also be a string or a function.  If it is a string, expired
 190 messages end up in that group.  If it is a function, the function is
 191 called in a buffer narrowed to the message in question.  The function
 192 receives one argument, the name of the group the message comes from.
 193 The return value should be `delete' or a group name (a string)."
 194   :version "21.1"
 195   :group 'nnmail-expire
 196   :type '(choice (const delete)
 197                  (function :format "%v" nnmail-)
 198                  string))
 199
 200 (defcustom nnmail-fancy-expiry-targets nil
 201   "Determine expiry target based on articles using fancy techniques.
 202
 203 This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries.  If
 204 `nnmail-expiry-target' is set to the function
 205 `nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
 206 the message will be expired to a group determined by invoking
 207 `format-time-string' with TARGET used as the format string and the
 208 time extracted from the articles' Date header (if missing the current
 209 time is used).
 210
 211 In the special cases that HEADER is the symbol `to-from', the regexp
 212 will try to match against both the From and the To header.
 213
 214 Example:
 215
 216 \(setq nnmail-fancy-expiry-targets
 217       '((to-from \"boss\" \"nnfolder:Work\")
 218         (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
 219         (\"from\" \".*\" \"nnfolder:Archive-%Y\")))
 220
 221 In this case, articles containing the string \"boss\" in the To or the
 222 From header will be expired to the group \"nnfolder:Work\";
 223 articles containing the sting \"IMPORTANT\" in the Subject header will
 224 be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
 225 everything else will be expired to \"nnfolder:Archive-YYYY\"."
 226   :group 'nnmail-expire
 227   :type '(repeat (list (choice :tag "Match against"
 228                                (string :tag "Header")
 229                                (const to-from))
 230                        regexp
 231                        (string :tag "Target group format string"))))
 232
 233 (defcustom nnmail-cache-accepted-message-ids nil
 234   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
 235 If non-nil, also update the cache when copy or move articles."
 236   :group 'nnmail
 237   :type 'boolean)
 238
 239 (defcustom nnmail-spool-file '((file))
 240   "*Where the mail backends will look for incoming mail.
 241 This variable is a list of mail source specifiers.
 242 This variable is obsolete; `mail-sources' should be used instead."
 243   :group 'nnmail-files
 244   :type 'sexp)
 245
 246 (defcustom nnmail-resplit-incoming nil
 247   "*If non-nil, re-split incoming procmail sorted mail."
 248   :group 'nnmail-procmail
 249   :type 'boolean)
 250
 251 (defcustom nnmail-scan-directory-mail-source-once nil
 252   "*If non-nil, scan all incoming procmail sorted mails once.
 253 It scans low-level sorted spools even when not required."
 254   :version "21.1"
 255   :group 'nnmail-procmail
 256   :type 'boolean)
 257
 258 (defcustom nnmail-delete-file-function 'delete-file
 259   "Function called to delete files in some mail backends."
 260   :group 'nnmail-files
 261   :type 'function)
 262
 263 (defcustom nnmail-crosspost-link-function
 264   (if (string-match "windows-nt\\|emx" (symbol-name system-type))
 265       'copy-file
 266     'add-name-to-file)
 267   "*Function called to create a copy of a file.
 268 This is `add-name-to-file' by default, which means that crossposts
 269 will use hard links.  If your file system doesn't allow hard
 270 links, you could set this variable to `copy-file' instead."
 271   :group 'nnmail-files
 272   :type '(radio (function-item add-name-to-file)
 273                 (function-item copy-file)
 274                 (function :tag "Other")))
 275
 276 (defcustom nnmail-read-incoming-hook
 277   (if (eq system-type 'windows-nt)
 278       '(nnheader-ms-strip-cr)
 279     nil)
 280   "*Hook that will be run after the incoming mail has been transferred.
 281 The incoming mail is moved from the specified spool file (which normally is
 282 something like \"/usr/spool/mail/$user\") to the user's home
 283 directory.  This hook is called after the incoming mail box has been
 284 emptied, and can be used to call any mail box programs you have
 285 running (\"xwatch\", etc.)
 286
 287 Eg.
 288
 289 \(add-hook 'nnmail-read-incoming-hook
 290           (lambda ()
 291             (call-process \"/local/bin/mailsend\" nil nil nil
 292                           \"read\" nnmail-spool-file)))
 293
 294 If you have xwatch running, this will alert it that mail has been
 295 read.
 296
 297 If you use `display-time', you could use something like this:
 298
 299 \(add-hook 'nnmail-read-incoming-hook
 300           (lambda ()
 301             ;; Update the displayed time, since that will clear out
 302             ;; the flag that says you have mail.
 303             (when (eq (process-status \"display-time\") 'run)
 304               (display-time-filter display-time-process \"\"))))"
 305   :group 'nnmail-prepare
 306   :type 'hook)
 307
 308 (defcustom nnmail-prepare-incoming-hook nil
 309   "Hook called before treating incoming mail.
 310 The hook is run in a buffer with all the new, incoming mail."
 311   :group 'nnmail-prepare
 312   :type 'hook)
 313
 314 (defcustom nnmail-prepare-incoming-header-hook nil
 315   "Hook called narrowed to the headers of each message.
 316 This can be used to remove excessive spaces (and stuff like
 317 that) from the headers before splitting and saving the messages."
 318   :group 'nnmail-prepare
 319   :type 'hook)
 320
 321 (defcustom nnmail-prepare-incoming-message-hook nil
 322   "Hook called narrowed to each message."
 323   :group 'nnmail-prepare
 324   :type 'hook)
 325
 326 (defcustom nnmail-list-identifiers nil
 327   "Regexp that matches list identifiers to be removed.
 328 This can also be a list of regexps."
 329   :group 'nnmail-prepare
 330   :type '(choice (const :tag "none" nil)
 331                  (regexp :value ".*")
 332                  (repeat :value (".*") regexp)))
 333
 334 (defcustom nnmail-pre-get-new-mail-hook nil
 335   "Hook called just before starting to handle new incoming mail."
 336   :group 'nnmail-retrieve
 337   :type 'hook)
 338
 339 (defcustom nnmail-post-get-new-mail-hook nil
 340   "Hook called just after finishing handling new incoming mail."
 341   :group 'nnmail-retrieve
 342   :type 'hook)
 343
 344 (defcustom nnmail-split-hook nil
 345   "Hook called before deciding where to split an article.
 346 The functions in this hook are free to modify the buffer
 347 contents in any way they choose -- the buffer contents are
 348 discarded after running the split process."
 349   :group 'nnmail-split
 350   :type 'hook)
 351
 352 (defcustom nnmail-spool-hook nil
 353   "*A hook called when a new article is spooled."
 354   :group 'nnmail
 355   :type 'hook)
 356
 357 (defcustom nnmail-large-newsgroup 50
 358   "*The number of articles which indicates a large newsgroup or nil.
 359 If the number of articles is greater than the value, verbose
 360 messages will be shown to indicate the current status."
 361   :group 'nnmail-various
 362   :type '(choice (const :tag "infinite" nil)
 363                  (number :tag "count")))
 364
 365 (define-widget 'nnmail-lazy 'default
 366   "Base widget for recursive datastructures.
 367
 368 This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility."
 369   :format "%{%t%}: %v"
 370   :convert-widget 'widget-value-convert-widget
 371   :value-create (lambda (widget)
 372                   (let ((value (widget-get widget :value))
 373                         (type (widget-get widget :type)))
 374                     (widget-put widget :children
 375                                 (list (widget-create-child-value
 376                                        widget (widget-convert type) value)))))
 377   :value-delete 'widget-children-value-delete
 378   :value-get (lambda (widget)
 379                (widget-value (car (widget-get widget :children))))
 380   :value-inline (lambda (widget)
 381                   (widget-apply (car (widget-get widget :children))
 382                                 :value-inline))
 383   :default-get (lambda (widget)
 384                  (widget-default-get
 385                   (widget-convert (widget-get widget :type))))
 386   :match (lambda (widget value)
 387            (widget-apply (widget-convert (widget-get widget :type))
 388                          :match value))
 389   :validate (lambda (widget)
 390               (widget-apply (car (widget-get widget :children)) :validate)))
 391
 392 (define-widget 'nnmail-split-fancy 'nnmail-lazy
 393   "Widget for customizing splits in the variable of the same name."
 394   :tag "Split"
 395   :type '(menu-choice :value (any ".*value.*" "misc")
 396                       :tag "Type"
 397                       (string :tag "Destination")
 398                       (list :tag "Use first match (|)" :value (|)
 399                             (const :format "" |)
 400                             (editable-list :inline t nnmail-split-fancy))
 401                       (list :tag "Use all matches (&)" :value (&)
 402                             (const :format "" &)
 403                             (editable-list :inline t nnmail-split-fancy))
 404                       (list :tag "Function with fixed arguments (:)"
 405                             :value (:)
 406                             (const :format "" :value :)
 407                             function
 408                             (editable-list :inline t (sexp :tag "Arg"))
 409                             )
 410                       (list :tag "Function with split arguments (!)"
 411                             :value (!)
 412                             (const :format "" !)
 413                             function
 414                             (editable-list :inline t nnmail-split-fancy))
 415                       (list :tag "Field match"
 416                             (choice :tag "Field"
 417                                     regexp symbol)
 418                             (choice :tag "Match"
 419                                     regexp
 420                                     (symbol :value mail))
 421                             (repeat :inline t
 422                                     :tag "Restrictions"
 423                                     (group :inline t
 424                                            (const :format "" -)
 425                                            regexp))
 426                             nnmail-split-fancy)
 427                       (const :tag "Junk (delete mail)" junk)))
 428
 429 (defcustom nnmail-split-fancy "mail.misc"
 430   "Incoming mail can be split according to this fancy variable.
 431 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
 432
 433 The format of this variable is SPLIT, where SPLIT can be one of
 434 the following:
 435
 436 GROUP: Mail will be stored in GROUP (a string).
 437
 438 \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
 439   field FIELD (a regexp) contains VALUE (a regexp), store the messages
 440   as specified by SPLIT.  If RESTRICT (a regexp) matches some string
 441   after FIELD and before the end of the matched VALUE, return nil,
 442   otherwise process SPLIT.  Multiple RESTRICTs add up, further
 443   restricting the possibility of processing SPLIT.
 444
 445 \(| SPLIT...): Process each SPLIT expression until one of them matches.
 446   A SPLIT expression is said to match if it will cause the mail
 447   message to be stored in one or more groups.
 448
 449 \(& SPLIT...): Process each SPLIT expression.
 450
 451 \(: FUNCTION optional args): Call FUNCTION with the optional args, in
 452   the buffer containing the message headers.  The return value FUNCTION
 453   should be a split, which is then recursively processed.
 454
 455 \(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT.  The
 456   return value FUNCTION should be a split, which is then recursively
 457   processed.
 458
 459 junk: Mail will be deleted.  Use with care!  Do not submerge in water!
 460   Example:
 461   (setq nnmail-split-fancy
 462         '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
 463             ...other.rules.omitted...))
 464
 465 FIELD must match a complete field name.  VALUE must match a complete
 466 word according to the `nnmail-split-fancy-syntax-table' syntax table.
 467 You can use \".*\" in the regexps to match partial field names or words.
 468
 469 FIELD and VALUE can also be Lisp symbols, in that case they are expanded
 470 as specified in `nnmail-split-abbrev-alist'.
 471
 472 GROUP can contain \\& and \\N which will substitute from matching
 473 \\(\\) patterns in the previous VALUE.
 474
 475 Example:
 476
 477 \(setq nnmail-split-methods 'nnmail-split-fancy
 478       nnmail-split-fancy
 479       ;; Messages from the mailer daemon are not crossposted to any of
 480       ;; the ordinary groups.  Warnings are put in a separate group
 481       ;; from real errors.
 482       '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
 483                           \"mail.misc\"))
 484           ;; Non-error messages are crossposted to all relevant
 485           ;; groups, but we don't crosspost between the group for the
 486           ;; (ding) list and the group for other (ding) related mail.
 487           (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
 488                 (\"subject\" \"ding\" \"ding.misc\"))
 489              ;; Other mailing lists...
 490              (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
 491              (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
 492              ;; Both lists below have the same suffix, so prevent
 493              ;; cross-posting to mkpkg.list of messages posted only to
 494              ;; the bugs- list, but allow cross-posting when the
 495              ;; message was really cross-posted.
 496              (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
 497              (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
 498              ;;
 499              ;; People...
 500              (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
 501           ;; Unmatched mail goes to the catch all group.
 502           \"misc.misc\"))"
 503   :group 'nnmail-split
 504   :type 'nnmail-split-fancy)
 505
 506 (defcustom nnmail-split-abbrev-alist
 507   '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
 508     (mail . "mailer-daemon\\|postmaster\\|uucp")
 509     (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
 510     (from . "from\\|sender\\|resent-from")
 511     (nato . "to\\|cc\\|resent-to\\|resent-cc")
 512     (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
 513   "*Alist of abbreviations allowed in `nnmail-split-fancy'."
 514   :group 'nnmail-split
 515   :type '(repeat (cons :format "%v" symbol regexp)))
 516
 517 (defcustom nnmail-message-id-cache-length 1000
 518   "*The approximate number of Message-IDs nnmail will keep in its cache.
 519 If this variable is nil, no checking on duplicate messages will be
 520 performed."
 521   :group 'nnmail-duplicate
 522   :type '(choice (const :tag "disable" nil)
 523                  (integer :format "%v")))
 524
 525 (defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
 526   "*The file name of the nnmail Message-ID cache."
 527   :group 'nnmail-duplicate
 528   :group 'nnmail-files
 529   :type 'file)
 530
 531 (defcustom nnmail-treat-duplicates 'warn
 532   "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
 533 Three values are valid: nil, which means that nnmail is not to keep a
 534 Message-ID cache; `warn', which means that nnmail should insert extra
 535 headers to warn the user about the duplication (this is the default);
 536 and `delete', which means that nnmail will delete duplicated mails.
 537
 538 This variable can also be a function.  It will be called from a buffer
 539 narrowed to the article in question with the Message-ID as a
 540 parameter.  It should return nil, `warn' or `delete'."
 541   :group 'nnmail-duplicate
 542   :type '(choice (const :tag "off" nil)
 543                  (const warn)
 544                  (const delete)))
 545
 546 (defcustom nnmail-extra-headers '(To Newsgroups)
 547   "*Extra headers to parse."
 548   :version "21.1"
 549   :group 'nnmail
 550   :type '(repeat symbol))
 551
 552 (defcustom nnmail-split-header-length-limit 512
 553   "Header lines longer than this limit are excluded from the split function."
 554   :version "21.1"
 555   :group 'nnmail
 556   :type 'integer)
 557
 558 (defcustom nnmail-mail-splitting-charset nil
 559   "Default charset to be used when splitting incoming mail."
 560   :group 'nnmail
 561   :type 'symbol)
 562
 563 (defcustom nnmail-mail-splitting-decodes nil
 564   "Whether the nnmail splitting functionality should MIME decode headers."
 565   :group 'nnmail
 566   :type 'boolean)
 567
 568 (defcustom nnmail-split-fancy-match-partial-words nil
 569   "Whether to match partial words when fancy splitting.
 570 Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
 571 by \"\\=\\<...\\>\".  If this variable is true, they are not implicitly\
 572  surrounded
 573 by anything."
 574   :group 'nnmail
 575   :type 'boolean)
 576
 577 ;;; Internal variables.
 578
 579 (defvar nnmail-article-buffer " *nnmail incoming*"
 580   "The buffer used for splitting incoming mails.")
 581
 582 (defvar nnmail-split-history nil
 583   "List of group/article elements that say where the previous split put messages.")
 584
 585 (defvar nnmail-split-fancy-syntax-table
 586   (let ((table (make-syntax-table)))
 587     ;; support the %-hack
 588     (modify-syntax-entry ?\% "." table)
 589     table)
 590   "Syntax table used by `nnmail-split-fancy'.")
 591
 592 (defvar nnmail-prepare-save-mail-hook nil
 593   "Hook called before saving mail.")
 594
 595 (defvar nnmail-split-tracing nil)
 596 (defvar nnmail-split-trace nil)
 597
 598 \f
 599
 600 (defun nnmail-request-post (&optional server)
 601   (mail-send-and-exit nil))
 602
 603 (defvar nnmail-file-coding-system 'raw-text
 604   "Coding system used in nnmail.")
 605
 606 (defvar nnmail-incoming-coding-system
 607   mm-text-coding-system
 608   "Coding system used in reading inbox")
 609
 610 (defvar nnmail-pathname-coding-system nil
 611   "*Coding system for file name.")
 612
 613 (defun nnmail-find-file (file)
 614   "Insert FILE in server buffer safely."
 615   (set-buffer nntp-server-buffer)
 616   (delete-region (point-min) (point-max))
 617   (let ((format-alist nil)
 618         (after-insert-file-functions nil))
 619     (condition-case ()
 620         (let ((coding-system-for-read nnmail-file-coding-system)
 621               (auto-mode-alist (mm-auto-mode-alist))
 622               (file-name-coding-system nnmail-pathname-coding-system))
 623           (insert-file-contents file)
 624           t)
 625       (file-error nil))))
 626
 627 (defun nnmail-group-pathname (group dir &optional file)
 628   "Make file name for GROUP."
 629   (concat
 630    (let ((dir (file-name-as-directory (expand-file-name dir))))
 631      (setq group (nnheader-replace-duplicate-chars-in-string
 632                   (nnheader-replace-chars-in-string group ?/ ?_)
 633                   ?. ?_))
 634      (setq group (nnheader-translate-file-chars group))
 635      ;; If this directory exists, we use it directly.
 636      (file-name-as-directory
 637       (if (or nnmail-use-long-file-names
 638               (file-directory-p (concat dir group)))
 639           (expand-file-name group dir)
 640         ;; If not, we translate dots into slashes.
 641         (expand-file-name
 642          (mm-encode-coding-string
 643           (nnheader-replace-chars-in-string group ?. ?/)
 644           nnmail-pathname-coding-system)
 645          dir))))
 646    (or file "")))
 647
 648 (defun nnmail-get-active ()
 649   "Returns an assoc of group names and active ranges.
 650 nn*-request-list should have been called before calling this function."
 651   ;; Go through all groups from the active list.
 652   (save-excursion
 653     (set-buffer nntp-server-buffer)
 654     (nnmail-parse-active)))
 655
 656 (defun nnmail-parse-active ()
 657   "Parse the active file in the current buffer and return an alist."
 658   (goto-char (point-min))
 659   (unless (re-search-forward "[\\\"]" nil t)
 660     (goto-char (point-max))
 661     (while (re-search-backward "[][';?()#]" nil t)
 662       (insert ?\\)))
 663   (goto-char (point-min))
 664   (let ((buffer (current-buffer))
 665         group-assoc group max min)
 666     (while (not (eobp))
 667       (condition-case err
 668           (progn
 669             (narrow-to-region (point) (point-at-eol))
 670             (setq group (read buffer))
 671             (unless (stringp group)
 672               (setq group (symbol-name group)))
 673             (if (and (numberp (setq max (read buffer)))
 674                      (numberp (setq min (read buffer))))
 675                 (push (list group (cons min max))
 676                       group-assoc)))
 677         (error nil))
 678       (widen)
 679       (forward-line 1))
 680     group-assoc))
 681
 682 (defvar nnmail-active-file-coding-system 'raw-text
 683   "*Coding system for active file.")
 684
 685 (defun nnmail-save-active (group-assoc file-name)
 686   "Save GROUP-ASSOC in ACTIVE-FILE."
 687   (let ((coding-system-for-write nnmail-active-file-coding-system))
 688     (when file-name
 689       (with-temp-file file-name
 690         (nnmail-generate-active group-assoc)))))
 691
 692 (defun nnmail-generate-active (alist)
 693   "Generate an active file from group-alist ALIST."
 694   (erase-buffer)
 695   (let (group)
 696     (while (setq group (pop alist))
 697       (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
 698                       (caadr group))))
 699     (goto-char (point-max))
 700     (while (search-backward "\\." nil t)
 701       (delete-char 1))))
 702
 703 (defun nnmail-get-split-group (file source)
 704   "Find out whether this FILE is to be split into GROUP only.
 705 If SOURCE is a directory spec, try to return the group name component."
 706   (if (eq (car source) 'directory)
 707       (let ((file (file-name-nondirectory file)))
 708         (mail-source-bind (directory source)
 709           (if (string-match (concat (regexp-quote suffix) "$") file)
 710               (substring file 0 (match-beginning 0))
 711             nil)))
 712     nil))
 713
 714 (defun nnmail-process-babyl-mail-format (func artnum-func)
 715   (let ((case-fold-search t)
 716         (count 0)
 717         start message-id content-length do-search end)
 718     (while (not (eobp))
 719       (goto-char (point-min))
 720       (re-search-forward
 721        "\f\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
 722       (goto-char (match-end 0))
 723       (delete-region (match-beginning 0) (match-end 0))
 724       (narrow-to-region
 725        (setq start (point))
 726        (progn
 727          ;; Skip all the headers in case there are more "From "s...
 728          (or (search-forward "\n\n" nil t)
 729              (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
 730              (search-forward "\1f\f"))
 731          (point)))
 732       ;; Unquote the ">From " line, if any.
 733       (goto-char (point-min))
 734       (when (looking-at ">From ")
 735         (replace-match "X-From-Line: ") )
 736       (run-hooks 'nnmail-prepare-incoming-header-hook)
 737       (goto-char (point-max))
 738       ;; Find the Message-ID header.
 739       (save-excursion
 740         (if (re-search-backward
 741              "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
 742             (setq message-id (buffer-substring (match-beginning 1)
 743                                                (match-end 1)))
 744           ;; There is no Message-ID here, so we create one.
 745           (save-excursion
 746             (when (re-search-backward "^Message-ID[ \t]*:" nil t)
 747               (beginning-of-line)
 748               (insert "Original-")))
 749           (forward-line -1)
 750           (insert "Message-ID: " (setq message-id (nnmail-message-id))
 751                   "\n")))
 752       ;; Look for a Content-Length header.
 753       (if (not (save-excursion
 754                  (and (re-search-backward
 755                        "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
 756                       (setq content-length (string-to-int
 757                                             (buffer-substring
 758                                              (match-beginning 1)
 759                                              (match-end 1))))
 760                       ;; We destroy the header, since none of
 761                       ;; the backends ever use it, and we do not
 762                       ;; want to confuse other mailers by having
 763                       ;; a (possibly) faulty header.
 764                       (progn (insert "X-") t))))
 765           (setq do-search t)
 766         (widen)
 767         (if (or (= (+ (point) content-length) (point-max))
 768                 (save-excursion
 769                   (goto-char (+ (point) content-length))
 770                   (looking-at "\1f")))
 771             (progn
 772               (goto-char (+ (point) content-length))
 773               (setq do-search nil))
 774           (setq do-search t)))
 775       (widen)
 776       ;; Go to the beginning of the next article - or to the end
 777       ;; of the buffer.
 778       (when do-search
 779         (if (re-search-forward "^\1f" nil t)
 780             (goto-char (match-beginning 0))
 781           (goto-char (1- (point-max)))))
 782       (delete-char 1)                   ; delete ^_
 783       (save-excursion
 784         (save-restriction
 785           (narrow-to-region start (point))
 786           (goto-char (point-min))
 787           (nnmail-check-duplication message-id func artnum-func)
 788           (incf count)
 789           (setq end (point-max))))
 790       (goto-char end))
 791     count))
 792
 793 (defsubst nnmail-search-unix-mail-delim ()
 794   "Put point at the beginning of the next Unix mbox message."
 795   ;; Algorithm used to find the next article in the
 796   ;; brain-dead Unix mbox format:
 797   ;;
 798   ;; 1) Search for "^From ".
 799   ;; 2) If we find it, then see whether the previous
 800   ;;    line is blank and the next line looks like a header.
 801   ;; Then it's possible that this is a mail delim, and we use it.
 802   (let ((case-fold-search nil)
 803         found)
 804     (while (not found)
 805       (if (not (re-search-forward "^From " nil t))
 806           (setq found 'no)
 807         (save-excursion
 808           (beginning-of-line)
 809           (when (and (or (bobp)
 810                          (save-excursion
 811                            (forward-line -1)
 812                            (eq (char-after) ?\n)))
 813                      (save-excursion
 814                        (forward-line 1)
 815                        (while (looking-at ">From \\|From ")
 816                          (forward-line 1))
 817                        (looking-at "[^ \n\t:]+[ \n\t]*:")))
 818             (setq found 'yes)))))
 819     (beginning-of-line)
 820     (eq found 'yes)))
 821
 822 (defun nnmail-search-unix-mail-delim-backward ()
 823   "Put point at the beginning of the current Unix mbox message."
 824   ;; Algorithm used to find the next article in the
 825   ;; brain-dead Unix mbox format:
 826   ;;
 827   ;; 1) Search for "^From ".
 828   ;; 2) If we find it, then see whether the previous
 829   ;;    line is blank and the next line looks like a header.
 830   ;; Then it's possible that this is a mail delim, and we use it.
 831   (let ((case-fold-search nil)
 832         found)
 833     (while (not found)
 834       (if (not (re-search-backward "^From " nil t))
 835           (setq found 'no)
 836         (save-excursion
 837           (beginning-of-line)
 838           (when (and (or (bobp)
 839                          (save-excursion
 840                            (forward-line -1)
 841                            (eq (char-after) ?\n)))
 842                      (save-excursion
 843                        (forward-line 1)
 844                        (while (looking-at ">From \\|From ")
 845                          (forward-line 1))
 846                        (looking-at "[^ \n\t:]+[ \n\t]*:")))