From: Katsumi Yamaoka Date: Fri, 10 Jun 2011 00:10:24 +0000 (+0000) Subject: Improve Gnus' dribble data handling. X-Git-Tag: emacs-pretest-24.0.90~104^2~597 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b229f37d43081a2d960467ead3c5eed6a5764680;p=emacs.git Improve Gnus' dribble data handling. --- 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 + + * 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 * 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 @@ -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.