gnus-art.el (gnus-mime-buttonize-attachments-in-header): Improve criterion that finds...

[gnus] / lisp / nnmbox.el

diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el
index 5f6ecd1..4eb98cf 100644 (file)
--- a/lisp/nnmbox.el
+++ b/lisp/nnmbox.el
@@ -1,21 +1,25 @@
 ;;; nnmbox.el --- mail mbox access for Gnus
 ;;; nnmbox.el --- mail mbox access for Gnus

-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995-2014 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>

-;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>

 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.

 
 ;; You should have received a copy of the GNU General Public License
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -28,6 +32,7 @@
 (require 'message)
 (require 'nnmail)
 (require 'nnoo)
 (require 'message)
 (require 'nnmail)
 (require 'nnoo)

+(require 'gnus-range)

 (eval-when-compile (require 'cl))
 
 (nnoo-declare nnmbox)
 (eval-when-compile (require 'cl))
 
 (nnoo-declare nnmbox)


@@ -52,18 +57,20 @@
 (defvoo nnmbox-current-group nil
   "Current nnmbox news group directory.")
 
 (defvoo nnmbox-current-group nil
   "Current nnmbox news group directory.")
 

-(defconst nnmbox-mbox-buffer nil)
+(defvar nnmbox-mbox-buffer nil)

 
 (defvoo nnmbox-status-string "")
 
 (defvoo nnmbox-group-alist nil)
 (defvoo nnmbox-active-timestamp nil)
 
 
 (defvoo nnmbox-status-string "")
 
 (defvoo nnmbox-group-alist nil)
 (defvoo nnmbox-active-timestamp nil)
 

-(defvoo nnmbox-file-coding-system mm-text-coding-system)
+(defvoo nnmbox-file-coding-system mm-binary-coding-system)

 (defvoo nnmbox-file-coding-system-for-write nil)
 (defvoo nnmbox-file-coding-system-for-write nil)

-(defvoo nnmbox-active-file-coding-system mm-text-coding-system)
+(defvoo nnmbox-active-file-coding-system mm-binary-coding-system)

 (defvoo nnmbox-active-file-coding-system-for-write nil)
 
 (defvoo nnmbox-active-file-coding-system-for-write nil)
 

+(defvar nnmbox-group-building-active-articles nil)
+(defvar nnmbox-group-active-articles nil)

 \f
 
 ;;; Interface functions
 \f
 
 ;;; Interface functions


@@ -71,20 +78,16 @@
 (nnoo-define-basics nnmbox)
 
 (deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
 (nnoo-define-basics nnmbox)
 
 (deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)

-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer

     (erase-buffer)
     (let ((number (length sequence))
          (count 0)
     (erase-buffer)
     (let ((number (length sequence))
          (count 0)

-         article art-string start stop)
+         article start stop)

       (nnmbox-possibly-change-newsgroup newsgroup server)
       (while sequence
        (setq article (car sequence))
       (nnmbox-possibly-change-newsgroup newsgroup server)
       (while sequence
        (setq article (car sequence))

-       (setq art-string (nnmbox-article-string article))

        (set-buffer nnmbox-mbox-buffer)
        (set-buffer nnmbox-mbox-buffer)

-       (when (or (search-forward art-string nil t)
-                 (progn (goto-char (point-min))
-                        (search-forward art-string nil t)))
+       (when (nnmbox-find-article article)

          (setq start
                (save-excursion
                  (re-search-backward
          (setq start
                (save-excursion
                  (re-search-backward


@@ -144,33 +147,32 @@
 
 (deffoo nnmbox-request-article (article &optional newsgroup server buffer)
   (nnmbox-possibly-change-newsgroup newsgroup server)
 
 (deffoo nnmbox-request-article (article &optional newsgroup server buffer)
   (nnmbox-possibly-change-newsgroup newsgroup server)

-  (save-excursion
-    (set-buffer nnmbox-mbox-buffer)
-    (goto-char (point-min))
-    (when (search-forward (nnmbox-article-string article) nil t)
-      (let (start stop)
-       (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
-       (setq start (point))
-       (forward-line 1)
-       (or (and (re-search-forward
-                 (concat "^" message-unix-mail-delimiter) nil t)
-                (forward-line -1))
-           (goto-char (point-max)))
-       (setq stop (point))
-       (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
-         (set-buffer nntp-server-buffer)
-         (erase-buffer)
-         (insert-buffer-substring nnmbox-mbox-buffer start stop)
-         (goto-char (point-min))
-         (while (looking-at "From ")
-           (delete-char 5)
-           (insert "X-From-Line: ")
-           (forward-line 1))
-         (if (numberp article)
-             (cons nnmbox-current-group article)
-           (nnmbox-article-group-number)))))))
-
-(deffoo nnmbox-request-group (group &optional server dont-check)
+  (with-current-buffer nnmbox-mbox-buffer
+    (save-excursion
+      (when (nnmbox-find-article article)
+        (let (start stop)
+          (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
+          (setq start (point))
+          (forward-line 1)
+          (setq stop (if (re-search-forward (concat "^"
+                                                    message-unix-mail-delimiter)
+                                            nil 'move)
+                         (match-beginning 0)
+                       (point)))
+          (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+            (set-buffer nntp-server-buffer)
+            (erase-buffer)
+            (insert-buffer-substring nnmbox-mbox-buffer start stop)
+            (goto-char (point-min))
+            (while (looking-at "From ")
+              (delete-char 5)
+              (insert "X-From-Line: ")
+              (forward-line 1))
+            (if (numberp article)
+                (cons nnmbox-current-group article)
+              (nnmbox-article-group-number nil))))))))
+
+(deffoo nnmbox-request-group (group &optional server dont-check info)

   (nnmbox-possibly-change-newsgroup nil server)
   (let ((active (cadr (assoc group nnmbox-group-alist))))
     (cond
   (nnmbox-possibly-change-newsgroup nil server)
   (let ((active (cadr (assoc group nnmbox-group-alist))))
     (cond


@@ -187,7 +189,7 @@
                       (car active) (cdr active) group)))))
 
 (defun nnmbox-save-buffer ()
                       (car active) (cdr active) group)))))
 
 (defun nnmbox-save-buffer ()

-  (let ((coding-system-for-write 
+  (let ((coding-system-for-write

         (or nnmbox-file-coding-system-for-write
             nnmbox-file-coding-system)))
     (save-buffer)))
         (or nnmbox-file-coding-system-for-write
             nnmbox-file-coding-system)))
     (save-buffer)))


@@ -204,8 +206,7 @@
   (nnmail-get-new-mail
    'nnmbox
    (lambda ()
   (nnmail-get-new-mail
    'nnmbox
    (lambda ()

-     (save-excursion
-       (set-buffer nnmbox-mbox-buffer)
+     (with-current-buffer nnmbox-mbox-buffer

        (nnmbox-save-buffer)))
    (file-name-directory nnmbox-mbox-file)
    group
        (nnmbox-save-buffer)))
    (file-name-directory nnmbox-mbox-file)
    group


@@ -249,17 +250,24 @@
         rest)
     (nnmail-activate 'nnmbox)
 
         rest)
     (nnmail-activate 'nnmbox)
 

-    (save-excursion
-      (set-buffer nnmbox-mbox-buffer)
+    (with-current-buffer nnmbox-mbox-buffer

       (while (and articles is-old)
       (while (and articles is-old)

-       (goto-char (point-min))
-       (when (search-forward (nnmbox-article-string (car articles)) nil t)
+       (when (nnmbox-find-article (car articles))

          (if (setq is-old
                    (nnmail-expired-article-p
                     newsgroup
          (if (setq is-old
                    (nnmail-expired-article-p
                     newsgroup

-                    (buffer-substring
-                     (point) (progn (end-of-line) (point))) force))
+                    (buffer-substring (point) (line-end-position))
+                    force))

              (progn
              (progn

+               (unless (eq nnmail-expiry-target 'delete)
+                 (with-temp-buffer
+                   (nnmbox-request-article (car articles)
+                                           newsgroup server
+                                           (current-buffer))
+                   (let ((nnml-current-directory nil))
+                     (nnmail-expiry-target-group
+                      nnmail-expiry-target newsgroup)))
+                 (nnmbox-possibly-change-newsgroup newsgroup server))

                (nnheader-message 5 "Deleting article %d in %s..."
                                  (car articles) newsgroup)
                (nnmbox-delete-mail))
                (nnheader-message 5 "Deleting article %d in %s..."
                                  (car articles) newsgroup)
                (nnmbox-delete-mail))


@@ -268,39 +276,33 @@
       (nnmbox-save-buffer)
       ;; Find the lowest active article in this group.
       (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
       (nnmbox-save-buffer)
       ;; Find the lowest active article in this group.
       (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))

-       (goto-char (point-min))
-       (while (and (not (search-forward
-                         (nnmbox-article-string (car active)) nil t))
+       (while (and (not (nnmbox-find-article (car active)))

                    (<= (car active) (cdr active)))
                    (<= (car active) (cdr active)))

-         (setcar active (1+ (car active)))
-         (goto-char (point-min))))
+         (setcar active (1+ (car active)))))

       (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)
       (nconc rest articles))))
 
 (deffoo nnmbox-request-move-article
       (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)
       (nconc rest articles))))
 
 (deffoo nnmbox-request-move-article

-    (article group server accept-form &optional last)
+    (article group server accept-form &optional last move-is-internal)

   (let ((buf (get-buffer-create " *nnmbox move*"))
        result)
     (and
      (nnmbox-request-article article group server)
   (let ((buf (get-buffer-create " *nnmbox move*"))
        result)
     (and
      (nnmbox-request-article article group server)

-     (save-excursion
-       (set-buffer buf)
+     (with-current-buffer buf

        (erase-buffer)
        (insert-buffer-substring nntp-server-buffer)
        (goto-char (point-min))
        (while (re-search-forward
               "^X-Gnus-Newsgroup:"
               (save-excursion (search-forward "\n\n" nil t) (point)) t)
        (erase-buffer)
        (insert-buffer-substring nntp-server-buffer)
        (goto-char (point-min))
        (while (re-search-forward
               "^X-Gnus-Newsgroup:"
               (save-excursion (search-forward "\n\n" nil t) (point)) t)

-        (delete-region (progn (beginning-of-line) (point))
-                       (progn (forward-line 1) (point))))
+        (gnus-delete-line))

        (setq result (eval accept-form))
        (kill-buffer buf)
        result)
      (save-excursion
        (nnmbox-possibly-change-newsgroup group server)
        (set-buffer nnmbox-mbox-buffer)
        (setq result (eval accept-form))
        (kill-buffer buf)
        result)
      (save-excursion
        (nnmbox-possibly-change-newsgroup group server)
        (set-buffer nnmbox-mbox-buffer)

-       (goto-char (point-min))
-       (when (search-forward (nnmbox-article-string article) nil t)
+       (when (nnmbox-find-article article)

         (nnmbox-delete-mail))
        (and last (nnmbox-save-buffer))))
     result))
         (nnmbox-delete-mail))
        (and last (nnmbox-save-buffer))))
     result))


@@ -309,36 +311,45 @@
   (nnmbox-possibly-change-newsgroup group server)
   (nnmail-check-syntax)
   (let ((buf (current-buffer))
   (nnmbox-possibly-change-newsgroup group server)
   (nnmail-check-syntax)
   (let ((buf (current-buffer))

-       result)
-    (goto-char (point-min))
-    ;; The From line may have been quoted by movemail.
-    (when (looking-at (concat ">" message-unix-mail-delimiter))
-      (delete-char 1))
-    (if (looking-at "X-From-Line: ")
-       (replace-match "From ")
-      (insert "From nobody " (current-time-string) "\n"))
+       result cont)

     (and
      (nnmail-activate 'nnmbox)
     (and
      (nnmail-activate 'nnmbox)

-     (progn
-       (set-buffer buf)
+     (with-temp-buffer
+       (insert-buffer-substring buf)

        (goto-char (point-min))
        (goto-char (point-min))

-       (search-forward "\n\n" nil t)
-       (forward-line -1)
+       (cond (;; The From line may have been quoted by movemail.
+             (looking-at (concat ">" message-unix-mail-delimiter))
+             (delete-char 1)
+             (forward-line 1))
+            ((looking-at "X-From-Line: ")
+             (replace-match "From ")
+             (forward-line 1))
+            (t
+             (insert "From nobody " (current-time-string) "\n")))
+       (narrow-to-region (point)
+                        (if (search-forward "\n\n" nil 'move)
+                            (1- (point))
+                          (point)))

        (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
         (delete-region (point) (progn (forward-line 1) (point))))
        (when nnmail-cache-accepted-message-ids
        (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
         (delete-region (point) (progn (forward-line 1) (point))))
        (when nnmail-cache-accepted-message-ids

-        (nnmail-cache-insert (nnmail-fetch-field "message-id")))