*** empty log message ***
[gnus] / lisp / nnfolder.el
index 4012b16..b81b870 100644 (file)
@@ -39,7 +39,7 @@
 (defvoo nnfolder-directory (expand-file-name message-directory)
   "The name of the nnfolder directory.")
 
-(defvoo nnfolder-active-file 
+(defvoo nnfolder-active-file
   (nnheader-concat nnfolder-directory "active")
   "The name of the active file.")
 
@@ -49,7 +49,7 @@
 (defvoo nnfolder-ignore-active-file nil
   "If non-nil, causes nnfolder to do some extra work in order to determine
 the true active ranges of an mbox file.  Note that the active file is still
-saved, but it's values are not used.  This costs some extra time when 
+saved, but it's values are not used.  This costs some extra time when
 scanning an mbox when opening it.")
 
 (defvoo nnfolder-distrust-mbox nil
@@ -59,7 +59,7 @@ slow down scans, which now must scan the entire file for unmarked messages.
 When nil, scans occur forward from the last marked message, a huge
 time saver for large mailboxes.")
 
-(defvoo nnfolder-newsgroups-file 
+(defvoo nnfolder-newsgroups-file
   (concat (file-name-as-directory nnfolder-directory) "newsgroups")
   "Mail newsgroups description file.")
 
@@ -137,7 +137,7 @@ time saver for large mailboxes.")
   (nnoo-change-server 'nnfolder server defs)
   (nnmail-activate 'nnfolder t)
   (gnus-make-directory nnfolder-directory)
-  (cond 
+  (cond
    ((not (file-exists-p nnfolder-directory))
     (nnfolder-close-server)
     (nnheader-report 'nnfolder "Couldn't create directory: %s"
@@ -188,51 +188,52 @@ time saver for large mailboxes.")
            (goto-char (point-min))
            (search-forward (concat "\n" nnfolder-article-marker))
            (cons nnfolder-current-group
-                 (string-to-int 
-                  (buffer-substring 
+                 (string-to-int
+                  (buffer-substring
                    (point) (progn (end-of-line) (point)))))))))))
 
 (deffoo nnfolder-request-group (group &optional server dont-check)
-  (nnfolder-possibly-change-group group server)
+  (nnfolder-possibly-change-group group server t)
   (save-excursion
-    (nnmail-activate 'nnfolder)
     (if (not (assoc group nnfolder-group-alist))
        (nnheader-report 'nnfolder "No such group: %s" group)
       (if dont-check
-         (progn 
+         (progn
            (nnheader-report 'nnfolder "Selected group %s" group)
            t)
        (let* ((active (assoc group nnfolder-group-alist))
               (group (car active))
               (range (cadr active)))
-         (cond 
+         (cond
           ((null active)
            (nnheader-report 'nnfolder "No such group: %s" group))
           ((null nnfolder-current-group)
            (nnheader-report 'nnfolder "Empty group: %s" group))
           (t
            (nnheader-report 'nnfolder "Selected group %s" group)
-           (nnheader-insert "211 %d %d %d %s\n" 
+           (nnheader-insert "211 %d %d %d %s\n"
                             (1+ (- (cdr range) (car range)))
                             (car range) (cdr range) group))))))))
 
 (deffoo nnfolder-request-scan (&optional group server)
-  (nnfolder-possibly-change-group group server t)
-  (nnmail-get-new-mail
-   'nnfolder 
-   (lambda ()
-     (let ((bufs nnfolder-buffer-alist))
-       (save-excursion
-        (while bufs
-          (if (not (buffer-name (nth 1 (car bufs))))
-              (setq nnfolder-buffer-alist 
-                    (delq (car bufs) nnfolder-buffer-alist))
-            (set-buffer (nth 1 (car bufs)))
-            (nnfolder-save-buffer)
-            (kill-buffer (current-buffer)))
-          (setq bufs (cdr bufs))))))
-   nnfolder-directory
-   group))
+  (nnfolder-possibly-change-group nil server)
+  (when nnfolder-get-new-mail
+    (nnfolder-possibly-change-group group server)
+    (nnmail-get-new-mail
+     'nnfolder
+     (lambda ()
+       (let ((bufs nnfolder-buffer-alist))
+        (save-excursion
+          (while bufs
+            (if (not (buffer-live-p (nth 1 (car bufs))))
+                (setq nnfolder-buffer-alist
+                      (delq (car bufs) nnfolder-buffer-alist))
+              (set-buffer (nth 1 (car bufs)))
+              (nnfolder-save-buffer)
+              (kill-buffer (current-buffer)))
+            (setq bufs (cdr bufs))))))
+     nnfolder-directory
+     group)))
 
 ;; Don't close the buffer if we're not shutting down the server.  This way,
 ;; we can keep the buffer in the group buffer cache, and not have to grovel
@@ -245,7 +246,8 @@ time saver for large mailboxes.")
            (equal group nnfolder-current-group))
     (let ((inf (assoc group nnfolder-buffer-alist)))
       (when inf
-       (when nnfolder-current-group
+       (when (and nnfolder-current-group
+                  nnfolder-current-buffer)
          (push (list nnfolder-current-group nnfolder-current-buffer)
                nnfolder-buffer-alist))
        (setq nnfolder-buffer-alist
@@ -271,7 +273,7 @@ time saver for large mailboxes.")
 (deffoo nnfolder-request-create-group (group &optional server args)
   (nnfolder-possibly-change-group nil server)
   (nnmail-activate 'nnfolder)
-  (when group 
+  (when group
     (unless (assoc group nnfolder-group-alist)
       (push (list group (cons 1 0)) nnfolder-group-alist)
       (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
@@ -293,26 +295,26 @@ time saver for large mailboxes.")
   (save-excursion
     (nnmail-find-file nnfolder-newsgroups-file)))
 
-(deffoo nnfolder-request-expire-articles 
+(deffoo nnfolder-request-expire-articles
   (articles newsgroup &optional server force)
   (nnfolder-possibly-change-group newsgroup server)
   (let* ((is-old t)
         rest)
     (nnmail-activate 'nnfolder)
 
-    (save-excursion 
+    (save-excursion
       (set-buffer nnfolder-current-buffer)
       (while (and articles is-old)
        (goto-char (point-min))
        (when (search-forward (nnfolder-article-string (car articles)) nil t)
          (if (setq is-old
-                   (nnmail-expired-article-p 
+                   (nnmail-expired-article-p
                     newsgroup
-                    (buffer-substring 
+                    (buffer-substring
                      (point) (progn (end-of-line) (point)))
                     force nnfolder-inhibit-expiry))
              (progn
-               (nnheader-message 5 "Deleting article %d..." 
+               (nnheader-message 5 "Deleting article %d..."
                                  (car articles) newsgroup)
                (nnfolder-delete-mail))
            (push (car articles) rest)))
@@ -320,19 +322,7 @@ time saver for large mailboxes.")
       (unless nnfolder-inhibit-expiry
        (nnheader-message 5 "Deleting articles...done"))
       (nnfolder-save-buffer)
-      ;; Find the lowest active article in this group.
-      (let* ((active (cadr (assoc newsgroup nnfolder-group-alist)))
-            (marker (concat "\n" nnfolder-article-marker))
-            (number "[0-9]+")
-            (activemin (cdr active)))
-       (goto-char (point-min))
-       (while (and (search-forward marker nil t)
-                   (re-search-forward number nil t))
-         (setq activemin (min activemin
-                              (string-to-number (buffer-substring
-                                                 (match-beginning 0)
-                                                 (match-end 0))))))
-       (setcar active activemin))
+      (nnfolder-adjust-min-active newsgroup)
       (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
       (nconc rest articles))))
 
@@ -340,7 +330,7 @@ time saver for large mailboxes.")
   (article group server accept-form &optional last)
   (let ((buf (get-buffer-create " *nnfolder move*"))
        result)
-    (and 
+    (and
      (nnfolder-request-article article group server)
      (save-excursion
        (set-buffer buf)
@@ -348,7 +338,7 @@ time saver for large mailboxes.")
        (erase-buffer)
        (insert-buffer-substring nntp-server-buffer)
        (goto-char (point-min))
-       (while (re-search-forward 
+       (while (re-search-forward
               (concat "^" nnfolder-article-marker)
               (save-excursion (search-forward "\n\n" nil t) (point)) t)
         (delete-region (progn (beginning-of-line) (point))
@@ -362,7 +352,10 @@ time saver for large mailboxes.")
        (goto-char (point-min))
        (when (search-forward (nnfolder-article-string article) nil t)
         (nnfolder-delete-mail))
-       (and last (nnfolder-save-buffer))))
+       (when last
+        (nnfolder-save-buffer)
+        (nnfolder-adjust-min-active group)
+        (nnmail-save-active nnfolder-group-alist nnfolder-active-file))))
     result))
 
 (deffoo nnfolder-request-accept-article (group &optional server last)
@@ -373,7 +366,7 @@ time saver for large mailboxes.")
     (goto-char (point-min))
     (when (looking-at "X-From-Line: ")
       (replace-match "From "))
-    (and 
+    (and
      (nnfolder-request-list)
      (save-excursion
        (set-buffer buf)
@@ -382,7 +375,7 @@ time saver for large mailboxes.")
        (forward-line -1)
        (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
         (delete-region (point) (progn (forward-line 1) (point))))
-       (when nnmail-cache-message-id-when-accepting
+       (when nnmail-cache-accepted-message-ids
         (nnmail-cache-insert (nnmail-fetch-field "message-id")))
        (setq result
             (car (nnfolder-save-mail
@@ -394,7 +387,8 @@ time saver for large mailboxes.")
        (save-excursion
         (nnfolder-possibly-change-folder (or (caar art-group) group))
         (nnfolder-save-buffer)
-        (nnmail-cache-close))))
+        (when nnmail-cache-accepted-message-ids
+          (nnmail-cache-close)))))
     (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
     (unless result
       (nnheader-report 'nnfolder "Couldn't store article"))
@@ -421,7 +415,7 @@ time saver for large mailboxes.")
     (ignore-errors
       (delete-file (nnfolder-group-pathname group))))
   ;; Remove the group from all structures.
-  (setq nnfolder-group-alist 
+  (setq nnfolder-group-alist
        (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
        nnfolder-current-group nil
        nnfolder-current-buffer nil)
@@ -435,7 +429,7 @@ time saver for large mailboxes.")
     (set-buffer nnfolder-current-buffer)
     (and (file-writable-p buffer-file-name)
         (ignore-errors
-          (rename-file 
+          (rename-file
            buffer-file-name
            (nnfolder-group-pathname new-name))
           t)
@@ -453,6 +447,23 @@ time saver for large mailboxes.")
 \f
 ;;; Internal functions.
 
+(defun nnfolder-adjust-min-active (group)
+  ;; Find the lowest active article in this group.
+  (let* ((active (cadr (assoc group nnfolder-group-alist)))
+        (marker (concat "\n" nnfolder-article-marker))
+        (number "[0-9]+")
+        (activemin (cdr active)))
+    (save-excursion
+      (set-buffer nnfolder-current-buffer)
+      (goto-char (point-min))
+      (while (and (search-forward marker nil t)
+                 (re-search-forward number nil t))
+       (setq activemin (min activemin
+                            (string-to-number (buffer-substring
+                                               (match-beginning 0)
+                                               (match-end 0))))))
+      (setcar active activemin))))
+
 (defun nnfolder-article-string (article)
   (if (numberp article)
       (concat "\n" nnfolder-article-marker (int-to-string article) " ")
@@ -474,11 +485,14 @@ time saver for large mailboxes.")
             (point))
         (point-max))))))
 
-(defun nnfolder-possibly-change-group (group &optional server scanning)
+(defun nnfolder-possibly-change-group (group &optional server dont-check)
   ;; Change servers.
   (when (and server
             (not (nnfolder-server-opened server)))
     (nnfolder-open-server server))
+  (unless (gnus-buffer-live-p nnfolder-current-buffer)
+    (setq nnfolder-current-buffer nil
+         nnfolder-current-group nil))
   ;; Change group.
   (when (and group
             (not (equal group nnfolder-current-group)))
@@ -489,36 +503,38 @@ time saver for large mailboxes.")
       ;; The group doesn't exist, so we create a new entry for it.
       (push (list group (cons 1 0)) nnfolder-group-alist)
       (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
-    
-    (let (inf file)
-      ;; If we have to change groups, see if we don't already have the
-      ;; folder in memory.  If we do, verify the modtime and destroy
-      ;; the folder if needed so we can rescan it.
-      (when (setq inf (assoc group nnfolder-buffer-alist))
-       (setq nnfolder-current-buffer (nth 1 inf)))
-
-      ;; If the buffer is not live, make sure it isn't in the alist.  If it
-      ;; is live, verify that nobody else has touched the file since last
-      ;; time.
-      (when (and nnfolder-current-buffer
-                (not (gnus-buffer-live-p nnfolder-current-buffer)))
-       (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
-             nnfolder-current-buffer nil))
-
-      (setq nnfolder-current-group group)
-    
-      (when (or (not nnfolder-current-buffer)
-               (not (verify-visited-file-modtime nnfolder-current-buffer)))
-       (save-excursion
-         (setq file (nnfolder-group-pathname group))
-         ;; See whether we need to create the new file.
-         (unless (file-exists-p file)
-           (gnus-make-directory (file-name-directory file))
-           (nnmail-write-region 1 1 file t 'nomesg))
-         (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
-           (set-buffer nnfolder-current-buffer)
-           (push (list group nnfolder-current-buffer)
-                 nnfolder-buffer-alist)))))))
+
+    (if dont-check
+       (setq nnfolder-current-group group)
+      (let (inf file)
+       ;; If we have to change groups, see if we don't already have the
+       ;; folder in memory.  If we do, verify the modtime and destroy
+       ;; the folder if needed so we can rescan it.
+       (when (setq inf (assoc group nnfolder-buffer-alist))
+         (setq nnfolder-current-buffer (nth 1 inf)))
+
+       ;; If the buffer is not live, make sure it isn't in the alist.  If it
+       ;; is live, verify that nobody else has touched the file since last
+       ;; time.
+       (when (and nnfolder-current-buffer
+                  (not (gnus-buffer-live-p nnfolder-current-buffer)))
+         (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
+               nnfolder-current-buffer nil))
+
+       (setq nnfolder-current-group group)
+
+       (when (or (not nnfolder-current-buffer)
+                 (not (verify-visited-file-modtime nnfolder-current-buffer)))
+         (save-excursion
+           (setq file (nnfolder-group-pathname group))
+           ;; See whether we need to create the new file.
+           (unless (file-exists-p file)
+             (gnus-make-directory (file-name-directory file))
+             (nnmail-write-region 1 1 file t 'nomesg))
+           (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
+             (set-buffer nnfolder-current-buffer)
+             (push (list group nnfolder-current-buffer)
+                   nnfolder-buffer-alist))))))))
 
 (defun nnfolder-save-mail (group-art-list)
   "Called narrowed to an article."
@@ -527,15 +543,16 @@ time saver for large mailboxes.")
     ;; The From line may have been quoted by movemail.
     (when (looking-at (concat ">" message-unix-mail-delimiter))
       (delete-char 1))
-    ;; This might come from somewhere else.    
+    ;; This might come from somewhere else.
     (unless (looking-at message-unix-mail-delimiter)
       (insert "From nobody " (current-time-string) "\n")
       (goto-char (point-min)))
     ;; Quote all "From " lines in the article.
     (forward-line 1)
-    (while (re-search-forward "^From " nil t)
-      (beginning-of-line)
-      (insert "> "))
+    (let (case-fold-search)
+      (while (re-search-forward "^From " nil t)
+       (beginning-of-line)
+       (insert "> ")))
     (setq save-list group-art-list)
     (nnmail-insert-lines)
     (nnmail-insert-xref group-art-list)
@@ -630,7 +647,8 @@ time saver for large mailboxes.")
        (let ((delim (concat "^" message-unix-mail-delimiter))
              (marker (concat "\n" nnfolder-article-marker))
              (number "[0-9]+")
-             (active (cadr (assoc group nnfolder-group-alist)))
+             (active (or (cadr (assoc group nnfolder-group-alist))
+                         (cons 1 0)))
              (scantime (assoc group nnfolder-scantime-alist))
              (minid (lsh -1 -1))
              maxid start end newscantime
@@ -678,7 +696,7 @@ time saver for large mailboxes.")
            (setq start (marker-position end))
            (goto-char end)
            ;; There may be more than one "From " line, so we skip past
-           ;; them.  
+           ;; them.
            (while (looking-at delim)
              (forward-line 1))
            (set-marker end (if (nnmail-search-unix-mail-delim)
@@ -713,18 +731,23 @@ time saver for large mailboxes.")
     (while (setq file (pop files))
       (when (and (not (backup-file-name-p file))
                  (message-mail-file-mbox-p
-                 (concat nnfolder-directory file)))
-        (nnheader-message 5 "Adding group %s..." file)
-        (push (list file (cons 1 0)) nnfolder-group-alist)
-        (nnfolder-possibly-change-group file)
-        (nnfolder-close-group file))
-      (message ""))))
+                 (nnheader-concat nnfolder-directory file)))
+        (let ((oldgroup (assoc file nnfolder-group-alist)))
+          (if oldgroup
+              (nnheader-message 5 "Refreshing group %s..." file)
+            (nnheader-message 5 "Adding group %s..." file))
+          (setq nnfolder-group-alist (remove oldgroup nnfolder-group-alist))
+          (push (list file (cons 1 0)) nnfolder-group-alist)
+          (nnfolder-possibly-change-folder file)
+          (nnfolder-possibly-change-group file)
+          (nnfolder-close-group file))))
+    (message "")))
 
 (defun nnfolder-group-pathname (group)
   "Make pathname for GROUP."
   (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
     ;; If this file exists, we use it directly.
-    (if (or nnmail-use-long-file-names 
+    (if (or nnmail-use-long-file-names
            (file-exists-p (concat dir group)))
        (concat dir group)
       ;; If not, we translate dots into slashes.