* gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed
[gnus] / lisp / gnus-agent.el
index bc5b9ff..38e96de 100644 (file)
@@ -128,6 +128,18 @@ If this is `ask' the hook will query the user."
                 (const :tag "Ask" ask))
   :group 'gnus-agent)
 
+(defcustom gnus-agent-mark-unread-after-downloaded t
+  "Indicate whether to mark articles unread after downloaded."
+  :version "21.1"
+  :type 'boolean
+  :group 'gnus-agent)
+
+(defcustom gnus-agent-download-marks '(download)
+  "Marks for downloading."
+  :version "21.1"
+  :type '(repeat (symbol :tag "Mark"))
+  :group 'gnus-agent)
+
 ;;; Internal variables
 
 (defvar gnus-agent-history-buffers nil)
@@ -143,6 +155,7 @@ If this is `ask' the hook will query the user."
 (defvar gnus-agent-file-name nil)
 (defvar gnus-agent-send-mail-function nil)
 (defvar gnus-agent-file-coding-system 'raw-text)
+(defvar gnus-agent-file-loading-cache nil)
 
 ;; Dynamic variables
 (defvar gnus-headers)
@@ -312,7 +325,7 @@ If this is `ask' the hook will query the user."
        ["Mark as downloadable" gnus-agent-mark-article t]
        ["Unmark as downloadable" gnus-agent-unmark-article t]
        ["Toggle mark" gnus-agent-toggle-mark t]
-       ["Fetch downloadable" gnus-aget-summary-fetch-group t]
+       ["Fetch downloadable" gnus-agent-summary-fetch-group t]
        ["Catchup undownloaded" gnus-agent-catchup t]))))
 
 (defvar gnus-agent-server-mode-map (make-sparse-keymap))
@@ -379,6 +392,13 @@ If this is `ask' the hook will query the user."
   (setq gnus-plugged t)
   (gnus))
 
+;;;###autoload
+(defun gnus-slave-unplugged (&optional arg)
+  "Read news as a slave unplugged."
+  (interactive "P")
+  (setq gnus-plugged nil)
+  (gnus arg nil 'slave))
+
 ;;;###autoload
 (defun gnus-agentize ()
   "Allow Gnus to be an offline newsreader.
@@ -670,7 +690,8 @@ the actual number of articles toggled is returned."
          (push article gnus-newsgroup-undownloaded))
       (setq gnus-newsgroup-undownloaded
            (delq article gnus-newsgroup-undownloaded))
-      (push article gnus-newsgroup-downloadable))
+      (setq gnus-newsgroup-downloadable
+           (gnus-add-to-sorted-list gnus-newsgroup-downloadable article)))
     (gnus-summary-update-mark
      (if unmark gnus-undownloaded-mark gnus-downloadable-mark)
      'unread)))
@@ -731,7 +752,8 @@ the actual number of articles toggled is returned."
            (dolist (article articles)
              (setq gnus-newsgroup-downloadable
                    (delq article gnus-newsgroup-downloadable))
-             (gnus-summary-mark-article article gnus-unread-mark))))
+             (if gnus-agent-mark-unread-after-downloaded
+                 (gnus-summary-mark-article article gnus-unread-mark)))))
       (when (and (not state)
                 gnus-plugged)
        (gnus-agent-toggle-plugged nil)))))
@@ -943,33 +965,35 @@ the actual number of articles toggled is returned."
          (while pos
            (narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
            (goto-char (point-min))
-           (when (search-forward "\n\n" nil t)
-             (when (search-backward "\nXrefs: " nil t)
-               ;; Handle crossposting.
-               (skip-chars-forward "^ ")
-               (skip-chars-forward " ")
-               (setq crosses nil)
-               (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +")
-                 (push (cons (buffer-substring (match-beginning 1)
-                                               (match-end 1))
-                             (buffer-substring (match-beginning 2)
-                                               (match-end 2)))
-                       crosses)
-                 (goto-char (match-end 0)))
-               (gnus-agent-crosspost crosses (caar pos))))
-           (goto-char (point-min))
-           (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t))
-               (setq id "No-Message-ID-in-article")
-             (setq id (buffer-substring (match-beginning 1) (match-end 1))))
-           (let ((coding-system-for-write
-                  gnus-agent-file-coding-system))
-             (write-region (point-min) (point-max)
-                           (concat dir (number-to-string (caar pos)))
-                           nil 'silent))
-           (when (setq elem (assq (caar pos) gnus-agent-article-alist))
-             (setcdr elem t))
-           (gnus-agent-enter-history
-            id (or crosses (list (cons group (caar pos)))) date)
+           (unless (eobp)  ;; Don't save empty articles.
+             (when (search-forward "\n\n" nil t)
+               (when (search-backward "\nXrefs: " nil t)
+                 ;; Handle cross posting.
+                 (skip-chars-forward "^ ")
+                 (skip-chars-forward " ")
+                 (setq crosses nil)
+                 (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +")
+                   (push (cons (buffer-substring (match-beginning 1)
+                                                 (match-end 1))
+                               (buffer-substring (match-beginning 2)
+                                                 (match-end 2)))
+                         crosses)
+                   (goto-char (match-end 0)))
+                 (gnus-agent-crosspost crosses (caar pos))))
+             (goto-char (point-min))
+             (if (not (re-search-forward 
+                       "^Message-ID: *<\\([^>\n]+\\)>" nil t))
+                 (setq id "No-Message-ID-in-article")
+               (setq id (buffer-substring (match-beginning 1) (match-end 1))))
+             (let ((coding-system-for-write
+                    gnus-agent-file-coding-system))
+               (write-region (point-min) (point-max)
+                             (concat dir (number-to-string (caar pos)))
+                             nil 'silent))
+             (when (setq elem (assq (caar pos) gnus-agent-article-alist))
+               (setcdr elem t))
+             (gnus-agent-enter-history
+              id (or crosses (list (cons group (caar pos)))) date))
            (widen)
            (pop pos)))
        (gnus-agent-save-alist group)))))
