* nnmail.el (nnmail-cache-insert): make sure that the
[gnus] / lisp / gnus-agent.el
index 9a3202a..87ef285 100644 (file)
@@ -284,56 +284,61 @@ node `(gnus)Server Buffer'.")
                     (setq category (cdr category)))))))
   category)
 
-(defmacro gnus-agent-cat-defaccessor (name prop-name)
-  "Define accessor and setter methods for manipulating a list of the form
+(eval-when-compile
+  (defmacro gnus-agent-cat-defaccessor (name prop-name)
+    "Define accessor and setter methods for manipulating a list of the form
 \(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)).
 Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
 manipulated as follows:
   (func LIST): Returns VALUE1
   (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
-  `(progn (defmacro ,name (category)
-            (list (quote cdr) (list (quote assq)
-                                    (quote (quote ,prop-name)) category)))
-
-          (define-setf-method ,name (category)
-            (let* ((--category--temp-- (gensym "--category--"))
-                   (--value--temp-- (gensym "--value--")))
-              (list (list --category--temp--) ; temporary-variables
-                    (list category)     ; value-forms
-                    (list --value--temp--) ; store-variables
-                    (let* ((category --category--temp--) ; store-form
-                           (value --value--temp--))
-                      (list (quote gnus-agent-cat-set-property)
-                            category
-                            (quote (quote ,prop-name))
-                            value))
-                    (list (quote ,name) --category--temp--) ; access-form
-                    )))))
+    `(progn (defmacro ,name (category)
+              (list (quote cdr) (list (quote assq)
+                                      (quote (quote ,prop-name)) category)))
+
+            (define-setf-method ,name (category)
+              (let* ((--category--temp-- (make-symbol "--category--"))
+                     (--value--temp-- (make-symbol "--value--")))
+                (list (list --category--temp--) ; temporary-variables
+                      (list category)   ; value-forms
+                      (list --value--temp--) ; store-variables
+                      (let* ((category --category--temp--) ; store-form
+                             (value --value--temp--))
+                        (list (quote gnus-agent-cat-set-property)
+                              category
+                              (quote (quote ,prop-name))
+                              value))
+                      (list (quote ,name) --category--temp--) ; access-form
+                      )))))
+  )
 
 (defmacro gnus-agent-cat-name (category)
   `(car ,category))
 
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-days-until-old    agent-days-until-old)
+ gnus-agent-cat-days-until-old             agent-days-until-old)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-enable-expiration          agent-enable-expiration)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-enable-expiration agent-enable-expiration)
+ gnus-agent-cat-groups                     agent-groups)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-groups            agent-groups)
+ gnus-agent-cat-high-score                 agent-high-score)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-high-score        agent-high-score)
+ gnus-agent-cat-length-when-long           agent-length-when-long)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-long  agent-length-when-long)
+ gnus-agent-cat-length-when-short          agent-length-when-short)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-short agent-length-when-short)
+ gnus-agent-cat-low-score                  agent-low-score)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-low-score         agent-low-score)
+ gnus-agent-cat-predicate                  agent-predicate)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-predicate         agent-predicate)
+ gnus-agent-cat-score-file                 agent-score-file)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-score-file        agent-score-file)
+ gnus-agent-cat-disable-undownloaded-faces agent-disable-undownloaded-faces)
 
-(defsetf gnus-agent-cat-groups (category) (groups)
-  (list 'gnus-agent-set-cat-groups category groups))
+(eval-when-compile
+  (defsetf gnus-agent-cat-groups (category) (groups)
+    (list 'gnus-agent-set-cat-groups category groups)))
 
 (defun gnus-agent-set-cat-groups (category groups)
   (unless (eq groups 'ignore)
@@ -368,8 +373,8 @@ manipulated as follows:
                            (setcdr category (cons cell (cdr category)))
                            cell)) groups))))))
 
