(require 'gnus-group)
(require 'gnus-start)
+(defgroup gnus-topic nil
+ "Group topics."
+ :group 'gnus-group)
+
(defvar gnus-topic-mode nil
"Minor mode for Gnus group buffers.")
-(defvar gnus-topic-mode-hook nil
- "Hook run in topic mode buffers.")
+(defcustom gnus-topic-mode-hook nil
+ "Hook run in topic mode buffers."
+ :type 'hook
+ :group 'gnus-topic)
-(defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
+(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
"Format of topic lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%g Number of groups in the topic.
%a Number of unread articles in the groups in the topic.
%A Number of unread articles in the groups in the topic and its subtopics.
-")
+"
+ :type 'string
+ :group 'gnus-topic)
-(defvar gnus-topic-indent-level 2
- "*How much each subtopic should be indented.")
+(defcustom gnus-topic-indent-level 2
+ "*How much each subtopic should be indented."
+ :type 'integer
+ :group 'gnus-topic)
-(defvar gnus-topic-display-empty-topics t
- "*If non-nil, display the topic lines even of topics that have no unread articles.")
+(defcustom gnus-topic-display-empty-topics t
+ "*If non-nil, display the topic lines even of topics that have no unread articles."
+ :type 'boolean
+ :group 'gnus-topic)
;; Internal variables.
(setq level (or level 7))
;; We go through the newsrc to look for matches.
(while groups
- (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb)
- info (nth 2 entry)
- params (gnus-info-params info)
- active (gnus-active group)
- unread (or (car entry)
- (and (not (equal group "dummy.group"))
- active
- (- (1+ (cdr active)) (car active))))
- clevel (or (gnus-info-level info)
- (if (member group gnus-zombie-list) 8 9)))
+ (when (setq group (pop groups))
+ (setq entry (gnus-gethash group gnus-newsrc-hashtb)
+ info (nth 2 entry)
+ params (gnus-info-params info)
+ active (gnus-active group)
+ unread (or (car entry)
+ (and (not (equal group "dummy.group"))
+ active
+ (- (1+ (cdr active)) (car active))))
+ clevel (or (gnus-info-level info)
+ (if (member group gnus-zombie-list) 8 9))))
(and
unread ; nil means that the group is dead.
(<= clevel level)
(defun gnus-topic-parameters (topic)
"Return the parameters for TOPIC."
(let ((top (gnus-topic-find-topology topic)))
- (unless top
- (error "No such topic: %s" topic))
- (nth 3 (cadr top))))
+ (when top
+ (nth 3 (cadr top)))))
(defun gnus-topic-set-parameters (topic parameters)
"Set the topic parameters of TOPIC to PARAMETERS."
(nconc (cadr top) (list nil)))
(unless (nthcdr 3 (cadr top))
(nconc (cadr top) (list nil)))
- (setcar (nthcdr 3 (cadr top)) parameters)))
+ (setcar (nthcdr 3 (cadr top)) parameters)
+ (gnus-dribble-enter
+ (format "(gnus-topic-set-parameters %s '%S)" topic parameters))))
(defun gnus-group-topic-parameters (group)
"Compute the group parameters for GROUP taking into account inheritance from topics."
(beg (progn (beginning-of-line) (point)))
(topicl (reverse topicl))
(all-entries entries)
+ (point-max (point-max))
(unread 0)
(topic (car type))
info entry end active)
;; Insert the topic line.
(when (and (not silent)
(or gnus-topic-display-empty-topics
- (not (zerop unread))))
+ (not (zerop unread))
+ (/= point-max (point-max))))
(gnus-extent-start-open (point))
(gnus-topic-insert-topic-line
(car type) visiblep
(while (and (zerop (forward-line 1))
(> (or (gnus-group-topic-level) (1+ level)) level)))
(delete-region beg (point))
- (setcdr (cadr (gnus-topic-find-topology topic))
- (if insert (list 'visible) (list 'invisible)))
- (when hide
- (setcdr (cdadr (gnus-topic-find-topology topic))
- (list hide)))
- (unless total-remove
+ ;; Do the change in this rather odd manner because it has been
+ ;; reported that some topics share parts of some lists, for some
+ ;; reason. I have been unable to determine why this is the
+ ;; case, but this hack seems to take care of things.
+ (let ((data (cadr (gnus-topic-find-topology topic))))
+ (setcdr data
+ (list (if insert 'visible 'invisible)
+ (if hide 'hide nil)
+ (cadddr data))))
+ (if total-remove
+ (setq gnus-topic-alist
+ (delq (assoc topic gnus-topic-alist) gnus-topic-alist))
(gnus-topic-insert-topic topic in-level)))))
(defun gnus-topic-insert-topic (topic &optional level)
(forward-line -1)
(when (setq alist (assoc (gnus-current-topic) gnus-topic-alist))
(setcdr alist (gnus-delete-first group (cdr alist))))))
- ;; If the group is subscribed. then we enter it into the topics.
+ ;; If the group is subscribed we enter it into the topics.
(when (and (< level gnus-level-zombie)
(>= oldlevel gnus-level-zombie))
(let* ((prev (gnus-group-group-name))
(> (prefix-numeric-value arg) 0)))
;; Infest Gnus with topics.
(when gnus-topic-mode
- (when (and menu-bar-mode
- (gnus-visual-p 'topic-menu 'menu))
+ (when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(setq gnus-topic-line-format-spec
(gnus-parse-format gnus-topic-line-format
(remove-hook 'gnus-group-change-level-function
'gnus-topic-change-level)
(remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
- (setq gnus-group-prepare-function 'gnus-group-prepare-flat))
+ (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
+ (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
(when redisplay
(gnus-group-list-groups))))
(gnus-topic-goto-topic start-topic))
(gnus-group-list-groups)))
-(defun gnus-topic-remove-group ()
+(defun gnus-topic-remove-group (&optional arg)
"Remove the current group from the topic."
- (interactive)
- (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
- (group (gnus-group-group-name))
- (buffer-read-only nil))
- (when (and topicl group)
- (gnus-delete-line)
- (gnus-delete-first group topicl))
- (gnus-topic-update-topic)
- (gnus-group-position-point)))
+ (interactive "P")
+ (gnus-group-iterate arg
+ (lambda (group)
+ (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
+ (buffer-read-only nil))
+ (when (and topicl group)
+ (gnus-delete-line)
+ (gnus-delete-first group topicl))
+ (gnus-topic-update-topic)
+ (gnus-group-position-point)))))
(defun gnus-topic-copy-group (n topic)
"Copy the current group to a topic."
(interactive "P")
(if (gnus-group-topic-p)
(let ((topic (gnus-group-topic-name)))
- (gnus-topic-remove-topic nil t)
- (push (gnus-topic-find-topology topic nil nil gnus-topic-topology)
+ (push (cons
+ (gnus-topic-find-topology topic)
+ (assoc topic gnus-topic-alist))
gnus-topic-killed-topics)
+ (gnus-topic-remove-topic nil t)
+ (gnus-topic-find-topology topic nil nil gnus-topic-topology)
(gnus-topic-enter-dribble))
(gnus-group-kill-group n discard)
(gnus-topic-update-topic)))
"Yank the last topic."
(interactive "p")
(if gnus-topic-killed-topics
- (let ((previous
- (or (gnus-group-topic-name)
- (gnus-topic-next-topic (gnus-current-topic))))
- (item (cdr (pop gnus-topic-killed-topics))))
+ (let* ((previous
+ (or (gnus-group-topic-name)
+ (gnus-topic-next-topic (gnus-current-topic))))
+ (data (pop gnus-topic-killed-topics))
+ (alist (cdr data))
+ (item (cdar data)))
+ (push alist gnus-topic-alist)
(gnus-topic-create-topic
(caar item) (gnus-topic-parent-topic previous) previous
item)
(gnus-topic-goto-topic topic)
(gnus-topic-kill-group)
(gnus-topic-create-topic
- topic parent nil (cdr (pop gnus-topic-killed-topics)))
+ topic parent nil (cdar (pop gnus-topic-killed-topics)))
(or (gnus-topic-goto-topic topic)
(gnus-topic-goto-topic parent))))))
(gnus-topic-kill-group)
(gnus-topic-create-topic
topic grandparent (gnus-topic-next-topic parent)
- (cdr (pop gnus-topic-killed-topics)))
+ (cdar (pop gnus-topic-killed-topics)))
(gnus-topic-goto-topic topic))))
(defun gnus-topic-list-active (&optional force)
projects / gnus / blobdiff