Importing Pterodactyl Gnus v0.96.
[elisp/gnus.git-] / lisp / nnfolder.el
index 898d14d..a45f4f7 100644 (file)
@@ -90,7 +90,13 @@ time saver for large mailboxes.")
 (defvoo nnfolder-buffer-alist nil)
 (defvoo nnfolder-scantime-alist nil)
 (defvoo nnfolder-active-timestamp nil)
-(defvoo nnfolder-file-coding-system nnmail-file-coding-system-1)
+(defvoo nnfolder-active-file-coding-system mm-text-coding-system)
+(defvoo nnfolder-active-file-coding-system-for-write 
+    nnmail-active-file-coding-system)
+(defvoo nnfolder-file-coding-system mm-text-coding-system)
+(defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system
+  "Coding system for save nnfolder file.
+If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.")
 
 \f
 
@@ -267,15 +273,14 @@ time saver for large mailboxes.")
   (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)
+      (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
       (nnfolder-read-folder group)))
   t)
 
 (deffoo nnfolder-request-list (&optional server)
   (nnfolder-possibly-change-group nil server)
   (save-excursion
-    (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
-         (pathname-coding-system 'binary))
+    (let ((nnmail-file-coding-system nnfolder-active-file-coding-system))
       (nnmail-find-file nnfolder-active-file)
       (setq nnfolder-group-alist (nnmail-get-active)))
     t))
@@ -287,41 +292,67 @@ time saver for large mailboxes.")
 (deffoo nnfolder-request-list-newsgroups (&optional server)
   (nnfolder-possibly-change-group nil server)
   (save-excursion
-    (nnmail-find-file nnfolder-newsgroups-file)))
+    (let ((nnmail-file-coding-system nnfolder-file-coding-system))
+      (nnmail-find-file nnfolder-newsgroups-file))))
+
+;; Return a list consisting of all article numbers existing in the
+;; current folder.
+
+(defun nnfolder-existing-articles ()
+  (save-excursion
+    (when nnfolder-current-buffer
+      (set-buffer nnfolder-current-buffer)
+      (goto-char (point-min))
+      (let ((marker (concat "\n" nnfolder-article-marker))
+           (number "[0-9]+")
+           numbers)
+      
+       (while (and (search-forward marker nil t)
+                   (re-search-forward number nil t))
+         (let ((newnum (string-to-number (match-string 0))))
+           (if (nnmail-within-headers-p)
+               (push newnum numbers))))
+       numbers))))
 
 (deffoo nnfolder-request-expire-articles
   (articles newsgroup &optional server force)
   (nnfolder-possibly-change-group newsgroup server)
   (let* ((is-old t)
-        rest)
+        ;; The articles we have deleted so far.
+        (deleted-articles nil)
+        ;; The articles that really exist and will be expired if they are old enough.
+        (maybe-expirable (gnus-intersection articles (nnfolder-existing-articles))))
     (nnmail-activate 'nnfolder)
 
     (save-excursion
       (set-buffer nnfolder-current-buffer)
-      (while (and articles is-old)
+      ;; Since messages are sorted in arrival order and expired in the
+      ;; same order, we can stop as soon as we find a message that is
+      ;; too old.
+      (while (and maybe-expirable is-old)
        (goto-char (point-min))
-       (when (and (nnfolder-goto-article (car articles))
+       (when (and (nnfolder-goto-article (car maybe-expirable))
                   (search-forward (concat "\n" nnfolder-article-marker)
                                   nil t))
          (forward-sexp)
-         (if (setq is-old
+         (when (setq is-old
                    (nnmail-expired-article-p
                     newsgroup
                     (buffer-substring
                      (point) (progn (end-of-line) (point)))
                     force nnfolder-inhibit-expiry))
-             (progn
                (nnheader-message 5 "Deleting article %d..."
-                                 (car articles) newsgroup)
-               (nnfolder-delete-mail))
-           (push (car articles) rest)))
-       (setq articles (cdr articles)))
+                             (car maybe-expirable) newsgroup)
+           (nnfolder-delete-mail)
+           ;; Must remember which articles were actually deleted
+           (push (car maybe-expirable) deleted-articles)))
+       (setq maybe-expirable (cdr maybe-expirable)))
       (unless nnfolder-inhibit-expiry
        (nnheader-message 5 "Deleting articles...done"))
       (nnfolder-save-buffer)
       (nnfolder-adjust-min-active newsgroup)
-      (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
-      (nconc rest articles))))
+      (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
+      (gnus-sorted-complement articles (nreverse deleted-articles)))))
 
 (deffoo nnfolder-request-move-article (article group server
                                               accept-form &optional last)
@@ -352,7 +383,7 @@ time saver for large mailboxes.")
         (when last
           (nnfolder-save-buffer)
           (nnfolder-adjust-min-active group)
-          (nnmail-save-active nnfolder-group-alist nnfolder-active-file))))
+          (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))))
       result)))
 
 (deffoo nnfolder-request-accept-article (group &optional server last)
@@ -390,7 +421,7 @@ time saver for large mailboxes.")
           (nnfolder-save-buffer)
           (when nnmail-cache-accepted-message-ids
             (nnmail-cache-close)))))
-      (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+      (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
       (unless result
        (nnheader-report 'nnfolder "Couldn't store article"))
       result)))
@@ -407,7 +438,7 @@ time saver for large mailboxes.")
       (goto-char (point-min))
       (if xfrom
          (insert "From " xfrom "\n")
-       (unless (looking-at message-unix-mail-delimiter)
+       (unless (looking-at "From ")
          (insert "From nobody " (current-time-string) "\n"))))
     (nnfolder-normalize-buffer)
     (set-buffer nnfolder-current-buffer)
@@ -433,7 +464,7 @@ time saver for large mailboxes.")
        nnfolder-current-group nil
        nnfolder-current-buffer nil)
   ;; Save the active file.