@@ -1030,9 +1054,9 @@ the actual number of articles toggled is returned."
     (setq articles (sort (gnus-uncompress-sequence articles) '<))
     ;; Remove known articles.
     (when (gnus-agent-load-alist group)
-      (setq articles (gnus-sorted-intersection
+      (setq articles (gnus-list-range-intersection 
                      articles
-                     (gnus-uncompress-range
+                     (list
                       (cons (1+ (caar (last gnus-agent-article-alist)))
                             (cdr (gnus-active group)))))))
     ;; Fetch them.
@@ -1059,78 +1083,87 @@ the actual number of articles toggled is returned."
        articles))))
 
 (defsubst gnus-agent-copy-nov-line (article)
-  (let (b e)
+  (let (art b e)
     (set-buffer gnus-agent-overview-buffer)
-    (unless (eobp)
+    (while (and (not (eobp))
+               (< (setq art (read (current-buffer))) article))
+      (forward-line 1))
+    (beginning-of-line)
+    (if (or (eobp)
+           (not (eq article art)))
+       (set-buffer nntp-server-buffer)
       (setq b (point))
-      (if (eq article (read (current-buffer)))
-         (setq e (progn (forward-line 1) (point)))
-       (progn
-         (beginning-of-line)
-         (setq e b)))
+      (setq e (progn (forward-line 1) (point)))
       (set-buffer nntp-server-buffer)
       (insert-buffer-substring gnus-agent-overview-buffer b e))))
 
 (defun gnus-agent-braid-nov (group articles file)
-  (set-buffer gnus-agent-overview-buffer)
-  (goto-char (point-min))
-  (set-buffer nntp-server-buffer)
-  (erase-buffer)
-  (nnheader-insert-file-contents file)
-  (goto-char (point-max))
-  (if (or (= (point-min) (point-max))
-         (progn
-           (forward-line -1)
-           (< (read (current-buffer)) (car articles))))
-      ;; We have only headers that are after the older headers,
-      ;; so we just append them.
-      (progn
-       (goto-char (point-max))
-       (insert-buffer-substring gnus-agent-overview-buffer))
-    ;; We do it the hard way.
-    (nnheader-find-nov-line (car articles))
-    (gnus-agent-copy-nov-line (car articles))
-    (pop articles)
-    (while (and articles
-               (not (eobp)))
-      (while (and (not (eobp))
-                 (< (read (current-buffer)) (car articles)))
-       (forward-line 1))
-      (beginning-of-line)
-      (unless (eobp)
-       (gnus-agent-copy-nov-line (car articles))
-       (setq articles (cdr articles))))
+  (let (start last)
+    (set-buffer gnus-agent-overview-buffer)
+    (goto-char (point-min))
     (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (nnheader-insert-file-contents file)
+    (goto-char (point-max))
+    (unless (or (= (point-min) (point-max))
+               (progn
+                 (forward-line -1)
+                 (< (setq last (read (current-buffer))) (car articles))))
+      ;; We do it the hard way.
+      (nnheader-find-nov-line (car articles))
+      (gnus-agent-copy-nov-line (pop articles))
+      (while (and articles
+                 (not (eobp)))
+       (while (and (not (eobp))
+                   (< (read (current-buffer)) (car articles)))
+         (forward-line 1))
+       (beginning-of-line)
+       (unless (eobp)
+         (gnus-agent-copy-nov-line (pop articles)))))
+    ;; Copy the rest lines
+    (set-buffer nntp-server-buffer)
+    (goto-char (point-max))
     (when articles
-      (let (b e)
+      (when last
        (set-buffer gnus-agent-overview-buffer)
-       (setq b (point)
-             e (point-max))
        (while (and (not (eobp))
-                   (<= (read (current-buffer)) (car articles)))
-         (forward-line 1)
-         (setq b (point)))
-       (set-buffer nntp-server-buffer)
-       (insert-buffer-substring gnus-agent-overview-buffer b e)))))
+                   (<= (read (current-buffer)) last))
+         (forward-line 1))
+       (beginning-of-line)
+       (setq start (point))
+       (set-buffer nntp-server-buffer))
+      (insert-buffer-substring gnus-agent-overview-buffer start))))
 
 (defun gnus-agent-load-alist (group &optional dir)
   "Load the article-state alist for GROUP."
+  (let ((file ))
   (setq gnus-agent-article-alist
-       (gnus-agent-read-file
+       (gnus-cache-file-contents
         (if dir
-            (expand-file-name ".agentview" dir)
-          (gnus-agent-article-name ".agentview" group)))))
+                 (expand-file-name ".agentview" dir)
+               (gnus-agent-article-name ".agentview" group))
+        'gnus-agent-file-loading-cache
+        'gnus-agent-read-file))))
 
 (defun gnus-agent-save-alist (group &optional articles state dir)
   "Save the article-state alist for GROUP."
-  (let ((file-name-coding-system nnmail-pathname-coding-system)
-       print-level print-length item)
-    (dolist (art articles)
-      (if (setq item (memq art gnus-agent-article-alist))
-         (setcdr item state)
-       (push (cons art state) gnus-agent-article-alist)))
-    (setq gnus-agent-article-alist 
-         (sort gnus-agent-article-alist 'car-less-than-car))
+  (let* ((file-name-coding-system nnmail-pathname-coding-system)
+        (prev (cons nil gnus-agent-article-alist))
+        (all prev)
+        print-level print-length item article)
+    (while (setq article (pop articles))
+      (while (and (cdr prev)
+                (< (caadr prev) article))
+       (setq prev (cdr prev)))
+      (cond
+       ((not (cdr prev))
+       (setcdr prev (list (cons article state))))
+       ((> (caadr prev) article)
+       (setcdr prev (cons (cons article state) (cdr prev))))
+       ((= (caadr prev) article)
+       (setcdr (cadr prev) state)))
+      (setq prev (cdr prev)))
+    (setq gnus-agent-article-alist (cdr all))
     (with-temp-file (if dir
                        (expand-file-name ".agentview" dir)
                      (gnus-agent-article-name ".agentview" group))
@@ -1256,18 +1289,20 @@ the actual number of articles toggled is returned."
       (when arts
        (gnus-agent-fetch-articles group arts)))
     ;; Perhaps we have some additional articles to fetch.
-    (setq arts (assq 'download (gnus-info-marks
-                               (setq info (gnus-get-info group)))))
-    (when (cdr arts)
-      (gnus-message 8 "Agent is downloading marked articles...")
-      (gnus-agent-fetch-articles
-       group (gnus-uncompress-range (cdr arts)))
-      (setq marks (delq arts (gnus-info-marks info)))
-      (gnus-info-set-marks info marks)
-      (gnus-dribble-enter
-       (concat "(gnus-group-set-info '"
-              (gnus-prin1-to-string info)
-              ")")))))
+    (dolist (mark gnus-agent-download-marks)
+      (setq arts (assq mark (gnus-info-marks
+                            (setq info (gnus-get-info group)))))
+      (when (cdr arts)
+       (gnus-message 8 "Agent is downloading marked articles...")
+       (gnus-agent-fetch-articles
+        group (gnus-uncompress-range (cdr arts)))
+       (when (eq mark 'download)
+         (setq marks (delq arts (gnus-info-marks info)))
+         (gnus-info-set-marks info marks)
+         (gnus-dribble-enter
+          (concat "(gnus-group-set-info '"
+                  (gnus-prin1-to-string info)
+                  ")")))))))
 
 ;;;
 ;;; Agent Category Mode
@@ -1591,9 +1626,11 @@ The following commands are available:
 (defun gnus-get-predicate (predicate)
   "Return the predicate for CATEGORY."
   (or (cdr (assoc predicate gnus-category-predicate-cache))
-      (cdar (push (cons predicate
-                       (gnus-category-make-function predicate))
-                 gnus-category-predicate-cache))))
+      (let ((func (gnus-category-make-function predicate)))
+       (setq gnus-category-predicate-cache
+             (nconc gnus-category-predicate-cache
+                    (list (cons predicate func))))
+       func)))
 
 (defun gnus-group-category (group)
   "Return the category GROUP belongs to."
@@ -1825,15 +1862,15 @@ The following commands are available:
          (erase-buffer)
          (let ((nnheader-file-coding-system
                 gnus-agent-file-coding-system))
-           (nnheader-insert-file-contents file))
-         (goto-char (point-min)) 
+           (nnheader-insert-nov-file file (car articles)))
+         (nnheader-find-nov-line (car articles))
          (while (not (eobp))
            (when (looking-at "[0-9]")
              (push (read (current-buffer)) cached-articles))
            (forward-line 1))
-         (setq cached-articles (sort cached-articles '<))))
+         (setq cached-articles (nreverse cached-articles))))
       (if (setq uncached-articles 
-               (gnus-set-difference articles cached-articles))
+               (gnus-sorted-difference articles cached-articles))
          (progn
            (set-buffer nntp-server-buffer)
            (erase-buffer)