diff lisp/gnus/gnus-topic.el @ 16:0293115a14e9 r19-15b91

Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents ac2d302a0011
children d95e72db5c07
line wrap: on
line diff
--- a/lisp/gnus/gnus-topic.el	Mon Aug 13 08:48:43 2007 +0200
+++ b/lisp/gnus/gnus-topic.el	Mon Aug 13 08:49:20 2007 +0200
@@ -1,5 +1,5 @@
 ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
 
 ;; Author: Ilja Weis <kult@uni-paderborn.de>
 ;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -27,15 +27,22 @@
 ;;; Code:
 
 (require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-group)
+(require 'gnus-start)
+
+(defgroup gnus-topic nil
+  "Group topics."
+  :group 'gnus-group)
 
 (defvar gnus-topic-mode nil
   "Minor mode for Gnus group buffers.")
 
-(defvar gnus-topic-mode-hook nil
-  "Hook run in topic mode buffers.")
+(defcustom gnus-topic-mode-hook nil
+  "Hook run in topic mode buffers."
+  :type 'hook
+  :group 'gnus-topic)
 
-(defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
+(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
   "Format of topic lines.
 It works along the same lines as a normal formatting string,
 with some simple extensions.
@@ -46,10 +53,19 @@
 %g  Number of groups in the topic.
 %a  Number of unread articles in the groups in the topic.
 %A  Number of unread articles in the groups in the topic and its subtopics.
-")
+"
+  :type 'string
+  :group 'gnus-topic)
 
-(defvar gnus-topic-indent-level 2
-  "*How much each subtopic should be indented.")
+(defcustom gnus-topic-indent-level 2
+  "*How much each subtopic should be indented."
+  :type 'integer
+  :group 'gnus-topic)
+
+(defcustom gnus-topic-display-empty-topics t
+  "*If non-nil, display the topic lines even of topics that have no unread articles."
+  :type 'boolean
+  :group 'gnus-topic)
 
 ;; Internal variables.
 
@@ -74,20 +90,20 @@
 
 (defvar gnus-topic-line-format-spec nil)
 
-;; Functions.
+;;; Utility functions
 
 (defun gnus-group-topic-name ()
   "The name of the topic on the current line."
-  (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
+  (let ((topic (get-text-property (point-at-bol) 'gnus-topic)))
     (and topic (symbol-name topic))))
 
 (defun gnus-group-topic-level ()
   "The level of the topic on the current line."
-  (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
+  (get-text-property (point-at-bol) 'gnus-topic-level))
 
 (defun gnus-group-topic-unread ()
   "The number of unread articles in topic on the current line."
-  (get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
+  (get-text-property (point-at-bol) 'gnus-topic-unread))
 
 (defun gnus-topic-unread (topic)
   "Return the number of unread articles in TOPIC."
@@ -96,118 +112,73 @@
 	     (gnus-group-topic-unread)))
       0))
 
-(defun gnus-topic-init-alist ()
-  "Initialize the topic structures."
-  (setq gnus-topic-topology
-	(cons (list "Gnus" 'visible)
-	      (mapcar (lambda (topic)
-			(list (list (car topic) 'visible)))
-		      '(("misc")))))
-  (setq gnus-topic-alist
-	(list (cons "misc"
-		    (mapcar (lambda (info) (gnus-info-group info))
-			    (cdr gnus-newsrc-alist)))
-	      (list "Gnus")))
-  (gnus-topic-enter-dribble))
+(defun gnus-group-topic-p ()
+  "Return non-nil if the current line is a topic."
+  (gnus-group-topic-name))
 
-(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level)
-  "List all newsgroups with unread articles of level LEVEL or lower, and
-use the `gnus-group-topics' to sort the groups.
-If ALL is non-nil, list groups that have no unread articles.
-If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
-  (set-buffer gnus-group-buffer)
-  (let ((buffer-read-only nil)
-        (lowest (or lowest 1)))
-
-    (setq gnus-topic-tallied-groups nil)
+(defun gnus-topic-visible-p ()
+  "Return non-nil if the current topic is visible."
+  (get-text-property (point-at-bol) 'gnus-topic-visible))
 
-    (when (or (not gnus-topic-alist)
-	      (not gnus-topology-checked-p))
-      (gnus-topic-check-topology))
+(defun gnus-topic-articles-in-topic (entries)
+  (let ((total 0)
+	number)
+    (while entries
+      (when (numberp (setq number (car (pop entries))))
+	(incf total number)))
+    total))
 
-    (unless list-topic 
-      (erase-buffer))
-    
-    ;; List dead groups?
-    (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
-      (gnus-group-prepare-flat-list-dead 
-       (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 
-       gnus-level-zombie ?Z
-       regexp))
-    
-    (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
-      (gnus-group-prepare-flat-list-dead 
-       (setq gnus-killed-list (sort gnus-killed-list 'string<))
-       gnus-level-killed ?K
-       regexp))
-
-    ;; Use topics.
-    (when (< lowest gnus-level-zombie)
-      (if list-topic
-	  (let ((top (gnus-topic-find-topology list-topic)))
-	    (gnus-topic-prepare-topic (cdr top) (car top)
-				      (or topic-level level) all))
-	(gnus-topic-prepare-topic gnus-topic-topology 0
-				  (or topic-level level) all))))
+(defun gnus-group-topic (group)
+  "Return the topic GROUP is a member of."
+  (let ((alist gnus-topic-alist)
+	out)
+    (while alist
+      (when (member group (cdar alist))
+	(setq out (caar alist)
+	      alist nil))
+      (setq alist (cdr alist)))
+    out))
 
-  (gnus-group-set-mode-line)
-  (setq gnus-group-list-mode (cons level all))
-  (run-hooks 'gnus-group-prepare-hook))
+(defun gnus-group-parent-topic (group)
+  "Return the topic GROUP is member of by looking at the group buffer."
+  (save-excursion
+    (set-buffer gnus-group-buffer)
+    (if (gnus-group-goto-group group)
+	(gnus-current-topic)
+      (gnus-group-topic group))))
+
+(defun gnus-topic-goto-topic (topic)
+  "Go to TOPIC."
+  (when topic
+    (gnus-goto-char (text-property-any (point-min) (point-max)
+				       'gnus-topic (intern topic)))))
 
-(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent)
-  "Insert TOPIC into the group buffer.
-If SILENT, don't insert anything.  Return the number of unread
-articles in the topic and its subtopics."
-  (let* ((type (pop topicl))
-	 (entries (gnus-topic-find-groups (car type) list-level all))
-	 (visiblep (and (eq (nth 1 type) 'visible) (not silent)))
-	 (gnus-group-indentation 
-	  (make-string (* gnus-topic-indent-level level) ? ))
-	 (beg (progn (beginning-of-line) (point)))
-	 (topicl (reverse topicl))
-	 (all-entries entries)
-	 (unread 0)
-	 (topic (car type))
-	 info entry end active)
-    ;; Insert any sub-topics.
-    (while topicl
-      (incf unread
-	    (gnus-topic-prepare-topic 
-	     (pop topicl) (1+ level) list-level all
-	     (not visiblep))))
-    (setq end (point))
-    (goto-char beg)
-    ;; Insert all the groups that belong in this topic.
-    (while (setq entry (pop entries))
-      (when visiblep 
-	(if (stringp entry)
-	    ;; Dead groups.
-	    (gnus-group-insert-group-line
-	     entry (if (member entry gnus-zombie-list) 8 9)
-	     nil (- (1+ (cdr (setq active (gnus-active entry))))
-		    (car active)) nil)
-	  ;; Living groups.
-	  (when (setq info (nth 2 entry))
-	    (gnus-group-insert-group-line 
-	     (gnus-info-group info)
-	     (gnus-info-level info) (gnus-info-marks info) 
-	     (car entry) (gnus-info-method info)))))
-      (when (and (listp entry)
-		 (numberp (car entry))
-		 (not (member (gnus-info-group (setq info (nth 2 entry)))
-			      gnus-topic-tallied-groups)))
-	(push (gnus-info-group info) gnus-topic-tallied-groups)
-	(incf unread (car entry))))
-    (goto-char beg)
-    ;; Insert the topic line.
-    (unless silent
-      (gnus-extent-start-open (point))
-      (gnus-topic-insert-topic-line 
-       (car type) visiblep
-       (not (eq (nth 2 type) 'hidden))
-       level all-entries unread))
-    (goto-char end)
-    unread))
+(defun gnus-current-topic ()
+  "Return the name of the current topic."
+  (let ((result
+	 (or (get-text-property (point) 'gnus-topic)
+	     (save-excursion
+	       (and (gnus-goto-char (previous-single-property-change
+				     (point) 'gnus-topic))
+		    (get-text-property (max (1- (point)) (point-min))
+				       'gnus-topic))))))
+    (when result
+      (symbol-name result))))
+
+(defun gnus-current-topics ()
+  "Return a list of all current topics, lowest in hierarchy first."
+  (let ((topic (gnus-current-topic))
+	topics)
+    (while topic
+      (push topic topics)
+      (setq topic (gnus-topic-parent-topic topic)))
+    (nreverse topics)))
+
+(defun gnus-group-active-topic-p ()
+  "Say whether the current topic comes from the active topics."
+  (save-excursion
+    (beginning-of-line)
+    (get-text-property (point) 'gnus-active)))
 
 (defun gnus-topic-find-groups (topic &optional level all)
   "Return entries for all visible groups in TOPIC."
@@ -217,19 +188,20 @@
     (setq level (or level 7))
     ;; We go through the newsrc to look for matches.
     (while groups
-      (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb)
-	    info (nth 2 entry)
-	    params (gnus-info-params info)
-	    active (gnus-active group)
-            unread (or (car entry)
-		       (and (not (equal group "dummy.group"))
-			    active
-			    (- (1+ (cdr active)) (car active))))
-	    clevel (or (gnus-info-level info)
-		       (if (member group gnus-zombie-list) 8 9)))
+      (when (setq group (pop groups))
+	(setq entry (gnus-gethash group gnus-newsrc-hashtb)
+	      info (nth 2 entry)
+	      params (gnus-info-params info)
+	      active (gnus-active group)
+	      unread (or (car entry)
+			 (and (not (equal group "dummy.group"))
+			      active
+			      (- (1+ (cdr active)) (car active))))
+	      clevel (or (gnus-info-level info)
+			 (if (member group gnus-zombie-list) 8 9))))
       (and 
        unread				; nil means that the group is dead.
-       (<= clevel level) 
+       (<= clevel level)
        (>= clevel lowest)		; Is inside the level we want.
        (or all
 	   (if (eq unread t)
@@ -247,72 +219,6 @@
        (push (or entry group) visible-groups)))
     (nreverse visible-groups)))
 
-(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
-  "Remove the current topic."
-  (let ((topic (gnus-group-topic-name))
-	(level (gnus-group-topic-level))
-	(beg (progn (beginning-of-line) (point)))
-	buffer-read-only)
-    (when topic
-      (while (and (zerop (forward-line 1))
-		  (> (or (gnus-group-topic-level) (1+ level)) level)))
-      (delete-region beg (point))
-      (setcar (cdadr (gnus-topic-find-topology topic))
-	      (if insert 'visible 'invisible))
-      (when hide
-	(setcdr (cdadr (gnus-topic-find-topology topic))
-		(list hide)))
-      (unless total-remove
-	(gnus-topic-insert-topic topic in-level)))))
-
-(defun gnus-topic-insert-topic (topic &optional level)
-  "Insert TOPIC."
-  (gnus-group-prepare-topics 
-   (car gnus-group-list-mode) (cdr gnus-group-list-mode)
-   nil nil topic level))
-  
-(defun gnus-topic-fold (&optional insert)
-  "Remove/insert the current topic."
-  (let ((topic (gnus-group-topic-name))) 
-    (when topic
-      (save-excursion
-	(if (not (gnus-group-active-topic-p))
-	    (gnus-topic-remove-topic
-	     (or insert (not (gnus-topic-visible-p))))
-	  (let ((gnus-topic-topology gnus-topic-active-topology)
-		(gnus-topic-alist gnus-topic-active-alist)
-		(gnus-group-list-mode (cons 5 t)))
-	    (gnus-topic-remove-topic
-	     (or insert (not (gnus-topic-visible-p))) nil nil 9)))))))
-
-(defun gnus-group-topic-p ()
-  "Return non-nil if the current line is a topic."
-  (gnus-group-topic-name))
-
-(defun gnus-topic-visible-p ()
-  "Return non-nil if the current topic is visible."
-  (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
-
-(defun gnus-topic-insert-topic-line (name visiblep shownp level entries 
-					  &optional unread)
-  (let* ((visible (if visiblep "" "..."))
-	 (indentation (make-string (* gnus-topic-indent-level level) ? ))
-	 (total-number-of-articles unread)
-	 (number-of-groups (length entries))
-	 (active-topic (eq gnus-topic-alist gnus-topic-active-alist)))
-    (beginning-of-line)
-    ;; Insert the text.
-    (gnus-add-text-properties 
-     (point)
-     (prog1 (1+ (point)) 
-       (eval gnus-topic-line-format-spec)
-       (gnus-topic-remove-excess-properties)1)
-     (list 'gnus-topic (intern name)
-	   'gnus-topic-level level
-	   'gnus-topic-unread unread
-	   'gnus-active active-topic
-	   'gnus-topic-visible visiblep))))
-
 (defun gnus-topic-previous-topic (topic)
   "Return the previous topic on the same level as TOPIC."
   (let ((top (cddr (gnus-topic-find-topology
@@ -337,8 +243,7 @@
 
 (defun gnus-topic-next-topic (topic &optional previous)
   "Return the next sibling of TOPIC."
-  (let ((topology gnus-topic-topology)
-	(parentt (cddr (gnus-topic-find-topology 
+  (let ((parentt (cddr (gnus-topic-find-topology 
 			(gnus-topic-parent-topic topic))))
 	prev)
     (while (and parentt
@@ -369,6 +274,334 @@
 	(setq topology (cdr topology)))
       result)))
 
+(defvar gnus-tmp-topics nil)
+(defun gnus-topic-list (&optional topology)
+  "Return a list of all topics in the topology."
+  (unless topology
+    (setq topology gnus-topic-topology 
+	  gnus-tmp-topics nil))
+  (push (caar topology) gnus-tmp-topics)
+  (mapcar 'gnus-topic-list (cdr topology))
+  gnus-tmp-topics)
+
+;;; Topic parameter jazz
+
+(defun gnus-topic-parameters (topic)
+  "Return the parameters for TOPIC."
+  (let ((top (gnus-topic-find-topology topic)))
+    (when top
+      (nth 3 (cadr top)))))
+
+(defun gnus-topic-set-parameters (topic parameters)
+  "Set the topic parameters of TOPIC to PARAMETERS."
+  (let ((top (gnus-topic-find-topology topic)))
+    (unless top
+      (error "No such topic: %s" topic))
+    ;; We may have to extend if there is no parameters here
+    ;; to begin with.
+    (unless (nthcdr 2 (cadr top))
+      (nconc (cadr top) (list nil)))
+    (unless (nthcdr 3 (cadr top))
+      (nconc (cadr top) (list nil)))
+    (setcar (nthcdr 3 (cadr top)) parameters)
+    (gnus-dribble-enter
+     (format "(gnus-topic-set-parameters %S '%S)" topic parameters))))
+
+(defun gnus-group-topic-parameters (group)
+  "Compute the group parameters for GROUP taking into account inheritance from topics."
+  (let ((params-list (list (gnus-group-get-parameter group)))
+	topics params param out)
+    (save-excursion
+      (gnus-group-goto-group group)
+      (setq topics (gnus-current-topics))
+      (while topics
+	(push (gnus-topic-parameters (pop topics)) params-list))
+      ;; We probably have lots of nil elements here, so
+      ;; we remove them.  Probably faster than doing this "properly".
+      (setq params-list (delq nil params-list))
+      ;; Now we have all the parameters, so we go through them
+      ;; and do inheritance in the obvious way.
+      (while (setq params (pop params-list))
+	(while (setq param (pop params))
+	  (when (atom param)
+	    (setq param (cons param t)))
+	  ;; Override any old versions of this param.
+	  (setq out (delq (assq (car param) out) out))
+	  (push param out)))
+      ;; Return the resulting parameter list.
+      out)))
+
+;;; General utility functions
+
+(defun gnus-topic-enter-dribble ()
+  (gnus-dribble-enter
+   (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
+
+;;; Generating group buffers
+
+(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level)
+  "List all newsgroups with unread articles of level LEVEL or lower, and
+use the `gnus-group-topics' to sort the groups.
+If ALL is non-nil, list groups that have no unread articles.
+If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
+  (set-buffer gnus-group-buffer)
+  (let ((buffer-read-only nil)
+        (lowest (or lowest 1)))
+
+    (setq gnus-topic-tallied-groups nil)
+
+    (when (or (not gnus-topic-alist)
+	      (not gnus-topology-checked-p))
+      (gnus-topic-check-topology))
+
+    (unless list-topic 
+      (erase-buffer))
+    
+    ;; List dead groups?
+    (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
+      (gnus-group-prepare-flat-list-dead 
+       (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+       gnus-level-zombie ?Z
+       regexp))
+    
+    (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
+      (gnus-group-prepare-flat-list-dead 
+       (setq gnus-killed-list (sort gnus-killed-list 'string<))
+       gnus-level-killed ?K
+       regexp))
+
+    ;; Use topics.
+    (prog1
+	(when (< lowest gnus-level-zombie)
+	  (if list-topic
+	      (let ((top (gnus-topic-find-topology list-topic)))
+		(gnus-topic-prepare-topic (cdr top) (car top)
+					  (or topic-level level) all))
+	    (gnus-topic-prepare-topic gnus-topic-topology 0
+				      (or topic-level level) all)))
+      
+      (gnus-group-set-mode-line)
+      (setq gnus-group-list-mode (cons level all))
+      (run-hooks 'gnus-group-prepare-hook))))
+
+(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent)
+  "Insert TOPIC into the group buffer.
+If SILENT, don't insert anything.  Return the number of unread
+articles in the topic and its subtopics."
+  (let* ((type (pop topicl))
+	 (entries (gnus-topic-find-groups (car type) list-level all))
+	 (visiblep (and (eq (nth 1 type) 'visible) (not silent)))
+	 (gnus-group-indentation 
+	  (make-string (* gnus-topic-indent-level level) ? ))
+	 (beg (progn (beginning-of-line) (point)))
+	 (topicl (reverse topicl))
+	 (all-entries entries)
+	 (point-max (point-max))
+	 (unread 0)
+	 (topic (car type))
+	 info entry end active)
+    ;; Insert any sub-topics.
+    (while topicl
+      (incf unread
+	    (gnus-topic-prepare-topic 
+	     (pop topicl) (1+ level) list-level all
+	     (not visiblep))))
+    (setq end (point))
+    (goto-char beg)
+    ;; Insert all the groups that belong in this topic.
+    (while (setq entry (pop entries))
+      (when visiblep 
+	(if (stringp entry)
+	    ;; Dead groups.
+	    (gnus-group-insert-group-line
+	     entry (if (member entry gnus-zombie-list) 8 9)
+	     nil (- (1+ (cdr (setq active (gnus-active entry))))
+		    (car active))
+	     nil)
+	  ;; Living groups.
+	  (when (setq info (nth 2 entry))
+	    (gnus-group-insert-group-line 
+	     (gnus-info-group info)
+	     (gnus-info-level info) (gnus-info-marks info)
+	     (car entry) (gnus-info-method info)))))
+      (when (and (listp entry)
+		 (numberp (car entry))
+		 (not (member (gnus-info-group (setq info (nth 2 entry)))
+			      gnus-topic-tallied-groups)))
+	(push (gnus-info-group info) gnus-topic-tallied-groups)
+	(incf unread (car entry))))
+    (goto-char beg)
+    ;; Insert the topic line.
+    (when (and (not silent)
+	       (or gnus-topic-display-empty-topics
+		   (not (zerop unread))
+		   (/= point-max (point-max))))
+      (gnus-extent-start-open (point))
+      (gnus-topic-insert-topic-line 
+       (car type) visiblep
+       (not (eq (nth 2 type) 'hidden))
+       level all-entries unread))
+    (goto-char end)
+    unread))
+
+(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
+  "Remove the current topic."
+  (let ((topic (gnus-group-topic-name))
+	(level (gnus-group-topic-level))
+	(beg (progn (beginning-of-line) (point)))
+	buffer-read-only)
+    (when topic
+      (while (and (zerop (forward-line 1))
+		  (> (or (gnus-group-topic-level) (1+ level)) level)))
+      (delete-region beg (point))
+      ;; Do the change in this rather odd manner because it has been
+      ;; reported that some topics share parts of some lists, for some
+      ;; reason.  I have been unable to determine why this is the
+      ;; case, but this hack seems to take care of things.
+      (let ((data (cadr (gnus-topic-find-topology topic))))
+	(setcdr data
+		(list (if insert 'visible 'invisible)
+		      (if hide 'hide nil)
+		      (cadddr data))))
+      (if total-remove
+	  (setq gnus-topic-alist
+		(delq (assoc topic gnus-topic-alist) gnus-topic-alist))
+	(gnus-topic-insert-topic topic in-level)))))
+
+(defun gnus-topic-insert-topic (topic &optional level)
+  "Insert TOPIC."
+  (gnus-group-prepare-topics 
+   (car gnus-group-list-mode) (cdr gnus-group-list-mode)
+   nil nil topic level))
+  
+(defun gnus-topic-fold (&optional insert)
+  "Remove/insert the current topic."
+  (let ((topic (gnus-group-topic-name)))
+    (when topic
+      (save-excursion
+	(if (not (gnus-group-active-topic-p))
+	    (gnus-topic-remove-topic
+	     (or insert (not (gnus-topic-visible-p))))
+	  (let ((gnus-topic-topology gnus-topic-active-topology)
+		(gnus-topic-alist gnus-topic-active-alist)
+		(gnus-group-list-mode (cons 5 t)))
+	    (gnus-topic-remove-topic
+	     (or insert (not (gnus-topic-visible-p))) nil nil 9)))))))
+
+(defun gnus-topic-insert-topic-line (name visiblep shownp level entries 
+					  &optional unread)
+  (let* ((visible (if visiblep "" "..."))
+	 (indentation (make-string (* gnus-topic-indent-level level) ? ))
+	 (total-number-of-articles unread)
+	 (number-of-groups (length entries))
+	 (active-topic (eq gnus-topic-alist gnus-topic-active-alist)))
+    (beginning-of-line)
+    ;; Insert the text.
+    (gnus-add-text-properties 
+     (point)
+     (prog1 (1+ (point))
+       (eval gnus-topic-line-format-spec)
+       (gnus-topic-remove-excess-properties)1)
+     (list 'gnus-topic (intern name)
+	   'gnus-topic-level level
+	   'gnus-topic-unread unread
+	   'gnus-active active-topic
+	   'gnus-topic-visible visiblep))))
+
+(defun gnus-topic-update-topics-containing-group (group)
+  "Update all topics that have GROUP as a member."
+  (when (and (eq major-mode 'gnus-group-mode)
+	     gnus-topic-mode)
+    (save-excursion
+      (let ((alist gnus-topic-alist))
+	;; This is probably not entirely correct.  If a topic
+	;; isn't shown, then it's not updated.  But the updating
+	;; should be performed in any case, since the topic's
+	;; parent should be updated.  Pfft.
+	(while alist
+	  (when (and (member group (cdar alist))
+		     (gnus-topic-goto-topic (caar alist)))
+	    (gnus-topic-update-topic-line (caar alist)))
+	  (pop alist))))))
+
+(defun gnus-topic-update-topic ()
+  "Update all parent topics to the current group."
+  (when (and (eq major-mode 'gnus-group-mode)
+	     gnus-topic-mode)
+    (let ((group (gnus-group-group-name))
+	  (buffer-read-only nil))
+      (when (and group 
+		 (gnus-get-info group)
+		 (gnus-topic-goto-topic (gnus-current-topic)))
+	(gnus-topic-update-topic-line (gnus-group-topic-name))
+	(gnus-group-goto-group group)
+	(gnus-group-position-point)))))
+
+(defun gnus-topic-goto-missing-group (group)
+  "Place point where GROUP is supposed to be inserted."
+  (let* ((topic (gnus-group-topic group))
+	 (groups (cdr (assoc topic gnus-topic-alist)))
+	 (g (cdr (member group groups)))
+	 (unfound t))
+    ;; Try to jump to a visible group.
+    (while (and g (not (gnus-group-goto-group (car g) t)))
+      (pop g))
+    ;; It wasn't visible, so we try to see where to insert it.
+    (when (not g)
+      (setq g (cdr (member group (reverse groups))))
+      (while (and g unfound)
+	(when (gnus-group-goto-group (pop g) t)
+	  (forward-line 1)
+	  (setq unfound nil)))
+      (when unfound
+	(gnus-topic-goto-topic topic)
+	(forward-line 1)))))
+
+(defun gnus-topic-update-topic-line (topic-name &optional reads)
+  (let* ((top (gnus-topic-find-topology topic-name))
+	 (type (cadr top))
+	 (children (cddr top))
+	 (entries (gnus-topic-find-groups 
+		   (car type) (car gnus-group-list-mode)
+		   (cdr gnus-group-list-mode)))
+	 (parent (gnus-topic-parent-topic topic-name))
+	 (all-entries entries)
+	 (unread 0)
+	 old-unread entry)
+    (when (gnus-topic-goto-topic (car type))
+      ;; Tally all the groups that belong in this topic.
+      (if reads
+	  (setq unread (- (gnus-group-topic-unread) reads))
+	(while children
+	  (incf unread (gnus-topic-unread (caar (pop children)))))
+	(while (setq entry (pop entries))
+	  (when (numberp (car entry))
+	    (incf unread (car entry)))))
+      (setq old-unread (gnus-group-topic-unread))
+      ;; Insert the topic line.
+      (gnus-topic-insert-topic-line 
+       (car type) (gnus-topic-visible-p)
+       (not (eq (nth 2 type) 'hidden))
+       (gnus-group-topic-level) all-entries unread)
+      (gnus-delete-line))
+    (when parent
+      (forward-line -1)
+      (gnus-topic-update-topic-line
+       parent (- old-unread (gnus-group-topic-unread))))
+    unread))
+
+(defun gnus-topic-group-indentation ()
+  (make-string 
+   (* gnus-topic-indent-level
+      (or (save-excursion
+	    (forward-line -1)
+	    (gnus-topic-goto-topic (gnus-current-topic))
+	    (gnus-group-topic-level))
+	  0))
+   ? ))
+
+;;; Initialization
+
 (gnus-add-shutdown 'gnus-topic-close 'gnus)
 
 (defun gnus-topic-close ()
@@ -378,8 +611,7 @@
 	gnus-topic-tallied-groups nil
 	gnus-topology-checked-p nil))
 
-
-(defun gnus-topic-check-topology ()  
+(defun gnus-topic-check-topology ()
   ;; The first time we set the topology to whatever we have
   ;; gotten here, which can be rather random.
   (unless gnus-topic-alist
@@ -424,120 +656,122 @@
 	    (setq topic (cdr topic))
 	  (setcdr topic (cddr topic)))))))
 
-(defvar gnus-tmp-topics nil)
-(defun gnus-topic-list (&optional topology)
-  (unless topology
-    (setq topology gnus-topic-topology 
-	  gnus-tmp-topics nil))
-  (push (caar topology) gnus-tmp-topics)
-  (mapcar 'gnus-topic-list (cdr topology))
-  gnus-tmp-topics)
+(defun gnus-topic-init-alist ()
+  "Initialize the topic structures."
+  (setq gnus-topic-topology
+	(cons (list "Gnus" 'visible)
+	      (mapcar (lambda (topic)
+			(list (list (car topic) 'visible)))
+		      '(("misc")))))
+  (setq gnus-topic-alist
+	(list (cons "misc"
+		    (mapcar (lambda (info) (gnus-info-group info))
+			    (cdr gnus-newsrc-alist)))
+	      (list "Gnus")))
+  (gnus-topic-enter-dribble))
 
-(defun gnus-topic-enter-dribble ()
-  (gnus-dribble-enter
-   (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
+;;; Maintenance
 
-(defun gnus-topic-articles-in-topic (entries)
-  (let ((total 0)
-	number)
-    (while entries
-      (when (numberp (setq number (car (pop entries))))
-	(incf total number)))
-    total))
-
-(defun gnus-group-topic (group)
-  "Return the topic GROUP is a member of."
-  (let ((alist gnus-topic-alist)
-	out)
-    (while alist
-      (when (member group (cdar alist))
-	(setq out (caar alist)
-	      alist nil))
-      (setq alist (cdr alist)))
-    out))
-
-(defun gnus-topic-goto-topic (topic)
-  "Go to TOPIC."
-  (when topic
-    (gnus-goto-char (text-property-any (point-min) (point-max)
-				       'gnus-topic (intern topic)))))
+(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))
+	  (when (and (or (gnus-gethash group gnus-active-hashtb)
+			 (gnus-info-method (gnus-get-info group)))
+		     (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-group-parent-topic ()
-  "Return the name of the current topic."
-  (let ((result
-	 (or (get-text-property (point) 'gnus-topic)
-	     (save-excursion
-	       (and (gnus-goto-char (previous-single-property-change
-				     (point) 'gnus-topic))
-		    (get-text-property (max (1- (point)) (point-min))
-				       'gnus-topic))))))
-    (when result
-      (symbol-name result))))
-  
-(defun gnus-topic-update-topic ()
-  "Update all parent topics to the current group."
-  (when (and (eq major-mode 'gnus-group-mode)
-	     gnus-topic-mode)
-    (let ((group (gnus-group-group-name))
-	  (buffer-read-only nil))
-      (when (and group (gnus-get-info group)
-		 (gnus-topic-goto-topic (gnus-group-parent-topic)))
-	(gnus-topic-update-topic-line (gnus-group-topic-name))
-	(gnus-group-goto-group group)
-	(gnus-group-position-point)))))
+(defun gnus-topic-change-level (group level oldlevel)
+  "Run when changing levels to enter/remove groups from topics."
+  (save-excursion
+    (set-buffer gnus-group-buffer)
+    (when (and gnus-topic-mode 
+	       gnus-topic-alist
+	       (not gnus-topic-inhibit-change-level))
+      ;; Remove the group from the topics.
+      (when (and (< oldlevel gnus-level-zombie)
+		 (>= level gnus-level-zombie))
+	(let (alist)
+	  (forward-line -1)
+	  (when (setq alist (assoc (gnus-current-topic) gnus-topic-alist))
+	    (setcdr alist (gnus-delete-first group (cdr alist))))))
+      ;; If the group is subscribed we enter it into the topics.
+      (when (and (< level gnus-level-zombie)
+		 (>= oldlevel gnus-level-zombie))
+	(let* ((prev (gnus-group-group-name))
+	       (gnus-topic-inhibit-change-level t)
+	       (gnus-group-indentation
+		(make-string 
+		 (* gnus-topic-indent-level
+		    (or (save-excursion
+			  (gnus-topic-goto-topic (gnus-current-topic))
+			  (gnus-group-topic-level))
+			0))
+		 ? ))
+	       (yanked (list group))
+	       alist talist end)
+	  ;; Then we enter the yanked groups into the topics they belong
+	  ;; to. 
+	  (when (setq alist (assoc (save-excursion
+				     (forward-line -1)
+				     (or
+				      (gnus-current-topic)
+				      (caar gnus-topic-topology)))
+				   gnus-topic-alist))
+	    (setq talist alist)
+	    (when (stringp yanked)
+	      (setq yanked (list yanked)))
+	    (if (not prev)
+		(nconc alist yanked)
+	      (if (not (cdr alist))
+		  (setcdr alist (nconc yanked (cdr alist)))
+		(while (and (not end) (cdr alist))
+		  (when (equal (cadr alist) prev)
+		    (setcdr alist (nconc yanked (cdr alist)))
+		    (setq end t))
+		  (setq alist (cdr alist)))
+		(unless end
+		  (nconc talist yanked))))))
+	(gnus-topic-update-topic)))))
 
-(defun gnus-topic-goto-missing-group (group) 
-  "Place point where GROUP is supposed to be inserted."
-  (let* ((topic (gnus-group-topic group))
-	 (groups (cdr (assoc topic gnus-topic-alist)))
-	 (g (cdr (member group groups)))
-	 (unfound t))
-    (while (and g unfound)
-      (when (gnus-group-goto-group (pop g))
-	(beginning-of-line)
-	(setq unfound nil)))
-    (when unfound
-      (setq g (cdr (member group (reverse groups))))
-      (while (and g unfound)
-	(when (gnus-group-goto-group (pop g))
-	  (forward-line 1)
-	  (setq unfound nil)))
-      (when unfound
-	(gnus-topic-goto-topic topic)
-	(forward-line 1)))))
+(defun gnus-topic-goto-next-group (group props)
+  "Go to group or the next group after group."
+  (if (not group)
+      (if (not (memq 'gnus-topic props))
+	  (goto-char (point-max))
+	(gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))))
+    (if (gnus-group-goto-group group)
+	t
+      ;; The group is no longer visible.
+      (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist))
+	     (after (cdr (member group (cdr list)))))
+	;; First try to put point on a group after the current one.
+	(while (and after
+		    (not (gnus-group-goto-group (car after))))
+	  (setq after (cdr after)))
+	;; Then try to put point on a group before point.
+	(unless after
+	  (setq after (cdr (member group (reverse (cdr list)))))
+	  (while (and after 
+		      (not (gnus-group-goto-group (car after))))
+	    (setq after (cdr after))))
+	;; Finally, just put point on the topic.
+	(if (not (car list))
+	    (goto-char (point-min))
+	  (unless after
+	    (gnus-topic-goto-topic (car list))
+	    (setq after nil)))
+	t))))
 
-(defun gnus-topic-update-topic-line (topic-name &optional reads)
-  (let* ((top (gnus-topic-find-topology topic-name))
-	 (type (cadr top))
-	 (children (cddr top))
-	 (entries (gnus-topic-find-groups 
-		   (car type) (car gnus-group-list-mode)
-		   (cdr gnus-group-list-mode)))
-	 (parent (gnus-topic-parent-topic topic-name))
-	 (all-entries entries)
-	 (unread 0)
-	 old-unread entry)
-    (when (gnus-topic-goto-topic (car type))
-      ;; Tally all the groups that belong in this topic.
-      (if reads
-	  (setq unread (- (gnus-group-topic-unread) reads))
-	(while children
-	  (incf unread (gnus-topic-unread (caar (pop children)))))
-	(while (setq entry (pop entries))
-	  (when (numberp (car entry))
-	    (incf unread (car entry)))))
-      (setq old-unread (gnus-group-topic-unread))
-      ;; Insert the topic line.
-      (gnus-topic-insert-topic-line 
-       (car type) (gnus-topic-visible-p)
-       (not (eq (nth 2 type) 'hidden))
-       (gnus-group-topic-level) all-entries unread)
-      (gnus-delete-line))
-    (when parent
-      (forward-line -1)
-      (gnus-topic-update-topic-line
-       parent (- old-unread (gnus-group-topic-unread))))
-    unread))
+;;; Topic-active functions
 
 (defun gnus-topic-grok-active (&optional force)
   "Parse all active groups and create topic structures for them."
@@ -589,12 +823,6 @@
     ;; to this topic.
     groups))
 
-(defun gnus-group-active-topic-p ()
-  "Return whether the current active comes from the active topics."
-  (save-excursion
-    (beginning-of-line)
-    (get-text-property (point) 'gnus-active)))
-
 ;;; Topic mode, commands and keymap.
 
 (defvar gnus-topic-mode-map nil)
@@ -604,34 +832,44 @@
   (setq gnus-topic-mode-map (make-sparse-keymap))
 
   ;; Override certain group mode keys.
-  (gnus-define-keys
-   gnus-topic-mode-map
-   "=" gnus-topic-select-group
-   "\r" gnus-topic-select-group
-   " " gnus-topic-read-group
-   "\C-k" gnus-topic-kill-group
-   "\C-y" gnus-topic-yank-group
-   "\M-g" gnus-topic-get-new-news-this-topic
-   "AT" gnus-topic-list-active
-   gnus-mouse-2 gnus-mouse-pick-topic)
+  (gnus-define-keys gnus-topic-mode-map
+    "=" gnus-topic-select-group
+    "\r" gnus-topic-select-group
+    " " gnus-topic-read-group
+    "\C-k" gnus-topic-kill-group
+    "\C-y" gnus-topic-yank-group
+    "\M-g" gnus-topic-get-new-news-this-topic
+    "AT" gnus-topic-list-active
+    "Gp" gnus-topic-edit-parameters
+    "#" gnus-topic-mark-topic
+    "\M-#" gnus-topic-unmark-topic
+    gnus-mouse-2 gnus-mouse-pick-topic)
 
   ;; Define a new submap.
-  (gnus-define-keys
-   (gnus-group-topic-map "T" gnus-group-mode-map)
-   "#" gnus-topic-mark-topic
-   "\M-#" gnus-topic-unmark-topic
-   "n" gnus-topic-create-topic
-   "m" gnus-topic-move-group
-   "D" gnus-topic-remove-group
-   "c" gnus-topic-copy-group
-   "h" gnus-topic-hide-topic
-   "s" gnus-topic-show-topic
-   "M" gnus-topic-move-matching
-   "C" gnus-topic-copy-matching
-   "\C-i" gnus-topic-indent
-   [tab] gnus-topic-indent
-   "r" gnus-topic-rename
-   "\177" gnus-topic-delete))
+  (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map)
+    "#" gnus-topic-mark-topic
+    "\M-#" gnus-topic-unmark-topic
+    "n" gnus-topic-create-topic
+    "m" gnus-topic-move-group
+    "D" gnus-topic-remove-group
+    "c" gnus-topic-copy-group
+    "h" gnus-topic-hide-topic
+    "s" gnus-topic-show-topic
+    "M" gnus-topic-move-matching
+    "C" gnus-topic-copy-matching
+    "\C-i" gnus-topic-indent
+    [tab] gnus-topic-indent
+    "r" gnus-topic-rename
+    "\177" gnus-topic-delete)
+
+  (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map)
+    "s" gnus-topic-sort-groups
+    "a" gnus-topic-sort-groups-by-alphabet
+    "u" gnus-topic-sort-groups-by-unread
+    "l" gnus-topic-sort-groups-by-level
+    "v" gnus-topic-sort-groups-by-score
+    "r" gnus-topic-sort-groups-by-rank
+    "m" gnus-topic-sort-groups-by-method))
 
 (defun gnus-topic-make-menu-bar ()
   (unless (boundp 'gnus-topic-menu)
@@ -665,8 +903,7 @@
 	    (> (prefix-numeric-value arg) 0)))
     ;; Infest Gnus with topics.
     (when gnus-topic-mode
-      (when (and menu-bar-mode
-		 (gnus-visual-p 'topic-menu 'menu))
+      (when (gnus-visual-p 'topic-menu 'menu)
 	(gnus-topic-make-menu-bar))
       (setq gnus-topic-line-format-spec 
 	    (gnus-parse-format gnus-topic-line-format 
@@ -678,17 +915,20 @@
 	      minor-mode-map-alist))
       (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
       (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
-      (add-hook 'gnus-group-update-group-hook 'gnus-topic-update-topic)
-      (make-local-variable 'gnus-group-prepare-function)
-      (setq gnus-group-prepare-function 'gnus-group-prepare-topics)
-      (make-local-variable 'gnus-group-goto-next-group-function)
-      (setq gnus-group-goto-next-group-function 
-	    'gnus-topic-goto-next-group)
+      (set (make-local-variable 'gnus-group-prepare-function)
+	   'gnus-group-prepare-topics)
+      (set (make-local-variable 'gnus-group-get-parameter-function)
+	   'gnus-group-topic-parameters)
+      (set (make-local-variable 'gnus-group-goto-next-group-function)
+	   'gnus-topic-goto-next-group)
+      (set (make-local-variable 'gnus-group-indentation-function)
+	   'gnus-topic-group-indentation)
+      (set (make-local-variable 'gnus-group-update-group-function)
+	   'gnus-topic-update-topics-containing-group)
+      (set (make-local-variable 'gnus-group-sort-alist-function)
+	   'gnus-group-sort-topic)
       (setq gnus-group-change-level-function 'gnus-topic-change-level)
       (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
-      (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)
@@ -702,7 +942,8 @@
       (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))
+      (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
+      (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
     (when redisplay
       (gnus-group-list-groups))))
     
@@ -746,10 +987,10 @@
   (interactive 
    (list
     (read-string "New topic: ")
-    (gnus-group-parent-topic)))
+    (gnus-current-topic)))
   ;; Check whether this topic already exists.
   (when (gnus-topic-find-topology topic)
-    (error "Topic aleady exists"))
+    (error "Topic already exists"))
   (unless parent
     (setq parent (caar gnus-topic-topology)))
   (let ((top (cdr (gnus-topic-find-topology parent)))
@@ -777,30 +1018,36 @@
 	 (completing-read "Move to topic: " gnus-topic-alist nil t)))
   (let ((groups (gnus-group-process-prefix n))
 	(topicl (assoc topic gnus-topic-alist))
+	(start-group (progn (forward-line 1) (gnus-group-group-name)))
+	(start-topic (gnus-group-topic-name))
 	entry)
-    (mapcar (lambda (g) 
-	      (gnus-group-remove-mark g)
-	      (when (and
-		     (setq entry (assoc (gnus-group-parent-topic)
-					gnus-topic-alist))
-		     (not copyp))
-		(setcdr entry (gnus-delete-first g (cdr entry))))
-	      (nconc topicl (list g)))
-	    groups)
-    (gnus-group-position-point))
-  (gnus-topic-enter-dribble)
-  (gnus-group-list-groups))
+    (mapcar 
+     (lambda (g)
+       (gnus-group-remove-mark g)
+       (when (and
+	      (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
+	      (not copyp))
+	 (setcdr entry (gnus-delete-first g (cdr entry))))
+       (nconc topicl (list g)))
+     groups)
+    (gnus-topic-enter-dribble)
+    (if start-group
+	(gnus-group-goto-group start-group)
+      (gnus-topic-goto-topic start-topic))
+    (gnus-group-list-groups)))
 
-(defun gnus-topic-remove-group ()
+(defun gnus-topic-remove-group (&optional arg)
   "Remove the current group from the topic."
-  (interactive)
-  (let ((topicl (assoc (gnus-group-parent-topic) gnus-topic-alist))
-	(group (gnus-group-group-name))
-	(buffer-read-only nil))
-    (when (and topicl group)
-      (gnus-delete-line)
-      (gnus-delete-first group topicl))
-    (gnus-group-position-point)))
+  (interactive "P")
+  (gnus-group-iterate arg 
+    (lambda (group)
+      (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
+	    (buffer-read-only nil))
+	(when (and topicl group)
+	  (gnus-delete-line)
+	  (gnus-delete-first group topicl))
+	(gnus-topic-update-topic)
+	(gnus-group-position-point)))))
 
 (defun gnus-topic-copy-group (n topic)
   "Copy the current group to a topic."
@@ -809,113 +1056,18 @@
 	 (completing-read "Copy to topic: " gnus-topic-alist nil t)))
   (gnus-topic-move-group n topic t))
 
-(defun gnus-topic-group-indentation ()
-  (make-string 
-   (* gnus-topic-indent-level
-      (or (save-excursion
-	    (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
-    (set-buffer gnus-group-buffer)
-    (when (and gnus-topic-mode 
-	       gnus-topic-alist
-	       (not gnus-topic-inhibit-change-level))
-      ;; Remove the group from the topics.
-      (when (and (< oldlevel gnus-level-zombie)
-		 (>= level gnus-level-zombie))
-	(let (alist)
-	  (forward-line -1)
-	  (when (setq alist (assoc (gnus-group-parent-topic) gnus-topic-alist))
-	    (setcdr alist (gnus-delete-first group (cdr alist))))))
-      ;; If the group is subscribed. then we enter it into the topics.
-      (when (and (< level gnus-level-zombie)
-		 (>= oldlevel gnus-level-zombie))
-	(let* ((prev (gnus-group-group-name))
-	       (gnus-topic-inhibit-change-level t)
-	       (gnus-group-indentation
-		(make-string 
-		 (* gnus-topic-indent-level
-		    (or (save-excursion
-			  (gnus-topic-goto-topic (gnus-group-parent-topic))
-			  (gnus-group-topic-level)) 0)) ? ))
-	       (yanked (list group))
-	       alist talist end)
-	  ;; Then we enter the yanked groups into the topics they belong
-	  ;; to. 
-	  (when (setq alist (assoc (save-excursion
-				     (forward-line -1)
-				     (or
-				      (gnus-group-parent-topic)
-				      (caar gnus-topic-topology)))
-				   gnus-topic-alist))
-	    (setq talist alist)
-	    (when (stringp yanked)
-	      (setq yanked (list yanked)))
-	    (if (not prev)
-		(nconc alist yanked)
-	      (if (not (cdr alist))
-		  (setcdr alist (nconc yanked (cdr alist)))
-		(while (and (not end) (cdr alist))
-		  (when (equal (cadr alist) prev)
-		    (setcdr alist (nconc yanked (cdr alist)))
-		    (setq end t))
-		  (setq alist (cdr alist)))
-		(unless end
-		  (nconc talist yanked))))))
-	(gnus-topic-update-topic)))))
-
-(defun gnus-topic-goto-next-group (group props)
-  "Go to group or the next group after group."
-  (if (null group)
-      (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))
-    (if (gnus-group-goto-group group)
-	t
-      ;; The group is no longer visible.
-      (let* ((list (assoc (gnus-group-parent-topic) gnus-topic-alist))
-	     (after (cdr (member group (cdr list)))))
-	;; First try to put point on a group after the current one.
-	(while (and after
-		    (not (gnus-group-goto-group (car after))))
-	  (setq after (cdr after)))
-	;; Then try to put point on a group before point.
-	(unless after
-	  (setq after (cdr (member group (reverse (cdr list)))))
-	  (while (and after 
-		      (not (gnus-group-goto-group (car after))))
-	    (setq after (cdr after))))
-	;; Finally, just put point on the topic.
-	(unless after
-	  (gnus-topic-goto-topic (car list))
-	  (setq after nil))
-	t))))
-
 (defun gnus-topic-kill-group (&optional n discard)
   "Kill the next N groups."
   (interactive "P")
   (if (gnus-group-topic-p)
       (let ((topic (gnus-group-topic-name)))
+	(push (cons 
+	       (gnus-topic-find-topology topic)
+	       (assoc topic gnus-topic-alist))
+	      gnus-topic-killed-topics)
 	(gnus-topic-remove-topic nil t)
-	(push (gnus-topic-find-topology topic nil nil gnus-topic-topology)
-	      gnus-topic-killed-topics))
+	(gnus-topic-find-topology topic nil nil gnus-topic-topology)
+	(gnus-topic-enter-dribble))
     (gnus-group-kill-group n discard)
     (gnus-topic-update-topic)))
   
@@ -923,13 +1075,17 @@
   "Yank the last topic."
   (interactive "p")
   (if gnus-topic-killed-topics
-      (let ((previous 
-	     (or (gnus-group-topic-name)
-		 (gnus-topic-next-topic (gnus-group-parent-topic))))
-	    (item (cdr (pop gnus-topic-killed-topics))))
+      (let* ((previous 
+	      (or (gnus-group-topic-name)
+		  (gnus-topic-next-topic (gnus-current-topic))))
+	     (data (pop gnus-topic-killed-topics))
+	     (alist (cdr data))
+	     (item (cdar data)))
+	(push alist gnus-topic-alist)
 	(gnus-topic-create-topic
 	 (caar item) (gnus-topic-parent-topic previous) previous
 	 item)
+	(gnus-topic-enter-dribble)
 	(gnus-topic-goto-topic (caar item)))
     (let* ((prev (gnus-group-group-name))
 	   (gnus-topic-inhibit-change-level t)
@@ -937,8 +1093,10 @@
 	    (make-string 
 	     (* gnus-topic-indent-level
 		(or (save-excursion
-		      (gnus-topic-goto-topic (gnus-group-parent-topic))
-		      (gnus-group-topic-level)) 0)) ? ))
+		      (gnus-topic-goto-topic (gnus-current-topic))
+		      (gnus-group-topic-level))
+		    0))
+	     ? ))
 	   yanked alist)
       ;; We first yank the groups the normal way...
       (setq yanked (gnus-group-yank-group arg))
@@ -946,7 +1104,7 @@
       ;; to. 
       (setq alist (assoc (save-excursion
 			   (forward-line -1)
-			   (gnus-group-parent-topic))
+			   (gnus-current-topic))
 			 gnus-topic-alist))
       (when (stringp yanked)
 	(setq yanked (list yanked)))
@@ -964,8 +1122,8 @@
 (defun gnus-topic-hide-topic ()
   "Hide the current topic."
   (interactive)
-  (when (gnus-group-parent-topic)
-    (gnus-topic-goto-topic (gnus-group-parent-topic))
+  (when (gnus-current-topic)
+    (gnus-topic-goto-topic (gnus-current-topic))
     (gnus-topic-remove-topic nil nil 'hidden)))
 
 (defun gnus-topic-show-topic ()
@@ -976,17 +1134,21 @@
 
 (defun gnus-topic-mark-topic (topic &optional unmark)
   "Mark all groups in the topic with the process mark."
-  (interactive (list (gnus-group-parent-topic)))
-  (save-excursion
-    (let ((groups (gnus-topic-find-groups topic 9 t)))
-      (while groups
-	(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
-		 (gnus-info-group (nth 2 (pop groups))))))))
+  (interactive (list (gnus-group-topic-name)))
+  (if (not topic)
+      (call-interactively 'gnus-group-mark-group)
+    (save-excursion
+      (let ((groups (gnus-topic-find-groups topic 9 t)))
+	(while groups
+	  (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
+		   (gnus-info-group (nth 2 (pop groups)))))))))
 
 (defun gnus-topic-unmark-topic (topic &optional unmark)
   "Remove the process mark from all groups in the topic."
-  (interactive (list (gnus-group-parent-topic)))
-  (gnus-topic-mark-topic topic t))
+  (interactive (list (gnus-group-topic-name)))
+  (if (not topic)
+      (call-interactively 'gnus-group-unmark-group)
+    (gnus-topic-mark-topic topic t)))
 
 (defun gnus-topic-get-new-news-this-topic (&optional n)
   "Check for new news in the current topic."
@@ -1037,7 +1199,7 @@
 (defun gnus-topic-rename (old-name new-name)
   "Rename a topic."
   (interactive
-   (let ((topic (gnus-group-parent-topic)))
+   (let ((topic (gnus-current-topic)))
      (list topic
 	   (read-string (format "Rename %s to: " topic)))))
   (let ((top (gnus-topic-find-topology old-name))
@@ -1047,6 +1209,7 @@
     (when entry 
       (setcar entry new-name))
     (forward-line -1)
+    (gnus-dribble-touch)
     (gnus-group-list-groups)))
 
 (defun gnus-topic-indent (&optional unindent)
@@ -1055,22 +1218,25 @@
   (interactive "P")
   (if unindent
       (gnus-topic-unindent)
-    (let* ((topic (gnus-group-parent-topic))
-	   (parent (gnus-topic-previous-topic topic)))
+    (let* ((topic (gnus-current-topic))
+	   (parent (gnus-topic-previous-topic topic))
+	   (buffer-read-only nil))
       (unless parent
 	(error "Nothing to indent %s into" topic))
       (when topic
 	(gnus-topic-goto-topic topic)
 	(gnus-topic-kill-group)
+	(push (cdar gnus-topic-killed-topics) gnus-topic-alist)
 	(gnus-topic-create-topic
-	 topic parent nil (cdr (pop gnus-topic-killed-topics)))
+	 topic parent nil (cdaar gnus-topic-killed-topics))
+	(pop gnus-topic-killed-topics)
 	(or (gnus-topic-goto-topic topic)
 	    (gnus-topic-goto-topic parent))))))
 
 (defun gnus-topic-unindent ()
   "Unindent a topic."
   (interactive)
-  (let* ((topic (gnus-group-parent-topic))
+  (let* ((topic (gnus-current-topic))
 	 (parent (gnus-topic-parent-topic topic))
 	 (grandparent (gnus-topic-parent-topic parent)))
     (unless grandparent
@@ -1078,9 +1244,11 @@
     (when topic
       (gnus-topic-goto-topic topic)
       (gnus-topic-kill-group)
+      (push (cdar gnus-topic-killed-topics) gnus-topic-alist)
       (gnus-topic-create-topic
        topic grandparent (gnus-topic-next-topic parent)
-       (cdr (pop gnus-topic-killed-topics)))
+       (cdaar gnus-topic-killed-topics))
+      (pop gnus-topic-killed-topics)
       (gnus-topic-goto-topic topic))))
 
 (defun gnus-topic-list-active (&optional force)
@@ -1095,6 +1263,95 @@
 	gnus-killed-list gnus-zombie-list)
     (gnus-group-list-groups 9 nil 1)))
 
+;;; Topic sorting functions
+
+(defun gnus-topic-edit-parameters (group)
+  "Edit the group parameters of GROUP.
+If performed on a topic, edit the topic parameters instead."
+  (interactive (list (gnus-group-group-name)))
+  (if group
+      (gnus-group-edit-group-parameters group)
+    (if (not (gnus-group-topic-p))
+	(error "Nothing to edit on the current line.")
+      (let ((topic (gnus-group-topic-name)))
+	(gnus-edit-form
+	 (gnus-topic-parameters topic)
+	 "Editing the topic parameters."
+	 `(lambda (form)
+	    (gnus-topic-set-parameters ,topic form)))))))
+
+(defun gnus-group-sort-topic (func reverse)
+  "Sort groups in the topics according to FUNC and REVERSE."
+  (let ((alist gnus-topic-alist))
+    (while alist
+      ;; !!!Sometimes nil elements sneak into the alist,
+      ;; for some reason or other.
+      (setcar alist (delq nil (car alist)))
+      (gnus-topic-sort-topic (pop alist) func reverse))))
+
+(defun gnus-topic-sort-topic (topic func reverse)
+  ;; Each topic only lists the name of the group, while
+  ;; the sort predicates expect group infos as inputs.
+  ;; So we first transform the group names into infos,
+  ;; then sort, and then transform back into group names.
+  (setcdr
+   topic
+   (mapcar
+    (lambda (info) (gnus-info-group info))
+    (sort
+     (mapcar
+      (lambda (group) (gnus-get-info group))
+      (cdr topic))
+     func)))
+  ;; Do the reversal, if necessary.
+  (when reverse
+    (setcdr topic (nreverse (cdr topic)))))
+
+(defun gnus-topic-sort-groups (func &optional reverse)
+  "Sort the current topic according to FUNC.
+If REVERSE, reverse the sorting order."
+  (interactive (list gnus-group-sort-function current-prefix-arg))
+  (let ((topic (assoc (gnus-current-topic) gnus-topic-alist)))
+    (gnus-topic-sort-topic
+     topic (gnus-make-sort-function func) reverse)
+    (gnus-group-list-groups)))
+
+(defun gnus-topic-sort-groups-by-alphabet (&optional reverse)
+  "Sort the current topic alphabetically by group name.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse))
+
+(defun gnus-topic-sort-groups-by-unread (&optional reverse)
+  "Sort the current topic by number of unread articles.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse))
+
+(defun gnus-topic-sort-groups-by-level (&optional reverse)
+  "Sort the current topic by group level.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse))
+
+(defun gnus-topic-sort-groups-by-score (&optional reverse)
+  "Sort the current topic by group score.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse))
+
+(defun gnus-topic-sort-groups-by-rank (&optional reverse)
+  "Sort the current topic by group rank.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse))
+
+(defun gnus-topic-sort-groups-by-method (&optional reverse)
+  "Sort the current topic alphabetically by backend name.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse))
+
 (provide 'gnus-topic)
 
 ;;; gnus-topic.el ends here