-  (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+  (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
   t)
 
 (deffoo nnfolder-request-rename-group (group new-name &optional server)
@@ -444,7 +475,9 @@ time saver for large mailboxes.")
         (ignore-errors
           (rename-file
            buffer-file-name
-           (nnfolder-group-pathname new-name))
+           (let ((new-file (nnfolder-group-pathname new-name)))
+             (gnus-make-directory (file-name-directory new-file))
+             new-file))
           t)
         ;; That went ok, so we change the internal structures.
         (let ((entry (assoc group nnfolder-group-alist)))
@@ -452,7 +485,7 @@ time saver for large mailboxes.")
           (setq nnfolder-current-buffer nil
                 nnfolder-current-group nil)
           ;; Save the new group alist.
-          (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+          (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
           ;; We kill the buffer instead of renaming it and stuff.
           (kill-buffer (current-buffer))
           t))))
@@ -541,14 +574,14 @@ deleted.  Point is left where the deleted region was."
   ;; Change group.
   (when (and group
             (not (equal group nnfolder-current-group)))
-    (let ((pathname-coding-system 'binary))
+    (let ((pathname-coding-system nnmail-pathname-coding-system))
       (nnmail-activate 'nnfolder)
       (when (and (not (assoc group nnfolder-group-alist))
                 (not (file-exists-p
                       (nnfolder-group-pathname group))))
        ;; 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))
+       (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))
 
       (if dont-check
          (setq nnfolder-current-group group
@@ -578,7 +611,10 @@ deleted.  Point is left where the deleted region was."
              ;; 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))
+               (let ((nnmail-file-coding-system 
+                      (or nnfolder-file-coding-system-for-write
+                          nnfolder-file-coding-system-for-write)))
+                 (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)
@@ -589,10 +625,10 @@ deleted.  Point is left where the deleted region was."
   (let* (save-list group-art)
     (goto-char (point-min))
     ;; The From line may have been quoted by movemail.
-    (when (looking-at (concat ">" message-unix-mail-delimiter))
+    (when (looking-at ">From")
       (delete-char 1))
     ;; This might come from somewhere else.
-    (unless (looking-at message-unix-mail-delimiter)
+    (unless (looking-at "From ")
       (insert "From nobody " (current-time-string) "\n")
       (goto-char (point-min)))
     ;; Quote all "From " lines in the article.
@@ -666,7 +702,7 @@ deleted.  Point is left where the deleted region was."
       (when inf
        (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)))
       (when nnfolder-group-alist
-       (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
+       (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))
       (push (list group (nnfolder-read-folder group))
            nnfolder-buffer-alist))))
 
@@ -688,7 +724,7 @@ deleted.  Point is left where the deleted region was."
 (defun nnfolder-read-folder (group)
   (let* ((file (nnfolder-group-pathname group))
         (buffer (set-buffer
-                 (let ((nnmail-file-coding-system
+                 (let ((nnheader-file-coding-system 
                         nnfolder-file-coding-system))
                    (nnheader-find-file-noselect file)))))
     (if (equal (cadr (assoc group nnfolder-scantime-alist))
@@ -701,9 +737,13 @@ deleted.  Point is left where the deleted region was."
          (save-buffer))
       ;; Parse the damn thing.
       (save-excursion
+       (goto-char (point-min))
+       ;; Remove any blank lines at the start.
+       (while (eq (following-char) ?\n)
+         (delete-char 1))
        (nnmail-activate 'nnfolder)
        ;; Read in the file.
-       (let ((delim (concat "^" message-unix-mail-delimiter))
+       (let ((delim "^From ")
              (marker (concat "\n" nnfolder-article-marker))
              (number "[0-9]+")
              (active (or (cadr (assoc group nnfolder-group-alist))
@@ -772,7 +812,7 @@ deleted.  Point is left where the deleted region was."
 
          (set-marker end nil)
          ;; Make absolutely sure that the active list reflects reality!
-         (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+         (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
          ;; Set the scantime for this group.
          (setq newscantime (visited-file-modtime))
          (if scantime
@@ -783,7 +823,8 @@ deleted.  Point is left where the deleted region was."
 
 ;;;###autoload
 (defun nnfolder-generate-active-file ()
-  "Look for mbox folders in the nnfolder directory and make them into groups."
+  "Look for mbox folders in the nnfolder directory and make them into groups.
+This command does not work if you use short group names."
   (interactive)
   (nnmail-activate 'nnfolder)
   (let ((files (directory-files nnfolder-directory))
@@ -822,7 +863,16 @@ deleted.  Point is left where the deleted region was."
   (when (buffer-modified-p)
     (run-hooks 'nnfolder-save-buffer-hook)
     (gnus-make-directory (file-name-directory (buffer-file-name)))
-    (save-buffer)))
+    (let ((coding-system-for-write 
+          (or nnfolder-file-coding-system-for-write
+              nnfolder-file-coding-system)))
+      (save-buffer))))
+
+(defun nnfolder-save-active (group-alist active-file)
+  (let ((nnmail-active-file-coding-system
+        (or nnfolder-active-file-coding-system-for-write
+            nnfolder-active-file-coding-system)))
+    (nnmail-save-active group-alist active-file)))
 
 (provide 'nnfolder)