Importing gnus-5.6.44.
[elisp/gnus.git-] / lisp / gnus-agent.el
index b4654fd..cb4d0d8 100644 (file)
@@ -27,9 +27,7 @@
 (require 'gnus-cache)
 (require 'nnvirtual)
 (require 'gnus-sum)
-(eval-when-compile
-  (require 'cl)
-  (require 'gnus-score))
+(eval-when-compile (require 'cl))
 
 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
   "Where the Gnus agent will store its files."
@@ -79,6 +77,8 @@ If nil, only read articles will be expired."
 
 ;;; Internal variables
 
+(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
+
 (defvar gnus-agent-history-buffers nil)
 (defvar gnus-agent-buffer-alist nil)
 (defvar gnus-agent-article-alist nil)
@@ -94,13 +94,6 @@ If nil, only read articles will be expired."
 (defvar gnus-agent-send-mail-function nil)
 (defvar gnus-agent-file-coding-system 'no-conversion)
 
-(defconst gnus-agent-scoreable-headers
-  (list
-   "subject" "from" "date" "message-id" 
-   "references" "chars" "lines" "xref")
-  "Headers that are considered when scoring articles
-for download via the Agent.")
-
 ;; Dynamic variables
 (defvar gnus-headers)
 (defvar gnus-score)
@@ -134,7 +127,7 @@ for download via the Agent.")
 
 (defun gnus-agent-read-file (file)
   "Load FILE and do a `read' there."
-  (with-temp-buffer
+  (nnheader-temp-write nil
     (ignore-errors
       (nnheader-insert-file-contents file)
       (goto-char (point-min))
@@ -341,7 +334,7 @@ agent minor mode in all Gnus buffers."
      (concat "^" (regexp-quote mail-header-separator) "\n"))
     (replace-match "\n")
     (gnus-agent-insert-meta-information 'mail)
-    (gnus-request-accept-article "nndraft:queue" nil t t)))
+    (gnus-request-accept-article "nndraft:queue")))
 
 (defun gnus-agent-insert-meta-information (type &optional method)
   "Insert meta-information into the message that says how it's to be posted.
@@ -434,7 +427,7 @@ be a select method."
 
 (defun gnus-agent-write-servers ()
   "Write the alist of covered servers."
-  (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
+  (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers")
     (prin1 gnus-agent-covered-methods (current-buffer))))
 
 ;;;
@@ -545,7 +538,7 @@ the actual number of articles toggled is returned."
                     (gnus-agent-lib-file "active")
                   (gnus-agent-lib-file "groups"))))
       (gnus-make-directory (file-name-directory file))
-      (with-temp-file file
+      (nnheader-temp-write file
        (when (file-exists-p file)
          (nnheader-insert-file-contents file))
        (goto-char (point-min))
@@ -663,7 +656,7 @@ the actual number of articles toggled is returned."
       (let ((dir (concat
                  (gnus-agent-directory)
                  (gnus-agent-group-path group) "/"))
-           (date (time-to-days (current-time)))
+           (date (gnus-time-to-day (current-time)))
            (case-fold-search t)
            pos crosses id elem)
        (gnus-make-directory dir)
@@ -671,7 +664,7 @@ the actual number of articles toggled is returned."
        ;; Fetch the articles from the backend.
        (if (gnus-check-backend-function 'retrieve-articles group)
            (setq pos (gnus-retrieve-articles articles group))
-         (with-temp-file nil
+         (nnheader-temp-write nil
            (let (article)
              (while (setq article (pop articles))
                (when (gnus-request-article article group)
@@ -756,43 +749,43 @@ the actual number of articles toggled is returned."
                      nil 'silent))
       (pop gnus-agent-buffer-alist))
     (while gnus-agent-group-alist
-      (with-temp-file (caar gnus-agent-group-alist)
+      (nnheader-temp-write (caar gnus-agent-group-alist)
        (princ (cdar gnus-agent-group-alist))
        (insert "\n"))
       (pop gnus-agent-group-alist))))
 
 (defun gnus-agent-fetch-headers (group &optional force)
   (let ((articles (if (gnus-agent-load-alist group)   
-                     (gnus-sorted-intersection
-                      (gnus-list-of-unread-articles group)
-                      (gnus-uncompress-range
-                       (cons (1+ (caar (last gnus-agent-article-alist)))
-                             (cdr (gnus-active group)))))
-                   (gnus-list-of-unread-articles group))))
+                     (gnus-sorted-intersection
+                      (gnus-list-of-unread-articles group)
+                      (gnus-uncompress-range
+                       (cons (1+ (caar (last gnus-agent-article-alist)))
+                             (cdr (gnus-active group)))))
+                   (gnus-list-of-unread-articles group))))
     ;; Fetch them.
     (when articles
       (gnus-message 7 "Fetching headers for %s..." group)
       (save-excursion
-       (set-buffer nntp-server-buffer)
-       (unless (eq 'nov (gnus-retrieve-headers articles group))
-         (nnvirtual-convert-headers))
-       ;; Save these headers for later processing.
-       (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
-       (let (file)
-         (when (file-exists-p
-                (setq file (gnus-agent-article-name ".overview" group)))
-           (gnus-agent-braid-nov group articles file))
-         (gnus-make-directory (nnheader-translate-file-chars
-                               (file-name-directory file)))
-         (let ((coding-system-for-write
-                gnus-agent-file-coding-system))
-           (write-region (point-min) (point-max) file nil 'silent))
-         (gnus-agent-save-alist group articles nil)
-         (gnus-agent-enter-history
-          "last-header-fetched-for-session"
-          (list (cons group (nth (- (length  articles) 1) articles)))
-          (time-to-days (current-time)))
-         articles)))))
+       (set-buffer nntp-server-buffer)
+       (unless (eq 'nov (gnus-retrieve-headers articles group))
+         (nnvirtual-convert-headers))
+       ;; Save these headers for later processing.
+       (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+       (let (file)
+         (when (file-exists-p
+                (setq file (gnus-agent-article-name ".overview" group)))
+           (gnus-agent-braid-nov group articles file))
+         (gnus-make-directory (nnheader-translate-file-chars
+                               (file-name-directory file)))
+         (let ((coding-system-for-write
+                gnus-agent-file-coding-system))
+           (write-region (point-min) (point-max) file nil 'silent))
+         (gnus-agent-save-alist group articles nil)
+         (gnus-agent-enter-history
+          "last-header-fetched-for-session"
+          (list (cons group (nth (- (length  articles) 1) articles)))
+          (gnus-time-to-day (current-time)))
+         articles)))))
 
 (defsubst gnus-agent-copy-nov-line (article)
   (let (b e)
@@ -853,9 +846,9 @@ the actual number of articles toggled is returned."
 
 (defun gnus-agent-save-alist (group &optional articles state dir)
   "Save the article-state alist for GROUP."
-  (with-temp-file (if dir
-                     (concat dir ".agentview")
-                   (gnus-agent-article-name ".agentview" group))
+  (nnheader-temp-write (if dir
+                          (concat dir ".agentview")
+                        (gnus-agent-article-name ".agentview" group))
     (princ (setq gnus-agent-article-alist
                 (nconc gnus-agent-article-alist
                        (mapcar (lambda (article) (cons article state))
@@ -910,63 +903,27 @@ the actual number of articles toggled is returned."
       ;; Parse them and see which articles we want to fetch.
       (setq gnus-newsgroup-dependencies
            (make-vector (length articles) 0))
-      ;; No need to call `gnus-get-newsgroup-headers-xover' with 
-      ;; the entire .overview for group as we still have the just
-      ;; downloaded headers in `gnus-agent-overview-buffer'.
-      (let ((nntp-server-buffer gnus-agent-overview-buffer))
-       (setq gnus-newsgroup-headers
-             (gnus-get-newsgroup-headers-xover articles nil nil group)))
+      (setq gnus-newsgroup-headers
+           (gnus-get-newsgroup-headers-xover articles nil nil group))
       (setq category (gnus-group-category group))
       (setq predicate
            (gnus-get-predicate 
-            (or (gnus-group-get-parameter group 'agent-predicate t)
+            (or (gnus-group-get-parameter group 'agent-predicate)
                 (cadr category))))
-      ;; Do we want to download everything, or nothing?
-      (if (or (eq (caaddr predicate) 'gnus-agent-true)
-             (eq (caaddr predicate) 'gnus-agent-false))
-         ;; Yes.
-         (setq arts (symbol-value 
-                     (cadr (assoc (caaddr predicate) 
-                                  '((gnus-agent-true articles)
-                                    (gnus-agent-false nil))))))
-       ;; No, we need to decide what we want.
-       (setq score-param
-             (let ((score-method (or 
-                                  (gnus-group-get-parameter group 'agent-score t)
-                                  (caddr category))))
-               (when score-method
-                 (require 'gnus-score)
-                 (if (eq score-method 'file)
-                     (let ((entries
-                            (gnus-score-load-files
-                             (gnus-all-score-files group)))
-                           list score-file)
-                       (while (setq list (car entries))
-                         (push (car list) score-file)
-                         (setq list (cdr list))
-                         (while list
-                           (when (member (caar list)
-                                         gnus-agent-scoreable-headers)
-                             (push (car list) score-file))
-                           (setq list (cdr list)))
-                         (setq score-param 
-                               (append score-param (list (nreverse score-file)))
-                               score-file nil entries (cdr entries)))
-                       (list score-param))
-                   (if (stringp (car score-method))
-                       score-method
-                     (list (list score-method)))))))
-       (when score-param
-         (gnus-score-headers score-param))
-       (setq arts nil)
-       (while (setq gnus-headers (pop gnus-newsgroup-headers))
-         (setq gnus-score
-               (or (cdr (assq (mail-header-number gnus-headers)
-                              gnus-newsgroup-scored))
-                   gnus-summary-default-score))
-         (when (funcall predicate)
-           (push (mail-header-number gnus-headers)
-                 arts))))
+      (setq score-param
+           (or (gnus-group-get-parameter group 'agent-score)
+               (caddr category)))
+      (when score-param
+       (gnus-score-headers (list (list score-param))))
+      (setq arts nil)
+      (while (setq gnus-headers (pop gnus-newsgroup-headers))
+       (setq gnus-score
+             (or (cdr (assq (mail-header-number gnus-headers)
+                            gnus-newsgroup-scored))
+                 gnus-summary-default-score))
+       (when (funcall predicate)
+         (push (mail-header-number gnus-headers)
+               arts)))
       ;; Fetch the articles.
       (when arts
        (gnus-agent-fetch-articles group arts)))
@@ -1079,7 +1036,7 @@ The following commands are available:
   (gnus-set-default-directory)
   (setq mode-line-process nil)
   (use-local-map gnus-category-mode-map)
-  (buffer-disable-undo)
+  (buffer-disable-undo (current-buffer))
   (setq truncate-lines t)
   (setq buffer-read-only t)
   (gnus-run-hooks 'gnus-category-mode-hook))
@@ -1136,7 +1093,7 @@ The following commands are available:
   "Write the category alist."
   (setq gnus-category-predicate-cache nil
        gnus-category-group-cache nil)
-  (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
+  (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/categories")
     (prin1 gnus-category-alist (current-buffer))))
 
 (defun gnus-category-edit-predicate (category)
@@ -1310,7 +1267,7 @@ The following commands are available:
   "Expire all old articles."
   (interactive)
   (let ((methods gnus-agent-covered-methods)
-       (day (- (time-to-days (current-time)) gnus-agent-expire-days))
+       (day (- (gnus-time-to-day (current-time)) gnus-agent-expire-days))
        gnus-command-method sym group articles
        history overview file histories elem art nov-file low info
        unreads marked article)
@@ -1427,15 +1384,12 @@ The following commands are available:
               ;; Maybe everything has been expired from `gnus-article-alist'
               ;; and so the above marking as read could not be conducted,
               ;; or there are expired article within the range of the alist.
-              (when (and info
-                         expired
-                         (or (not (caar gnus-agent-article-alist))
-                             (> (car expired)
-                                (caar gnus-agent-article-alist))))
-                (setcar (nthcdr 2 info)
-                        (gnus-add-to-range
-                         (nth 2 info)
-                         (nreverse expired))))
+              (when (or (not (caar gnus-agent-article-alist))
+                        (> (car expired) (caar gnus-agent-article-alist)))  
+              (setcar (nthcdr 2 info)
+                      (gnus-add-to-range
+                       (nth 2 info)
+                       (nreverse expired))))
               (gnus-dribble-enter
                (concat "(gnus-group-set-info '"
                        (gnus-prin1-to-string info)