;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(defun gnus-group-topic-name ()
"The name of the topic on the current line."
- (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
+ (let ((topic (get-text-property (point-at-bol) 'gnus-topic)))
(and topic (symbol-name topic))))
(defun gnus-group-topic-level ()
"The level of the topic on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
+ (get-text-property (point-at-bol) 'gnus-topic-level))
(defun gnus-group-topic-unread ()
"The number of unread articles in topic on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
+ (get-text-property (point-at-bol) 'gnus-topic-unread))
(defun gnus-topic-unread (topic)
"Return the number of unread articles in TOPIC."
(defun gnus-topic-visible-p ()
"Return non-nil if the current topic is visible."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
+ (get-text-property (point-at-bol) 'gnus-topic-visible))
(defun gnus-topic-articles-in-topic (entries)
(let ((total 0)
(list (completing-read "Go to topic: "
(mapcar 'list (gnus-topic-list))
nil t)))
- (dolist (topic (gnus-current-topics topic))
- (gnus-topic-goto-topic topic)
- (gnus-topic-fold t))
+ (let ((buffer-read-only nil))
+ (dolist (topic (gnus-current-topics topic))
+ (unless (gnus-topic-goto-topic topic)
+ (gnus-topic-goto-missing-topic topic)
+ (gnus-topic-display-missing-topic topic))))
(gnus-topic-goto-topic topic))
(defun gnus-current-topic ()
(defun gnus-group-active-topic-p ()
"Say whether the current topic comes from the active topics."
- (save-excursion
- (beginning-of-line)
- (get-text-property (point) 'gnus-active)))
+ (get-text-property (point-at-bol) 'gnus-active))
(defun gnus-topic-find-groups (topic &optional level all lowest recursive)
"Return entries for all visible groups in TOPIC.
;; We go through the newsrc to look for matches.
(while groups
(when (setq group (pop groups))
- (setq entry (gnus-gethash group gnus-newsrc-hashtb)
+ (setq entry (gnus-group-entry group)
info (nth 2 entry)
params (gnus-info-params info)
active (gnus-active group)
(defun gnus-topic-hierarchical-parameters (topic)
"Return a topic list computed for TOPIC."
- (let ((topics (gnus-current-topics topic))
- params-list param out params)
- (while topics
- (push (gnus-topic-parameters (pop topics)) params-list))
+ (let ((params-list (nreverse (mapcar 'gnus-topic-parameters
+ (gnus-current-topics topic))))
+ param out params)
;; We probably have lots of nil elements here, so
;; we remove them. Probably faster than doing this "properly".
(setq params-list (delq nil params-list))
(copy-sequence gnus-group-listed-groups))))
(gnus-update-format-specifications nil 'topic)
-
+
(when (or (not gnus-topic-alist)
(not gnus-topology-checked-p))
(gnus-topic-check-topology))
(gnus-make-hashtable-from-killed))
(gnus-group-prepare-flat-list-dead
(gnus-remove-if (lambda (group)
- (or (gnus-gethash group gnus-newsrc-hashtb)
+ (or (gnus-group-entry group)
(gnus-gethash group gnus-killed-hashtb)))
not-in-list)
gnus-level-killed ?K regexp)))
(not (eq (nth 2 type) 'hidden))
level all-entries unread))
(gnus-topic-update-unreads (car type) unread)
+ (when gnus-group-update-tool-bar
+ (gnus-put-text-property beg end 'point-entered
+ 'gnus-tool-bar-update)
+ (gnus-put-text-property beg end 'point-left
+ 'gnus-tool-bar-update))
(goto-char end)
unread))
(not (gnus-topic-goto-topic (caaar tp))))
(pop tp))
(if tp
- (forward-line 1)
+ (gnus-topic-forward-topic 1)
(gnus-topic-goto-missing-topic (caadr top)))))
nil))
(pop topics)))
;; Go through all living groups and make sure that
;; they belong to some topic.
- (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
- gnus-topic-alist)))
+ (let* ((tgroups (apply 'append (mapcar 'cdr gnus-topic-alist)))
(entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist)))
(newsrc (cdr gnus-newsrc-alist))
group)
(while (setq topic (pop alist))
(while (cdr topic)
(if (and (cadr topic)
- (gnus-gethash (cadr topic) gnus-newsrc-hashtb))
+ (gnus-group-entry (cadr topic)))
(setq topic (cdr topic))
(setcdr topic (cddr topic)))))))
(let ((topic-name (pop topic))
group filtered-topic)
(while (setq group (pop topic))
- (when (and (or (gnus-gethash group gnus-active-hashtb)
+ (when (and (or (gnus-active group)
(gnus-info-method (gnus-get-info group)))
(not (gnus-gethash group gnus-killed-hashtb)))
(push group filtered-topic)))
(when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
- (gnus-add-minor-mode 'gnus-topic-mode " Topic"
- gnus-topic-mode-map nil (lambda (&rest junk)
- (interactive)
- (gnus-topic-mode nil t)))
+ (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)
(add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
(set (make-local-variable 'gnus-group-prepare-function)
'gnus-group-prepare-topics)
(let ((use-marked (and (not n) (not (gnus-region-active-p))
gnus-group-marked t))
(groups (gnus-group-process-prefix n)))
- (mapcar
+ (mapc
(lambda (group)
(gnus-group-remove-mark group use-marked)
(let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
(if (gnus-topic-find-topology to current-top 0);; Don't care the level
(error "Can't move `%s' to its sub-level" current))
(gnus-topic-find-topology current nil nil 'delete)
- (while (cdr to-top)
- (setq to-top (cdr to-top)))
- (setcdr to-top (list current-top))
+ (setcdr (last to-top) (list current-top))
(gnus-topic-enter-dribble)
(gnus-group-list-groups)
(gnus-topic-goto-topic current)))
(provide 'gnus-topic)
+;;; arch-tag: bf176856-f30c-40f0-ae77-e41529a1134c
;;; gnus-topic.el ends here