Improve Gnus' dribble data handling.

6 files changed, 77 insertions, 26 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ff3eb98bb97..2bfaf32f958 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,24 @@
+2011-06-10  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-group.el (gnus-group-update-group): Add new argument
+	`info-unchanged' that stops updating dribble buffer.
+
+	* gnus-start.el (gnus-dribble-enter): Add new argument `regexp' that
+	deletes lines matching to it in dribble buffer.
+
+	* gnus-agent.el (gnus-agent-fetch-group-1):
+	* gnus-group.el (gnus-group-update-group-line, gnus-group-make-group):
+	* gnus-srvr.el (gnus-server-update-server, gnus-server-set-info):
+	* gnus-start.el (gnus-group-change-level):
+	* gnus-sum.el (gnus-summary-move-article): Delete old dribble entry.
+
+	* gnus-sum.el (gnus-summary-update-info): Don't update dribble buffer
+	if newsgroup info is not changed.
+
+	* gnus-group.el (gnus-group-get-new-news-this-group):
+	* gnus-sum.el (gnus-summary-read-group-1, gnus-summary-exit-no-update):
+	Don't update dribble buffer.
+
 2011-06-01  Teodor Zlatanov  <tzz@lifelogs.com>
 
 	* gnus-registry.el (gnus-registry-remove-ignored): New function to
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index b4f0dc38e7e..424c55c40f5 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -2614,7 +2614,9 @@ modified) original contents, they are first saved to their own file."
                     (gnus-dribble-enter
                      (concat "(gnus-group-set-info '"
                              (gnus-prin1-to-string info)
-                             ")"))))))))))))
+                             ")")
+		     (concat "^(gnus-group-set-info '(\""
+			     (regexp-quote group) "\""))))))))))))
 
 ;;;
 ;;; Agent Category Mode
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 4c474b0aa23..518f215a7ba 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1437,7 +1437,8 @@ if it is a string, only list groups matching REGEXP."
 	   (gnus-dribble-enter
 	    (concat "(gnus-group-set-info '"
 		    (gnus-prin1-to-string (nth 2 entry))
-		    ")")))
+		    ")")
+	    (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))
       (setq gnus-group-indentation (gnus-group-group-indentation))
       (gnus-delete-line)
       (gnus-group-insert-group-line-info group)
@@ -1685,10 +1686,11 @@ and ends at END."
 				     (gnus-active group))
   (gnus-group-update-group group))
 
