diff lisp/gnus/gnus-agent.el @ 67418:28264c86d408

Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 157-168) - Merge from emacs--cvs-trunk--0 - Update from CVS - Update from CVS: texi/message.texi: Fix default values. 2005-12-08 Reiner Steib <Reiner.Steib@gmx.de> * lisp/gnus/mm-decode.el (mm-discouraged-alternatives): Fix custom type. Suggest image/.* in the doc string. 2005-12-07 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/mm-decode.el (mm-display-external): Use nametemplate (defined in RFC1524) if it is in mailcap or add a suffix according to mailcap-mime-extensions when generating a temp filename; postpone deleting a temp file for 2 seconds for some wrappers, shell scripts, and so on, which might exit right after having started a viewer command as a background job. 2005-12-06 Reiner Steib <Reiner.Steib@gmx.de> * lisp/gnus/gnus-art.el (gnus-default-article-saver): Add user-defined `function' to custom type. 2005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change) * lisp/gnus/mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced parens. 2005-11-29 Reiner Steib <Reiner.Steib@gmx.de> * lisp/gnus/gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and long lines. (gnus-cache-delete-group): Wrap doc strings. * lisp/gnus/gnus-agent.el (gnus-agent-rename-group) (gnus-agent-delete-group): Wrap doc strings. 2005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change) * lisp/gnus/rfc2231.el (rfc2231-parse-string): Support non-ascii chars. 2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Use current-time instead of current-time-string. 2005-11-20 Stefan Schimanski <schimmi@debian.org> (tiny change) * lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Protect against invalid date header. 2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny patch) * lisp/gnus/imap.el (imap-kerberos4-open): Ignore SSL stuff. 2005-11-14 Kevin Greiner <kevin.greiner@compsol.cc> * lisp/gnus/gnus-agent.el (gnus-agent-article-alist-save-format): Changed internal variable to a custom variable. Changed default value from compressed(2) to uncompressed(1). (gnus-agent-read-agentview): Reversed revision 7.8 to restore support for uncompressed agentview files. Taken together, reading the agentview file should now be 6-7 times faster. (gnus-agent-long-article, gnus-agent-short-article, gnus-agent-score): Renamed category keywords to match gnus-cus. (gnus-agent-summary-fetch-series): Modified to protect against gnus-agent-summary-fetch-group clearing processable flags. (gnus-agent-synchronize-group-flags): Update live group buffer as synchronization may occur due to the user toggling the plugged status. (gnus-agent-braid-nov): Now tests new nov entries for duplicates which are removed. The invalid sort check then triggers a rescan after the sort as sorting may have moved duplicate entries such that they can be cheaply detected. (gnus-agent-read-local): Trivial fix to format of error message to display actual error condition. (gnus-agent-save-local): Avoid saving symbols that are bound to nil as they simply result in a warning message in gnus-agent-read-local. (gnus-agent-fetch-group-1): Clear downloadable flag when article successfully downloaded. (gnus-agent-regenerate-group): Use gnus-agent-synchronize-group-flags to reset read status in both gnus and server. * lisp/gnus/nntp.el (nntp-end-of-line): Doc fix. (nntp-authinfo-rejected): New error condition. (nntp-wait-for): Use new error condition to signal authentication error. (nntp-retrieve-data): Rethrow new error condition to break out of recursive call to nntp-send-authinfo. 2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/gnus-start.el (gnus-dribble-read-file): Use make-local-variable rather than make-variable-buffer-local for file-precious-flag. 2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag. 2005-11-11 Jan Nieuwenhuizen <janneke@gnu.org> * lisp/gnus/gnus-start.el (gnus-dribble-read-file): Set file-precious-flag, as a buffer-local variable. This avoids creating truncated dribble files as a result of a hang up, eg. 2005-11-04 Ken Manheimer <ken.manheimer@gmail.com> * lisp/gnus/pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region) (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' argument to all these routines, so the passphrase can be managed externally and passed in to the system. (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for pgg-add-passphrase-to-cache function. * lisp/gnus/pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region) (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric) (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt) (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase' argument to all these routines, so the passphrase can be managed externally and passed in to the system. (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache function. 2005-10-30 Chong Yidong <cyd@stupidchicken.com> * lisp/gnus/imap.el (imap-open): Handle case where buffer is a buffer object. 2005-10-29 Ken Manheimer <ken.manheimer@gmail.com> * lisp/gnus/pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right part of the decoded armor to find the key-identifier. (pgg-gpg-lookup-key-owner): New function to return the human-readable identifier of a key owner. (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the key itself. (pgg-gpg-decrypt-region): Prompt with the key owner (rather than the key value) if we have a key and can match it against a secret key. Also, added a note pointing out fact that the prompt only indicates the first matching key. * lisp/gnus/pgg.el (pgg-decrypt): Passing along 'passphrase' in call to pgg-decrypt-region. (pgg-pending-timers): A new hash for tracking the passphrase cache timers, so that new ones supercede old ones. (pgg-add-passphrase-to-cache): Rename from `pgg-add-passphrase-cache' to reduce confusion (all callers changed). Modified to cancel old timers when new ones are added. (pgg-remove-passphrase-from-cache): Rename from `pgg-remove-passphrase-cache' to reduce confusion (all callers changed). Modified to cancel old timers when their keys are removed from the cache. (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in XEmacs, an indirection to delete-itimer. (pgg-read-passphrase-from-cache, pgg-read-passphrase): Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so users can only check cache without risk of prompting. Correct bug in notruncate behavior. (pgg-read-passphrase-from-cache, pgg-read-passphrase) (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): Add informative docstrings. (pgg-decrypt): Convey provided passphrase in subordinate call to pgg-decrypt-region. 2005-10-20 Ken Manheimer <ken.manheimer+emacs@gmail.com> * lisp/gnus/pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region) (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region) (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional 'passphrase' argument, so the passphrase can be managed externally and then passed in to the system. * lisp/gnus/pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache) (pgg-remove-passphrase-cache): Add optional 'notruncate' argument, so the passphrase cache can be used reliably with identifiers besides a pgp packet's key id. * lisp/gnus/pgg-gpg.el (pgg-pgp-encrypt-region) (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' argument to all these routines, so the passphrase can be managed externally and passed in to the system. * lisp/gnus/pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional 'notruncate' argument, so the passphrase cache can be used reliably with identifiers besides a pgp packet's key id. 2005-10-29 Sascha Wilde <swilde@sha-bang.de> * lisp/gnus/pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for symmetric encryption. (pgg-gpg-symmetric-key-p): New function to check for an symmetric encrypted session key. (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted message ask for the passphrase in a proper way. * lisp/gnus/pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region): New user commands for symmetric encryption. 2005-12-05 Katsumi Yamaoka <yamaoka@jpl.org> * man/pgg.texi (User Commands): Fix description of pgg-verify-region. (Selecting an implementation): Fix descriptions. 2005-11-30 Katsumi Yamaoka <yamaoka@jpl.org> * man/message.texi (Various Message Variables): Addition. 2005-11-29 Katsumi Yamaoka <yamaoka@jpl.org> * man/message.texi: Fix default values. 2005-11-25 Katsumi Yamaoka <yamaoka@jpl.org> * man/message.texi (Header Commands): Clarify descriptions of message-cross-post-followup-to, message-reduce-to-to-cc, and message-insert-wide-reply. (Various Commands): Fix kindex for message-kill-to-signature; clarify description of message-tab. 2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org> * man/message.texi (Mailing Lists): Fix description about MFT. * man/gnus.texi (Emacs Lisp): Use ~/.gnus.el instead of ~/.emacs. 2005-11-17 Katsumi Yamaoka <yamaoka@jpl.org> * man/gnus.texi (Slow Terminal Connection): Replace old description with new one. 2005-11-16 Katsumi Yamaoka <yamaoka@jpl.org> * man/gnus.texi (Oort Gnus): Use ~/.gnus.el instead of ~/.emacs; replace X-Draft-Headers with X-Draft-From. 2005-11-14 Katsumi Yamaoka <yamaoka@jpl.org> * man/gnus.texi (Various Various): Fix the default value of nnheader-max-head-length. (Gnus Versions): Fix typo.
author Miles Bader <miles@gnu.org>
date Fri, 09 Dec 2005 08:57:58 +0000
parents cb3218d6e82a
children 1c477099d3ac
line wrap: on
line diff
--- a/lisp/gnus/gnus-agent.el	Fri Dec 09 08:16:04 2005 +0000
+++ b/lisp/gnus/gnus-agent.el	Fri Dec 09 08:57:58 2005 +0000
@@ -213,6 +213,17 @@
   :group 'gnus-agent
   :type 'boolean)
 
