lisp/gnus/nnfolder.el

   1 ;;; nnfolder.el --- mail folder access for Gnus
   2
   3 ;; Copyright (C) 1995-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Simon Josefsson <simon@josefsson.org>
   6 ;;      ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
   7 ;;      Scott Byer <byer@mv.us.adobe.com>
   8 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
   9 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
  10 ;; Keywords: mail
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (require 'nnheader)
  32 (require 'message)
  33 (require 'nnmail)
  34 (require 'nnoo)
  35 (require 'gnus)
  36 (require 'gnus-util)
  37 (require 'gnus-range)
  38
  39 ;; FIXME not explicitly used in this file.
  40 (autoload 'gnus-article-unpropagatable-p "gnus-sum")
  41
  42 (nnoo-declare nnfolder)
  43
  44 (defvoo nnfolder-directory (expand-file-name message-directory)
  45   "The name of the nnfolder directory.")
  46
  47 (defvoo nnfolder-nov-directory nil
  48   "The name of the nnfolder NOV directory.
  49 If nil, `nnfolder-directory' is used.")
  50
  51 (defvoo nnfolder-active-file
  52     (nnheader-concat nnfolder-directory "active")
  53   "The name of the active file.")
  54
  55 ;; I renamed this variable to something more in keeping with the general GNU
  56 ;; style. -SLB
  57
  58 (defvoo nnfolder-ignore-active-file nil
  59   "If non-nil, the active file is ignored.
  60 This causes nnfolder to do some extra work in order to determine the
  61 true active ranges of an mbox file.  Note that the active file is
  62 still saved, but its values are not used.  This costs some extra time
  63 when scanning an mbox when opening it.")
  64
  65 (defvoo nnfolder-distrust-mbox nil
  66   "If non-nil, the folder will be distrusted.
  67 This means that nnfolder will not trust the user with respect to
  68 inserting unaccounted for mail in the middle of an mbox file.  This
  69 can greatly slow down scans, which now must scan the entire file for
  70 unmarked messages.  When nil, scans occur forward from the last marked
  71 message, a huge time saver for large mailboxes.")
  72
  73 (defvoo nnfolder-newsgroups-file
  74     (concat (file-name-as-directory nnfolder-directory) "newsgroups")
  75   "Mail newsgroups description file.")
  76
  77 (defvoo nnfolder-get-new-mail t
  78   "If non-nil, nnfolder will check the incoming mail file and split the mail.")
  79
  80 (defvoo nnfolder-prepare-save-mail-hook nil
  81   "Hook run narrowed to an article before saving.")
  82
  83 (defvoo nnfolder-save-buffer-hook nil
  84   "Hook run before saving the nnfolder mbox buffer.")
  85
  86
  87 (defvoo nnfolder-inhibit-expiry nil
  88   "If non-nil, inhibit expiry.")
  89
  90 \f
  91
  92 (defconst nnfolder-version "nnfolder 2.0"
  93   "nnfolder version.")
  94
  95 (defconst nnfolder-article-marker "X-Gnus-Article-Number: "
  96   "String used to demarcate what the article number for a message is.")
  97
  98 (defvoo nnfolder-current-group nil)
  99 (defvoo nnfolder-current-buffer nil)
 100 (defvoo nnfolder-status-string "")
 101 (defvoo nnfolder-group-alist nil)
 102 (defvoo nnfolder-buffer-alist nil)
 103 (defvoo nnfolder-scantime-alist nil)
 104 (defvoo nnfolder-active-timestamp nil)
 105 (defvoo nnfolder-active-file-coding-system mm-text-coding-system)
 106 (defvoo nnfolder-active-file-coding-system-for-write
 107     nnmail-active-file-coding-system)
 108 (defvoo nnfolder-file-coding-system mm-text-coding-system)
 109 (defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system
 110   "Coding system for save nnfolder file.
 111 if nil, `nnfolder-file-coding-system' is used.") ; FIXME: fill-in the doc-string of this variable
 112
 113 (defvoo nnfolder-nov-is-evil nil
 114   "If non-nil, Gnus will never generate and use nov databases for mail groups.
 115 Using nov databases will speed up header fetching considerably.
 116 This variable shouldn't be flipped much.  If you have, for some reason,
 117 set this to t, and want to set it to nil again, you should always run
 118 the `nnfolder-generate-active-file' command.  The function will go
 119 through all nnfolder directories and generate nov databases for them
 120 all.  This may very well take some time.")
 121
 122 (defvoo nnfolder-nov-file-suffix ".nov")
 123
 124 (defvoo nnfolder-nov-buffer-alist nil)
 125
 126 (defvar nnfolder-nov-buffer-file-name nil)
 127
 128 \f
 129
 130 ;;; Interface functions
 131
 132 (nnoo-define-basics nnfolder)
 133
 134 (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old)
 135   (with-current-buffer nntp-server-buffer
 136     (erase-buffer)
 137     (let (article start stop num)
 138       (nnfolder-possibly-change-group group server)
 139       (when nnfolder-current-buffer
 140         (set-buffer nnfolder-current-buffer)
 141         (goto-char (point-min))
 142         (if (stringp (car articles))
 143             'headers
 144           (if (nnfolder-retrieve-headers-with-nov articles fetch-old)
 145               'nov
 146             (setq articles (gnus-sorted-intersection
 147                             ;; Is ARTICLES sorted?
 148                             (sort articles '<)
 149                             (nnfolder-existing-articles)))
 150             (while (setq article (pop articles))
 151               (set-buffer nnfolder-current-buffer)
 152               (cond ((nnfolder-goto-article article)
 153                      (setq start (point))
 154                      (setq stop (if (search-forward "\n\n" nil t)
 155                                     (1- (point))
 156                                   (point-max)))
 157                      (set-buffer nntp-server-buffer)
 158                      (insert (format "221 %d Article retrieved.\n" article))
 159                      (insert-buffer-substring nnfolder-current-buffer
 160                                               start stop)
 161                      (goto-char (point-max))
 162                      (insert ".\n"))
 163
 164                     ;; If we couldn't find this article, skip over ranges
 165                     ;; of missing articles so we don't search the whole file
 166                     ;; for each of them.
 167                     ((numberp article)
 168                      (setq start (point))
 169                      (and
 170                       ;; Check that we are either at BOF or after an
 171                       ;; article with a lower number.  We do this so we
 172                       ;; won't be confused by out-of-order article numbers,
 173                       ;; as caused by active file bogosity.
 174                       (cond
 175                        ((bobp))
 176                        ((search-backward (concat "\n" nnfolder-article-marker)
 177                                          nil t)
 178                         (goto-char (match-end 0))
 179                         (setq num (string-to-number
 180                                    (buffer-substring
 181                                     (point) (point-at-eol))))
 182                         (goto-char start)
 183                         (< num article)))
 184                       ;; Check that we are before an article with a
 185                       ;; higher number.
 186                       (search-forward (concat "\n" nnfolder-article-marker)
 187                                       nil t)
 188                       (progn
 189                         (setq num (string-to-number
 190                                    (buffer-substring
 191                                     (point) (point-at-eol))))
 192                         (> num article))
 193                       ;; Discard any article numbers before the one we're
 194                       ;; now looking at.
 195                       (while (and articles
 196                                   (< (car articles) num))
 197                         (setq articles (cdr articles))))
 198                      (goto-char start))))
 199             (set-buffer nntp-server-buffer)
 200             (nnheader-fold-continuation-lines)
 201             'headers))))))
 202
 203 (deffoo nnfolder-open-server (server &optional defs)
 204   (nnoo-change-server 'nnfolder server defs)
 205   (nnmail-activate 'nnfolder t)
 206   (gnus-make-directory nnfolder-directory)
 207   (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
 208     (and nnfolder-nov-directory
 209          (gnus-make-directory nnfolder-nov-directory)))
 210   (cond
 211    ((not (file-exists-p nnfolder-directory))
 212     (nnfolder-close-server)
 213     (nnheader-report 'nnfolder "Couldn't create directory: %s"
 214                      nnfolder-directory))
 215    ((not (file-directory-p (file-truename nnfolder-directory)))
 216     (nnfolder-close-server)
 217     (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory))
 218    (t
 219     (nnmail-activate 'nnfolder)
 220     (nnheader-report 'nnfolder "Opened server %s using directory %s"
 221                      server nnfolder-directory)
 222     t)))
 223
 224 (deffoo nnfolder-request-close ()
 225   (let ((alist nnfolder-buffer-alist))
 226     (while alist
 227       (nnfolder-close-group (caar alist) nil t)
 228       (setq alist (cdr alist))))
 229   (nnoo-close-server 'nnfolder)
 230   (setq nnfolder-buffer-alist nil
 231         nnfolder-group-alist nil))
 232
 233 (deffoo nnfolder-request-article (article &optional group server buffer)
 234   (nnfolder-possibly-change-group group server)
 235   (with-current-buffer nnfolder-current-buffer
 236     (goto-char (point-min))
 237     (when (nnfolder-goto-article article)
 238       (let (start stop)
 239         (setq start (point))
 240         (forward-line 1)
 241         (unless (and (nnmail-search-unix-mail-delim)
 242                      (forward-line -1))
 243           (goto-char (point-max)))
 244         (setq stop (point))
 245         (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
 246           (set-buffer nntp-server-buffer)
 247           (erase-buffer)
 248           (insert-buffer-substring nnfolder-current-buffer start stop)
 249           (goto-char (point-min))
 250           (while (looking-at "From ")
 251             (delete-char 5)
 252             (insert "X-From-Line: ")
 253             (forward-line 1))
 254           (if (numberp article)
 255               (cons nnfolder-current-group article)
 256             (goto-char (point-min))
 257             (cons nnfolder-current-group
 258                   (if (search-forward (concat "\n" nnfolder-article-marker)
 259                                       nil t)
 260                       (string-to-number (buffer-substring
 261                                       (point) (point-at-eol)))
 262                     -1))))))))
 263
 264 (deffoo nnfolder-request-group (group &optional server dont-check info)
 265   (nnfolder-possibly-change-group group server t)
 266   (save-excursion
 267     (cond ((not (assoc group nnfolder-group-alist))
 268            (nnheader-report 'nnfolder "No such group: %s" group))
 269           ((file-directory-p (nnfolder-group-pathname group))
 270            (nnheader-report 'nnfolder "%s is a directory"
 271                             (file-name-as-directory
 272                              (let ((nnmail-pathname-coding-system nil))
 273                                (nnfolder-group-pathname group)))))
 274           (dont-check
 275            (nnheader-report 'nnfolder "Selected group %s" group)
 276            t)
 277           (t
 278            (let* ((active (assoc group nnfolder-group-alist))
 279                   (group (car active))
 280                   (range (cadr active)))
 281              (cond
 282               ((null active)
 283                (nnheader-report 'nnfolder "No such group: %s" group))
 284               ((null nnfolder-current-group)
 285                (nnheader-report 'nnfolder "Empty group: %s" group))
 286               (t
 287                (nnheader-report 'nnfolder "Selected group %s" group)
 288                (nnheader-insert "211 %d %d %d %s\n"
 289                                 (1+ (- (cdr range) (car range)))
 290                                 (car range) (cdr range) group))))))))
 291
 292 (deffoo nnfolder-request-scan (&optional group server)
 293   (nnfolder-possibly-change-group nil server)
 294   (when nnfolder-get-new-mail
 295     (nnfolder-possibly-change-group group server)
 296     (nnmail-get-new-mail
 297      'nnfolder 'nnfolder-save-all-buffers
 298      nnfolder-directory group)))
 299
 300 (defun nnfolder-save-all-buffers ()
 301   (let ((bufs nnfolder-buffer-alist))
 302     (save-excursion
 303       (while bufs
 304         (if (not (gnus-buffer-live-p (nth 1 (car bufs))))
 305             (setq nnfolder-buffer-alist
 306                   (delq (car bufs) nnfolder-buffer-alist))
 307           (set-buffer (nth 1 (car bufs)))
 308           (nnfolder-save-buffer)
 309           (kill-buffer (current-buffer)))
 310         (setq bufs (cdr bufs))))))
 311
 312 ;; Don't close the buffer if we're not shutting down the server.  This way,
 313 ;; we can keep the buffer in the group buffer cache, and not have to grovel
 314 ;; over the buffer again unless we add new mail to it or modify it in some
 315 ;; way.
 316
 317 (deffoo nnfolder-close-group (group &optional server force)
 318   ;; Make sure we _had_ the group open.
 319   (when (or (assoc group nnfolder-buffer-alist)
 320             (equal group nnfolder-current-group))
 321     (let ((inf (assoc group nnfolder-buffer-alist)))
 322       (when inf
 323         (when (and nnfolder-current-group
 324                    nnfolder-current-buffer)
 325           (push (list nnfolder-current-group nnfolder-current-buffer)
 326                 nnfolder-buffer-alist))
 327         (setq nnfolder-buffer-alist
 328               (delq inf nnfolder-buffer-alist))
 329         (setq nnfolder-current-buffer (cadr inf)
 330               nnfolder-current-group (car inf))))
 331     (when (and nnfolder-current-buffer
 332                (buffer-name nnfolder-current-buffer))
 333       (with-current-buffer nnfolder-current-buffer
 334         ;; If the buffer was modified, write the file out now.
 335         (nnfolder-save-buffer)
 336         ;; If we're shutting the server down, we need to kill the
 337         ;; buffer and remove it from the open buffer list.  Or, of
 338         ;; course, if we're trying to minimize our space impact.
 339         (kill-buffer (current-buffer))
 340         (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist)
 341                                           nnfolder-buffer-alist)))))
 342   (setq nnfolder-current-group nil
 343         nnfolder-current-buffer nil)
 344   t)
 345
 346 (deffoo nnfolder-request-create-group (group &optional server args)
 347   (nnfolder-possibly-change-group nil server)
 348   (nnmail-activate 'nnfolder)
 349   (cond ((zerop (length group))
 350          (nnheader-report 'nnfolder "Invalid (empty) group name"))
 351         ((file-directory-p (nnfolder-group-pathname group))
 352          (nnheader-report 'nnfolder "%s is a directory"
 353                           (file-name-as-directory
 354                            (let ((nnmail-pathname-coding-system nil))
 355                              (nnfolder-group-pathname group)))))
 356         ((assoc group nnfolder-group-alist)
 357          t)
 358         (t
 359          (push (list group (cons 1 0)) nnfolder-group-alist)
 360          (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
 361          (save-current-buffer
 362            (nnfolder-read-folder group))
 363          t)))
 364
 365 (deffoo nnfolder-request-list (&optional server)
 366   (nnfolder-possibly-change-group nil server)
 367   (save-excursion
 368     (let ((nnmail-file-coding-system nnfolder-active-file-coding-system))
 369       (nnmail-find-file nnfolder-active-file)
 370       (setq nnfolder-group-alist (nnmail-get-active)))
 371     t))
 372
 373 (deffoo nnfolder-request-newgroups (date &optional server)
 374   (nnfolder-possibly-change-group nil server)
 375   (nnfolder-request-list server))
 376
 377 (deffoo nnfolder-request-list-newsgroups (&optional server)
 378   (nnfolder-possibly-change-group nil server)
 379   (save-excursion
 380     (let ((nnmail-file-coding-system nnfolder-file-coding-system))
 381       (nnmail-find-file nnfolder-newsgroups-file))))
 382
 383 ;; Return a list consisting of all article numbers existing in the
 384 ;; current folder.
 385
 386 (defun nnfolder-existing-articles ()
 387   (save-excursion
 388     (when nnfolder-current-buffer
 389       (set-buffer nnfolder-current-buffer)
 390       (goto-char (point-min))
 391       (let ((marker (concat "\n" nnfolder-article-marker))
 392             (number "[0-9]+")
 393             numbers)
 394         (while (and (search-forward marker nil t)
 395                     (re-search-forward number nil t))
 396           (let ((newnum (string-to-number (match-string 0))))
 397             (if (nnmail-within-headers-p)
 398                 (push newnum numbers))))
 399       ;; The article numbers are increasing, so this result is sorted.
 400         (nreverse numbers)))))
 401
 402 (autoload 'gnus-request-group "gnus-int")
 403 (declare-function gnus-request-create-group "gnus-int"
 404                   (group &optional gnus-command-method args))
 405
 406 (deffoo nnfolder-request-expire-articles (articles newsgroup
 407                                                    &optional server force)
 408   (nnfolder-possibly-change-group newsgroup server)
 409   (let ((is-old t)
 410         ;; The articles we have deleted so far.
 411         (deleted-articles nil)
 412         ;; The articles that really exist and will
 413         ;; be expired if they are old enough.
 414         (maybe-expirable
 415          (gnus-sorted-intersection articles (nnfolder-existing-articles)))
 416         target)
 417     (nnmail-activate 'nnfolder)
 418
 419     (with-current-buffer nnfolder-current-buffer
 420       ;; Since messages are sorted in arrival order and expired in the
 421       ;; same order, we can stop as soon as we find a message that is
 422       ;; too old.
 423       (while (and maybe-expirable is-old)
 424         (goto-char (point-min))
 425         (when (and (nnfolder-goto-article (car maybe-expirable))
 426                    (search-forward (concat "\n" nnfolder-article-marker)
 427                                    nil t))
 428           (forward-sexp)
 429           (when (setq is-old
 430                       (nnmail-expired-article-p
 431                        newsgroup
 432                        (buffer-substring
 433                         (point) (progn (end-of-line) (point)))
 434                        force nnfolder-inhibit-expiry))
 435             (setq target nnmail-expiry-target)
 436             (unless (eq target 'delete)
 437               (with-temp-buffer
 438                 (nnfolder-request-article (car maybe-expirable)
 439                                           newsgroup server (current-buffer))
 440                 (let ((nnfolder-current-directory nil))
 441                   (when (functionp target)
 442                     (setq target (funcall target newsgroup)))
 443                   (when (and target (not (eq target 'delete)))
 444                     (if (or (gnus-request-group target)
 445                             (gnus-request-create-group target))
 446                         (nnmail-expiry-target-group target newsgroup)
 447                       (setq target nil)))))
 448               (nnfolder-possibly-change-group newsgroup server))
 449             (when target
 450               (nnheader-message 5 "Deleting article %d in %s..."
 451                                 (car maybe-expirable) newsgroup)
 452               (nnfolder-delete-mail)
 453               (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
 454                 (nnfolder-nov-delete-article newsgroup (car maybe-expirable)))
 455               ;; Must remember which articles were actually deleted
 456               (push (car maybe-expirable) deleted-articles))))
 457         (setq maybe-expirable (cdr maybe-expirable)))
 458       (unless nnfolder-inhibit-expiry
 459         (nnheader-message 5 "Deleting articles...done"))
 460       (nnfolder-save-buffer)
 461       (nnfolder-adjust-min-active newsgroup)
 462       (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
 463       (nnfolder-save-all-buffers)
 464       (gnus-sorted-difference articles (nreverse deleted-articles)))))
 465
 466 (deffoo nnfolder-request-move-article (article group server accept-form
 467                                                &optional last move-is-internal)
 468   (save-excursion
 469     (let ((buf (get-buffer-create " *nnfolder move*"))
 470           result)
 471       (and
 472        (nnfolder-request-article article group server)
 473        (with-current-buffer buf
 474          (erase-buffer)
 475          (insert-buffer-substring nntp-server-buffer)
 476          (goto-char (point-min))
 477          (while (re-search-forward
 478                  (concat "^" nnfolder-article-marker)
 479                  (save-excursion (and (search-forward "\n\n" nil t) (point)))
 480                  t)
 481            (gnus-delete-line))
 482          (setq result (eval accept-form))
 483          (kill-buffer buf)
 484          result)
 485        (save-excursion
 486          (nnfolder-possibly-change-group group server)
 487          (set-buffer nnfolder-current-buffer)
 488          (goto-char (point-min))
 489          (when (nnfolder-goto-article article)
 490            (nnfolder-delete-mail))
 491          (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
 492            (nnfolder-nov-delete-article group article))
 493          (when last
 494            (nnfolder-save-buffer)
 495            (nnfolder-adjust-min-active group)
 496            (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))))
 497       result)))
 498
 499 (deffoo nnfolder-request-accept-article (group &optional server last)
 500   (save-excursion
 501     (nnfolder-possibly-change-group group server)
 502     (nnmail-check-syntax)
 503     (let ((buf (current-buffer))
 504           result art-group)
 505       (goto-char (point-min))
 506       (when (looking-at "X-From-Line: ")
 507         (replace-match "From ")
 508         (while (progn (forward-line) (looking-at "[ \t]"))
 509           (delete-char -1)))
 510       (with-temp-buffer
 511         (let ((nnmail-file-coding-system nnfolder-active-file-coding-system)
 512               (nntp-server-buffer (current-buffer)))
 513           (nnmail-find-file nnfolder-active-file)
 514           (setq nnfolder-group-alist (nnmail-parse-active))))
 515       (save-excursion
 516         (goto-char (point-min))
 517         (if (search-forward "\n\n" nil t)
 518             (forward-line -1)
 519           (goto-char (point-max)))
 520         (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
 521           (delete-region (point) (progn (forward-line 1) (point))))
 522         (when nnmail-cache-accepted-message-ids
 523           (nnmail-cache-insert (nnmail-fetch-field "message-id")
 524                                group
 525                                (nnmail-fetch-field "subject")
 526                                (nnmail-fetch-field "from")))
 527         (setq result (if (stringp group)
 528                          (list (cons group (nnfolder-active-number group)))
 529                        (setq art-group
 530                              (nnmail-article-group 'nnfolder-active-number))))
 531         (if (and (null result)
 532                  (yes-or-no-p "Moved to `junk' group; delete article? "))
 533             (setq result 'junk)
 534           (setq result
 535                 (car (nnfolder-save-mail result)))))
 536       (when last
 537         (save-excursion
 538           (nnfolder-possibly-change-folder (or (caar art-group) group))
 539           (nnfolder-save-buffer)
 540           (when nnmail-cache-accepted-message-ids
 541             (nnmail-cache-close))))
 542       (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
 543       (unless result
 544         (nnheader-report 'nnfolder "Couldn't store article"))
 545       result)))
 546
 547 (deffoo nnfolder-request-replace-article (article group buffer)
 548   (nnfolder-possibly-change-group group)
 549   (with-current-buffer buffer
 550     (goto-char (point-min))
 551     (if (not (looking-at "X-From-Line: "))
 552         (insert "From nobody " (current-time-string) "\n")
 553       (replace-match "From ")
 554       (forward-line 1)
 555       (while (looking-at "[ \t]")
 556         (delete-char -1)
 557         (forward-line 1)))
 558     (nnfolder-normalize-buffer)
 559     (set-buffer nnfolder-current-buffer)
 560     (goto-char (point-min))
 561     (if (not (nnfolder-goto-article article))
 562         nil
 563       (nnfolder-delete-mail)
 564       (insert-buffer-substring buffer)
 565       (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
 566         (with-current-buffer buffer
 567           (let ((headers (nnfolder-parse-head article
 568                                               (point-min) (point-max))))
 569             (with-current-buffer (nnfolder-open-nov group)
 570               (if (nnheader-find-nov-line article)
 571                   (delete-region (point) (progn (forward-line 1) (point))))
 572               (nnheader-insert-nov headers)))))
 573       (nnfolder-save-buffer)
 574       t)))
 575
 576 (deffoo nnfolder-request-delete-group (group &optional force server)
 577   (nnfolder-close-group group server t)
 578   ;; Delete all articles in GROUP.
 579   (if (not force)
 580       ()                                ; Don't delete the articles.
 581     ;; Delete the file that holds the group.
 582     (let ((data (nnfolder-group-pathname group))
 583           (nov (nnfolder-group-nov-pathname group)))
 584       (ignore-errors (delete-file data))
 585       (ignore-errors (delete-file nov))))
 586   ;; Remove the group from all structures.
 587   (setq nnfolder-group-alist
 588         (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
 589         nnfolder-current-group nil
 590         nnfolder-current-buffer nil)
 591   ;; Save the active file.
 592   (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
 593   t)
 594
 595 (deffoo nnfolder-request-rename-group (group new-name &optional server)
 596   (nnfolder-possibly-change-group group server)
 597   (with-current-buffer nnfolder-current-buffer
 598     (and (file-writable-p buffer-file-name)
 599          (ignore-errors
 600            (let ((new-file (nnfolder-group-pathname new-name)))
 601              (gnus-make-directory (file-name-directory new-file))
 602              (rename-file buffer-file-name new-file)
 603              (when (file-exists-p (nnfolder-group-nov-pathname group))
 604                (setq new-file (nnfolder-group-nov-pathname new-name))
 605                (gnus-make-directory (file-name-directory new-file))
 606                (rename-file (nnfolder-group-nov-pathname group) new-file)))
 607            t)
 608          ;; That went ok, so we change the internal structures.
 609          (let ((entry (assoc group nnfolder-group-alist)))
 610            (and entry (setcar entry new-name))
 611            (setq nnfolder-current-buffer nil
 612                  nnfolder-current-group nil)
 613            ;; Save the new group alist.
 614            (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
 615            ;; We kill the buffer instead of renaming it and stuff.
 616            (kill-buffer (current-buffer))
 617            t))))
 618
 619 (deffoo nnfolder-request-regenerate (server)
 620   (nnfolder-possibly-change-group nil server)
 621   (nnfolder-generate-active-file)
 622   t)
 623
 624 \f
 625 ;;; Internal functions.
 626
 627 (defun nnfolder-adjust-min-active (group)
 628   ;; Find the lowest active article in this group.
 629   (let* ((active (cadr (assoc group nnfolder-group-alist)))
 630          (marker (concat "\n" nnfolder-article-marker))
 631          (number "[0-9]+")
 632          (activemin (cdr active)))
 633     (with-current-buffer nnfolder-current-buffer
 634       (goto-char (point-min))
 635       (while (and (search-forward marker nil t)
 636                   (re-search-forward number nil t))
 637         (let ((newnum (string-to-number (match-string 0))))
 638           (if (nnmail-within-headers-p)
 639               (setq activemin (min activemin newnum)))))
 640       (setcar active activemin))))
 641
 642 (defun nnfolder-article-string (article)
 643   (if (numberp article)
 644       (concat "\n" nnfolder-article-marker (int-to-string article) " ")
 645     (concat "\nMessage-ID: " article)))
 646
 647 (defun nnfolder-goto-article (article)
 648   "Place point at the start of the headers of ARTICLE.
 649 ARTICLE can be an article number or a Message-ID.
 650 Returns t if successful, nil otherwise."
 651   (let ((art-string (nnfolder-article-string article))
 652         start found)
 653     ;; It is likely that we are at or before the delimiter line.
 654     ;; We therefore go to the end of the previous line, and start
 655     ;; searching from there.
 656     (beginning-of-line)
 657     (unless (bobp)
 658       (forward-char -1))
 659     (setq start (point))
 660     ;; First search forward.
 661     (while (and (setq found (search-forward art-string nil t))
 662                 (not (nnmail-within-headers-p))))
 663     ;; If unsuccessful, search backward from where we started,
 664     (unless found
 665       (goto-char start)
 666       (while (and (setq found (search-backward art-string nil t))
 667                   (not (nnmail-within-headers-p)))))
 668     (when found
 669       (nnmail-search-unix-mail-delim-backward))))
 670
 671 (defun nnfolder-delete-mail (&optional leave-delim)
 672   "Delete the message that point is in.
 673 If optional argument LEAVE-DELIM is t, then mailbox delimiter is not
 674 deleted.  Point is left where the deleted region was."
 675   (save-restriction
 676     (narrow-to-region
 677      (save-excursion
 678        ;; In case point is at the beginning of the message already.
 679        (forward-line 1)
 680        (nnmail-search-unix-mail-delim-backward)
 681        (if leave-delim (progn (forward-line 1) (point))
 682          (point)))
 683      (progn
 684        (forward-line 1)
 685        (if (nnmail-search-unix-mail-delim)
 686            (point)
 687          (point-max))))
 688     (run-hooks 'nnfolder-delete-mail-hook)
 689     (delete-region (point-min) (point-max))))
 690
 691 (defun nnfolder-possibly-change-group (group &optional server dont-check)
 692   ;; Change servers.
 693   (when (and server
 694              (not (nnfolder-server-opened server)))
 695     (nnfolder-open-server server))
 696   (unless (gnus-buffer-live-p nnfolder-current-buffer)
 697     (setq nnfolder-current-buffer nil
 698           nnfolder-current-group nil))
 699   ;; Change group.
 700   (let ((file-name-coding-system nnmail-pathname-coding-system))
 701     (when (and group
 702                (not (equal group nnfolder-current-group))
 703                (progn
 704                  (nnmail-activate 'nnfolder)
 705                  (and (assoc group nnfolder-group-alist)
 706                       (file-exists-p (nnfolder-group-pathname group)))))
 707       (if dont-check
 708           (setq nnfolder-current-group group
 709                 nnfolder-current-buffer nil)
 710         (let (inf file)
 711           ;; If we have to change groups, see if we don't already have
 712           ;; the folder in memory.  If we do, verify the modtime and
 713           ;; destroy the folder if needed so we can rescan it.
 714           (setq nnfolder-current-buffer
 715                 (nth 1 (assoc group nnfolder-buffer-alist)))
 716
 717           ;; If the buffer is not live, make sure it isn't in the
 718           ;; alist.  If it is live, verify that nobody else has
 719           ;; touched the file since last time.
 720           (when (and nnfolder-current-buffer
 721                      (not (gnus-buffer-live-p nnfolder-current-buffer)))
 722             (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
 723                   nnfolder-current-buffer nil))
 724
 725           (setq nnfolder-current-group group)
 726
 727           (when (or (not nnfolder-current-buffer)
 728                     (not (verify-visited-file-modtime
 729                           nnfolder-current-buffer)))
 730             (save-excursion
 731               (setq file (nnfolder-group-pathname group))
 732               ;; See whether we need to create the new file.
 733               (unless (file-exists-p file)
 734                 (gnus-make-directory (file-name-directory file))
 735                 (let ((nnmail-file-coding-system
 736                        (or nnfolder-file-coding-system-for-write
 737                            nnfolder-file-coding-system-for-write)))
 738                   (nnmail-write-region (point-min) (point-min)
 739                                        file t 'nomesg)))
 740               (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
 741                 (set-buffer nnfolder-current-buffer)
 742                 (push (list group nnfolder-current-buffer)
 743                       nnfolder-buffer-alist)))))))))
 744
 745 (defun nnfolder-save-mail (group-art-list)
 746   "Called narrowed to an article."
 747   (let* (save-list group-art)
 748     (goto-char (point-min))
 749     ;; The From line may have been quoted by movemail.
 750     (when (looking-at ">From")
 751       (delete-char 1))
 752     ;; This might come from somewhere else.
 753     (unless (looking-at "From ")
 754       (insert "From nobody " (current-time-string) "\n")
 755       (goto-char (point-min)))
 756     ;; Quote all "From " lines in the article.
 757     (forward-line 1)
 758     (let (case-fold-search)
 759       (while (re-search-forward "^From " nil t)
 760         (beginning-of-line)
 761         (insert "> ")))
 762     (setq save-list group-art-list)
 763     (nnmail-insert-lines)
 764     (nnmail-insert-xref group-art-list)
 765     (run-hooks 'nnmail-prepare-save-mail-hook)
 766     (run-hooks 'nnfolder-prepare-save-mail-hook)
 767
 768     ;; Insert the mail into each of the destination groups.
 769     (while (setq group-art (pop group-art-list))
 770       ;; Kill any previous newsgroup markers.
 771       (goto-char (point-min))
 772       (if (search-forward "\n\n" nil t)
 773           (forward-line -1)
 774         (goto-char (point-max)))
 775       (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
 776         (delete-region (1+ (point)) (progn (forward-line 2) (point))))
 777
 778       ;; Insert the new newsgroup marker.
 779       (nnfolder-insert-newsgroup-line group-art)
 780
 781       (save-excursion
 782         (let ((beg (point-min))
 783               (end (point-max))
 784               (obuf (current-buffer)))
 785           (nnfolder-possibly-change-folder (car group-art))
 786           (let ((buffer-read-only nil))
 787             (nnfolder-normalize-buffer)
 788             (insert-buffer-substring obuf beg end))
 789           (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
 790             (set-buffer obuf)
 791             (nnfolder-add-nov (car group-art) (cdr group-art)
 792                               (nnfolder-parse-head nil beg end))))))
 793
 794     ;; Did we save it anywhere?
 795     save-list))
 796
 797 (defun nnfolder-normalize-buffer ()
 798   "Make sure there are two newlines at the end of the buffer."
 799   (goto-char (point-max))
 800   (skip-chars-backward "\n")
 801   (delete-region (point) (point-max))
 802   (unless (bobp)
 803     (insert "\n\n")))
 804
 805 (defun nnfolder-insert-newsgroup-line (group-art)
 806   (save-excursion
 807     (goto-char (point-min))
 808     (unless (search-forward "\n\n" nil t)
 809       (goto-char (point-max))
 810       (insert "\n"))
 811     (forward-char -1)
 812     (insert (format (concat nnfolder-article-marker "%d   %s\n")
 813                     (cdr group-art) (message-make-date)))))
 814
 815 (defun nnfolder-active-number (group)
 816   ;; Find the next article number in GROUP.
 817   (let ((active (cadr (assoc group nnfolder-group-alist))))
 818     (if active
 819         (setcdr active (1+ (cdr active)))
 820       ;; This group is new, so we create a new entry for it.
 821       ;; This might be a bit naughty... creating groups on the drop of
 822       ;; a hat, but I don't know...
 823       (push (list group (setq active (cons 1 1)))
 824             nnfolder-group-alist))
 825     (cdr active)))
 826
 827 (defun nnfolder-possibly-change-folder (group)
 828   (let ((inf (assoc group nnfolder-buffer-alist)))
 829     (if (and inf
 830              (gnus-buffer-live-p (cadr inf)))
 831         (set-buffer (cadr inf))
 832       (when inf
 833         (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)))
 834       (when nnfolder-group-alist
 835         (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))
 836       (push (list group (nnfolder-read-folder group))
 837             nnfolder-buffer-alist))))
 838
 839 ;; This method has a problem if you've accidentally let the active
 840 ;; list get out of sync with the files.  This could happen, say, if
 841 ;; you've accidentally gotten new mail with something other than Gnus
 842 ;; (but why would _that_ ever happen? :-).  In that case, we will be
 843 ;; in the middle of processing the file, ready to add new X-Gnus
 844 ;; article number markers, and we'll run across a message with no ID
 845 ;; yet - the active list _may_not_ be ready for us yet.
 846
 847 ;; To handle this, I'm modifying this routine to maintain the maximum
 848 ;; ID seen so far, and when we hit a message with no ID, we will
 849 ;; _manually_ scan the rest of the message looking for any more,
 850 ;; possibly higher IDs.  We'll assume the maximum that we find is the
 851 ;; highest active.  Note that this shouldn't cost us much extra time
 852 ;; at all, but will be a lot less vulnerable to glitches between the
 853 ;; mbox and the active file.
 854
 855 (defun nnfolder-read-folder (group)
 856   (let* ((file (nnfolder-group-pathname group))
 857          (nov  (nnfolder-group-nov-pathname group))
 858          (buffer (set-buffer
 859                   (let ((nnheader-file-coding-system
 860                          nnfolder-file-coding-system))
 861                     (nnheader-find-file-noselect file t)))))
 862     (mm-enable-multibyte) ;; Use multibyte buffer for future copying.
 863     (buffer-disable-undo)
 864     (if (equal (cadr (assoc group nnfolder-scantime-alist))
 865                (nth 5 (file-attributes file)))
 866         ;; This looks up-to-date, so we don't do any scanning.
 867         (if (file-exists-p file)
 868             buffer
 869           (push (list group buffer) nnfolder-buffer-alist)
 870           (set-buffer-modified-p t)
 871           (nnfolder-save-buffer))
 872       ;; Parse the damn thing.
 873       (save-excursion
 874         (goto-char (point-min))
 875         ;; Remove any blank lines at the start.
 876         (while (eq (following-char) ?\n)
 877           (delete-char 1))
 878         (nnmail-activate 'nnfolder)
 879         ;; Read in the file.
 880         (let ((delim "^From ")
 881               (marker (concat "\n" nnfolder-article-marker))
 882               (number "[0-9]+")
 883               (active (or (cadr (assoc group nnfolder-group-alist))
 884                           (cons 1 0)))
 885               (scantime (assoc group nnfolder-scantime-alist))
 886               (minid most-positive-fixnum)
 887               maxid start end newscantime
 888               novbuf articles newnum
 889               buffer-read-only)
 890           (setq maxid (cdr active))
 891
 892           (unless (or gnus-nov-is-evil nnfolder-nov-is-evil
 893                       (and (file-exists-p nov)
 894                            (file-newer-than-file-p nov file)))
 895             (unless (file-exists-p nov)
 896               (gnus-make-directory (file-name-directory nov)))
 897             (with-current-buffer
 898                 (setq novbuf (nnfolder-open-nov group))
 899               (goto-char (point-min))
 900               (while (not (eobp))
 901                 (push (read novbuf) articles)
 902                 (forward-line 1))
 903               (setq articles (nreverse articles))))
 904           (goto-char (point-min))
 905
 906           ;; Anytime the active number is 1 or 0, it is suspect.  In
 907           ;; that case, search the file manually to find the active
 908           ;; number.  Or, of course, if we're being paranoid.  (This
 909           ;; would also be the place to build other lists from the
 910           ;; header markers, such as expunge lists, etc., if we ever
 911           ;; desired to abandon the active file entirely for mboxes.)
 912           (when (or nnfolder-ignore-active-file
 913                     novbuf
 914                     (< maxid 2))
 915             (while (and (search-forward marker nil t)
 916                         (looking-at number))
 917               (setq newnum (string-to-number (match-string 0)))
 918               (when (nnmail-within-headers-p)
 919                 (setq maxid (max maxid newnum)
 920                       minid (min minid newnum))
 921                 (when novbuf
 922                   (if (memq newnum articles)
 923                       (setq articles (delq newnum articles))
 924                     (let ((headers (nnfolder-parse-head newnum)))
 925                       (with-current-buffer novbuf
 926                         (nnheader-find-nov-line newnum)
 927                         (nnheader-insert-nov headers)))))))
 928             (when (and novbuf articles)
 929               (with-current-buffer novbuf
 930                 (dolist (article articles)
 931                   (when (nnheader-find-nov-line article)
 932                     (delete-region (point)
 933                                    (progn (forward-line 1) (point)))))))
 934             (setcar active (max 1 (min minid maxid)))
 935             (setcdr active (max maxid (cdr active)))
 936             (goto-char (point-min)))
 937
 938           ;; As long as we trust that the user will only insert
 939           ;; unmarked mail at the end, go to the end and search
 940           ;; backwards for the last marker.  Find the start of that
 941           ;; message, and begin to search for unmarked messages from
 942           ;; there.
 943           (when (not (or nnfolder-distrust-mbox
 944                          (< maxid 2)))
 945             (goto-char (point-max))
 946             (unless (re-search-backward marker nil t)
 947               (goto-char (point-min)))
 948             ;;(when (nnmail-search-unix-mail-delim)
 949             ;;  (goto-char (point-min)))
 950             )
 951
 952           ;; Keep track of the active number on our own, and insert it
 953           ;; back into the active list when we're done.  Also, prime
 954           ;; the pump to cut down on the number of searches we do.
 955           (unless (nnmail-search-unix-mail-delim)
 956             (goto-char (point-max)))
 957           (setq end (point-marker))
 958           (while (not (= end (point-max)))
 959             (setq start (marker-position end))
 960             (goto-char end)
 961            ;; There may be more than one "From " line, so we skip past
 962             ;; them.
 963             (while (looking-at delim)
 964               (forward-line 1))
 965             (set-marker end (if (nnmail-search-unix-mail-delim)
 966                                 (point)
 967                               (point-max)))
 968             (goto-char start)
 969             (when (not (search-forward marker end t))
 970               (narrow-to-region start end)
 971               (nnmail-insert-lines)
 972               (nnfolder-insert-newsgroup-line
 973                (cons nil
 974                      (setq newnum
 975                            (nnfolder-active-number group))))
 976               (when novbuf
 977                 (let ((headers (nnfolder-parse-head newnum (point-min)
 978                                                     (point-max))))
 979                   (with-current-buffer novbuf
 980                     (goto-char (point-max))
 981                     (nnheader-insert-nov headers))))
 982               (widen)))
 983
 984           (set-marker end nil)
 985           ;; Make absolutely sure that the active list reflects
 986           ;; reality!
 987           (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
 988
 989           ;; Set the scantime for this group.
 990           (setq newscantime (visited-file-modtime))
 991           (if scantime
 992               (setcdr scantime (list newscantime))
 993             (push (list group newscantime)
 994                   nnfolder-scantime-alist))
 995           ;; Save nov.
 996           (when novbuf
 997             (nnfolder-save-nov))
 998           (current-buffer))))))
 999
1000 (defun nnfolder-recursive-directory-files (dir prefix)
1001   (let ((files nil))
1002     (dolist (file (directory-files dir))
1003       (cond
1004        ((or (file-symlink-p (expand-file-name file dir))
1005             (member file '("." "..")))
1006         ;; Ignore
1007         )
1008        ((file-directory-p (expand-file-name file dir))
1009         (setq files (nconc (nnfolder-recursive-directory-files
1010                             (expand-file-name file dir)
1011                             (if prefix
1012                                 (concat prefix "." (directory-file-name file))
1013                               (file-name-nondirectory file)))
1014                            files)))
1015        ((file-regular-p (expand-file-name file dir))
1016         (push (if prefix
1017                   (concat prefix "." file)
1018                 file)
1019               files))))
1020     files))
1021
1022 ;;;###autoload
1023 (defun nnfolder-generate-active-file ()
1024   "Look for mbox folders in the nnfolder directory and make them into groups.
1025 This command does not work if you use short group names."
1026   (interactive)
1027   (nnmail-activate 'nnfolder)
1028   (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
1029     (dolist (file (directory-files (or nnfolder-nov-directory
1030                                        nnfolder-directory)
1031                                    t
1032                                    (concat
1033                                     (regexp-quote nnfolder-nov-file-suffix)
1034                                     "$")))
1035       (when (not (message-mail-file-mbox-p file))
1036         (ignore-errors
1037           (delete-file file)))))
1038     (dolist (file (if nnmail-use-long-file-names
1039                       (directory-files nnfolder-directory)
1040                     (nnfolder-recursive-directory-files
1041                      nnfolder-directory nil)))
1042       (when (and (not (backup-file-name-p file))
1043                  (message-mail-file-mbox-p
1044                   (nnfolder-group-pathname file)))
1045         (let ((oldgroup (assoc file nnfolder-group-alist)))
1046           (if oldgroup
1047               (nnheader-message 5 "Refreshing group %s..." file)
1048             (nnheader-message 5 "Adding group %s..." file))
1049           (if oldgroup
1050               (setq nnfolder-group-alist
1051                     (delq oldgroup (copy-sequence nnfolder-group-alist))))
1052           (push (list file (cons 1 0)) nnfolder-group-alist)
1053           (nnfolder-possibly-change-folder file)
1054           (nnfolder-possibly-change-group file)
1055           (nnfolder-close-group file))))
1056     (nnheader-message 5 ""))
1057
1058 (defun nnfolder-group-pathname (group)
1059   "Make file name for GROUP."
1060   (setq group
1061         (encode-coding-string group nnmail-pathname-coding-system))
1062   (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
1063     ;; If this file exists, we use it directly.
1064     (if (or nnmail-use-long-file-names
1065             (file-exists-p (concat dir group)))
1066         (concat dir group)
1067       ;; If not, we translate dots into slashes.
1068       (concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
1069
1070 (defun nnfolder-group-nov-pathname (group)
1071   "Make pathname for GROUP NOV."
1072   (let ((nnfolder-directory
1073          (or nnfolder-nov-directory nnfolder-directory)))
1074     (concat (nnfolder-group-pathname group) nnfolder-nov-file-suffix)))
1075
1076 (defvar copyright-update)
1077
1078 (defun nnfolder-save-buffer ()
1079   "Save the buffer."
1080   (let ((delete-old-versions t))
1081     (when (buffer-modified-p)
1082       (run-hooks 'nnfolder-save-buffer-hook)
1083       (gnus-make-directory (file-name-directory (buffer-file-name)))
1084       (let ((coding-system-for-write
1085              (or nnfolder-file-coding-system-for-write
1086                  nnfolder-file-coding-system)))
1087         (set (make-local-variable 'copyright-update) nil)
1088         (save-buffer)))
1089     (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
1090       (nnfolder-save-nov))))
1091
1092 (defun nnfolder-save-active (group-alist active-file)
1093   (let ((nnmail-active-file-coding-system
1094          (or nnfolder-active-file-coding-system-for-write
1095              nnfolder-active-file-coding-system)))
1096     (nnmail-save-active group-alist active-file)))
1097
1098 (defun nnfolder-open-nov (group)
1099   (or (cdr (assoc group nnfolder-nov-buffer-alist))
1100       (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group))))
1101         (with-current-buffer buffer
1102           (set (make-local-variable 'nnfolder-nov-buffer-file-name)
1103                (nnfolder-group-nov-pathname group))
1104           (erase-buffer)
1105           (when (file-exists-p nnfolder-nov-buffer-file-name)
1106             (nnheader-insert-file-contents nnfolder-nov-buffer-file-name)))
1107         (push (cons group buffer) nnfolder-nov-buffer-alist)
1108         buffer)))
1109
1110 (defun nnfolder-save-nov ()
1111   (save-excursion
1112     (while nnfolder-nov-buffer-alist
1113       (when (buffer-name (cdar nnfolder-nov-buffer-alist))
1114         (set-buffer (cdar nnfolder-nov-buffer-alist))
1115         (when (buffer-modified-p)
1116           (gnus-make-directory (file-name-directory
1117                                 nnfolder-nov-buffer-file-name))
1118           (nnmail-write-region 1 (point-max) nnfolder-nov-buffer-file-name
1119                                nil 'nomesg))
1120         (set-buffer-modified-p nil)
1121         (kill-buffer (current-buffer)))
1122       (setq nnfolder-nov-buffer-alist (cdr nnfolder-nov-buffer-alist)))))
1123
1124 (defun nnfolder-nov-delete-article (group article)
1125   (with-current-buffer (nnfolder-open-nov group)
1126     (when (nnheader-find-nov-line article)
1127       (delete-region (point) (progn (forward-line 1) (point))))
1128     t))
1129
1130 (defun nnfolder-retrieve-headers-with-nov (articles &optional fetch-old)
1131   (if (or gnus-nov-is-evil nnfolder-nov-is-evil)
1132       nil
1133     (let ((nov (nnfolder-group-nov-pathname nnfolder-current-group)))
1134       (when (file-exists-p nov)
1135         (with-current-buffer nntp-server-buffer
1136           (erase-buffer)
1137           (nnheader-insert-file-contents nov)
1138           (if (and fetch-old
1139                    (not (numberp fetch-old)))
1140               t                         ; Don't remove anything.
1141             (nnheader-nov-delete-outside-range
1142              (if fetch-old (max 1 (- (car articles) fetch-old))
1143                (car articles))
1144              (car (last articles)))
1145             t))))))
1146
1147 (defun nnfolder-parse-head (&optional number b e)
1148   "Parse the head of the current buffer."
1149   (let ((buf (current-buffer))
1150         chars)
1151     (save-excursion
1152       (unless b
1153         (setq b (if (nnmail-search-unix-mail-delim-backward)
1154                     (point) (point-min)))
1155         (forward-line 1)
1156         (setq e (if (nnmail-search-unix-mail-delim)
1157                     (point) (point-max))))
1158       (setq chars (- e b))
1159       (unless (zerop chars)
1160         (goto-char b)
1161         (if (search-forward "\n\n" e t) (setq e (1- (point)))))
1162       (with-temp-buffer
1163         (insert-buffer-substring buf b e)
1164         (let ((headers (nnheader-parse-naked-head)))
1165           (mail-header-set-chars headers chars)
1166           (mail-header-set-number headers number)
1167           headers)))))
1168
1169 (defun nnfolder-add-nov (group article headers)
1170   "Add a nov line for the GROUP base."
1171   (with-current-buffer (nnfolder-open-nov group)
1172     (goto-char (point-max))
1173     (mail-header-set-number headers article)
1174     (nnheader-insert-nov headers)))
1175
1176 (provide 'nnfolder)
1177
1178 ;;; nnfolder.el ends here