-(defun gnus-group-update-group (group &optional visible-only)
+(defun gnus-group-update-group (group &optional visible-only
+				      info-unchanged)
   "Update all lines where GROUP appear.
 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
-already."
+already.  If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
   (with-current-buffer gnus-group-buffer
     (save-excursion
       ;; The buffer may be narrowed.
@@ -1697,14 +1699,17 @@ already."
         (let ((ident (gnus-intern-safe group gnus-active-hashtb))
               (loc (point-min))
               found buffer-read-only)
-          ;; Enter the current status into the dribble buffer.
-          (let ((entry (gnus-group-entry group)))
-            (when (and entry
-                       (not (gnus-ephemeral-group-p group)))
-              (gnus-dribble-enter
-               (concat "(gnus-group-set-info '"
-                       (gnus-prin1-to-string (nth 2 entry))
-                       ")"))))
+	  (unless info-unchanged
+	    ;; Enter the current status into the dribble buffer.
+	    (let ((entry (gnus-group-entry group)))
+	      (when (and entry
+			 (not (gnus-ephemeral-group-p group)))
+		(gnus-dribble-enter
+		 (concat "(gnus-group-set-info '"
+			 (gnus-prin1-to-string (nth 2 entry))
+			 ")")
+		 (concat "^(gnus-group-set-info '(\""
+			 (regexp-quote group) "\"")))))
           ;; Find all group instances.  If topics are in use, each group
           ;; may be listed in more than once.
           (while (setq loc (text-property-any
@@ -2715,7 +2720,8 @@ server."
     (unless (gnus-ephemeral-group-p name)
       (gnus-dribble-enter
        (concat "(gnus-group-set-info '"
-	       (gnus-prin1-to-string (cdr info)) ")")))
+	       (gnus-prin1-to-string (cdr info)) ")")
+       (concat "^(gnus-group-set-info '(\"" (regexp-quote name) "\"")))
     ;; Insert the line.
     (gnus-group-insert-group-line-info nname)
     (forward-line -1)
@@ -4032,7 +4038,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
 	    (when gnus-agent
 	      (gnus-agent-save-group-info
 	       method (gnus-group-real-name group) active))
-	    (gnus-group-update-group group))
+	    (gnus-group-update-group group nil t))
 	(if (eq (gnus-server-status (gnus-find-method-for-group group))
 		'denied)
 	    (gnus-error 3 "Server denied access")
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 9bf2d37a3e4..ec98b2ff749 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -362,7 +362,8 @@ The following commands are available:
       (when entry
 	(gnus-dribble-enter
 	 (concat "(gnus-server-set-info \"" server "\" '"
-		 (gnus-prin1-to-string (cdr entry)) ")\n")))
+		 (gnus-prin1-to-string (cdr entry)) ")\n")
+	 (concat "^(gnus-server-set-info \"" (regexp-quote server) "\"")))
       (when (or entry oentry)
 	;; Buffer may be narrowed.
 	(save-restriction
@@ -381,7 +382,8 @@ The following commands are available:
   (when (and server info)
     (gnus-dribble-enter
      (concat "(gnus-server-set-info \"" server "\" '"
-	     (gnus-prin1-to-string info) ")"))
+	     (gnus-prin1-to-string info) ")")
+     (concat "^(gnus-server-set-info \"" (regexp-quote server) "\""))
     (let* ((server (nth 1 info))
 	   (entry (assoc server gnus-server-alist))
 	   (cached (assoc server gnus-server-method-cache)))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 719d0c9e472..aa9af012a1c 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -832,13 +832,22 @@ prompt the user for the name of an NNTP server to use."
      gnus-current-startup-file)
    "-dribble"))
 
-(defun gnus-dribble-enter (string)
-  "Enter STRING into the dribble buffer."
+(defun gnus-dribble-enter (string &optional regexp)
+  "Enter STRING into the dribble buffer.
+If REGEXP is given, lines that match it will be deleted."
   (when (and (not gnus-dribble-ignore)
 	     gnus-dribble-buffer
 	     (buffer-name gnus-dribble-buffer))
     (let ((obuf (current-buffer)))
       (set-buffer gnus-dribble-buffer)
+      (when regexp
+	(goto-char (point-min))
+	(let (end)
+	  (while (re-search-forward regexp nil t)
+	    (unless (bolp) (forward-line 1))
+	    (setq end (point))
+	    (goto-char (match-beginning 0))
+	    (delete-region (point-at-bol) end))))
       (goto-char (point-max))
       (insert string "\n")
       ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
@@ -1354,8 +1363,8 @@ for new groups, and subscribe the new groups as zombies."
 	  (when (cdr entry)
 	    (setcdr (gnus-group-entry (caadr entry)) entry))
 	  (gnus-dribble-enter
-	   (format
-	    "(gnus-group-set-info '%S)" info)))))
+	   (format "(gnus-group-set-info '%S)" info)
+	   (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))))
       (when gnus-group-change-level-function
 	(funcall gnus-group-change-level-function
 		 group level oldlevel previous)))))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 1c4382b24a6..f974d386acb 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -4098,7 +4098,7 @@ If NO-DISPLAY, don't generate a summary buffer."
 	(setq gnus-newsgroup-prepared t)
 	(gnus-run-hooks 'gnus-summary-prepared-hook)
 	(unless (gnus-ephemeral-group-p group)
-	  (gnus-group-update-group group))
+	  (gnus-group-update-group group nil t))
 	t)))))
 
 (defun gnus-summary-auto-select-subject ()
@@ -7140,7 +7140,12 @@ The prefix argument ALL means to select all articles."
 		 t)))
 	(unless (listp (cdr gnus-newsgroup-killed))
 	  (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
-	(let ((headers gnus-newsgroup-headers))
+	(let ((headers gnus-newsgroup-headers)
+	      (ephemeral-p (gnus-ephemeral-group-p group))
+	      info)
+	  (unless ephemeral-p
+	    (setq info (copy-sequence (gnus-get-info group))
+		  info (delq (gnus-info-params info) info)))
 	  ;; Set the new ranges of read articles.
 	  (with-current-buffer gnus-group-buffer
 	    (gnus-undo-force-boundary))
@@ -7160,8 +7165,12 @@ The prefix argument ALL means to select all articles."
 	    (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
 	  ;; Do not switch windows but change the buffer to work.
 	  (set-buffer gnus-group-buffer)
-	  (unless (gnus-ephemeral-group-p group)
-	    (gnus-group-update-group group)))))))
+	  (unless ephemeral-p
+	    (gnus-group-update-group
+	     group nil
+	     (equal info
+		    (setq info (copy-sequence (gnus-get-info group))
+			  info (delq (gnus-info-params info) info))))))))))
 
 (defun gnus-summary-save-newsrc (&optional force)
   "Save the current number of read/marked articles in the dribble buffer.
@@ -7314,7 +7323,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
       ;; Clear the current group name.
       (setq gnus-newsgroup-name nil)
       (unless (gnus-ephemeral-group-p group)
-	(gnus-group-update-group group))
+	(gnus-group-update-group group nil t))
       (when (equal (gnus-group-group-name) group)
 	(gnus-group-next-unread-group 1))
       (when quit-config
@@ -9994,7 +10003,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
 	      (gnus-dribble-enter
 	       (concat "(gnus-group-set-info '"
 		       (gnus-prin1-to-string (gnus-get-info to-group))
-		       ")"))))
+		       ")")
+	       (concat "^(gnus-group-set-info '(\""
+		       (regexp-quote to-group) "\""))))
 
 	  ;; Update the Xref header in this article to point to
 	  ;; the new crossposted article we have just created.