+(defcustom gnus-agent-article-alist-save-format 1
+  "Indicates whether to use compression(2), verses no
+  compression(1), when writing agentview files.  The compressed
+  files do save space but load times are 6-7 times higher.  A
+  group must be opened then closed for the agentview to be
+  updated using the new format."
+  :version "22.1"
+  :group 'gnus-agent
+  :type '(radio (const :format "Compressed" 2)
+		(const :format "Uncompressed" 1)))
+
 ;;; Internal variables
 
 (defvar gnus-agent-history-buffers nil)
@@ -357,17 +368,17 @@
 (gnus-agent-cat-defaccessor
  gnus-agent-cat-high-score                 agent-high-score)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-long           agent-length-when-long)
+ gnus-agent-cat-length-when-long           agent-long-article)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-short          agent-length-when-short)
+ gnus-agent-cat-length-when-short          agent-short-article)
 (gnus-agent-cat-defaccessor
  gnus-agent-cat-low-score                  agent-low-score)
 (gnus-agent-cat-defaccessor
  gnus-agent-cat-predicate                  agent-predicate)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-score-file                 agent-score-file)
+ gnus-agent-cat-score-file                 agent-score)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
+ gnus-agent-cat-enable-undownloaded-faces  agent-enable-undownloaded-faces)
 
 
 ;; This form is equivalent to defsetf except that it calls make-symbol
