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

   1 ;;; gnus-registry.el --- article registry for Gnus
   2
   3 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
   4 ;;; Free Software Foundation, Inc.
   5
   6 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
   7 ;; Keywords: news registry
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This is the gnus-registry.el package, which works with all
  27 ;; backends, not just nnmail (e.g. NNTP).  The major issue is that it
  28 ;; doesn't go across backends, so for instance if an article is in
  29 ;; nnml:sys and you see a reference to it in nnimap splitting, the
  30 ;; article will end up in nnimap:sys
  31
  32 ;; gnus-registry.el intercepts article respooling, moving, deleting,
  33 ;; and copying for all backends.  If it doesn't work correctly for
  34 ;; you, submit a bug report and I'll be glad to fix it.  It needs
  35 ;; documentation in the manual (also on my to-do list).
  36
  37 ;; Put this in your startup file (~/.gnus.el for instance)
  38
  39 ;; (setq gnus-registry-max-entries 2500
  40 ;;       gnus-registry-use-long-group-names t)
  41
  42 ;; (gnus-registry-initialize)
  43
  44 ;; Then use this in your fancy-split:
  45
  46 ;; (: gnus-registry-split-fancy-with-parent)
  47
  48 ;; TODO:
  49
  50 ;; - get the correct group on spool actions
  51
  52 ;; - articles that are spooled to a different backend should be handled
  53
  54 ;;; Code:
  55
  56 (eval-when-compile (require 'cl))
  57
  58 (require 'gnus)
  59 (require 'gnus-int)
  60 (require 'gnus-sum)
  61 (require 'gnus-util)
  62 (require 'nnmail)
  63 (require 'easymenu)
  64
  65 (defvar gnus-adaptive-word-syntax-table)
  66
  67 (defvar gnus-registry-dirty t
  68  "Boolean set to t when the registry is modified")
  69
  70 (defgroup gnus-registry nil
  71   "The Gnus registry."
  72   :version "22.1"
  73   :group 'gnus)
  74
  75 (defvar gnus-registry-hashtb (make-hash-table
  76                               :size 256
  77                               :test 'equal)
  78   "*The article registry by Message ID.")
  79
  80 (defcustom gnus-registry-marks
  81   '((Important
  82      :char ?i
  83      :image "summary_important")
  84     (Work
  85      :char ?w
  86      :image "summary_work")
  87     (Personal
  88      :char ?p
  89      :image "summary_personal")
  90     (To-Do
  91      :char ?t
  92      :image "summary_todo")
  93     (Later
  94      :char ?l
  95      :image "summary_later"))
  96
  97   "List of registry marks and their options.
  98
  99 `gnus-registry-mark-article' will offer symbols from this list
 100 for completion.
 101
 102 Each entry must have a character to be useful for summary mode
 103 line display and for keyboard shortcuts.
 104
 105 Each entry must have an image string to be useful for visual
 106 display."
 107   :group 'gnus-registry
 108   :type '(repeat :tag "Registry Marks"
 109                  (cons :tag "Mark"
 110                        (symbol :tag "Name")
 111                        (checklist :tag "Options" :greedy t
 112                                   (group :inline t
 113                                          (const :format "" :value :char)
 114                                          (character :tag "Character code"))
 115                                   (group :inline t
 116                                          (const :format "" :value :image)
 117                                          (string :tag "Image"))))))
 118
 119 (defcustom gnus-registry-default-mark 'To-Do
 120   "The default mark.  Should be a valid key for `gnus-registry-marks'."
 121   :group 'gnus-registry
 122   :type 'symbol)
 123
 124 (defcustom gnus-registry-unfollowed-groups
 125   '("delayed$" "drafts$" "queue$" "INBOX$")
 126   "List of groups that gnus-registry-split-fancy-with-parent won't return.
 127 The group names are matched, they don't have to be fully
 128 qualified.  This parameter tells the Registry 'never split a
 129 message into a group that matches one of these, regardless of
 130 references.'"
 131   :group 'gnus-registry
 132   :type '(repeat regexp))
 133
 134 (defcustom gnus-registry-install 'ask
 135   "Whether the registry should be installed."
 136   :group 'gnus-registry
 137   :type '(choice (const :tag "Never Install" nil)
 138                  (const :tag "Always Install" t)
 139                  (const :tag "Ask Me" ask)))
 140
 141 (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
 142
 143 (defvar gnus-registry-misc-menus nil)   ; ugly way to keep the menus
 144
 145 (defcustom gnus-registry-clean-empty t
 146   "Whether the empty registry entries should be deleted.
 147 Registry entries are considered empty when they have no groups
 148 and no extra data."
 149   :group 'gnus-registry
 150   :type 'boolean)
 151
 152 (defcustom gnus-registry-use-long-group-names t
 153   "Whether the registry should use long group names."
 154   :group 'gnus-registry
 155   :type 'boolean)
 156
 157 (defcustom gnus-registry-max-track-groups 20
 158   "The maximum number of non-unique group matches to check for a message ID."
 159   :group 'gnus-registry
 160   :type '(radio (const :format "Unlimited " nil)
 161                 (integer :format "Maximum non-unique matches: %v")))
 162
 163 (defcustom gnus-registry-track-extra nil
 164   "Whether the registry should track extra data about a message.
 165 The Subject and Sender (From:) headers are currently tracked this
 166 way."
 167   :group 'gnus-registry
 168   :type
 169   '(set :tag "Tracking choices"
 170     (const :tag "Track by subject (Subject: header)" subject)
 171     (const :tag "Track by sender (From: header)"  sender)))
 172
 173 (defcustom gnus-registry-split-strategy nil
 174   "Whether the registry should track extra data about a message.
 175 The Subject and Sender (From:) headers are currently tracked this
 176 way."
 177   :group 'gnus-registry
 178   :type
 179   '(choice :tag "Tracking choices"
 180            (const :tag "Only use single choices, discard multiple matches" nil)
 181            (const :tag "Majority of matches wins" majority)
 182            (const :tag "First found wins"  first)))
 183
 184 (defcustom gnus-registry-entry-caching t
 185   "Whether the registry should cache extra information."
 186   :group 'gnus-registry
 187   :type 'boolean)
 188
 189 (defcustom gnus-registry-minimum-subject-length 5
 190   "The minimum length of a subject before it's considered trackable."
 191   :group 'gnus-registry
 192   :type 'integer)
 193
 194 (defcustom gnus-registry-trim-articles-without-groups t
 195   "Whether the registry should clean out message IDs without groups."
 196   :group 'gnus-registry
 197   :type 'boolean)
 198
 199 (defcustom gnus-registry-extra-entries-precious '(marks)
 200   "What extra entries are precious, meaning they won't get trimmed.
 201 When you save the Gnus registry, it's trimmed to be no longer
 202 than `gnus-registry-max-entries' (which is nil by default, so no
 203 trimming happens).  Any entries with extra data in this list (by
 204 default, marks are included, so articles with marks are
 205 considered precious) will not be trimmed."
 206   :group 'gnus-registry
 207   :type '(repeat symbol))
 208
 209 (defcustom gnus-registry-cache-file