1 ;;; gnus-topic.el --- a folding group mode for Gnus
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Author: Ilja Weis <kult@uni-paderborn.de>
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
8 ;; This file is part of GNU Emacs.
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)
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.
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.
30 (defvar gnus-group-topic-face 'underline
31 "*Face used to highlight topic headers.")
33 (defvar gnus-group-topics '(("misc" "." nil))
34 "*Alist of newsgroup topics.
35 This alist has entries of the form
39 where TOPIC is the name of the topic a group is put in if it matches
40 REGEXP. A group can only be in one topic at a time.
42 If SHOW is nil, newsgroups will be inserted according to
43 `gnus-group-topic-topics-only', otherwise that variable is ignored and
44 the groups are always shown if SHOW is true or never if SHOW is a
47 (defvar gnus-group-topic-topics-only nil
48 "*If non-nil, only the topics will be shown when typing `l' or `L'.")
50 ;; Internal variables.
52 (defvar gnus-topics-not-listed nil)
56 (defun gnus-group-topic-name ()
57 (get-text-property (gnus-point-at-bol) 'gnus-topic))
59 (defun gnus-group-prepare-topics (level &optional all lowest regexp)
60 "List all newsgroups with unread articles of level LEVEL or lower, and
61 use the `gnus-group-topics' to sort the groups.
62 If ALL is non-nil, list groups that have no unread articles.
63 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
64 (set-buffer gnus-group-buffer)
65 (let ((buffer-read-only nil)
66 (lowest (or lowest 1)))
71 (and (>= level 8) (<= lowest 8)
72 (gnus-group-prepare-flat-list-dead
73 (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 8 ?Z
76 (and (>= level 9) (<= lowest 9)
77 (gnus-group-prepare-flat-list-dead
78 (setq gnus-killed-list (sort gnus-killed-list 'string<)) 9 ?K
83 (let ((topics gnus-group-topics)
87 (setq topic (car (car topics))
88 how (nth 2 (car topics))
96 (list 'mouse-face gnus-mouse-face
97 'face gnus-group-topic-face
100 (if (and (or (and (not how) (not gnus-group-topic-topics-only))
101 (and how (not (numberp how))))
102 (not (member topic gnus-topics-not-listed)))
103 (gnus-topic-insert-topic topic level all lowest t)
104 (setq gnus-topics-not-listed
105 (cons topic gnus-topics-not-listed)))))))
107 (gnus-group-set-mode-line)
108 (setq gnus-group-list-mode (cons level all))
109 (run-hooks 'gnus-group-prepare-hook))
111 (defun gnus-topic-insert-topic (topic level &optional all lowest m)
112 "Insert all groups matching TOPIC with unread articles of level LEVEL or lower.
113 If ALL is non-nil, list groups that have no unread articles. If
114 LOWEST is non-nil, list all newsgroups of level LOWEST or higher. If
115 M is non-nil, nothing will be inserted, but only
116 `gnus-group-listed-topics' will be changed."
117 (let ((buffer-read-only nil)
118 (regexp (car (cdr (assoc topic gnus-group-topics))))
119 (newsrc (cdr gnus-newsrc-alist))
120 info clevel unread group w)
121 (setq lowest (or lowest 1))
123 (setq info (car newsrc)
126 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
128 (string-match regexp group)
129 (<= (setq clevel (car (cdr info))) level)
134 (cdr (assq 'tick (nth 3 info))))
136 (gnus-group-insert-group-line
137 nil group (car (cdr info)) (nth 3 info) unread
139 (setq gnus-topics-not-listed
140 (delete topic gnus-topics-not-listed)))))))
142 (defun gnus-topic-remove-topic ()
143 (let ((topic (gnus-group-topic-name))
145 (setq gnus-topics-not-listed (cons topic gnus-topics-not-listed))
147 (delete-region (point)
148 (or (next-single-property-change (point) 'gnus-topic)
151 (defun gnus-topic-fold ()
152 (let ((topic (gnus-group-topic-name)))
154 (if (not (member topic gnus-topics-not-listed))
155 (gnus-topic-remove-topic)
157 (gnus-topic-insert-topic
158 topic (gnus-group-default-level)
159 (cdr gnus-group-list-mode))))))
161 ;;; gnus-topic.el ends here