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 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
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'gnus)
  29 (eval-when-compile (require 'cl))
  30
  31 (defvar gnus-topic-mode nil
  32   "Minor mode for Gnus group buffers.")
  33
  34 (defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %a ]%v\n"
  35   "Format of topic lines.
  36 It works along the same lines as a normal formatting string,
  37 with some simple extensions.
  38
  39 %i  Indentation based on topic level.
  40 %n  Topic name.
  41 %v  Nothing if the topic is visible, \"...\" otherwise.
  42 %g  Number of groups in the topic.
  43 %a  Number of unread articles in the groups in the topic.
  44 ")
  45
  46 (defvar gnus-group-topic-topics-only nil
  47   "*If non-nil, only the topics will be shown when typing `l' or `L'.")
  48
  49 (defvar gnus-topic-unique t
  50   "*If non-nil, each group will only belong to one topic.")
  51
  52 (defvar gnus-topic-hide-subtopics t
  53   "*If non-nil, hide subtopics along with groups.")
  54
  55 ;; Internal variables.
  56
  57 (defvar gnus-topic-killed-topics nil)
  58
  59 (defconst gnus-topic-line-format-alist
  60   `((?n name ?s)
  61     (?v visible ?s)
  62     (?i indentation ?s)
  63     (?g number-of-groups ?d)
  64     (?a number-of-articles ?d)
  65     (?l level ?d)))
  66
  67 (defvar gnus-topic-line-format-spec nil)
  68
  69 ;; Functions.
  70
  71 (defun gnus-group-topic-name ()
  72   "The name of the topic on the current line."
  73   (get-text-property (gnus-point-at-bol) 'gnus-topic))
  74
  75 (defun gnus-group-topic-level ()
  76   "The level of the topic on the current line."
  77   (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
  78
  79 (defun gnus-topic-init-alist ()
  80   (setq gnus-topic-topology
  81         (cons (list "Gnus" 'visible)
  82               (mapcar (lambda (topic)
  83                         (list (list (car topic) 'visible)))
  84                       '(("misc")))))
  85   (setq gnus-topic-alist
  86         (list (cons "misc"
  87                     (mapcar (lambda (info) (gnus-info-group info))
  88                             (cdr gnus-newsrc-alist)))
  89               (list "Gnus")))
  90   (gnus-topic-enter-dribble))
  91
  92 (defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic)
  93   "List all newsgroups with unread articles of level LEVEL or lower, and
  94 use the `gnus-group-topics' to sort the groups.
  95 If ALL is non-nil, list groups that have no unread articles.
  96 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
  97   (set-buffer gnus-group-buffer)
  98   (let ((buffer-read-only nil)
  99         (lowest (or lowest 1))
 100         tlist info)
 101
 102     (unless list-topic
 103       (erase-buffer))
 104
 105     ;; List dead groups?
 106     (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
 107       (gnus-group-prepare-flat-list-dead
 108        (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
 109        gnus-level-zombie ?Z
 110        regexp))
 111
 112     (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
 113       (gnus-group-prepare-flat-list-dead
 114        (setq gnus-killed-list (sort gnus-killed-list 'string<))
 115        gnus-level-killed ?K
 116        regexp))
 117
 118     ;; Use topics.
 119     (when (< lowest gnus-level-zombie)
 120       (let (topics topic how)
 121         ;; The first time we set the topology to whatever we have
 122         ;; gotten here, which can be rather random.
 123         (unless gnus-topic-alist
 124           (gnus-topic-init-alist))
 125         (gnus-topic-check-topology)
 126
 127         (if list-topic
 128             (let ((top (gnus-topic-find-topology list-topic)))
 129               (gnus-topic-prepare-topic (cdr top) (car top) level all))
 130           (gnus-topic-prepare-topic gnus-topic-topology 0 level all)))))
 131
 132   (gnus-group-set-mode-line)
 133   (setq gnus-group-list-mode (cons level all))
 134   (run-hooks 'gnus-group-prepare-hook))
 135
 136 (defun gnus-topic-prepare-topic (topic level &optional list-level all)
 137   "Insert TOPIC into the group buffer."
 138   (let* ((type (pop topic))
 139          (entries (gnus-topic-find-groups (car type) list-level all))
 140          (visiblep (eq (nth 1 type) 'visible))
 141          info entry)
 142     ;; Insert the topic line.
 143     (gnus-topic-insert-topic-line
 144      (car type) visiblep
 145      (not (eq (nth 2 type) 'hidden))
 146      level entries)
 147     (when visiblep
 148       ;; Insert all the groups that belong in this topic.
 149       (while entries
 150         (setq entry (pop entries)
 151               info (nth 2 entry))
 152         (gnus-group-insert-group-line
 153          (gnus-info-group info)
 154          (gnus-info-level info) (gnus-info-marks info)
 155          (car entry) (gnus-info-method info))))
 156     ;; Insert any sub-topics.
 157     (when (or visiblep
 158               (and (not gnus-topic-hide-subtopics)
 159                    (eq (nth 2 type) 'shown)))
 160       (while topic
 161         (gnus-topic-prepare-topic (pop topic) (1+ level) list-level all)))))
 162
 163 (defun gnus-topic-find-groups (topic &optional level all)
 164   "Return entries for all visible groups in TOPIC."
 165   (let ((groups (cdr (assoc topic gnus-topic-alist)))
 166         info clevel unread group w lowest gtopic params visible-groups entry)
 167     (setq lowest (or lowest 1))
 168     (setq level (or level 7))
 169     ;; We go through the newsrc to look for matches.
 170     (while groups
 171       (setq entry (gnus-gethash (pop groups) gnus-newsrc-hashtb)
 172             info (nth 2 entry)
 173             group (gnus-info-group info)
 174             params (gnus-info-params info)
 175             unread (car entry))
 176       (and
 177        unread                           ; nil means that the group is dead.
 178        (<= (setq clevel (gnus-info-level info)) level)
 179        (>= clevel lowest)               ; Is inside the level we want.
 180        (or all
 181            (eq unread t)
 182            (> unread 0)
 183            (cdr (assq 'tick (gnus-info-marks info))) ; Has right readedness.
 184            ;; Check for permanent visibility.
 185            (and gnus-permanently-visible-groups
 186                 (string-match gnus-permanently-visible-groups group))
 187            (memq 'visible params)
 188            (cdr (assq 'visible params)))
 189        ;; Add this group to the list of visible groups.
 190        (push entry visible-groups)))
 191     (nreverse visible-groups)))
 192
 193 (defun gnus-topic-remove-topic (&optional insert total-remove hide)
 194   "Remove the current topic."
 195   (let ((topic (gnus-group-topic-name))
 196         (level (gnus-group-topic-level))
 197         (beg (progn (beginning-of-line) (point)))
 198         buffer-read-only)
 199     (when topic
 200       (while (and (zerop (forward-line 1))
 201                   (> (or (gnus-group-topic-level) (1+ level)) level)))
 202       (delete-region beg (point))
 203       (setcar (cdr (car (cdr (gnus-topic-find-topology topic))))
 204               (if insert 'visible 'invisible))
 205       (when hide
 206         (setcdr (cdr (car (cdr (gnus-topic-find-topology topic))))
 207                 (list hide)))
 208       (unless total-remove
 209         (gnus-topic-insert-topic topic)))))
 210
 211 (defun gnus-topic-insert-topic (topic)
 212   "Insert TOPIC."
 213   (gnus-group-prepare-topics
 214    (car gnus-group-list-mode) (cdr gnus-group-list-mode)
 215    nil nil topic))
 216
 217 (defun gnus-topic-fold (&optional insert)
 218   "Remove/insert the current topic."
 219   (let ((topic (gnus-group-topic-name)))
 220     (when topic
 221       (save-excursion
 222         (gnus-topic-remove-topic (or insert (not (gnus-topic-visible-p))))))))
 223
 224 (defun gnus-group-topic-p ()
 225   "Return non-nil if the current line is a topic."
 226   (get-text-property (gnus-point-at-bol) 'gnus-topic))
 227
 228 (defun gnus-topic-visible-p ()
 229   "Return non-nil if the current topic is visible."
 230   (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
 231
 232 (defun gnus-topic-insert-topic-line (name visiblep shownp level entries)
 233   (let* ((visible (if (and visiblep shownp) "" "..."))
 234          (indentation (make-string (* 2 level) ? ))
 235          (number-of-articles (gnus-topic-articles-in-topic entries))
 236          (number-of-groups (length entries)))
 237     (beginning-of-line)
 238     ;; Insert the text.
 239     (add-text-properties
 240      (point)
 241      (prog1 (1+ (point))
 242        (eval gnus-topic-line-format-spec))
 243      (list 'gnus-topic name
 244            'gnus-topic-level level
 245            'gnus-topic-visible visiblep))))
 246
 247 (defun gnus-topic-previous-topic (topic)
 248   "Return the previous topic on the same level as TOPIC."
 249   (let ((top (cdr (cdr (gnus-topic-find-topology
 250                         (gnus-topic-parent-topic topic))))))
 251     (unless (equal topic (car (car (car top))))
 252       (while (and top (not (equal (car (car (car (cdr top)))) topic)))
 253         (setq top (cdr top)))
 254       (car (car (car top))))))
 255
 256 (defun gnus-topic-parent-topic (topic &optional topology)
 257   "Return the parent of TOPIC."
 258   (unless topology
 259     (setq topology gnus-topic-topology))
 260   (let ((parent (car (pop topology)))
 261         result found)
 262     (while (and topology
 263                 (not (setq found (equal (car (car (car topology))) topic)))
 264                 (not (setq result (gnus-topic-parent-topic topic
 265                                                            (car topology)))))
 266       (setq topology (cdr topology)))
 267     (or result (and found parent))))
 268
 269 (defun gnus-topic-find-topology (topic &optional topology level remove)
 270   "Return the topology of TOPIC."
 271   (unless topology
 272     (setq topology gnus-topic-topology)
 273     (setq level 0))
 274   (let ((top topology)
 275         result)
 276     (if (equal (car (car topology)) topic)
 277         (progn
 278           (when remove
 279             (delq topology remove))
 280           (cons level topology))
 281       (setq topology (cdr topology))
 282       (while (and topology
 283                   (not (setq result (gnus-topic-find-topology
 284                                      topic (car topology) (1+ level)
 285                                      (and remove top)))))
 286         (setq topology (cdr topology)))
 287       result)))
 288
 289 (defun gnus-topic-check-topology ()
 290   (let ((topics (gnus-topic-list))
 291         (alist gnus-topic-alist)
 292         changed)
 293     (while alist
 294       (unless (member (car (car alist)) topics)
 295         (nconc gnus-topic-topology
 296                (list (list (list (car (car alist)) 'visible))))
 297         (setq changed t))
 298       (setq alist (cdr alist)))
 299     (when changed
 300       (gnus-topic-enter-dribble)))
 301   (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
 302                                          gnus-topic-alist)))
 303          (entry (assoc "Gnus" gnus-topic-alist))
 304          (newsrc gnus-newsrc-alist)
 305          group)
 306     (while newsrc
 307       (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
 308         (setcdr entry (cons group (cdr entry)))))))
 309
 310 (defvar gnus-tmp-topics nil)
 311 (defun gnus-topic-list (&optional topology)
 312   (unless topology
 313     (setq topology gnus-topic-topology
 314           gnus-tmp-topics nil))
 315   (push (car (car topology)) gnus-tmp-topics)
 316   (mapcar 'gnus-topic-list (cdr topology))
 317   gnus-tmp-topics)
 318
 319 (defun gnus-topic-enter-dribble ()
 320   (gnus-dribble-enter
 321    (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
 322
 323 (defun gnus-topic-articles-in-topic (entries)
 324   (let ((total 0)
 325         number)
 326     (while entries
 327       (when (numberp (setq number (car (pop entries))))
 328         (incf total number)))
 329     total))
 330
 331 (defun gnus-group-parent-topic ()
 332   "Return the topic the current group belongs in."
 333   (let ((group (gnus-group-group-name)))
 334     (if group
 335         (gnus-group-topic group)
 336       (gnus-group-topic-name))))
 337
 338 (defun gnus-group-topic (group)
 339   "Return the topic GROUP is a member of."
 340   (let ((alist gnus-topic-alist)
 341         out)
 342     (while alist
 343       (when (member group (cdr (car alist)))
 344         (setq out (car (car alist))
 345               alist nil))
 346       (setq alist (cdr alist)))
 347     out))
 348
 349 (defun gnus-topic-goto-topic (topic)
 350   (goto-char (point-min))
 351   (while (and (not (equal topic (gnus-group-topic-name)))
 352               (zerop (forward-line 1))))
 353   (gnus-group-topic-name))
 354
 355 (defun gnus-topic-update-topic ()
 356   (when (and (eq major-mode 'gnus-group-mode)
 357              gnus-topic-mode)
 358     (let ((group (gnus-group-group-name)))
 359       (gnus-topic-goto-topic (gnus-group-parent-topic))
 360       (gnus-topic-update-topic-line)
 361       (gnus-group-goto-group group)
 362       (gnus-group-position-point))))
 363
 364 (defun gnus-topic-update-topic-line ()
 365   (let* ((buffer-read-only nil)
 366          (topic (gnus-group-topic-name))
 367          (entry (gnus-topic-find-topology topic))
 368          (level (car entry))
 369          (type (nth 1 entry))
 370          (entries (gnus-topic-find-groups (car type)))
 371          (visiblep (eq (nth 1 type) 'visible)))
 372     ;; Insert the topic line.
 373     (if topic
 374         (progn
 375           (gnus-delete-line)
 376           (gnus-topic-insert-topic-line
 377            (car type) visiblep
 378            (not (eq (nth 2 type) 'hidden)) level entries)))))
 379
 380 ;;; Topic mode, commands and keymap.
 381
 382 (defvar gnus-topic-mode-map nil)
 383 (defvar gnus-group-topic-map nil)
 384
 385 (unless gnus-topic-mode-map
 386   (setq gnus-topic-mode-map (make-sparse-keymap))
 387   (define-key gnus-topic-mode-map "=" 'gnus-topic-select-group)
 388   (define-key gnus-topic-mode-map "\r" 'gnus-topic-select-group)
 389   (define-key gnus-topic-mode-map " " 'gnus-topic-read-group)
 390   (define-key gnus-topic-mode-map "\C-k" 'gnus-topic-kill-group)
 391   (define-key gnus-topic-mode-map "\C-y" 'gnus-topic-yank-group)
 392   (define-key gnus-topic-mode-map "\M-g" 'gnus-topic-get-new-news-this-topic)
 393   (define-key gnus-topic-mode-map "\C-i" 'gnus-topic-indent)
 394
 395   (define-prefix-command 'gnus-group-topic-map)
 396   (define-key gnus-group-mode-map "T" 'gnus-group-topic-map)
 397   (define-key gnus-group-topic-map "#" 'gnus-topic-mark-topic)
 398   (define-key gnus-group-topic-map "n" 'gnus-topic-create-topic)
 399   (define-key gnus-group-topic-map "m" 'gnus-topic-move-group)
 400   (define-key gnus-group-topic-map "c" 'gnus-topic-copy-group)
 401   (define-key gnus-group-topic-map "h" 'gnus-topic-hide-topic)
 402   (define-key gnus-group-topic-map "s" 'gnus-topic-show-topic)
 403   (define-key gnus-group-topic-map "M" 'gnus-topic-move-matching)
 404   (define-key gnus-group-topic-map "C" 'gnus-topic-copy-matching)
 405   (define-key gnus-group-topic-map "r" 'gnus-topic-rename)
 406   (define-key gnus-group-topic-map "\177" 'gnus-topic-delete)
 407
 408   (define-key gnus-topic-mode-map gnus-mouse-2 'gnus-mouse-pick-topic)
 409   )
 410
 411 ;;;###autoload
 412 (defun gnus-topic-mode (&optional arg redisplay)
 413   "Minor mode for Gnus group buffers."
 414   (interactive (list current-prefix-arg t))
 415   (when (eq major-mode 'gnus-group-mode)
 416     (make-local-variable 'gnus-topic-mode)
 417     (setq gnus-topic-mode
 418           (if (null arg) (not gnus-topic-mode)
 419             (> (prefix-numeric-value arg) 0)))
 420     (when gnus-topic-mode
 421       (setq gnus-topic-line-format-spec
 422             (gnus-parse-format gnus-topic-line-format
 423                                gnus-topic-line-format-alist t))
 424       (unless (assq 'gnus-topic-mode minor-mode-alist)
 425         (push '(gnus-topic-mode " Topic") minor-mode-alist))
 426       (unless (assq 'gnus-topic-mode minor-mode-map-alist)
 427         (push (cons 'gnus-topic-mode gnus-topic-mode-map)
 428               minor-mode-map-alist)))
 429     (make-local-variable 'gnus-group-prepare-function)
 430     (setq gnus-group-prepare-function
 431           (if gnus-topic-mode
 432               'gnus-group-prepare-topics
 433             'gnus-group-prepare-flat))
 434     (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
 435     (when redisplay
 436       (gnus-group-list-groups))))
 437
 438 (defun gnus-topic-select-group (&optional all)
 439   "Select this newsgroup.
 440 No article is selected automatically.
 441 If ALL is non-nil, already read articles become readable.
 442 If ALL is a number, fetch this number of articles."
 443   (interactive "P")
 444   (if (gnus-group-topic-p)
 445       (let ((gnus-group-list-mode
 446              (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
 447         (gnus-topic-fold all))
 448     (gnus-group-select-group all)))
 449
 450 (defun gnus-mouse-pick-topic (e)
 451   "Select the group or topic under the mouse pointer."
 452   (interactive "e")
 453   (mouse-set-point e)
 454   (gnus-topic-read-group nil))
 455
 456 (defun gnus-topic-read-group (&optional all no-article group)
 457   "Read news in this newsgroup.
 458 If the prefix argument ALL is non-nil, already read articles become
 459 readable.  IF ALL is a number, fetch this number of articles.  If the
 460 optional argument NO-ARTICLE is non-nil, no article will be
 461 auto-selected upon group entry.  If GROUP is non-nil, fetch that
 462 group."
 463   (interactive "P")
 464   (if (gnus-group-topic-p)
 465       (let ((gnus-group-list-mode
 466              (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
 467         (gnus-topic-fold all))
 468     (gnus-group-read-group all no-article group)))
 469
 470 (defun gnus-topic-create-topic (topic parent &optional previous)
 471   (interactive
 472    (list
 473     (read-string "Create topic: ")
 474     (completing-read "Parent topic: " gnus-topic-alist nil t)))
 475   ;; Check whether this topic already exists.
 476   (when (gnus-topic-find-topology topic)
 477     (error "Topic aleady exists"))
 478   (let ((top (cdr (gnus-topic-find-topology parent))))
 479     (unless top
 480       (error "No such topic: %s" parent))
 481     (if previous
 482         (progn
 483           (while (and (cdr top)
 484                       (not (equal (car (car (car (cdr top)))) previous)))
 485             (setq top (cdr top)))
 486           (setcdr top (cons (list (list topic 'visible)) (cdr top))))
 487       (nconc top (list (list (list topic 'visible)))))
 488     (unless (assoc topic gnus-topic-alist)
 489       (push (list topic) gnus-topic-alist)))
 490   (gnus-topic-enter-dribble)
 491   (gnus-group-list-groups))
 492
 493 (defun gnus-topic-move-group (n topic &optional copyp)
 494   "Move the current group to a topic."
 495   (interactive
 496    (list current-prefix-arg
 497          (completing-read "Move to topic: " gnus-topic-alist nil t)))
 498   (let ((groups (gnus-group-process-prefix n))
 499         (topicl (assoc topic gnus-topic-alist))
 500         entry)
 501     (unless topicl
 502       (error "No such topic: %s" topic))
 503     (mapcar (lambda (g)
 504               (gnus-group-remove-mark g)
 505               (when (and
 506                      (setq entry (assoc (gnus-group-topic g) gnus-topic-alist))
 507                      (not copyp))
 508                 (setcdr entry (delete g (cdr entry))))
 509               (nconc topicl (list g)))
 510             groups)
 511     (gnus-group-position-point))
 512   (gnus-topic-enter-dribble)
 513   (gnus-group-list-groups))
 514
 515 (defun gnus-topic-copy-group (n topic)
 516   "Copy the current group to a topic."
 517   (interactive
 518    (list current-prefix-arg
 519          (completing-read "Copy to topic: " gnus-topic-alist nil t)))
 520   (gnus-topic-move-group n topic t))
 521
 522 (defun gnus-topic-kill-group (&optional n discard)
 523   "Kill the next N groups."
 524   (interactive "P")
 525   (if (not (gnus-group-topic-p))
 526       (gnus-group-kill-group n discard)
 527     (let ((topic (gnus-group-topic-name)))
 528       (gnus-topic-remove-topic nil t)
 529       (push (gnus-topic-find-topology topic nil nil gnus-topic-topology)
 530             gnus-topic-killed-topics))))
 531
 532 (defun gnus-topic-yank-group (&optional arg)
 533   "Yank the last topic."
 534   (interactive "p")
 535   (if (null gnus-topic-killed-topics)
 536       (gnus-group-yank-group arg)
 537     (let ((previous (gnus-group-parent-topic))
 538           (item (nth 1 (pop gnus-topic-killed-topics))))
 539       (gnus-topic-create-topic
 540        (car item) (gnus-topic-parent-topic previous) previous))))
 541
 542 (defun gnus-topic-hide-topic ()
 543   "Hide all subtopics under the current topic."
 544   (interactive)
 545   (when (gnus-group-topic-p)
 546     (gnus-topic-remove-topic nil nil 'hidden)))
 547
 548 (defun gnus-topic-show-topic ()
 549   "Show the hidden topic."
 550   (interactive)
 551   (when (gnus-group-topic-p)
 552     (gnus-topic-remove-topic t nil 'shown)))
 553
 554 (defun gnus-topic-mark-topic (topic)
 555   "Mark all groups in the topic with the process mark."
 556   (interactive (list (gnus-group-parent-topic)))
 557   (let ((groups (cdr (gnus-topic-find-groups topic))))
 558     (while groups
 559       (gnus-group-set-mark (gnus-info-group (nth 2 (pop groups)))))))
 560
 561 (defun gnus-topic-get-new-news-this-topic (&optional n)
 562   "Check for new news in the current topic."
 563   (interactive "P")
 564   (if (not (gnus-group-topic-p))
 565       (gnus-group-get-new-news-this-group n)
 566     (gnus-topic-mark-topic (gnus-group-topic-name))
 567     (gnus-group-get-new-news-this-group)))
 568
 569 (defun gnus-topic-move-matching (regexp topic &optional copyp)
 570   "Move all groups that match REGEXP to some topic."
 571   (interactive
 572    (let (topic)
 573      (list
 574       (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
 575       (read-string (format "Move to %s (regexp): " topic)))))
 576   (gnus-group-mark-regexp regexp)
 577   (gnus-topic-move-group nil topic copyp))
 578
 579 (defun gnus-topic-copy-matching (regexp topic &optional copyp)
 580   "Copy all groups that match REGEXP to some topic."
 581   (interactive
 582    (let (topic)
 583      (list
 584       (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
 585       (read-string (format "Copy to %s (regexp): " topic)))))
 586   (gnus-topic-move-matching regexp topic t))
 587
 588 (defun gnus-topic-delete (topic)
 589   "Delete a topic."
 590   (interactive (list (gnus-group-topic-name)))
 591   (unless topic
 592     (error "No topic to be deleted"))
 593   (let ((entry (assoc topic gnus-topic-alist))
 594         (buffer-read-only nil))
 595     (when (cdr entry)
 596       (error "Topic not empty"))
 597     ;; Delete if visible.
 598     (when (gnus-topic-goto-topic topic)
 599       (gnus-delete-line))
 600     ;; Remove from alist.
 601     (setq gnus-topic-alist (delq entry gnus-topic-alist))
 602     ;; Remove from topology.
 603     (gnus-topic-find-topology topic nil nil 'delete)))
 604
 605 (defun gnus-topic-rename (old-name new-name)
 606   "Rename a topic."
 607   (interactive
 608    (list
 609     (completing-read "Rename topic: " gnus-topic-alist nil t)
 610     (read-string (format "Rename %s to: "))))
 611   (let ((top (gnus-topic-find-topology old-name))
 612         (entry (assoc old-name gnus-topic-alist)))
 613     (when top
 614       (setcar (car (cdr top)) new-name))
 615     (when entry
 616       (setcar entry new-name))))
 617
 618 (defun gnus-topic-indent (&optional unindent)
 619   "Indent a topic -- make it a sub-topic of the previous topic.
 620 If UNINDENT, remove an indentation."
 621   (interactive "P")
 622   (if unindent
 623       (gnus-topic-unindent)
 624     (let* ((topic (gnus-group-parent-topic))
 625            (parent (gnus-topic-previous-topic topic)))
 626       (unless parent
 627         (error "Nothing to indent %s into" topic))
 628       (when topic
 629         (gnus-topic-goto-topic topic)
 630         (gnus-topic-kill-group)
 631         (gnus-topic-create-topic topic parent)))))
 632
 633 (defun gnus-topic-unindent ()
 634   "Unindent a topic."
 635   (interactive)
 636   (let* ((topic (gnus-group-parent-topic))
 637          (parent (gnus-topic-parent-topic topic))
 638          (grandparent (gnus-topic-parent-topic parent)))
 639     (unless grandparent
 640       (error "Nothing to indent %s into" topic))
 641     (when topic
 642       (gnus-topic-goto-topic topic)
 643       (gnus-topic-kill-group)
 644       (gnus-topic-create-topic topic grandparent))))
 645
 646 (provide 'gnus-topic)
 647
 648 ;;; gnus-topic.el ends here