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

   1 ;;; nnml.el --- mail spool 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 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
  27
  28 ;;; Code:
  29
  30 (require 'nnheader)
  31 (require 'rmail)
  32 (require 'nnmail)
  33
  34 (defvar nnml-directory "~/Mail/"
  35   "*Mail directory.")
  36
  37 (defvar nnml-active-file (concat nnml-directory "active")
  38   "*Mail active file.")
  39
  40 (defvar nnml-newsgroups-file (concat nnml-directory "newsgroups")
  41   "*Mail newsgroups description file.")
  42
  43 (defvar nnml-nov-is-evil nil
  44   "If non-nil, Gnus will never generate and use nov databases for mail groups.
  45 Using nov databases will speed up header fetching considerably.
  46 This variable shouldn't be flipped much. If you have, for some reason,
  47 set this to t, and want to set it to nil again, you should always run
  48 the `nnml-generate-nov-databases' command. The function will go
  49 through all nnml directories and generate nov databases for them
  50 all. This may very well take some time.")
  51
  52 (defvar nnml-large-newsgroup 50
  53   "*The number of the articles which indicates a large newsgroup.
  54 If the number of the articles is greater than the value, verbose
  55 messages will be shown to indicate the current status.")
  56
  57 \f
  58
  59 (defconst nnml-version "nnml 0.2"
  60   "nnml version.")
  61
  62 (defvar nnml-current-directory nil
  63   "Current news group directory.")
  64
  65 (defvar nnml-status-string "")
  66
  67 (defvar nnml-nov-buffer-alist nil)
  68
  69 \f
  70
  71 ;;; Interface functions.
  72
  73 (defun nnml-retrieve-headers (sequence &optional newsgroup server)
  74   "Retrieve the headers for the articles in SEQUENCE.
  75 Newsgroup must be selected before calling this function."
  76   (save-excursion
  77     (set-buffer nntp-server-buffer)
  78     (erase-buffer)
  79     (let ((file nil)
  80           (number (length sequence))
  81           (count 0)
  82           beg article)
  83       (nnml-possibly-change-directory newsgroup)
  84       (if (nnml-retrieve-header-with-nov sequence)
  85           'nov
  86         (while sequence
  87           (setq article (car sequence))
  88           (setq file
  89                 (concat nnml-current-directory (prin1-to-string article)))
  90           (if (and (file-exists-p file)
  91                    (not (file-directory-p file)))
  92               (progn
  93                 (insert (format "221 %d Article retrieved.\n" article))
  94                 (setq beg (point))
  95                 (insert-file-contents file)
  96                 (goto-char beg)
  97                 (if (search-forward "\n\n" nil t)
  98                     (forward-char -1)
  99                   (goto-char (point-max))
 100                   (insert "\n\n"))
 101                 (insert ".\n")
 102                 (delete-region (point) (point-max))))
 103           (setq sequence (cdr sequence))
 104           (setq count (1+ count))
 105           (and (numberp nnml-large-newsgroup)
 106                (> number nnml-large-newsgroup)
 107                (zerop (% count 20))
 108                (message "NNML: Receiving headers... %d%%"
 109                         (/ (* count 100) number))))
 110
 111         (and (numberp nnml-large-newsgroup)
 112              (> number nnml-large-newsgroup)
 113              (message "NNML: Receiving headers... done"))
 114
 115         ;; Fold continuation lines.
 116         (goto-char 1)
 117         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 118           (replace-match " " t t))
 119         'headers))))
 120
 121 (defun nnml-open-server (host &optional service)
 122   "Open news server on HOST.
 123 If HOST is nil, use value of environment variable `NNTPSERVER'.
 124 If optional argument SERVICE is non-nil, open by the service name."
 125   (let ((host (or host (getenv "NNTPSERVER"))))
 126     (setq nnml-status-string "")
 127     (nnmail-open-server-internal host service)))
 128
 129 (defun nnml-close-server (&optional server)
 130   "Close news server."
 131   (nnml-close-server-internal))
 132
 133 (fset 'nnml-request-quit (symbol-function 'nnml-close-server))
 134
 135 (defun nnml-server-opened (&optional server)
 136   "Return server process status, T or NIL.
 137 If the stream is opened, return T, otherwise return NIL."
 138   (and nntp-server-buffer
 139        (get-buffer nntp-server-buffer)))
 140
 141 (defun nnml-status-message ()
 142   "Return server status response as string."
 143   nnml-status-string)
 144
 145 (defun nnml-request-article (id &optional newsgroup server buffer)
 146   "Select article by message ID (or number)."
 147   (nnml-possibly-change-directory newsgroup)
 148   (let ((file (if (stringp id)
 149                   nil
 150                 (concat nnml-current-directory (prin1-to-string id))))
 151         (nntp-server-buffer (or buffer nntp-server-buffer)))
 152     (if (and (stringp file)
 153              (file-exists-p file)
 154              (not (file-directory-p file)))
 155         (save-excursion
 156           (nnml-find-file file)))))
 157
 158 (defun nnml-request-group (group &optional server dont-check)
 159   "Select news GROUP."
 160   (if (not dont-check)
 161       (nnml-get-new-mail))
 162   (let ((pathname (nnml-article-pathname group))
 163         dir)
 164     (if (file-directory-p pathname)
 165         (progn
 166           (setq nnml-current-directory pathname)
 167           (if (not dont-check)
 168               (progn
 169                 (setq dir
 170                       (sort
 171                        (mapcar
 172                         (function
 173                          (lambda (name)
 174                            (string-to-int name)))
 175                         (directory-files pathname nil "^[0-9]+$" t))
 176                        '<))
 177                 (save-excursion
 178                   (set-buffer nntp-server-buffer)
 179                   (erase-buffer)
 180                   (if dir
 181                       (insert (format "211 %d %d %d %s\n" (length dir)
 182                                       (car dir)
 183                                       (progn (while (cdr dir)
 184                                                (setq dir (cdr dir)))
 185                                              (car dir))
 186                                       group))
 187                     (insert (format "211 0 1 0 %s\n" group))))))
 188           t))))
 189
 190 (defun nnml-request-list (&optional server)
 191   "List active newsgoups."
 192   (save-excursion
 193     (nnml-find-file nnml-active-file)))
 194
 195 (defun nnml-request-list-newsgroups (&optional server)
 196   "List newsgroups (defined in NNTP2)."
 197   (save-excursion
 198     (nnml-find-file nnml-newsgroups-file)))
 199
 200 (defun nnml-request-post (&optional server)
 201   "Post a new news in current buffer."
 202   (mail-send-and-exit nil))
 203
 204 (fset 'nnml-request-post-buffer 'nnmail-request-post-buffer)
 205
 206 (defun nnml-request-expire-articles (articles newsgroup &optional server force)
 207   "Expire all articles in the ARTICLES list in group GROUP.
 208 The list of unexpired articles will be returned (ie. all articles that
 209 were too fresh to be expired).
 210 If FORCE is non-nil, ARTICLES will be deleted whether they are old or not."
 211   (nnml-possibly-change-directory newsgroup)
 212   (let* ((days (or (and nnmail-expiry-wait-function
 213                         (funcall nnmail-expiry-wait-function newsgroup))
 214                    nnmail-expiry-wait))
 215          (cur-time (current-time))
 216          (day-sec (* 24 60 60 days))
 217          (day-time (list nil nil))
 218          mod-time article rest)
 219     (setcar day-time (/ day-sec 65536))
 220     (setcar (cdr day-time) (- day-sec (* (car day-time) 65536)))
 221     (if (< (car (cdr cur-time)) (car (cdr day-time)))
 222         (progn
 223           (setcar day-time (+ 1 (- (car cur-time) (car day-time))))
 224           (setcar (cdr day-time) (- (+ 65536 (car (cdr cur-time)))
 225                                     (car (cdr day-time)))))
 226       (setcar day-time (- (car cur-time) (car day-time)))
 227       (setcar (cdr day-time) (- (car (cdr cur-time)) (car (cdr day-time)))))
 228     (while articles
 229       (setq article (concat nnml-current-directory (int-to-string
 230                                                       (car articles))))
 231       (if (setq mod-time (nth 5 (file-attributes article)))
 232           (if (or force
 233                   (< (car mod-time) (car day-time))
 234                   (and (= (car mod-time) (car day-time))
 235                        (< (car (cdr mod-time)) (car (cdr day-time)))))
 236               (progn
 237                 (message "Deleting %s..." article)
 238                 (condition-case ()
 239                     (delete-file article)
 240                   (file-error nil))
 241                 (nnml-nov-delete-article newsgroup (car articles)))
 242             (setq rest (cons (car articles) rest))))
 243       (setq articles (cdr articles)))
 244     (nnml-save-nov)
 245     rest))
 246
 247 (defun nnml-request-move-article (article group server accept-form)
 248   (let ((buf (get-buffer-create " *nnml move*"))
 249         result)
 250     (and
 251      (nnml-request-article article group server)
 252      (save-excursion
 253        (set-buffer buf)
 254        (insert-buffer-substring nntp-server-buffer)
 255        (setq result (eval accept-form))
 256        (kill-buffer (current-buffer))
 257        result)
 258      (and (condition-case ()
 259               (delete-file (concat nnml-current-directory
 260                                    (int-to-string article)))
 261             (file-error nil))
 262           (nnml-nov-delete-article group article)
 263           (nnml-save-nov)))
 264     result))
 265
 266 (defun nnml-request-accept-article (group)
 267   (let (result)
 268     (if (stringp group)
 269         (and
 270          (nnml-get-active)
 271          ;; We trick the choosing function into believing that only one
 272          ;; group is availiable.
 273          (let ((nnmail-split-methods '(group "")))
 274            (setq result
 275                  (cons group (nnml-choose-mail (point-min) (point-max)))))
 276          (nnml-save-active))
 277       (and
 278        (nnml-get-active)
 279        (setq result (nnml-choose-mail (point-min) (point-max)))
 280        (nnml-save-active)))
 281     result))
 282
 283 \f
 284 ;;; Low-Level Interface
 285
 286 (defun nnml-retrieve-header-with-nov (articles)
 287   (if nnml-nov-is-evil
 288       nil
 289     (let ((first (car articles))
 290           (last (progn (while (cdr articles) (setq articles (cdr articles)))
 291                        (car articles)))
 292           (nov (concat nnml-current-directory ".nov")))
 293       (if (file-exists-p nov)
 294           (save-excursion
 295             (set-buffer nntp-server-buffer)
 296             (erase-buffer)
 297             (insert-file-contents nov)
 298             (goto-char 1)
 299             (while (and (not (eobp)) (< first (read (current-buffer))))
 300               (forward-line 1))
 301             (beginning-of-line)
 302             (if (not (eobp)) (delete-region 1 (point)))
 303             (while (and (not (eobp)) (>= last (read (current-buffer))))
 304               (forward-line 1))
 305             (beginning-of-line)
 306             (if (not (eobp)) (delete-region (point) (point-max)))
 307             t)))))
 308
 309 (defun nnml-open-server-internal (host &optional service)
 310   "Open connection to news server on HOST by SERVICE."
 311   (save-excursion
 312     ;; Initialize communication buffer.
 313     (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
 314     (set-buffer nntp-server-buffer)
 315     (buffer-disable-undo (current-buffer))
 316     (erase-buffer)
 317     (kill-all-local-variables)
 318     (setq case-fold-search t)           ;Should ignore case.
 319     t))
 320
 321 (defun nnml-close-server-internal ()
 322   "Close connection to news server."
 323   nil)
 324
 325 (defun nnml-find-file (file)
 326   "Insert FILE in server buffer safely."
 327   (set-buffer nntp-server-buffer)
 328   (erase-buffer)
 329   (condition-case ()
 330       (progn (insert-file-contents file) t)
 331     (file-error nil)))
 332
 333 (defun nnml-possibly-change-directory (newsgroup)
 334   (if newsgroup
 335       (let ((pathname (nnml-article-pathname newsgroup)))
 336         (if (file-directory-p pathname)
 337             (setq nnml-current-directory pathname)
 338           (error "No such newsgroup: %s" newsgroup)))))
 339
 340 (defun nnml-article-pathname (group)
 341   "Make pathname for GROUP."
 342   (concat (file-name-as-directory (expand-file-name nnml-directory))
 343           (nnml-replace-chars-in-string group ?. ?/) "/"))
 344
 345 (defun nnml-replace-chars-in-string (string from to)
 346   "Replace characters in STRING from FROM to TO."
 347   (let ((string (substring string 0))   ;Copy string.
 348         (len (length string))
 349         (idx 0))
 350     ;; Replace all occurrences of FROM with TO.
 351     (while (< idx len)
 352       (if (= (aref string idx) from)
 353           (aset string idx to))
 354       (setq idx (1+ idx)))
 355     string))
 356
 357 (defun nnml-create-directories ()
 358   (let ((methods nnmail-split-methods)
 359         dir dirs)
 360     (while methods
 361       (setq dir (nnml-article-pathname (car (car methods))))
 362       (while (not (file-directory-p dir))
 363         (setq dirs (cons dir dirs))
 364         (setq dir (file-name-directory (directory-file-name dir))))
 365       (while dirs
 366         (if (make-directory (directory-file-name (car dirs)))
 367             (error "Could not create directory %s" (car dirs)))
 368         (message "Creating mail directory %s" (car dirs))
 369         (setq dirs (cdr dirs)))
 370       (setq methods (cdr methods)))))
 371
 372 ;; Most of this function was taken from rmail.el
 373 (defun nnml-move-inbox ()
 374   (let ((inbox (expand-file-name nnmail-spool-file))
 375         tofile errors)
 376     (setq tofile (make-temp-name
 377                   (expand-file-name (concat nnml-directory "Incoming"))))
 378     (unwind-protect
 379         (save-excursion
 380           (setq errors (generate-new-buffer " *nnml loss*"))
 381           (buffer-disable-undo errors)
 382           (call-process
 383            (expand-file-name "movemail" exec-directory)
 384            nil errors nil inbox tofile)
 385           (if (not (buffer-modified-p errors))
 386               ;; No output => movemail won
 387               nil
 388             (set-buffer errors)
 389             (subst-char-in-region (point-min) (point-max) ?\n ?\  )
 390             (goto-char (point-max))
 391             (skip-chars-backward " \t")
 392             (delete-region (point) (point-max))
 393             (goto-char (point-min))
 394             (if (looking-at "movemail: ")
 395                 (delete-region (point-min) (match-end 0)))
 396             (error (concat "movemail: "
 397                            (buffer-substring (point-min)
 398                                              (point-max)))))))
 399     (if (buffer-name errors)
 400         (kill-buffer errors))
 401     tofile))
 402
 403 (defvar nnml-newsgroups nil)
 404
 405 (defun nnml-get-active ()
 406   (let ((methods nnmail-split-methods))
 407     (setq nnml-newsgroups nil)
 408     (if (nnml-request-list)
 409         (save-excursion
 410           (set-buffer (get-buffer-create " *nntpd*"))
 411           (goto-char 1)
 412           (while (re-search-forward
 413                   "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
 414             (setq nnml-newsgroups
 415                   (cons (list (buffer-substring (match-beginning 1)
 416                                                 (match-end 1))
 417                               (cons (string-to-int
 418                                      (buffer-substring (match-beginning 3)
 419                                                        (match-end 3)))
 420                                     (string-to-int
 421                                      (buffer-substring (match-beginning 2)
 422                                                        (match-end 2)))))
 423                         nnml-newsgroups)))))
 424     (while methods
 425       (if (not (assoc (car (car methods)) nnml-newsgroups))
 426           (setq nnml-newsgroups
 427                 (cons (list (car (car methods)) (cons 1 0))
 428                       nnml-newsgroups)))
 429       (setq methods (cdr methods)))
 430     t))
 431
 432 (defun nnml-save-active ()
 433   (let ((groups nnml-newsgroups)
 434         group)
 435     (save-excursion
 436       (set-buffer (get-buffer-create " *nnml*"))
 437       (buffer-disable-undo (current-buffer))
 438       (erase-buffer)
 439       (while groups
 440         (setq group (car groups))
 441         (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) )
 442                         (car (car (cdr group)))))
 443         (setq groups (cdr groups)))
 444       (write-region 1 (point-max) (expand-file-name nnml-active-file) nil
 445                     'nomesg)
 446       (kill-buffer (current-buffer)))))
 447
 448 (defun nnml-split-incoming (incoming)
 449   "Go through the entire INCOMING file and pick out each individual mail."
 450   (let (start)
 451     (nnml-get-active)
 452     (save-excursion
 453       (set-buffer (get-buffer-create "*(ding) Gnus mail*"))
 454       (buffer-disable-undo (current-buffer))
 455       (erase-buffer)
 456       (insert-file-contents incoming)
 457       (goto-char 1)
 458       (save-excursion
 459         (run-hooks 'nnmail-prepare-incoming-hook))
 460       ;; Go to the beginning of the first mail...
 461       (if (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t)
 462                (goto-char (match-beginning 0)))
 463           ;; and then carry on until the bitter end.
 464           (while (not (eobp))
 465             (setq start (point))
 466             ;; Skip all the headers in case there are mode "From "s...
 467             (if (not (search-forward "\n\n" nil t))
 468                 (forward-line 1))
 469             (if (re-search-forward
 470                  (concat "^" rmail-unix-mail-delimiter) nil t)
 471                 (goto-char (match-beginning 0))
 472               (goto-char (point-max)))
 473             (nnml-choose-mail start (point))))
 474       (kill-buffer (current-buffer)))))
 475
 476 ;; Mail crossposts syggested by Brian Edmonds <edmonds@cs.ubc.ca>.
 477 (defun nnml-article-group (beg end)
 478   (let ((methods nnmail-split-methods)
 479         (obuf (current-buffer))
 480         found group-art)
 481   (save-excursion
 482     ;; Find headers.
 483     (goto-char beg)
 484     (setq end (if (search-forward "\n\n" end t) (point) end))
 485     (set-buffer (get-buffer-create " *nnml work*"))
 486     (buffer-disable-undo (current-buffer))
 487     (erase-buffer)
 488     ;; Copy the headers into the work buffer.
 489     (insert-buffer-substring obuf beg end)
 490     ;; Fold continuation lines.
 491     (goto-char (point-min))
 492     (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 493       (replace-match " " t t))
 494     ;; Go throught the split methods to find a match.
 495     (while (and methods (or nnmail-crosspost (not group-art)))
 496       (goto-char (point-max))
 497       (if (or (cdr methods)
 498               (not (string= "" (nth 1 (car methods)))))
 499           (if (and (re-search-backward (car (cdr (car methods))) nil t)
 500                    ;; Don't enter the article into the same group twice.
 501                    (not (memq (car (car methods)) group-art)))
 502               (setq group-art
 503                     (cons
 504                      (cons (car (car methods))
 505                            (nnml-active-number (car (car methods))))
 506                      group-art)))
 507         (or group-art
 508             (setq group-art
 509                   (list (cons (car (car methods))
 510                               (nnml-active-number (car (car methods))))))))
 511       (setq methods (cdr methods)))
 512     group-art)))
 513
 514 (defun nnml-choose-mail (beg end)
 515   "Find out what mail group the mail between BEG and END belongs in."
 516   (let ((group-art (nreverse (nnml-article-group beg end)))
 517         chars nov-line lines hbeg hend)
 518     (save-excursion
 519       (save-restriction
 520         (narrow-to-region beg end)
 521         ;; First fix headers.
 522         (goto-char (point-min))
 523         (save-excursion
 524           (save-restriction
 525             (narrow-to-region (point)
 526                               (progn (search-forward "\n\n" nil t)
 527                                      (setq chars (- (point-max) (point)))
 528                                      (setq lines (- (count-lines
 529                                                      (point) (point-max)) 1))
 530                                      (1- (point))))
 531             ;; Insert Lines.
 532             (if (not (save-excursion (re-search-backward "^Lines:" beg t)))
 533                 (insert (format "Lines: %d\n" lines)))
 534             ;; Make an Xref header.
 535             (save-excursion
 536               (goto-char (point-max))
 537               (if (re-search-backward "^Xref:" nil t)
 538                   (delete-region (match-beginning 0)
 539                                  (progn (forward-line 1) (point)))))
 540             (insert (format "Xref: %s" (system-name)))
 541             (let ((ga group-art))
 542               (while ga
 543                 (insert (format " %s:%d" (car (car ga)) (cdr (car ga))))
 544                 (setq ga (cdr ga))))
 545             (insert "\n")
 546             (setq hbeg (point-min))
 547             (setq hend (point-max))))
 548         ;; We save the article in all the newsgroups it belongs in.
 549         (let ((ga group-art)
 550               first)
 551           (while ga
 552             (let ((file (concat (nnml-article-pathname
 553                                  (car (car ga)))
 554                                 (int-to-string (cdr (car ga))))))
 555               (if first
 556                   ;; It was already saved, so we just make a hard link.
 557                   (add-name-to-file first file t)
 558                 ;; Save the article.
 559                 (write-region (point-min) (point-max) file nil nil)
 560                 (setq first file)))
 561             (setq ga (cdr ga))))
 562         ;; Generate a nov line for this article. We generate the nov
 563         ;; line after saving, because nov generation destroys the
 564         ;; header.
 565         (save-excursion
 566           (save-restriction
 567             (narrow-to-region hbeg hend)
 568             (setq nov-line (nnml-make-nov-line chars))))
 569         ;; Output the nov line to all nov databases that should have it.
 570         (let ((ga group-art))
 571           (while ga
 572             (nnml-add-nov (car (car ga)) (cdr (car ga)) nov-line)
 573             (setq ga (cdr ga))))
 574         group-art))))
 575
 576 (defun nnml-active-number (group)
 577   "Compute the next article number in GROUP."
 578   (let ((active (car (cdr (assoc group nnml-newsgroups)))))
 579     (setcdr active (1+ (cdr active)))
 580     (let (file)
 581       (while (file-exists-p
 582               (setq file (concat (nnml-article-pathname group)
 583                                  (int-to-string (cdr active)))))
 584         (setcdr active (1+ (cdr active)))))
 585     (cdr active)))
 586
 587 (defun nnml-get-new-mail ()
 588   "Read new incoming mail."
 589   (let (incoming)
 590     (nnml-create-directories)
 591     (if (and (file-exists-p nnmail-spool-file)
 592              (> (nth 7 (file-attributes nnmail-spool-file)) 0))
 593         (progn
 594           (message "nnml: Reading incoming mail...")
 595           (setq incoming (nnml-move-inbox))
 596           (nnml-split-incoming incoming)
 597           (nnml-save-active)
 598           (nnml-save-nov)
 599           (run-hooks 'nnmail-read-incoming-hook)
 600 ;;         (delete-file incoming)
 601           (message "nnml: Reading incoming mail...done")))))
 602
 603
 604 (defun nnml-add-nov (group article line)
 605   "Add a nov line for the GROUP base."
 606   (save-excursion
 607     (set-buffer (nnml-open-nov group))
 608     (goto-char (point-max))
 609     (insert (int-to-string article) line)))
 610
 611 (defsubst nnml-header-value ()
 612   (buffer-substring (match-end 0) (save-excursion (end-of-line) (point))))
 613
 614 (defun nnml-make-nov-line (chars)
 615   "Create a nov from the current headers."
 616   (let ((case-fold-search t)
 617         subject from date id references lines xref in-reply-to char)
 618     ;; Fold continuation lines.
 619     (goto-char (point-min))
 620     (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 621       (replace-match " " t t))
 622     (subst-char-in-region (point-min) (point-max) ?\t ? )
 623     ;; [number subject from date id references chars lines xref]
 624     (save-excursion
 625       (goto-char (point-min))
 626       (while (re-search-forward "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): "
 627                                 nil t)
 628         (beginning-of-line)
 629         (setq char (downcase (following-char)))
 630         (cond
 631          ((eq char ?s)
 632           (setq subject (nnml-header-value)))
 633          ((eq char ?f)
 634           (setq from (nnml-header-value)))
 635          ((eq char ?x)
 636           (setq xref (nnml-header-value)))
 637          ((eq char ?l)
 638           (setq lines (nnml-header-value)))
 639          ((eq char ?d)
 640           (setq date (nnml-header-value)))
 641          ((eq char ?m)
 642           (setq id (setq id (nnml-header-value))))
 643          ((eq char ?r)
 644           (setq references (nnml-header-value)))
 645          ((eq char ?i)
 646           (setq in-reply-to (nnml-header-value))))
 647         (forward-line 1))
 648
 649       (and (not references)
 650            in-reply-to
 651            (string-match "<[^>]+>" in-reply-to)
 652            (setq references
 653                  (substring in-reply-to (match-beginning 0)
 654                             (match-end 0)))))
 655       ;; [number subject from date id references chars lines xref]
 656       (format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\n"
 657               (or subject "(none)")
 658               (or from "(nobody)") (or date "")
 659               (or id "") (or references "")
 660               chars (or lines "0") (or xref ""))))
 661
 662 (defun nnml-open-nov (group)
 663   (or (cdr (assoc group nnml-nov-buffer-alist))
 664       (let ((buffer (find-file-noselect
 665                      (concat (nnml-article-pathname group) ".nov"))))
 666         (save-excursion
 667           (set-buffer buffer)
 668           (buffer-disable-undo (current-buffer)))
 669         (setq nnml-nov-buffer-alist (cons (cons group buffer)
 670                                           nnml-nov-buffer-alist))
 671         buffer)))
 672
 673 (defun nnml-save-nov ()
 674   (save-excursion
 675     (while nnml-nov-buffer-alist
 676       (if (buffer-name (cdr (car nnml-nov-buffer-alist)))
 677           (progn
 678             (set-buffer (cdr (car nnml-nov-buffer-alist)))
 679             (write-region 1 (point-max) (buffer-file-name) nil 'nomesg)
 680             (set-buffer-modified-p nil)
 681             (kill-buffer (current-buffer))))
 682       (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
 683
 684 (defun nnml-generate-nov-databases (dir)
 685   "Generate nov databases in all nnml mail newsgroups."
 686   (interactive
 687    (progn
 688      (setq nnml-newsgroups nil)
 689      (list nnml-directory)))
 690   (nnml-open-server (system-name))
 691   (let ((dirs (directory-files dir t nil t)))
 692     (while dirs
 693       (if (and (not (string-match "/\\.\\.$" (car dirs)))
 694                (not (string-match "/\\.$" (car dirs)))
 695                (file-directory-p (car dirs)))
 696           (nnml-generate-nov-databases (car dirs)))
 697       (setq dirs (cdr dirs))))
 698   (let ((files (sort
 699                 (mapcar
 700                  (function
 701                   (lambda (name)
 702                     (string-to-int name)))
 703                  (directory-files dir nil "^[0-9]+$" t))
 704                 (function <)))
 705         (nov (concat dir "/.nov"))
 706         (nov-buffer (get-buffer-create "*nov*"))
 707         nov-line chars)
 708     (if files
 709         (setq nnml-newsgroups
 710               (cons (list (nnml-replace-chars-in-string
 711                            (substring (expand-file-name dir)
 712                                       (length (expand-file-name
 713                                                nnml-directory)))
 714                            ?/ ?.)
 715                           (cons (car files)
 716                                 (let ((f files))
 717                                   (while (cdr f) (setq f (cdr f)))
 718                                   (car f))))
 719                     nnml-newsgroups)))
 720     (if files
 721         (save-excursion
 722           (set-buffer nntp-server-buffer)
 723           (if (file-exists-p nov)
 724               (delete-file nov))
 725           (save-excursion
 726             (set-buffer nov-buffer)
 727             (buffer-disable-undo (current-buffer))
 728             (erase-buffer))
 729           (while files
 730             (erase-buffer)
 731             (insert-file-contents (concat dir "/" (int-to-string (car files))))
 732             (goto-char 1)
 733             (narrow-to-region 1 (save-excursion (search-forward "\n\n" nil t)
 734                                                 (setq chars (- (point-max)
 735                                                                (point)))
 736                                                 (point)))
 737             (setq nov-line (nnml-make-nov-line chars))
 738             (save-excursion
 739               (set-buffer nov-buffer)
 740               (goto-char (point-max))
 741               (insert (int-to-string (car files)) nov-line))
 742             (widen)
 743             (setq files (cdr files)))
 744           (save-excursion
 745             (set-buffer nov-buffer)
 746             (write-region 1 (point-max) (expand-file-name nov) nil
 747                           'nomesg)
 748             (kill-buffer (current-buffer)))))
 749     (nnml-save-active)))
 750
 751 (defun nnml-nov-delete-article (group article)
 752   (save-excursion
 753     (set-buffer (nnml-open-nov group))
 754     (goto-char 1)
 755     (if (re-search-forward (concat "^" (int-to-string article) "\t"))
 756         (delete-region (match-beginning 0) (progn (forward-line 1) (point))))))
 757
 758 (provide 'nnml)
 759
 760 ;;; nnml.el ends here