;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
(require 'gnus-group)
(require 'gnus-start)
(beginning-of-line)
(get-text-property (point) 'gnus-active)))
-(defun gnus-topic-find-groups (topic &optional level all)
+(defun gnus-topic-find-groups (topic &optional level all lowest)
"Return entries for all visible groups in TOPIC."
(let ((groups (cdr (assoc topic gnus-topic-alist)))
- info clevel unread group lowest params visible-groups entry active)
+ info clevel unread group params visible-groups entry active)
(setq lowest (or lowest 1))
- (setq level (or level 7))
+ (setq level (or level gnus-level-unsubscribed))
;; We go through the newsrc to look for matches.
(while groups
(when (setq group (pop groups))
active
(- (1+ (cdr active)) (car active))))
clevel (or (gnus-info-level info)
- (if (member group gnus-zombie-list) 8 9))))
+ (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed))))
(and
unread ; nil means that the group is dead.
(<= clevel level)
(erase-buffer))
;; List dead groups?
- (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
+ (when (and (>= level gnus-level-zombie)
+ (<= lowest gnus-level-zombie))
(gnus-group-prepare-flat-list-dead
(setq gnus-zombie-list (sort gnus-zombie-list 'string<))
gnus-level-zombie ?Z
(if list-topic
(let ((top (gnus-topic-find-topology list-topic)))
(gnus-topic-prepare-topic (cdr top) (car top)
- (or topic-level level) all))
+ (or topic-level level) all
+ nil lowest))
(gnus-topic-prepare-topic gnus-topic-topology 0
- (or topic-level level) all)))
+ (or topic-level level) all
+ nil lowest)))
(gnus-group-set-mode-line)
(setq gnus-group-list-mode (cons level all))
- (run-hooks 'gnus-group-prepare-hook))))
+ (gnus-run-hooks 'gnus-group-prepare-hook))))
-(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent)
+(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent
+ lowest)
"Insert TOPIC into the group buffer.
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))
+ (entries (gnus-topic-find-groups (car type) list-level all lowest))
(visiblep (and (eq (nth 1 type) 'visible) (not silent)))
(gnus-group-indentation
(make-string (* gnus-topic-indent-level level) ? ))
(incf unread
(gnus-topic-prepare-topic
(pop topicl) (1+ level) list-level all
- (not visiblep))))
+ (not visiblep) lowest)))
(setq end (point))
(goto-char beg)
;; Insert all the groups that belong in this topic.
(if (stringp entry)
;; Dead groups.
(gnus-group-insert-group-line
- entry (if (member entry gnus-zombie-list) 8 9)
+ entry (if (member entry gnus-zombie-list) gnus-level-zombie gnus-level-killed)
nil (- (1+ (cdr (setq active (gnus-active entry))))
(car active))
nil)
(indentation (make-string (* gnus-topic-indent-level level) ? ))
(total-number-of-articles unread)
(number-of-groups (length entries))
- (active-topic (eq gnus-topic-alist gnus-topic-active-alist)))
+ (active-topic (eq gnus-topic-alist gnus-topic-active-alist))
+ gnus-tmp-header)
(beginning-of-line)
;; Insert the text.
(gnus-add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec)
- (gnus-topic-remove-excess-properties)1)
+ (eval gnus-topic-line-format-spec))
(list 'gnus-topic (intern name)
'gnus-topic-level level
'gnus-topic-unread unread
(when parent
(forward-line -1)
(gnus-topic-update-topic-line
- parent (- old-unread (gnus-group-topic-unread))))
+ parent (- (or old-unread 0) (or (gnus-group-topic-unread) 0))))
unread))
(defun gnus-topic-group-indentation ()
;; they belong to some topic.
(let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
gnus-topic-alist)))
- (entry (assoc (caar gnus-topic-topology) gnus-topic-alist))
+ (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist)))
(newsrc (cdr gnus-newsrc-alist))
group)
(while newsrc
(unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
- (setcdr entry (cons group (cdr entry))))))
+ (setcdr entry (list group))
+ (setq entry (cdr entry)))))
;; Go through all topics and make sure they contain only living groups.
(let ((alist gnus-topic-alist)
topic)
(while (setq topic (pop alist))
(while (cdr topic)
- (if (gnus-gethash (cadr topic) gnus-newsrc-hashtb)
+ (if (and (cadr topic)
+ (gnus-gethash (cadr topic) gnus-newsrc-hashtb))
(setq topic (cdr topic))
(setcdr topic (cddr topic)))))))
(push (cons topic-name (nreverse filtered-topic)) result)))
(setq gnus-topic-alist (nreverse result))))
-(defun gnus-topic-change-level (group level oldlevel)
+(defun gnus-topic-change-level (group level oldlevel &optional previous)
"Run when changing levels to enter/remove groups from topics."
(save-excursion
(set-buffer gnus-group-buffer)
- (when (and gnus-topic-mode
- gnus-topic-alist
- (not gnus-topic-inhibit-change-level))
- ;; Remove the group from the topics.
- (when (and (< oldlevel gnus-level-zombie)
+ (unless gnus-topic-inhibit-change-level
+ (gnus-group-goto-group (or (car (nth 2 previous)) group))
+ (when (and gnus-topic-mode
+ gnus-topic-alist
+ (not gnus-topic-inhibit-change-level))
+ ;; Remove the group from the topics.
+ (if (and (< oldlevel gnus-level-zombie)
(>= level gnus-level-zombie))
- (let (alist)
- (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 we enter it into the topics.
- (when (and (< level gnus-level-zombie)
- (>= oldlevel gnus-level-zombie))
- (let* ((prev (gnus-group-group-name))
- (gnus-topic-inhibit-change-level t)
- (gnus-group-indentation
- (make-string
- (* gnus-topic-indent-level
- (or (save-excursion
- (gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level))
- 0))
- ? ))
- (yanked (list group))
- alist talist end)
- ;; Then we enter the yanked groups into the topics they belong
- ;; to.
- (when (setq alist (assoc (save-excursion
- (forward-line -1)
- (or
- (gnus-current-topic)
- (caar gnus-topic-topology)))
- gnus-topic-alist))
- (setq talist alist)
- (when (stringp yanked)
- (setq yanked (list yanked)))
- (if (not prev)
- (nconc alist yanked)
- (if (not (cdr alist))
- (setcdr alist (nconc yanked (cdr alist)))
- (while (and (not end) (cdr alist))
- (when (equal (cadr alist) prev)
- (setcdr alist (nconc yanked (cdr alist)))
- (setq end t))
- (setq alist (cdr alist)))
- (unless end
- (nconc talist yanked))))))
- (gnus-topic-update-topic)))))
+ (let ((alist gnus-topic-alist))
+ (while (gnus-group-goto-group group)
+ (gnus-delete-line))
+ (while alist
+ (when (member group (car alist))
+ (setcdr (car alist) (delete group (cdar alist))))
+ (pop alist)))
+ ;; 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))
+ (gnus-topic-inhibit-change-level t)
+ (gnus-group-indentation
+ (make-string
+ (* gnus-topic-indent-level
+ (or (save-excursion
+ (gnus-topic-goto-topic (gnus-current-topic))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
+ (yanked (list group))
+ alist talist end)
+ ;; Then we enter the yanked groups into the topics they belong
+ ;; to.
+ (when (setq alist (assoc (save-excursion
+ (forward-line -1)
+ (or
+ (gnus-current-topic)
+ (caar gnus-topic-topology)))
+ gnus-topic-alist))
+ (setq talist alist)
+ (when (stringp yanked)
+ (setq yanked (list yanked)))
+ (if (not prev)
+ (nconc alist yanked)
+ (if (not (cdr alist))
+ (setcdr alist (nconc yanked (cdr alist)))
+ (while (and (not end) (cdr alist))
+ (when (equal (cadr alist) prev)
+ (setcdr alist (nconc yanked (cdr alist)))
+ (setq end t))
+ (setq alist (cdr alist)))
+ (unless end
+ (nconc talist yanked))))))
+ (gnus-topic-update-topic)))))))
(defun gnus-topic-goto-next-group (group props)
"Go to group or the next group after group."
["Create" gnus-topic-create-topic t]
["Mark" gnus-topic-mark-topic t]
["Indent" gnus-topic-indent t]
- ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t])
+ ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t]
+ ["Edit parameters" gnus-topic-edit-parameters t])
["List active" gnus-topic-list-active t]))))
(defun gnus-topic-mode (&optional arg redisplay)
(if (null arg) (not gnus-topic-mode)
(> (prefix-numeric-value arg) 0)))
;; Infest Gnus with topics.
- (if (not gnus-topic-mode)
- (setq gnus-goto-missing-group-function nil)
+ (if (not gnus-topic-mode)
+ (setq gnus-goto-missing-group-function nil)
(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
- gnus-topic-line-format-alist t))
- (unless (assq 'gnus-topic-mode minor-mode-alist)
- (push '(gnus-topic-mode " Topic") minor-mode-alist))
- (unless (assq 'gnus-topic-mode minor-mode-map-alist)
- (push (cons 'gnus-topic-mode gnus-topic-mode-map)
- minor-mode-map-alist))
+ (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)
;; We check the topology.
(when gnus-newsrc-alist
(gnus-topic-check-topology))
- (run-hooks 'gnus-topic-mode-hook))
+ (gnus-run-hooks 'gnus-topic-mode-hook))
;; Remove topic infestation.
(unless gnus-topic-mode
(remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
(if (not topic)
(call-interactively 'gnus-group-mark-group)
(save-excursion
- (let ((groups (gnus-topic-find-groups topic 9 t)))
+ (let ((groups (gnus-topic-find-groups topic gnus-level-killed t)))
(while groups
(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
(gnus-info-group (nth 2 (pop groups)))))))))
;; Remove from alist.
(setq gnus-topic-alist (delq entry gnus-topic-alist))
;; Remove from topology.
- (gnus-topic-find-topology topic nil nil 'delete)))
+ (gnus-topic-find-topology topic nil nil 'delete)
+ (gnus-dribble-touch)))
(defun gnus-topic-rename (old-name new-name)
"Rename a topic."
(let ((topic (gnus-current-topic)))
(list topic
(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"))
+ ;; Do the renaming.
(let ((top (gnus-topic-find-topology old-name))
(entry (assoc old-name gnus-topic-alist)))
(when top
(let ((gnus-topic-topology gnus-topic-active-topology)
(gnus-topic-alist gnus-topic-active-alist)
gnus-killed-list gnus-zombie-list)
- (gnus-group-list-groups 9 nil 1)))
+ (gnus-group-list-groups gnus-level-killed nil 1)))
(defun gnus-topic-toggle-display-empty-topics ()
"Show/hide topics that have no unread articles."
(interactive)
(setq gnus-topic-display-empty-topics
(not gnus-topic-display-empty-topics))
+ (gnus-group-list-groups)
(message "%s empty topics"
(if gnus-topic-display-empty-topics
"Showing" "Hiding")))
projects / gnus / blobdiff