@@ -858,9 +869,11 @@
 
 ;;;###autoload
 (defun gnus-agent-rename-group (old-group new-group)
-  "Rename fully-qualified OLD-GROUP as NEW-GROUP.  Always updates the agent, even when
-disabled, as the old agent files would corrupt gnus when the agent was
-next enabled. Depends upon the caller to determine whether group renaming is supported."
+  "Rename fully-qualified OLD-GROUP as NEW-GROUP.
+Always updates the agent, even when disabled, as the old agent
+files would corrupt gnus when the agent was next enabled.
+Depends upon the caller to determine whether group renaming is
+supported."
   (let* ((old-command-method (gnus-find-method-for-group old-group))
 	 (old-path           (directory-file-name
 			      (let (gnus-command-method old-command-method)
@@ -888,9 +901,11 @@
 
 ;;;###autoload
 (defun gnus-agent-delete-group (group)
-  "Delete fully-qualified GROUP.  Always updates the agent, even when
-disabled, as the old agent files would corrupt gnus when the agent was
-next enabled. Depends upon the caller to determine whether group deletion is supported."
+  "Delete fully-qualified GROUP.
+Always updates the agent, even when disabled, as the old agent
+files would corrupt gnus when the agent was next enabled.
+Depends upon the caller to determine whether group deletion is
+supported."
   (let* ((command-method (gnus-find-method-for-group group))
 	 (path           (directory-file-name
 			  (let (gnus-command-method command-method)
@@ -1134,20 +1149,22 @@
   (when gnus-newsgroup-processable
     (setq gnus-newsgroup-downloadable
           (let* ((dl gnus-newsgroup-downloadable)
-                 (gnus-newsgroup-downloadable
-		  (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
-                 (fetched-articles (gnus-agent-summary-fetch-group)))
+		 (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
+                 (gnus-newsgroup-downloadable processable))
+	    (gnus-agent-summary-fetch-group)
+
+            ;; For each article that I processed that is no longer
+            ;; undownloaded, remove its processable mark.
+
+	    (mapc #'gnus-summary-remove-process-mark 
+		  (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
+
             ;; The preceeding call to (gnus-agent-summary-fetch-group)
-            ;; updated gnus-newsgroup-downloadable to remove each
-            ;; article successfully fetched.
-
-            ;; For each article that I processed, remove its
-            ;; processable mark IF the article is no longer
-            ;; downloadable (i.e. it's already downloaded)
-            (dolist (article gnus-newsgroup-processable)
-              (unless (memq article gnus-newsgroup-downloadable)
-                (gnus-summary-remove-process-mark article)))
-            (gnus-sorted-ndifference dl fetched-articles)))))
+            ;; updated the temporary gnus-newsgroup-downloadable to
+            ;; remove each article successfully fetched.  Now, I
+            ;; update the real gnus-newsgroup-downloadable to only
+            ;; include undownloaded articles.
+	    (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
 
 (defun gnus-agent-summary-fetch-group (&optional all)
   "Fetch the downloadable articles in the group.
@@ -1240,7 +1257,13 @@
 				  'gnus-range-add
 				'gnus-remove-from-range)
 			      (cdr info-marks)
-			      range)))))))))
+			      range))))))))
+
+      ;;Marks can be synchronized at any time by simply toggling from
+      ;;unplugged to plugged.  If that is what is happening right now, make
+      ;;sure that the group buffer is up to date.
+          (when (gnus-buffer-live-p gnus-group-buffer)
+            (gnus-group-update-group group t)))
     nil))
 
 (defun gnus-agent-save-active (method)
@@ -1330,7 +1353,7 @@
           (when (re-search-forward
                  (concat "^" (regexp-quote group) " ") nil t)
             (save-excursion
-	      (setq oactive-max (read (current-buffer)) ;; max
+              (setq oactive-max (read (current-buffer))	;; max
                     oactive-min (read (current-buffer)))) ;; min
             (gnus-delete-line)))
 	(when active
@@ -1824,7 +1847,7 @@
 (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
+  ;; It is unfortunate 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")
@@ -1913,6 +1936,7 @@
 	(goto-char p))
 
       (setq last (or last -134217728))
+      (while (catch 'problems
       (let (sort art)
 	(while (not (eobp))
 	  (setq art (gnus-agent-read-article-number))
@@ -1924,12 +1948,27 @@
 		 ;; Art num out of order - enable sort
 		 (setq sort t)
 		 (forward-line 1))
+			 ((= art last)
+			  ;; Bad repeat of art number - delete this line
+			  (beginning-of-line)
+			  (delete-region (point) (progn (forward-line 1) (point))))
 		(t
 		 ;; Good art num
 		 (setq last art)
 		 (forward-line 1))))
 	(when sort
-	  (sort-numeric-fields 1 (point-min) (point-max)))))))
+		   ;; something is seriously wrong as we simply shouldn't see out-of-order data.
+		   ;; First, we'll fix the sort.
+		   (sort-numeric-fields 1 (point-min) (point-max))
+
+		   ;; but now we have to consider that we may have duplicate rows...	  
+		   ;; so reset to beginning of file
+		   (goto-char (point-min))
+		   (setq last -134217728)
+	  
+		   ;; and throw a code that restarts this scan
+		   (throw 'problems t))
+		 nil))))))
 
 ;; Keeps the compiler from warning about the free variable in
 ;; gnus-agent-read-agentview.
