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

[gnus] / lisp / nnvirtual.el

diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el
index a08dc37..f67943a 100644 (file)
--- a/lisp/nnvirtual.el
+++ b/lisp/nnvirtual.el
@@ -1,17 +1,18 @@
 ;;; nnvirtual.el --- virtual newsgroups access for Gnus
 ;;; nnvirtual.el --- virtual newsgroups access for Gnus

-;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
+
+;; Copyright (C) 1994-2014 Free Software Foundation, Inc.

 
 ;; Author: David Moore <dmoore@ucsd.edu>
 
 ;; Author: David Moore <dmoore@ucsd.edu>

-;;     Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>

 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
 ;; Keywords: news
 
 ;; 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
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -19,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; 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:
 


@@ -38,19 +37,19 @@
 (require 'gnus-util)
 (require 'gnus-start)
 (require 'gnus-sum)
 (require 'gnus-util)
 (require 'gnus-start)
 (require 'gnus-sum)

+(require 'gnus-msg)

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

-(defvoo nnvirtual-always-rescan nil
-  "*If non-nil, always scan groups for unread articles when entering a group.
-If this variable is nil (which is the default) and you read articles
-in a component group after the virtual group has been activated, the
-read articles from the component group will show up when you enter the
-virtual group.")
+(defvoo nnvirtual-always-rescan t
+  "If non-nil, always scan groups for unread articles when entering a group.
+If this variable is nil and you read articles in a component group
+after the virtual group has been activated, the read articles from the
+component group will show up when you enter the virtual group.")

 
 (defvoo nnvirtual-component-regexp nil
 
 (defvoo nnvirtual-component-regexp nil

-  "*Regexp to match component groups.")
+  "Regexp to match component groups.")

 
 (defvoo nnvirtual-component-groups nil
   "Component group in this nnvirtual group.")
 
 (defvoo nnvirtual-component-groups nil
   "Component group in this nnvirtual group.")


@@ -62,8 +61,7 @@ virtual group.")
 (defvoo nnvirtual-current-group nil)
 
 (defvoo nnvirtual-mapping-table nil
 (defvoo nnvirtual-current-group nil)
 
 (defvoo nnvirtual-mapping-table nil

-  "Table of rules on how to map between component group and article number
-to virtual article number.")
+  "Table of rules on how to map between component group and article number to virtual article number.")

 
 (defvoo nnvirtual-mapping-offsets nil
   "Table indexed by component group to an offset to be applied to article numbers in that group.")
 
 (defvoo nnvirtual-mapping-offsets nil
   "Table indexed by component group to an offset to be applied to article numbers in that group.")


@@ -77,10 +75,12 @@ to virtual article number.")
 (defvoo nnvirtual-mapping-marks nil
   "Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
 
 (defvoo nnvirtual-mapping-marks nil
   "Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
 

+(defvoo nnvirtual-info-installed nil
+  "T if we have already installed the group info for this group, and shouldn't blast over it again.")
+

 (defvoo nnvirtual-status-string "")
 
 (defvoo nnvirtual-status-string "")
 

-(eval-and-compile
-  (autoload 'gnus-cache-articles-in-group "gnus-cache"))
+(autoload 'gnus-cache-articles-in-group "gnus-cache")

 
 \f
 
 
 \f
 


@@ -92,12 +92,11 @@ to virtual article number.")
 (deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
                                             server fetch-old)
   (when (nnvirtual-possibly-change-server server)
 (deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
                                             server fetch-old)
   (when (nnvirtual-possibly-change-server server)

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

       (erase-buffer)
       (if (stringp (car articles))
          'headers
       (erase-buffer)
       (if (stringp (car articles))
          'headers

-       (let ((vbuf (nnheader-set-temp-buffer 
+       (let ((vbuf (nnheader-set-temp-buffer

                     (get-buffer-create " *virtual headers*")))
              (carticles (nnvirtual-partition-sequence articles))
              (system-name (system-name))
                     (get-buffer-create " *virtual headers*")))
              (carticles (nnvirtual-partition-sequence articles))
              (system-name (system-name))


@@ -118,47 +117,47 @@ to virtual article number.")
                       (let ((gnus-use-cache t))
                         (setq result (gnus-retrieve-headers
                                       articles cgroup nil))))
                       (let ((gnus-use-cache t))
                         (setq result (gnus-retrieve-headers
                                       articles cgroup nil))))

-           (set-buffer nntp-server-buffer)
-           ;; If we got HEAD headers, we convert them into NOV
-           ;; headers.  This is slow, inefficient and, come to think
-           ;; of it, downright evil.  So sue me.  I couldn't be
-           ;; bothered to write a header parse routine that could
-           ;; parse a mixed HEAD/NOV buffer.
-           (when (eq result 'headers)
-             (nnvirtual-convert-headers))
-           (goto-char (point-min))
-           (while (not (eobp))
-             (delete-region (point)
-                            (progn
-                              (setq carticle (read nntp-server-buffer))
-                              (point)))
-
-             ;; We remove this article from the articles list, if
-             ;; anything is left in the articles list after going through
-             ;; the entire buffer, then those articles have been
-             ;; expired or canceled, so we appropriately update the
-             ;; component group below.  They should be coming up
-             ;; generally in order, so this shouldn't be slow.
-             (setq articles (delq carticle articles))
-             
-             (setq article (nnvirtual-reverse-map-article cgroup carticle))
-             (if (null article)
-                 ;; This line has no reverse mapping, that means it
-                 ;; was an extra article reference returned by nntp.
-                 (progn
-                   (beginning-of-line)
-                   (delete-region (point) (progn (forward-line 1) (point))))
-               ;; Otherwise insert the virtual article number,
-               ;; and clean up the xrefs.
-               (princ article nntp-server-buffer)
-               (nnvirtual-update-xref-header cgroup carticle
-                                             prefix system-name)
-               (forward-line 1))
-             )
-           
-           (set-buffer vbuf)
-           (goto-char (point-max))
-           (insert-buffer-substring nntp-server-buffer))
+             (set-buffer nntp-server-buffer)
+             ;; If we got HEAD headers, we convert them into NOV
+             ;; headers.  This is slow, inefficient and, come to think
+             ;; of it, downright evil.  So sue me.  I couldn't be
+             ;; bothered to write a header parse routine that could
+             ;; parse a mixed HEAD/NOV buffer.
+             (when (eq result 'headers)
+               (nnvirtual-convert-headers))
+             (goto-char (point-min))
+             (while (not (eobp))
+               (delete-region (point)
+                              (progn
+                                (setq carticle (read nntp-server-buffer))
+                                (point)))
+
+               ;; We remove this article from the articles list, if
+               ;; anything is left in the articles list after going through
+               ;; the entire buffer, then those articles have been
+               ;; expired or canceled, so we appropriately update the
+               ;; component group below.  They should be coming up
+               ;; generally in order, so this shouldn't be slow.
+               (setq articles (delq carticle articles))
+
+               (setq article (nnvirtual-reverse-map-article cgroup carticle))
+               (if (null article)
+                   ;; This line has no reverse mapping, that means it
+                   ;; was an extra article reference returned by nntp.
+                   (progn
+                     (beginning-of-line)
+                     (delete-region (point) (progn (forward-line 1) (point))))
+                 ;; Otherwise insert the virtual article number,
+                 ;; and clean up the xrefs.
+                 (princ article nntp-server-buffer)
+                 (nnvirtual-update-xref-header cgroup carticle
+                                               prefix system-name)
+                 (forward-line 1))
+               )
+
+             (set-buffer vbuf)
+             (goto-char (point-max))
+             (insert-buffer-substring nntp-server-buffer))

            ;; Anything left in articles is expired or canceled.
            ;; Could be smart and not tell it about articles already known?
            (when articles
            ;; Anything left in articles is expired or canceled.
            ;; Could be smart and not tell it about articles already known?
            (when articles


@@ -169,8 +168,7 @@ to virtual article number.")
          ;; the nntp-server-buffer, which is where Gnus expects to find
          ;; them.
          (prog1
          ;; the nntp-server-buffer, which is where Gnus expects to find
          ;; them.
          (prog1

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

                (erase-buffer)
                (insert-buffer-substring vbuf)
                ;; FIX FIX FIX, we should be able to sort faster than
                (erase-buffer)
                (insert-buffer-substring vbuf)
                ;; FIX FIX FIX, we should be able to sort faster than


@@ -181,26 +179,45 @@ to virtual article number.")
            (kill-buffer vbuf)))))))
 
 
            (kill-buffer vbuf)))))))
 
 

+(defvoo nnvirtual-last-accessed-component-group nil)

 
 (deffoo nnvirtual-request-article (article &optional group server buffer)
 
 (deffoo nnvirtual-request-article (article &optional group server buffer)

-  (when (and (nnvirtual-possibly-change-server server)
-            (numberp article))
-    (let* ((amap (nnvirtual-map-article article))
-          (cgroup (car amap)))
-      (cond
-       ((not amap)
-       (nnheader-report 'nnvirtual "No such article: %s" article))
-       ((not (gnus-check-group cgroup))
-       (nnheader-report
-        'nnvirtual "Can't open server where %s exists" cgroup))
-       ((not (gnus-request-group cgroup t))
-       (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
-       (t
-       (if buffer 
-           (save-excursion
-             (set-buffer buffer)
-             (gnus-request-article-this-buffer (cdr amap) cgroup))
-         (gnus-request-article (cdr amap) cgroup)))))))
+  (when (nnvirtual-possibly-change-server server)
+    (if (stringp article)
+       ;; This is a fetch by Message-ID.
+       (cond
+        ((not nnvirtual-last-accessed-component-group)
+         (nnheader-report
+          'nnvirtual "Don't know what server to request from"))
+        (t
+         (save-excursion
+           (when buffer
+             (set-buffer buffer))
+           (let* ((gnus-override-method nil)
+                  (gnus-command-method
+                   (gnus-find-method-for-group
+                    nnvirtual-last-accessed-component-group)))
+             (funcall (gnus-get-function gnus-command-method 'request-article)
+                      article nil (nth 1 gnus-command-method) buffer)))))
+      ;; This is a fetch by number.
+      (let* ((amap (nnvirtual-map-article article))
+            (cgroup (car amap)))
+       (cond
+        ((not amap)
+         (nnheader-report 'nnvirtual "No such article: %s" article))
+        ((not (gnus-check-group cgroup))
+         (nnheader-report
+          'nnvirtual "Can't open server where %s exists" cgroup))
+        ((not (gnus-request-group cgroup t))
+         (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
+        (t
+         (setq nnvirtual-last-accessed-component-group cgroup)
+         (if buffer
+             (with-current-buffer buffer
+               ;; We bind this here to avoid double decoding.
+               (let ((gnus-article-decode-hook nil))
+                 (gnus-request-article-this-buffer (cdr amap) cgroup)))
+           (gnus-request-article (cdr amap) cgroup))))))))

 
 
 (deffoo nnvirtual-open-server (server &optional defs)
 
 
 (deffoo nnvirtual-open-server (server &optional defs)


@@ -214,7 +231,8 @@ to virtual article number.")
          nnvirtual-mapping-offsets nil
          nnvirtual-mapping-len 0
          nnvirtual-mapping-reads nil
          nnvirtual-mapping-offsets nil
          nnvirtual-mapping-len 0
          nnvirtual-mapping-reads nil

-         nnvirtual-mapping-marks nil)
+         nnvirtual-mapping-marks nil
+         nnvirtual-info-installed nil)

     (when nnvirtual-component-regexp
       ;; Go through the newsrc alist and find all component groups.
       (let ((newsrc (cdr gnus-newsrc-alist))
     (when nnvirtual-component-regexp
       ;; Go through the newsrc alist and find all component groups.
       (let ((newsrc (cdr gnus-newsrc-alist))


@@ -229,7 +247,7 @@ to virtual article number.")
       t)))
 
 
       t)))
 
 

-(deffoo nnvirtual-request-group (group &optional server dont-check)
+(deffoo nnvirtual-request-group (group &optional server dont-check info)

   (nnvirtual-possibly-change-server server)
   (setq nnvirtual-component-groups
        (delete (nnvirtual-current-group) nnvirtual-component-groups))
   (nnvirtual-possibly-change-server server)
   (setq nnvirtual-component-groups
        (delete (nnvirtual-current-group) nnvirtual-component-groups))


@@ -238,42 +256,43 @@ to virtual article number.")
     (setq nnvirtual-current-group nil)
     (nnheader-report 'nnvirtual "No component groups in %s" group))
    (t
     (setq nnvirtual-current-group nil)
     (nnheader-report 'nnvirtual "No component groups in %s" group))
    (t

-    (when (or (not dont-check)
-             nnvirtual-always-rescan)
-      (nnvirtual-create-mapping))

     (setq nnvirtual-current-group group)
     (setq nnvirtual-current-group group)

-    (nnheader-insert "211 %d 1 %d %s\n" 
+    (nnvirtual-create-mapping dont-check)
+    (when nnvirtual-always-rescan
+      (nnvirtual-request-update-info
+       (nnvirtual-current-group)
+       (gnus-get-info (nnvirtual-current-group))))
+    (nnheader-insert "211 %d 1 %d %s\n"

                     nnvirtual-mapping-len nnvirtual-mapping-len group))))
 
 
 (deffoo nnvirtual-request-type (group &optional article)
   (if (not article)
       'unknown
                     nnvirtual-mapping-len nnvirtual-mapping-len group))))
 
 
 (deffoo nnvirtual-request-type (group &optional article)
   (if (not article)
       'unknown

-    (let ((mart (nnvirtual-map-article article)))
-      (when mart
-       (gnus-request-type (car mart) (cdr mart))))))
+    (if (numberp article)
+       (let ((mart (nnvirtual-map-article article)))
+         (if mart
+             (gnus-request-type (car mart) (cdr mart))))
+      (gnus-request-type
+       nnvirtual-last-accessed-component-group nil))))

 
 (deffoo nnvirtual-request-update-mark (group article mark)
   (let* ((nart (nnvirtual-map-article article))
 
 (deffoo nnvirtual-request-update-mark (group article mark)
   (let* ((nart (nnvirtual-map-article article))

-        (cgroup (car nart))
-        ;; The component group might be a virtual group.
-        (nmark (gnus-request-update-mark cgroup (cdr nart) mark)))
+        (cgroup (car nart)))

     (when (and nart
     (when (and nart

-              (= mark nmark)
+              (memq mark gnus-auto-expirable-marks)
+              ;; The component group might be a virtual group.
+              (= mark (gnus-request-update-mark cgroup (cdr nart) mark))

               (gnus-group-auto-expirable-p cgroup))
       (setq mark gnus-expirable-mark)))
   mark)
 
               (gnus-group-auto-expirable-p cgroup))
       (setq mark gnus-expirable-mark)))
   mark)
 

-    
+

 (deffoo nnvirtual-close-group (group &optional server)
   (when (and (nnvirtual-possibly-change-server server)
             (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
     (nnvirtual-update-read-and-marked t t))
   t)
 (deffoo nnvirtual-close-group (group &optional server)
   (when (and (nnvirtual-possibly-change-server server)
             (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
     (nnvirtual-update-read-and-marked t t))
   t)

-    
-
-(deffoo nnvirtual-request-list (&optional server)
-  (nnheader-report 'nnvirtual "LIST is not implemented."))

 
 
 (deffoo nnvirtual-request-newgroups (date &optional server)
 
 
 (deffoo nnvirtual-request-newgroups (date &optional server)


@@ -285,7 +304,8 @@ to virtual article number.")
 
 
 (deffoo nnvirtual-request-update-info (group info &optional server)
 
 
 (deffoo nnvirtual-request-update-info (group info &optional server)

-  (when (nnvirtual-possibly-change-server server)
+  (when (and (nnvirtual-possibly-change-server server)
+            (not nnvirtual-info-installed))

     ;; Install the precomputed lists atomically, so the virtual group
     ;; is not left in a half-way state in case of C-g.
     (gnus-atomic-progn
     ;; Install the precomputed lists atomically, so the virtual group
     ;; is not left in a half-way state in case of C-g.
     (gnus-atomic-progn


@@ -293,9 +313,10 @@ to virtual article number.")
       (if (nthcdr 3 info)
          (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
        (when nnvirtual-mapping-marks
       (if (nthcdr 3 info)
          (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
        (when nnvirtual-mapping-marks

-         (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks)))))
+         (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
+      (setq nnvirtual-info-installed t))

     t))
     t))

-      
+

 
 (deffoo nnvirtual-catchup-group (group &optional server all)
   (when (and (nnvirtual-possibly-change-server server)
 
 (deffoo nnvirtual-catchup-group (group &optional server all)
   (when (and (nnvirtual-possibly-change-server server)


@@ -306,13 +327,12 @@ to virtual article number.")
     (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
          (gnus-expert-user t))
       ;; Make sure all groups are activated.
     (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
          (gnus-expert-user t))
       ;; Make sure all groups are activated.

-      (mapcar
+      (mapc

        (lambda (g)
        (lambda (g)

-        (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
+        (when (not (numberp (gnus-group-unread g)))

           (gnus-activate-group g)))
        nnvirtual-component-groups)
           (gnus-activate-group g)))
        nnvirtual-component-groups)

-      (save-excursion
-       (set-buffer gnus-group-buffer)
+      (with-current-buffer gnus-group-buffer

        (gnus-group-catchup-current nil all)))))
 
 
        (gnus-group-catchup-current nil all)))))
 
 


@@ -320,19 +340,42 @@ to virtual article number.")
   "Return the real group and article for virtual GROUP and ARTICLE."
   (nnvirtual-map-article article))
 
   "Return the real group and article for virtual GROUP and ARTICLE."
   (nnvirtual-map-article article))
 

+
+(deffoo nnvirtual-request-post (&optional server)
+  (if (not gnus-message-group-art)
+      (nnheader-report 'nnvirtual "Can't post to an nnvirtual group")
+    (let ((group (car (nnvirtual-find-group-art
+                      (car gnus-message-group-art)
+                      (cdr gnus-message-group-art)))))
+      (gnus-request-post (gnus-find-method-for-group group)))))
+
+
+(deffoo nnvirtual-request-expire-articles (articles group
+                                                   &optional server force)
+  (nnvirtual-possibly-change-server server)
+  (setq nnvirtual-component-groups
+       (delete (nnvirtual-current-group) nnvirtual-component-groups))
+  (let (unexpired)
+    (dolist (group nnvirtual-component-groups)
+      (setq unexpired (nconc unexpired
+                            (mapcar
+                             #'(lambda (article)
+                                 (nnvirtual-reverse-map-article
+                                  group article))
+                             (gnus-uncompress-range
+                              (gnus-group-expire-articles-1 group))))))
+    (sort (delq nil unexpired) '<)))
+

 \f
 ;;; Internal functions.
 
 (defun nnvirtual-convert-headers ()
   "Convert HEAD headers into NOV headers."
 \f
 ;;; Internal functions.
 
 (defun nnvirtual-convert-headers ()
   "Convert HEAD headers into NOV headers."

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

     (let* ((dependencies (make-vector 100 0))
     (let* ((dependencies (make-vector 100 0))

-          (headers (gnus-get-newsgroup-headers dependencies))
-          header)
+          (headers (gnus-get-newsgroup-headers dependencies)))

       (erase-buffer)
       (erase-buffer)

-      (while (setq header (pop headers))
-       (nnheader-insert-nov header)))))
+      (mapc 'nnheader-insert-nov headers))))

 
 
 (defun nnvirtual-update-xref-header (group article prefix system-name)
 
 
 (defun nnvirtual-update-xref-header (group article prefix system-name)


@@ -342,36 +385,43 @@ to virtual article number.")
   (looking-at
    "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
   (goto-char (match-end 0))
   (looking-at
    "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
   (goto-char (match-end 0))

-  (unless (search-forward "\t" (gnus-point-at-eol) 'move)
+  (unless (search-forward "\t" (point-at-eol) 'move)

     (insert "\t"))
 
   ;; Remove any spaces at the beginning of the Xref field.
     (insert "\t"))
 
   ;; Remove any spaces at the beginning of the Xref field.

-  (while (= (char-after (1- (point))) ? )
+  (while (eq (char-after (1- (point))) ? )

     (forward-char -1)
     (delete-char 1))
 
   (insert "Xref: " system-name " " group ":")
   (princ article (current-buffer))
     (forward-char -1)