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

   1 ;;; nnmail.el --- mail mbox access for Gnus
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no>
   5 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   6 ;; Keywords: news, mail
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'nnheader)
  29 (require 'rmail)
  30
  31 (defvar nnmail-split-methods
  32   '(("mail.misc" ""))
  33   "nnmail will split incoming mail into the groups detailed in this variable.")
  34
  35 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
  36 (defvar nnmail-crosspost t
  37   "If non-nil, do crossposting if several split methods match the mail.
  38 If nil, the first match found will be used.")
  39
  40 (defvar nnmail-mbox-file (expand-file-name "~/mbox")
  41   "The name of the mail box file in the users home directory.")
  42
  43 (defvar nnmail-active-file (expand-file-name "~/.mbox-active")
  44   "The name of the active file for the mail box.")
  45
  46 (defvar nnmail-expiry-wait 7
  47   "Articles that are older than `nnmail-expiry-wait' days will be expired.")
  48
  49 ;; Quote fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
  50 (defvar nnmail-expiry-wait-function nil
  51   "Variable that holds funtion to specify how old articles should be before they are expired.
  52   The function will be called with the name of the group that the
  53 expiry is to be performed in, and it should return an integer that
  54 says how many days an article can be stored before it is considered
  55 'old'.
  56
  57 Eg.:
  58
  59 (setq nnmail-expiry-wait-function
  60   (function
  61     (lambda (newsgroup)
  62       (cond ((string-match \"private\" newsgroup) 31)
  63             ((string-match \"junk\" newsgroup) 1)
  64             (t 7)))))")
  65
  66 (defvar nnmail-spool-file
  67   (or (getenv "MAIL")
  68       (concat "/usr/spool/mail/" (user-login-name))))
  69
  70 (defvar nnmail-read-incoming-hook nil
  71   "Hook that will be run after the incoming mail has been transferred.
  72 The incoming mail is moved from `nnmail-spool-file' (which normally is
  73 something like \"/usr/spool/mail/$user\") to the user's home
  74 directory. This hook is called after the incoming mail box has been
  75 emptied, and can be used to call any mail box programs you have
  76 running (\"xwatch\", etc.)
  77
  78 Eg.
  79
  80 (add-hook 'nnmail-read-incoming-hook
  81           (function
  82            (lambda ()
  83              (start-process \"mailsend\" nil
  84                             \"/local/bin/mailsend\" \"read\" \"mbox\"))))")
  85
  86 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
  87 (defvar nnmail-prepare-incoming-hook nil
  88   "Hook called before treating incoming mail.
  89 The hook is run in a buffer with all the new, incoming mail.")
  90
  91 (defvar nnmail-large-newsgroup 50
  92   "*The number of the articles which indicates a large newsgroup.
  93 If the number of the articles is greater than the value, verbose
  94 messages will be shown to indicate the current status.")
  95
  96 \f
  97
  98 (defconst nnmail-version "nnmail 0.1"
  99   "nnmail version.")
 100
 101 (defvar nnmail-current-group nil
 102   "Current nnmail news group directory.")
 103
 104 (defconst nnmail-mbox-buffer "*nnmail mbox buffer*")
 105
 106 (defvar nnmail-active-alist nil)
 107
 108 (defvar nnmail-status-string "")
 109
 110 ;;; Interface functions
 111
 112 (defun nnmail-retrieve-headers (sequence &optional newsgroup server)
 113   "Retrieve the headers for the articles in SEQUENCE.
 114 Newsgroup must be selected before calling this function."
 115   (save-excursion
 116     (set-buffer nntp-server-buffer)
 117     (erase-buffer)
 118     (let ((file nil)
 119           (number (length sequence))
 120           (count 0)
 121           beg article art-string start stop)
 122       (nnmail-possibly-change-newsgroup newsgroup)
 123       (while sequence
 124         (setq article (car sequence))
 125         (setq art-string (nnmail-article-string article))
 126         (set-buffer nnmail-mbox-buffer)
 127         (if (or (search-forward art-string nil t)
 128                 (progn (goto-char 1)
 129                        (search-forward art-string nil t)))
 130             (progn
 131               (setq start
 132                     (save-excursion
 133                       (re-search-backward
 134                        (concat "^" rmail-unix-mail-delimiter) nil t)
 135                       (point)))
 136               (search-forward "\n\n" nil t)
 137               (setq stop (1- (point)))
 138               (set-buffer nntp-server-buffer)
 139               (insert (format "221 %d Article retrieved.\n" article))
 140               (setq beg (point))
 141               (insert-buffer-substring nnmail-mbox-buffer start stop)
 142               (goto-char (point-max))
 143               (insert ".\n")))
 144         (setq sequence (cdr sequence))
 145         (setq count (1+ count))
 146         (and (numberp nnmail-large-newsgroup)
 147              (> number nnmail-large-newsgroup)
 148              (zerop (% count 20))
 149              (message "NNMAIL: Receiving headers... %d%%"
 150                       (/ (* count 100) number))))
 151
 152       (and (numberp nnmail-large-newsgroup)
 153            (> number nnmail-large-newsgroup)
 154            (message "NNMAIL: Receiving headers... done"))
 155
 156       ;; Fold continuation lines.
 157       (goto-char 1)
 158       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 159         (replace-match " " t t))
 160       'headers)))
 161
 162 (defun nnmail-open-server (host &optional service)
 163   "Open mbox backend."
 164   (setq nnmail-status-string "")
 165   (nnmail-open-server-internal host service))
 166
 167 (defun nnmail-close-server (&optional server)
 168   "Close news server."
 169   (nnmail-close-server-internal))
 170
 171 (fset 'nnmail-request-quit (symbol-function 'nnmail-close-server))
 172
 173 (defun nnmail-server-opened (&optional server)
 174   "Return server process status, T or NIL.
 175 If the stream is opened, return T, otherwise return NIL."
 176   (and nntp-server-buffer
 177        (get-buffer nntp-server-buffer)))
 178
 179 (defun nnmail-status-message ()
 180   "Return server status response as string."
 181   nnmail-status-string)
 182
 183 (defun nnmail-request-article (article &optional newsgroup server buffer)
 184   "Select ARTICLE by number."
 185   (nnmail-possibly-change-newsgroup newsgroup)
 186   (if (stringp article)
 187       nil
 188     (save-excursion
 189       (set-buffer nnmail-mbox-buffer)
 190       (goto-char 1)
 191       (if (search-forward (nnmail-article-string article) nil t)
 192           (let (start stop)
 193             (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
 194             (setq start (point))
 195             (forward-line 1)
 196             (or (and (re-search-forward
 197                       (concat "^" rmail-unix-mail-delimiter) nil t)
 198                      (forward-line -1))
 199                 (goto-char (point-max)))
 200             (setq stop (point))
 201             (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
 202               (set-buffer nntp-server-buffer)
 203               (erase-buffer)
 204               (insert-buffer-substring nnmail-mbox-buffer start stop)
 205               t))))))
 206
 207 (defun nnmail-request-group (group &optional server dont-check)
 208   "Select news GROUP."
 209   (if (nnmail-possibly-change-newsgroup group)
 210       (if dont-check
 211           t
 212         (nnmail-get-new-mail)
 213         (save-excursion
 214           (set-buffer nntp-server-buffer)
 215           (erase-buffer)
 216           (let ((active (assoc group nnmail-active-alist)))
 217             (insert (format "211 %d %d %d %s\n"
 218                             (1+ (- (cdr (car (cdr active)))
 219                                    (car (car (cdr active)))))
 220                             (car (car (cdr active)))
 221                             (cdr (car (cdr active)))
 222                             (car active))))
 223           t))))
 224
 225 (defun nnmail-request-list (&optional server)
 226   "List active newsgoups."
 227   (nnmail-find-file nnmail-active-file))
 228
 229 (defun nnmail-request-list-newsgroups (&optional server)
 230   "List newsgroups (defined in NNTP2)."
 231   (setq nnmail-status-string "NNMAIL: LIST NEWSGROUPS is not implemented.")
 232   nil)
 233
 234 (defun nnmail-request-post (&optional server)
 235   "Post a new news in current buffer."
 236   (mail-send-and-exit nil))
 237
 238 (defun nnmail-request-post-buffer (method header article-buffer group info)
 239   (let ((method-address (nth 1 (nth 4 info)))
 240         from subject date to reply-to message-of
 241         references message-id sender follow-to)
 242     (setq method-address
 243           (if (and (stringp method-address)
 244                    (string= method-address ""))
 245               nil method-address))
 246     (save-excursion
 247       (set-buffer (get-buffer-create "*mail*"))
 248       (mail-mode)
 249       (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
 250       (local-set-key "\C-c\C-y" 'gnus-mail-yank-original)
 251       (if (and (buffer-modified-p)
 252                (> (buffer-size) 0)
 253                (not (y-or-n-p "Unsent mail being composed; erase it? ")))
 254           ()
 255         (erase-buffer)
 256         (if (eq method 'post)
 257             (mail-setup method-address nil nil nil nil nil)
 258           (save-excursion
 259             (set-buffer article-buffer)
 260             (goto-char (point-min))
 261             (narrow-to-region (point-min)
 262                               (progn (search-forward "\n\n") (point)))
 263             (set-text-properties (point-min) (point-max) nil)
 264             (if (and (boundp 'gnus-followup-to-function)
 265                      gnus-followup-to-function)
 266                 (setq follow-to (funcall gnus-followup-to-function group)))
 267             (setq from (header-from header))
 268             (setq date (header-date header))
 269             (and from
 270                  (let ((stop-pos
 271                         (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
 272                    (setq message-of
 273                          (concat (if stop-pos (substring from 0 stop-pos) from)
 274                                  "'s message of " date))))
 275             (setq sender (mail-fetch-field "sender"))
 276             (setq subject (header-subject header))
 277             (or (string-match "^[Rr][Ee]:" subject)
 278                 (setq subject (concat "Re: " subject)))
 279             (setq reply-to (mail-fetch-field "reply-to"))
 280             (setq references (header-references header))
 281             (setq message-id (header-id header))
 282             (widen))
 283           (setq news-reply-yank-from from)
 284           (setq news-reply-yank-message-id message-id)
 285           (mail-setup (or follow-to method-address sender reply-to from)
 286                       subject message-of nil article-buffer nil)
 287           ;; Fold long references line to follow RFC1036.
 288           (mail-position-on-field "References")
 289           (let ((begin (- (point) (length "References: ")))
 290                 (fill-column 78)
 291                 (fill-prefix "\t"))
 292             (if references (insert references))
 293             (if (and references message-id) (insert " "))
 294             (if message-id (insert message-id))
 295             ;; The region must end with a newline to fill the region
 296             ;; without inserting extra newline.
 297             (fill-region-as-paragraph begin (1+ (point))))
 298           ))
 299       (current-buffer))))
 300
 301 (defun nnmail-request-expire-articles (articles newsgroup &optional server force)
 302   "Expire all articles in the ARTICLES list in group GROUP.
 303 The list of unexpired articles will be returned (ie. all articles that
 304 were too fresh to be expired).
 305 If FORCE is non-nil, the ARTICLES will be deleted without looking at
 306 the date."
 307   (nnmail-possibly-change-newsgroup newsgroup)
 308   (let* ((days (or (and nnmail-expiry-wait-function
 309                         (funcall nnmail-expiry-wait-function newsgroup))
 310                    nnmail-expiry-wait))
 311          (cur-time (current-time))
 312          (day-sec (* 24 60 60 days))
 313          (day-time (list nil nil))
 314          mod-time article rest)
 315     (setcar day-time (/ day-sec 65536))
 316     (setcar (cdr day-time) (- day-sec (* (car day-time) 65536)))
 317     (if (< (car (cdr cur-time)) (car (cdr day-time)))
 318         (progn
 319           (setcar day-time (+ 1 (- (car cur-time) (car day-time))))
 320           (setcar (cdr day-time) (- (+ 65536 (car (cdr cur-time)))
 321                                     (car (cdr day-time)))))
 322       (setcar day-time (- (car cur-time) (car day-time)))
 323       (setcar (cdr day-time) (- (car (cdr cur-time)) (car (cdr day-time)))))
 324     (save-excursion
 325       (set-buffer nnmail-mbox-buffer)
 326       (while articles
 327         (goto-char 1)
 328         (if (and (search-forward (nnmail-article-string (car articles)) nil t)
 329                  (or force
 330                      (setq mod-time (read (current-buffer)))
 331                      (or (< (car mod-time) (car day-time))
 332                          (and (= (car mod-time) (car day-time))
 333                               (< (car (cdr mod-time)) (car (cdr day-time)))))))
 334             (progn
 335               (message "Deleting: %s" article)
 336               (nnmail-delete-mail))
 337           (setq rest (cons (car articles) rest)))
 338         (setq articles (cdr articles)))
 339       (save-buffer)
 340       rest)))
 341
 342 (defun nnmail-request-move-article (article group server accept-form)
 343   (let ((buf (get-buffer-create " *nnmail move*"))
 344         result)
 345     (and
 346      (nnmail-request-article article group server)
 347      (save-excursion
 348        (set-buffer buf)
 349        (insert-buffer-substring nntp-server-buffer)
 350        (goto-char (point-min))
 351        (if (re-search-forward
 352             "^X-Gnus-Newsgroup:"
 353             (save-excursion (search-forward "\n\n" nil t) (point)) t)
 354            (delete-region (progn (beginning-of-line) (point))
 355                           (progn (forward-line 1) (point))))
 356        (setq result (eval accept-form))
 357        (kill-buffer (current-buffer))
 358        result)
 359      (save-excursion
 360        (set-buffer nnmail-mbox-buffer)
 361        (goto-char 1)
 362        (if (search-forward (nnmail-article-string article) nil t)
 363            (nnmail-delete-mail))
 364        (save-buffer)))
 365     result))
 366
 367 (defun nnmail-request-accept-article (group)
 368   (let ((buf (current-buffer))
 369         result beg)
 370     (and
 371      (nnmail-get-active)
 372      (save-excursion
 373        (set-buffer nnmail-mbox-buffer)
 374        (setq beg (goto-char (point-max)))
 375        (insert-buffer-substring buf)
 376        (goto-char beg)
 377        (if (stringp group)
 378            (progn
 379              (search-forward "\n\n" nil t)
 380              (forward-line -1)
 381              (save-excursion
 382                (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
 383                  (delete-region
 384                   (point)
 385                   (progn
 386                     (forward-line 1)
 387                     (point)))))
 388              (setq result (nnmail-insert-newsgroup-line group beg (point))))
 389          (setq result (nnmail-choose-mail beg (point-max))))
 390        (save-buffer)
 391        result)
 392      (nnmail-save-active))
 393     result))
 394
 395 \f
 396 ;;; Low-Level Interface
 397
 398 (defun nnmail-delete-mail ()
 399   (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
 400   (delete-region
 401    (point)
 402    (progn
 403      (forward-line 1)
 404      (or (and (re-search-forward
 405                (concat "^" rmail-unix-mail-delimiter) nil t)
 406               (forward-line -1)
 407               (point))
 408          (point-max)))))
 409
 410 (defun nnmail-open-server-internal (host &optional service)
 411   "Open connection to news server on HOST by SERVICE (default is nntp)."
 412   (save-excursion
 413     (if (not (string-equal host (system-name)))
 414         (error "NNMAIL: cannot talk to %s." host))
 415     ;; Initialize communication buffer.
 416     (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
 417     (set-buffer nntp-server-buffer)
 418     (buffer-disable-undo (current-buffer))
 419     (erase-buffer)
 420     (kill-all-local-variables)
 421     (setq case-fold-search t)           ;Should ignore case.
 422     t))
 423
 424 (defun nnmail-close-server-internal ()
 425   "Close connection to news server."
 426   nil)
 427
 428 (defun nnmail-find-file (file)
 429   "Insert FILE in server buffer safely."
 430   (save-excursion
 431     (set-buffer nntp-server-buffer)
 432     (erase-buffer)
 433     (condition-case ()
 434         (progn (insert-file-contents file) t)
 435       (file-error nil))))
 436
 437 (defun nnmail-possibly-change-newsgroup (newsgroup)
 438   (if (not (get-buffer nnmail-mbox-buffer))
 439       (save-excursion
 440         (set-buffer (setq nnmail-mbox-buffer
 441                           (find-file-noselect nnmail-mbox-file)))
 442         (buffer-disable-undo (current-buffer))))
 443   (if (not nnmail-active-alist)
 444       (nnmail-get-active))
 445   (if newsgroup
 446       (if (assoc newsgroup nnmail-active-alist)
 447           (setq nnmail-current-group newsgroup))))
 448
 449 ;; Most of this function was taken from rmail.el
 450 (defun nnmail-move-inbox ()
 451   (let ((inbox (expand-file-name nnmail-spool-file))
 452         tofile errors)
 453     (setq tofile (make-temp-name
 454                   (expand-file-name (concat nnmail-mbox-file "-Incoming"))))
 455     (unwind-protect
 456         (save-excursion
 457           (setq errors (generate-new-buffer " *nnmail loss*"))
 458           (buffer-disable-undo errors)
 459           (call-process
 460            (expand-file-name "movemail" exec-directory)
 461            nil errors nil inbox tofile)
 462           (if (not (buffer-modified-p errors))
 463               ;; No output => movemail won
 464               nil
 465             (set-buffer errors)
 466             (subst-char-in-region (point-min) (point-max) ?\n ?\  )
 467             (goto-char (point-max))
 468             (skip-chars-backward " \t")
 469             (delete-region (point) (point-max))
 470             (goto-char (point-min))
 471             (if (looking-at "movemail: ")
 472                 (delete-region (point-min) (match-end 0)))
 473             (error (concat "movemail: "
 474                            (buffer-substring (point-min)
 475                                              (point-max)))))))
 476     tofile))
 477
 478 (defun nnmail-article-string (article)
 479   (concat "\nX-Gnus-Newsgroup: " nnmail-current-group ":"
 480           (int-to-string article) " ("))
 481
 482 (defun nnmail-choose-mail (beg end)
 483   (let (result)
 484     (save-excursion
 485       (goto-char end)
 486       (let ((methods nnmail-split-methods)
 487             found)
 488         (while (and (not found) methods)
 489           (if (re-search-backward (car (cdr (car methods))) beg t)
 490               (progn
 491                 (goto-char end)
 492                 (setq result (nnmail-insert-newsgroup-line
 493                               (car (car methods)) beg end))
 494                 (setq found t))
 495             (setq methods (cdr methods))))
 496         (if (not found)
 497             (progn
 498               (goto-char end)
 499               (setq result (nnmail-insert-newsgroup-line
 500                             (car (car nnmail-split-methods)) beg end))))))
 501     result))
 502
 503 (defun nnmail-insert-newsgroup-line (group beg end)
 504   (let ((active (car (cdr (assoc group nnmail-active-alist))))
 505         (time (current-time)))
 506     (if (not active)
 507         (progn
 508           (setq nnmail-active-alist
 509                 (cons (list group (cons 1 0)) nnmail-active-alist))
 510           (setq active (car (cdr (car nnmail-active-alist))))))
 511     (setcdr active (1+ (cdr active)))
 512     (insert (format "X-Gnus-Newsgroup: %s:%d (%d %d)\n" group (cdr active)
 513                     (car time) (car (cdr time))))
 514     (cons group (cdr active))))
 515
 516 (defun nnmail-split-region (beg end)
 517   (save-excursion
 518     (save-restriction
 519       (goto-char beg)
 520       (narrow-to-region beg end)
 521       (let ((delim (concat "^" rmail-unix-mail-delimiter))
 522             start)
 523         (while (re-search-forward delim nil t)
 524           (setq start (match-beginning 0))
 525           (search-forward "\n\n" nil t)
 526           (forward-char -1)
 527           (save-excursion
 528             (if (not (save-excursion (re-search-backward "^Lines:" start t)))
 529                 (insert
 530                  (format "Lines: %d\n"
 531                          (- (count-lines
 532                              (point)
 533                              (or (save-excursion
 534                                    (and (re-search-forward
 535                                          rmail-unix-mail-delimiter nil t)
 536                                         (match-beginning 0)))
 537                                  (point-max)))
 538                             2)))))
 539           (if (not (search-backward "\nX-Gnus-Newsgroup: " start t))
 540               (nnmail-choose-mail start (point))))))))
 541
 542 (defun nnmail-read-mbox ()
 543   (if (not (file-exists-p nnmail-mbox-file))
 544       (write-region 1 1 nnmail-mbox-file t 'nomesg))
 545   (if (and nnmail-mbox-buffer
 546            (get-buffer nnmail-mbox-buffer)
 547            (buffer-name nnmail-mbox-buffer)
 548            (save-excursion
 549              (set-buffer nnmail-mbox-buffer)
 550              (= (buffer-size) (nth 7 (file-attributes nnmail-mbox-file)))))
 551       ()
 552     (save-excursion
 553       (set-buffer (setq nnmail-mbox-buffer
 554                         (find-file-noselect nnmail-mbox-file)))
 555       (buffer-disable-undo (current-buffer))
 556       (nnmail-split-region (point-min) (point-max)))))
 557
 558 (defun nnmail-split-incoming (incoming)
 559   (save-excursion
 560     (set-buffer nnmail-mbox-buffer)
 561     (goto-char (point-max))
 562     (let ((start (point)))
 563       (insert-file-contents incoming)
 564       (save-excursion
 565         (save-restriction
 566           (narrow-to-region start (point-max))
 567           (run-hooks 'nnmail-prepare-incoming-hook)))
 568       (nnmail-split-region start (point-max)))))
 569
 570 (defun nnmail-get-active ()
 571   (let ((methods nnmail-split-methods))
 572     (setq nnmail-active-alist nil)
 573     (if (nnmail-request-list)
 574         (save-excursion
 575           (set-buffer (get-buffer-create " *nntpd*"))
 576           (goto-char 1)
 577           (while (re-search-forward
 578                   "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
 579             (setq nnmail-active-alist
 580                   (cons (list (buffer-substring (match-beginning 1)
 581                                                 (match-end 1))
 582                               (cons (string-to-int
 583                                      (buffer-substring (match-beginning 3)
 584                                                        (match-end 3)))
 585                                     (string-to-int
 586                                      (buffer-substring (match-beginning 2)
 587                                                        (match-end 2)))))
 588                         nnmail-active-alist)))))
 589     (while methods
 590       (if (not (assoc (car (car methods)) nnmail-active-alist))
 591           (setq nnmail-active-alist
 592                 (cons (list (car (car methods)) (cons 1 0))
 593                       nnmail-active-alist)))
 594       (setq methods (cdr methods)))
 595     t))
 596
 597 (defun nnmail-save-active ()
 598   (let ((groups nnmail-active-alist)
 599         group)
 600     (save-excursion
 601       (set-buffer (get-buffer-create " *nnmail*"))
 602       (buffer-disable-undo (current-buffer))
 603       (erase-buffer)
 604       (while groups
 605         (setq group (car groups))
 606         (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) )
 607                         (car (car (cdr group)))))
 608         (setq groups (cdr groups)))
 609       (write-region 1 (point-max) (expand-file-name nnmail-active-file) nil
 610                     'nomesg)
 611       (kill-buffer (current-buffer)))))
 612
 613 (defun nnmail-get-new-mail ()
 614   (let (incoming)
 615     (nnmail-get-active)
 616     (nnmail-read-mbox)
 617     (if (and (file-exists-p nnmail-spool-file)
 618              (> (nth 7 (file-attributes nnmail-spool-file)) 0))
 619         (progn
 620           (setq incoming (nnmail-move-inbox))
 621           (nnmail-split-incoming incoming)
 622           (run-hooks 'nnmail-read-incoming-hook)))
 623     (and (buffer-modified-p nnmail-mbox-buffer)
 624          (save-excursion
 625            (nnmail-save-active)
 626            (set-buffer nnmail-mbox-buffer)
 627            (save-buffer)))
 628 ;    (if incoming
 629 ;       (delete-file incoming))
 630     ))
 631
 632 (provide 'nnmail)
 633
 634 ;;; nnmail.el ends here