/[emacs]/emacs/lisp/gnus/nnml.el
ViewVC logotype

Diff of /emacs/lisp/gnus/nnml.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by miles, Mon Sep 1 15:45:24 2003 UTC revision 1.11.2.1 by schwab, Thu Jul 22 16:45:51 2004 UTC
# Line 1  Line 1 
1  ;;; nnml.el --- mail spool access for Gnus  ;;; nnml.el --- mail spool access for Gnus
2  ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000  ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003
3  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
6  ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>  ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
7    ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8  ;; Keywords: news, mail  ;; Keywords: news, mail
9    
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 31  Line 32 
32    
33  ;;; Code:  ;;; Code:
34    
35    (require 'gnus)
36  (require 'nnheader)  (require 'nnheader)
37  (require 'nnmail)  (require 'nnmail)
38  (require 'nnoo)  (require 'nnoo)
39  (eval-when-compile (require 'cl))  (eval-when-compile (require 'cl))
40    
41  (eval-and-compile  (eval-and-compile
42    (autoload 'gnus-sorted-intersection "gnus-range"))    (autoload 'gnus-article-unpropagatable-p "gnus-sum"))
43    
44  (nnoo-declare nnml)  (nnoo-declare nnml)
45    
# Line 55  Line 58 
58    "If non-nil, nnml will check the incoming mail file and split the mail.")    "If non-nil, nnml will check the incoming mail file and split the mail.")
59    
60  (defvoo nnml-nov-is-evil nil  (defvoo nnml-nov-is-evil nil
61    "If non-nil, Gnus will never generate and use nov databases for mail groups.    "If non-nil, Gnus will never generate and use nov databases for mail spools.
62  Using nov databases will speed up header fetching considerably.  Using nov databases will speed up header fetching considerably.
63  This variable shouldn't be flipped much.  If you have, for some reason,  This variable shouldn't be flipped much.  If you have, for some reason,
64  set this to t, and want to set it to nil again, you should always run  set this to t, and want to set it to nil again, you should always run
# Line 63  the `nnml-generate-nov-databases' comman Line 66  the `nnml-generate-nov-databases' comman
66  through all nnml directories and generate nov databases for them  through all nnml directories and generate nov databases for them
67  all.  This may very well take some time.")  all.  This may very well take some time.")
68    
69    (defvoo nnml-marks-is-evil nil
70      "If non-nil, Gnus will never generate and use marks file for mail spools.
71    Using marks files makes it possible to backup and restore mail groups
72    separately from `.newsrc.eld'.  If you have, for some reason, set this
73    to t, and want to set it to nil again, you should always remove the
74    corresponding marks file (usually named `.marks' in the nnml group
75    directory, but see `nnml-marks-file-name') for the group.  Then the
76    marks file will be regenerated properly by Gnus.")
77    
78  (defvoo nnml-prepare-save-mail-hook nil  (defvoo nnml-prepare-save-mail-hook nil
79    "Hook run narrowed to an article before saving.")    "Hook run narrowed to an article before saving.")
80    
81  (defvoo nnml-inhibit-expiry nil  (defvoo nnml-inhibit-expiry nil
82    "If non-nil, inhibit expiry.")    "If non-nil, inhibit expiry.")
83    
84    (defvoo nnml-use-compressed-files nil
85      "If non-nil, allow using compressed message files.")
86    
87    
88    
# Line 76  all.  This may very well take some time. Line 90  all.  This may very well take some time.
90    "nnml version.")    "nnml version.")
91    
92  (defvoo nnml-nov-file-name ".overview")  (defvoo nnml-nov-file-name ".overview")
93    (defvoo nnml-marks-file-name ".marks")
94    
95  (defvoo nnml-current-directory nil)  (defvoo nnml-current-directory nil)
96  (defvoo nnml-current-group nil)  (defvoo nnml-current-group nil)
# Line 91  all.  This may very well take some time. Line 106  all.  This may very well take some time.
106    
107  (defvoo nnml-file-coding-system nnmail-file-coding-system)  (defvoo nnml-file-coding-system nnmail-file-coding-system)
108    
109    (defvoo nnml-marks nil)
110    
111    (defvar nnml-marks-modtime (gnus-make-hashtable))
112    
113    
114  ;;; Interface functions.  ;;; Interface functions.
115    
116  (nnoo-define-basics nnml)  (nnoo-define-basics nnml)
# Line 102  all.  This may very well take some time. Line 120  all.  This may very well take some time.
120      (save-excursion      (save-excursion
121        (set-buffer nntp-server-buffer)        (set-buffer nntp-server-buffer)
122        (erase-buffer)        (erase-buffer)
123        (let ((file nil)        (let* ((file nil)
124              (number (length sequence))               (number (length sequence))
125              (count 0)               (count 0)
126              (file-name-coding-system nnmail-pathname-coding-system)               (file-name-coding-system nnmail-pathname-coding-system)
127              beg article)               beg article)
128          (if (stringp (car sequence))          (if (stringp (car sequence))
129              'headers              'headers
130            (if (nnml-retrieve-headers-with-nov sequence fetch-old)            (if (nnml-retrieve-headers-with-nov sequence fetch-old)
# Line 121  all.  This may very well take some time. Line 139  all.  This may very well take some time.
139                  (setq beg (point))                  (setq beg (point))
140                  (nnheader-insert-head file)                  (nnheader-insert-head file)
141                  (goto-char beg)                  (goto-char beg)
142                  (if (search-forward "\n\n" nil t)                  (if (re-search-forward "\n\r?\n" nil t)
143                      (forward-char -1)                      (forward-char -1)
144                    (goto-char (point-max))                    (goto-char (point-max))
145                    (insert "\n\n"))                    (insert "\n\n"))
# Line 158  all.  This may very well take some time. Line 176  all.  This may very well take some time.
176                       server nnml-directory)                       server nnml-directory)
177      t)))      t)))
178    
179  (defun nnml-request-regenerate (server)  (deffoo nnml-request-regenerate (server)
180    (nnml-possibly-change-directory nil server)    (nnml-possibly-change-directory nil server)
181    (nnml-generate-nov-databases)    (nnml-generate-nov-databases server)
182    t)    t)
183    
184  (deffoo nnml-request-article (id &optional group server buffer)  (deffoo nnml-request-article (id &optional group server buffer)
# Line 245  all.  This may very well take some time. Line 263  all.  This may very well take some time.
263              nnml-group-alist)              nnml-group-alist)
264        (nnml-possibly-create-directory group)        (nnml-possibly-create-directory group)
265        (nnml-possibly-change-directory group server)        (nnml-possibly-change-directory group server)
266        (let ((articles (nnheader-directory-articles nnml-current-directory)))        (let ((articles (nnml-directory-articles nnml-current-directory)))
267          (when articles          (when articles
268            (setcar active (apply 'min articles))            (setcar active (apply 'min articles))
269            (setcdr active (apply 'max articles))))            (setcdr active (apply 'max articles))))
# Line 270  all.  This may very well take some time. Line 288  all.  This may very well take some time.
288  (deffoo nnml-request-expire-articles (articles group &optional server force)  (deffoo nnml-request-expire-articles (articles group &optional server force)
289    (nnml-possibly-change-directory group server)    (nnml-possibly-change-directory group server)
290    (let ((active-articles    (let ((active-articles
291           (nnheader-directory-articles nnml-current-directory))           (nnml-directory-articles nnml-current-directory))
292          (is-old t)          (is-old t)
293          article rest mod-time number)          article rest mod-time number)
294      (nnmail-activate 'nnml)      (nnmail-activate 'nnml)
# Line 281  all.  This may very well take some time. Line 299  all.  This may very well take some time.
299      (setq articles (gnus-sorted-intersection articles active-articles))      (setq articles (gnus-sorted-intersection articles active-articles))
300    
301      (while (and articles is-old)      (while (and articles is-old)
302        (when (setq article (nnml-article-to-file (setq number (pop articles))))        (if (and (setq article (nnml-article-to-file
303          (when (setq mod-time (nth 5 (file-attributes article)))                                (setq number (pop articles))))
304            (if (and (nnml-deletable-article-p group number)                 (setq mod-time (nth 5 (file-attributes article)))
305                     (setq is-old                 (nnml-deletable-article-p group number)
306                           (nnmail-expired-article-p group mod-time force                 (setq is-old (nnmail-expired-article-p group mod-time force
307                                                     nnml-inhibit-expiry)))                                                        nnml-inhibit-expiry)))
308                (progn            (progn
309                  ;; Allow a special target group.              ;; Allow a special target group.
310                  (unless (eq nnmail-expiry-target 'delete)              (unless (eq nnmail-expiry-target 'delete)
311                    (with-temp-buffer                (with-temp-buffer
312                      (nnml-request-article number group server                  (nnml-request-article number group server (current-buffer))
313                                            (current-buffer))                  (let (nnml-current-directory
314                      (let ((nnml-current-directory nil))                        nnml-current-group
315                        (nnmail-expiry-target-group                        nnml-article-file-alist)
316                         nnmail-expiry-target group))))                    (nnmail-expiry-target-group nnmail-expiry-target group)))
317                  (nnheader-message 5 "Deleting article %s in %s"                ;; Maybe directory is changed during nnmail-expiry-target-group.
318                                    number group)                (nnml-possibly-change-directory group server))
319                  (condition-case ()              (nnheader-message 5 "Deleting article %s in %s"
320                      (funcall nnmail-delete-file-function article)                                number group)
321                    (file-error              (condition-case ()
322                     (push number rest)))                  (funcall nnmail-delete-file-function article)
323                  (setq active-articles (delq number active-articles))                (file-error
324                  (nnml-nov-delete-article group number))                 (push number rest)))
325              (push number rest)))))              (setq active-articles (delq number active-articles))
326                (nnml-nov-delete-article group number))
327            (push number rest)))
328      (let ((active (nth 1 (assoc group nnml-group-alist))))      (let ((active (nth 1 (assoc group nnml-group-alist))))
329        (when active        (when active
330          (setcar active (or (and active-articles          (setcar active (or (and active-articles
# Line 349  all.  This may very well take some time. Line 369  all.  This may very well take some time.
369    (nnmail-check-syntax)    (nnmail-check-syntax)
370    (let (result)    (let (result)
371      (when nnmail-cache-accepted-message-ids      (when nnmail-cache-accepted-message-ids
372        (nnmail-cache-insert (nnmail-fetch-field "message-id")))        (nnmail-cache-insert (nnmail-fetch-field "message-id")
373                               group
374                               (nnmail-fetch-field "subject")
375                               (nnmail-fetch-field "from")))
376      (if (stringp group)      (if (stringp group)
377          (and          (and
378           (nnmail-activate 'nnml)           (nnmail-activate 'nnml)
# Line 371  all.  This may very well take some time. Line 394  all.  This may very well take some time.
394           (nnml-save-nov))))           (nnml-save-nov))))
395      result))      result))
396    
397    (deffoo nnml-request-post (&optional server)
398      (nnmail-do-request-post 'nnml-request-accept-article server))
399    
400  (deffoo nnml-request-replace-article (article group buffer)  (deffoo nnml-request-replace-article (article group buffer)
401    (nnml-possibly-change-directory group)    (nnml-possibly-change-directory group)
402    (save-excursion    (save-excursion
# Line 395  all.  This may very well take some time. Line 421  all.  This may very well take some time.
421            (if (or (looking-at art)            (if (or (looking-at art)
422                    (search-forward (concat "\n" art) nil t))                    (search-forward (concat "\n" art) nil t))
423                ;; Delete the old NOV line.                ;; Delete the old NOV line.
424                (delete-region (progn (beginning-of-line) (point))                (gnus-delete-line)
                              (progn (forward-line 1) (point)))  
425              ;; The line isn't here, so we have to find out where              ;; The line isn't here, so we have to find out where
426              ;; we should insert it.  (This situation should never              ;; we should insert it.  (This situation should never
427              ;; occur, but one likes to make sure...)              ;; occur, but one likes to make sure...)
# Line 419  all.  This may very well take some time. Line 444  all.  This may very well take some time.
444             (directory-files             (directory-files
445              nnml-current-directory t              nnml-current-directory t
446              (concat nnheader-numerical-short-files              (concat nnheader-numerical-short-files
447                      "\\|" (regexp-quote nnml-nov-file-name) "$")))                      "\\|" (regexp-quote nnml-nov-file-name) "$"
448                        "\\|" (regexp-quote nnml-marks-file-name) "$")))
449            article)            article)
450        (while articles        (while articles
451          (setq article (pop articles))          (setq article (pop articles))
# Line 457  all.  This may very well take some time. Line 483  all.  This may very well take some time.
483        (let ((overview (concat old-dir nnml-nov-file-name)))        (let ((overview (concat old-dir nnml-nov-file-name)))
484          (when (file-exists-p overview)          (when (file-exists-p overview)
485            (rename-file overview (concat new-dir nnml-nov-file-name))))            (rename-file overview (concat new-dir nnml-nov-file-name))))
486          ;; Move .marks file.
487          (let ((marks (concat old-dir nnml-marks-file-name)))
488            (when (file-exists-p marks)
489              (rename-file marks (concat new-dir nnml-marks-file-name))))
490        (when (<= (length (directory-files old-dir)) 2)        (when (<= (length (directory-files old-dir)) 2)
491          (ignore-errors (delete-directory old-dir)))          (ignore-errors (delete-directory old-dir)))
492        ;; That went ok, so we change the internal structures.        ;; That went ok, so we change the internal structures.
# Line 487  all.  This may very well take some time. Line 517  all.  This may very well take some time.
517  (defun nnml-article-to-file (article)  (defun nnml-article-to-file (article)
518    (nnml-update-file-alist)    (nnml-update-file-alist)
519    (let (file)    (let (file)
520      (if (setq file (cdr (assq article nnml-article-file-alist)))      (if (setq file
521                  (if nnml-use-compressed-files
522                      (cdr (assq article nnml-article-file-alist))
523                    (number-to-string article)))
524          (expand-file-name file nnml-current-directory)          (expand-file-name file nnml-current-directory)
525        ;; Just to make sure nothing went wrong when reading over NFS --        (when (not nnheader-directory-files-is-safe)
526        ;; check once more.          ;; Just to make sure nothing went wrong when reading over NFS --
527        (when (file-exists-p          ;; check once more.
528               (setq file (expand-file-name (number-to-string article)          (when (file-exists-p
529                                            nnml-current-directory)))                 (setq file (expand-file-name (number-to-string article)
530          (nnml-update-file-alist t)                                              nnml-current-directory)))
531          file))))            (nnml-update-file-alist t)
532              file)))))
533    
534  (defun nnml-deletable-article-p (group article)  (defun nnml-deletable-article-p (group article)
535    "Say whether ARTICLE in GROUP can be deleted."    "Say whether ARTICLE in GROUP can be deleted."
# Line 517  all.  This may very well take some time. Line 551  all.  This may very well take some time.
551        ;; likely that the article we are looking for is in that group.        ;; likely that the article we are looking for is in that group.
552        (if (setq number (nnml-find-id nnml-current-group id))        (if (setq number (nnml-find-id nnml-current-group id))
553            (cons nnml-current-group number)            (cons nnml-current-group number)
554          ;; It wasn't there, so we look through the other groups as well.        ;; It wasn't there, so we look through the other groups as well.
555          (while (and (not number)          (while (and (not number)
556                      alist)                      alist)
557            (or (string= (caar alist) nnml-current-group)            (or (string= (caar alist) nnml-current-group)
# Line 587  all.  This may very well take some time. Line 621  all.  This may very well take some time.
621    
622  (defun nnml-save-mail (group-art)  (defun nnml-save-mail (group-art)
623    "Called narrowed to an article."    "Called narrowed to an article."
624    (let (chars headers)    (let (chars headers extension)
625      (setq chars (nnmail-insert-lines))      (setq chars (nnmail-insert-lines))
626        (setq extension
627             (and nnml-use-compressed-files
628                  (> chars 1000)
629                  ".gz"))
630      (nnmail-insert-xref group-art)      (nnmail-insert-xref group-art)
631      (run-hooks 'nnmail-prepare-save-mail-hook)      (run-hooks 'nnmail-prepare-save-mail-hook)
632      (run-hooks 'nnml-prepare-save-mail-hook)      (run-hooks 'nnml-prepare-save-mail-hook)
# Line 603  all.  This may very well take some time. Line 641  all.  This may very well take some time.
641          (nnml-possibly-create-directory (caar ga))          (nnml-possibly-create-directory (caar ga))
642          (let ((file (concat (nnmail-group-pathname          (let ((file (concat (nnmail-group-pathname
643                               (caar ga) nnml-directory)                               (caar ga) nnml-directory)
644                              (int-to-string (cdar ga)))))                              (int-to-string (cdar ga))
645                                extension)))
646            (if first            (if first
647                ;; It was already saved, so we just make a hard link.                ;; It was already saved, so we just make a hard link.
648                (funcall nnmail-crosspost-link-function first file t)                (funcall nnmail-crosspost-link-function first file t)
# Line 636  all.  This may very well take some time. Line 675  all.  This may very well take some time.
675        (unless nnml-article-file-alist        (unless nnml-article-file-alist
676          (setq nnml-article-file-alist          (setq nnml-article-file-alist
677                (sort                (sort
678                 (nnheader-article-to-file-alist nnml-current-directory)                 (nnml-current-group-article-to-file-alist)
679                 'car-less-than-car)))                 'car-less-than-car)))
680        (setq active        (setq active
681              (if nnml-article-file-alist              (if nnml-article-file-alist
# Line 660  all.  This may very well take some time. Line 699  all.  This may very well take some time.
699      (nnheader-insert-nov headers)))      (nnheader-insert-nov headers)))
700    
701  (defsubst nnml-header-value ()  (defsubst nnml-header-value ()
702    (buffer-substring (match-end 0) (progn (end-of-line) (point))))    (buffer-substring (match-end 0) (gnus-point-at-eol)))
703    
704  (defun nnml-parse-head (chars &optional number)  (defun nnml-parse-head (chars &optional number)
705    "Parse the head of the current buffer."    "Parse the head of the current buffer."
# Line 669  all.  This may very well take some time. Line 708  all.  This may very well take some time.
708        (unless (zerop (buffer-size))        (unless (zerop (buffer-size))
709          (narrow-to-region          (narrow-to-region
710           (goto-char (point-min))           (goto-char (point-min))
711           (if (search-forward "\n\n" nil t) (1- (point)) (point-max))))           (if (re-search-forward "\n\r?\n" nil t)
712        ;; Fold continuation lines.               (1- (point))
713        (goto-char (point-min))             (point-max))))
714        (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)        (let ((headers (nnheader-parse-naked-head)))
         (replace-match " " t t))  
       ;; Remove any tabs; they are too confusing.  
       (subst-char-in-region (point-min) (point-max) ?\t ? )  
       (let ((headers (nnheader-parse-head t)))  
715          (mail-header-set-chars headers chars)          (mail-header-set-chars headers chars)
716          (mail-header-set-number headers number)          (mail-header-set-number headers number)
717          headers))))          headers))))
718    
719    (defun nnml-get-nov-buffer (group)
720      (let ((buffer (get-buffer-create (format " *nnml overview %s*" group))))
721        (save-excursion
722          (set-buffer buffer)
723          (set (make-local-variable 'nnml-nov-buffer-file-name)
724               (expand-file-name
725                nnml-nov-file-name
726                (nnmail-group-pathname group nnml-directory)))
727          (erase-buffer)
728          (when (file-exists-p nnml-nov-buffer-file-name)
729            (nnheader-insert-file-contents nnml-nov-buffer-file-name)))
730        buffer))
731    
732  (defun nnml-open-nov (group)  (defun nnml-open-nov (group)
733    (or (cdr (assoc group nnml-nov-buffer-alist))    (or (cdr (assoc group nnml-nov-buffer-alist))
734        (let ((buffer (get-buffer-create (format " *nnml overview %s*" group))))        (let ((buffer (nnml-get-nov-buffer group)))
         (save-excursion  
           (set-buffer buffer)  
           (set (make-local-variable 'nnml-nov-buffer-file-name)  
                (expand-file-name  
                 nnml-nov-file-name  
                 (nnmail-group-pathname group nnml-directory)))  
           (erase-buffer)  
           (when (file-exists-p nnml-nov-buffer-file-name)  
             (nnheader-insert-file-contents nnml-nov-buffer-file-name)))  
735          (push (cons group buffer) nnml-nov-buffer-alist)          (push (cons group buffer) nnml-nov-buffer-alist)
736          buffer)))          buffer)))
737    
# Line 709  all.  This may very well take some time. Line 748  all.  This may very well take some time.
748        (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))        (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
749    
750  ;;;###autoload  ;;;###autoload
751  (defun nnml-generate-nov-databases ()  (defun nnml-generate-nov-databases (&optional server)
752    "Generate NOV databases in all nnml directories."    "Generate NOV databases in all nnml directories."
753    (interactive)    (interactive (list (or (nnoo-current-server 'nnml) "")))
754    ;; Read the active file to make sure we don't re-use articles    ;; Read the active file to make sure we don't re-use articles
755    ;; numbers in empty groups.    ;; numbers in empty groups.
756    (nnmail-activate 'nnml)    (nnmail-activate 'nnml)
757    (nnml-open-server (or (nnoo-current-server 'nnml) ""))    (unless (nnml-server-opened server)
758        (nnml-open-server server))
759    (setq nnml-directory (expand-file-name nnml-directory))    (setq nnml-directory (expand-file-name nnml-directory))
760    ;; Recurse down the directories.    ;; Recurse down the directories.
761    (nnml-generate-nov-databases-1 nnml-directory nil t)    (nnml-generate-nov-databases-1 nnml-directory nil t)
# Line 754  all.  This may very well take some time. Line 794  all.  This may very well take some time.
794  (eval-when-compile (defvar files))  (eval-when-compile (defvar files))
795  (defun nnml-generate-active-info (dir)  (defun nnml-generate-active-info (dir)
796    ;; Update the active info for this group.    ;; Update the active info for this group.
797    (let ((group (nnheader-file-to-group    (let* ((group (nnheader-file-to-group
798                  (directory-file-name dir) nnml-directory)))                   (directory-file-name dir) nnml-directory))
799      (setq nnml-group-alist           (entry (assoc group nnml-group-alist))
800            (delq (assoc group nnml-group-alist) nnml-group-alist))           (last (or (caadr entry) 0)))
801        (setq nnml-group-alist (delq entry nnml-group-alist))
802      (push (list group      (push (list group
803                  (cons (caar files)                  (cons (or (caar files) (1+ last))
804                        (let ((f files))                        (max last
805                          (while (cdr f) (setq f (cdr f)))                             (or (let ((f files))
806                          (caar f))))                                   (while (cdr f) (setq f (cdr f)))
807                                     (caar f))
808                                   0))))
809            nnml-group-alist)))            nnml-group-alist)))
810    
811  (defun nnml-generate-nov-file (dir files)  (defun nnml-generate-nov-file (dir files)
# Line 786  all.  This may very well take some time. Line 829  all.  This may very well take some time.
829            (narrow-to-region            (narrow-to-region
830             (goto-char (point-min))             (goto-char (point-min))
831             (progn             (progn
832               (search-forward "\n\n" nil t)               (re-search-forward "\n\r?\n" nil t)
833               (setq chars (- (point-max) (point)))               (setq chars (- (point-max) (point)))
834               (max (point-min) (1- (point)))))               (max (point-min) (1- (point)))))
835            (unless (zerop (buffer-size))            (unless (zerop (buffer-size))
# Line 820  all.  This may very well take some time. Line 863  all.  This may very well take some time.
863      t))      t))
864    
865  (defun nnml-update-file-alist (&optional force)  (defun nnml-update-file-alist (&optional force)
866    (when (or (not nnml-article-file-alist)    (when nnml-use-compressed-files
867              force)      (when (or (not nnml-article-file-alist)
868      (setq nnml-article-file-alist                force)
869            (nnheader-article-to-file-alist nnml-current-directory))))        (setq nnml-article-file-alist
870                (nnml-current-group-article-to-file-alist)))))
871    
872    (defun nnml-directory-articles (dir)
873      "Return a list of all article files in a directory.
874    Use the nov database for that directory if available."
875      (if (or gnus-nov-is-evil nnml-nov-is-evil
876              (not (file-exists-p
877                    (expand-file-name nnml-nov-file-name dir))))
878          (nnheader-directory-articles dir)
879        ;; build list from .overview if available
880        ;; We would use nnml-open-nov, except that nnml-nov-buffer-alist is
881        ;; defvoo'd, and we might get called when it hasn't been swapped in.
882        (save-excursion
883          (let ((list nil)
884                art
885                (buffer (nnml-get-nov-buffer nnml-current-group)))
886            (set-buffer buffer)
887            (goto-char (point-min))
888            (while (not (eobp))
889              (setq art (read (current-buffer)))
890              (push art list)
891              (forward-line 1))
892            list))))
893    
894    (defun nnml-current-group-article-to-file-alist ()
895      "Return an alist of article/file pairs in the current group.
896    Use the nov database for the current group if available."
897      (if (or nnml-use-compressed-files
898              gnus-nov-is-evil
899              nnml-nov-is-evil
900              (not (file-exists-p
901                    (expand-file-name nnml-nov-file-name
902                                      nnml-current-directory))))
903          (nnheader-article-to-file-alist nnml-current-directory)
904        ;; build list from .overview if available
905        (save-excursion
906          (let ((alist nil)
907                (buffer (nnml-get-nov-buffer nnml-current-group))
908                art)
909            (set-buffer buffer)
910            (goto-char (point-min))
911            (while (not (eobp))
912              (setq art (read (current-buffer)))
913              ;; assume file name is unadorned (ie. not compressed etc)
914              (push (cons art (int-to-string art)) alist)
915              (forward-line 1))
916            alist))))
917    
918    (deffoo nnml-request-set-mark (group actions &optional server)
919      (nnml-possibly-change-directory group server)
920      (unless nnml-marks-is-evil
921        (nnml-open-marks group server)
922        (dolist (action actions)
923          (let ((range (nth 0 action))
924                (what  (nth 1 action))
925                (marks (nth 2 action)))
926            (assert (or (eq what 'add) (eq what 'del)) t
927                    "Unknown request-set-mark action: %s" what)
928            (dolist (mark marks)
929              (setq nnml-marks (gnus-update-alist-soft
930                                mark
931                                (funcall (if (eq what 'add) 'gnus-range-add
932                                           'gnus-remove-from-range)
933                                         (cdr (assoc mark nnml-marks)) range)
934                                nnml-marks)))))
935        (nnml-save-marks group server))
936      nil)
937    
938    (deffoo nnml-request-update-info (group info &optional server)
939      (nnml-possibly-change-directory group server)
940      (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group))
941        (nnheader-message 8 "Updating marks for %s..." group)
942        (nnml-open-marks group server)
943        ;; Update info using `nnml-marks'.
944        (mapcar (lambda (pred)
945                  (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
946                    (gnus-info-set-marks
947                     info
948                     (gnus-update-alist-soft
949                      (cdr pred)
950                      (cdr (assq (cdr pred) nnml-marks))
951                      (gnus-info-marks info))
952                     t)))
953                gnus-article-mark-lists)
954        (let ((seen (cdr (assq 'read nnml-marks))))
955          (gnus-info-set-read info
956                              (if (and (integerp (car seen))
957                                       (null (cdr seen)))
958                                  (list (cons (car seen) (car seen)))
959                                seen)))
960        (nnheader-message 8 "Updating marks for %s...done" group))
961      info)
962    
963    (defun nnml-marks-changed-p (group)
964      (let ((file (expand-file-name nnml-marks-file-name
965                                    (nnmail-group-pathname group nnml-directory))))
966        (if (null (gnus-gethash file nnml-marks-modtime))
967            t ;; never looked at marks file, assume it has changed
968          (not (equal (gnus-gethash file nnml-marks-modtime)
969                      (nth 5 (file-attributes file)))))))
970    
971    (defun nnml-save-marks (group server)
972      (let ((file-name-coding-system nnmail-pathname-coding-system)
973            (file (expand-file-name nnml-marks-file-name
974                                    (nnmail-group-pathname group nnml-directory))))
975        (condition-case err
976            (progn
977              (nnml-possibly-create-directory group)
978              (with-temp-file file
979                (erase-buffer)
980                (gnus-prin1 nnml-marks)
981                (insert "\n"))
982              (gnus-sethash file
983                            (nth 5 (file-attributes file))
984                            nnml-marks-modtime))
985          (error (or (gnus-yes-or-no-p
986                      (format "Could not write to %s (%s).  Continue? " file err))
987                     (error "Cannot write to %s (%s)" err))))))
988    
989    (defun nnml-open-marks (group server)
990      (let ((file (expand-file-name
991                   nnml-marks-file-name
992                   (nnmail-group-pathname group nnml-directory))))
993        (if (file-exists-p file)
994            (condition-case err
995                (with-temp-buffer
996                  (gnus-sethash file (nth 5 (file-attributes file))
997                                nnml-marks-modtime)
998                  (nnheader-insert-file-contents file)
999                  (setq nnml-marks (read (current-buffer)))
1000                  (dolist (el gnus-article-unpropagated-mark-lists)
1001                    (setq nnml-marks (gnus-remassoc el nnml-marks))))
1002              (error (or (gnus-yes-or-no-p
1003                          (format "Error reading nnml marks file %s (%s).  Continuing will use marks from .newsrc.eld.  Continue? " file err))
1004                         (error "Cannot read nnml marks file %s (%s)" file err))))
1005          ;; User didn't have a .marks file.  Probably first time
1006          ;; user of the .marks stuff.  Bootstrap it from .newsrc.eld.
1007          (let ((info (gnus-get-info
1008                       (gnus-group-prefixed-name
1009                        group
1010                        (gnus-server-to-method (format "nnml:%s" server))))))
1011            (nnheader-message 7 "Bootstrapping marks for %s..." group)
1012            (setq nnml-marks (gnus-info-marks info))
1013            (push (cons 'read (gnus-info-read info)) nnml-marks)
1014            (dolist (el gnus-article-unpropagated-mark-lists)
1015              (setq nnml-marks (gnus-remassoc el nnml-marks)))
1016            (nnml-save-marks group server)
1017            (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
1018    
1019  (provide 'nnml)  (provide 'nnml)
1020    

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.11.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26