@@ -1946,11 +1985,6 @@
            'gnus-agent-file-loading-cache
            'gnus-agent-read-agentview))))
 
-;; Save format may be either 1 or 2.  Two is the new, compressed
-;; format that is still being tested.  Format 1 is uncompressed but
-;; known to be reliable.
-(defconst gnus-agent-article-alist-save-format 2)
-
 (defun gnus-agent-read-agentview (file)
   "Load FILE and do a `read' there."
   (with-temp-buffer
@@ -1964,8 +1998,6 @@
               changed-version)
 
           (cond
-           ((< version 2)
-            (error "gnus-agent-read-agentview no longer supports version %d.  Stop gnus, manually evaluate gnus-agent-convert-to-compressed-agentview, then restart gnus." version))
            ((= version 0)
             (let ((inhibit-quit t)
                   entry)
@@ -1996,7 +2028,8 @@
                              (setq uncomp (cons (cons article-id state) uncomp)))
                            sequence)))
                alist)
-              (setq alist (sort uncomp 'car-less-than-car)))))
+		(setq alist (sort uncomp 'car-less-than-car)))
+	      (setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
           (when changed-version
             (let ((gnus-agent-article-alist alist))
               (gnus-agent-save-alist gnus-agent-read-agentview)))
@@ -2110,7 +2143,7 @@
               ;; NOTE: The '+ 0' ensure that min and max are both numerics.
               (set group (cons (+ 0 min) (+ 0 max))))
           (error
-           (gnus-message 3 "Warning - invalid agent local: %s on line %d: "
+           (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
                          file line (error-message-string err))))
         (forward-line 1)
         (setq line (1+ line))))
@@ -2141,13 +2174,14 @@
 				((member (symbol-name symbol) '("+dirty" "+method"))
 				 nil)
 				(t
+				 (let ((range (symbol-value symbol)))
+				   (when range
 				 (prin1 symbol)
-				 (let ((range (symbol-value symbol)))
 				   (princ " ")
 				   (princ (car range))
 				   (princ " ")
 				   (princ (cdr range))
-				   (princ "\n")))))
+				     (princ "\n"))))))
 			my-obarray))))))))
 
 (defun gnus-agent-get-local (group &optional gmane method)
@@ -2402,7 +2436,9 @@
                         (dolist (article marked-articles)
                           (gnus-summary-set-agent-mark article t))
                         (dolist (article fetched-articles)
-                          (if gnus-agent-mark-unread-after-downloaded
+                          (when gnus-agent-mark-unread-after-downloaded
+			    (setq gnus-newsgroup-downloadable
+				  (delq article gnus-newsgroup-downloadable))
                               (gnus-summary-mark-article
 			       article gnus-unread-mark))
                           (when (gnus-summary-goto-subject article nil t)
@@ -3191,7 +3227,7 @@
 	       ((setq type
 		      (cond
 		       ((not (integerp fetch-date))
-			'read) ;; never fetched article (may expire
+			 'read)	;; never fetched article (may expire
 		       ;; right now)
 		       ((not (file-exists-p
 			      (concat dir (number-to-string
@@ -3871,8 +3907,9 @@
                 (gnus-agent-possibly-alter-active group group-active)))))
 
         (when (and reread gnus-agent-article-alist)
-          (gnus-make-ascending-articles-unread
+	(gnus-agent-synchronize-group-flags 
            group
+	 (list (list
            (if (listp reread)
                reread
              (delq nil (mapcar (function (lambda (c)
@@ -3880,7 +3917,9 @@
                                                   (car c))
                                                  ((cdr c)
                                                   (car c)))))
-                               gnus-agent-article-alist))))
+				    gnus-agent-article-alist)))
+		'del '(read)))
+	 gnus-command-method)
 
           (when (gnus-buffer-live-p gnus-group-buffer)
             (gnus-group-update-group group t)))