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