annotate lisp/gnus/gnus-registry.el @ 95329:3bf215f97a31

(vc-string-prefix-p): New function. (vc-dir-parent-marked-p): Use it.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Tue, 27 May 2008 01:13:25 +0000
parents e6e8d9b7ab7d
children c3512b2085a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1 ;;; gnus-registry.el --- article registry for Gnus
64754
fafd692d1e40 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64085
diff changeset
2
94748
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
3 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
4 ;;; Free Software Foundation, Inc.
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
5
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
6 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
94748
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
7 ;; Keywords: news registry
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
8
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
10
94662
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94451
diff changeset
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
94662
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94451
diff changeset
13 ;; the Free Software Foundation, either version 3 of the License, or
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94451
diff changeset
14 ;; (at your option) any later version.
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
15
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
94662
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94451
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
20
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
94662
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94451
diff changeset
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
23
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
24 ;;; Commentary:
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
25
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
26 ;; This is the gnus-registry.el package, which works with all
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
27 ;; backends, not just nnmail (e.g. NNTP). The major issue is that it
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
28 ;; doesn't go across backends, so for instance if an article is in
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
29 ;; nnml:sys and you see a reference to it in nnimap splitting, the
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
30 ;; article will end up in nnimap:sys
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
31
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
32 ;; gnus-registry.el intercepts article respooling, moving, deleting,
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
33 ;; and copying for all backends. If it doesn't work correctly for
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
34 ;; you, submit a bug report and I'll be glad to fix it. It needs
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
35 ;; documentation in the manual (also on my to-do list).
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
36
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
37 ;; Put this in your startup file (~/.gnus.el for instance)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
38
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
39 ;; (setq gnus-registry-max-entries 2500
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
40 ;; gnus-registry-use-long-group-names t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
41
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
42 ;; (gnus-registry-initialize)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
43
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
44 ;; Then use this in your fancy-split:
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
45
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
46 ;; (: gnus-registry-split-fancy-with-parent)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
47
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
48 ;; TODO:
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
49
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
50 ;; - get the correct group on spool actions
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
51
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
52 ;; - articles that are spooled to a different backend should be handled
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
53
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
54 ;;; Code:
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
55
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
56 (eval-when-compile (require 'cl))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
57
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
58 (require 'gnus)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
59 (require 'gnus-int)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
60 (require 'gnus-sum)
73269
aeb79612dc36 Merge from gnus--rel--5.10
Miles Bader <miles@gnu.org>
parents: 68633
diff changeset
61 (require 'gnus-util)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
62 (require 'nnmail)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
63
86154
1cdfc94602cb * smime.el (from):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 85712
diff changeset
64 (defvar gnus-adaptive-word-syntax-table)
1cdfc94602cb * smime.el (from):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 85712
diff changeset
65
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
66 (defvar gnus-registry-dirty t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
67 "Boolean set to t when the registry is modified")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
68
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
69 (defgroup gnus-registry nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
70 "The Gnus registry."
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
71 :version "22.1"
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
72 :group 'gnus)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
73
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
74 (defvar gnus-registry-hashtb (make-hash-table
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
75 :size 256
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
76 :test 'equal)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
77 "*The article registry by Message ID.")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
78
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
79 (defcustom gnus-registry-marks
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
80 '((Important
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
81 :char ?i
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
82 :image "summary_important")
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
83 (Work
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
84 :char ?w
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
85 :image "summary_work")
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
86 (Personal
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
87 :char ?p
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
88 :image "summary_personal")
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
89 (To-Do
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
90 :char ?t
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
91 :image "summary_todo")
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
92 (Later
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
93 :char ?l
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
94 :image "summary_later"))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
95
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
96 "List of registry marks and their options.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
97
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
98 `gnus-registry-mark-article' will offer symbols from this list
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
99 for completion.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
100
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
101 Each entry must have a character to be useful for summary mode
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
102 line display and for keyboard shortcuts.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
103
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
104 Each entry must have an image string to be useful for visual
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
105 display."
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
106 :group 'gnus-registry
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
107 :type '(repeat :tag "Registry Marks"
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
108 (cons :tag "Mark"
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
109 (symbol :tag "Name")
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
110 (checklist :tag "Options" :greedy t
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
111 (group :inline t
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
112 (const :format "" :value :char)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
113 (character :tag "Character code"))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
114 (group :inline t
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
115 (const :format "" :value :image)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
116 (string :tag "Image"))))))
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
117
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
118 (defcustom gnus-registry-default-mark 'To-Do
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
119 "The default mark. Should be a valid key for `gnus-registry-marks'."
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
120 :group 'gnus-registry
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
121 :type 'symbol)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
122
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
123 (defcustom gnus-registry-unfollowed-groups
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
124 '("delayed$" "drafts$" "queue$" "INBOX$")
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
125 "List of groups that gnus-registry-split-fancy-with-parent won't return.
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
126 The group names are matched, they don't have to be fully
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
127 qualified. This parameter tells the Registry 'never split a
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
128 message into a group that matches one of these, regardless of
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
129 references.'"
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
130 :group 'gnus-registry
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
131 :type '(repeat regexp))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
132
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
133 (defcustom gnus-registry-install 'ask
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
134 "Whether the registry should be installed."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
135 :group 'gnus-registry
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
136 :type '(choice (const :tag "Never Install" nil)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
137 (const :tag "Always Install" t)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
138 (const :tag "Ask Me" ask)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
139
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
140 (defcustom gnus-registry-clean-empty t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
141 "Whether the empty registry entries should be deleted.
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
142 Registry entries are considered empty when they have no groups
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
143 and no extra data."
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
144 :group 'gnus-registry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
145 :type 'boolean)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
146
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
147 (defcustom gnus-registry-use-long-group-names nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
148 "Whether the registry should use long group names (BUGGY)."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
149 :group 'gnus-registry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
150 :type 'boolean)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
151
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
152 (defcustom gnus-registry-track-extra nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
153 "Whether the registry should track extra data about a message.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
154 The Subject and Sender (From:) headers are currently tracked this
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
155 way."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
156 :group 'gnus-registry
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
157 :type
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
158 '(set :tag "Tracking choices"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
159 (const :tag "Track by subject (Subject: header)" subject)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
160 (const :tag "Track by sender (From: header)" sender)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
161
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
162 (defcustom gnus-registry-split-strategy nil
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
163 "Whether the registry should track extra data about a message.
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
164 The Subject and Sender (From:) headers are currently tracked this
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
165 way."
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
166 :group 'gnus-registry
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
167 :type
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
168 '(choice :tag "Tracking choices"
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
169 (const :tag "Only use single choices, discard multiple matches" nil)
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
170 (const :tag "Majority of matches wins" majority)
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
171 (const :tag "First found wins" first)))
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
172
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
173 (defcustom gnus-registry-entry-caching t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
174 "Whether the registry should cache extra information."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
175 :group 'gnus-registry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
176 :type 'boolean)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
177
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
178 (defcustom gnus-registry-minimum-subject-length 5
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
179 "The minimum length of a subject before it's considered trackable."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
180 :group 'gnus-registry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
181 :type 'integer)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
182
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
183 (defcustom gnus-registry-trim-articles-without-groups t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
184 "Whether the registry should clean out message IDs without groups."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
185 :group 'gnus-registry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
186 :type 'boolean)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
187
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
188 (defcustom gnus-registry-extra-entries-precious '(marks)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
189 "What extra entries are precious, meaning they won't get trimmed.
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
190 When you save the Gnus registry, it's trimmed to be no longer
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
191 than `gnus-registry-max-entries' (which is nil by default, so no
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
192 trimming happens). Any entries with extra data in this list (by
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
193 default, marks are included, so articles with marks are
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
194 considered precious) will not be trimmed."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
195 :group 'gnus-registry
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
196 :type '(repeat symbol))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
197
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
198 (defcustom gnus-registry-cache-file
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
199 (nnheader-concat
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
200 (or gnus-dribble-directory gnus-home-directory "~/")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
201 ".gnus.registry.eld")
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
202 "File where the Gnus registry will be stored."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
203 :group 'gnus-registry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
204 :type 'file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
205
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
206 (defcustom gnus-registry-max-entries nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
207 "Maximum number of entries in the registry, nil for unlimited."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
208 :group 'gnus-registry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
209 :type '(radio (const :format "Unlimited " nil)
58835
9bdd97960431 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-716
Miles Bader <miles@gnu.org>
parents: 57856
diff changeset
210 (integer :format "Maximum number: %v")))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
211
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
212 (defun gnus-registry-track-subject-p ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
213 (memq 'subject gnus-registry-track-extra))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
214
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
215 (defun gnus-registry-track-sender-p ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
216 (memq 'sender gnus-registry-track-extra))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
217
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
218 (defun gnus-registry-cache-read ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
219 "Read the registry cache file."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
220 (interactive)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
221 (let ((file gnus-registry-cache-file))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
222 (when (file-exists-p file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
223 (gnus-message 5 "Reading %s..." file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
224 (gnus-load file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
225 (gnus-message 5 "Reading %s...done" file))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
226
76836
9feeb7a817c0 * nnmail.el (nnmail-spool-file): Mark as obsolete.
Reiner Steib <Reiner.Steib@gmx.de>
parents: 75347
diff changeset
227 ;; FIXME: Get rid of duplicated code, cf. `gnus-save-newsrc-file' in
9feeb7a817c0 * nnmail.el (nnmail-spool-file): Mark as obsolete.
Reiner Steib <Reiner.Steib@gmx.de>
parents: 75347
diff changeset
228 ;; `gnus-start.el'. --rsteib
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
229 (defun gnus-registry-cache-save ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
230 "Save the registry cache file."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
231 (interactive)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
232 (let ((file gnus-registry-cache-file))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
233 (save-excursion
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
234 (set-buffer (gnus-get-buffer-create " *Gnus-registry-cache*"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
235 (make-local-variable 'version-control)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
236 (setq version-control gnus-backup-startup-file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
237 (setq buffer-file-name file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
238 (setq default-directory (file-name-directory buffer-file-name))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
239 (buffer-disable-undo)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
240 (erase-buffer)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
241 (gnus-message 5 "Saving %s..." file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
242 (if gnus-save-startup-file-via-temp-buffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
243 (let ((coding-system-for-write gnus-ding-file-coding-system)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
244 (standard-output (current-buffer)))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
245 (gnus-gnus-to-quick-newsrc-format
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
246 t "gnus registry startup file" 'gnus-registry-alist)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
247 (gnus-registry-cache-whitespace file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
248 (save-buffer))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
249 (let ((coding-system-for-write gnus-ding-file-coding-system)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
250 (version-control gnus-backup-startup-file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
251 (startup-file file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
252 (working-dir (file-name-directory file))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
253 working-file
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
254 (i -1))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
255 ;; Generate the name of a non-existent file.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
256 (while (progn (setq working-file
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
257 (format
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
258 (if (and (eq system-type 'ms-dos)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
259 (not (gnus-long-file-names)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
260 "%s#%d.tm#" ; MSDOS limits files to 8+3
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
261 (if (memq system-type '(vax-vms axp-vms))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
262 "%s$tmp$%d"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
263 "%s#tmp#%d"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
264 working-dir (setq i (1+ i))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
265 (file-exists-p working-file)))
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
266
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
267 (unwind-protect
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
268 (progn
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
269 (gnus-with-output-to-file working-file
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
270 (gnus-gnus-to-quick-newsrc-format
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
271 t "gnus registry startup file" 'gnus-registry-alist))
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
272
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
273 ;; These bindings will mislead the current buffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
274 ;; into thinking that it is visiting the startup
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
275 ;; file.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
276 (let ((buffer-backed-up nil)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
277 (buffer-file-name startup-file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
278 (file-precious-flag t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
279 (setmodes (file-modes startup-file)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
280 ;; Backup the current version of the startup file.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
281 (backup-buffer)
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
282
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
283 ;; Replace the existing startup file with the temp file.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
284 (rename-file working-file startup-file t)
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
285 (gnus-set-file-modes startup-file setmodes)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
286 (condition-case nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
287 (delete-file working-file)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
288 (file-error nil)))))
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
289
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
290 (gnus-kill-buffer (current-buffer))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
291 (gnus-message 5 "Saving %s...done" file))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
292
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
293 ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
294 ;; Save the gnus-registry file with extra line breaks.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
295 (defun gnus-registry-cache-whitespace (filename)
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
296 (gnus-message 7 "Adding whitespace to %s" filename)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
297 (save-excursion
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
298 (goto-char (point-min))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
299 (while (re-search-forward "^(\\|(\\\"" nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
300 (replace-match "\n\\&" t))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
301 (goto-char (point-min))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
302 (while (re-search-forward " $" nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
303 (replace-match "" t t))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
304
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
305 (defun gnus-registry-save (&optional force)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
306 (when (or gnus-registry-dirty force)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
307 (let ((caching gnus-registry-entry-caching))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
308 ;; turn off entry caching, so mtime doesn't get recorded
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
309 (setq gnus-registry-entry-caching nil)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
310 ;; remove entry caches
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
311 (maphash
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
312 (lambda (key value)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
313 (if (hash-table-p value)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
314 (remhash key gnus-registry-hashtb)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
315 gnus-registry-hashtb)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
316 ;; remove empty entries
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
317 (when gnus-registry-clean-empty
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
318 (gnus-registry-clean-empty-function))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
319 ;; now trim and clean text properties from the registry appropriately
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
320 (setq gnus-registry-alist
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
321 (gnus-registry-remove-alist-text-properties
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
322 (gnus-registry-trim
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
323 (gnus-hashtable-to-alist
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
324 gnus-registry-hashtb))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
325 ;; really save
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
326 (gnus-registry-cache-save)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
327 (setq gnus-registry-entry-caching caching)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
328 (setq gnus-registry-dirty nil))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
329
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
330 (defun gnus-registry-clean-empty-function ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
331 "Remove all empty entries from the registry. Returns count thereof."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
332 (let ((count 0))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
333
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
334 (maphash
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
335 (lambda (key value)
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
336 (when (stringp key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
337 (dolist (group (gnus-registry-fetch-groups key))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
338 (when (gnus-parameter-registry-ignore group)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
339 (gnus-message
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
340 10
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
341 "gnus-registry: deleted ignored group %s from key %s"
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
342 group key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
343 (gnus-registry-delete-group key group)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
344
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
345 (unless (gnus-registry-group-count key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
346 (gnus-registry-delete-id key))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
347
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
348 (unless (or
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
349 (gnus-registry-fetch-group key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
350 ;; TODO: look for specific extra data here!
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
351 ;; in this example, we look for 'label
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
352 (gnus-registry-fetch-extra key 'label))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
353 (incf count)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
354 (gnus-registry-delete-id key))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
355
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
356 (unless (stringp key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
357 (gnus-message
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
358 10
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
359 "gnus-registry key %s was not a string, removing"
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
360 key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
361 (gnus-registry-delete-id key))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
362
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
363 gnus-registry-hashtb)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
364 count))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
365
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
366 (defun gnus-registry-read ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
367 (gnus-registry-cache-read)
73269
aeb79612dc36 Merge from gnus--rel--5.10
Miles Bader <miles@gnu.org>
parents: 68633
diff changeset
368 (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
369 (setq gnus-registry-dirty nil))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
370
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
371 (defun gnus-registry-remove-alist-text-properties (v)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
372 "Remove text properties from all strings in alist."
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
373 (if (stringp v)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
374 (gnus-string-remove-all-properties v)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
375 (if (and (listp v) (listp (cdr v)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
376 (mapcar 'gnus-registry-remove-alist-text-properties v)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
377 (if (and (listp v) (stringp (cdr v)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
378 (cons (gnus-registry-remove-alist-text-properties (car v))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
379 (gnus-registry-remove-alist-text-properties (cdr v)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
380 v))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
381
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
382 (defun gnus-registry-trim (alist)
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
383 "Trim alist to size, using gnus-registry-max-entries.
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
384 Any entries with extra data (marks, currently) are left alone."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
385 (if (null gnus-registry-max-entries)
57055
06f2ccbf6e0f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-539
Miles Bader <miles@gnu.org>
parents: 56927
diff changeset
386 alist ; just return the alist
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
387 ;; else, when given max-entries, trim the alist
57055
06f2ccbf6e0f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-539
Miles Bader <miles@gnu.org>
parents: 56927
diff changeset
388 (let* ((timehash (make-hash-table
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
389 :size 20000
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
390 :test 'equal))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
391 (precious (make-hash-table
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
392 :size 20000
57055
06f2ccbf6e0f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-539
Miles Bader <miles@gnu.org>
parents: 56927
diff changeset
393 :test 'equal))
06f2ccbf6e0f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-539
Miles Bader <miles@gnu.org>
parents: 56927
diff changeset
394 (trim-length (- (length alist) gnus-registry-max-entries))
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
395 (trim-length (if (natnump trim-length) trim-length 0))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
396 precious-list junk-list)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
397 (maphash
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
398 (lambda (key value)
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
399 (let ((extra (gnus-registry-fetch-extra key)))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
400 (dolist (item gnus-registry-extra-entries-precious)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
401 (dolist (e extra)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
402 (when (equal (nth 0 e) item)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
403 (puthash key t precious)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
404 (return))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
405 (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
406 gnus-registry-hashtb)
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
407
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
408 (dolist (item alist)
92255
5602f2f74fe4 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87859
diff changeset
409 (let ((key (nth 0 item)))
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
410 (if (gethash key precious)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
411 (push item precious-list)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
412 (push item junk-list))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
413
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
414 (sort
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
415 junk-list
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
416 (lambda (a b)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
417 (let ((t1 (or (cdr (gethash (car a) timehash))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
418 '(0 0 0)))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
419 (t2 (or (cdr (gethash (car b) timehash))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
420 '(0 0 0))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
421 (time-less-p t1 t2))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
422
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
423 ;; we use the return value of this setq, which is the trimmed alist
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
424 (setq alist (append precious-list
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
425 (nthcdr trim-length junk-list))))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
426
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
427 (defun gnus-registry-action (action data-header from &optional to method)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
428 (let* ((id (mail-header-id data-header))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
429 (subject (gnus-string-remove-all-properties
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
430 (gnus-registry-simplify-subject
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
431 (mail-header-subject data-header))))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
432 (sender (gnus-string-remove-all-properties
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
433 (mail-header-from data-header)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
434 (from (gnus-group-guess-full-name-from-command-method from))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
435 (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
436 (to-name (if to to "the Bit Bucket"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
437 (old-entry (gethash id gnus-registry-hashtb)))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
438 (gnus-message 7 "Registry: article %s %s from %s to %s"
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
439 id
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
440 (if method "respooling" "going")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
441 from
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
442 to)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
443
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
444 ;; All except copy will need a delete
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
445 (gnus-registry-delete-group id from)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
446
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
447 (when (equal 'copy action)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
448 (gnus-registry-add-group id from subject sender)) ; undo the delete
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
449
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
450 (gnus-registry-add-group id to subject sender)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
451
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
452 (defun gnus-registry-spool-action (id group &optional subject sender)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
453 (let ((group (gnus-group-guess-full-name-from-command-method group)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
454 (when (and (stringp id) (string-match "\r$" id))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
455 (setq id (substring id 0 -1)))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
456 (gnus-message 7 "Registry: article %s spooled to %s"
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
457 id
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
458 group)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
459 (gnus-registry-add-group id group subject sender)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
460
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
461 ;; Function for nn{mail|imap}-split-fancy: look up all references in
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
462 ;; the cache and if a match is found, return that group.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
463 (defun gnus-registry-split-fancy-with-parent ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
464 "Split this message into the same group as its parent. The parent
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
465 is obtained from the registry. This function can be used as an entry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
466 in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
467 this: (: gnus-registry-split-fancy-with-parent)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
468
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
469 This function tracks ALL backends, unlike
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
470 `nnmail-split-fancy-with-parent' which tracks only nnmail
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
471 messages.
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
472
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
473 For a message to be split, it looks for the parent message in the
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
474 References or In-Reply-To header and then looks in the registry
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
475 to see which group that message was put in. This group is
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
476 returned, unless `gnus-registry-follow-group-p' return nil for
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
477 that group.
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
478
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
479 See the Info node `(gnus)Fancy Mail Splitting' for more details."
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
480 (let* ((refstr (or (message-fetch-field "references") "")) ; guaranteed
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
481 (reply-to (message-fetch-field "in-reply-to")) ; may be nil
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
482 ;; now, if reply-to is valid, append it to the References
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
483 (refstr (if reply-to
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
484 (concat refstr " " reply-to)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
485 refstr))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
486 ;; these may not be used, but the code is cleaner having them up here
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
487 (sender (gnus-string-remove-all-properties
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
488 (message-fetch-field "from")))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
489 (subject (gnus-string-remove-all-properties
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
490 (gnus-registry-simplify-subject
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
491 (message-fetch-field "subject"))))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
492
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
493 (nnmail-split-fancy-with-parent-ignore-groups
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
494 (if (listp nnmail-split-fancy-with-parent-ignore-groups)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
495 nnmail-split-fancy-with-parent-ignore-groups
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
496 (list nnmail-split-fancy-with-parent-ignore-groups)))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
497 (log-agent "gnus-registry-split-fancy-with-parent")
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
498 found found-full)
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
499
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
500 ;; this is a big if-else statement. it uses
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
501 ;; gnus-registry-post-process-groups to filter the results after
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
502 ;; every step.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
503 (cond
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
504 ;; the references string must be valid and parse to valid references
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
505 ((and refstr (gnus-extract-references refstr))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
506 (dolist (reference (nreverse (gnus-extract-references refstr)))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
507 (gnus-message
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
508 9
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
509 "%s is looking for matches for reference %s from [%s]"
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
510 log-agent reference refstr)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
511 (dolist (group (gnus-registry-fetch-groups reference))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
512 (when (and group (gnus-registry-follow-group-p group))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
513 (gnus-message
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
514 7
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
515 "%s traced the reference %s from [%s] to group %s"
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
516 log-agent reference refstr group)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
517 (push group found))))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
518 ;; filter the found groups and return them
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
519 ;; the found groups are the full groups
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
520 (setq found (gnus-registry-post-process-groups
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
521 "references" refstr found found)))
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
522
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
523 ;; else: there were no matches, now try the extra tracking by sender
94451
760ef541936c Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94369
diff changeset
524 ((and (gnus-registry-track-sender-p)
760ef541936c Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94369
diff changeset
525 sender
94748
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
526 (not (equal (gnus-extract-address-component-email sender)
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
527 user-mail-address)))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
528 (maphash
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
529 (lambda (key value)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
530 (let ((this-sender (cdr
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
531 (gnus-registry-fetch-extra key 'sender)))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
532 matches)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
533 (when (and this-sender
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
534 (equal sender this-sender))
93386
a789a1138b08 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92694
diff changeset
535 (let ((groups (gnus-registry-fetch-groups key)))
a789a1138b08 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92694
diff changeset
536 (dolist (group groups)
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
537 (push group found-full)
93386
a789a1138b08 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92694
diff changeset
538 (setq found (append (list group) (delete group found)))))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
539 (push key matches)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
540 (gnus-message
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
541 ;; raise level of messaging if gnus-registry-track-extra
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
542 (if gnus-registry-track-extra 7 9)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
543 "%s (extra tracking) traced sender %s to groups %s (keys %s)"
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
544 log-agent sender found matches))))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
545 gnus-registry-hashtb)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
546 ;; filter the found groups and return them
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
547 ;; the found groups are NOT the full groups
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
548 (setq found (gnus-registry-post-process-groups
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
549 "sender" sender found found-full)))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
550
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
551 ;; else: there were no matches, now try the extra tracking by subject
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
552 ((and (gnus-registry-track-subject-p)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
553 subject
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
554 (< gnus-registry-minimum-subject-length (length subject)))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
555 (maphash
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
556 (lambda (key value)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
557 (let ((this-subject (cdr
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
558 (gnus-registry-fetch-extra key 'subject)))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
559 matches)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
560 (when (and this-subject
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
561 (equal subject this-subject))
93386
a789a1138b08 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92694
diff changeset
562 (let ((groups (gnus-registry-fetch-groups key)))
a789a1138b08 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92694
diff changeset
563 (dolist (group groups)
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
564 (push group found-full)
93386
a789a1138b08 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92694
diff changeset
565 (setq found (append (list group) (delete group found)))))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
566 (push key matches)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
567 (gnus-message
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
568 ;; raise level of messaging if gnus-registry-track-extra
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
569 (if gnus-registry-track-extra 7 9)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
570 "%s (extra tracking) traced subject %s to groups %s (keys %s)"
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
571 log-agent subject found matches))))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
572 gnus-registry-hashtb)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
573 ;; filter the found groups and return them
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
574 ;; the found groups are NOT the full groups
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
575 (setq found (gnus-registry-post-process-groups
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
576 "subject" subject found found-full))))
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
577 ;; after the (cond) we extract the actual value safely
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
578 (car-safe found)))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
579
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
580 (defun gnus-registry-post-process-groups (mode key groups groups-full)
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
581 "Modifies GROUPS found by MODE for KEY to determine which ones to follow.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
582
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
583 MODE can be 'subject' or 'sender' for example. The KEY is the
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
584 value by which MODE was searched.
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
585
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
586 Transforms each group name to the equivalent short name.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
587
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
588 Checks if the current Gnus method (from `gnus-command-method' or
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
589 from `gnus-newsgroup-name') is the same as the group's method.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
590 This is not possible if gnus-registry-use-long-group-names is
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
591 false. Foreign methods are not supported so they are rejected.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
592
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
593 Reduces the list to a single group, or complains if that's not
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
594 possible. Uses `gnus-registry-split-strategy' and GROUPS-FULL if
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
595 necessary."
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
596 (let ((log-agent "gnus-registry-post-process-group")
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
597 out)
94369
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
598
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
599 ;; the strategy can be 'first, 'majority, or nil
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
600 (when (eq gnus-registry-split-strategy 'first)
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
601 (when groups
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
602 (setq groups (list (car-safe groups)))))
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
603
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
604 (when (eq gnus-registry-split-strategy 'majority)
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
605 (let ((freq (make-hash-table
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
606 :size 256
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
607 :test 'equal)))
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
608 (mapc (lambda(x) (puthash x (1+ (gethash x freq 0)) freq)) groups-full)
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
609 (setq groups (list (car-safe
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
610 (sort
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
611 groups
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
612 (lambda (a b)
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
613 (> (gethash a freq 0)
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
614 (gethash b freq 0)))))))))
86c0a3e7c039 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94209
diff changeset
615
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
616 (if gnus-registry-use-long-group-names
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
617 (dolist (group groups)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
618 (let ((m1 (gnus-find-method-for-group group))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
619 (m2 (or gnus-command-method
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
620 (gnus-find-method-for-group gnus-newsgroup-name)))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
621 (short-name (gnus-group-short-name group)))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
622 (if (gnus-methods-equal-p m1 m2)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
623 (progn
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
624 ;; this is REALLY just for debugging
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
625 (gnus-message
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
626 10
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
627 "%s stripped group %s to %s"
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
628 log-agent group short-name)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
629 (unless (member short-name out)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
630 (push short-name out)))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
631 ;; else...
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
632 (gnus-message
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
633 7
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
634 "%s ignored foreign group %s"
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
635 log-agent group))))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
636 (setq out groups))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
637 (when (cdr-safe out)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
638 (gnus-message
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
639 5
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
640 "%s: too many extra matches (%s) for %s %s. Returning none."
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
641 log-agent out mode key)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
642 (setq out nil))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
643 out))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
644
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
645 (defun gnus-registry-follow-group-p (group)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
646 "Determines if a group name should be followed.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
647 Consults `gnus-registry-unfollowed-groups' and
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
648 `nnmail-split-fancy-with-parent-ignore-groups'."
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
649 (not (or (gnus-registry-grep-in-list
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
650 group
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
651 gnus-registry-unfollowed-groups)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
652 (gnus-registry-grep-in-list
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
653 group
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
654 nnmail-split-fancy-with-parent-ignore-groups))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
655
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
656 (defun gnus-registry-wash-for-keywords (&optional force)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
657 (interactive)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
658 (let ((id (gnus-registry-fetch-message-id-fast gnus-current-article))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
659 word words)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
660 (if (or (not (gnus-registry-fetch-extra id 'keywords))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
661 force)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
662 (save-excursion
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
663 (set-buffer gnus-article-buffer)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
664 (article-goto-body)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
665 (save-window-excursion
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
666 (save-restriction
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
667 (narrow-to-region (point) (point-max))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
668 (with-syntax-table gnus-adaptive-word-syntax-table
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
669 (while (re-search-forward "\\b\\w+\\b" nil t)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
670 (setq word (gnus-registry-remove-alist-text-properties
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
671 (downcase (buffer-substring
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
672 (match-beginning 0) (match-end 0)))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
673 (if (> (length word) 3)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
674 (push word words))))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
675 (gnus-registry-store-extra-entry id 'keywords words)))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
676
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
677 (defun gnus-registry-find-keywords (keyword)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
678 (interactive "skeyword: ")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
679 (let (articles)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
680 (maphash
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
681 (lambda (key value)
94748
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
682 (when (member keyword
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
683 (cdr-safe (gnus-registry-fetch-extra key 'keywords)))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
684 (push key articles)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
685 gnus-registry-hashtb)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
686 articles))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
687
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
688 (defun gnus-registry-register-message-ids ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
689 "Register the Message-ID of every article in the group"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
690 (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
691 (dolist (article gnus-newsgroup-articles)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
692 (let ((id (gnus-registry-fetch-message-id-fast article)))
92255
5602f2f74fe4 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87859
diff changeset
693 (unless (member gnus-newsgroup-name (gnus-registry-fetch-groups id))
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
694 (gnus-message 9 "Registry: Registering article %d with group %s"
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
695 article gnus-newsgroup-name)
92255
5602f2f74fe4 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87859
diff changeset
696 (gnus-registry-add-group
5602f2f74fe4 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87859
diff changeset
697 id
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
698 gnus-newsgroup-name
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
699 (gnus-registry-fetch-simplified-message-subject-fast article)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
700 (gnus-registry-fetch-sender-fast article)))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
701
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
702 (defun gnus-registry-fetch-message-id-fast (article)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
703 "Fetch the Message-ID quickly, using the internal gnus-data-list function"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
704 (if (and (numberp article)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
705 (assoc article (gnus-data-list nil)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
706 (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
707 nil))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
708
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
709 (defun gnus-registry-simplify-subject (subject)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
710 (if (stringp subject)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
711 (gnus-simplify-subject subject)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
712 nil))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
713
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
714 (defun gnus-registry-fetch-simplified-message-subject-fast (article)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
715 "Fetch the Subject quickly, using the internal gnus-data-list function"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
716 (if (and (numberp article)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
717 (assoc article (gnus-data-list nil)))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
718 (gnus-string-remove-all-properties
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
719 (gnus-registry-simplify-subject
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
720 (mail-header-subject (gnus-data-header
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
721 (assoc article (gnus-data-list nil))))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
722 nil))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
723
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
724 (defun gnus-registry-fetch-sender-fast (article)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
725 "Fetch the Sender quickly, using the internal gnus-data-list function"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
726 (if (and (numberp article)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
727 (assoc article (gnus-data-list nil)))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
728 (gnus-string-remove-all-properties
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
729 (mail-header-from (gnus-data-header
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
730 (assoc article (gnus-data-list nil)))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
731 nil))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
732
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
733 (defun gnus-registry-grep-in-list (word list)
94748
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
734 "Find if a WORD matches any regular expression in the given LIST."
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
735 (when (and word list)
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
736 (catch 'found
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
737 (dolist (r list)
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
738 (when (string-match r word)
e6e8d9b7ab7d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 94662
diff changeset
739 (throw 'found r))))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
740
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
741 (defun gnus-registry-do-marks (type function)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
742 "For each known mark, call FUNCTION for each cell of type TYPE.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
743
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
744 FUNCTION should take two parameters, a mark symbol and the cell value."
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
745 (dolist (mark-info gnus-registry-marks)
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
746 (let* ((mark (car-safe mark-info))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
747 (data (cdr-safe mark-info))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
748 (cell-data (plist-get data type)))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
749 (when cell-data
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
750 (funcall function mark cell-data)))))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
751
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
752 ;;; this is ugly code, but I don't know how to do it better
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
753 (defun gnus-registry-install-shortcuts ()
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
754 "Install the keyboard shortcuts and menus for the registry.
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
755 Uses `gnus-registry-marks' to find what shortcuts to install."
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
756 (let (keys-plist)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
757 (gnus-registry-do-marks
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
758 :char
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
759 (lambda (mark data)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
760 (let ((function-format
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
761 (format "gnus-registry-%%s-article-%s-mark" mark)))
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
762
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
763 ;;; The following generates these functions:
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
764 ;;; (defun gnus-registry-set-article-Important-mark (&rest articles)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
765 ;;; "Apply the Important mark to process-marked ARTICLES."
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
766 ;;; (interactive (gnus-summary-work-articles current-prefix-arg))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
767 ;;; (gnus-registry-set-article-mark-internal 'Important articles nil t))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
768 ;;; (defun gnus-registry-remove-article-Important-mark (&rest articles)
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
769 ;;; "Apply the Important mark to process-marked ARTICLES."
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
770 ;;; (interactive (gnus-summary-work-articles current-prefix-arg))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
771 ;;; (gnus-registry-set-article-mark-internal 'Important articles t t))
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
772
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
773 (dolist (remove '(t nil))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
774 (let* ((variant-name (if remove "remove" "set"))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
775 (function-name (format function-format variant-name))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
776 (shortcut (format "%c" data))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
777 (shortcut (if remove (upcase shortcut) shortcut)))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
778 (unintern function-name)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
779 (eval
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
780 `(defun
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
781 ;; function name
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
782 ,(intern function-name)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
783 ;; parameter definition
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
784 (&rest articles)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
785 ;; documentation
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
786 ,(format
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
787 "%s the %s mark over process-marked ARTICLES."
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
788 (upcase-initials variant-name)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
789 mark)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
790 ;; interactive definition
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
791 (interactive
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
792 (gnus-summary-work-articles current-prefix-arg))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
793 ;; actual code
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
794
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
795 ;; if this is called and the user doesn't want the
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
796 ;; registry enabled, we'll ask anyhow
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
797 (when (eq gnus-registry-install nil)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
798 (setq gnus-registry-install 'ask))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
799
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
800 ;; now the user is asked if gnus-registry-install is 'ask
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
801 (when (gnus-registry-install-p)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
802 (gnus-registry-set-article-mark-internal
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
803 ;; all this just to get the mark, I must be doing it wrong
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
804 (intern ,(symbol-name mark))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
805 articles ,remove t)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
806 (dolist (article articles)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
807 (gnus-summary-update-article
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
808 article
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
809 (assoc article (gnus-data-list nil)))))))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
810 (push (intern function-name) keys-plist)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
811 (push shortcut keys-plist)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
812 (gnus-message
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
813 9
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
814 "Defined mark handling function %s"
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
815 function-name))))))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
816 (gnus-define-keys-1
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
817 '(gnus-registry-mark-map "M" gnus-summary-mark-map)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
818 keys-plist)))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
819
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
820 ;;; use like this:
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
821 ;;; (defalias 'gnus-user-format-function-M
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
822 ;;; 'gnus-registry-user-format-function-M)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
823 (defun gnus-registry-user-format-function-M (headers)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
824 (let* ((id (mail-header-message-id headers))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
825 (marks (when id (gnus-registry-fetch-extra-marks id))))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
826 (apply 'concat (mapcar (lambda(mark)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
827 (let ((c
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
828 (plist-get
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
829 (cdr-safe
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
830 (assoc mark gnus-registry-marks))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
831 :char)))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
832 (if c
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
833 (list c)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
834 nil)))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
835 marks))))
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
836
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
837 (defun gnus-registry-read-mark ()
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
838 "Read a mark name from the user with completion."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
839 (let ((mark (gnus-completing-read-with-default
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
840 (symbol-name gnus-registry-default-mark)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
841 "Label"
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
842 (mapcar (lambda (x) ; completion list
92359
1af6d6eab2e9 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92255
diff changeset
843 (cons (symbol-name (car-safe x)) (car-safe x)))
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
844 gnus-registry-marks))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
845 (when (stringp mark)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
846 (intern mark))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
847
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
848 (defun gnus-registry-set-article-mark (&rest articles)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
849 "Apply a mark to process-marked ARTICLES."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
850 (interactive (gnus-summary-work-articles current-prefix-arg))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
851 (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles nil t))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
852
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
853 (defun gnus-registry-remove-article-mark (&rest articles)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
854 "Remove a mark from process-marked ARTICLES."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
855 (interactive (gnus-summary-work-articles current-prefix-arg))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
856 (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles t t))
87454
0cbc451989a7 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 86154
diff changeset
857
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
858 (defun gnus-registry-set-article-mark-internal (mark articles &optional remove show-message)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
859 "Apply a mark to a list of ARTICLES."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
860 (let ((article-id-list
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
861 (mapcar 'gnus-registry-fetch-message-id-fast articles)))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
862 (dolist (id article-id-list)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
863 (let* (
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
864 ;; all the marks for this article without the mark of
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
865 ;; interest
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
866 (marks
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
867 (delq mark (gnus-registry-fetch-extra-marks id)))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
868 ;; the new marks we want to use
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
869 (new-marks (if remove
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
870 marks
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
871 (cons mark marks))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
872 (when show-message
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
873 (gnus-message 1 "%s mark %s with message ID %s, resulting in %S"
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
874 (if remove "Removing" "Adding")
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
875 mark id new-marks))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
876
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
877 (apply 'gnus-registry-store-extra-marks ; set the extra marks
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
878 id ; for the message ID
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
879 new-marks)))))
87454
0cbc451989a7 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 86154
diff changeset
880
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
881 (defun gnus-registry-get-article-marks (&rest articles)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
882 "Get the Gnus registry marks for ARTICLES and show them if interactive.
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
883 Uses process/prefix conventions. For multiple articles,
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
884 only the last one's marks are returned."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
885 (interactive (gnus-summary-work-articles 1))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
886 (let (marks)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
887 (dolist (article articles)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
888 (let ((article-id
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
889 (gnus-registry-fetch-message-id-fast article)))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
890 (setq marks (gnus-registry-fetch-extra-marks article-id))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
891 (when (interactive-p)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
892 (gnus-message 1 "Marks are %S" marks))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
893 marks))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
894
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
895 ;;; if this extends to more than 'marks, it should be improved to be more generic.
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
896 (defun gnus-registry-fetch-extra-marks (id)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
897 "Get the marks of a message, based on the message ID.
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
898 Returns a list of symbol marks or nil."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
899 (car-safe (cdr (gnus-registry-fetch-extra id 'marks))))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
900
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
901 (defun gnus-registry-has-extra-mark (id mark)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
902 "Checks if a message has `mark', based on the message ID `id'."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
903 (memq mark (gnus-registry-fetch-extra-marks id)))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
904
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
905 (defun gnus-registry-store-extra-marks (id &rest mark-list)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
906 "Set the marks of a message, based on the message ID.
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
907 The `mark-list' can be nil, in which case no marks are left."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
908 (gnus-registry-store-extra-entry id 'marks (list mark-list)))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
909
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
910 (defun gnus-registry-delete-extra-marks (id &rest mark-delete-list)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
911 "Delete the message marks in `mark-delete-list', based on the message ID."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
912 (let ((marks (gnus-registry-fetch-extra-marks id)))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
913 (when marks
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
914 (dolist (mark mark-delete-list)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
915 (setq marks (delq mark marks))))
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
916 (gnus-registry-store-extra-marks id (car marks))))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
917
87859
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
918 (defun gnus-registry-delete-all-extra-marks (id)
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
919 "Delete all the marks for a message ID."
1bb83c2fe524 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 87649
diff changeset
920 (gnus-registry-store-extra-marks id nil))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
921
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
922 (defun gnus-registry-fetch-extra (id &optional entry)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
923 "Get the extra data of a message, based on the message ID.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
924 Returns the first place where the trail finds a nonstring."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
925 (let ((entry-cache (gethash entry gnus-registry-hashtb)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
926 (if (and entry
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
927 (hash-table-p entry-cache)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
928 (gethash id entry-cache))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
929 (gethash id entry-cache)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
930 ;; else, if there is no caching possible...
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
931 (let ((trail (gethash id gnus-registry-hashtb)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
932 (when (listp trail)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
933 (dolist (crumb trail)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
934 (unless (stringp crumb)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
935 (return (gnus-registry-fetch-extra-entry crumb entry id)))))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
936
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
937 (defun gnus-registry-fetch-extra-entry (alist &optional entry id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
938 "Get the extra data of a message, or a specific entry in it.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
939 Update the entry cache if needed."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
940 (if (and entry id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
941 (let ((entry-cache (gethash entry gnus-registry-hashtb))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
942 entree)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
943 (when gnus-registry-entry-caching
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
944 ;; create the hash table
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
945 (unless (hash-table-p entry-cache)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
946 (setq entry-cache (make-hash-table
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
947 :size 4096
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
948 :test 'equal))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
949 (puthash entry entry-cache gnus-registry-hashtb))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
950
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
951 ;; get the entree from the hash table or from the alist
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
952 (setq entree (gethash id entry-cache)))
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
953
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
954 (unless entree
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
955 (setq entree (assq entry alist))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
956 (when gnus-registry-entry-caching
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
957 (puthash id entree entry-cache)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
958 entree)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
959 alist))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
960
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
961 (defun gnus-registry-store-extra (id extra)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
962 "Store the extra data of a message, based on the message ID.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
963 The message must have at least one group name."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
964 (when (gnus-registry-group-count id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
965 ;; we now know the trail has at least 1 group name, so it's not empty
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
966 (let ((trail (gethash id gnus-registry-hashtb))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
967 (old-extra (gnus-registry-fetch-extra id))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
968 entry-cache)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
969 (dolist (crumb trail)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
970 (unless (stringp crumb)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
971 (dolist (entry crumb)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
972 (setq entry-cache (gethash (car entry) gnus-registry-hashtb))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
973 (when entry-cache
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
974 (remhash id entry-cache))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
975 (puthash id (cons extra (delete old-extra trail))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
976 gnus-registry-hashtb)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
977 (setq gnus-registry-dirty t)))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
978
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
979 (defun gnus-registry-delete-extra-entry (id key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
980 "Delete a specific entry in the extras field of the registry entry for id."
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
981 (gnus-registry-store-extra-entry id key nil))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
982
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
983 (defun gnus-registry-store-extra-entry (id key value)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
984 "Put a specific entry in the extras field of the registry entry for id."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
985 (let* ((extra (gnus-registry-fetch-extra id))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
986 ;; all the entries except the one for `key'
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
987 (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
988 (alist (if value
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
989 (gnus-registry-remove-alist-text-properties
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
990 (cons (cons key value)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
991 the-rest))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
992 the-rest)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
993 (gnus-registry-store-extra id alist)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
994
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
995 (defun gnus-registry-fetch-group (id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
996 "Get the group of a message, based on the message ID.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
997 Returns the first place where the trail finds a group name."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
998 (when (gnus-registry-group-count id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
999 ;; we now know the trail has at least 1 group name
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1000 (let ((trail (gethash id gnus-registry-hashtb)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1001 (dolist (crumb trail)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1002 (when (stringp crumb)
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1003 (return (if gnus-registry-use-long-group-names
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1004 crumb
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1005 (gnus-group-short-name crumb))))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1006
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1007 (defun gnus-registry-fetch-groups (id)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1008 "Get the groups of a message, based on the message ID."
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1009 (let ((trail (gethash id gnus-registry-hashtb))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1010 groups)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1011 (dolist (crumb trail)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1012 (when (stringp crumb)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1013 ;; push the group name into the list
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1014 (setq
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1015 groups
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1016 (cons
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1017 (if (or (not (stringp crumb)) gnus-registry-use-long-group-names)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1018 crumb
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1019 (gnus-group-short-name crumb))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1020 groups))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1021 ;; return the list of groups
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1022 groups))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1023
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1024 (defun gnus-registry-group-count (id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1025 "Get the number of groups of a message, based on the message ID."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1026 (let ((trail (gethash id gnus-registry-hashtb)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1027 (if (and trail (listp trail))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1028 (apply '+ (mapcar (lambda (x) (if (stringp x) 1 0)) trail))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1029 0)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1030
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1031 (defun gnus-registry-delete-group (id group)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1032 "Delete a group for a message, based on the message ID."
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1033 (when (and group id)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1034 (let ((trail (gethash id gnus-registry-hashtb))
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1035 (short-group (gnus-group-short-name group)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1036 (puthash id (if trail
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1037 (delete short-group (delete group trail))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1038 nil)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1039 gnus-registry-hashtb))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1040 ;; now, clear the entry if there are no more groups
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1041 (when gnus-registry-trim-articles-without-groups
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1042 (unless (gnus-registry-group-count id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1043 (gnus-registry-delete-id id)))
60161
b070535d2416 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-111
Miles Bader <miles@gnu.org>
parents: 59996
diff changeset
1044 ;; is this ID still in the registry?
b070535d2416 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-111
Miles Bader <miles@gnu.org>
parents: 59996
diff changeset
1045 (when (gethash id gnus-registry-hashtb)
85712
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents: 78224
diff changeset
1046 (gnus-registry-store-extra-entry id 'mtime (current-time)))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1047
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1048 (defun gnus-registry-delete-id (id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1049 "Delete a message ID from the registry."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1050 (when (stringp id)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1051 (remhash id gnus-registry-hashtb)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1052 (maphash
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1053 (lambda (key value)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1054 (when (hash-table-p value)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1055 (remhash id value)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1056 gnus-registry-hashtb)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1057
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1058 (defun gnus-registry-add-group (id group &optional subject sender)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1059 "Add a group for a message, based on the message ID."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1060 (when group
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1061 (when (and id
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1062 (not (string-match "totally-fudged-out-message-id" id)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1063 (let ((full-group group)
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1064 (group (if gnus-registry-use-long-group-names
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1065 group
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1066 (gnus-group-short-name group))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1067 (gnus-registry-delete-group id group)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1068
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1069 (unless gnus-registry-use-long-group-names ;; unnecessary in this case
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1070 (gnus-registry-delete-group id full-group))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1071
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1072 (let ((trail (gethash id gnus-registry-hashtb)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1073 (puthash id (if trail
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1074 (cons group trail)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1075 (list group))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1076 gnus-registry-hashtb)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1077
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1078 (when (and (gnus-registry-track-subject-p)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1079 subject)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1080 (gnus-registry-store-extra-entry
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1081 id
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1082 'subject
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1083 (gnus-registry-simplify-subject subject)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1084 (when (and (gnus-registry-track-sender-p)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1085 sender)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1086 (gnus-registry-store-extra-entry
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1087 id
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1088 'sender
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1089 sender))
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1090
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1091 (gnus-registry-store-extra-entry id 'mtime (current-time)))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1092
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1093 (defun gnus-registry-clear ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1094 "Clear the Gnus registry."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1095 (interactive)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1096 (setq gnus-registry-alist nil)
73269
aeb79612dc36 Merge from gnus--rel--5.10
Miles Bader <miles@gnu.org>
parents: 68633
diff changeset
1097 (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1098 (setq gnus-registry-dirty t))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1099
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1100 ;;;###autoload
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1101 (defun gnus-registry-initialize ()
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1102 "Initialize the Gnus registry."
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1103 (interactive)
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1104 (gnus-message 5 "Initializing the registry")
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1105 (setq gnus-registry-install t) ; in case it was 'ask or nil
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1106 (gnus-registry-install-hooks)
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1107 (gnus-registry-install-shortcuts)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1108 (gnus-registry-read))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1109
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1110 ;;;###autoload
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1111 (defun gnus-registry-install-hooks ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1112 "Install the registry hooks."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1113 (interactive)
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1114 (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1115 (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1116 (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1117 (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1118
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1119 (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1120 (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1121
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1122 (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1123
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1124 (defun gnus-registry-unload-hook ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1125 "Uninstall the registry hooks."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1126 (interactive)
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1127 (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1128 (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1129 (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1130 (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 58835
diff changeset
1131
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1132 (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1133 (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1134
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1135 (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1136
57552
27c5fd98f808 (gnus-registry-unload-hook): Set as a variable with add-hook.
Richard M. Stallman <rms@gnu.org>
parents: 57055
diff changeset
1137 (add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
27c5fd98f808 (gnus-registry-unload-hook): Set as a variable with add-hook.
Richard M. Stallman <rms@gnu.org>
parents: 57055
diff changeset
1138
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1139 (defun gnus-registry-install-p ()
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1140 (interactive)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1141 (when (eq gnus-registry-install 'ask)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1142 (setq gnus-registry-install
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1143 (gnus-y-or-n-p
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1144 (concat "Enable the Gnus registry? "
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1145 "See the variable `gnus-registry-install' "
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1146 "to get rid of this query permanently. ")))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1147 (when gnus-registry-install
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1148 ;; we just set gnus-registry-install to t, so initialize the registry!
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1149 (gnus-registry-initialize)))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1150 ;;; we could call it here: (customize-variable 'gnus-registry-install)
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1151 gnus-registry-install)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1152
94209
0ffd6dd0f75d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 93975
diff changeset
1153 (when (or (eq gnus-registry-install t)
0ffd6dd0f75d Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 93975
diff changeset
1154 (gnus-registry-install-p))
92694
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1155 (gnus-registry-initialize))
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1156
d3767aa9ae49 Merge from gnus--devo--0
Miles Bader <miles@gnu.org>
parents: 92359
diff changeset
1157 ;; TODO: a few things
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1158
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1159 (provide 'gnus-registry)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1160
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93386
diff changeset
1161 ;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
diff changeset
1162 ;;; gnus-registry.el ends here