-(defsubst gnus-agent-cat-make (name)
-  (list name '(agent-predicate . false)))
+(defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
+  (list name `(agent-predicate . ,(or default-agent-predicate 'false))))
 
 ;;; Fetching setup functions.
 
@@ -431,7 +436,8 @@ manipulated as follows:
                                                     buffer))))
            minor-mode-map-alist))
     (when (eq major-mode 'gnus-group-mode)
-      (let ((init-plugged gnus-plugged))
+      (let ((init-plugged gnus-plugged)
+            (gnus-agent-go-online nil))
         ;; g-a-t-p does nothing when gnus-plugged isn't changed.
         ;; Therefore, make certain that the current value does not
         ;; match the desired initial value.
@@ -578,10 +584,10 @@ manipulated as follows:
 ;;;###autoload
 (defun gnus-agentize ()
   "Allow Gnus to be an offline newsreader.
-The normal usage of this command is to put the following as the
-last form in your `.gnus.el' file:
 
-\(gnus-agentize)
+The gnus-agentize function is now called internally by gnus when
+gnus-agent is set.  If you wish to avoid calling gnus-agentize,
+customize gnus-agent to nil.
 
 This will modify the `gnus-setup-news-hook', and
 `message-send-mail-real-function' variables, and install the Gnus agent
@@ -605,14 +611,18 @@ minor mode in all Gnus buffers."
                       gnus-agent-covered-methods ))))
      (append (list gnus-select-method) gnus-secondary-select-methods))))
 
-(defun gnus-agent-queue-setup ()
-  "Make sure the queue group exists."
-  (unless (gnus-gethash "nndraft:queue" gnus-newsrc-hashtb)
-    (gnus-request-create-group "queue" '(nndraft ""))
+(defun gnus-agent-queue-setup (&optional group-name)
+  "Make sure the queue group exists.
+Optional arg GROUP-NAME allows to specify another group."
+  (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
+                       gnus-newsrc-hashtb)
+    (gnus-request-create-group (or group-name "queue") '(nndraft ""))
     (let ((gnus-level-default-subscribed 1))
-      (gnus-subscribe-group "nndraft:queue" nil '(nndraft "")))
+      (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
+                           nil '(nndraft "")))
     (gnus-group-set-parameter
-     "nndraft:queue" 'gnus-dummy '((gnus-draft-mode)))))
+     (format "nndraft:%s" (or group-name "queue"))
+     'gnus-dummy '((gnus-draft-mode)))))
 
 (defun gnus-agent-send-mail ()
   (if gnus-plugged
@@ -816,8 +826,7 @@ be a select method."
              (if method
                   (unless (member method gnus-agent-covered-methods)
                     (push method gnus-agent-covered-methods))
-               (gnus-message 1 "Ignoring disappeared server `%s'" m)
-               (sit-for 1))))
+               (gnus-message 1 "Ignoring disappeared server `%s'" m))))
          (gnus-agent-read-file
           (nnheader-concat gnus-agent-directory "lib/servers"))))
 
@@ -913,28 +922,28 @@ article's mark is toggled."
            (cond ((< a h)
                   ;; Ignore IDs in the alist that are not being
                   ;; displayed in the summary.
-                  (pop alist))
+                  (setq alist (cdr alist)))
                  ((> a h)
                    ;; Headers that are not in the alist should be
                    ;; fictious (see nnagent-retrieve-headers); they
                    ;; imply that this article isn't in the agent.
                   (gnus-agent-append-to-list tail-undownloaded h)
                   (gnus-agent-append-to-list tail-unfetched    h)
-                   (pop headers)) 
+                   (setq headers (cdr headers))) 
                  ((cdar alist)
-                  (pop alist)
-                  (pop headers)
+                  (setq alist (cdr alist))
+                  (setq headers (cdr headers))
                   nil                  ; ignore already downloaded
                   )
                  (t
-                  (pop alist)
-                  (pop headers)
+                  (setq alist (cdr alist))
+                  (setq headers (cdr headers))
                    
                    ;; This article isn't in the agent.  Check to see
                    ;; if it is in the cache.  If it is, it's been
                    ;; downloaded.
                    (while (and cached (< (car cached) a))
-                     (pop cached))
+                     (setq cached (cdr cached)))
                    (unless (equal a (car cached))
                      (gnus-agent-append-to-list tail-undownloaded a))))))
 
@@ -1156,7 +1165,9 @@ This can be added to `gnus-select-article-hook' or
   ;; nnagent uses nnmail-group-pathname to read articles while
   ;; unplugged.  The agent must, therefore, use the same directory
   ;; while plugged.
-  (nnmail-group-pathname (gnus-group-real-name group) (gnus-agent-directory)))
+  (let ((gnus-command-method (or gnus-command-method
+                                 (gnus-find-method-for-group group))))
+    (nnmail-group-pathname (gnus-group-real-name group) (gnus-agent-directory))))
 
 (defun gnus-agent-get-function (method)
   (if (gnus-online method)
@@ -1322,7 +1333,7 @@ This can be added to `gnus-select-article-hook' or
                       (gnus-agent-append-to-list
                       tail-fetched-articles (caar pos)))
                     (widen)
