;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
%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.
-"
+
+General format specifiers can also be used.
+See Info node `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
:type 'string
:group 'gnus-topic)
(mapcar 'list (gnus-topic-list))
nil t)))
(dolist (topic (gnus-current-topics topic))
+ (gnus-topic-goto-topic topic)
(gnus-topic-fold t))
(gnus-topic-goto-topic topic))
"Return entries for all visible groups in TOPIC.
If RECURSIVE is t, return groups in its subtopics too."
(let ((groups (cdr (assoc topic gnus-topic-alist)))
- info clevel unread group params visible-groups entry active)
+ info clevel unread group params visible-groups entry active)
(setq lowest (or lowest 1))
(setq level (or level gnus-level-unsubscribed))
;; We go through the newsrc to look for matches.
(cdr recursive)))
visible-groups))
+(defun gnus-topic-goto-previous-topic (n)
+ "Go to the N'th previous topic."
+ (interactive "p")
+ (gnus-topic-goto-next-topic (- n)))
+
+(defun gnus-topic-goto-next-topic (n)
+ "Go to the N'th next topic."
+ (interactive "p")
+ (let ((backward (< n 0))
+ (n (abs n))
+ (topic (gnus-current-topic)))
+ (while (and (> n 0)
+ (setq topic
+ (if backward
+ (gnus-topic-previous-topic topic)
+ (gnus-topic-next-topic topic))))
+ (gnus-topic-goto-topic topic)
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more topics"))
+ n))
+
(defun gnus-topic-previous-topic (topic)
"Return the previous topic on the same level as TOPIC."
(let ((top (cddr (gnus-topic-find-topology
"Compute the group parameters for GROUP taking into account inheritance from topics."
(let ((params-list (copy-sequence (gnus-group-get-parameter group))))
(save-excursion
- (gnus-group-goto-group group)
(nconc params-list
- (gnus-topic-hierarchical-parameters (gnus-current-topic))))))
+ (gnus-topic-hierarchical-parameters
+ ;; First we try to go to the group within the group
+ ;; buffer and find the topic for the group that way.
+ ;; This hopefully copes well with groups that are in
+ ;; more than one topic. Failing that (i.e. when the
+ ;; group isn't visible in the group buffer) we find a
+ ;; topic for the group via gnus-group-topic.
+ (or (and (gnus-group-goto-group group)
+ (gnus-current-topic))
+ (gnus-group-topic group)))))))
(defun gnus-topic-hierarchical-parameters (topic)
"Return a topic list computed for TOPIC."
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
(set-buffer gnus-group-buffer)
(let ((buffer-read-only nil)
- (lowest (or lowest 1))
+ (lowest (or lowest 1))
(not-in-list
(and gnus-group-listed-groups
(copy-sequence gnus-group-listed-groups))))
(and (>= level gnus-level-killed)
(<= lowest gnus-level-killed)))
(gnus-group-prepare-flat-list-dead
- (gnus-union
- (and not-in-list
- (gnus-delete-if (lambda (group)
- (< (gnus-group-level group) gnus-level-killed))
- not-in-list))
- (setq gnus-killed-list (sort gnus-killed-list 'string<)))
- gnus-level-killed ?K
- regexp))
+ (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ gnus-level-killed ?K regexp)
+ (when not-in-list
+ (unless gnus-killed-hashtb
+ (gnus-make-hashtable-from-killed))
+ (gnus-group-prepare-flat-list-dead
+ (gnus-delete-if (lambda (group)
+ (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-gethash group gnus-killed-hashtb)))
+ not-in-list)
+ gnus-level-killed ?K regexp)))
;; Use topics.
(prog1
(when (and (eq major-mode 'gnus-group-mode)
gnus-topic-mode)
(let ((group (gnus-group-group-name))
- (m (point-marker))
+ (m (point-marker))
(buffer-read-only nil))
(when (and group
(gnus-get-info group)
(unfound t)
entry)
;; Try to jump to a visible group.
- (while (and g (not (gnus-group-goto-group (car g) t)))
+ (while (and g
+ (not (gnus-group-goto-group (car g) t)))
(pop g))
;; It wasn't visible, so we try to see where to insert it.
(when (not g)
(when (and unfound
topic
(not (gnus-topic-goto-missing-topic topic)))
- (let* ((top (gnus-topic-find-topology topic))
- (children (cddr top))
- (type (cadr top))
- (unread 0)
- (entries (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode))))
- (while children
- (incf unread (gnus-topic-unread (caar (pop children)))))
- (while (setq entry (pop entries))
- (when (numberp (car entry))
- (incf unread (car entry))))
- (gnus-topic-insert-topic-line
- topic t t (car (gnus-topic-find-topology topic)) nil unread))))))
+ (gnus-topic-display-missing-topic topic)))))
+
+(defun gnus-topic-display-missing-topic (topic)
+ "Insert topic lines recursively for missing topics."
+ (let ((parent (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic))))
+ (when (and parent
+ (not (gnus-topic-goto-missing-topic (caadr parent))))
+ (gnus-topic-display-missing-topic (caadr parent))))
+ (gnus-topic-goto-missing-topic topic)
+ (let* ((top (gnus-topic-find-topology topic))
+ (children (cddr top))
+ (type (cadr top))
+ (unread 0)
+ (entries (gnus-topic-find-groups
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode)))
+ entry)
+ (while children
+ (incf unread (gnus-topic-unread (caar (pop children)))))
+ (while (setq entry (pop entries))
+ (when (numberp (car entry))
+ (incf unread (car entry))))
+ (gnus-topic-insert-topic-line
+ topic t t (car (gnus-topic-find-topology topic)) nil unread)))
(defun gnus-topic-goto-missing-topic (topic)
(if (gnus-topic-goto-topic topic)
"\r" gnus-topic-select-group
" " gnus-topic-read-group
"\C-c\C-x" gnus-topic-expire-articles
+ "c" gnus-topic-catchup-articles
"\C-k" gnus-topic-kill-group
"\C-y" gnus-topic-yank-group
"\M-g" gnus-topic-get-new-news-this-topic
"j" gnus-topic-jump-to-topic
"M" gnus-topic-move-matching
"C" gnus-topic-copy-matching
+ "\M-p" gnus-topic-goto-previous-topic
+ "\M-n" gnus-topic-goto-next-topic
"\C-i" gnus-topic-indent
[tab] gnus-topic-indent
"r" gnus-topic-rename
"a" gnus-topic-sort-groups-by-alphabet
"u" gnus-topic-sort-groups-by-unread
"l" gnus-topic-sort-groups-by-level
+ "e" gnus-topic-sort-groups-by-server
"v" gnus-topic-sort-groups-by-score
"r" gnus-topic-sort-groups-by-rank
"m" gnus-topic-sort-groups-by-method))
'("Topics"
["Toggle topics" gnus-topic-mode t]
("Groups"
- ["Copy" gnus-topic-copy-group t]
- ["Move" gnus-topic-move-group t]
+ ["Copy..." gnus-topic-copy-group t]
+ ["Move..." gnus-topic-move-group t]
["Remove" gnus-topic-remove-group t]
- ["Copy matching" gnus-topic-copy-matching t]
+ ["Copy matching..." gnus-topic-copy-matching t]
["Move matching" gnus-topic-move-matching t])
("Topics"
- ["Goto" gnus-topic-jump-to-topic t]
+ ["Goto..." gnus-topic-jump-to-topic t]
["Show" gnus-topic-show-topic t]
["Hide" gnus-topic-hide-topic t]
["Delete" gnus-topic-delete t]
- ["Rename" gnus-topic-rename t]
- ["Create" gnus-topic-create-topic t]
+ ["Rename..." gnus-topic-rename t]
+ ["Create..." gnus-topic-create-topic t]
["Mark" gnus-topic-mark-topic t]
["Indent" gnus-topic-indent t]
["Sort" gnus-topic-sort-topics t]
+ ["Previous topic" gnus-topic-goto-previous-topic t]
+ ["Next topic" gnus-topic-goto-next-topic 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]))))
(> (prefix-numeric-value arg) 0)))
;; Infest Gnus with topics.
(if (not gnus-topic-mode)
- (setq gnus-goto-missing-group-function nil)
+ (setq gnus-goto-missing-group-function nil)
(when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
(setq gnus-group-change-level-function 'gnus-topic-change-level)
(setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
(make-local-hook 'gnus-check-bogus-groups-hook)
- (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
+ (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist
+ nil 'local)
(setq gnus-topology-checked-p nil)
;; We check the topology.
(when gnus-newsrc-alist
(defun gnus-topic-select-group (&optional all)
"Select this newsgroup.
No article is selected automatically.
+If the group is opened, just switch the summary buffer.
If ALL is non-nil, already read articles become readable.
If ALL is a number, fetch this number of articles.
(gnus-group-expire-articles nil))
(gnus-message 5 "Expiring groups in %s...done" topic))))
+(defun gnus-topic-catchup-articles (topic)
+ "Catchup this topic or group.
+Also see `gnus-group-catchup'."
+ (interactive (list (gnus-group-topic-name)))
+ (if (not topic)
+ (call-interactively 'gnus-group-catchup-current)
+ (save-excursion
+ (let* ((groups
+ (mapcar (lambda (entry) (car (nth 2 entry)))
+ (gnus-topic-find-groups topic gnus-level-killed t)))
+ (buffer-read-only nil)
+ (gnus-group-marked groups))
+ (gnus-group-catchup-current)
+ (mapcar 'gnus-topic-update-topics-containing-group groups)))))
+
(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
If COPYP, copy the groups instead."
(interactive
(list current-prefix-arg
- (completing-read "Move to topic: " gnus-topic-alist nil t)))
+ (gnus-completing-read "Move to topic" gnus-topic-alist nil t
+ 'gnus-topic-history)))
(let ((use-marked (and (not n) (not (gnus-region-active-p))
gnus-group-marked t))
(groups (gnus-group-process-prefix n))
(interactive "P")
(if (not (gnus-group-topic-p))
(gnus-group-get-new-news-this-group n)
- (gnus-topic-mark-topic (gnus-group-topic-name) nil (and n t))
- (gnus-group-get-new-news-this-group)))
+ (let* ((topic (gnus-group-topic-name))
+ (data (cadr (gnus-topic-find-topology topic))))
+ (save-excursion
+ (gnus-topic-mark-topic topic nil (and n t))
+ (gnus-group-get-new-news-this-group))
+ (gnus-topic-remove-topic (eq 'visible (cadr data))))))
(defun gnus-topic-move-matching (regexp topic &optional copyp)
"Move all groups that match REGEXP to some topic."
(interactive
(let ((topic (gnus-current-topic)))
(list topic
- (read-string (format "Rename %s to: " topic)))))
+ (read-string (format "Rename %s to: " topic) topic))))
;; Check whether the new name exists.
(when (gnus-topic-find-topology new-name)
(error "Topic '%s' already exists" new-name))
(gnus-topic-kill-group)
(push (cdar gnus-topic-killed-topics) gnus-topic-alist)
(gnus-topic-create-topic
- topic parent nil (cdaar gnus-topic-killed-topics))
+ topic parent nil (cdar (car gnus-topic-killed-topics)))
(pop gnus-topic-killed-topics)
(or (gnus-topic-goto-topic topic)
(gnus-topic-goto-topic parent))))))
(push (cdar gnus-topic-killed-topics) gnus-topic-alist)
(gnus-topic-create-topic
topic grandparent (gnus-topic-next-topic parent)
- (cdaar gnus-topic-killed-topics))
+ (cdar (car gnus-topic-killed-topics)))
(pop gnus-topic-killed-topics)
(gnus-topic-goto-topic topic))))
(interactive "P")
(gnus-topic-sort-groups 'gnus-group-sort-by-method reverse))
+(defun gnus-topic-sort-groups-by-server (&optional reverse)
+ "Sort the current topic alphabetically by server name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-server reverse))
+
(defun gnus-topic-sort-topics-1 (top reverse)
(if (cdr top)
(let ((subtop
- (mapcar `(lambda (top)
- (gnus-topic-sort-topics-1 top ,reverse))
+ (mapcar (gnus-byte-compile
+ `(lambda (top)
+ (gnus-topic-sort-topics-1 top ,reverse)))
(sort (cdr top)
- '(lambda (t1 t2)
- (string-lessp (caar t1) (caar t2)))))))
+ (lambda (t1 t2)
+ (string-lessp (caar t1) (caar t2)))))))
(setcdr top (if reverse (reverse subtop) subtop))))
top)
(defun gnus-topic-sort-topics (&optional topic reverse)
- "Sort topics in TOPIC alphabeticaly by topic name.
+ "Sort topics in TOPIC alphabetically by topic name.
If REVERSE, reverse the sorting order."
(interactive
(list (completing-read "Sort topics in : " gnus-topic-alist nil t
(gnus-subscribe-alphabetically newsgroup)
;; Add the group to the topic.
(nconc (assoc topic gnus-topic-alist) (list newsgroup))
- (throw 'end t))))))
+ ;; if this topic specifies a default level, use it
+ (let ((subscribe-level (cdr (assq 'subscribe-level
+ (gnus-topic-parameters topic)))))
+ (when subscribe-level
+ (gnus-group-change-level newsgroup subscribe-level
+ gnus-level-default-subscribed)))
+ (throw 'end t)))
+ nil)))
(provide 'gnus-topic)
projects / gnus / blobdiff