cgit.sxemacs.org Git - gnus/blob - lisp/gnus-topic.el

   1 ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
   2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
   3
   4 ;; Author: Ilja Weis <kult@uni-paderborn.de>
   5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (require 'gnus-load)
  30 (require 'gnus-group)
  31 (require 'gnus-start)
  32 (require 'gnus)
  33
  34 (defvar gnus-topic-mode nil
  35   "Minor mode for Gnus group buffers.")
  36
  37 (defvar gnus-topic-mode-hook nil
  38   "Hook run in topic mode buffers.")
  39
  40 (defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
  41   "Format of topic lines.
  42 It works along the same lines as a normal formatting string,
  43 with some simple extensions.
  44
  45 %i  Indentation based on topic level.
  46 %n  Topic name.
  47 %v  Nothing if the topic is visible, \"...\" otherwise.
  48 %g  Number of groups in the topic.
  49 %a  Number of unread articles in the groups in the topic.
  50 %A  Number of unread articles in the groups in the topic and its subtopics.
  51 ")
  52
  53 (defvar gnus-topic-indent-level 2
  54   "*How much each subtopic should be indented.")
  55
  56 ;; Internal variables.
  57
  58 (defvar gnus-topic-active-topology nil)
  59 (defvar gnus-topic-active-alist nil)
  60
  61 (defvar gnus-topology-checked-p nil
  62   "Whether the topology has been checked in this session.")
  63
  64 (defvar gnus-topic-killed-topics nil)
  65 (defvar gnus-topic-inhibit-change-level nil)
  66 (defvar gnus-topic-tallied-groups nil)
  67
  68 (defconst gnus-topic-line-format-alist
  69   `((?n name ?s)
  70     (?v visible ?s)
  71     (?i indentation ?s)
  72     (?g number-of-groups ?d)
  73     (?a (gnus-topic-articles-in-topic entries) ?d)
  74     (?A total-number-of-articles ?d)
  75     (?l level ?d)))
  76
  77 (defvar gnus-topic-line-format-spec nil)
  78
  79 ;;; Utility functions
  80
  81 (defun gnus-group-topic-name ()
  82   "The name of the topic on the current line."
  83   (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
  84     (and topic (symbol-name topic))))
  85
  86 (defun gnus-group-topic-level ()
  87   "The level of the topic on the current line."
  88   (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
  89
  90 (defun gnus-group-topic-unread ()
  91   "The number of unread articles in topic on the current line."
  92   (get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
  93
  94 (defun gnus-topic-unread (topic)
  95   "Return the number of unread articles in TOPIC."
  96   (or (save-excursion
  97         (and (gnus-topic-goto-topic topic)
  98              (gnus-group-topic-unread)))
  99       0))
 100
 101 (defun gnus-group-topic-p ()
 102   "Return non-nil if the current line is a topic."
 103   (gnus-group-topic-name))
 104
 105 (defun gnus-topic-visible-p ()
 106   "Return non-nil if the current topic is visible."
 107   (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
 108
 109 (defun gnus-topic-articles-in-topic (entries)
 110   (let ((total 0)
 111         number)
 112     (while entries
 113       (when (numberp (setq number (car (pop entries))))
 114         (incf total number)))
 115     total))
 116
 117 (defun gnus-group-topic (group)
 118   "Return the topic GROUP is a member of."
 119   (let ((alist gnus-topic-alist)
 120         out)
 121     (while alist
 122       (when (member group (cdar alist))
 123         (setq out (caar alist)
 124               alist nil))
 125       (setq alist (cdr alist)))
 126     out))
 127
 128 (defun gnus-group-parent-topic (group)
 129   "Return the topic GROUP is member of by looking at the group buffer."
 130   (save-excursion
 131     (set-buffer gnus-group-buffer)
 132     (if (gnus-group-goto-group group)
 133         (gnus-current-topic)
 134       (gnus-group-topic group))))
 135
 136 (defun gnus-topic-goto-topic (topic)
 137   "Go to TOPIC."
 138   (when topic
 139     (gnus-goto-char (text-property-any (point-min) (point-max)
 140                                        'gnus-topic (intern topic)))))
 141
 142 (defun gnus-current-topic ()
 143   "Return the name of the current topic."
 144   (let ((result
 145          (or (get-text-property (point) 'gnus-topic)
 146              (save-excursion
 147                (and (gnus-goto-char (previous-single-property-change
 148                                      (point) 'gnus-topic))
 149                     (get-text-property (max (1- (point)) (point-min))
 150                                        'gnus-topic))))))
 151     (when result
 152       (symbol-name result))))
 153
 154 (defun gnus-current-topics ()
 155   "Return a list of all current topics, lowest in hierarchy first."
 156   (let ((topic (gnus-current-topic))
 157         topics)
 158     (while topic
 159       (push topic topics)
 160       (setq topic (gnus-topic-parent-topic topic)))
 161     (nreverse topics)))
 162
 163 (defun gnus-group-active-topic-p ()
 164   "Say whether the current topic comes from the active topics."
 165   (save-excursion
 166     (beginning-of-line)
 167     (get-text-property (point) 'gnus-active)))
 168
 169 (defun gnus-topic-find-groups (topic &optional level all)
 170   "Return entries for all visible groups in TOPIC."
 171   (let ((groups (cdr (assoc topic gnus-topic-alist)))
 172         info clevel unread group lowest params visible-groups entry active)
 173     (setq lowest (or lowest 1))
 174     (setq level (or level 7))
 175     ;; We go through the newsrc to look for matches.
 176     (while groups
 177       (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb)
 178             info (nth 2 entry)
 179             params (gnus-info-params info)
 180             active (gnus-active group)
 181             unread (or (car entry)
 182                        (and (not (equal group "dummy.group"))
 183                             active
 184                             (- (1+ (cdr active)) (car active))))
 185             clevel (or (gnus-info-level info)
 186                        (if (member group gnus-zombie-list) 8 9)))
 187       (and
 188        unread                           ; nil means that the group is dead.
 189        (<= clevel level)
 190        (>= clevel lowest)               ; Is inside the level we want.
 191        (or all
 192            (if (eq unread t)
 193                gnus-group-list-inactive-groups
 194              (> unread 0))
 195            (and gnus-list-groups-with-ticked-articles
 196                 (cdr (assq 'tick (gnus-info-marks info))))
 197                                         ; Has right readedness.
 198            ;; Check for permanent visibility.
 199            (and gnus-permanently-visible-groups
 200                 (string-match gnus-permanently-visible-groups group))
 201            (memq 'visible params)
 202            (cdr (assq 'visible params)))
 203        ;; Add this group to the list of visible groups.
 204        (push (or entry group) visible-groups)))
 205     (nreverse visible-groups)))
 206
 207 (defun gnus-topic-previous-topic (topic)
 208   "Return the previous topic on the same level as TOPIC."
 209   (let ((top (cddr (gnus-topic-find-topology
 210                     (gnus-topic-parent-topic topic)))))
 211     (unless (equal topic (caaar top))
 212       (while (and top (not (equal (caaadr top) topic)))
 213         (setq top (cdr top)))
 214       (caaar top))))
 215
 216 (defun gnus-topic-parent-topic (topic &optional topology)
 217   "Return the parent of TOPIC."
 218   (unless topology
 219     (setq topology gnus-topic-topology))
 220   (let ((parent (car (pop topology)))
 221         result found)
 222     (while (and topology
 223                 (not (setq found (equal (caaar topology) topic)))
 224                 (not (setq result (gnus-topic-parent-topic topic
 225                                                            (car topology)))))
 226       (setq topology (cdr topology)))
 227     (or result (and found parent))))
 228
 229 (defun gnus-topic-next-topic (topic &optional previous)
 230   "Return the next sibling of TOPIC."
 231   (let ((parentt (cddr (gnus-topic-find-topology
 232                         (gnus-topic-parent-topic topic))))
 233         prev)
 234     (while (and parentt
 235                 (not (equal (caaar parentt) topic)))
 236       (setq prev (caaar parentt)
 237             parentt (cdr parentt)))
 238     (if previous
 239         prev
 240       (caaadr parentt))))
 241
 242 (defun gnus-topic-find-topology (topic &optional topology level remove)
 243   "Return the topology of TOPIC."
 244   (unless topology
 245     (setq topology gnus-topic-topology)
 246     (setq level 0))
 247   (let ((top topology)
 248         result)
 249     (if (equal (caar topology) topic)
 250         (progn
 251           (when remove
 252             (delq topology remove))
 253           (cons level topology))
 254       (setq topology (cdr topology))
 255       (while (and topology
 256                   (not (setq result (gnus-topic-find-topology
 257                                      topic (car topology) (1+ level)
 258                                      (and remove top)))))
 259         (setq topology (cdr topology)))
 260       result)))
 261
 262 (defvar gnus-tmp-topics nil)
 263 (defun gnus-topic-list (&optional topology)
 264   "Return a list of all topics in the topology."
 265   (unless topology
 266     (setq topology gnus-topic-topology
 267           gnus-tmp-topics nil))
 268   (push (caar topology) gnus-tmp-topics)
 269   (mapcar 'gnus-topic-list (cdr topology))
 270   gnus-tmp-topics)
 271
 272 ;;; Topic parameter jazz
 273
 274 (defun gnus-topic-parameters (topic)
 275   "Return the parameters for TOPIC."
 276   (let ((top (gnus-topic-find-topology topic)))
 277     (unless top
 278       (error "No such topic: %s" topic))
 279     (nth 3 (cadr top))))
 280
 281 (defun gnus-topic-set-parameters (topic parameters)
 282   "Set the topic parameters of TOPIC to PARAMETERS."
 283   (let ((top (gnus-topic-find-topology topic)))
 284     (unless top
 285       (error "No such topic: %s" topic))
 286     ;; We may have to extend if there is no parameters here
 287     ;; to begin with.
 288     (unless (nthcdr 2 (car top))
 289       (nconc (car top) (list nil)))
 290     (unless (nthcdr 3 (car top))
 291       (nconc (car top) (list nil)))
 292     (setcar (nthcdr 3 (car top)) parameters)))
 293
 294 (defun gnus-group-topic-parameters (group)
 295   "Compute the group parameters for GROUP taking into account inheretance from topics."
 296   (let ((params-list (list (gnus-group-get-parameter group)))
 297         topics params param out)
 298     (save-excursion
 299       (gnus-group-goto-group group)
 300       (setq topics (gnus-current-topics))
 301       (while topics
 302         (push (gnus-topic-parameters (pop topics)) params-list))
 303       ;; We probably have lots of nil elements here, so
 304       ;; we remove them.  Probably faster than doing this "properly".
 305       (setq params-list (delq nil params-list))
 306       ;; Now we have all the parameters, so we go through them
 307       ;; and do inheretance in the obvious way.
 308       (while (setq params (pop params-list))
 309         (while (setq param (pop params))
 310           (when (atom param)
 311             (setq param (cons param t)))
 312           ;; Override any old versions of this param.
 313           (setq out (delq (assq (car param) out) out))
 314           (push param out)))
 315       ;; Return the resulting parameter list.
 316       out)))
 317
 318 ;;; General utility funtions
 319
 320 (defun gnus-topic-enter-dribble ()
 321   (gnus-dribble-enter
 322    (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
 323
 324 ;;; Generating group buffers
 325
 326 (defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level)
 327   "List all newsgroups with unread articles of level LEVEL or lower, and
 328 use the `gnus-group-topics' to sort the groups.
 329 If ALL is non-nil, list groups that have no unread articles.
 330 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
 331   (set-buffer gnus-group-buffer)
 332   (let ((buffer-read-only nil)
 333         (lowest (or lowest 1)))
 334
 335     (setq gnus-topic-tallied-groups nil)
 336
 337     (when (or (not gnus-topic-alist)
 338               (not gnus-topology-checked-p))
 339       (gnus-topic-check-topology))
 340
 341     (unless list-topic
 342       (erase-buffer))
 343
 344     ;; List dead groups?
 345     (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
 346       (gnus-group-prepare-flat-list-dead
 347        (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
 348        gnus-level-zombie ?Z
 349        regexp))
 350
 351     (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
 352       (gnus-group-prepare-flat-list-dead
 353        (setq gnus-killed-list (sort gnus-killed-list 'string<))
 354        gnus-level-killed ?K
 355        regexp))
 356
 357     ;; Use topics.
 358     (when (< lowest gnus-level-zombie)
 359       (if list-topic
 360           (let ((top (gnus-topic-find-topology list-topic)))
 361             (gnus-topic-prepare-topic (cdr top) (car top)
 362                                       (or topic-level level) all))
 363         (gnus-topic-prepare-topic gnus-topic-topology 0
 364                                   (or topic-level level) all))))
 365
 366   (gnus-group-set-mode-line)
 367   (setq gnus-group-list-mode (cons level all))
 368   (run-hooks 'gnus-group-prepare-hook))
 369
 370 (defun gnus-topic-prepare-topic (topicl level &optional list-level all silent)
 371   "Insert TOPIC into the group buffer.
 372 If SILENT, don't insert anything.  Return the number of unread
 373 articles in the topic and its subtopics."
 374   (let* ((type (pop topicl))
 375          (entries (gnus-topic-find-groups (car type) list-level all))
 376          (visiblep (and (eq (nth 1 type) 'visible) (not silent)))
 377          (gnus-group-indentation
 378           (make-string (* gnus-topic-indent-level level) ? ))
 379          (beg (progn (beginning-of-line) (point)))
 380          (topicl (reverse topicl))
 381          (all-entries entries)
 382          (unread 0)
 383          (topic (car type))
 384          info entry end active)
 385     ;; Insert any sub-topics.
 386     (while topicl
 387       (incf unread
 388             (gnus-topic-prepare-topic
 389              (pop topicl) (1+ level) list-level all
 390              (not visiblep))))
 391     (setq end (point))
 392     (goto-char beg)
 393     ;; Insert all the groups that belong in this topic.
 394     (while (setq entry (pop entries))
 395       (when visiblep
 396         (if (stringp entry)
 397             ;; Dead groups.
 398             (gnus-group-insert-group-line
 399              entry (if (member entry gnus-zombie-list) 8 9)
 400              nil (- (1+ (cdr (setq active (gnus-active entry))))
 401                     (car active)) nil)
 402           ;; Living groups.
 403           (when (setq info (nth 2 entry))
 404             (gnus-group-insert-group-line
 405              (gnus-info-group info)
 406              (gnus-info-level info) (gnus-info-marks info)
 407              (car entry) (gnus-info-method info)))))
 408       (when (and (listp entry)
 409                  (numberp (car entry))
 410                  (not (member (gnus-info-group (setq info (nth 2 entry)))
 411                               gnus-topic-tallied-groups)))
 412         (push (gnus-info-group info) gnus-topic-tallied-groups)
 413         (incf unread (car entry))))
 414     (goto-char beg)
 415     ;; Insert the topic line.
 416     (unless silent
 417       (gnus-extent-start-open (point))
 418       (gnus-topic-insert-topic-line
 419        (car type) visiblep
 420        (not (eq (nth 2 type) 'hidden))
 421        level all-entries unread))
 422     (goto-char end)
 423     unread))
 424
 425 (defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
 426   "Remove the current topic."
 427   (let ((topic (gnus-group-topic-name))
 428         (level (gnus-group-topic-level))
 429         (beg (progn (beginning-of-line) (point)))
 430         buffer-read-only)
 431     (when topic
 432       (while (and (zerop (forward-line 1))
 433                   (> (or (gnus-group-topic-level) (1+ level)) level)))
 434       (delete-region beg (point))
 435       (setcar (cdadr (gnus-topic-find-topology topic))
 436               (if insert 'visible 'invisible))
 437       (when hide
 438         (setcdr (cdadr (gnus-topic-find-topology topic))
 439                 (list hide)))
 440       (unless total-remove
 441         (gnus-topic-insert-topic topic in-level)))))
 442
 443 (defun gnus-topic-insert-topic (topic &optional level)
 444   "Insert TOPIC."
 445   (gnus-group-prepare-topics
 446    (car gnus-group-list-mode) (cdr gnus-group-list-mode)
 447    nil nil topic level))
 448
 449 (defun gnus-topic-fold (&optional insert)
 450   "Remove/insert the current topic."
 451   (let ((topic (gnus-group-topic-name)))
 452     (when topic
 453       (save-excursion
 454         (if (not (gnus-group-active-topic-p))
 455             (gnus-topic-remove-topic
 456              (or insert (not (gnus-topic-visible-p))))
 457           (let ((gnus-topic-topology gnus-topic-active-topology)
 458                 (gnus-topic-alist gnus-topic-active-alist)
 459                 (gnus-group-list-mode (cons 5 t)))
 460             (gnus-topic-remove-topic
 461              (or insert (not (gnus-topic-visible-p))) nil nil 9)))))))
 462
 463 (defun gnus-topic-insert-topic-line (name visiblep shownp level entries
 464                                           &optional unread)
 465   (let* ((visible (if visiblep "" "..."))
 466          (indentation (make-string (* gnus-topic-indent-level level) ? ))
 467          (total-number-of-articles unread)
 468          (number-of-groups (length entries))
 469          (active-topic (eq gnus-topic-alist gnus-topic-active-alist)))
 470     (beginning-of-line)
 471     ;; Insert the text.
 472     (gnus-add-text-properties
 473      (point)
 474      (prog1 (1+ (point))
 475        (eval gnus-topic-line-format-spec)
 476        (gnus-topic-remove-excess-properties)1)
 477      (list 'gnus-topic (intern name)
 478            'gnus-topic-level level
 479            'gnus-topic-unread unread
 480            'gnus-active active-topic
 481            'gnus-topic-visible visiblep))))
 482
 483 (defun gnus-topic-update-topic ()
 484   "Update all parent topics to the current group."
 485   (when (and (eq major-mode 'gnus-group-mode)
 486              gnus-topic-mode)
 487     (let ((group (gnus-group-group-name))
 488           (buffer-read-only nil))
 489       (when (and group (gnus-get-info group)
 490                  (gnus-topic-goto-topic (gnus-current-topic)))
 491         (gnus-topic-update-topic-line (gnus-group-topic-name))
 492         (gnus-group-goto-group group)
 493         (gnus-group-position-point)))))
 494
 495 (defun gnus-topic-goto-missing-group (group)
 496   "Place point where GROUP is supposed to be inserted."
 497   (let* ((topic (gnus-group-topic group))
 498          (groups (cdr (assoc topic gnus-topic-alist)))
 499          (g (cdr (member group groups)))
 500          (unfound t))
 501     ;; Try to jump to a visible group.
 502     (while (and g (not (gnus-group-goto-group (car g) t)))
 503       (pop g))
 504     ;; It wasn't visible, so we try to see where to insert it.
 505     (when (not g)
 506       (setq g (cdr (member group (reverse groups))))
 507       (while (and g unfound)
 508         (when (gnus-group-goto-group (pop g) t)
 509           (forward-line 1)
 510           (setq unfound nil)))
 511       (when unfound
 512         (gnus-topic-goto-topic topic)
 513         (forward-line 1)))))
 514
 515 (defun gnus-topic-update-topic-line (topic-name &optional reads)
 516   (let* ((top (gnus-topic-find-topology topic-name))
 517          (type (cadr top))
 518          (children (cddr top))
 519          (entries (gnus-topic-find-groups
 520                    (car type) (car gnus-group-list-mode)
 521                    (cdr gnus-group-list-mode)))
 522          (parent (gnus-topic-parent-topic topic-name))
 523          (all-entries entries)
 524          (unread 0)
 525          old-unread entry)
 526     (when (gnus-topic-goto-topic (car type))
 527       ;; Tally all the groups that belong in this topic.
 528       (if reads
 529           (setq unread (- (gnus-group-topic-unread) reads))
 530         (while children
 531           (incf unread (gnus-topic-unread (caar (pop children)))))
 532         (while (setq entry (pop entries))
 533           (when (numberp (car entry))
 534             (incf unread (car entry)))))
 535       (setq old-unread (gnus-group-topic-unread))
 536       ;; Insert the topic line.
 537       (gnus-topic-insert-topic-line
 538        (car type) (gnus-topic-visible-p)
 539        (not (eq (nth 2 type) 'hidden))
 540        (gnus-group-topic-level) all-entries unread)
 541       (gnus-delete-line))
 542     (when parent
 543       (forward-line -1)
 544       (gnus-topic-update-topic-line
 545        parent (- old-unread (gnus-group-topic-unread))))
 546     unread))
 547
 548 (defun gnus-topic-group-indentation ()
 549   (make-string
 550    (* gnus-topic-indent-level
 551       (or (save-excursion
 552             (gnus-topic-goto-topic (gnus-current-topic))
 553             (gnus-group-topic-level)) 0)) ? ))
 554
 555 ;;; Initialization
 556
 557 (gnus-add-shutdown 'gnus-topic-close 'gnus)
 558
 559 (defun gnus-topic-close ()
 560   (setq gnus-topic-active-topology nil
 561         gnus-topic-active-alist nil
 562         gnus-topic-killed-topics nil
 563         gnus-topic-tallied-groups nil
 564         gnus-topology-checked-p nil))
 565
 566 (defun gnus-topic-check-topology ()
 567   ;; The first time we set the topology to whatever we have
 568   ;; gotten here, which can be rather random.
 569   (unless gnus-topic-alist
 570     (gnus-topic-init-alist))
 571
 572   (setq gnus-topology-checked-p t)
 573   ;; Go through the topic alist and make sure that all topics
 574   ;; are in the topic topology.
 575   (let ((topics (gnus-topic-list))
 576         (alist gnus-topic-alist)
 577         changed)
 578     (while alist
 579       (unless (member (caar alist) topics)
 580         (nconc gnus-topic-topology
 581                (list (list (list (caar alist) 'visible))))
 582         (setq changed t))
 583       (setq alist (cdr alist)))
 584     (when changed
 585       (gnus-topic-enter-dribble))
 586     ;; Conversely, go through the topology and make sure that all
 587     ;; topologies have alists.
 588     (while topics
 589       (unless (assoc (car topics) gnus-topic-alist)
 590         (push (list (car topics)) gnus-topic-alist))
 591       (pop topics)))
 592   ;; Go through all living groups and make sure that
 593   ;; they belong to some topic.
 594   (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
 595                                          gnus-topic-alist)))
 596          (entry (assoc (caar gnus-topic-topology) gnus-topic-alist))
 597          (newsrc gnus-newsrc-alist)
 598          group)
 599     (while newsrc
 600       (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
 601         (setcdr entry (cons group (cdr entry))))))
 602   ;; Go through all topics and make sure they contain only living groups.
 603   (let ((alist gnus-topic-alist)
 604         topic)
 605     (while (setq topic (pop alist))
 606       (while (cdr topic)
 607         (if (gnus-gethash (cadr topic) gnus-newsrc-hashtb)
 608             (setq topic (cdr topic))
 609           (setcdr topic (cddr topic)))))))
 610
 611 (defun gnus-topic-init-alist ()
 612   "Initialize the topic structures."
 613   (setq gnus-topic-topology
 614         (cons (list "Gnus" 'visible)
 615               (mapcar (lambda (topic)
 616                         (list (list (car topic) 'visible)))
 617                       '(("misc")))))
 618   (setq gnus-topic-alist
 619         (list (cons "misc"
 620                     (mapcar (lambda (info) (gnus-info-group info))
 621                             (cdr gnus-newsrc-alist)))
 622               (list "Gnus")))
 623   (gnus-topic-enter-dribble))
 624
 625 ;;; Maintenance
 626
 627 (defun gnus-topic-clean-alist ()
 628   "Remove bogus groups from the topic alist."
 629   (let ((topic-alist gnus-topic-alist)
 630         result topic)
 631     (unless gnus-killed-hashtb
 632       (gnus-make-hashtable-from-killed))
 633     (while (setq topic (pop topic-alist))
 634       (let ((topic-name (pop topic))
 635             group filtered-topic)
 636         (while (setq group (pop topic))
 637           (if (and (gnus-gethash group gnus-active-hashtb)
 638                    (not (gnus-gethash group gnus-killed-hashtb)))
 639               (push group filtered-topic)))
 640         (push (cons topic-name (nreverse filtered-topic)) result)))
 641     (setq gnus-topic-alist (nreverse result))))
 642
 643 (defun gnus-topic-change-level (group level oldlevel)
 644   "Run when changing levels to enter/remove groups from topics."
 645   (save-excursion
 646     (set-buffer gnus-group-buffer)
 647     (when (and gnus-topic-mode
 648                gnus-topic-alist
 649                (not gnus-topic-inhibit-change-level))
 650       ;; Remove the group from the topics.
 651       (when (and (< oldlevel gnus-level-zombie)
 652                  (>= level gnus-level-zombie))
 653         (let (alist)
 654           (forward-line -1)
 655           (when (setq alist (assoc (gnus-current-topic) gnus-topic-alist))
 656             (setcdr alist (gnus-delete-first group (cdr alist))))))
 657       ;; If the group is subscribed. then we enter it into the topics.
 658       (when (and (< level gnus-level-zombie)
 659                  (>= oldlevel gnus-level-zombie))
 660         (let* ((prev (gnus-group-group-name))
 661                (gnus-topic-inhibit-change-level t)
 662                (gnus-group-indentation
 663                 (make-string
 664                  (* gnus-topic-indent-level
 665                     (or (save-excursion
 666                           (gnus-topic-goto-topic (gnus-current-topic))
 667                           (gnus-group-topic-level)) 0)) ? ))
 668                (yanked (list group))
 669                alist talist end)
 670           ;; Then we enter the yanked groups into the topics they belong
 671           ;; to.
 672           (when (setq alist (assoc (save-excursion
 673                                      (forward-line -1)
 674                                      (or
 675                                       (gnus-current-topic)
 676                                       (caar gnus-topic-topology)))
 677                                    gnus-topic-alist))
 678             (setq talist alist)
 679             (when (stringp yanked)
 680               (setq yanked (list yanked)))
 681             (if (not prev)
 682                 (nconc alist yanked)
 683               (if (not (cdr alist))
 684                   (setcdr alist (nconc yanked (cdr alist)))
 685                 (while (and (not end) (cdr alist))
 686                   (when (equal (cadr alist) prev)
 687                     (setcdr alist (nconc yanked (cdr alist)))
 688                     (setq end t))
 689                   (setq alist (cdr alist)))
 690                 (unless end
 691                   (nconc talist yanked))))))
 692         (gnus-topic-update-topic)))))
 693
 694 (defun gnus-topic-goto-next-group (group props)
 695   "Go to group or the next group after group."
 696   (if (null group)
 697       (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))
 698     (if (gnus-group-goto-group group)
 699         t
 700       ;; The group is no longer visible.
 701       (let* ((list (assoc (gnus-current-topic) gnus-topic-alist))
 702              (after (cdr (member group (cdr list)))))
 703         ;; First try to put point on a group after the current one.
 704         (while (and after
 705                     (not (gnus-group-goto-group (car after))))
 706           (setq after (cdr after)))
 707         ;; Then try to put point on a group before point.
 708         (unless after
 709           (setq after (cdr (member group (reverse (cdr list)))))
 710           (while (and after
 711                       (not (gnus-group-goto-group (car after))))
 712             (setq after (cdr after))))
 713         ;; Finally, just put point on the topic.
 714         (unless after
 715           (gnus-topic-goto-topic (car list))
 716           (setq after nil))
 717         t))))
 718
 719 ;;; Topic-active functions
 720
 721 (defun gnus-topic-grok-active (&optional force)
 722   "Parse all active groups and create topic structures for them."
 723   ;; First we make sure that we have really read the active file.
 724   (when (or force
 725             (not gnus-topic-active-alist))
 726     (let (groups)
 727       ;; Get a list of all groups available.
 728       (mapatoms (lambda (g) (when (symbol-value g)
 729                               (push (symbol-name g) groups)))
 730                 gnus-active-hashtb)
 731       (setq groups (sort groups 'string<))
 732       ;; Init the variables.
 733       (setq gnus-topic-active-topology (list (list "" 'visible)))
 734       (setq gnus-topic-active-alist nil)
 735       ;; Descend the top-level hierarchy.
 736       (gnus-topic-grok-active-1 gnus-topic-active-topology groups)
 737       ;; Set the top-level topic names to something nice.
 738       (setcar (car gnus-topic-active-topology) "Gnus active")
 739       (setcar (car gnus-topic-active-alist) "Gnus active"))))
 740
 741 (defun gnus-topic-grok-active-1 (topology groups)
 742   (let* ((name (caar topology))
 743          (prefix (concat "^" (regexp-quote name)))
 744          tgroups ntopology group)
 745     (while (and groups
 746                 (string-match prefix (setq group (car groups))))
 747       (if (not (string-match "\\." group (match-end 0)))
 748           ;; There are no further hierarchies here, so we just
 749           ;; enter this group into the list belonging to this
 750           ;; topic.
 751           (push (pop groups) tgroups)
 752         ;; New sub-hierarchy, so we add it to the topology.
 753         (nconc topology (list (setq ntopology
 754                                     (list (list (substring
 755                                                  group 0 (match-end 0))
 756                                                 'invisible)))))
 757         ;; Descend the hierarchy.
 758         (setq groups (gnus-topic-grok-active-1 ntopology groups))))
 759     ;; We remove the trailing "." from the topic name.
 760     (setq name
 761           (if (string-match "\\.$" name)
 762               (substring name 0 (match-beginning 0))
 763             name))
 764     ;; Add this topic and its groups to the topic alist.
 765     (push (cons name (nreverse tgroups)) gnus-topic-active-alist)
 766     (setcar (car topology) name)
 767     ;; We return the rest of the groups that didn't belong
 768     ;; to this topic.
 769     groups))
 770
 771 ;;; Topic mode, commands and keymap.
 772
 773 (defvar gnus-topic-mode-map nil)
 774 (defvar gnus-group-topic-map nil)
 775
 776 (unless gnus-topic-mode-map
 777   (setq gnus-topic-mode-map (make-sparse-keymap))
 778
 779   ;; Override certain group mode keys.
 780   (gnus-define-keys
 781    gnus-topic-mode-map
 782    "=" gnus-topic-select-group
 783    "\r" gnus-topic-select-group
 784    " " gnus-topic-read-group
 785    "\C-k" gnus-topic-kill-group
 786    "\C-y" gnus-topic-yank-group
 787    "\M-g" gnus-topic-get-new-news-this-topic
 788    "AT" gnus-topic-list-active
 789    "Gp" gnus-topic-edit-parameters
 790    gnus-mouse-2 gnus-mouse-pick-topic)
 791
 792   ;; Define a new submap.
 793   (gnus-define-keys
 794    (gnus-group-topic-map "T" gnus-group-mode-map)
 795    "#" gnus-topic-mark-topic
 796    "\M-#" gnus-topic-unmark-topic
 797    "n" gnus-topic-create-topic
 798    "m" gnus-topic-move-group
 799    "D" gnus-topic-remove-group
 800    "c" gnus-topic-copy-group
 801    "h" gnus-topic-hide-topic
 802    "s" gnus-topic-show-topic
 803    "M" gnus-topic-move-matching
 804    "C" gnus-topic-copy-matching
 805    "\C-i" gnus-topic-indent
 806    [tab] gnus-topic-indent
 807    "r" gnus-topic-rename
 808    "\177" gnus-topic-delete))
 809
 810 (defun gnus-topic-make-menu-bar ()
 811   (unless (boundp 'gnus-topic-menu)
 812     (easy-menu-define
 813      gnus-topic-menu gnus-topic-mode-map ""
 814      '("Topics"
 815        ["Toggle topics" gnus-topic-mode t]
 816        ("Groups"
 817         ["Copy" gnus-topic-copy-group t]
 818         ["Move" gnus-topic-move-group t]
 819         ["Remove" gnus-topic-remove-group t]
 820         ["Copy matching" gnus-topic-copy-matching t]
 821         ["Move matching" gnus-topic-move-matching t])
 822        ("Topics"
 823         ["Show" gnus-topic-show-topic t]
 824         ["Hide" gnus-topic-hide-topic t]
 825         ["Delete" gnus-topic-delete t]
 826         ["Rename" gnus-topic-rename t]
 827         ["Create" gnus-topic-create-topic t]
 828         ["Mark" gnus-topic-mark-topic t]
 829         ["Indent" gnus-topic-indent t])
 830        ["List active" gnus-topic-list-active t]))))
 831
 832 (defun gnus-topic-mode (&optional arg redisplay)
 833   "Minor mode for topicsifying Gnus group buffers."
 834   (interactive (list current-prefix-arg t))
 835   (when (eq major-mode 'gnus-group-mode)
 836     (make-local-variable 'gnus-topic-mode)
 837     (setq gnus-topic-mode
 838           (if (null arg) (not gnus-topic-mode)
 839             (> (prefix-numeric-value arg) 0)))
 840     ;; Infest Gnus with topics.
 841     (when gnus-topic-mode
 842       (when (and menu-bar-mode
 843                  (gnus-visual-p 'topic-menu 'menu))
 844         (gnus-topic-make-menu-bar))
 845       (setq gnus-topic-line-format-spec
 846             (gnus-parse-format gnus-topic-line-format
 847                                gnus-topic-line-format-alist t))
 848       (unless (assq 'gnus-topic-mode minor-mode-alist)
 849         (push '(gnus-topic-mode " Topic") minor-mode-alist))
 850       (unless (assq 'gnus-topic-mode minor-mode-map-alist)
 851         (push (cons 'gnus-topic-mode gnus-topic-mode-map)
 852               minor-mode-map-alist))
 853       (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
 854       (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
 855       (add-hook 'gnus-group-update-group-hook 'gnus-topic-update-topic)
 856       (set (make-local-variable 'gnus-group-prepare-function)
 857            'gnus-group-prepare-topics)
 858       (set (make-local-variable 'gnus-group-get-parameter-function)
 859            'gnus-group-topic-parameters)
 860       (set (make-local-variable 'gnus-group-goto-next-group-function)
 861            'gnus-topic-goto-next-group)
 862       (set (make-local-variable 'gnus-group-indentation-function)
 863            'gnus-topic-group-indentation)
 864       (setq gnus-group-change-level-function 'gnus-topic-change-level)
 865       (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
 866       (gnus-make-local-hook 'gnus-check-bogus-groups-hook)
 867       (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
 868       (setq gnus-topology-checked-p nil)
 869       ;; We check the topology.
 870       (when gnus-newsrc-alist
 871         (gnus-topic-check-topology))
 872       (run-hooks 'gnus-topic-mode-hook))
 873     ;; Remove topic infestation.
 874     (unless gnus-topic-mode
 875       (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
 876       (remove-hook 'gnus-group-change-level-function
 877                    'gnus-topic-change-level)
 878       (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
 879       (setq gnus-group-prepare-function 'gnus-group-prepare-flat))
 880     (when redisplay
 881       (gnus-group-list-groups))))
 882
 883 (defun gnus-topic-select-group (&optional all)
 884   "Select this newsgroup.
 885 No article is selected automatically.
 886 If ALL is non-nil, already read articles become readable.
 887 If ALL is a number, fetch this number of articles.
 888
 889 If performed over a topic line, toggle folding the topic."
 890   (interactive "P")
 891   (if (gnus-group-topic-p)
 892       (let ((gnus-group-list-mode
 893              (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
 894         (gnus-topic-fold all))
 895     (gnus-group-select-group all)))
 896
 897 (defun gnus-mouse-pick-topic (e)
 898   "Select the group or topic under the mouse pointer."
 899   (interactive "e")
 900   (mouse-set-point e)
 901   (gnus-topic-read-group nil))
 902
 903 (defun gnus-topic-read-group (&optional all no-article group)
 904   "Read news in this newsgroup.
 905 If the prefix argument ALL is non-nil, already read articles become
 906 readable.  IF ALL is a number, fetch this number of articles.  If the
 907 optional argument NO-ARTICLE is non-nil, no article will be
 908 auto-selected upon group entry.  If GROUP is non-nil, fetch that
 909 group.
 910
 911 If performed over a topic line, toggle folding the topic."
 912   (interactive "P")
 913   (if (gnus-group-topic-p)
 914       (let ((gnus-group-list-mode
 915              (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
 916         (gnus-topic-fold all))
 917     (gnus-group-read-group all no-article group)))
 918
 919 (defun gnus-topic-create-topic (topic parent &optional previous full-topic)
 920   (interactive
 921    (list
 922     (read-string "New topic: ")
 923     (gnus-current-topic)))
 924   ;; Check whether this topic already exists.
 925   (when (gnus-topic-find-topology topic)
 926     (error "Topic aleady exists"))
 927   (unless parent
 928     (setq parent (caar gnus-topic-topology)))
 929   (let ((top (cdr (gnus-topic-find-topology parent)))
 930         (full-topic (or full-topic `((,topic visible)))))
 931     (unless top
 932       (error "No such parent topic: %s" parent))
 933     (if previous
 934         (progn
 935           (while (and (cdr top)
 936                       (not (equal (caaadr top) previous)))
 937             (setq top (cdr top)))
 938           (setcdr top (cons full-topic (cdr top))))
 939       (nconc top (list full-topic)))
 940     (unless (assoc topic gnus-topic-alist)
 941       (push (list topic) gnus-topic-alist)))
 942   (gnus-topic-enter-dribble)
 943   (gnus-group-list-groups)
 944   (gnus-topic-goto-topic topic))
 945
 946 (defun gnus-topic-move-group (n topic &optional copyp)
 947   "Move the next N groups to TOPIC.
 948 If COPYP, copy the groups instead."
 949   (interactive
 950    (list current-prefix-arg
 951          (completing-read "Move to topic: " gnus-topic-alist nil t)))
 952   (let ((groups (gnus-group-process-prefix n))
 953         (topicl (assoc topic gnus-topic-alist))
 954         entry)
 955     (mapcar (lambda (g)
 956               (gnus-group-remove-mark g)
 957               (when (and
 958                      (setq entry (assoc (gnus-current-topic)
 959                                         gnus-topic-alist))
 960                      (not copyp))
 961                 (setcdr entry (gnus-delete-first g (cdr entry))))
 962               (nconc topicl (list g)))
 963             groups)
 964     (gnus-group-position-point))
 965   (gnus-topic-enter-dribble)
 966   (gnus-group-list-groups))
 967
 968 (defun gnus-topic-remove-group ()
 969   "Remove the current group from the topic."
 970   (interactive)
 971   (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
 972         (group (gnus-group-group-name))
 973         (buffer-read-only nil))
 974     (when (and topicl group)
 975       (gnus-delete-line)
 976       (gnus-delete-first group topicl))
 977     (gnus-group-position-point)))
 978
 979 (defun gnus-topic-copy-group (n topic)
 980   "Copy the current group to a topic."
 981   (interactive
 982    (list current-prefix-arg
 983          (completing-read "Copy to topic: " gnus-topic-alist nil t)))
 984   (gnus-topic-move-group n topic t))
 985
 986 (defun gnus-topic-kill-group (&optional n discard)
 987   "Kill the next N groups."
 988   (interactive "P")
 989   (if (gnus-group-topic-p)
 990       (let ((topic (gnus-group-topic-name)))
 991         (gnus-topic-remove-topic nil t)
 992         (push (gnus-topic-find-topology topic nil nil gnus-topic-topology)
 993               gnus-topic-killed-topics))
 994     (gnus-group-kill-group n discard)
 995     (gnus-topic-update-topic)))
 996
 997 (defun gnus-topic-yank-group (&optional arg)
 998   "Yank the last topic."
 999   (interactive "p")
1000   (if gnus-topic-killed-topics
1001       (let ((previous
1002              (or (gnus-group-topic-name)
1003                  (gnus-topic-next-topic (gnus-current-topic))))
1004             (item (cdr (pop gnus-topic-killed-topics))))
1005         (gnus-topic-create-topic
1006          (caar item) (gnus-topic-parent-topic previous) previous
1007          item)
1008         (gnus-topic-goto-topic (caar item)))
1009     (let* ((prev (gnus-group-group-name))
1010            (gnus-topic-inhibit-change-level t)
1011            (gnus-group-indentation
1012             (make-string
1013              (* gnus-topic-indent-level
1014                 (or (save-excursion
1015                       (gnus-topic-goto-topic (gnus-current-topic))
1016                       (gnus-group-topic-level)) 0)) ? ))
1017            yanked alist)
1018       ;; We first yank the groups the normal way...
1019       (setq yanked (gnus-group-yank-group arg))
1020       ;; Then we enter the yanked groups into the topics they belong
1021       ;; to.
1022       (setq alist (assoc (save-excursion
1023                            (forward-line -1)
1024                            (gnus-current-topic))
1025                          gnus-topic-alist))
1026       (when (stringp yanked)
1027         (setq yanked (list yanked)))
1028       (if (not prev)
1029           (nconc alist yanked)
1030         (if (not (cdr alist))
1031             (setcdr alist (nconc yanked (cdr alist)))
1032           (while (cdr alist)
1033             (when (equal (cadr alist) prev)
1034               (setcdr alist (nconc yanked (cdr alist)))
1035               (setq alist nil))
1036             (setq alist (cdr alist))))))
1037     (gnus-topic-update-topic)))
1038
1039 (defun gnus-topic-hide-topic ()
1040   "Hide the current topic."
1041   (interactive)
1042   (when (gnus-current-topic)
1043     (gnus-topic-goto-topic (gnus-current-topic))
1044     (gnus-topic-remove-topic nil nil 'hidden)))
1045
1046 (defun gnus-topic-show-topic ()
1047   "Show the hidden topic."
1048   (interactive)
1049   (when (gnus-group-topic-p)
1050     (gnus-topic-remove-topic t nil 'shown)))
1051
1052 (defun gnus-topic-mark-topic (topic &optional unmark)
1053   "Mark all groups in the topic with the process mark."
1054   (interactive (list (gnus-current-topic)))
1055   (save-excursion
1056     (let ((groups (gnus-topic-find-groups topic 9 t)))
1057       (while groups
1058         (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
1059                  (gnus-info-group (nth 2 (pop groups))))))))
1060
1061 (defun gnus-topic-unmark-topic (topic &optional unmark)
1062   "Remove the process mark from all groups in the topic."
1063   (interactive (list (gnus-current-topic)))
1064   (gnus-topic-mark-topic topic t))
1065
1066 (defun gnus-topic-get-new-news-this-topic (&optional n)
1067   "Check for new news in the current topic."
1068   (interactive "P")
1069   (if (not (gnus-group-topic-p))
1070       (gnus-group-get-new-news-this-group n)
1071     (gnus-topic-mark-topic (gnus-group-topic-name))
1072     (gnus-group-get-new-news-this-group)))
1073
1074 (defun gnus-topic-move-matching (regexp topic &optional copyp)
1075   "Move all groups that match REGEXP to some topic."
1076   (interactive
1077    (let (topic)
1078      (nreverse
1079       (list
1080        (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
1081        (read-string (format "Move to %s (regexp): " topic))))))
1082   (gnus-group-mark-regexp regexp)
1083   (gnus-topic-move-group nil topic copyp))
1084
1085 (defun gnus-topic-copy-matching (regexp topic &optional copyp)
1086   "Copy all groups that match REGEXP to some topic."
1087   (interactive
1088    (let (topic)
1089      (nreverse
1090       (list
1091        (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
1092        (read-string (format "Copy to %s (regexp): " topic))))))
1093   (gnus-topic-move-matching regexp topic t))
1094
1095 (defun gnus-topic-delete (topic)
1096   "Delete a topic."
1097   (interactive (list (gnus-group-topic-name)))
1098   (unless topic
1099     (error "No topic to be deleted"))
1100   (let ((entry (assoc topic gnus-topic-alist))
1101         (buffer-read-only nil))
1102     (when (cdr entry)
1103       (error "Topic not empty"))
1104     ;; Delete if visible.
1105     (when (gnus-topic-goto-topic topic)
1106       (gnus-delete-line))
1107     ;; Remove from alist.
1108     (setq gnus-topic-alist (delq entry gnus-topic-alist))
1109     ;; Remove from topology.
1110     (gnus-topic-find-topology topic nil nil 'delete)))
1111
1112 (defun gnus-topic-rename (old-name new-name)
1113   "Rename a topic."
1114   (interactive
1115    (let ((topic (gnus-current-topic)))
1116      (list topic
1117            (read-string (format "Rename %s to: " topic)))))
1118   (let ((top (gnus-topic-find-topology old-name))
1119         (entry (assoc old-name gnus-topic-alist)))
1120     (when top
1121       (setcar (cadr top) new-name))
1122     (when entry
1123       (setcar entry new-name))
1124     (forward-line -1)
1125     (gnus-group-list-groups)))
1126
1127 (defun gnus-topic-indent (&optional unindent)
1128   "Indent a topic -- make it a sub-topic of the previous topic.
1129 If UNINDENT, remove an indentation."
1130   (interactive "P")
1131   (if unindent
1132       (gnus-topic-unindent)
1133     (let* ((topic (gnus-current-topic))
1134            (parent (gnus-topic-previous-topic topic)))
1135       (unless parent
1136         (error "Nothing to indent %s into" topic))
1137       (when topic
1138         (gnus-topic-goto-topic topic)
1139         (gnus-topic-kill-group)
1140         (gnus-topic-create-topic
1141          topic parent nil (cdr (pop gnus-topic-killed-topics)))
1142         (or (gnus-topic-goto-topic topic)
1143             (gnus-topic-goto-topic parent))))))
1144
1145 (defun gnus-topic-unindent ()
1146   "Unindent a topic."
1147   (interactive)
1148   (let* ((topic (gnus-current-topic))
1149          (parent (gnus-topic-parent-topic topic))
1150          (grandparent (gnus-topic-parent-topic parent)))
1151     (unless grandparent
1152       (error "Nothing to indent %s into" topic))
1153     (when topic
1154       (gnus-topic-goto-topic topic)
1155       (gnus-topic-kill-group)
1156       (gnus-topic-create-topic
1157        topic grandparent (gnus-topic-next-topic parent)
1158        (cdr (pop gnus-topic-killed-topics)))
1159       (gnus-topic-goto-topic topic))))
1160
1161 (defun gnus-topic-list-active (&optional force)
1162   "List all groups that Gnus knows about in a topicsified fashion.
1163 If FORCE, always re-read the active file."
1164   (interactive "P")
1165   (when force
1166     (gnus-get-killed-groups))
1167   (gnus-topic-grok-active force)
1168   (let ((gnus-topic-topology gnus-topic-active-topology)
1169         (gnus-topic-alist gnus-topic-active-alist)
1170         gnus-killed-list gnus-zombie-list)
1171     (gnus-group-list-groups 9 nil 1)))
1172
1173 (defun gnus-topic-edit-parameters (group)
1174   "Edit the group parameters of GROUP.
1175 If performed on a topic, edit the topic parameters instead."
1176   (interactive (list (gnus-group-group-name)))
1177   (if group
1178       (gnus-group-edit-group-parameters group)
1179     (if (not (gnus-group-topic-p))
1180         (error "Nothing to edit on the current line.")
1181       (let ((topic (gnus-group-topic-name)))
1182         (gnus-edit-form
1183          (gnus-topic-parameters topic)
1184          "Editing the topic parameters."
1185          `(lambda (form)
1186             (gnus-topic-set-parameters ,topic form)))))))
1187
1188 (provide 'gnus-topic)
1189
1190 ;;; gnus-topic.el ends here