cgit.sxemacs.org Git - gnus/blob - lisp/gnus-topic.el

   1 ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   4 ;;   2004, 2005, 2006 Free Software Foundation, Inc.
   5
   6 ;; Author: Ilja Weis <kult@uni-paderborn.de>
   7 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
   8 ;; Keywords: news
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (eval-when-compile (require 'cl))
  32
  33 (require 'gnus)
  34 (require 'gnus-group)
  35 (require 'gnus-start)
  36 (require 'gnus-util)
  37
  38 (defgroup gnus-topic nil
  39   "Group topics."
  40   :group 'gnus-group)
  41
  42 (defvar gnus-topic-mode nil
  43   "Minor mode for Gnus group buffers.")
  44
  45 (defcustom gnus-topic-mode-hook nil
  46   "Hook run in topic mode buffers."
  47   :type 'hook
  48   :group 'gnus-topic)
  49
  50 (when (featurep 'xemacs)
  51   (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add))
  52
  53 (defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
  54   "Format of topic lines.
  55 It works along the same lines as a normal formatting string,
  56 with some simple extensions.
  57
  58 %i  Indentation based on topic level.
  59 %n  Topic name.
  60 %v  Nothing if the topic is visible, \"...\" otherwise.
  61 %g  Number of groups in the topic.
  62 %a  Number of unread articles in the groups in the topic.
  63 %A  Number of unread articles in the groups in the topic and its subtopics.
  64
  65 General format specifiers can also be used.
  66 See Info node `(gnus)Formatting Variables'."
  67   :link '(custom-manual "(gnus)Formatting Variables")
  68   :type 'string
  69   :group 'gnus-topic)
  70
  71 (defcustom gnus-topic-indent-level 2
  72   "*How much each subtopic should be indented."
  73   :type 'integer
  74   :group 'gnus-topic)
  75
  76 (defcustom gnus-topic-display-empty-topics t
  77   "*If non-nil, display the topic lines even of topics that have no unread articles."
  78   :type 'boolean
  79   :group 'gnus-topic)
  80
  81 ;; Internal variables.
  82
  83 (defvar gnus-topic-active-topology nil)
  84 (defvar gnus-topic-active-alist nil)
  85 (defvar gnus-topic-unreads nil)
  86
  87 (defvar gnus-topology-checked-p nil
  88   "Whether the topology has been checked in this session.")
  89
  90 (defvar gnus-topic-killed-topics nil)
  91 (defvar gnus-topic-inhibit-change-level nil)
  92
  93 (defconst gnus-topic-line-format-alist
  94   `((?n name ?s)
  95     (?v visible ?s)
  96     (?i indentation ?s)
  97     (?g number-of-groups ?d)
  98     (?a (gnus-topic-articles-in-topic entries) ?d)
  99     (?A total-number-of-articles ?d)
 100     (?l level ?d)))
 101
 102 (defvar gnus-topic-line-format-spec nil)
 103
 104 ;;; Utility functions
 105
 106 (defun gnus-group-topic-name ()
 107   "The name of the topic on the current line."
 108   (let ((topic (get-text-property (point-at-bol) 'gnus-topic)))
 109     (and topic (symbol-name topic))))
 110
 111 (defun gnus-group-topic-level ()
 112   "The level of the topic on the current line."
 113   (get-text-property (point-at-bol) 'gnus-topic-level))
 114
 115 (defun gnus-group-topic-unread ()
 116   "The number of unread articles in topic on the current line."
 117   (get-text-property (point-at-bol) 'gnus-topic-unread))
 118
 119 (defun gnus-topic-unread (topic)
 120   "Return the number of unread articles in TOPIC."
 121   (or (cdr (assoc topic gnus-topic-unreads))
 122       0))
 123
 124 (defun gnus-group-topic-p ()
 125   "Return non-nil if the current line is a topic."
 126   (gnus-group-topic-name))
 127
 128 (defun gnus-topic-visible-p ()
 129   "Return non-nil if the current topic is visible."
 130   (get-text-property (point-at-bol) 'gnus-topic-visible))
 131
 132 (defun gnus-topic-articles-in-topic (entries)
 133   (let ((total 0)
 134         number)
 135     (while entries
 136       (when (numberp (setq number (car (pop entries))))
 137         (incf total number)))
 138     total))
 139
 140 (defun gnus-group-topic (group)
 141   "Return the topic GROUP is a member of."
 142   (let ((alist gnus-topic-alist)
 143         out)
 144     (while alist
 145       (when (member group (cdar alist))
 146         (setq out (caar alist)
 147               alist nil))
 148       (setq alist (cdr alist)))
 149     out))
 150
 151 (defun gnus-group-parent-topic (group)
 152   "Return the topic GROUP is member of by looking at the group buffer."
 153   (save-excursion
 154     (set-buffer gnus-group-buffer)
 155     (if (gnus-group-goto-group group)
 156         (gnus-current-topic)
 157       (gnus-group-topic group))))
 158
 159 (defun gnus-topic-goto-topic (topic)