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

   1 ;;; nnfolder.el --- mail folder access for Gnus
   2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
   3
   4 ;; Author: Scott Byer <byer@mv.us.adobe.com>
   5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   6 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   7 ;; Keywords: 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., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; For an overview of what the interface functions do, please see the
  29 ;; Gnus sources.
  30
  31 ;; Various enhancements by byer@mv.us.adobe.com (Scott Byer).
  32
  33 ;;; Code:
  34
  35 (require 'nnheader)
  36 (require 'message)
  37 (require 'nnmail)
  38 (require 'nnoo)
  39 (eval-when-compile (require 'cl))
  40
  41 (nnoo-declare nnfolder)
  42
  43 (defvoo nnfolder-directory (expand-file-name message-directory)
  44   "The name of the nnfolder directory.")
  45
  46 (defvoo nnfolder-active-file
  47   (nnheader-concat nnfolder-directory "active")
  48   "The name of the active file.")
  49
  50 ;; I renamed this variable to something more in keeping with the general GNU
  51 ;; style. -SLB
  52
  53 (defvoo nnfolder-ignore-active-file nil
  54   "If non-nil, causes nnfolder to do some extra work in order to determine the true active ranges of an mbox file.
  55 Note that the active file is still saved, but it's values are not
  56 used.  This costs some extra time when scanning an mbox when opening
  57 it.")
  58
  59 (defvoo nnfolder-newsgroups-file
  60   (concat (file-name-as-directory nnfolder-directory) "newsgroups")
  61   "Mail newsgroups description file.")
  62
  63 (defvoo nnfolder-get-new-mail t
  64   "If non-nil, nnfolder will check the incoming mail file and split the mail.")
  65
  66 (defvoo nnfolder-prepare-save-mail-hook nil
  67   "Hook run narrowed to an article before saving.")
  68
  69 (defvoo nnfolder-save-buffer-hook nil
  70   "Hook run before saving the nnfolder mbox buffer.")
  71
  72 (defvoo nnfolder-inhibit-expiry nil
  73   "If non-nil, inhibit expiry.")
  74
  75 \f
  76
  77 (defconst nnfolder-version "nnfolder 1.0"
  78   "nnfolder version.")
  79
  80 (defconst nnfolder-article-marker "X-Gnus-Article-Number: "
  81   "String used to demarcate what the article number for a message is.")
  82
  83 (defvoo nnfolder-current-group nil)
  84 (defvoo nnfolder-current-buffer nil)
  85 (defvoo nnfolder-status-string "")
  86 (defvoo nnfolder-group-alist nil)
  87 (defvoo nnfolder-buffer-alist nil)
  88 (defvoo nnfolder-active-timestamp nil)
  89
  90 \f
  91
  92 ;;; Interface functions
  93
  94 (nnoo-define-basics nnfolder)
  95
  96 (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old)
  97   (save-excursion
  98     (set-buffer nntp-server-buffer)
  99     (erase-buffer)
 100     (let ((delim-string (concat "^" message-unix-mail-delimiter))
 101           article art-string start stop)
 102       (nnfolder-possibly-change-group group server)
 103       (set-buffer nnfolder-current-buffer)
 104       (goto-char (point-min))
 105       (if (stringp (car articles))
 106           'headers
 107         (while articles
 108           (setq article (car articles))
 109           (setq art-string (nnfolder-article-string article))
 110           (set-buffer nnfolder-current-buffer)
 111           (if (or (search-forward art-string nil t)
 112                   ;; Don't search the whole file twice!  Also, articles
 113                   ;; probably have some locality by number, so searching
 114                   ;; backwards will be faster.  Especially if we're at the
 115                   ;; beginning of the buffer :-). -SLB
 116                   (search-backward art-string nil t))
 117               (progn
 118                 (setq start (or (re-search-backward delim-string nil t)
 119                                 (point)))
 120                 (search-forward "\n\n" nil t)
 121                 (setq stop (1- (point)))
 122                 (set-buffer nntp-server-buffer)
 123                 (insert (format "221 %d Article retrieved.\n" article))
 124                 (insert-buffer-substring nnfolder-current-buffer start stop)
 125                 (goto-char (point-max))
 126                 (insert ".\n")))
 127           (setq articles (cdr articles)))
 128
 129         (set-buffer nntp-server-buffer)
 130         (nnheader-fold-continuation-lines)
 131         'headers))))
 132
 133 (deffoo nnfolder-open-server (server &optional defs)
 134   (nnoo-change-server 'nnfolder server defs)
 135   (when (not (file-exists-p nnfolder-directory))
 136     (condition-case ()
 137         (make-directory nnfolder-directory t)
 138       (error t)))
 139   (cond
 140    ((not (file-exists-p nnfolder-directory))
 141     (nnfolder-close-server)
 142     (nnheader-report 'nnfolder "Couldn't create directory: %s"
 143                      nnfolder-directory))
 144    ((not (file-directory-p (file-truename nnfolder-directory)))
 145     (nnfolder-close-server)
 146     (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory))
 147    (t
 148     (nnheader-report 'nnfolder "Opened server %s using directory %s"
 149                      server nnfolder-directory)
 150     t)))
 151
 152 (deffoo nnfolder-request-close ()
 153   (let ((alist nnfolder-buffer-alist))
 154     (while alist
 155       (nnfolder-close-group (caar alist) nil t)
 156       (setq alist (cdr alist))))
 157   (nnoo-close-server 'nnfolder)
 158   (setq nnfolder-buffer-alist nil
 159         nnfolder-group-alist nil))
 160
 161 (deffoo nnfolder-request-article (article &optional group server buffer)
 162   (nnfolder-possibly-change-group group server)
 163   (save-excursion
 164     (set-buffer nnfolder-current-buffer)
 165     (goto-char (point-min))
 166     (if (search-forward (nnfolder-article-string article) nil t)
 167         (let (start stop)
 168           (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
 169           (setq start (point))
 170           (forward-line 1)
 171           (or (and (re-search-forward
 172                     (concat "^" message-unix-mail-delimiter) nil t)
 173                    (forward-line -1))
 174               (goto-char (point-max)))
 175           (setq stop (point))
 176           (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
 177             (set-buffer nntp-server-buffer)
 178             (erase-buffer)
 179             (insert-buffer-substring nnfolder-current-buffer start stop)
 180             (goto-char (point-min))
 181             (while (looking-at "From ")
 182               (delete-char 5)
 183               (insert "X-From-Line: ")
 184               (forward-line 1))
 185             (if (numberp article)
 186                 (cons nnfolder-current-group article)
 187               (goto-char (point-min))
 188               (search-forward (concat "\n" nnfolder-article-marker))
 189               (cons nnfolder-current-group
 190                     (string-to-int
 191                      (buffer-substring
 192                       (point) (progn (end-of-line) (point)))))))))))
 193
 194 (deffoo nnfolder-request-group (group &optional server dont-check)
 195   (save-excursion
 196     (nnmail-activate 'nnfolder)
 197     (if (not (assoc group nnfolder-group-alist))
 198         (nnheader-report 'nnfolder "No such group: %s" group)
 199       (nnfolder-possibly-change-group group server)
 200       (if dont-check
 201           (progn
 202             (nnheader-report 'nnfolder "Selected group %s" group)
 203             t)
 204         (let* ((active (assoc group nnfolder-group-alist))
 205                (group (car active))
 206                (range (cadr active)))
 207           (cond
 208            ((null active)
 209             (nnheader-report 'nnfolder "No such group: %s" group))
 210            (t
 211             (nnheader-report 'nnfolder "Selected group %s" group)
 212             (nnheader-insert "211 %d %d %d %s\n"
 213                              (1+ (- (cdr range) (car range)))
 214                              (car range) (cdr range) group))))))))
 215
 216 (deffoo nnfolder-request-scan (&optional group server)
 217   (nnfolder-possibly-change-group group server)
 218   (nnmail-get-new-mail
 219    'nnfolder
 220    (lambda ()
 221      (let ((bufs nnfolder-buffer-alist))
 222        (save-excursion
 223          (while bufs
 224            (if (not (buffer-name (nth 1 (car bufs))))
 225                (setq nnfolder-buffer-alist
 226                      (delq (car bufs) nnfolder-buffer-alist))
 227              (set-buffer (nth 1 (car bufs)))
 228              (nnfolder-save-buffer)
 229              (kill-buffer (current-buffer)))
 230            (setq bufs (cdr bufs))))))
 231    nnfolder-directory
 232    group))
 233
 234 ;; Don't close the buffer if we're not shutting down the server.  This way,
 235 ;; we can keep the buffer in the group buffer cache, and not have to grovel
 236 ;; over the buffer again unless we add new mail to it or modify it in some
 237 ;; way.
 238
 239 (deffoo nnfolder-close-group (group &optional server force)
 240   ;; Make sure we _had_ the group open.
 241   (when (or (assoc group nnfolder-buffer-alist)
 242             (equal group nnfolder-current-group))
 243     (let ((inf (assoc group nnfolder-buffer-alist)))
 244       (when inf
 245         (when nnfolder-current-group
 246           (push (list nnfolder-current-group nnfolder-current-buffer)
 247                 nnfolder-buffer-alist))
 248         (setq nnfolder-buffer-alist
 249               (delq inf nnfolder-buffer-alist))
 250         (setq nnfolder-current-buffer (cadr inf)
 251               nnfolder-current-group (car inf))))
 252     (when (and nnfolder-current-buffer
 253                (buffer-name nnfolder-current-buffer))
 254       (save-excursion
 255         (set-buffer nnfolder-current-buffer)
 256         ;; If the buffer was modified, write the file out now.
 257         (nnfolder-save-buffer)
 258         ;; If we're shutting the server down, we need to kill the
 259         ;; buffer and remove it from the open buffer list.  Or, of
 260         ;; course, if we're trying to minimize our space impact.
 261         (kill-buffer (current-buffer))
 262         (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist)
 263                                           nnfolder-buffer-alist)))))
 264   (setq nnfolder-current-group nil
 265         nnfolder-current-buffer nil)
 266   t)
 267
 268 (deffoo nnfolder-request-create-group (group &optional server)
 269   (nnfolder-possibly-change-group nil server)
 270   (nnmail-activate 'nnfolder)
 271   (when group
 272     (unless (assoc group nnfolder-group-alist)
 273       (push (list group (cons 1 0)) nnfolder-group-alist)
 274       (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
 275   t)
 276
 277 (deffoo nnfolder-request-list (&optional server)
 278   (nnfolder-possibly-change-group nil server)
 279   (save-excursion
 280     (nnmail-find-file nnfolder-active-file)
 281     (setq nnfolder-group-alist (nnmail-get-active))))
 282
 283 (deffoo nnfolder-request-newgroups (date &optional server)
 284   (nnfolder-possibly-change-group nil server)
 285   (nnfolder-request-list server))
 286
 287 (deffoo nnfolder-request-list-newsgroups (&optional server)
 288   (nnfolder-possibly-change-group nil server)
 289   (save-excursion
 290     (nnmail-find-file nnfolder-newsgroups-file)))
 291
 292 (deffoo nnfolder-request-expire-articles
 293   (articles newsgroup &optional server force)
 294   (nnfolder-possibly-change-group newsgroup server)
 295   (let* ((is-old t)
 296          rest)
 297     (nnmail-activate 'nnfolder)
 298
 299     (save-excursion
 300       (set-buffer nnfolder-current-buffer)
 301       (while (and articles is-old)
 302         (goto-char (point-min))
 303         (if (search-forward (nnfolder-article-string (car articles)) nil t)
 304             (if (setq is-old
 305                       (nnmail-expired-article-p
 306                        newsgroup
 307                        (buffer-substring
 308                         (point) (progn (end-of-line) (point)))
 309                        force nnfolder-inhibit-expiry))
 310                 (progn
 311                   (nnheader-message 5 "Deleting article %d..."
 312                                     (car articles) newsgroup)
 313                   (nnfolder-delete-mail))
 314               (setq rest (cons (car articles) rest))))
 315         (setq articles (cdr articles)))
 316       (nnfolder-save-buffer)
 317       ;; Find the lowest active article in this group.
 318       (let* ((active (cadr (assoc newsgroup nnfolder-group-alist)))
 319              (marker (concat "\n" nnfolder-article-marker))
 320              (number "[0-9]+")
 321              (activemin (cdr active)))
 322         (goto-char (point-min))
 323         (while (and (search-forward marker nil t)
 324                     (re-search-forward number nil t))
 325           (setq activemin (min activemin
 326                                (string-to-number (buffer-substring
 327                                                   (match-beginning 0)
 328                                                   (match-end 0))))))
 329         (setcar active activemin))
 330       (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
 331       (nconc rest articles))))
 332
 333 (deffoo nnfolder-request-move-article
 334   (article group server accept-form &optional last)
 335   (nnfolder-possibly-change-group group server)
 336   (let ((buf (get-buffer-create " *nnfolder move*"))
 337         result)
 338     (and
 339      (nnfolder-request-article article group server)
 340      (save-excursion
 341        (set-buffer buf)
 342        (buffer-disable-undo (current-buffer))
 343        (erase-buffer)
 344        (insert-buffer-substring nntp-server-buffer)
 345        (goto-char (point-min))
 346        (while (re-search-forward
 347                (concat "^" nnfolder-article-marker)
 348                (save-excursion (search-forward "\n\n" nil t) (point)) t)
 349          (delete-region (progn (beginning-of-line) (point))
 350                         (progn (forward-line 1) (point))))
 351        (setq result (eval accept-form))
 352        (kill-buffer buf)
 353        result)
 354      (save-excursion
 355        (nnfolder-possibly-change-group group server)
 356        (set-buffer nnfolder-current-buffer)
 357        (goto-char (point-min))
 358        (if (search-forward (nnfolder-article-string article) nil t)
 359            (nnfolder-delete-mail))
 360        (and last (nnfolder-save-buffer))))
 361     result))
 362
 363 (deffoo nnfolder-request-accept-article (group &optional server last)
 364   (nnfolder-possibly-change-group group server)
 365   (and (stringp group) (nnfolder-possibly-change-group group))
 366   (let ((buf (current-buffer))
 367         result)
 368     (goto-char (point-min))
 369     (when (looking-at "X-From-Line: ")
 370       (replace-match "From "))
 371     (and
 372      (nnfolder-request-list)
 373      (save-excursion
 374        (set-buffer buf)
 375        (goto-char (point-min))
 376        (search-forward "\n\n" nil t)
 377        (forward-line -1)
 378        (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
 379          (delete-region (point) (progn (forward-line 1) (point))))
 380        (setq result (car (nnfolder-save-mail (and (stringp group) group)))))
 381      (save-excursion
 382        (set-buffer nnfolder-current-buffer)
 383        (and last (nnfolder-save-buffer))))
 384     (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
 385     (unless result
 386       (nnheader-report 'nnfolder "Couldn't store article"))
 387     result))
 388
 389 (deffoo nnfolder-request-replace-article (article group buffer)
 390   (nnfolder-possibly-change-group group)
 391   (save-excursion
 392     (set-buffer nnfolder-current-buffer)
 393     (goto-char (point-min))
 394     (if (not (search-forward (nnfolder-article-string article) nil t))
 395         nil
 396       (nnfolder-delete-mail t t)
 397       (insert-buffer-substring buffer)
 398       (nnfolder-save-buffer)
 399       t)))
 400
 401 (deffoo nnfolder-request-delete-group (group &optional force server)
 402   (nnfolder-close-group group server t)
 403   ;; Delete all articles in GROUP.
 404   (if (not force)
 405       ()                                ; Don't delete the articles.
 406     ;; Delete the file that holds the group.
 407     (condition-case nil
 408         (delete-file (nnfolder-group-pathname group))
 409       (error nil)))
 410   ;; Remove the group from all structures.
 411   (setq nnfolder-group-alist
 412         (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
 413         nnfolder-current-group nil
 414         nnfolder-current-buffer nil)
 415   ;; Save the active file.
 416   (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
 417   t)
 418
 419 (deffoo nnfolder-request-rename-group (group new-name &optional server)
 420   (nnfolder-possibly-change-group group server)
 421   (save-excursion
 422     (set-buffer nnfolder-current-buffer)
 423     (and (file-writable-p buffer-file-name)
 424          (condition-case ()
 425              (progn
 426                (rename-file
 427                 buffer-file-name
 428                 (nnfolder-group-pathname new-name))
 429                t)
 430            (error nil))
 431          ;; That went ok, so we change the internal structures.
 432          (let ((entry (assoc group nnfolder-group-alist)))
 433            (and entry (setcar entry new-name))
 434            (setq nnfolder-current-buffer nil
 435                  nnfolder-current-group nil)
 436            ;; Save the new group alist.
 437            (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
 438            ;; We kill the buffer instead of renaming it and stuff.
 439            (kill-buffer (current-buffer))
 440            t))))
 441
 442 \f
 443 ;;; Internal functions.
 444
 445 (defun nnfolder-article-string (article)
 446   (if (numberp article)
 447       (concat "\n" nnfolder-article-marker (int-to-string article) " ")
 448     (concat "\nMessage-ID: " article)))
 449
 450 (defun nnfolder-delete-mail (&optional force leave-delim)
 451   "Delete the message that point is in."
 452   (save-excursion
 453     (delete-region
 454      (save-excursion
 455        (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
 456        (if leave-delim (progn (forward-line 1) (point))
 457          (match-beginning 0)))
 458      (progn
 459        (forward-line 1)
 460        (if (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
 461            (if (and (not (bobp)) leave-delim)
 462                (progn (forward-line -2) (point))
 463              (match-beginning 0))
 464          (point-max))))))
 465
 466 (defun nnfolder-possibly-change-group (group &optional server)
 467   (when (and server
 468              (not (nnfolder-server-opened server)))
 469     (nnfolder-open-server server))
 470   (when group
 471     (unless (file-exists-p nnfolder-directory)
 472       (make-directory (directory-file-name nnfolder-directory) t))
 473     (nnfolder-possibly-activate-groups nil)
 474     (or (assoc group nnfolder-group-alist)
 475         (not (file-exists-p
 476               (nnfolder-group-pathname group)))
 477         (progn
 478           (setq nnfolder-group-alist
 479                 (cons (list group (cons 1 0)) nnfolder-group-alist))
 480           (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
 481     (let (inf file)
 482       (if (and (equal group nnfolder-current-group)
 483                nnfolder-current-buffer
 484                (buffer-name nnfolder-current-buffer))
 485           ()
 486         (setq nnfolder-current-group group)
 487
 488         ;; If we have to change groups, see if we don't already have the mbox
 489         ;; in memory.  If we do, verify the modtime and destroy the mbox if
 490         ;; needed so we can rescan it.
 491         (if (setq inf (assoc group nnfolder-buffer-alist))
 492             (setq nnfolder-current-buffer (nth 1 inf)))
 493
 494         ;; If the buffer is not live, make sure it isn't in the alist.  If it
 495         ;; is live, verify that nobody else has touched the file since last
 496         ;; time.
 497         (if (or (not (and nnfolder-current-buffer
 498                           (buffer-name nnfolder-current-buffer)))
 499                 (not (and (bufferp nnfolder-current-buffer)
 500                           (verify-visited-file-modtime
 501                            nnfolder-current-buffer))))
 502             (progn
 503               (if (and nnfolder-current-buffer
 504                        (buffer-name nnfolder-current-buffer)
 505                        (bufferp nnfolder-current-buffer))
 506                   (kill-buffer nnfolder-current-buffer))
 507               (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))
 508               (setq inf nil)))
 509
 510         (if inf
 511             ()
 512           (save-excursion
 513             (setq file (nnfolder-group-pathname group))
 514             (if (file-directory-p (file-truename file))
 515                 ()
 516               (unless (file-exists-p file)
 517                 (unless (file-exists-p (file-name-directory file))
 518                   (make-directory (file-name-directory file) t))
 519                 (write-region 1 1 file t 'nomesg))
 520               (setq nnfolder-current-buffer
 521                     (set-buffer (nnfolder-read-folder file)))
 522               (setq nnfolder-buffer-alist (cons (list group (current-buffer))
 523                                                 nnfolder-buffer-alist)))))))
 524     (setq nnfolder-current-group group)))
 525
 526 (defun nnfolder-save-mail (&optional group)
 527   "Called narrowed to an article."
 528   (let* ((nnmail-split-methods
 529           (if group (list (list group "")) nnmail-split-methods))
 530          (group-art-list
 531           (nreverse (nnmail-article-group 'nnfolder-active-number)))
 532          (delim (concat "^" message-unix-mail-delimiter))
 533          save-list group-art)
 534     (goto-char (point-min))
 535     ;; This might come from somewhere else.
 536     (unless (looking-at delim)
 537       (insert "From nobody " (current-time-string) "\n")
 538       (goto-char (point-min)))
 539     ;; Quote all "From " lines in the article.
 540     (forward-line 1)
 541     (while (re-search-forward delim nil t)
 542       (beginning-of-line)
 543       (insert "> "))
 544     (setq save-list group-art-list)
 545     (nnmail-insert-lines)
 546     (nnmail-insert-xref group-art-list)
 547     (run-hooks 'nnmail-prepare-save-mail-hook)
 548     (run-hooks 'nnfolder-prepare-save-mail-hook)
 549
 550     ;; Insert the mail into each of the destination groups.
 551     (while group-art-list
 552       (setq group-art (car group-art-list)
 553             group-art-list (cdr group-art-list))
 554
 555       ;; Kill the previous newsgroup markers.
 556       (goto-char (point-min))
 557       (search-forward "\n\n" nil t)
 558       (forward-line -1)
 559       (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
 560         (delete-region (1+ (point)) (progn (forward-line 2) (point))))
 561
 562       (nnfolder-possibly-change-group (car group-art))
 563       ;; Insert the new newsgroup marker.
 564       (nnfolder-insert-newsgroup-line group-art)
 565       (unless nnfolder-current-buffer
 566         (nnfolder-request-create-group (car group-art))
 567         (nnfolder-possibly-change-group (car group-art)))
 568       (let ((beg (point-min))
 569             (end (point-max))
 570             (obuf (current-buffer)))
 571         (set-buffer nnfolder-current-buffer)
 572         (goto-char (point-max))
 573         (unless (eolp)
 574           (insert "\n"))
 575         (insert "\n")
 576         (insert-buffer-substring obuf beg end)
 577         (set-buffer obuf)))
 578
 579     ;; Did we save it anywhere?
 580     save-list))
 581
 582 (defun nnfolder-insert-newsgroup-line (group-art)
 583   (save-excursion
 584     (goto-char (point-min))
 585     (if (search-forward "\n\n" nil t)
 586         (progn
 587           (forward-char -1)
 588           (insert (format (concat nnfolder-article-marker "%d   %s\n")
 589                           (cdr group-art) (current-time-string)))))))
 590
 591 (defun nnfolder-possibly-activate-groups (&optional group)
 592   (save-excursion
 593     ;; If we're looking for the activation of a specific group, find out
 594     ;; its real name and switch to it.
 595     (if group (nnfolder-possibly-change-group group))
 596     ;; If the group alist isn't active, activate it now.
 597     (nnmail-activate 'nnfolder)))
 598
 599 (defun nnfolder-active-number (group)
 600   (when group
 601     (save-excursion
 602       ;; Find the next article number in GROUP.
 603       (prog1
 604           (let ((active (cadr (assoc group nnfolder-group-alist))))
 605             (if active
 606                 (setcdr active (1+ (cdr active)))
 607               ;; This group is new, so we create a new entry for it.
 608               ;; This might be a bit naughty... creating groups on the drop of
 609               ;; a hat, but I don't know...
 610               (setq nnfolder-group-alist
 611                     (cons (list group (setq active (cons 1 1)))
 612                           nnfolder-group-alist)))
 613             (cdr active))
 614         (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
 615         (nnfolder-possibly-activate-groups group)))))
 616
 617
 618 ;; This method has a problem if you've accidentally let the active list get
 619 ;; out of sync with the files.  This could happen, say, if you've
 620 ;; accidentally gotten new mail with something other than Gnus (but why
 621 ;; would _that_ ever happen? :-).  In that case, we will be in the middle of
 622 ;; processing the file, ready to add new X-Gnus article number markers, and
 623 ;; we'll run across a message with no ID yet - the active list _may_not_ be
 624 ;; ready for us yet.
 625
 626 ;; To handle this, I'm modifying this routine to maintain the maximum ID seen
 627 ;; so far, and when we hit a message with no ID, we will _manually_ scan the
 628 ;; rest of the message looking for any more, possibly higher IDs.  We'll
 629 ;; assume the maximum that we find is the highest active.  Note that this
 630 ;; shouldn't cost us much extra time at all, but will be a lot less
 631 ;; vulnerable to glitches between the mbox and the active file.
 632
 633 (defun nnfolder-read-folder (file)
 634   (save-excursion
 635     (nnfolder-possibly-activate-groups nil)
 636     ;; We should be paranoid here and make sure the group is in the alist,
 637     ;; and add it if it isn't.
 638     ;;(if (not (assoc nnfoler-current-group nnfolder-group-alist)
 639     (set-buffer (setq nnfolder-current-buffer
 640                       (nnheader-find-file-noselect file nil 'raw)))
 641     (buffer-disable-undo (current-buffer))
 642     (let* ((delim (concat "^" message-unix-mail-delimiter))
 643            (marker (concat "\n" nnfolder-article-marker))
 644            (number "[0-9]+")
 645            (active (cadr (assoc nnfolder-current-group
 646                                 nnfolder-group-alist)))
 647            ;; Set min to Big Number.
 648            (min (max (1- (lsh 1 23)) (1- (lsh 1 24)) (1- (lsh 1 25))))
 649            (max (cdr active))
 650            start end)
 651       (goto-char (point-min))
 652
 653       ;; Anytime the active number is 1 or 0, it is suspect.  In that case,
 654       ;; search the file manually to find the active number.  Or, of course,
 655       ;; if we're being paranoid.  (This would also be the place to build
 656       ;; other lists from the header markers, such as expunge lists, etc., if
 657       ;; we ever desired to abandon the active file entirely for mboxes.)
 658       (when (or nnfolder-ignore-active-file
 659                 (< max 2))
 660         (while (and (search-forward marker nil t)
 661                     (re-search-forward number nil t))
 662           (let ((newnum (string-to-number (match-string 0))))
 663             (setq max (max max newnum))
 664             (setq min (min min newnum))))
 665         (setcar active (max 1 (min min max)))
 666         (setcdr active (max max (cdr active)))
 667         (goto-char (point-min)))
 668
 669       ;; Keep track of the active number on our own, and insert it back into
 670       ;; the active list when we're done. Also, prime the pump to cut down on
 671       ;; the number of searches we do.
 672       (setq end (point-marker))
 673       (set-marker end (or (and (re-search-forward delim nil t)
 674                                (match-beginning 0))
 675                           (point-max)))
 676       (while (not (= end (point-max)))
 677         (setq start (marker-position end))
 678         (goto-char end)
 679         ;; There may be more than one "From " line, so we skip past
 680         ;; them.
 681         (while (looking-at delim)
 682           (forward-line 1))
 683         (set-marker end (or (and (re-search-forward delim nil t)
 684                                  (match-beginning 0))
 685                             (point-max)))
 686         (goto-char start)
 687         (if (not (search-forward marker end t))
 688             (progn
 689               (narrow-to-region start end)
 690               (nnmail-insert-lines)
 691               (nnfolder-insert-newsgroup-line
 692                (cons nil (nnfolder-active-number nnfolder-current-group)))
 693               (widen))))
 694
 695       ;; Make absolutely sure that the active list reflects reality!
 696       (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
 697       (current-buffer))))
 698
 699 ;;;###autoload
 700 (defun nnfolder-generate-active-file ()
 701   "Look for mbox folders in the nnfolder directory and make them into groups."
 702   (interactive)
 703   (nnmail-activate 'nnfolder)
 704   (let ((files (directory-files nnfolder-directory))
 705         file)
 706     (while (setq file (pop files))
 707       (when (nnheader-mail-file-mbox-p file)
 708         (nnheader-message 5 "Adding group %s..." file)
 709         (push (list file (cons 1 0)) nnfolder-group-alist)
 710         (nnfolder-read-folder file)
 711         (nnfolder-close-group file))
 712       (message ""))))
 713
 714 (defun nnfolder-group-pathname (group)
 715   "Make pathname for GROUP."
 716   (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
 717     ;; If this file exists, we use it directly.
 718     (if (or nnmail-use-long-file-names
 719             (file-exists-p (concat dir group)))
 720         (concat dir group)
 721       ;; If not, we translate dots into slashes.
 722       (concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
 723
 724 (defun nnfolder-save-buffer ()
 725   "Save the buffer."
 726   (when (buffer-modified-p)
 727     (run-hooks 'nnfolder-save-buffer-hook)
 728     (save-buffer)))
 729
 730 (provide 'nnfolder)
 731
 732 ;;; nnfolder.el ends here