;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(when recursive
(if (eq recursive t)
(setq recursive (cdr (gnus-topic-find-topology topic))))
- (mapcar (lambda (topic-topology)
- (setq visible-groups
- (nconc visible-groups
- (gnus-topic-find-groups
- (caar topic-topology)
- level all lowest topic-topology))))
- (cdr recursive)))
+ (dolist (topic-topology (cdr recursive))
+ (setq visible-groups
+ (nconc visible-groups
+ (gnus-topic-find-groups
+ (caar topic-topology)
+ level all lowest topic-topology)))))
visible-groups))
(defun gnus-topic-goto-previous-topic (n)
(setq topology gnus-topic-topology
gnus-tmp-topics nil))
(push (caar topology) gnus-tmp-topics)
- (mapcar 'gnus-topic-list (cdr topology))
+ (mapc 'gnus-topic-list (cdr topology))
gnus-tmp-topics)
;;; Topic parameter jazz
(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."
+ "Compute the group parameters for GROUP in topic mode.
+Possibly inherit parameters from topics above GROUP."
(let ((params-list (copy-sequence (gnus-group-get-parameter group))))
(save-excursion
- (nconc params-list
- (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."
- (let ((params-list (nreverse (mapcar 'gnus-topic-parameters
- (gnus-current-topics 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))
+ params-list))))
+
+(defun gnus-topic-hierarchical-parameters (topic &optional group-params-list)
+ "Compute the topic parameters for TOPIC.
+Possibly inherit parameters from topics above TOPIC.
+If optional argument GROUP-PARAMS-LIST is non-nil, use it as the basis for
+inheritance."
+ (let ((params-list
+ ;; We probably have lots of nil elements here, so we remove them.
+ ;; Probably faster than doing this "properly".
+ (delq nil (cons group-params-list
+ (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))
;; Now we have all the parameters, so we go through them
;; and do inheritance in the obvious way.
- (while (setq params (pop params-list))
- (while (setq param (pop params))
- (when (atom param)
- (setq param (cons param t)))
- ;; Override any old versions of this param.
- (gnus-pull (car param) out)
- (push param out)))
+ (let (posting-style)
+ (while (setq params (pop params-list))
+ (while (setq param (pop params))
+ (when (atom param)
+ (setq param (cons param t)))
+ (cond ((eq (car param) 'posting-style)
+ (let ((param (cdr param))
+ elt)
+ (while (setq elt (pop param))
+ (unless (assoc (car elt) posting-style)
+ (push elt posting-style)))))
+ (t
+ (unless (assq (car param) out)
+ (push param out))))))
+ (and posting-style (push (cons 'posting-style posting-style) out)))
;; Return the resulting parameter list.
out))
entry)
(if (and (not groups) (not copyp) start-topic)
(gnus-topic-move start-topic topic)
- (mapcar
- (lambda (g)
- (gnus-group-remove-mark g use-marked)
- (when (and
- (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
- (not copyp))
- (setcdr entry (gnus-delete-first g (cdr entry))))
- (nconc topicl (list g)))
- groups)
+ (dolist (g groups)
+ (gnus-group-remove-mark g use-marked)
+ (when (and
+ (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
+ (not copyp))
+ (setcdr entry (gnus-delete-first g (cdr entry))))
+ (nconc topicl (list g)))
(gnus-topic-enter-dribble)
(if start-group
(gnus-group-goto-group start-group)