-                    (pop pos))))
+                    (setq pos (cdr pos)))))
 
             (gnus-agent-save-alist group (cdr fetched-articles) date)
             (gnus-message 7 ""))
@@ -1356,7 +1367,7 @@ This can be added to `gnus-select-article-hook' or
        (insert (string-to-number (cdar crosses)))
        (insert-buffer-substring gnus-agent-overview-buffer beg end)
         (gnus-agent-check-overview-buffer))
-      (pop crosses))))
+      (setq crosses (cdr crosses)))))
 
 (defun gnus-agent-backup-overview-buffer ()
   (when gnus-newsgroup-name
@@ -1424,7 +1435,7 @@ and that there are no duplicates."
                      (gnus-agent-article-name ".overview"
                                               (caar gnus-agent-buffer-alist))
                      nil 'silent))
-      (pop gnus-agent-buffer-alist))
+      (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
     (while gnus-agent-group-alist
       (with-temp-file (gnus-agent-article-name
                       ".agentview" (caar gnus-agent-group-alist))
@@ -1432,7 +1443,7 @@ and that there are no duplicates."
        (insert "\n")
         (princ 1 (current-buffer))
        (insert "\n"))
-      (pop gnus-agent-group-alist))))
+      (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
 
 (defun gnus-agent-find-parameter (group symbol)
   "Search for GROUPs SYMBOL in the group's parameters, the group's
@@ -1443,14 +1454,14 @@ variables.  Returns the first non-nil value found."
       (symbol-value
        (cdr
         (assq symbol
-         '((agent-short-article . gnus-agent-short-article)
-           (agent-long-article . gnus-agent-long-article)
-           (agent-low-score . gnus-agent-low-score)
-           (agent-high-score . gnus-agent-high-score)
-           (agent-days-until-old . gnus-agent-expire-days)
-           (agent-enable-expiration
-            . gnus-agent-enable-expiration)
-           (agent-predicate . gnus-agent-predicate)))))))
+              '((agent-short-article . gnus-agent-short-article)
+                (agent-long-article . gnus-agent-long-article)
+                (agent-low-score . gnus-agent-low-score)
+                (agent-high-score . gnus-agent-high-score)
+                (agent-days-until-old . gnus-agent-expire-days)
+                (agent-enable-expiration
+                 . gnus-agent-enable-expiration)
+                (agent-predicate . gnus-agent-predicate)))))))
 
 (defun gnus-agent-fetch-headers (group &optional force)
   "Fetch interesting headers into the agent.  The group's overview
@@ -1803,7 +1814,7 @@ FILE and places the combined headers into `nntp-server-buffer'."
                                       (error-message-string err)))
                       (signal 'quit
                               "Cannot fetch articles into the Gnus agent")))))))))
-       (pop methods))
+       (setq methods (cdr methods)))
       (gnus-run-hooks 'gnus-agent-fetched-hook)
       (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
 
@@ -2182,7 +2193,7 @@ The following commands are available:
                                   '(agent-predicate agent-score-file agent-groups))))
                    c)
                  old-list)))))
