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

   1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   4 ;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news, mail
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 ;; For Emacs < 22.2.
  29 (eval-and-compile
  30   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  31
  32 (eval-when-compile (require 'cl))
  33
  34 (require 'gnus)                         ; for macro gnus-kill-buffer, at least
  35 (require 'nnheader)
  36 (require 'message)
  37 (require 'gnus-util)
  38 (require 'mail-source)
  39 (require 'mm-util)
  40 (require 'gnus-int)
  41
  42 (autoload 'gnus-add-buffer "gnus")
  43 (autoload 'gnus-kill-buffer "gnus")
  44
  45 (defgroup nnmail nil
  46   "Reading mail with Gnus."
  47   :group 'gnus)
  48
  49 (defgroup nnmail-retrieve nil
  50   "Retrieving new mail."
  51   :group 'nnmail)
  52
  53 (defgroup nnmail-prepare nil
  54   "Preparing (or mangling) new mail after retrieval."
  55   :group 'nnmail)
  56
  57 (defgroup nnmail-duplicate nil
  58   "Handling of duplicate mail messages."
  59   :group 'nnmail)
  60
  61 (defgroup nnmail-split nil
  62   "Organizing the incoming mail in folders."
  63   :group 'nnmail)
  64
  65 (defgroup nnmail-files nil
  66   "Mail files."
  67   :group 'gnus-files
  68   :group 'nnmail)
  69
  70 (defgroup nnmail-expire nil
  71   "Expiring old mail."
  72   :group 'nnmail)
  73
  74 (defgroup nnmail-procmail nil
  75   "Interfacing with procmail and other mail agents."
  76   :group 'nnmail)
  77
  78 (defgroup nnmail-various nil
  79   "Various mail options."
  80   :group 'nnmail)
  81
  82 (defcustom nnmail-split-methods '(("mail.misc" ""))
  83   "*Incoming mail will be split according to this variable.
  84
  85 If you'd like, for instance, one mail group for mail from the
  86 \"4ad-l\" mailing list, one group for junk mail and one for everything
  87 else, you could do something like this:
  88
  89  (setq nnmail-split-methods
  90        '((\"mail.4ad\" \"From:.*4ad\")
  91          (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
  92          (\"mail.misc\" \"\")))
  93
  94 As you can see, this variable is a list of lists, where the first
  95 element in each \"rule\" is the name of the group (which, by the way,
  96 does not have to be called anything beginning with \"mail\",
  97 \"yonka.zow\" is a fine, fine name), and the second is a regexp that
  98 nnmail will try to match on the header to find a fit.
  99
 100 The second element can also be a function.  In that case, it will be
 101 called narrowed to the headers with the first element of the rule as
 102 the argument.  It should return a non-nil value if it thinks that the
 103 mail belongs in that group.
 104
 105 The last element should always have \"\" as the regexp.
 106
 107 This variable can also have a function as its value."
 108   :group 'nnmail-split
 109   :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
 110                                              (choice regexp function)))
 111                  (function-item nnmail-split-fancy)
 112                  (function :tag "Other")))
 113
 114 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
 115 (defcustom nnmail-crosspost t
 116   "If non-nil, do crossposting if several split methods match the mail.
 117 If nil, the first match found will be used."
 118   :group 'nnmail-split
 119   :type 'boolean)
 120
 121 (defcustom nnmail-split-fancy-with-parent-ignore-groups nil
 122   "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
 123 This can also be a list of regexps."
 124   :version "22.1"
 125   :group 'nnmail-split
 126   :type '(choice (const :tag "none" nil)
 127                  (regexp :value ".*")
 128                  (repeat :value (".*") regexp)))
 129
 130 (defcustom nnmail-cache-ignore-groups nil
 131   "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
 132 This can also be a list of regexps."
 133   :version "22.1"
 134   :group 'nnmail-split
 135   :type '(choice (const :tag "none" nil)
 136                  (regexp :value ".*")
 137                  (repeat :value (".*") regexp)))
 138
 139 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
 140 (defcustom nnmail-keep-last-article nil
 141   "If non-nil, nnmail will never delete/move a group's last article.
 142 It can be marked expirable, so it will be deleted when it is no longer last.
 143
 144 You may need to set this variable if other programs are putting
 145 new mail into folder numbers that Gnus has marked as expired."
 146   :group 'nnmail-procmail
 147   :group 'nnmail-various
 148   :type 'boolean)
 149
 150 (defcustom nnmail-use-long-file-names nil
 151   "If non-nil the mail backends will use long file and directory names.
 152 If nil, groups like \"mail.misc\" will end up in directories like
 153 \"mail/misc/\"."
 154   :group 'nnmail-files
 155   :type 'boolean)
 156
 157 (defcustom nnmail-default-file-modes 384
 158   "Set the mode bits of all new mail files to this integer."
 159   :group 'nnmail-files
 160   :type 'integer)
 161
 162 (defcustom nnmail-expiry-wait 7
 163   "*Expirable articles that are older than this will be expired.
 164 This variable can either be a number (which will be interpreted as a
 165 number of days) -- this doesn't have to be an integer.  This variable
 166 can also be `immediate' and `never'."
 167   :group 'nnmail-expire
 168   :type '(choice (const immediate)
 169                  (number :tag "days")
 170                  (const never)))
 171
 172 (defcustom nnmail-expiry-wait-function nil
 173   "Variable that holds function to specify how old articles should be before they are expired.
 174 The function will be called with the name of the group that the expiry
 175 is to be performed in, and it should return an integer that says how
 176 many days an article can be stored before it is considered \"old\".
 177 It can also return the values `never' and `immediate'.
 178
 179 Eg.:
 180
 181 \(setq nnmail-expiry-wait-function
 182       (lambda (newsgroup)
 183         (cond ((string-match \"private\" newsgroup) 31)
 184               ((string-match \"junk\" newsgroup) 1)
 185               ((string-match \"important\" newsgroup) 'never)
 186               (t 7))))"
 187   :group 'nnmail-expire
 188   :type '(choice (const :tag "nnmail-expiry-wait" nil)
 189                  (function :format "%v" nnmail-)))
 190
 191 (defcustom nnmail-expiry-target 'delete
 192   "*Variable that says where expired messages should end up.
 193 The default value is `delete' (which says to delete the messages),
 194 but it can also be a string or a function.  If it is a string, expired
 195 messages end up in that group.  If it is a function, the function is
 196 called in a buffer narrowed to the message in question.  The function
 197 receives one argument, the name of the group the message comes from.
 198 The return value should be `delete' or a group name (a string)."
 199   :version "21.1"
 200   :group 'nnmail-expire
 201   :type '(choice (const delete)
 202                  function
 203                  string))
 204
 205 (defcustom nnmail-fancy-expiry-targets nil
 206   "Determine expiry target based on articles using fancy techniques.
 207
 208 This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries.  If
 209 `nnmail-expiry-target' is set to the function
 210 `nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
 211 the message will be expired to a group determined by invoking
 212 `format-time-string' with TARGET used as the format string and the
 213 time extracted from the articles' Date header (if missing the current
 214 time is used).
 215
 216 In the special cases that HEADER is the symbol `to-from', the regexp
 217 will try to match against both the From and the To header.
 218
 219 Example:
 220
 221 \(setq nnmail-fancy-expiry-targets
 222       '((to-from \"boss\" \"nnfolder:Work\")
 223         (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
 224         (\"from\" \".*\" \"nnfolder:Archive-%Y\")))
 225
 226 In this case, articles containing the string \"boss\" in the To or the
 227 From header will be expired to the group \"nnfolder:Work\";
 228 articles containing the sting \"IMPORTANT\" in the Subject header will
 229 be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
 230 everything else will be expired to \"nnfolder:Archive-YYYY\"."
 231   :version "22.1"
 232   :group 'nnmail-expire
 233   :type '(repeat (list (choice :tag "Match against"
 234                                (string :tag "Header")
 235                                (const to-from))
 236                        regexp
 237                        (string :tag "Target group format string"))))
 238
 239 (defcustom nnmail-cache-accepted-message-ids nil
 240   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
 241 If non-nil, also update the cache when copy or move articles."
 242   :group 'nnmail
 243   :type 'boolean)
 244
 245 (make-obsolete-variable 'nnmail-spool-file 'mail-sources
 246                         "Gnus 5.9 (Emacs 22.1)")
 247 ;; revision 5.29 / p0-85 / Gnus 5.9
 248 ;; Variable removed in No Gnus v0.7
 249
 250 (defcustom nnmail-resplit-incoming nil
 251   "*If non-nil, re-split incoming procmail sorted mail."
 252   :group 'nnmail-procmail
 253   :type 'boolean)
 254
 255 (defcustom nnmail-scan-directory-mail-source-once nil
 256   "*If non-nil, scan all incoming procmail sorted mails once.
 257 It scans low-level sorted spools even when not required."
 258   :version "21.1"
 259   :group 'nnmail-procmail
 260   :type 'boolean)
 261
 262 (defcustom nnmail-delete-file-function 'delete-file
 263   "Function called to delete files in some mail backends."
 264   :group 'nnmail-files
 265   :type 'function)
 266
 267 (defcustom nnmail-crosspost-link-function
 268   (if (string-match "windows-nt\\|emx" (symbol-name system-type))
 269       'copy-file
 270     'add-name-to-file)
 271   "*Function called to create a copy of a file.
 272 This is `add-name-to-file' by default, which means that crossposts
 273 will use hard links.  If your file system doesn't allow hard
 274 links, you could set this variable to `copy-file' instead."
 275   :group 'nnmail-files
 276   :type '(radio (function-item add-name-to-file)
 277                 (function-item copy-file)
 278                 (function :tag "Other")))
 279
 280 (defcustom nnmail-read-incoming-hook
 281   (if (eq system-type 'windows-nt)
 282       '(nnheader-ms-strip-cr)
 283     nil)
 284   "*Hook that will be run after the incoming mail has been transferred.
 285 The incoming mail is moved from the specified spool file (which normally is
 286 something like \"/usr/spool/mail/$user\") to the user's home
 287 directory.  This hook is called after the incoming mail box has been
 288 emptied, and can be used to call any mail box programs you have
 289 running (\"xwatch\", etc.)
 290
 291 Eg.
 292
 293 \(add-hook 'nnmail-read-incoming-hook
 294           (lambda ()
 295             (call-process \"/local/bin/mailsend\" nil nil nil
 296                           \"read\"
 297                           ;; The incoming mail box file.
 298                           (expand-file-name (user-login-name)
 299                                             rmail-spool-directory))))
 300
 301 If you have xwatch running, this will alert it that mail has been
 302 read.
 303
 304 If you use `display-time', you could use something like this:
 305
 306 \(add-hook 'nnmail-read-incoming-hook
 307           (lambda ()
 308             ;; Update the displayed time, since that will clear out
 309             ;; the flag that says you have mail.
 310             (when (eq (process-status \"display-time\") 'run)
 311               (display-time-filter display-time-process \"\"))))"
 312   :group 'nnmail-prepare
 313   :type 'hook)
 314
 315 (defcustom nnmail-prepare-incoming-hook nil
 316   "Hook called before treating incoming mail.
 317 The hook is run in a buffer with all the new, incoming mail."
 318   :group 'nnmail-prepare
 319   :type 'hook)
 320
 321 (defcustom nnmail-prepare-incoming-header-hook nil
 322   "Hook called narrowed to the headers of each message.
 323 This can be used to remove excessive spaces (and stuff like
 324 that) from the headers before splitting and saving the messages."
 325   :group 'nnmail-prepare
 326   :type 'hook)
 327
 328 (defcustom nnmail-prepare-incoming-message-hook nil
 329   "Hook called narrowed to each message."
 330   :group 'nnmail-prepare
 331   :type 'hook)
 332
 333 (defcustom nnmail-list-identifiers nil
 334   "Regexp that matches list identifiers to be removed.
 335 This can also be a list of regexps."
 336   :group 'nnmail-prepare
 337   :type '(choice (const :tag "none" nil)
 338                  (regexp :value ".*")
 339                  (repeat :value (".*") regexp)))
 340
 341 (defcustom nnmail-pre-get-new-mail-hook nil
 342   "Hook called just before starting to handle new incoming mail."
 343   :group 'nnmail-retrieve
 344   :type 'hook)
 345
 346 (defcustom nnmail-post-get-new-mail-hook nil
 347   "Hook called just after finishing handling new incoming mail."
 348   :group 'nnmail-retrieve
 349   :type 'hook)
 350
 351 (defcustom nnmail-split-hook nil
 352   "Hook called before deciding where to split an article.
 353 The functions in this hook are free to modify the buffer
 354 contents in any way they choose -- the buffer contents are
 355 discarded after running the split process."
 356   :group 'nnmail-split
 357   :type 'hook)
 358
 359 (defcustom nnmail-spool-hook nil
 360   "*A hook called when a new article is spooled."
 361   :version "22.1"
 362   :group 'nnmail
 363   :type 'hook)
 364
 365 (defcustom nnmail-large-newsgroup 50
 366   "*The number of articles which indicates a large newsgroup or nil.
 367 If the number of articles is greater than the value, verbose
 368 messages will be shown to indicate the current status."
 369   :group 'nnmail-various
 370   :type '(choice (const :tag "infinite" nil)
 371                  (number :tag "count")))
 372
 373 (define-widget 'nnmail-lazy 'default
 374   "Base widget for recursive datastructures.
 375
 376 This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
 377   :format "%{%t%}: %v"
 378   :convert-widget 'widget-value-convert-widget
 379   :value-create (lambda (widget)
 380                   (let ((value (widget-get widget :value))
 381                         (type (widget-get widget :type)))
 382                     (widget-put widget :children
 383                                 (list (widget-create-child-value
 384                                        widget (widget-convert type) value)))))
 385   :value-delete 'widget-children-value-delete
 386   :value-get (lambda (widget)
 387                (widget-value (car (widget-get widget :children))))
 388   :value-inline (lambda (widget)
 389                   (widget-apply (car (widget-get widget :children))
 390                                 :value-inline))
 391   :default-get (lambda (widget)
 392                  (widget-default-get
 393                   (widget-convert (widget-get widget :type))))
 394   :match (lambda (widget value)
 395            (widget-apply (widget-convert (widget-get widget :type))
 396                          :match value))
 397   :validate (lambda (widget)
 398               (widget-apply (car (widget-get widget :children)) :validate)))
 399
 400 (define-widget 'nnmail-split-fancy 'nnmail-lazy
 401   "Widget for customizing splits in the variable of the same name."
 402   :tag "Split"
 403   :type '(menu-choice :value (any ".*value.*" "misc")
 404                       :tag "Type"
 405                       (string :tag "Destination")
 406                       (list :tag "Use first match (|)" :value (|)
 407                             (const :format "" |)
 408                             (editable-list :inline t nnmail-split-fancy))
 409                       (list :tag "Use all matches (&)" :value (&)
 410                             (const :format "" &)
 411                             (editable-list :inline t nnmail-split-fancy))
 412                       (list :tag "Function with fixed arguments (:)"
 413                             :value (:)
 414                             (const :format "" :value :)
 415                             function
 416                             (editable-list :inline t (sexp :tag "Arg"))
 417                             )
 418                       (list :tag "Function with split arguments (!)"
 419                             :value (!)
 420                             (const :format "" !)
 421                             function
 422                             (editable-list :inline t nnmail-split-fancy))
 423                       (list :tag "Field match"
 424                             (choice :tag "Field"
 425                                     regexp symbol)
 426                             (choice :tag "Match"
 427                                     regexp
 428                                     (symbol :value mail))
 429                             (repeat :inline t
 430                                     :tag "Restrictions"
 431                                     (group :inline t
 432                                            (const :format "" -)
 433                                            regexp))
 434                             nnmail-split-fancy)
 435                       (const :tag "Junk (delete mail)" junk)))
 436
 437 (defcustom nnmail-split-fancy "mail.misc"
 438   "Incoming mail can be split according to this fancy variable.
 439 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
 440
 441 The format of this variable is SPLIT, where SPLIT can be one of
 442 the following:
 443
 444 GROUP: Mail will be stored in GROUP (a string).
 445
 446 \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
 447   field FIELD (a regexp) contains VALUE (a regexp), store the messages
 448   as specified by SPLIT.  If RESTRICT (a regexp) matches some string
 449   after FIELD and before the end of the matched VALUE, return nil,
 450   otherwise process SPLIT.  Multiple RESTRICTs add up, further
 451   restricting the possibility of processing SPLIT.
 452
 453 \(| SPLIT...): Process each SPLIT expression until one of them matches.
 454   A SPLIT expression is said to match if it will cause the mail
 455   message to be stored in one or more groups.
 456
 457 \(& SPLIT...): Process each SPLIT expression.
 458
 459 \(: FUNCTION optional args): Call FUNCTION with the optional args, in
 460   the buffer containing the message headers.  The return value FUNCTION
 461   should be a split, which is then recursively processed.
 462
 463 \(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT.  The
 464   return value FUNCTION should be a split, which is then recursively
 465   processed.
 466
 467 junk: Mail will be deleted.  Use with care!  Do not submerge in water!
 468   Example:
 469   (setq nnmail-split-fancy
 470         '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
 471             ...other.rules.omitted...))
 472
 473 FIELD must match a complete field name.  VALUE must match a complete
 474 word according to the `nnmail-split-fancy-syntax-table' syntax table.
 475 You can use \".*\" in the regexps to match partial field names or words.
 476
 477 FIELD and VALUE can also be Lisp symbols, in that case they are expanded
 478 as specified in `nnmail-split-abbrev-alist'.
 479
 480 GROUP can contain \\& and \\N which will substitute from matching
 481 \\(\\) patterns in the previous VALUE.
 482
 483 Example:
 484
 485 \(setq nnmail-split-methods 'nnmail-split-fancy
 486       nnmail-split-fancy
 487       ;; Messages from the mailer daemon are not crossposted to any of
 488       ;; the ordinary groups.  Warnings are put in a separate group
 489       ;; from real errors.
 490       '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
 491                           \"mail.misc\"))
 492           ;; Non-error messages are crossposted to all relevant
 493           ;; groups, but we don't crosspost between the group for the
 494           ;; (ding) list and the group for other (ding) related mail.
 495           (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
 496                 (\"subject\" \"ding\" \"ding.misc\"))
 497              ;; Other mailing lists...
 498              (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
 499              (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
 500              ;; Both lists below have the same suffix, so prevent
 501              ;; cross-posting to mkpkg.list of messages posted only to
 502              ;; the bugs- list, but allow cross-posting when the
 503              ;; message was really cross-posted.
 504              (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
 505              (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
 506              ;;
 507              ;; People...
 508              (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
 509           ;; Unmatched mail goes to the catch all group.
 510           \"misc.misc\"))"
 511   :group 'nnmail-split
 512   :type 'nnmail-split-fancy)
 513
 514 (defcustom nnmail-split-abbrev-alist
 515   '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
 516     (mail . "mailer-daemon\\|postmaster\\|uucp")
 517     (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
 518     (from . "from\\|sender\\|resent-from")
 519     (nato . "to\\|cc\\|resent-to\\|resent-cc")
 520     (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
 521   "*Alist of abbreviations allowed in `nnmail-split-fancy'."
 522   :group 'nnmail-split
 523   :type '(repeat (cons :format "%v" symbol regexp)))
 524
 525 (defcustom nnmail-message-id-cache-length 1000
 526   "*The approximate number of Message-IDs nnmail will keep in its cache.
 527 If this variable is nil, no checking on duplicate messages will be
 528 performed."
 529   :group 'nnmail-duplicate
 530   :type '(choice (const :tag "disable" nil)
 531                  (integer :format "%v")))
 532
 533 (defcustom nnmail-message-id-cache-file
 534   (nnheader-concat gnus-home-directory ".nnmail-cache")
 535   "The file name of the nnmail Message-ID cache."
 536   :group 'nnmail-duplicate
 537   :group 'nnmail-files
 538   :type 'file)
 539
 540 (defcustom nnmail-treat-duplicates 'warn
 541   "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
 542 Three values are valid: nil, which means that nnmail is not to keep a
 543 Message-ID cache; `warn', which means that nnmail should insert extra
 544 headers to warn the user about the duplication (this is the default);
 545 and `delete', which means that nnmail will delete duplicated mails.
 546
 547 This variable can also be a function.  It will be called from a buffer
 548 narrowed to the article in question with the Message-ID as a
 549 parameter.  It should return nil, `warn' or `delete'."
 550   :group 'nnmail-duplicate
 551   :type '(choice (const :tag "off" nil)
 552                  (const warn)
 553                  (const delete)))
 554
 555 (defcustom nnmail-extra-headers '(To Newsgroups)
 556   "*Extra headers to parse."
 557   :version "21.1"
 558   :group 'nnmail
 559   :type '(repeat symbol))
 560
 561 (defcustom nnmail-split-header-length-limit 2048
 562   "Header lines longer than this limit are excluded from the split function."
 563   :version "21.1"
 564   :group 'nnmail
 565   :type 'integer)
 566
 567 (defcustom nnmail-mail-splitting-charset nil
 568   "Default charset to be used when splitting incoming mail."
 569   :version "22.1"
 570   :group 'nnmail
 571   :type 'symbol)
 572
 573 (defcustom nnmail-mail-splitting-decodes nil
 574   "Whether the nnmail splitting functionality should MIME decode headers."
 575   :version "22.1"
 576   :group 'nnmail
 577   :type 'boolean)
 578
 579 (defcustom nnmail-split-fancy-match-partial-words nil
 580   "Whether to match partial words when fancy splitting.
 581 Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
 582 by \"\\=\\<...\\>\".  If this variable is true, they are not implicitly\
 583  surrounded
 584 by anything."
 585   :version "22.1"
 586   :group 'nnmail
 587   :type 'boolean)
 588
 589 (defcustom nnmail-split-lowercase-expanded t
 590   "Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
 591 This avoids the creation of multiple groups when users send to an address
 592 using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
 593   :version "22.1"
 594   :group 'nnmail
 595   :type 'boolean)
 596
 597 ;;; Internal variables.
 598
 599 (defvar nnmail-article-buffer " *nnmail incoming*"
 600   "The buffer used for splitting incoming mails.")
 601
 602 (defvar nnmail-split-history nil
 603   "List of group/article elements that say where the previous split put messages.")
 604
 605 (defvar nnmail-split-fancy-syntax-table
 606   (let ((table (make-syntax-table)))
 607     ;; support the %-hack
 608     (modify-syntax-entry ?\% "." table)
 609     table)
 610   "Syntax table used by `nnmail-split-fancy'.")
 611
 612 (defvar nnmail-prepare-save-mail-hook nil
 613   "Hook called before saving mail.")
 614
 615 (defvar nnmail-split-tracing nil)
 616 (defvar nnmail-split-trace nil)
 617
 618 \f
 619
 620 (defun nnmail-request-post (&optional server)
 621   (mail-send-and-exit nil))
 622
 623 (defvar nnmail-file-coding-system 'raw-text
 624   "Coding system used in nnmail.")
 625
 626 (defvar nnmail-incoming-coding-system
 627   mm-text-coding-system
 628   "Coding system used in reading inbox")
 629
 630 (defvar nnmail-pathname-coding-system
 631   ;; This causes Emacs 22.2 and 22.3 to issue a useless warning.
 632   ;;(if (and (featurep 'xemacs) (featurep 'file-coding))
 633   (if (featurep 'xemacs)
 634       (if (featurep 'file-coding)
 635           ;; Work around a bug in many XEmacs 21.5 betas.
 636           ;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/68134
 637           (setq file-name-coding-system (coding-system-aliasee 'file-name))))
 638   "*Coding system for file name.")
 639
 640 (defun nnmail-find-file (file)
 641   "Insert FILE in server buffer safely."
 642   (set-buffer nntp-server-buffer)
 643   (delete-region (point-min) (point-max))
 644   (let ((format-alist nil)
 645         (after-insert-file-functions nil))
 646     (condition-case ()
 647         (let ((coding-system-for-read nnmail-file-coding-system)
 648               (auto-mode-alist (mm-auto-mode-alist))
 649               (file-name-coding-system nnmail-pathname-coding-system))
 650           (insert-file-contents file)
 651           t)
 652       (file-error nil))))
 653
 654 (defun nnmail-group-pathname (group dir &optional file)
 655   "Make file name for GROUP."
 656   (concat
 657    (let ((dir (file-name-as-directory (expand-file-name dir))))
 658      (setq group (nnheader-replace-duplicate-chars-in-string
 659                   (nnheader-replace-chars-in-string group ?/ ?_)
 660                   ?. ?_))
 661      (setq group (nnheader-translate-file-chars group))
 662      ;; If this directory exists, we use it directly.
 663      (file-name-as-directory
 664       (if (or nnmail-use-long-file-names
 665               (file-directory-p (concat dir group)))
 666           (expand-file-name group dir)
 667         ;; If not, we translate dots into slashes.
 668         (expand-file-name
 669          (nnheader-replace-chars-in-string group ?. ?/)
 670          dir))))
 671    (or file "")))
 672
 673 (defun nnmail-get-active ()
 674   "Returns an assoc of group names and active ranges.
 675 nn*-request-list should have been called before calling this function."
 676   ;; Go through all groups from the active list.
 677   (save-excursion
 678     (set-buffer nntp-server-buffer)
 679     (nnmail-parse-active)))
 680
 681 (defun nnmail-parse-active ()
 682   "Parse the active file in the current buffer and return an alist."
 683   (goto-char (point-min))
 684   (unless (re-search-forward "[\\\"]" nil t)
 685     (goto-char (point-max))
 686     (while (re-search-backward "[][';?()#]" nil t)
 687       (insert ?\\)))
 688   (goto-char (point-min))
 689   (let ((buffer (current-buffer))
 690         group-assoc group max min)
 691     (while (not (eobp))
 692       (condition-case err
 693           (progn
 694             (narrow-to-region (point) (point-at-eol))
 695             (setq group (read buffer))
 696             (unless (stringp group)
 697               (setq group (symbol-name group)))
 698             (if (and (numberp (setq max (read buffer)))
 699                      (numberp (setq min (read buffer))))
 700                 (push (list (mm-string-as-unibyte group) (cons min max))
 701                       group-assoc)))
 702         (error nil))
 703       (widen)
 704       (forward-line 1))
 705     group-assoc))
 706
 707 (defvar nnmail-active-file-coding-system 'raw-text
 708   "*Coding system for active file.")
 709
 710 (defun nnmail-save-active (group-assoc file-name)
 711   "Save GROUP-ASSOC in ACTIVE-FILE."
 712   (let ((coding-system-for-write nnmail-active-file-coding-system))
 713     (when file-name
 714       (with-temp-file file-name
 715         (mm-disable-multibyte)
 716         (nnmail-generate-active group-assoc)))))
 717
 718 (defun nnmail-generate-active (alist)
 719   "Generate an active file from group-alist ALIST."
 720   (erase-buffer)
 721   (let (group)
 722     (while (setq group (pop alist))
 723       (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
 724                       (caadr group))))
 725     (goto-char (point-max))
 726     (while (search-backward "\\." nil t)
 727       (delete-char 1))))
 728
 729 (defun nnmail-get-split-group (file source)
 730   "Find out whether this FILE is to be split into GROUP only.
 731 If SOURCE is a directory spec, try to return the group name component."
 732   (if (eq (car source) 'directory)
 733       (let ((file (file-name-nondirectory file)))
 734         (mail-source-bind (directory source)
 735           (if (string-match (concat (regexp-quote suffix) "$") file)
 736               (substring file 0 (match-beginning 0))
 737             nil)))
 738     nil))
 739
 740 (defun nnmail-process-babyl-mail-format (func artnum-func)
 741   (let ((case-fold-search t)
 742         (count 0)
 743         start message-id content-length do-search end)
 744     (while (not (eobp))
 745       (goto-char (point-min))
 746       (re-search-forward
 747        "\f\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
 748       (goto-char (match-end 0))
 749       (delete-region (match-beginning 0) (match-end 0))
 750       (narrow-to-region
 751        (setq start (point))
 752        (progn
 753          ;; Skip all the headers in case there are more "From "s...
 754          (or (search-forward "\n\n" nil t)
 755              (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
 756              (search-forward "\1f\f"))
 757          (point)))
 758       ;; Unquote the ">From " line, if any.
 759       (goto-char (point-min))
 760       (when (looking-at ">From ")
 761         (replace-match "X-From-Line: ") )
 762       (run-hooks 'nnmail-prepare-incoming-header-hook)
 763       (goto-char (point-max))
 764       ;; Find the Message-ID header.
 765       (save-excursion
 766         (if (re-search-backward
 767              "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
 768             (setq message-id (buffer-substring (match-beginning 1)
 769                                                (match-end 1)))
 770           ;; There is no Message-ID here, so we create one.
 771           (save-excursion
 772             (when (re-search-backward "^Message-ID[ \t]*:" nil t)
 773               (beginning-of-line)
 774               (insert "Original-")))
 775           (forward-line -1)
 776           (insert "Message-ID: " (setq message-id (nnmail-message-id))
 777                   "\n")))
 778       ;; Look for a Content-Length header.
 779       (if (not (save-excursion
 780                  (and (re-search-backward
 781                        "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
 782                       (setq content-length (string-to-number
 783                                             (buffer-substring
 784                                              (match-beginning 1)
 785                                              (match-end 1))))
 786                       ;; We destroy the header, since none of
 787                       ;; the backends ever use it, and we do not
 788                       ;; want to confuse other mailers by having
 789                       ;; a (possibly) faulty header.
 790                       (progn (insert "X-") t))))
 791           (setq do-search t)
 792         (widen)
 793         (if (or (= (+ (point) content-length) (point-max))
 794                 (save-excursion
 795                   (goto-char (+ (point) content-length))
 796                   (looking-at "\1f")))
 797             (progn
 798               (goto-char (+ (point) content-length))
 799               (setq do-search nil))
 800           (setq do-search t)))
 801       (widen)
 802       ;; Go to the beginning of the next article - or to the end
 803       ;; of the buffer.
 804       (when do-search
 805         (if (re-search-forward "^\1f" nil t)
 806             (goto-char (match-beginning 0))
 807           (goto-char (1- (point-max)))))
 808       (delete-char 1)                   ; delete ^_
 809       (save-excursion
 810         (save-restriction
 811           (narrow-to-region start (point))
 812           (goto-char (point-min))
 813           (nnmail-check-duplication message-id func artnum-func)
 814           (incf count)
 815           (setq end (point-max))))
 816       (goto-char end))
 817     count))
 818
 819 (defsubst nnmail-search-unix-mail-delim ()
 820   "Put point at the beginning of the next Unix mbox message."
 821   ;; Algorithm used to find the next article in the
 822   ;; brain-dead Unix mbox format:
 823   ;;
 824   ;; 1) Search for "^From ".
 825   ;; 2) If we find it, then see whether the previous
 826   ;;    line is blank and the next line looks like a header.
 827   ;; Then it's possible that this is a mail delim, and we use it.
 828   (let ((case-fold-search nil)
 829         found)
 830     (while (not found)
 831       (if (not (re-search-forward "^From " nil t))
 832           (setq found 'no)
 833         (save-excursion
 834           (beginning-of-line)
 835           (when (and (or (bobp)
 836                          (save-excursion
 837                            (forward-line -1)
 838                            (eq (char-after) ?\n)))
 839                      (save-excursion
 840                        (forward-line 1)
 841                        (while (looking-at ">From \\|From ")
 842                          (forward-line 1))
 843                        (looking-at "[^ \n\t:]+[ \n\t]*:")))
 844             (setq found 'yes)))))
 845     (beginning-of-line)
 846     (eq found 'yes)))
 847
 848 (defun nnmail-search-unix-mail-delim-backward ()
 849   "Put point at the beginning of the current Unix mbox message."
 850   ;; Algorithm used to find the next article in the
 851   ;; brain-dead Unix mbox format:
 852   ;;
 853   ;; 1) Search for "^From ".
 854   ;; 2) If we find it, then see whether the previous
 855   ;;    line is blank and the next line looks like a header.
 856   ;; Then it's possible that this is a mail delim, and we use it.
 857   (let ((case-fold-search nil)
 858         found)
 859     (while (not found)
 860       (if (not (re-search-backward "^From " nil t))
 861           (setq found 'no)
 862         (save-excursion
 863           (beginning-of-line)
 864           (when (and (or (bobp)
 865                          (save-excursion
 866                            (forward-line -1)
 867                            (eq (char-after) ?\n)))
 868                      (save-excursion
 869                        (forward-line 1)
 870                        (while (looking-at ">From \\|From ")
 871                          (forward-line 1))
 872                        (looking-at "[^ \n\t:]+[ \n\t]*:")))
 873             (setq found 'yes)))))
 874     (beginning-of-line)
 875     (eq found 'yes)))
 876
 877 (defun nnmail-process-unix-mail-format (func artnum-func)
 878   (let ((case-fold-search t)
 879         (count 0)
 880         start message-id content-length end skip head-end)
 881     (goto-char (point-min))
 882     (if (not (and (re-search-forward "^From " nil t)
 883                   (goto-char (match-beginning 0))))
 884         ;; Possibly wrong format?
 885         (error "Error, unknown mail format! (Possibly corrupted %s `%s'.)"
 886                (if (buffer-file-name) "file" "buffer")
 887                (or (buffer-file-name) (buffer-name)))
 888       ;; Carry on until the bitter end.
 889       (while (not (eobp))
 890         (setq start (point)
 891               end nil)
 892         ;; Find the end of the head.
 893         (narrow-to-region
 894          start
 895          (if (search-forward "\n\n" nil t)
 896              (1- (point))
 897            ;; This will never happen, but just to be on the safe side --
 898            ;; if there is no head-body delimiter, we search a bit manually.
 899            (while (and (looking-at "From \\|[^ \t]+:")
 900                        (not (eobp)))
 901              (forward-line 1))
 902            (point)))
 903         ;; Find the Message-ID header.
 904         (goto-char (point-min))
 905         (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
 906             (setq message-id (match-string 1))
 907           (save-excursion
 908             (when (re-search-forward "^Message-ID[ \t]*:" nil t)
 909               (beginning-of-line)
 910               (insert "Original-")))
 911           ;; There is no Message-ID here, so we create one.
 912           (forward-line 1)
 913           (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
 914         ;; Look for a Content-Length header.
 915         (goto-char (point-min))
 916         (if (not (re-search-forward
 917                   "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
 918             (setq content-length nil)
 919           (setq content-length (string-to-number (match-string 1)))
 920           ;; We destroy the header, since none of the backends ever
 921           ;; use it, and we do not want to confuse other mailers by
 922           ;; having a (possibly) faulty header.
 923           (beginning-of-line)
 924           (insert "X-"))
 925         (run-hooks 'nnmail-prepare-incoming-header-hook)
 926         ;; Find the end of this article.
 927         (goto-char (point-max))
 928         (widen)
 929         (setq head-end (point))
 930         ;; We try the Content-Length value.  The idea: skip over the header
 931         ;; separator, then check what happens content-length bytes into the
 932         ;; message body.  This should be either the end of the buffer, the
 933         ;; message separator or a blank line followed by the separator.
 934         ;; The blank line should probably be deleted.  If neither of the
 935         ;; three is met, the content-length header is probably invalid.
 936         (when content-length
 937           (forward-line 1)
 938           (setq skip (+ (point) content-length))
 939           (goto-char skip)
 940           (cond ((or (= skip (point-max))
 941                      (= (1+ skip) (point-max)))
 942                  (setq end (point-max)))
 943                 ((looking-at "From ")
 944                  (setq end skip))
 945                 ((looking-at "[ \t]*\n\\(From \\)")
 946                  (setq end (match-beginning 1)))
 947                 (t (setq end nil))))
 948         (if end
 949             (goto-char end)
 950           ;; No Content-Length, so we find the beginning of the next
 951           ;; article or the end of the buffer.
 952           (goto-char head-end)
 953           (or (nnmail-search-unix-mail-delim)
 954               (goto-char (point-max))))
 955         ;; Allow the backend to save the article.
 956         (save-excursion
 957           (save-restriction
 958             (narrow-to-region start (point))
 959             (goto-char (point-min))
 960             (incf count)
 961             (nnmail-check-duplication message-id func artnum-func)
 962             (setq end (point-max))))
 963         (goto-char end)))
 964     count))
 965
 966 (defun nnmail-process-mmdf-mail-format (func artnum-func)
 967   (let ((delim "^\^A\^A\^A\^A$")
 968         (case-fold-search t)
 969         (count 0)
 970         start message-id end)
 971     (goto-char (point-min))
 972     (if (not (and (re-search-forward delim nil t)
 973                   (forward-line 1)))
 974         ;; Possibly wrong format?
 975         (error "Error, unknown mail format! (Possibly corrupted.)")
 976       ;; Carry on until the bitter end.
 977       (while (not (eobp))
 978         (setq start (point))
 979         ;; Find the end of the head.
 980         (narrow-to-region
 981          start
 982          (if (search-forward "\n\n" nil t)
 983              (1- (point))
 984            ;; This will never happen, but just to be on the safe side --
 985