From: yamaoka <yamaoka>
Date: Fri, 10 Sep 2004 00:33:49 +0000 (+0000)
Subject: Synch to No Gnus 200409092351.
X-Git-Tag: t-gnus-6_17_4-quimby-~775
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=5ad8ce53c836cff1212e5ae958a8a70a689f501e;p=elisp%2Fgnus.git-

Synch to No Gnus 200409092351.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f46cc05..e8aafbd 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,34 @@
+2004-09-09  Kevin Greiner  <kgreiner@compsol.cc>
+	* gnus-agent.el (gnus-agent-cat-groups): rewrote avoiding defsetf
+	to avoid run-time CL dependencies.
+	(gnus-agent-unfetch-articles): New function.
+	(gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate
+	article numbers even when local .overview file is missing.
+	(gnus-agent-read-article-number): New function. Only accepts
+	27-bit article numbers.
+	(gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use
+	gnus-agent-read-article-number.
+	(gnus-agent-braid-nov): Rewrote to validate article numbers coming
+	from backend while recognizing that article numbers in .overview
+	must be valid.
+	(gnus-agent-update-files-total-fetched-for): Use
+	directory-files-and-attributes to improve performance.
+	* gnus-int.el (gnus-request-move-article): Use
+	gnus-agent-unfetch-articles in place of gnus-agent-expire to
+	improve performance.
+
+	* gnus-start.el (gnus-convert-old-newsrc): Changed message text as
+	some users confused by references to .newsrc when they only have a
+	.newsrc.eld file.
+	(gnus-convert-mark-converter-prompt,
+	gnus-convert-converter-needs-prompt): Fixed use of property list.
+	* legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt):
+	New function. Used internally to only display 'gnus converting
+	files' message when actually necessary.
+
+	* gnus-sum.el (): Removed (require 'gnus-agent) as required
+	methods now autoloaded.
+
 2004-09-03  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* gnus-sum.el (gnus-summary-insert-subject): Remove list
diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el
index 8456a3a..81182bd 100644
--- a/lisp/gnus-agent.el
+++ b/lisp/gnus-agent.el
@@ -384,9 +384,23 @@ manipulated as follows:
 (gnus-agent-cat-defaccessor
  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
-  (defsetf gnus-agent-cat-groups (category) (groups)
-    (list 'gnus-agent-set-cat-groups category groups)))
+  (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--))))
+  )
 
 (defun gnus-agent-set-cat-groups (category groups)
   (unless (eq groups 'ignore)
@@ -1042,6 +1056,7 @@ article's mark is toggled."
 	 gnus-downloadable-mark)
        'unread))))
 
+;;;###autoload
 (defun gnus-agent-get-undownloaded-list ()
   "Construct list of articles that have not been downloaded."
   (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
@@ -1204,6 +1219,7 @@ This can be added to `gnus-select-article-hook' or
       ;; will add it while reading the file.
       (gnus-write-active-file file new nil)))
 
+;;;###autoload
 (defun gnus-agent-possibly-alter-active (group active &optional info)
   "Possibly expand a group's active range to include articles
 downloaded into the agent."
@@ -1510,6 +1526,37 @@ downloaded into the agent."
             (gnus-message 7 ""))
           (cdr fetched-articles))))))
 
+(defun gnus-agent-unfetch-articles (group articles)
+  "Delete ARTICLES that were fetched from GROUP into the agent."
+  (when articles
+    (gnus-agent-with-refreshed-group 
+     group
+     (gnus-agent-load-alist group)
+     (let* ((alist (cons nil gnus-agent-article-alist))
+	    (articles (sort articles #'<))
+	    (next-possibility alist)
+	    (delete-this (pop articles)))
+       (while (and (cdr next-possibility) delete-this)
+	 (let ((have-this (caar (cdr next-possibility))))
+	   (cond ((< delete-this have-this)
+		  (setq delete-this (pop articles)))
+		 ((= delete-this have-this)
+		  (let ((timestamp (cdar (cdr next-possibility))))
+		    (when timestamp
+		      (let* ((file-name (concat (gnus-agent-group-pathname group)
+						(number-to-string have-this)))
+			     (size-file (float (or (and gnus-agent-total-fetched-hashtb
+							(nth 7 (file-attributes file-name)))
+						   0))))
+			(delete-file file-name)
+			(gnus-agent-update-files-total-fetched-for group (- size-file)))))
+
+		  (setcdr next-possibility (cddr next-possibility)))
+		 (t
+		  (setq next-possibility (cdr next-possibility))))))
+       (setq gnus-agent-article-alist (cdr alist))
+       (gnus-agent-save-alist group)))))
+
 (defun gnus-agent-crosspost (crosses article &optional date)
   (setq date (or date t))
 
@@ -1616,6 +1663,7 @@ and that there are no duplicates."
 	(insert "\n"))
       (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
 
+;;;###autoload
 (defun gnus-agent-find-parameter (group symbol)
   "Search for GROUPs SYMBOL in the group's parameters, the group's
 topic parameters, the group's category, or the customizable
@@ -1726,8 +1774,10 @@ article numbers will be returned."
               ;; of FILE.
               (copy-to-buffer
 	       gnus-agent-overview-buffer (point-min) (point-max))
-              (when (file-exists-p file)
-                (gnus-agent-braid-nov group articles file))
+	      ;; NOTE: Call g-a-brand-nov even when the file does not
+	      ;; exist.  As a minimum, it will validate the article
+	      ;; numbers already in the buffer.
+	      (gnus-agent-braid-nov group articles file)
 	      (gnus-agent-check-overview-buffer)
 	      (write-region-as-coding-system
 	       gnus-agent-file-coding-system
@@ -1740,11 +1790,32 @@ article numbers will be returned."
             (nnheader-insert-file-contents file)))))
     articles))
 
+(defsubst gnus-agent-read-article-number ()
+  "Reads the article number at point.  Returns nil when a valid article number can not be read."
+
+  ;; It is unfortunite but the read function quietly overflows
+  ;; integer.  As a result, I have to use string operations to test
+  ;; for overflow BEFORE calling read.
+  (when (looking-at "[0-9]+\t")
+    (let ((len (- (match-end 0) (match-beginning 0))))
+      (cond ((< len 9)
+	     (read (current-buffer)))
+	    ((= len 9)
+	     ;; Many 9 digit base-10 numbers can be represented in a 27-bit int
+	     ;; Back convert from int to string to ensure that this is one of them.
+	     (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0))))
+		    (num (read (current-buffer)))
+		    (str2 (int-to-string num)))
+	       (when (equal str1 str2)
+		 num)))))))
+
 (defsubst gnus-agent-copy-nov-line (article)
+  "Copy the indicated ARTICLE from the overview buffer to the nntp server buffer."
   (let (art b e)
     (set-buffer gnus-agent-overview-buffer)
     (while (and (not (eobp))
-		(< (setq art (read (current-buffer))) article))
+		(or (not (setq art (gnus-agent-read-article-number)))
+		    (< art article)))
       (forward-line 1))
     (beginning-of-line)
     (if (or (eobp)
@@ -1757,64 +1828,77 @@ article numbers will be returned."
 
 (defun gnus-agent-braid-nov (group articles file)
   "Merge agent overview data with given file.
-Takes headers for ARTICLES from `gnus-agent-overview-buffer' and the given
-FILE and places the combined headers into `nntp-server-buffer'."
+Takes unvalidated headers for ARTICLES from
+`gnus-agent-overview-buffer' and validated headers from the given
+FILE and places the combined valid headers into
+`nntp-server-buffer'.  This function can be used, when file
+doesn't exist, to valid the overview buffer."
   (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)
+    (when (file-exists-p file)
+      (nnheader-insert-file-contents file))
     (goto-char (point-max))
     (forward-line -1)
-    (unless (looking-at "[0-9]+\t")
-      ;; Remove corrupted lines
-      (gnus-message
-       1 "Overview %s is corrupted. Removing corrupted lines..." file)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(if (looking-at "[0-9]+\t")
-	    (forward-line 1)
-	  (delete-region (point) (progn (forward-line 1) (point)))))
-      (forward-line -1))
+
     (unless (or (= (point-min) (point-max))
 		(< (setq last (read (current-buffer))) (car articles)))
-      ;; We do it the hard way.
+      ;; Old and new overlap -- We do it the hard way.
       (when (nnheader-find-nov-line (car articles))
         ;; Replacing existing NOV entry
         (delete-region (point) (progn (forward-line 1) (point))))
       (gnus-agent-copy-nov-line (pop articles))
 
       (ignore-errors
-        (while articles
-          (while (let ((art (read (current-buffer))))
-                   (cond ((< art (car articles))
-                          (forward-line 1)
-                          t)
-                         ((= art (car articles))
-                          (beginning-of-line)
-                          (delete-region
-			   (point) (progn (forward-line 1) (point)))
-                          nil)
-                         (t
-                          (beginning-of-line)
-                          nil))))
-
-	  (gnus-agent-copy-nov-line (pop articles)))))
-
-    ;; Copy the rest lines
-    (set-buffer nntp-server-buffer)
+       (while articles
+	 (while (let ((art (read (current-buffer))))
+		  (cond ((< art (car articles))
+			 (forward-line 1)
+			 t)
+			((= art (car articles))
+			 (beginning-of-line)
+			 (delete-region
+			  (point) (progn (forward-line 1) (point)))
+			 nil)
+			(t
+			 (beginning-of-line)
+			 nil))))
+
+	 (gnus-agent-copy-nov-line (pop articles)))))
+
     (goto-char (point-max))
+
+    ;; Append the remaining lines
     (when articles
       (when last
 	(set-buffer gnus-agent-overview-buffer)
-	(ignore-errors
-          (while (<= (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))))
+
+      (let ((p (point)))
+	(insert-buffer-substring gnus-agent-overview-buffer start)
+	(goto-char p))
+
+      (setq last (or last -134217728))
+      (let (sort art)
+	(while (not (eobp))
+	  (setq art (gnus-agent-read-article-number))
+	  (cond ((not art)
+		 ;; Bad art num - delete this line
+		 (beginning-of-line)
+		 (delete-region (point) (progn (forward-line 1) (point))))
+		((< art last)
+		 ;; Art num out of order - enable sort
+		 (setq sort t)
+		 (forward-line 1))
+		(t
+		 ;; Good art num
+		 (setq last art)
+		 (forward-line 1))))
+	(when sort
+	  (sort-numeric-fields 1 (point-min) (point-max)))))))
 
 ;; Keeps the compiler from warning about the free variable in
 ;; gnus-agent-read-agentview.
@@ -3374,7 +3458,7 @@ articles in every agentized group."))
 
 (defun gnus-agent-uncached-articles (articles group &optional cached-header)
   "Restrict ARTICLES to numbers already fetched.
-Returns a sublist of ARTICLES that excludes thos article ids in GROUP
+Returns a sublist of ARTICLES that excludes those article ids in GROUP
 that have already been fetched.
 If CACHED-HEADER is nil, articles are only excluded if the article itself
 has been fetched."
@@ -3464,12 +3548,11 @@ has been fetched."
 
                      ;; Get the list of articles that were fetched
                      (goto-char (point-min))
-                     (let ((pm (point-max)))
+                     (let ((pm (point-max))
+			   art)
                        (while (< (point) pm)
-                         (when (looking-at "[0-9]+\t")
-                           (gnus-agent-append-to-list
-                            tail-fetched-articles
-                            (read (current-buffer))))
+			 (when (setq art (gnus-agent-read-article-number))
+                           (gnus-agent-append-to-list tail-fetched-articles art))
                          (forward-line 1)))
 
                      ;; Clip this list to the headers that will
@@ -3508,7 +3591,7 @@ has been fetched."
 
 	    ;; Merge the temp buffer with the known headers (found on
 	    ;; disk in FILE) into the nntp-server-buffer
-	    (when (and uncached-articles (file-exists-p file))
+	    (when uncached-articles
 	      (gnus-agent-braid-nov group uncached-articles file))
 
 	    ;; Save the new set of known headers to FILE
@@ -3840,19 +3923,23 @@ agent has fetched."
 		       (gnus-sethash path (make-list 3 0) 
 				     gnus-agent-total-fetched-hashtb))))
        (when (listp delta)
-	 (unless delta
-	   (setq delta (directory-files path nil "^-?[0-9]+$" t)))
-
-	 (let ((sum 0.0)
-	       file)
-	   (while (setq file (pop delta))
-	     (incf sum (float (or (nth 7 (file-attributes 
-					  (nnheader-concat 
-					   path 
-					   (if (numberp file)
-					       (number-to-string file)
-					     file)))) 0))))
-	   (setq delta sum)))
+	 (if delta
+	     (let ((sum 0.0)
+		   file)
+	       (while (setq file (pop delta))
+		 (incf sum (float (or (nth 7 (file-attributes 
+					      (nnheader-concat 
+					       path 
+					       (if (numberp file)
+						   (number-to-string file)
+						 file)))) 0))))
+	       (setq delta sum))
+	   (let ((sum 0.0)
+		 (info (directory-files-and-attributes path nil "^-?[0-9]+$" t))
+		 file)
+	     (while (setq file (pop info))
+	       (incf sum (float (or (nth 8 file) 0))))
+	     (setq delta sum))))
 
        (setq gnus-agent-need-update-total-fetched-for t)
        (incf (nth 2 entry) delta)))))
diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index 922d575..f585b66 100644
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -570,7 +570,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
 			  (nth 1 gnus-command-method) accept-function last)))
     (when (and result gnus-agent
 	       (gnus-agent-method-p gnus-command-method))
-      (gnus-agent-expire (list article) group 'force))
+      (gnus-agent-unfetch-articles group (list article)))
     result))
 
 (defun gnus-request-accept-article (group &optional gnus-command-method last
diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index 068074d..37f29a9 100644
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -2258,7 +2258,7 @@ If FORCE is non-nil, the .newsrc file is read."
   (let ((fcv (and gnus-newsrc-file-version
 		  (gnus-continuum-version gnus-newsrc-file-version))))
     (when fcv
-      ;; A .newsrc.eld file was loaded.
+      ;; A newsrc file was loaded.
       (let (prompt-displayed
             (converters
              (sort
@@ -2303,18 +2303,18 @@ If FORCE is non-nil, the .newsrc file is read."
                   (while (let (c
                                (cursor-in-echo-area t)
                                (echo-keystrokes 0))
-                           (message "Convert newsrc from version '%s' to '%s'? (n/y/?)"
+                           (message "Convert gnus from version '%s' to '%s'? (n/y/?)"
                                     gnus-newsrc-file-version gnus-version)
                            (setq c (read-char-exclusive))
 
                            (cond ((or (eq c ?n) (eq c ?N))
-                                  (error "Can not start gnus using old (unconverted) newsrc"))
+                                  (error "Can not start gnus without converting"))
                                  ((or (eq c ?y) (eq c ?Y))
                                   (setq prompt-displayed t)
                                   nil)
                                  ((eq c ?\?)
                                   (message "This conversion is irreversible. \
- You should backup your files before proceeding.")
+ To be safe, you should backup your files before proceeding.")
                                   (sit-for 5)
                                   t)
                                  (t
@@ -2324,19 +2324,21 @@ If FORCE is non-nil, the .newsrc file is read."
 
               (funcall func convert-to)))
           (gnus-dribble-enter 
-           (format ";Converted newsrc from version '%s' to '%s'? (n/y/?)"
+           (format ";Converted gnus from version '%s' to '%s'."
                    gnus-newsrc-file-version gnus-version)))))))
 
 (defun gnus-convert-mark-converter-prompt (converter no-prompt)
-  (setplist converter
-            (let* ((symbol 'gnus-convert-no-prompt)
-                   (value (delq symbol (symbol-plist converter))))
-            (if no-prompt
-                (cons symbol value)
-              value))))
+  "Indicate whether CONVERTER requires gnus-convert-old-newsrc to
+  display the conversion prompt.  NO-PROMPT may be nil (prompt),
+  t (no prompt), or any form that can be called as a function.
+  The form should return either t or nil."
+  (put converter 'gnus-convert-no-prompt no-prompt))
 
 (defun gnus-convert-converter-needs-prompt (converter)
-  (not (memq 'gnus-convert-no-prompt (symbol-plist converter))))
+  (let ((no-prompt (get converter 'gnus-convert-no-prompt)))
+    (not (if (memq no-prompt '(t nil))
+	     no-prompt
+	   (funcall no-prompt)))))
 
 (defun gnus-convert-old-ticks (converting-to)
   (let ((newsrc (cdr gnus-newsrc-alist))
diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index 28fecf2..1fe6090 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -1522,7 +1522,6 @@ For example:
         nil
       (load "gnus-sum.el" t t t))
     (require 'gnus)
-    (require 'gnus-agent)
     (require 'gnus-art)))
 
 ;; Subject simplification.
diff --git a/lisp/legacy-gnus-agent.el b/lisp/legacy-gnus-agent.el
index 41c69b7..ee1b0d9 100644
--- a/lisp/legacy-gnus-agent.el
+++ b/lisp/legacy-gnus-agent.el
@@ -6,6 +6,8 @@
 ; Oort Gnus v0.08 - This release updated agent to no longer use
 ;                   history file and to support a compressed alist.
 
+(defvar gnus-agent-compressed-agentview-search-only nil)
+
 (defun gnus-agent-convert-to-compressed-agentview (converting-to)
   "Iterates over all agentview files to ensure that they have been
 converted to the compressed format."
@@ -30,6 +32,13 @@ converted to the compressed format."
     (if converted-something
         (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to))))
 
+(defun gnus-agent-convert-to-compressed-agentview-prompt ()
+  (catch 'found-file-to-convert
+    (let ((gnus-agent-compressed-agentview-search-only t))
+      (gnus-agent-convert-to-compressed-agentview nil))))
+
+(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt)
+
 (defun gnus-agent-convert-agentview (file)
   "Load FILE and do a `read' there."
   (with-temp-buffer
@@ -68,6 +77,9 @@ converted to the compressed format."
 	  (setq changed-version t)))
 
         (when changed-version
+	  (when gnus-agent-compressed-agentview-search-only
+	    (throw 'found-file-to-convert t))
+
           (erase-buffer)
           (let ((compressed nil))
             (mapcar (lambda (pair)