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

   1 ;;; gnus-registry.el --- article registry for Gnus
   2
   3 ;; Copyright (C) 2002-2011  Free Software Foundation, Inc.
   4
   5 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
   6 ;; Keywords: news registry
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This is the gnus-registry.el package, which works with all
  26 ;; Gnus backends, not just nnmail.  The major issue is that it
  27 ;; doesn't go across backends, so for instance if an article is in
  28 ;; nnml:sys and you see a reference to it in nnimap splitting, the
  29 ;; article will end up in nnimap:sys
  30
  31 ;; gnus-registry.el intercepts article respooling, moving, deleting,
  32 ;; and copying for all backends.  If it doesn't work correctly for
  33 ;; you, submit a bug report and I'll be glad to fix it.  It needs
  34 ;; better documentation in the manual (also on my to-do list).
  35
  36 ;; If you want to track recipients (and you should to make the
  37 ;; gnus-registry splitting work better), you need the To and Cc
  38 ;; headers collected by Gnus.  Note that in more recent Gnus versions
  39 ;; this is already the case: look at `gnus-extra-headers' to be sure.
  40
  41 ;; ;;; you may also want Gcc Newsgroups Keywords X-Face
  42 ;; (add-to-list 'gnus-extra-headers 'To)
  43 ;; (add-to-list 'gnus-extra-headers 'Cc)
  44 ;; (setq nnmail-extra-headers gnus-extra-headers)
  45
  46 ;; Put this in your startup file (~/.gnus.el for instance) or use Customize:
  47
  48 ;; (setq gnus-registry-max-entries 2500
  49 ;;       gnus-registry-track-extra '(sender subject recipient))
  50
  51 ;; (gnus-registry-initialize)
  52
  53 ;; Then use this in your fancy-split:
  54
  55 ;; (: gnus-registry-split-fancy-with-parent)
  56
  57 ;; You should also consider using the nnregistry backend to look up
  58 ;; articles.  See the Gnus manual for more information.
  59
  60 ;; TODO:
  61
  62 ;; - get the correct group on spool actions
  63
  64 ;; - articles that are spooled to a different backend should be moved
  65 ;;   after splitting
  66
  67 ;;; Code:
  68
  69 (eval-when-compile (require 'cl))
  70
  71 (eval-when-compile
  72   (when (null (ignore-errors (require 'ert)))
  73     (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
  74
  75 (ignore-errors
  76   (require 'ert))
  77 (require 'gnus)
  78 (require 'gnus-int)
  79 (require 'gnus-sum)
  80 (require 'gnus-art)
  81 (require 'gnus-util)
  82 (require 'nnmail)
  83 (require 'easymenu)
  84 (require 'registry)
  85
  86 (defvar gnus-adaptive-word-syntax-table)
  87
  88 (defvar gnus-registry-dirty t
  89  "Boolean set to t when the registry is modified")
  90
  91 (defgroup gnus-registry nil
  92   "The Gnus registry."
  93   :version "22.1"
  94   :group 'gnus)
  95
  96 (defvar gnus-registry-marks
  97   '((Important
  98      :char ?i
  99      :image "summary_important")
 100     (Work
 101      :char ?w
 102      :image "summary_work")
 103     (Personal
 104      :char ?p
 105      :image "summary_personal")
 106     (To-Do
 107      :char ?t
 108      :image "summary_todo")
 109     (Later
 110      :char ?l
 111      :image "summary_later"))
 112
 113   "List of registry marks and their options.
 114
 115 `gnus-registry-mark-article' will offer symbols from this list
 116 for completion.
 117
 118 Each entry must have a character to be useful for summary mode
 119 line display and for keyboard shortcuts.
 120
 121 Each entry must have an image string to be useful for visual
 122 display.")
 123
 124 (defcustom gnus-registry-default-mark 'To-Do
 125   "The default mark.  Should be a valid key for `gnus-registry-marks'."
 126   :group 'gnus-registry
 127   :type 'symbol)
 128
 129 (defcustom gnus-registry-unfollowed-addresses
 130   (list (regexp-quote user-mail-address))
 131   "List of addresses that gnus-registry-split-fancy-with-parent won't trace.
 132 The addresses are matched, they don't have to be fully qualified.
 133 In the messages, these addresses can be the sender or the
 134 recipients."
 135   :group 'gnus-registry
 136   :type '(repeat regexp))
 137
 138 (defcustom gnus-registry-unfollowed-groups
 139   '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive")
 140   "List of groups that gnus-registry-split-fancy-with-parent won't return.
 141 The group names are matched, they don't have to be fully
 142 qualified.  This parameter tells the Gnus registry 'never split a
 143 message into a group that matches one of these, regardless of
 144 references.'
 145
 146 nnmairix groups are specifically excluded because they are ephemeral."
 147   :group 'gnus-registry
 148   :type '(repeat regexp))
 149
 150 (defcustom gnus-registry-install 'ask
 151   "Whether the registry should be installed."
 152   :group 'gnus-registry
 153   :type '(choice (const :tag "Never Install" nil)
 154                  (const :tag "Always Install" t)
 155                  (const :tag "Ask Me" ask)))
 156
 157 (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
 158
 159 (defvar gnus-registry-misc-menus nil)   ; ugly way to keep the menus
 160
 161 (make-obsolete-variable 'gnus-registry-clean-empty nil "23.4")
 162 (make-obsolete-variable 'gnus-registry-use-long-group-names nil "23.4")
 163 (make-obsolete-variable 'gnus-registry-max-track-groups nil "23.4")
 164 (make-obsolete-variable 'gnus-registry-entry-caching nil "23.4")
 165 (make-obsolete-variable 'gnus-registry-trim-articles-without-groups nil "23.4")
 166
 167 (defcustom gnus-registry-track-extra '(subject sender recipient)
 168   "Whether the registry should track extra data about a message.
 169 The subject, recipients (To: and Cc:), and Sender (From:) headers
 170 are tracked this way by default."
 171   :group 'gnus-registry
 172   :type
 173   '(set :tag "Tracking choices"
 174     (const :tag "Track by subject (Subject: header)" subject)
 175     (const :tag "Track by recipient (To: and Cc: headers)" recipient)
 176     (const :tag "Track by sender (From: header)"  sender)))
 177
 178 (defcustom gnus-registry-split-strategy nil
 179   "The splitting strategy applied to the keys in `gnus-registry-track-extra'.
 180
 181 Given a set of unique found groups G and counts for each element
 182 of G, and a key K (typically 'sender or 'subject):
 183
 184 When nil, if G has only one element, use it.  Otherwise give up.
 185 This is the fastest but also least useful strategy.
 186
 187 When 'majority, use the majority by count.  So if there is a
 188 group with the most articles counted by K, use that.  Ties are
 189 resolved in no particular order, simply the first one found wins.
 190 This is the slowest strategy but also the most accurate one.
 191
 192 When 'first, the first element of G wins.  This is fast and
 193 should be OK if your senders and subjects don't \"bleed\" across
 194 groups."
 195   :group 'gnus-registry
 196   :type
 197   '(choice :tag "Splitting strategy"
 198            (const :tag "Only use single choices, discard multiple matches" nil)
 199            (const :tag "Majority of matches wins" majority)
 200            (const :tag "First found wins"  first)))
 201
 202 (defcustom gnus-registry-minimum-subject-length 5
 203   "The minimum length of a subject before it's considered trackable."
 204   :group 'gnus-registry
 205   :type 'integer)
 206
 207 (defcustom gnus-registry-extra-entries-precious '(mark)
 208   "What extra keys are precious, meaning entries with them won't get pruned.
 209 By default, 'mark is included, so articles with marks are
 210 considered precious.
 211
 212 Before you save the Gnus registry, it's pruned.  Any entries with
 213 keys in this list will not be pruned.  All other entries go to
 214 the Bit Bucket."
 215   :group 'gnus-registry
 216   :type '(repeat symbol))
 217
 218 (defcustom gnus-registry-cache-file
 219   (nnheader-concat
 220    (or gnus-dribble-directory gnus-home-directory "~/")
 221    ".gnus.registry.eioio")
 222   "File where the Gnus registry will be stored."
 223   :group 'gnus-registry
 224   :type 'file)
 225
 226 (defcustom gnus-registry-max-entries nil
 227   "Maximum number of entries in the registry, nil for unlimited."
 228   :group 'gnus-registry
 229   :type '(radio (const :format "Unlimited " nil)
 230                 (integer :format "Maximum number: %v")))
 231
 232 (defcustom gnus-registry-max-pruned-entries nil
 233   "Maximum number of pruned entries in the registry, nil for unlimited."
 234   :group 'gnus-registry
 235   :type '(radio (const :format "Unlimited " nil)
 236                 (integer :format "Maximum number: %v")))
 237
 238 (defun gnus-registry-fixup-registry (db)
 239   (when db
 240     (let ((old (oref db :tracked)))
 241       (oset db :precious
 242             (append gnus-registry-extra-entries-precious
 243                     '()))
 244       (oset db :max-hard
 245             (or gnus-registry-max-entries
 246                 most-positive-fixnum))
 247       (oset db :prune-factor
 248             0.1)
 249       (oset db :max-soft
 250             (or gnus-registry-max-pruned-entries
 251                 most-positive-fixnum))
 252       (oset db :tracked
 253             (append gnus-registry-track-extra
 254                     '(mark group keyword)))
 255       (when (not (equal old (oref db :tracked)))
 256         (gnus-message 4 "Reindexing the Gnus registry (tracked change)")
 257         (registry-reindex db))))
 258   db)
 259
 260 (defun gnus-registry-make-db (&optional file)
 261   (interactive "fGnus registry persistence file: \n")
 262   (gnus-registry-fixup-registry
 263    (registry-db
 264     "Gnus Registry"
 265     :file (or file gnus-registry-cache-file)
 266     ;; these parameters are set in `gnus-registry-fixup-registry'
 267     :max-hard most-positive-fixnum
 268     :max-soft most-positive-fixnum
 269     :precious nil
 270     :tracked nil)))
 271
 272 (defvar gnus-registry-db (gnus-registry-make-db)
 273   "*The article registry by Message ID.  See `registry-db'")
 274
 275 ;; top-level registry data management
 276 (defun gnus-registry-remake-db (&optional forsure)
 277   "Remake the registry database after customization.
 278 This is not required after changing `gnus-registry-cache-file'."
 279   (interactive (list (y-or-n-p "Remake and CLEAR the Gnus registry? ")))
 280   (when forsure
 281     (gnus-message 4 "Remaking the Gnus registry")
 282     (setq gnus-registry-db (gnus-registry-make-db))))
 283
 284 (defun gnus-registry-read ()
 285   "Read the registry cache file."
 286   (interactive)
 287   (let ((file gnus-registry-cache-file))
 288     (condition-case nil
 289         (progn
 290           (gnus-message 5 "Reading Gnus registry from %s..." file)
 291           (setq gnus-registry-db (gnus-registry-fixup-registry
 292                                   (eieio-persistent-read file)))
 293           (gnus-message 5 "Reading Gnus registry from %s...done" file))
 294       (error
 295        (gnus-message
 296         1
 297         "The Gnus registry could not be loaded from %s, creating a new one"
 298         file)
 299        (gnus-registry-remake-db t)))))
 300
 301 (defun gnus-registry-save (&optional file db)
 302   "Save the registry cache file."
 303   (interactive)
 304   (let ((file (or file gnus-registry-cache-file))
 305         (db (or db gnus-registry-db)))
 306     (gnus-message 5 "Saving Gnus registry (%d entries) to %s..."
 307                   (registry-size db) file)
 308     (registry-prune db)
 309     ;; TODO: call (gnus-string-remove-all-properties v) on all elements?
 310     (eieio-persistent-save db file)
 311     (gnus-message 5 "Saving Gnus registry (size %d) to %s...done"
 312                   (registry-size db) file)))
 313
 314 ;; article move/copy/spool/delete actions
 315 (defun gnus-registry-action (action data-header from &optional to method)
 316   (let* ((id (mail-header-id data-header))
 317          (subject (mail-header-subject data-header))
 318          (extra (mail-header-extra data-header))
 319          (recipients (gnus-registry-sort-addresses
 320                       (or (cdr-safe (assq 'Cc extra)) "")
 321                       (or (cdr-safe (assq 'To extra)) "")))
 322          (sender (nth 0 (gnus-registry-extract-addresses
 323                          (mail-header-from data-header))))
 324          (from (gnus-group-guess-full-name-from-command-method from))
 325          (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
 326          (to-name (if to to "the Bit Bucket")))
 327     (gnus-message 7 "Gnus registry: article %s %s from %s to %s"
 328                   id (if method "respooling" "going") from to)
 329
 330     (gnus-registry-handle-action
 331      id
 332      ;; unless copying, remove the old "from" group
 333      (if (not (equal 'copy action)) from nil)
 334      to subject sender recipients)))
 335
 336 (defun gnus-registry-spool-action (id group &optional subject sender recipients)
 337   (let ((to (gnus-group-guess-full-name-from-command-method group))
 338         (recipients (or recipients
 339                         (gnus-registry-sort-addresses
 340                          (or (message-fetch-field "cc") "")
 341                          (or (message-fetch-field "to") ""))))
 342         (subject (or subject (message-fetch-field "subject")))
 343         (sender (or sender (message-fetch-field "from"))))
 344     (when (and (stringp id) (string-match "\r$" id))
 345       (setq id (substring id 0 -1)))
 346     (gnus-message 7 "Gnus registry: article %s spooled to %s"
 347                   id
 348                   to)
 349     (gnus-registry-handle-action id nil to subject sender recipients)))
 350
 351 (defun gnus-registry-handle-action (id from to subject sender
 352                                        &optional recipients)
 353   (gnus-message
 354    10
 355    "gnus-registry-handle-action %S" (list id from to subject sender recipients))
 356   (let ((db gnus-registry-db)
 357         ;; if the group is ignored, set the destination to nil (same as delete)
 358         (to (if (gnus-registry-ignore-group-p to) nil to))
 359         ;; safe if not found
 360         (entry (gnus-registry-get-or-make-entry id))
 361         (subject (gnus-string-remove-all-properties
 362                   (gnus-registry-simplify-subject subject)))
 363         (sender (gnus-string-remove-all-properties sender)))
 364
 365     ;; this could be done by calling `gnus-registry-set-id-key'
 366     ;; several times but it's better to bunch the transactions
 367     ;; together
 368
 369     (registry-delete db (list id) nil)
 370     (when from
 371       (setq entry (cons (delete from (assoc 'group entry))
 372                         (assq-delete-all 'group entry))))
 373
 374     (dolist (kv `((group ,to)
 375                   (sender ,sender)
 376                   (recipient ,@recipients)
 377                   (subject ,subject)))
 378       (when (second kv)
 379         (let ((new (or (assq (first kv) entry)
 380                        (list (first kv)))))
 381           (dolist (toadd (cdr kv))
 382             (add-to-list 'new toadd t))
 383           (setq entry (cons new
 384                             (assq-delete-all (first kv) entry))))))
 385     (gnus-message 10 "Gnus registry: new entry for %s is %S"
 386                   id
 387                   entry)
 388     (gnus-registry-insert db id entry)))
 389
 390 ;; Function for nn{mail|imap}-split-fancy: look up all references in
 391 ;; the cache and if a match is found, return that group.
 392 (defun gnus-registry-split-fancy-with-parent ()
 393   "Split this message into the same group as its parent.  The parent
 394 is obtained from the registry.  This function can be used as an entry
 395 in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
 396 this: (: gnus-registry-split-fancy-with-parent)
 397
 398 This function tracks ALL backends, unlike
 399 `nnmail-split-fancy-with-parent' which tracks only nnmail
 400 messages.
 401
 402 For a message to be split, it looks for the parent message in the
 403 References or In-Reply-To header and then looks in the registry
 404 to see which group that message was put in.  This group is
 405 returned, unless `gnus-registry-follow-group-p' return nil for
 406 that group.
 407
 408 See the Info node `(gnus)Fancy Mail Splitting' for more details."
 409   (let* ((refstr (or (message-fetch-field "references") "")) ; guaranteed
 410          (reply-to (message-fetch-field "in-reply-to"))      ; may be nil
 411          ;; now, if reply-to is valid, append it to the References
 412          (refstr (if reply-to
 413                      (concat refstr " " reply-to)
 414                    refstr))
 415          (references (and refstr (gnus-extract-references refstr)))
 416          ;; these may not be used, but the code is cleaner having them up here
 417          (sender (gnus-string-remove-all-properties
 418                   (message-fetch-field "from")))
 419          (recipients (gnus-registry-sort-addresses
 420                       (or (message-fetch-field "cc") "")
 421                       (or (message-fetch-field "to") "")))
 422          (subject (gnus-string-remove-all-properties
 423                    (gnus-registry-simplify-subject
 424                     (message-fetch-field "subject"))))
 425
 426          (nnmail-split-fancy-with-parent-ignore-groups
 427           (if (listp nnmail-split-fancy-with-parent-ignore-groups)
 428               nnmail-split-fancy-with-parent-ignore-groups
 429             (list nnmail-split-fancy-with-parent-ignore-groups))))
 430     (gnus-registry--split-fancy-with-parent-internal
 431      :references references
 432      :refstr refstr
 433      :sender sender
 434      :recipients recipients
 435      :subject subject
 436      :log-agent "Gnus registry fancy splitting with parent")))
 437
 438 (defun* gnus-registry--split-fancy-with-parent-internal
 439     (&rest spec
 440            &key references refstr sender subject recipients log-agent
 441            &allow-other-keys)
 442   (gnus-message
 443    10
 444    "gnus-registry--split-fancy-with-parent-internal %S" spec)
 445   (let ((db gnus-registry-db)
 446         found)
 447     ;; this is a big chain of statements.  it uses
 448     ;; gnus-registry-post-process-groups to filter the results after
 449     ;; every step.
 450     ;; the references string must be valid and parse to valid references
 451     (when references
 452       (gnus-message
 453        9
 454        "%s is tracing references %s"
 455        log-agent refstr)
 456       (dolist (reference (nreverse references))
 457         (gnus-message 9 "%s is looking up %s" log-agent reference)
 458         (loop for group in (gnus-registry-get-id-key reference 'group)
 459               when (gnus-registry-follow-group-p group)
 460               do
 461               (progn
 462                 (gnus-message 7 "%s traced %s to %s" log-agent reference group)
 463                 (push group found))))
 464       ;; filter the found groups and return them
 465       ;; the found groups are the full groups
 466       (setq found (gnus-registry-post-process-groups
 467                    "references" refstr found)))
 468
 469      ;; else: there were no matches, now try the extra tracking by subject
 470      (when (and (null found)
 471                 (memq 'subject gnus-registry-track-extra)
 472                 subject
 473                 (< gnus-registry-minimum-subject-length (length subject)))
 474        (let ((groups (apply
 475                       'append
 476                       (mapcar
 477                        (lambda (reference)
 478                          (gnus-registry-get-id-key reference 'group))
 479                        (registry-lookup-secondary-value db 'subject subject)))))
 480          (setq found
 481                (loop for group in groups
 482                      when (gnus-registry-follow-group-p group)
 483                      do (gnus-message
 484                          ;; warn more if gnus-registry-track-extra
 485                          (if gnus-registry-track-extra 7 9)
 486                          "%s (extra tracking) traced subject '%s' to %s"
 487                          log-agent subject group)
 488                     and collect group))
 489          ;; filter the found groups and return them
 490          ;; the found groups are NOT the full groups
 491          (setq found (gnus-registry-post-process-groups
 492                       "subject" subject found))))
 493
 494      ;; else: there were no matches, try the extra tracking by sender
 495      (when (and (null found)
 496                 (memq 'sender gnus-registry-track-extra)
 497                 sender
 498                 (not (gnus-grep-in-list
 499                       sender
 500                       gnus-registry-unfollowed-addresses)))
 501        (let ((groups (apply
 502                       'append
 503                       (mapcar
 504                        (lambda (reference)
 505                          (gnus-registry-get-id-key reference 'group))
 506                        (registry-lookup-secondary-value db 'sender sender)))))
 507          (setq found
 508                (loop for group in groups
 509                      when (gnus-registry-follow-group-p group)
 510                      do (gnus-message
 511                          ;; warn more if gnus-registry-track-extra
 512                          (if gnus-registry-track-extra 7 9)
 513                          "%s (extra tracking) traced sender '%s' to %s"
 514                          log-agent sender group)
 515                      and collect group)))
 516
 517        ;; filter the found groups and return them
 518        ;; the found groups are NOT the full groups
 519        (setq found (gnus-registry-post-process-groups
 520                     "sender" sender found)))
 521
 522      ;; else: there were no matches, try the extra tracking by recipient
 523      (when (and (null found)
 524                 (memq 'recipient gnus-registry-track-extra)
 525                 recipients)
 526        (dolist (recp recipients)
 527          (when (and (null found)
 528                     (not (gnus-grep-in-list
 529                           recp
 530                           gnus-registry-unfollowed-addresses)))
 531            (let ((groups (apply 'append
 532                                 (mapcar
 533                                  (lambda (reference)
 534                                    (gnus-registry-get-id-key reference 'group))
 535                                  (registry-lookup-secondary-value
 536                                   db 'recipient recp)))))
 537              (setq found
 538                    (loop for group in groups
 539                          when (gnus-registry-follow-group-p group)
 540                          do (gnus-message
 541                              ;; warn more if gnus-registry-track-extra
 542                              (if gnus-registry-track-extra 7 9)
 543                              "%s (extra tracking) traced recipient '%s' to %s"
 544                              log-agent recp group)
 545                         and collect group)))))
 546
 547        ;; filter the found groups and return them
 548        ;; the found groups are NOT the full groups
 549        (setq found (gnus-registry-post-process-groups
 550                     "recipients" (mapconcat 'identity recipients ", ") found)))
 551
 552      ;; after the (cond) we extract the actual value safely
 553      (car-safe found)))
 554
 555 (defun gnus-registry-post-process-groups (mode key groups)
 556   "Inspects GROUPS found by MODE for KEY to determine which ones to follow.
 557
 558 MODE can be 'subject' or 'sender' for example.  The KEY is the
 559 value by which MODE was searched.
 560
 561 Transforms each group name to the equivalent short name.
 562
 563 Checks if the current Gnus method (from `gnus-command-method' or
 564 from `gnus-newsgroup-name') is the same as the group's method.
 565 Foreign methods are not supported so they are rejected.
 566
 567 Reduces the list to a single group, or complains if that's not
 568 possible.  Uses `gnus-registry-split-strategy'."
 569   (let ((log-agent "gnus-registry-post-process-group")
 570         (desc (format "%d groups" (length groups)))
 571         out chosen)
 572     ;; the strategy can be nil, in which case chosen is nil
 573     (setq chosen
 574           (case gnus-registry-split-strategy
 575             ;; default, take only one-element lists into chosen
 576             ((nil)
 577              (and (= (length groups) 1)
 578                   (car-safe groups)))
 579
 580             ((first)
 581              (car-safe groups))
 582
 583             ((majority)
 584              (let ((freq (make-hash-table
 585                           :size 256
 586                           :test 'equal)))
 587                (mapc (lambda (x) (let ((x (gnus-group-short-name x)))
 588                               (puthash x (1+ (gethash x freq 0)) freq)))
 589                      groups)
 590                (setq desc (format "%d groups, %d unique"
 591                                   (length groups)
 592                                   (hash-table-count freq)))
 593                (car-safe
 594                 (sort groups
 595                       (lambda (a b)
 596                         (> (gethash (gnus-group-short-name a) freq 0)
 597                            (gethash (gnus-group-short-name b) freq 0)))))))))
 598
 599     (if chosen
 600         (gnus-message
 601          9
 602          "%s: strategy %s on %s produced %s"
 603          log-agent gnus-registry-split-strategy desc chosen)
 604       (gnus-message
 605        9
 606        "%s: strategy %s on %s did not produce an answer"
 607        log-agent
 608        (or gnus-registry-split-strategy "default")
 609        desc))
 610
 611     (setq groups (and chosen (list chosen)))
 612
 613     (dolist (group groups)
 614       (let ((m1 (gnus-find-method-for-group group))
 615             (m2 (or gnus-command-method
 616                     (gnus-find-method-for-group gnus-newsgroup-name)))
 617             (short-name (gnus-group-short-name group)))
 618         (if (gnus-methods-equal-p m1 m2)
 619             (progn
 620               ;; this is REALLY just for debugging
 621               (when (not (equal group short-name))
 622                 (gnus-message
 623                  10
 624                  "%s: stripped group %s to %s"
 625                  log-agent group short-name))
 626               (add-to-list 'out short-name))
 627           ;; else...
 628           (gnus-message
 629            7
 630            "%s: ignored foreign group %s"
 631            log-agent group))))
 632
 633     (setq out (delq nil out))
 634
 635     (cond
 636      ((= (length out) 1) out)
 637      ((null out)
 638       (gnus-message
 639        5
 640        "%s: no matches for %s '%s'."
 641        log-agent mode key)
 642       nil)
 643      (t (gnus-message
 644          5
 645          "%s: too many extra matches (%s) for %s '%s'.  Returning none."
 646          log-agent out mode key)
 647         nil))))
 648
 649 (defun gnus-registry-follow-group-p (group)
 650   "Determines if a group name should be followed.
 651 Consults `gnus-registry-unfollowed-groups' and
 652 `nnmail-split-fancy-with-parent-ignore-groups'."
 653   (and group
 654        (not (or (gnus-grep-in-list
 655                  group
 656                  gnus-registry-unfollowed-groups)
 657                 (gnus-grep-in-list
 658                  group
 659                  nnmail-split-fancy-with-parent-ignore-groups)))))
 660
 661 ;; note that gnus-registry-ignored-groups is defined in gnus.el as a
 662 ;; group/topic parameter and an associated variable!
 663
 664 ;; we do special logic for ignoring to accept regular expressions and
 665 ;; nnmail-split-fancy-with-parent-ignore-groups as well
 666 (defun gnus-registry-ignore-group-p (group)
 667   "Determines if a group name should be ignored.
 668 Consults `gnus-registry-ignored-groups' and
 669 `nnmail-split-fancy-with-parent-ignore-groups'."
 670   (and group
 671        (or (gnus-grep-in-list
 672             group
 673             (delq nil (mapcar (lambda (g)
 674                                 (cond
 675                                  ((stringp g) g)
 676                                  ((and (listp g) (nth 1 g))
 677                                   (nth 0 g))
 678                                  (t nil))) gnus-registry-ignored-groups)))
 679            ;; only use `gnus-parameter-registry-ignore' if
 680            ;; `gnus-registry-ignored-groups' is a list of lists
 681            ;; (it can be a list of regexes)
 682            (and (listp (nth 0 gnus-registry-ignored-groups))
 683                 (get-buffer "*Group*")  ; in automatic tests this is false
 684                 (gnus-parameter-registry-ignore group))
 685            (gnus-grep-in-list
 686             group
 687             nnmail-split-fancy-with-parent-ignore-groups))))
 688
 689 (defun gnus-registry-wash-for-keywords (&optional force)
 690   "Get the keywords of the current article.
 691 Overrides existing keywords with FORCE set non-nil."
 692   (interactive)
 693   (let ((id (gnus-registry-fetch-message-id-fast gnus-current-article))
 694         word words)
 695     (if (or (not (gnus-registry-get-id-key id 'keyword))
 696             force)
 697         (with-current-buffer gnus-article-buffer
 698           (article-goto-body)
 699           (save-window-excursion
 700             (save-restriction
 701               (narrow-to-region (point) (point-max))
 702               (with-syntax-table gnus-adaptive-word-syntax-table
 703                 (while (re-search-forward "\\b\\w+\\b" nil t)
 704                   (setq word (gnus-string-remove-all-properties
 705                               (downcase (buffer-substring
 706                                          (match-beginning 0) (match-end 0)))))
 707                   (if (> (length word) 2)
 708                       (push word words))))))
 709           (gnus-registry-set-id-key id 'keyword words)))))
 710
 711 (defun gnus-registry-keywords ()
 712   (let ((table (registry-lookup-secondary gnus-registry-db 'keyword)))
 713     (when table (maphash (lambda (k v) k) table))))
 714
 715 (defun gnus-registry-find-keywords (keyword)
 716   (interactive (list
 717                 (completing-read "Keyword: " (gnus-registry-keywords) nil t)))
 718   (registry-lookup-secondary-value gnus-registry-db 'keyword keyword))
 719
 720 (defun gnus-registry-register-message-ids ()
 721   "Register the Message-ID of every article in the group"
 722   (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
 723     (dolist (article gnus-newsgroup-articles)
 724       (let* ((id (gnus-registry-fetch-message-id-fast article))
 725              (groups (gnus-registry-get-id-key id 'group)))
 726         (unless (member gnus-newsgroup-name groups)
 727           (gnus-message 9 "Registry: Registering article %d with group %s"
 728                         article gnus-newsgroup-name)
 729           (gnus-registry-handle-action id nil gnus-newsgroup-name
 730            (gnus-registry-fetch-simplified-message-subject-fast article)
 731            (gnus-registry-fetch-sender-fast article)
 732            (gnus-registry-fetch-recipients-fast article)))))))
 733
 734 ;; message field fetchers
 735 (defun gnus-registry-fetch-message-id-fast (article)
 736   "Fetch the Message-ID quickly, using the internal gnus-data-list function"
 737   (if (and (numberp article)
 738            (assoc article (gnus-data-list nil)))
 739       (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
 740     nil))
 741
 742 (defun gnus-registry-extract-addresses (text)
 743   "Extract all the addresses in a normalized way from TEXT.
 744 Returns an unsorted list of strings in the name <address> format.
 745 Addresses without a name will say \"noname\"."
 746   (mapcar (lambda (add)
 747             (gnus-string-remove-all-properties
 748              (let* ((name (or (nth 0 add) "noname"))
 749                     (addr (nth 1 add))
 750                     (addr (if (bufferp addr)
 751                               (with-current-buffer addr
 752                                 (buffer-string))
 753                             addr)))
 754                (format "%s <%s>" name addr))))
 755           (mail-extract-address-components text t)))
 756
 757 (defun gnus-registry-sort-addresses (&rest addresses)
 758   "Return a normalized and sorted list of ADDRESSES."
 759   (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses))
 760         'string-lessp))
 761
 762 (defun gnus-registry-simplify-subject (subject)
 763   (if (stringp subject)
 764       (gnus-simplify-subject subject)
 765     nil))
 766
 767 (defun gnus-registry-fetch-simplified-message-subject-fast (article)
 768   "Fetch the Subject quickly, using the internal gnus-data-list function"
 769   (if (and (numberp article)
 770            (assoc article (gnus-data-list nil)))
 771       (gnus-string-remove-all-properties
 772        (gnus-registry-simplify-subject
 773         (mail-header-subject (gnus-data-header
 774                               (assoc article (gnus-data-list nil))))))
 775     nil))
 776
 777 (defun gnus-registry-fetch-sender-fast (article)
 778   (gnus-registry-fetch-header-fast "from" article))
 779
 780 (defun gnus-registry-fetch-recipients-fast (article)
 781   (gnus-registry-sort-addresses
 782    (or (ignore-errors (gnus-registry-fetch-header-fast "Cc" article)) "")
 783    (or (ignore-errors (gnus-registry-fetch-header-fast "To" article)) "")))
 784
 785 (defun gnus-registry-fetch-header-fast (article header)
 786   "Fetch the HEADER quickly, using the internal gnus-data-list function"
 787   (if (and (numberp article)
 788            (assoc article (gnus-data-list nil)))
 789       (gnus-string-remove-all-properties
 790        (cdr (assq header (gnus-data-header
 791                           (assoc article (gnus-data-list nil))))))
 792     nil))
 793
 794 ;; registry marks glue
 795 (defun gnus-registry-do-marks (type function)
 796   "For each known mark, call FUNCTION for each cell of type TYPE.
 797
 798 FUNCTION should take two parameters, a mark symbol and the cell value."
 799   (dolist (mark-info gnus-registry-marks)
 800     (let* ((mark (car-safe mark-info))
 801            (data (cdr-safe mark-info))
 802            (cell-data (plist-get data type)))
 803       (when cell-data
 804         (funcall function mark cell-data)))))
 805
 806 ;;; this is ugly code, but I don't know how to do it better
 807 (defun gnus-registry-install-shortcuts ()
 808   "Install the keyboard shortcuts and menus for the registry.
 809 Uses `gnus-registry-marks' to find what shortcuts to install."
 810   (let (keys-plist)
 811     (setq gnus-registry-misc-menus nil)
 812     (gnus-registry-do-marks
 813      :char
 814      (lambda (mark data)
 815        (let ((function-format
 816               (format "gnus-registry-%%s-article-%s-mark" mark)))
 817
 818 ;;; The following generates these functions:
 819 ;;; (defun gnus-registry-set-article-Important-mark (&rest articles)
 820 ;;;   "Apply the Important mark to process-marked ARTICLES."
 821 ;;;   (interactive (gnus-summary-work-articles current-prefix-arg))
 822 ;;;   (gnus-registry-set-article-mark-internal 'Important articles nil t))
 823 ;;; (defun gnus-registry-remove-article-Important-mark (&rest articles)
 824 ;;;   "Apply the Important mark to process-marked ARTICLES."
 825 ;;;   (interactive (gnus-summary-work-articles current-prefix-arg))
 826 ;;;   (gnus-registry-set-article-mark-internal 'Important articles t t))
 827
 828          (dolist (remove '(t nil))
 829            (let* ((variant-name (if remove "remove" "set"))
 830                   (function-name (format function-format variant-name))
 831                   (shortcut (format "%c" data))
 832                   (shortcut (if remove (upcase shortcut) shortcut)))
 833              (unintern function-name obarray)
 834              (eval
 835               `(defun
 836                  ;; function name
 837                  ,(intern function-name)
 838                  ;; parameter definition
 839                  (&rest articles)
 840                  ;; documentation
 841                  ,(format
 842                    "%s the %s mark over process-marked ARTICLES."
 843                    (upcase-initials variant-name)
 844                    mark)
 845                  ;; interactive definition
 846                  (interactive
 847                   (gnus-summary-work-articles current-prefix-arg))
 848                  ;; actual code
 849
 850                  ;; if this is called and the user doesn't want the
 851                  ;; registry enabled, we'll ask anyhow
 852                  (when (eq gnus-registry-install nil)
 853                    (setq gnus-registry-install 'ask))
 854
 855                  ;; now the user is asked if gnus-registry-install is 'ask
 856                  (when (gnus-registry-install-p)
 857                    (gnus-registry-set-article-mark-internal
 858                     ;; all this just to get the mark, I must be doing it wrong
 859                     (intern ,(symbol-name mark))
 860                     articles ,remove t)
 861                    (gnus-message
 862                     9
 863                     "Applying mark %s to %d articles"
 864                     ,(symbol-name mark) (length articles))
 865                    (dolist (article articles)
 866                      (gnus-summary-update-article
 867                       article
 868                       (assoc article (gnus-data-list nil)))))))
 869              (push (intern function-name) keys-plist)
 870              (push shortcut keys-plist)
 871              (push (vector (format "%s %s"
 872                                    (upcase-initials variant-name)
 873                                    (symbol-name mark))
 874                            (intern function-name) t)
 875                    gnus-registry-misc-menus)
 876              (gnus-message
 877               9
 878               "Defined mark handling function %s"
 879               function-name))))))
 880     (gnus-define-keys-1
 881      '(gnus-registry-mark-map "M" gnus-summary-mark-map)
 882      keys-plist)
 883     (add-hook 'gnus-summary-menu-hook
 884               (lambda ()
 885                 (easy-menu-add-item
 886                  gnus-summary-misc-menu
 887                  nil
 888                  (cons "Registry Marks" gnus-registry-misc-menus))))))
 889
 890 ;;; use like this:
 891 ;;; (defalias 'gnus-user-format-function-M
 892 ;;;           'gnus-registry-user-format-function-M)
 893 (defun gnus-registry-user-format-function-M (headers)
 894   (let* ((id (mail-header-message-id headers))
 895          (marks (when id (gnus-registry-get-id-key id 'mark))))
 896     (apply 'concat (mapcar (lambda (mark)
 897                              (let ((c
 898                                     (plist-get
 899                                      (cdr-safe
 900                                       (assoc mark gnus-registry-marks))
 901                                      :char)))
 902                                (if c
 903                                    (list c)
 904                                  nil)))
 905                            marks))))
 906
 907 (defun gnus-registry-read-mark ()
 908   "Read a mark name from the user with completion."
 909   (let ((mark (gnus-completing-read
 910                "Label"
 911                (mapcar 'symbol-name (mapcar 'car gnus-registry-marks))
 912                nil nil nil
 913                (symbol-name gnus-registry-default-mark))))
 914     (when (stringp mark)
 915       (intern mark))))
 916
 917 (defun gnus-registry-set-article-mark (&rest articles)
 918   "Apply a mark to process-marked ARTICLES."
 919   (interactive (gnus-summary-work-articles current-prefix-arg))
 920   (gnus-registry-set-article-mark-internal (gnus-registry-read-mark)
 921                                            articles nil t))
 922
 923 (defun gnus-registry-remove-article-mark (&rest articles)
 924   "Remove a mark from process-marked ARTICLES."
 925   (interactive (gnus-summary-work-articles current-prefix-arg))
 926   (gnus-registry-set-article-mark-internal (gnus-registry-read-mark)
 927                                            articles t t))
 928
 929 (defun gnus-registry-set-article-mark-internal (mark
 930                                                 articles
 931                                                 &optional remove
 932                                                 show-message)
 933   "Apply or remove MARK across a list of ARTICLES."
 934   (let ((article-id-list
 935          (mapcar 'gnus-registry-fetch-message-id-fast articles)))
 936     (dolist (id article-id-list)
 937       (let* ((marks (delq mark (gnus-registry-get-id-key id 'mark)))
 938              (marks (if remove marks (cons mark marks))))
 939         (when show-message
 940           (gnus-message 1 "%s mark %s with message ID %s, resulting in %S"
 941                         (if remove "Removing" "Adding")
 942                         mark id marks))
 943         (gnus-registry-set-id-key id 'mark marks)))))
 944
 945 (defun gnus-registry-get-article-marks (&rest articles)
 946   "Get the Gnus registry marks for ARTICLES and show them if interactive.
 947 Uses process/prefix conventions.  For multiple articles,
 948 only the last one's marks are returned."
 949   (interactive (gnus-summary-work-articles 1))
 950   (let* ((article (last articles))
 951          (id (gnus-registry-fetch-message-id-fast article))
 952          (marks (when id (gnus-registry-get-id-key id 'mark))))
 953     (when (interactive-p)
 954       (gnus-message 1 "Marks are %S" marks))
 955     marks))
 956
 957 (defun gnus-registry-group-count (id)
 958   "Get the number of groups of a message, based on the message ID."
 959   (length (gnus-registry-get-id-key id 'group)))
 960
 961 (defun gnus-registry-get-or-make-entry (id)
 962   (let* ((db gnus-registry-db)
 963          ;; safe if not found
 964          (entries (registry-lookup db (list id))))
 965
 966     (when (null entries)
 967       (gnus-registry-insert db id (list (list 'creation-time (current-time))
 968                                         '(group) '(sender) '(subject)))
 969       (setq entries (registry-lookup db (list id))))
 970
 971     (nth 1 (assoc id entries))))
 972
 973 (defun gnus-registry-delete-entries (idlist)
 974   (registry-delete gnus-registry-db idlist nil))
 975
 976 (defun gnus-registry-get-id-key (id key)
 977   (cdr-safe (assq key (gnus-registry-get-or-make-entry id))))
 978
 979 (defun gnus-registry-set-id-key (id key vals)
 980   (let* ((db gnus-registry-db)
 981          (entry (gnus-registry-get-or-make-entry id)))
 982     (registry-delete db (list id) nil)
 983     (setq entry (cons (cons key vals) (assq-delete-all key entry)))
 984     (gnus-registry-insert db id entry)
 985     entry))
 986
 987 (defun gnus-registry-insert (db id entry)
 988   "Just like `registry-insert' but tries to prune on error."
 989   (when (registry-full db)
 990     (message "Trying to prune the registry because it's full")
 991     (registry-prune db))
 992   (registry-insert db id entry)
 993   entry)
 994
 995 (defun gnus-registry-import-eld (file)
 996   (interactive "fOld registry file to import? ")
 997   ;; example content:
 998   ;;   (setq gnus-registry-alist '(
 999   ;; ("<messageID>" ((marks nil)
1000   ;;                 (mtime 19365 1776 440496)
1001   ;;                 (sender . "root (Cron Daemon)")
1002   ;;                 (subject . "Cron"))
1003   ;;  "cron" "nnml+private:cron")
1004   (load file t)
1005   (when (boundp 'gnus-registry-alist)
1006     (let* ((old (symbol-value 'gnus-registry-alist))
1007            (count 0)
1008            (expected (length old))
1009            entry)
1010       (while (car-safe old)
1011         (incf count)
1012         ;; don't use progress reporters for backwards compatibility
1013         (when (and (< 0 expected)
1014                    (= 0 (mod count 100)))
1015           (message "importing: %d of %d (%.2f%%)"
1016                    count expected (/ (* 100 count) expected)))
1017         (setq entry (car-safe old)
1018               old (cdr-safe old))
1019         (let* ((id (car-safe entry))
1020                (new-entry (gnus-registry-get-or-make-entry id))
1021                (rest (cdr-safe entry))
1022                (groups (loop for p in rest
1023                              when (stringp p)
1024                              collect p))
1025                extra-cell key val)
1026           ;; remove all the strings from the entry
1027           (dolist (elem rest)
1028             (if (stringp elem) (setq rest (delq elem rest))))
1029           (gnus-registry-set-id-key id 'group groups)
1030           ;; just use the first extra element
1031           (setq rest (car-safe rest))
1032           (while (car-safe rest)
1033             (setq extra-cell (car-safe rest)
1034                   key (car-safe extra-cell)
1035                   val (cdr-safe extra-cell)
1036                   rest (cdr-safe rest))
1037             (when (and val (atom val))
1038               (setq val (list val)))
1039             (gnus-registry-set-id-key id key val))))
1040       (message "Import done, collected %d entries" count))))
1041
1042 (ert-deftest gnus-registry-misc-test ()
1043   (should-error (gnus-registry-extract-addresses '("" "")))
1044
1045   (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
1046                    "noname <ed@you.me>"
1047                    "noname <cyd@stupidchicken.com>"
1048                    "noname <tzz@lifelogs.com>")
1049                  (gnus-registry-extract-addresses
1050                   (concat "Ted Zlatanov <tzz@lifelogs.com>, "
1051                           "ed <ed@you.me>, " ; "ed" is not a valid name here
1052                           "cyd@stupidchicken.com, "
1053                           "tzz@lifelogs.com")))))
1054
1055 (ert-deftest gnus-registry-usage-test ()
1056   (let* ((n 100)
1057          (tempfile (make-temp-file "gnus-registry-persist"))
1058          (db (gnus-registry-make-db tempfile))
1059          (gnus-registry-db db)
1060          back size)
1061     (message "Adding %d keys to the test Gnus registry" n)
1062     (dotimes (i n)
1063       (let ((id (number-to-string i)))
1064         (gnus-registry-handle-action id
1065                                      (if (>= 50 i) "fromgroup" nil)
1066                                      "togroup"
1067                                      (when (>= 70 i)
1068                                        (format "subject %d" (mod i 10)))
1069                                      (when (>= 80 i)
1070                                        (format "sender %d" (mod i 10))))))
1071     (message "Testing Gnus registry size is %d" n)
1072     (should (= n (registry-size db)))
1073     (message "Looking up individual keys (registry-lookup)")
1074     (should (equal (loop for e
1075                          in (mapcar 'cadr
1076                                     (registry-lookup db '("20" "83" "72")))
1077                          collect (assq 'subject e)
1078                          collect (assq 'sender e)
1079                          collect (assq 'group e))
1080                    '((subject "subject 0") (sender "sender 0") (group "togroup")
1081                      (subject) (sender) (group "togroup")
1082                      (subject) (sender "sender 2") (group "togroup"))))
1083
1084     (message "Looking up individual keys (gnus-registry-id-key)")
1085     (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
1086     (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
1087     (message "Trying to insert a duplicate key")
1088     (should-error (gnus-registry-insert db "55" '()))
1089     (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
1090     (should (gnus-registry-get-or-make-entry "22"))
1091     (message "Saving the Gnus registry to %s" tempfile)
1092     (should (gnus-registry-save tempfile db))
1093     (setq size (nth 7 (file-attributes tempfile)))
1094     (message "Saving the Gnus registry to %s: size %d" tempfile size)
1095     (should (< 0 size))
1096     (with-temp-buffer
1097       (insert-file-contents-literally tempfile)
1098       (should (looking-at (concat ";; Object "
1099                                   "Gnus Registry"
1100                                   "\n;; EIEIO PERSISTENT OBJECT"))))
1101     (message "Reading Gnus registry back")
1102     (setq back (eieio-persistent-read tempfile))
1103     (should back)
1104     (message "Read Gnus registry back: %d keys, expected %d==%d"
1105              (registry-size back) n (registry-size db))
1106     (should (= (registry-size back) n))
1107     (should (= (registry-size back) (registry-size db)))
1108     (delete-file tempfile)
1109     (message "Pruning Gnus registry to 0 by setting :max-soft")
1110     (oset db :max-soft 0)
1111     (registry-prune db)
1112     (should (= (registry-size db) 0)))
1113   (message "Done with Gnus registry usage testing."))
1114
1115 ;;;###autoload
1116 (defun gnus-registry-initialize ()
1117 "Initialize the Gnus registry."
1118   (interactive)
1119   (gnus-message 5 "Initializing the registry")
1120   (setq gnus-registry-install t)        ; in case it was 'ask or nil
1121   (gnus-registry-install-hooks)
1122   (gnus-registry-install-shortcuts)
1123   (gnus-registry-read))
1124
1125 ;;;###autoload
1126 (defun gnus-registry-install-hooks ()
1127   "Install the registry hooks."
1128   (interactive)
1129   (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
1130   (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
1131   (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
1132   (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
1133
1134   (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
1135   (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
1136
1137   (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
1138
1139 (defun gnus-registry-unload-hook ()
1140   "Uninstall the registry hooks."
1141   (interactive)
1142   (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
1143   (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
1144   (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
1145   (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
1146
1147   (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
1148   (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
1149
1150   (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
1151
1152 (add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
1153
1154 (defun gnus-registry-install-p ()
1155   (interactive)
1156   (when (eq gnus-registry-install 'ask)
1157     (setq gnus-registry-install
1158           (gnus-y-or-n-p
1159            (concat "Enable the Gnus registry?  "
1160                    "See the variable `gnus-registry-install' "
1161                    "to get rid of this query permanently. ")))
1162     (when gnus-registry-install
1163       ;; we just set gnus-registry-install to t, so initialize the registry!
1164       (gnus-registry-initialize)))
1165 ;;; we could call it here: (customize-variable 'gnus-registry-install)
1166   gnus-registry-install)
1167
1168 ;; TODO: a few things
1169
1170 (provide 'gnus-registry)
1171
1172 ;;; gnus-registry.el ends here