X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-topic.el;h=97da766e4b9d5762bb9c665078a65f4c21afb6c5;hb=ed5859e1e7c85dee6841ff01b44bdd132a265de9;hp=108f3bc04bd77529f58036e6d3df4126ef21db2c;hpb=921c6a73e136cfe38e09eab73bb6eb528b7fba4f;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 108f3bc..97da766 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1,5 +1,5 @@ ;;; 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 ;; Lars Magne Ingebrigtsen @@ -149,11 +149,20 @@ with some simple extensions. (gnus-group-topic group)))) (defun gnus-topic-goto-topic (topic) - "Go to TOPIC." (when topic (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-topic (intern topic))))) +(defun gnus-topic-jump-to-topic (topic) + "Go to TOPIC." + (interactive + (list (completing-read "Go to topic: " + (mapcar 'list (gnus-topic-list)) + nil t))) + (dolist (topic (gnus-current-topics topic)) + (gnus-topic-fold t)) + (gnus-topic-goto-topic topic)) + (defun gnus-current-topic () "Return the name of the current topic." (let ((result @@ -361,7 +370,8 @@ If TOPIC, start with that topic." ;;; 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. @@ -416,7 +426,7 @@ articles in the topic and its subtopics." (entries (gnus-topic-find-groups (car type) list-level (or all - (cdr (assq 'visible + (cdr (assq 'visible (gnus-topic-hierarchical-parameters (car type))))) lowest)) @@ -444,7 +454,8 @@ articles in the topic and its subtopics." (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) @@ -505,9 +516,9 @@ articles in the topic and its subtopics." (car gnus-group-list-mode) (cdr gnus-group-list-mode) nil nil topic level)) -(defun gnus-topic-fold (&optional insert) +(defun gnus-topic-fold (&optional insert topic) "Remove/insert the current topic." - (let ((topic (gnus-group-topic-name))) + (let ((topic (or topic (gnus-group-topic-name)))) (when topic (save-excursion (if (not (gnus-group-active-topic-p)) @@ -627,7 +638,7 @@ articles in the topic and its subtopics." (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 @@ -643,11 +654,14 @@ articles in the topic and its subtopics." (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 () @@ -903,6 +917,7 @@ articles in the topic and its subtopics." "=" 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 @@ -912,6 +927,8 @@ articles in the topic and its subtopics." "\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. @@ -924,6 +941,7 @@ articles in the topic and its subtopics." "c" gnus-topic-copy-group "h" gnus-topic-hide-topic "s" gnus-topic-show-topic + "j" gnus-topic-jump-to-topic "M" gnus-topic-move-matching "C" gnus-topic-copy-matching "\C-i" gnus-topic-indent @@ -955,6 +973,7 @@ articles in the topic and its subtopics." ["Copy matching" gnus-topic-copy-matching t] ["Move matching" gnus-topic-move-matching t]) ("Topics" + ["Goto" gnus-topic-jump-to-topic t] ["Show" gnus-topic-show-topic t] ["Hide" gnus-topic-hide-topic t] ["Delete" gnus-topic-delete t] @@ -981,7 +1000,6 @@ articles in the topic and its subtopics." (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) @@ -1035,6 +1053,19 @@ If performed over a topic line, toggle folding the topic." (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