;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'gnus)
(require 'gnus-group)
(require 'gnus-start)
+(require 'gnus-util)
(defgroup gnus-topic nil
"Group topics."
(defvar gnus-topic-active-topology nil)
(defvar gnus-topic-active-alist nil)
+(defvar gnus-topic-unreads nil)
(defvar gnus-topology-checked-p nil
"Whether the topology has been checked in this session.")
(defun gnus-topic-unread (topic)
"Return the number of unread articles in TOPIC."
- (or (save-excursion
- (and (gnus-topic-goto-topic topic)
- (gnus-group-topic-unread)))
+ (or (cdr (assoc topic gnus-topic-unreads))
0))
(defun gnus-group-topic-p ()
(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))
+(defun gnus-current-topics (&optional topic)
+ "Return a list of all current topics, lowest in hierarchy first.
+If TOPIC, start with that topic."
+ (let ((topic (or topic (gnus-current-topic)))
topics)
(while topic
(push topic topics)
active
(- (1+ (cdr active)) (car active))))
clevel (or (gnus-info-level info)
- (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed))))
+ (if (member group gnus-zombie-list)
+ gnus-level-zombie gnus-level-killed))))
(and
unread ; nil means that the group is dead.
(<= clevel level)
(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)
+ (let ((params-list (copy-sequence (gnus-group-get-parameter group))))
(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)))
+ (nconc params-list
+ (gnus-topic-hierarchical-parameters (gnus-current-topic))))))
+
+(defun gnus-topic-hierarchical-parameters (topic)
+ "Return a topic list computed for TOPIC."
+ (let ((topics (gnus-current-topics topic))
+ params-list param out params)
+ (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.
+ (gnus-pull (car param) out)
+ (push param out)))
+ ;; Return the resulting parameter list.
+ out))
;;; General utility functions
;;; Generating group buffers
-(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level)
+(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.
Use the `gnus-group-topics' to sort the groups.
If ALL is non-nil, list groups that have no unread articles.
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 lowest))
+ (entries (gnus-topic-find-groups
+ (car type) list-level
+ (or all
+ (cdr (assq 'visible
+ (gnus-topic-hierarchical-parameters
+ (car type)))))
+ lowest))
(visiblep (and (eq (nth 1 type) 'visible) (not silent)))
(gnus-group-indentation
(make-string (* gnus-topic-indent-level level) ? ))
(if (stringp entry)
;; Dead groups.
(gnus-group-insert-group-line
- entry (if (member entry gnus-zombie-list) gnus-level-zombie gnus-level-killed)
+ entry (if (member entry gnus-zombie-list)
+ gnus-level-zombie gnus-level-killed)
nil (- (1+ (cdr (setq active (gnus-active entry))))
(car active))
nil)
(car type) visiblep
(not (eq (nth 2 type) 'hidden))
level all-entries unread))
+ (gnus-topic-update-unreads (car type) unread)
(goto-char end)
unread))
(number-of-groups (length entries))
(active-topic (eq gnus-topic-alist gnus-topic-active-alist))
gnus-tmp-header)
+ (gnus-topic-update-unreads name unread)
(beginning-of-line)
;; Insert the text.
(gnus-add-text-properties
'gnus-active active-topic
'gnus-topic-visible visiblep))))
+(defun gnus-topic-update-unreads (topic unreads)
+ (setq gnus-topic-unreads (delq (assoc topic gnus-topic-unreads)
+ gnus-topic-unreads))
+ (push (cons topic unreads) gnus-topic-unreads))
+
(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)
(parent (gnus-topic-parent-topic topic-name))
(all-entries entries)
(unread 0)
- old-unread entry)
+ old-unread entry new-unread)
(when (gnus-topic-goto-topic (car type))
;; Tally all the groups that belong in this topic.
(if reads
(car type) (gnus-topic-visible-p)
(not (eq (nth 2 type) 'hidden))
(gnus-group-topic-level) all-entries unread)
- (gnus-delete-line))
+ (gnus-delete-line)
+ (forward-line -1)
+ (setq new-unread (gnus-group-topic-unread)))
(when parent
(forward-line -1)
(gnus-topic-update-topic-line
- parent (- (or old-unread 0) (or (gnus-group-topic-unread) 0))))
+ parent
+ (- (or old-unread 0) (or new-unread 0))))
unread))
(defun gnus-topic-group-indentation ()
"=" gnus-topic-select-group
"\r" gnus-topic-select-group
" " gnus-topic-read-group
+ "\C-c\C-x" gnus-topic-expire-articles
"\C-k" gnus-topic-kill-group
"\C-y" gnus-topic-yank-group
"\M-g" gnus-topic-get-new-news-this-topic
"Gp" gnus-topic-edit-parameters
"#" gnus-topic-mark-topic
"\M-#" gnus-topic-unmark-topic
+ [tab] gnus-topic-indent
+ [(meta tab)] gnus-topic-unindent
+ "\C-i" gnus-topic-indent
+ "\M-\C-i" gnus-topic-unindent
gnus-mouse-2 gnus-mouse-pick-topic)
;; Define a new submap.
"r" gnus-topic-rename
"\177" gnus-topic-delete
[delete] gnus-topic-delete
- "h" gnus-topic-toggle-display-empty-topics)
+ "H" gnus-topic-toggle-display-empty-topics)
(gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map)
"s" gnus-topic-sort-groups
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
(gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)
- (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
(add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
(set (make-local-variable 'gnus-group-prepare-function)
'gnus-group-prepare-topics)
(mouse-set-point e)
(gnus-topic-read-group nil))
+(defun gnus-topic-expire-articles (topic)
+ "Expire articles in this topic or group."
+ (interactive (list (gnus-group-topic-name)))
+ (if (not topic)
+ (call-interactively 'gnus-group-expire-articles)
+ (save-excursion
+ (gnus-message 5 "Expiring groups in %s..." topic)
+ (let ((gnus-group-marked
+ (mapcar (lambda (entry) (car (nth 2 entry)))
+ (gnus-topic-find-groups topic gnus-level-killed t))))
+ (gnus-group-expire-articles nil))
+ (gnus-message 5 "Expiring groups in %s...done" topic))))
+
(defun gnus-topic-read-group (&optional all no-article group)
"Read news in this newsgroup.
If the prefix argument ALL is non-nil, already read articles become
(read-string (format "Rename %s to: " topic)))))
;; Check whether the new name exists.
(when (gnus-topic-find-topology new-name)
- (error "Topic '%s' already exists"))
+ (error "Topic '%s' already exists" new-name))
+ ;; "nil" is an invalid name, for reasons I'd rather not go
+ ;; into here. Trust me.
+ (when (equal new-name "nil")
+ (error "Invalid name: %s" nil))
;; Do the renaming.
(let ((top (gnus-topic-find-topology old-name))
(entry (assoc old-name gnus-topic-alist)))
(setcar entry new-name))
(forward-line -1)
(gnus-dribble-touch)
- (gnus-group-list-groups)))
+ (gnus-group-list-groups)
+ (forward-line 1)))
(defun gnus-topic-indent (&optional unindent)
"Indent a topic -- make it a sub-topic of the previous topic.