diff lisp/gnus/gnus-topic.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 0293115a14e9
line wrap: on
line diff
--- a/lisp/gnus/gnus-topic.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/gnus/gnus-topic.el	Mon Aug 13 08:46:35 2007 +0200
@@ -378,6 +378,7 @@
 	gnus-topic-tallied-groups nil
 	gnus-topology-checked-p nil))
 
+
 (defun gnus-topic-check-topology ()  
   ;; The first time we set the topology to whatever we have
   ;; gotten here, which can be rather random.
@@ -385,6 +386,8 @@
     (gnus-topic-init-alist))
 
   (setq gnus-topology-checked-p t)
+  ;; Go through the topic alist and make sure that all topics
+  ;; are in the topic topology.
   (let ((topics (gnus-topic-list))
 	(alist gnus-topic-alist)
 	changed)
@@ -395,7 +398,15 @@
 	(setq changed t))
       (setq alist (cdr alist)))
     (when changed
-      (gnus-topic-enter-dribble)))
+      (gnus-topic-enter-dribble))
+    ;; Conversely, go through the topology and make sure that all
+    ;; topologies have alists.
+    (while topics
+      (unless (assoc (car topics) gnus-topic-alist)
+	(push (list (car topics)) gnus-topic-alist))
+      (pop topics)))
+  ;; Go through all living groups and make sure that
+  ;; they belong to some topic.
   (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
 					 gnus-topic-alist)))
 	 (entry (assoc (caar gnus-topic-topology) gnus-topic-alist))
@@ -403,7 +414,15 @@
 	 group)
     (while newsrc
       (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
-	(setcdr entry (cons group (cdr entry)))))))
+	(setcdr entry (cons group (cdr entry))))))
+  ;; Go through all topics and make sure they contain only living groups.
+  (let ((alist gnus-topic-alist)
+	topic)
+    (while (setq topic (pop alist))
+      (while (cdr topic)
+	(if (gnus-gethash (cadr topic) gnus-newsrc-hashtb)
+	    (setq topic (cdr topic))
+	  (setcdr topic (cddr topic)))))))
 
 (defvar gnus-tmp-topics nil)
 (defun gnus-topic-list (&optional topology)
@@ -670,6 +689,8 @@
       (make-local-variable 'gnus-group-indentation-function)
       (setq gnus-group-indentation-function
 	    'gnus-topic-group-indentation)
+      (gnus-make-local-hook 'gnus-check-bogus-groups-hook)
+      (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
       (setq gnus-topology-checked-p nil)
       ;; We check the topology.
       (when gnus-newsrc-alist
@@ -680,6 +701,7 @@
       (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
       (remove-hook 'gnus-group-change-level-function 
 		   'gnus-topic-change-level)
+      (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
       (setq gnus-group-prepare-function 'gnus-group-prepare-flat))
     (when redisplay
       (gnus-group-list-groups))))
@@ -688,7 +710,9 @@
   "Select this newsgroup.
 No article is selected automatically.
 If ALL is non-nil, already read articles become readable.
-If ALL is a number, fetch this number of articles."
+If ALL is a number, fetch this number of articles.
+
+If performed over a topic line, toggle folding the topic."
   (interactive "P")
   (if (gnus-group-topic-p)
       (let ((gnus-group-list-mode 
@@ -708,7 +732,9 @@
 readable.  IF ALL is a number, fetch this number of articles.  If the
 optional argument NO-ARTICLE is non-nil, no article will be
 auto-selected upon group entry.  If GROUP is non-nil, fetch that
-group."
+group.
+
+If performed over a topic line, toggle folding the topic."
   (interactive "P")
   (if (gnus-group-topic-p)
       (let ((gnus-group-list-mode 
@@ -790,6 +816,22 @@
 	    (gnus-topic-goto-topic (gnus-group-parent-topic))
 	    (gnus-group-topic-level)) 0)) ? ))
 
+(defun gnus-topic-clean-alist ()
+  "Remove bogus groups from the topic alist."
+  (let ((topic-alist gnus-topic-alist)
+	result topic)
+    (unless gnus-killed-hashtb
+      (gnus-make-hashtable-from-killed))
+    (while (setq topic (pop topic-alist))
+      (let ((topic-name (pop topic))
+	    group filtered-topic)
+	(while (setq group (pop topic))
+	  (if (and (gnus-gethash group gnus-active-hashtb)
+		   (not (gnus-gethash group gnus-killed-hashtb)))
+	      (push group filtered-topic)))
+	(push (cons topic-name (nreverse filtered-topic)) result)))
+    (setq gnus-topic-alist (nreverse result))))
+
 (defun gnus-topic-change-level (group level oldlevel)
   "Run when changing levels to enter/remove groups from topics."
   (save-excursion
@@ -920,7 +962,7 @@
     (gnus-topic-update-topic)))
 
 (defun gnus-topic-hide-topic ()
-  "Hide all subtopics under the current topic."
+  "Hide the current topic."
   (interactive)
   (when (gnus-group-parent-topic)
     (gnus-topic-goto-topic (gnus-group-parent-topic))
@@ -1004,6 +1046,7 @@
       (setcar (cadr top) new-name))
     (when entry 
       (setcar entry new-name))
+    (forward-line -1)
     (gnus-group-list-groups)))
 
 (defun gnus-topic-indent (&optional unindent)