gnus-checker.el

   1 ;;; gnus-checker.el --- Mode line mail indicator for gnus
   2
   3 ;; Copyright (C) 2008 Philip Jackson
   4
   5 ;; Author: Philip Jackson <phil@shellarchive.co.uk>
   6
   7 ;; This file is not currently part of GNU Emacs.
   8
   9 ;; This program is free software; you can redistribute it and/or
  10 ;; modify it under the terms of the GNU General Public License as
  11 ;; published by the Free Software Foundation; either version 2, or (at
  12 ;; your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program ; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Set `gnus-checker-groups' to an alist of (group . face) pairs and
  27 ;; then you will get an indicator for those groups in their respective
  28 ;; faces.
  29
  30 ;; for example:
  31
  32 ;; (setq gnus-checker-groups
  33 ;;       '(("nnmaildir:inbox" . font-lock-warning-face)
  34 ;;         ("nnmaildir:porn-casting" . font-lock-too-small-face)))
  35
  36 (defvar gnus-checker-groups '())
  37
  38 (defvar gnus-checker-mode-string ""
  39   "The string to display in the modeline")
  40
  41 (defun gnus-checker-modeline-entry ()
  42   (when (length gnus-checker-groups)
  43     (concat "["
  44             (mapconcat
  45              (lambda (g)
  46                (let ((unread (number-to-string
  47                               (or (gnus-group-unread (car g)) 0))))
  48                  (propertize unread 'face (cdr g))))
  49              gnus-checker-groups " ")
  50             "] ")))
  51
  52 (defun gnus-checker-add-to-modeline ()
  53   (unless (memq 'gnus-checker-mode-string global-mode-string)
  54     (put 'gnus-checker-mode-string 'risky-local-variable t)
  55     (setcdr global-mode-string
  56             (cons 'gnus-checker-mode-string (cdr global-mode-string)))))
  57
  58 ;; startup
  59 (add-hook 'gnus-started-hook
  60           (lambda ()
  61             (setq gnus-checker-mode-string
  62              (gnus-checker-modeline-entry))
  63              (gnus-checker-add-to-modeline)))
  64
  65 ;; update the string after fetch
  66 (add-hook 'gnus-after-getting-new-news-hook
  67           (lambda ()
  68             (setq gnus-checker-mode-string
  69              (gnus-checker-modeline-entry))))
  70
  71 ;; remove it from the modeline
  72 (add-hook 'gnus-exit-gnus-hook
  73           (lambda ()
  74             (delete 'gnus-checker-mode-string
  75              global-mode-string)))
  76
  77 ;; this will reset the values when a group is exited
  78 (add-hook 'gnus-summary-exit-hook
  79           (lambda ()
  80             (setq gnus-checker-mode-string
  81              (gnus-checker-modeline-entry))))
  82
  83 (provide 'gnus-checker)