-         (list (gnus-agent-cat-make 'default)))))
+         (list (gnus-agent-cat-make 'default 'short)))))
 
 (defun gnus-category-write ()
   "Write the category alist."
@@ -2365,7 +2376,7 @@ The following commands are available:
   (cond
    ;; Functions are just returned as is.
    ((or (symbolp predicate)
-       (gnus-functionp predicate))
+       (functionp predicate))
     `(,(or (cdr (assq predicate gnus-category-predicate-alist))
           predicate)))
    ;; More complex predicate.
@@ -2402,7 +2413,7 @@ return only unread articles."
          nil)
         ((not function)
          nil)
-        ((gnus-functionp function)
+        ((functionp function)
          'ignore)
         ((memq (car function) '(or and not))
          (apply (car function)
@@ -2482,8 +2493,9 @@ FORCE is equivalent to setting the expiration predicates to true."
            (cons dir 
                  (symbol-value 'gnus-agent-expire-current-dirs))))
 
-    (if (eq 'DISABLE (gnus-agent-find-parameter group 
-                                                'agent-enable-expiration))
+    (if (and (not force)
+             (eq 'DISABLE (gnus-agent-find-parameter group 
+                                                     'agent-enable-expiration)))
         (gnus-message 5 "Expiry skipping over %s" group)
       (gnus-message 5 "Expiring articles in %s" group)
       (gnus-agent-load-alist group)
@@ -2891,7 +2903,7 @@ articles in every agentized group."))
                                   (push r to-remove))))
                            ((file-directory-p (setq file (nnheader-concat d file)))
                             (funcall checker file)))))))))
-        (funcall checker gnus-agent-directory)
+        (funcall checker (expand-file-name gnus-agent-directory))
 
         (when (and to-remove
                    (or gnus-expert-user
@@ -2901,7 +2913,7 @@ articles in every agentized group."))
  deleting them?")))
           (while to-remove
             (let ((dir (pop to-remove)))
-              (if (gnus-y-or-n-p (format "Delete %s?" dir))
+              (if (gnus-y-or-n-p (format "Delete %s? " dir))
                   (let* (delete-recursive
                          (delete-recursive
                           (function
@@ -2947,7 +2959,7 @@ articles in every agentized group."))
                        (gnus-agent-append-to-list tail-unread candidate)
                        nil)
                       ((> candidate max)
-                       (pop read)))))))
+                       (setq read (cdr read))))))))
     (while known
       (gnus-agent-append-to-list tail-unread (car (pop known))))
     (cdr unread)))
@@ -2975,14 +2987,14 @@ has been fetched."
               (v2 (caar ref)))
           (cond ((< v1 v2) ; v1 does not appear in the reference list
                 (gnus-agent-append-to-list tail-uncached v1)
-                 (pop arts))
+                 (setq arts (cdr arts)))
                 ((= v1 v2)
                  (unless (or cached-header (cdar ref)) ; v1 is already cached
                   (gnus-agent-append-to-list tail-uncached v1))
-                 (pop arts)
-                 (pop ref))
+                 (setq arts (cdr arts))
+                 (setq ref (cdr ref)))
                 (t ; reference article (v2) preceeds the list being filtered
-                 (pop ref)))))
+                 (setq ref (cdr ref))))))
       (while arts
        (gnus-agent-append-to-list tail-uncached (pop arts)))
       (cdr uncached))
@@ -3203,7 +3215,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
                           (gnus-message 4 "gnus-agent-regenerate-group: NOV\
  entries contained duplicate of article %s.     Duplicate deleted." l1)
                            (gnus-delete-line)
-                           (pop nov-arts)))))
+                           (setq nov-arts (cdr nov-arts))))))
                  (t
                  (gnus-message 1 "gnus-agent-regenerate-group: NOV\
  entries contained line that did not begin with an article number.  Deleted\
@@ -3249,12 +3261,12 @@ If REREAD is not nil, downloaded articles are marked as unread."
                            (nth 5 (file-attributes
                                    (concat dir (number-to-string
                                                 (car downloaded))))))) alist)
-              (pop downloaded)
-              (pop nov-arts))
+              (setq downloaded (cdr downloaded))
+              (setq nov-arts (cdr nov-arts)))
              (t
               ;; This entry in the overview has not been downloaded
               (push (cons (car nov-arts) nil) alist)
-              (pop nov-arts))))
+              (setq nov-arts (cdr nov-arts)))))
 
      ;; When gnus-agent-consider-all-articles is set,
      ;; gnus-agent-regenerate-group should NOT remove article IDs from
@@ -3278,15 +3290,15 @@ If REREAD is not nil, downloaded articles are marked as unread."
                    (oID (caar o)))
                (cond ((not nID)
                       (setq n (setcdr n (list (list oID))))
-                      (pop o))
+                      (setq o (cdr o)))
                      ((< oID nID)
                       (setcdr n (cons (list oID) (cdr n)))
-                      (pop o))
+                      (setq o (cdr o)))
                      ((= oID nID)
-                      (pop o)
-                      (pop n))
+                      (setq o (cdr o))
+                      (setq n (cdr n)))
                      (t
-                      (pop n)))))
+                      (setq n (cdr n))))))
            (setq alist (cdr merged)))
        ;; Restore the last article ID if it is not already in the new alist
        (let ((n (last alist))
@@ -3438,7 +3450,7 @@ If CLEAN, don't read existing active files."
                                                  (caar days)
                                                  group))
                                       (throw 'found (cadar days)))
-                                    (pop days))
+                                    (setq days (cdr days)))
                                   nil)))
                       (when day
                         (gnus-group-set-parameter group 'agent-days-until-old