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 'bold
31 "*Face used to highlight topic headers.")
33 (defvar gnus-group-topics '(("no" "^no" nil) ("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 (defvar gnus-topic-unique t
51 "*If non-nil, each group will only belong to one topic.")
53 ;; Internal variables.
55 (defvar gnus-topics-not-listed nil)
59 (defun gnus-group-topic-name ()
60 "The name of the topic on the current line."
61 (get-text-property (gnus-point-at-bol) 'gnus-topic))
63 (defun gnus-group-prepare-topics (level &optional all lowest regexp topic)
64 "List all newsgroups with unread articles of level LEVEL or lower, and
65 use the `gnus-group-topics' to sort the groups.
66 If ALL is non-nil, list groups that have no unread articles.
67 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
68 (set-buffer gnus-group-buffer)
69 (let ((buffer-read-only nil)
70 (lowest (or lowest 1))
73 (or topic (erase-buffer))
76 (and (>= level 8) (<= lowest 8)
77 (gnus-group-prepare-flat-list-dead
78 (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 8 ?Z
81 (and (>= level 9) (<= lowest 9)
82 (gnus-group-prepare-flat-list-dead
83 (setq gnus-killed-list (sort gnus-killed-list 'string<)) 9 ?K
88 (let ((topics (gnus-topic-find-groups topic))
92 (setq topic (car (car topics))
93 tlist (cdr (car topics))
94 how (nth 2 (assoc topic gnus-group-topics))
103 (list 'mouse-face gnus-mouse-face
104 'face gnus-group-topic-face
107 ;; We insert the groups for the topics we want to have.
108 (if (and (or (and (not how) (not gnus-group-topic-topics-only))
109 (and how (not (numberp how))))
110 (not (member topic gnus-topics-not-listed)))
112 (setq gnus-topics-not-listed
113 (delete topic gnus-topics-not-listed))
114 (setq tlist (nreverse tlist))
116 (setq info (car tlist))
117 (gnus-group-insert-group-line
118 nil (car info) (car (cdr info)) (nth 3 info)
119 (car (gnus-gethash (car info) gnus-newsrc-hashtb))
121 (setq tlist (cdr tlist))))
122 (setq gnus-topics-not-listed
123 (cons topic gnus-topics-not-listed)))))))
125 (gnus-group-set-mode-line)
126 (setq gnus-group-list-mode (cons level all))
127 (run-hooks 'gnus-group-prepare-hook))
129 (defun gnus-topic-find-groups (&optional topic)
130 "Find all topics and all groups in all topics.
131 If TOPIC, just find the groups in that topic."
132 (let ((newsrc (cdr gnus-newsrc-alist))
133 (topics (mapcar (lambda (e) (list (car e)))
135 (topic-alist (if topic (list (assoc topic gnus-group-topics))
137 info clevel unread group w lowest level all gtopic)
138 (setq lowest (or lowest 1))
139 ;; We go through the newsrc to look for matches.
141 (setq info (car newsrc)
144 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
146 unread ; nil means that the group is dead.
147 (<= (setq clevel (car (cdr info))) level)
148 (>= clevel lowest) ; Is inside the level we want.
152 (cdr (assq 'tick (nth 3 info)))) ; Has right readedness.
154 ;; So we find out what topic this group belongs to. First we
155 ;; check the group parameters.
156 (setq gtopic (cdr (assq 'topic (nth 5 info))))
157 ;; On match, we add it.
158 (and (stringp gtopic)
160 (string= gtopic topic))
161 (if (setq e (assoc gtopic topics))
162 (setcdr e (cons info (cdr e)))
163 (setq topics (cons (list gtopic info) topics))))
164 ;; We look through the topic alist for further matches, if
166 (if (or (not gnus-topic-unique) (not (stringp gtopic)))
167 (let ((ts topic-alist))
169 (if (string-match (nth 1 (car ts)) group)
171 (setcdr (setq e (assoc (car (car ts)) topics))
173 (and gnus-topic-unique (setq ts nil))))
174 (setq ts (cdr ts))))))))
177 (defun gnus-topic-remove-topic ()
178 "Remove the current topic."
179 (let ((topic (gnus-group-topic-name))
183 (setq gnus-topics-not-listed (cons topic gnus-topics-not-listed))
185 (delete-region (point)
186 (or (next-single-property-change (point) 'gnus-topic)
189 (defun gnus-topic-insert-topic (topic)
191 (gnus-group-prepare-topics
192 (car gnus-group-list-mode) (cdr gnus-group-list-mode)
195 (defun gnus-topic-fold ()
196 "Remove/insert the current topic."
197 (let ((topic (gnus-group-topic-name)))
201 (if (not (member topic gnus-topics-not-listed))
202 ;; If the topic is visible, we remove it.
203 (gnus-topic-remove-topic)
204 ;; If not, we insert it.
206 (gnus-topic-insert-topic topic))))))
208 ;;; gnus-topic.el ends here