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

   1 ;;; gnus-topic.el --- a folding group mode for Gnus
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Ilja Weis <kult@uni-paderborn.de>
   5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'gnus)
  29
  30 (defvar gnus-group-topic-face 'underline
  31   "*Face used to highlight topic headers.")
  32
  33 (defvar gnus-group-topics '(("misc" "." nil))
  34   "*Alist of newsgroup topics.
  35 This alist has entries of the form
  36
  37    (TOPIC REGEXP SHOW)
  38
  39 where TOPIC is the name of the topic a group is put in if it matches
  40 REGEXP.  A group can only be in one topic at a time.
  41
  42 If SHOW is nil, newsgroups will be inserted according to
  43 `gnus-group-topic-topics-only', otherwise that variable is ignored and
  44 the groups are always shown if SHOW is true or never if SHOW is a
  45 number.")
  46
  47 (defvar gnus-group-topic-topics-only nil
  48   "*If non-nil, only the topics will be shown when typing `l' or `L'.")
  49
  50 ;; Internal variables.
  51
  52 (defvar gnus-topics-not-listed nil)
  53
  54 ;; Functions.
  55
  56 (defun gnus-group-topic-name ()
  57   (get-text-property (gnus-point-at-bol) 'gnus-topic))
  58
  59 (defun gnus-group-prepare-topics (level &optional all lowest regexp)
  60   "List all newsgroups with unread articles of level LEVEL or lower, and
  61 use the `gnus-group-topics' to sort the groups.
  62 If ALL is non-nil, list groups that have no unread articles.
  63 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
  64   (set-buffer gnus-group-buffer)
  65   (let ((buffer-read-only nil)
  66         (lowest (or lowest 1)))
  67
  68     (erase-buffer)
  69
  70     ;; List dead groups?
  71     (and (>= level 8) (<= lowest 8)
  72          (gnus-group-prepare-flat-list-dead
  73           (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 8 ?Z
  74           regexp))
  75
  76     (and (>= level 9) (<= lowest 9)
  77          (gnus-group-prepare-flat-list-dead
  78           (setq gnus-killed-list (sort gnus-killed-list 'string<)) 9 ?K
  79           regexp))
  80
  81     ;; Use topics
  82     (if (< lowest 8)
  83         (let ((topics gnus-group-topics)
  84               topic how)
  85           (erase-buffer)
  86           (while topics
  87             (setq topic (car (car topics))
  88                   how (nth 2 (car topics))
  89                   topics (cdr topics))
  90
  91             (add-text-properties
  92              (point)
  93              (progn
  94                (insert topic "\n")
  95                (point))
  96              (list 'mouse-face gnus-mouse-face
  97                    'face gnus-group-topic-face
  98                    'gnus-topic topic))
  99
 100             (if (and (or (and (not how) (not gnus-group-topic-topics-only))
 101                          (and how (not (numberp how))))
 102                      (not (member topic gnus-topics-not-listed)))
 103                 (gnus-topic-insert-topic topic level all lowest t)
 104               (setq gnus-topics-not-listed
 105                     (cons topic gnus-topics-not-listed)))))))
 106
 107   (gnus-group-set-mode-line)
 108   (setq gnus-group-list-mode (cons level all))
 109   (run-hooks 'gnus-group-prepare-hook))
 110
 111 (defun gnus-topic-insert-topic (topic level &optional all lowest m)
 112   "Insert all groups matching TOPIC with unread articles of level LEVEL or lower.
 113 If ALL is non-nil, list groups that have no unread articles.  If
 114 LOWEST is non-nil, list all newsgroups of level LOWEST or higher.  If
 115 M is non-nil, nothing will be inserted, but only
 116 `gnus-group-listed-topics' will be changed."
 117   (let ((buffer-read-only nil)
 118         (regexp (car (cdr (assoc topic gnus-group-topics))))
 119         (newsrc (cdr gnus-newsrc-alist))
 120         info clevel unread group w)
 121     (setq lowest (or lowest 1))
 122     (while newsrc
 123       (setq info (car newsrc)
 124             group (car info)
 125             newsrc (cdr newsrc)
 126             unread (car (gnus-gethash group gnus-newsrc-hashtb)))
 127       (and unread
 128            (string-match regexp group)
 129            (<= (setq clevel (car (cdr info))) level)
 130            (>= clevel lowest)
 131            (or all
 132                (eq unread t)
 133                (> unread 0)
 134                (cdr (assq 'tick (nth 3 info))))
 135            (progn
 136              (gnus-group-insert-group-line
 137               nil group (car (cdr info)) (nth 3 info) unread
 138               (nth 4 info))
 139              (setq gnus-topics-not-listed
 140                    (delete topic gnus-topics-not-listed)))))))
 141
 142 (defun gnus-topic-remove-topic ()
 143   (let ((topic (gnus-group-topic-name))
 144         buffer-read-only)
 145     (setq gnus-topics-not-listed (cons topic gnus-topics-not-listed))
 146     (forward-line 1)
 147     (delete-region (point)
 148                    (or (next-single-property-change (point) 'gnus-topic)
 149                        (point-max)))))
 150
 151 (defun gnus-topic-fold ()
 152   (let ((topic (gnus-group-topic-name)))
 153     (save-excursion
 154       (if (not (member topic gnus-topics-not-listed))
 155           (gnus-topic-remove-topic)
 156         (forward-line 1)
 157         (gnus-topic-insert-topic
 158          topic (gnus-group-default-level)
 159          (cdr gnus-group-list-mode))))))
 160
 161 ;;; gnus-topic.el ends here