X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=60d6102f7c0d013d72c6fa0fe687987c95b8f9af;hb=873ba7b51ddfb07246cd874b7de72662308236c9;hp=284a37838c35b0b6465a0d76548568ff823a7369;hpb=d38bed32440e3c3b979152602f37d6d2d5e0fa36;p=gnus

diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el
index 284a37838..60d6102f7 100644
--- a/lisp/gnus-agent.el
+++ b/lisp/gnus-agent.el
@@ -1,6 +1,6 @@
 ;;; gnus-agent.el --- unplugged support for Gnus
 
-;; Copyright (C) 1997-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
@@ -354,23 +354,11 @@ 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-- (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
-                      )))))
+              (list 'cdr (list 'assq '',prop-name category)))
+
+            (defsetf ,name (category) (value)
+              (list 'gnus-agent-cat-set-property
+                    category '',prop-name value))))
   )
 
 (defmacro gnus-agent-cat-name (category)
@@ -398,22 +386,10 @@ manipulated as follows:
  gnus-agent-cat-enable-undownloaded-faces  agent-enable-undownloaded-faces)
 
 
-;; This form is equivalent to defsetf except that it calls make-symbol
-;; whereas defsetf calls gensym (Using gensym creates a run-time
-;; dependency on the CL library).
-
-(eval-and-compile
-  (define-setf-method gnus-agent-cat-groups (category)
-    (let* ((--category--temp-- (make-symbol "--category--"))
-	   (--groups--temp-- (make-symbol "--groups--")))
-      (list (list --category--temp--)
-	    (list category)
-	    (list --groups--temp--)
-	    (let* ((category --category--temp--)
-		   (groups --groups--temp--))
-	      (list (quote gnus-agent-set-cat-groups) category groups))
-	    (list (quote gnus-agent-cat-groups) --category--temp--))))
-  )
+;; This form may expand to code that uses CL functions at run-time,
+;; but that's OK since those functions will only ever be called from
+;; something like `setf', so only when CL is loaded anyway.
+(defsetf gnus-agent-cat-groups gnus-agent-set-cat-groups)
 
 (defun gnus-agent-set-cat-groups (category groups)
   (unless (eq groups 'ignore)
@@ -601,7 +577,7 @@ manipulated as follows:
 		  (make-mode-line-mouse-map mouse-button mouse-func)
 		  'mouse-face
 		  (if (and (featurep 'xemacs)
-			   ;; XEmacs' `facep' only checks for a face
+			   ;; XEmacs's `facep' only checks for a face
 			   ;; object, not for a face name, so it's useless
 			   ;; to check with `facep'.
 			   (find-face 'modeline))
@@ -1299,12 +1275,18 @@ This can be added to `gnus-select-article-hook' or
             (gnus-group-update-group group t)))
     nil))
 
-(defun gnus-agent-save-active (method)
+(defun gnus-agent-save-active (method &optional groups-p)
+  "Sync the agent's active file with the current buffer.
+Pass non-nil for GROUPS-P if the buffer starts out in groups format.
+Regardless, both the file and the buffer end up in active format
+if METHOD is agentized; otherwise the function is a no-op."
   (when (gnus-agent-method-p method)
     (let* ((gnus-command-method method)
 	   (new (gnus-make-hashtable (count-lines (point-min) (point-max))))
 	   (file (gnus-agent-lib-file "active")))
-      (gnus-active-to-gnus-format nil new)
+      (if groups-p
+	  (gnus-groups-to-gnus-format nil new)
+	(gnus-active-to-gnus-format nil new))
       (gnus-agent-write-active file new)
       (erase-buffer)
       (let ((nnheader-file-coding-system gnus-agent-file-coding-system))
@@ -3737,6 +3719,13 @@ has been fetched."
       (gnus-make-directory (nnheader-translate-file-chars
 			    (file-name-directory file) t))
 
+      (when fetch-old
+	(setq articles (gnus-uncompress-range
+			(cons (if (numberp fetch-old)
+				  (max 1 (- (car articles) fetch-old))
+				1)
+			      (car (last articles))))))
+
       ;; Populate temp buffer with known headers
       (when (file-exists-p file)
 	(with-current-buffer gnus-agent-overview-buffer
@@ -3773,12 +3762,7 @@ has been fetched."
                    (set-buffer nntp-server-buffer)
                    (let* ((fetched-articles (list nil))
                           (tail-fetched-articles fetched-articles)
-                          (min (cond ((numberp fetch-old)
-                                      (max 1 (- (car articles) fetch-old)))
-                                     (fetch-old
-                                      1)
-                                     (t
-                                      (car articles))))
+                          (min (car articles))
                           (max (car (last articles))))
 
                      ;; Get the list of articles that were fetched
@@ -3853,8 +3837,7 @@ has been fetched."
 	     (not (numberp fetch-old)))
 	t				; Don't remove anything.
       (nnheader-nov-delete-outside-range
-       (if fetch-old (max 1 (- (car articles) fetch-old))
-	 (car articles))
+       (car articles)
        (car (last articles)))
       t)