(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 ()
(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 ()
"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)
(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")
(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.