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 :max-soft
 248             (or gnus-registry-max-pruned-entries
 249                 most-positive-fixnum))
 250       (oset db :tracked
 251             (append gnus-registry-track-extra
 252                     '(mark group keyword)))
 253       (when (not (equal old (oref db :tracked)))
 254         (gnus-message 4 "Reindexing the Gnus registry (tracked change)")
 255         (registry-reindex db))))
 256   db)
 257
 258 (defun gnus-registry-make-db (&optional file)
 259   (interactive "fGnus registry persistence file: \n")
 260   (gnus-registry-fixup-registry
 261    (registry-db
 262     "Gnus Registry"
 263     :file (or file gnus-registry-cache-file)
 264     ;; these parameters are set in `gnus-registry-fixup-registry'
 265     :max-hard most-positive-fixnum
 266     :max-soft most-positive-fixnum
 267     :precious nil
 268     :tracked nil)))
 269
 270 (defvar gnus-registry-db (gnus-registry-make-db)
 271   "*The article registry by Message ID.  See `registry-db'")
 272
 273 ;; top-level registry data management
 274 (defun gnus-registry-remake-db (&optional forsure)
 275   "Remake the registry database after customization.
 276 This is not required after changing `gnus-registry-cache-file'."
 277   (interactive (list (y-or-n-p "Remake and CLEAR the Gnus registry? ")))
 278   (when forsure
 279     (gnus-message 4 "Remaking the Gnus registry")
 280     (setq gnus-registry-db (gnus-registry-make-db))))
 281
 282 (defun gnus-registry-read ()
 283   "Read the registry cache file."
 284   (interactive)
 285   (let ((file gnus-registry-cache-file))
 286     (condition-case nil
 287         (progn
 288           (gnus-message 5 "Reading Gnus registry from %s..." file)
 289           (setq gnus-registry-db (gnus-registry-fixup-registry
 290                                   (eieio-persistent-read file)))
 291           (gnus-message 5 "Reading Gnus registry from %s...done" file))
 292       (error
 293        (gnus-message
 294         1
 295         "The Gnus registry could not be loaded from %s, creating a new one"
 296         file)
 297        (gnus-registry-remake-db t)))))
 298
 299 (defun gnus-registry-save (&optional file db)
 300   "Save the registry cache file."
 301   (interactive)
 302   (let ((file (or file gnus-registry-cache-file))
 303         (db (or db gnus-registry-db)))
 304     (gnus-message 5 "Saving Gnus registry (%d entries) to %s..."
 305                   (registry-size db) file)
 306     (registry-prune db)
 307     ;; TODO: call (gnus-string-remove-all-properties v) on all elements?
 308     (eieio-persistent-save db file)
 309     (gnus-message 5 "Saving Gnus registry (size %d) to %s...done"
 310                   (registry-size db) file)))
 311
 312 ;; article move/copy/spool/delete actions
 313 (defun gnus-registry-action (action data-header from &optional to method)
 314   (let* ((id (mail-header-id data-header))
 315          (subject (mail-header-subject data-header))
 316          (extra (mail-header-extra data-header))
 317          (recipients (gnus-registry-sort-addresses
 318                       (or (cdr-safe (assq 'Cc extra)) "")
 319                       (or (cdr-safe (assq 'To extra)) "")))
 320          (sender (nth 0 (gnus-registry-extract-addresses
 321                          (mail-header-from data-header))))
 322          (from (gnus-group-guess-full-name-from-command-method from))
 323          (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
 324          (to-name (if to to "the Bit Bucket")))
 325     (gnus-message 7 "Gnus registry: article %s %s from %s to %s"
 326                   id (if method "respooling" "going") from to)
 327
 328     (gnus-registry-handle-action
 329      id
 330      ;; unless copying, remove the old "from" group
 331      (if (not (equal 'copy action)) from nil)
 332      to subject sender recipients)))
 333
 334 (defun gnus-registry-spool-action (id group &optional subject sender recipients)
 335   (let ((to (gnus-group-guess-full-name-from-command-method group))
 336         (recipients (or recipients
 337                         (gnus-registry-sort-addresses
 338                          (or (message-fetch-field "cc") "")
 339                          (or (message-fetch-field "to") ""))))
 340         (subject (or subject (message-fetch-field "subject")))
 341         (sender (or sender (message-fetch-field "from"))))
 342     (when (and (stringp id) (string-match "\r$" id))
 343       (setq id (substring id 0 -1)))
 344     (gnus-message 7 "Gnus registry: article %s spooled to %s"
 345                   id
 346                   to)
 347     (gnus-registry-handle-action id nil to subject sender recipients)))
 348
 349 (defun gnus-registry-handle-action (id from to subject sender
 350                                        &optional recipients)
 351   (gnus-message
 352    10
 353    "gnus-registry-handle-action %S" (list id from to subject sender recipients))
 354   (let ((db gnus-registry-db)
 355         ;; if the group is ignored, set the destination to nil (same as delete)
 356         (to (if (gnus-registry-ignore-group-p to) nil to))
 357         ;; safe if not found
 358         (entry (gnus-registry-get-or-make-entry id))
 359         (subject (gnus-string-remove-all-properties
 360                   (gnus-registry-simplify-subject subject)))
 361         (sender (gnus-string-remove-all-properties sender)))
 362
 363     ;; this could be done by calling `gnus-registry-set-id-key'
 364     ;; several times but it's better to bunch the transactions
 365     ;; together
 366
 367     (registry-delete db (list id) nil)
 368     (when from
 369       (setq entry (cons (delete from (assoc 'group entry))
 370                         (assq-delete-all 'group entry))))
 371
 372     (dolist (kv `((group ,to)
 373                   (sender ,sender)
 374                   (recipient ,@recipients)
 375                   (subject ,subject)))
 376       (when (second kv)
 377         (let ((new (or (assq (first kv) entry)
 378                        (list (first kv)))))
 379           (dolist (toadd (cdr kv))
 380             (add-to-list 'new toadd t))
 381           (setq entry (cons new
 382                             (assq-delete-all (first kv) entry))))))
 383     (gnus-message 10 "Gnus registry: new entry for %s is %S"
 384                   id
 385                   entry)
 386     (gnus-registry-insert db id entry)))
 387
 388 ;; Function for nn{mail|imap}-split-fancy: look up all references in
 389 ;; the cache and if a match is found, return that group.
 390 (defun gnus-registry-split-fancy-with-parent ()
 391   "Split this message into the same group as its parent.  The parent
 392 is obtained from the registry.  This function can be used as an entry
 393 in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
 394 this: (: gnus-registry-split-fancy-with-parent)
 395
 396 This function tracks ALL backends, unlike
 397 `nnmail-split-fancy-with-parent' which tracks only nnmail
 398 messages.
 399
 400 For a message to be split, it looks for the parent message in the
 401 References or In-Reply-To header and then looks in the registry
 402 to see which group that message was put in.  This group is
 403 returned, unless `gnus-registry-follow-group-p' return nil for
 404 that group.
 405
 406 See the Info node `(gnus)Fancy Mail Splitting' for more details."
 407   (let* ((refstr (or (message-fetch-field "references") "")) ; guaranteed
 408          (reply-to (message-fetch-field "in-reply-to"))      ; may be nil
 409          ;; now, if reply-to is valid, append it to the References
 410          (refstr (if reply-to
 411                      (concat refstr " " reply-to)
 412                    refstr))
 413          (references (and refstr (gnus-extract-references refstr)))
 414          ;; these may not be used, but the code is cleaner having them up here
 415          (sender (gnus-string-remove-all-properties
 416                   (message-fetch-field "from")))
 417          (recipients (gnus-registry-sort-addresses
 418                       (or (message-fetch-field "cc") "")
 419                       (or (message-fetch-field "to") "")))
 420          (subject (gnus-string-remove-all-properties
 421                    (gnus-registry-simplify-subject
 422                     (message-fetch-field "subject"))))
 423
 424          (nnmail-split-fancy-with-parent-ignore-groups
 425           (if (listp nnmail-split-fancy-with-parent-ignore-groups)
 426               nnmail-split-fancy-with-parent-ignore-groups
 427             (list nnmail-split-fancy-with-parent-ignore-groups))))
 428     (gnus-registry--split-fancy-with-parent-internal
 429      :references references
 430      :refstr refstr
 431      :sender sender
 432      :recipients recipients
 433      :subject subject
 434      :log-agent "Gnus registry fancy splitting with parent")))
 435
 436 (defun* gnus-registry--split-fancy-with-parent-internal
 437     (&rest spec
 438            &key references refstr sender subject recipients log-agent
 439            &allow-other-keys)
 440   (gnus-message
 441    10
 442    "gnus-registry--split-fancy-with-parent-internal %S" spec)
 443   (let ((db gnus-registry-db)
 444         found)
 445     ;; this is a big chain of statements.  it uses
 446     ;; gnus-registry-post-process-groups to filter the results after
 447     ;; every step.
 448     ;; the references string must be valid and parse to valid references
 449     (when references
 450       (gnus-message
 451        9
 452        "%s is tracing references %s"
 453        log-agent refstr)
 454       (dolist (reference (nreverse references))
 455         (gnus-message 9 "%s is looking up %s" log-agent reference)
 456         (loop for group in (gnus-registry-get-id-key reference 'group)
 457               when (gnus-registry-follow-group-p group)
 458               do
 459               (progn
 460                 (gnus-message 7 "%s traced %s to %s" log-agent reference group)
 461                 (push group found))))
 462       ;; filter the found groups and return them
 463       ;; the found groups are the full groups
 464       (setq found (gnus-registry-post-process-groups
 465                    "references" refstr found)))
 466
 467      ;; else: there were no matches, now try the extra tracking by subject
 468      (when (and (null found)
 469                 (memq 'subject gnus-registry-track-extra)
 470                 subject
 471                 (< gnus-registry-minimum-subject-length (length subject)))
 472        (let ((groups (apply
 473                       'append
 474                       (mapcar
 475                        (lambda (reference)
 476                          (gnus-registry-get-id-key reference 'group))
 477                        (registry-lookup-secondary-value db 'subject subject)))))
 478          (setq found
 479                (loop for group in groups
 480                      when (gnus-registry-follow-group-p group)
 481                      do (gnus-message
 482                          ;; warn more if gnus-registry-track-extra
 483                          (if gnus-registry-track-extra 7 9)
 484                          "%s (extra tracking) traced subject '%s' to %s"
 485                          log-agent subject group)
 486                     and collect group))
 487          ;; filter the found groups and return them
 488          ;; the found groups are NOT the full groups
 489          (setq found (gnus-registry-post-process-groups
 490                       "subject" subject found))))
 491
 492      ;; else: there were no matches, try the extra tracking by sender
 493      (when (and (null found)
 494                 (memq 'sender gnus-registry-track-extra)
 495                 sender
 496                 (not (gnus-grep-in-list
 497                       sender
 498                       gnus-registry-unfollowed-addresses)))
 499        (let ((groups (apply
 500                       'append
 501                       (mapcar
 502                        (lambda (reference)
 503                          (gnus-registry-get-id-key reference 'group))
 504                        (registry-lookup-secondary-value db 'sender sender)))))
 505          (setq found
 506                (loop for group in groups
 507                      when (gnus-registry-follow-group-p group)
 508                      do (gnus-message
 509                          ;; warn more if gnus-registry-track-extra
 510                          (if gnus-registry-track-extra 7 9)
 511                          "%s (extra tracking) traced sender '%s' to %s"
 512                          log-agent sender group)
 513                      and collect group)))
 514
 515        ;; filter the found groups and return them
 516        ;; the found groups are NOT the full groups
 517        (setq found (gnus-registry-post-process-groups
 518                     "sender" sender found)))
 519
 520      ;; else: there were no matches, try the extra tracking by recipient
 521      (when (and (null found)
 522                 (memq 'recipient gnus-registry-track-extra)
 523                 recipients)
 524        (dolist (recp recipients)
 525          (when (and (null found)
 526                     (not (gnus-grep-in-list
 527                           recp
 528                           gnus-registry-unfollowed-addresses)))
 529            (let ((groups (apply 'append
 530                                 (mapcar
 531                                  (lambda (reference)
 532                                    (gnus-registry-get-id-key reference 'group))
 533                                  (registry-lookup-secondary-value
 534                                   db 'recipient recp)))))
 535              (setq found
 536                    (loop for group in groups
 537                          when (gnus-registry-follow-group-p group)
 538                          do (gnus-message
 539                              ;; warn more if gnus-registry-track-extra
 540                              (if gnus-registry-track-extra 7 9)
 541                              "%s (extra tracking) traced recipient '%s' to %s"
 542                              log-agent recp group)
 543                         and collect group)))))
 544
 545        ;; filter the found groups and return them
 546        ;; the found groups are NOT the full groups
 547        (setq found (gnus-registry-post-process-groups
 548                     "recipients" (mapconcat 'identity recipients ", ") found)))
 549
 550      ;; after the (cond) we extract the actual value safely
 551      (car-safe found)))
 552
 553 (defun gnus-registry-post-process-groups (mode key groups)
 554   "Inspects GROUPS found by MODE for KEY to determine which ones to follow.
 555
 556 MODE can be 'subject' or 'sender' for example.  The KEY is the
 557 value by which MODE was searched.
 558
 559 Transforms each group name to the equivalent short name.
 560
 561 Checks if the current Gnus method (from `gnus-command-method' or
 562 from `gnus-newsgroup-name') is the same as the group's method.
 563 Foreign methods are not supported so they are rejected.
 564
 565 Reduces the list to a single group, or complains if that's not
 566 possible.  Uses `gnus-registry-split-strategy'."
 567   (let ((log-agent "gnus-registry-post-process-group")
 568         (desc (format "%d groups" (length groups)))
 569         out chosen)
 570     ;; the strategy can be nil, in which case chosen is nil
 571     (setq chosen
 572           (case gnus-registry-split-strategy
 573             ;; default, take only one-element lists into chosen
 574             ((nil)
 575              (and (= (length groups) 1)
 576                   (car-safe groups)))
 577
 578             ((first)
 579              (car-safe groups))
 580
 581             ((majority)
 582              (let ((freq (make-hash-table
 583                           :size 256
 584                           :test 'equal)))
 585                (mapc (lambda (x) (let ((x (gnus-group-short-name x)))
 586                               (puthash x (1+ (gethash x freq 0)) freq)))
 587                      groups)
 588                (setq desc (format "%d groups, %d unique"
 589                                   (length groups)
 590                                   (hash-table-count freq)))
 591                (car-safe
 592                 (sort groups
 593                       (lambda (a b)
 594                         (> (gethash (gnus-group-short-name a) freq 0)
 595                            (gethash (gnus-group-short-name b) freq 0)))))))))
 596
 597     (if chosen
 598         (gnus-message
 599          9
 600          "%s: strategy %s on %s produced %s"
 601          log-agent gnus-registry-split-strategy desc chosen)
 602       (gnus-message
 603        9
 604        "%s: strategy %s on %s did not produce an answer"
 605        log-agent
 606        (or gnus-registry-split-strategy "default")
 607        desc))
 608
 609     (setq groups (and chosen (list chosen)))
 610
 611     (dolist (group groups)
 612       (let ((m1 (gnus-find-method-for-group group))
 613             (m2 (or gnus-command-method
 614                     (gnus-find-method-for-group gnus-newsgroup-name)))
 615             (short-name (gnus-group-short-name group)))
 616         (if (gnus-methods-equal-p m1 m2)
 617             (progn
 618               ;; this is REALLY just for debugging
 619               (when (not (equal group short-name))
 620                 (gnus-message
 621                  10
 622                  "%s: stripped group %s to %s"
 623                  log-agent group short-name))
 624               (add-to-list 'out short-name))
 625           ;; else...
 626           (gnus-message
 627            7
 628            "%s: ignored foreign group %s"
 629            log-agent group))))
 630
 631     (setq out (delq nil out))
 632
 633     (cond
 634      ((= (length out) 1) out)
 635      ((null out)
 636       (gnus-message
 637        5
 638        "%s: no matches for %s '%s'."
 639        log-agent mode key)
 640       nil)
 641      (t (gnus-message
 642          5
 643          "%s: too many extra matches (%s) for %s '%s'.  Returning none."
 644          log-agent out mode key)
 645         nil))))
 646
 647 (defun gnus-registry-follow-group-p (group)
 648   "Determines if a group name should be followed.
 649 Consults `gnus-registry-unfollowed-groups' and
 650 `nnmail-split-fancy-with-parent-ignore-groups'."
 651   (and group
 652        (not (or (gnus-grep-in-list
 653                  group
 654                  gnus-registry-unfollowed-groups)
 655                 (gnus-grep-in-list
 656                  group
 657                  nnmail-split-fancy-with-parent-ignore-groups)))))
 658
 659 ;; note that gnus-registry-ignored-groups is defined in gnus.el as a
 660 ;; group/topic parameter and an associated variable!
 661
 662 ;; we do special logic for ignoring to accept regular expressions and
 663 ;; nnmail-split-fancy-with-parent-ignore-groups as well
 664 (defun gnus-registry-ignore-group-p (group)
 665   "Determines if a group name should be ignored.
 666 Consults `gnus-registry-ignored-groups' and
 667 `nnmail-split-fancy-with-parent-ignore-groups'."
 668   (and group
 669        (or (gnus-grep-in-list
 670             group
 671             (delq nil (mapcar (lambda (g)
 672                                 (cond
 673                                  ((stringp g) g)
 674                                  ((and (listp g) (nth 1 g))
 675                                   (nth 0 g))
 676                                  (t nil))) gnus-registry-ignored-groups)))
 677            ;; only use `gnus-parameter-registry-ignore' if
 678            ;; `gnus-registry-ignored-groups' is a list of lists
 679            ;; (it can be a list of regexes)
 680            (and (listp (nth 0 gnus-registry-ignored-groups))
 681                 (get-buffer "*Group*")  ; in automatic tests this is false
 682                 (gnus-parameter-registry-ignore group))
 683            (gnus-grep-in-list
 684             group
 685             nnmail-split-fancy-with-parent-ignore-groups))))
 686
 687 (defun gnus-registry-wash-for-keywords (&optional force)
 688   "Get the keywords of the current article.
 689 Overrides existing keywords with FORCE set non-nil."
 690   (interactive)
 691   (let ((id (gnus-registry-fetch-message-id-fast gnus-current-article))
 692         word words)
 693     (if (or (not (gnus-registry-get-id-key id 'keyword))
 694             force)
 695         (with-current-buffer gnus-article-buffer
 696           (article-goto-body)
 697           (save-window-excursion
 698             (save-restriction
 699               (narrow-to-region (point) (point-max))
 700               (with-syntax-table gnus-adaptive-word-syntax-table
 701                 (while (re-search-forward "\\b\\w+\\b" nil t)
 702                   (setq word (gnus-string-remove-all-properties
 703                               (downcase (buffer-substring
 704                                          (match-beginning 0) (match-end 0)))))
 705                   (if (> (length word) 2)
 706                       (push word words))))))
 707           (gnus-registry-set-id-key id 'keyword words)))))
 708
 709 (defun gnus-registry-keywords ()
 710   (let ((table (registry-lookup-secondary gnus-registry-db 'keyword)))
 711     (when table (maphash (lambda (k v) k) table))))
 712
 713 (defun gnus-registry-find-keywords (keyword)
 714   (interactive (list
 715                 (completing-read "Keyword: " (gnus-registry-keywords) nil t)))
 716   (registry-lookup-secondary-value gnus-registry-db 'keyword keyword))
 717
 718 (defun gnus-registry-register-message-ids ()
 719   "Register the Message-ID of every article in the group"
 720   (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
 721     (dolist (article gnus-newsgroup-articles)
 722       (let* ((id (gnus-registry-fetch-message-id-fast article))
 723              (groups (gnus-registry-get-id-key id 'group)))
 724         (unless (member gnus-newsgroup-name groups)
 725           (gnus-message 9 "Registry: Registering article %d with group %s"
 726                         article gnus-newsgroup-name)
 727           (gnus-registry-handle-action id nil gnus-newsgroup-name
 728            (gnus-registry-fetch-simplified-message-subject-fast article)
 729            (gnus-registry-fetch-sender-fast article)
 730            (gnus-registry-fetch-recipients-fast article)))))))
 731
 732 ;; message field fetchers
 733 (defun gnus-registry-fetch-message-id-fast (article)
 734   "Fetch the Message-ID quickly, using the internal gnus-data-list function"
 735   (if (and (numberp article)
 736            (assoc article (gnus-data-list nil)))
 737       (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
 738     nil))
 739
 740 (defun gnus-registry-extract-addresses (text)
 741   "Extract all the addresses in a normalized way from TEXT.
 742 Returns an unsorted list of strings in the name <address> format.
 743 Addresses without a name will say \"noname\"."
 744   (mapcar (lambda (add)
 745             (gnus-string-remove-all-properties
 746              (let* ((name (or (nth 0 add) "noname"))
 747                     (addr (nth 1 add))
 748                     (addr (if (bufferp addr)
 749                               (with-current-buffer addr
 750                                 (buffer-string))
 751                             addr)))
 752                (format "%s <%s>" name addr))))
 753           (mail-extract-address-components text t)))
 754
 755 (defun gnus-registry-sort-addresses (&rest addresses)
 756   "Return a normalized and sorted list of ADDRESSES."
 757   (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses))
 758         'string-lessp))
 759
 760 (defun gnus-registry-simplify-subject (subject)
 761   (if (stringp subject)
 762       (gnus-simplify-subject subject)
 763     nil))
 764
 765 (defun gnus-registry-fetch-simplified-message-subject-fast (article)
 766   "Fetch the Subject quickly, using the internal gnus-data-list function"
 767   (if (and (numberp article)
 768            (assoc article (gnus-data-list nil)))
 769       (gnus-string-remove-all-properties
 770        (gnus-registry-simplify-subject
 771         (mail-header-subject (gnus-data-header
 772                               (assoc article (gnus-data-list nil))))))
 773     nil))
 774
 775 (defun gnus-registry-fetch-sender-fast (article)
 776   (gnus-registry-fetch-header-fast "from" article))
 777
 778 (defun gnus-registry-fetch-recipients-fast (article)
 779   (gnus-registry-sort-addresses
 780    (or (ignore-errors (gnus-registry-fetch-header-fast "Cc" article)) "")
 781    (or (ignore-errors (gnus-registry-fetch-header-fast "To" article)) "")))
 782
 783 (defun gnus-registry-fetch-header-fast (article header)
 784   "Fetch the HEADER quickly, using the internal gnus-data-list function"
 785   (if (and (numberp article)
 786            (assoc article (gnus-data-list nil)))
 787       (gnus-string-remove-all-properties
 788        (cdr (assq header (gnus-data-header
 789                           (assoc article (gnus-data-list nil))))))
 790     nil))
 791
 792 ;; registry marks glue
 793 (defun gnus-registry-do-marks (type function)
 794   "For each known mark, call FUNCTION for each cell of type TYPE.
 795
 796 FUNCTION should take two parameters, a mark symbol and the cell value."
 797   (dolist (mark-info gnus-registry-marks)
 798     (let* ((mark (car-safe mark-info))
 799            (data (cdr-safe mark-info))
 800            (cell-data (plist-get data type)))
 801       (when cell-data
 802         (funcall function mark cell-data)))))
 803
 804 ;;; this is ugly code, but I don't know how to do it better
 805 (defun gnus-registry-install-shortcuts ()
 806   "Install the keyboard shortcuts and menus for the registry.
 807 Uses `gnus-registry-marks' to find what shortcuts to install."
 808   (let (keys-plist)
 809     (setq gnus-registry-misc-menus nil)
 810     (gnus-registry-do-marks
 811      :char
 812      (lambda (mark data)
 813        (let ((function-format
 814               (format "gnus-registry-%%s-article-%s-mark" mark)))
 815
 816 ;;; The following generates these functions:
 817 ;;; (defun gnus-registry-set-article-Important-mark (&rest articles)
 818 ;;;   "Apply the Important mark to process-marked ARTICLES."
 819 ;;;   (interactive (gnus-summary-work-articles current-prefix-arg))
 820 ;;;   (gnus-registry-set-article-mark-internal 'Important articles nil t))
 821 ;;; (defun gnus-registry-remove-article-Important-mark (&rest articles)
 822 ;;;   "Apply the Important mark to process-marked ARTICLES."
 823 ;;;   (interactive (gnus-summary-work-articles current-prefix-arg))
 824 ;;;   (gnus-registry-set-article-mark-internal 'Important articles t t))
 825
 826          (dolist (remove '(t nil))
 827            (let* ((variant-name (if remove "remove" "set"))
 828                   (function-name (format function-format variant-name))
 829                   (shortcut (format "%c" data))
 830                   (shortcut (if remove (upcase shortcut) shortcut)))
 831              (unintern function-name obarray)
 832              (eval
 833               `(defun
 834                  ;; function name
 835                  ,(intern function-name)
 836                  ;; parameter definition
 837                  (&rest articles)
 838                  ;; documentation
 839                  ,(format
 840                    "%s the %s mark over process-marked ARTICLES."
 841                    (upcase-initials variant-name)
 842                    mark)
 843                  ;; interactive definition
 844                  (interactive
 845                   (gnus-summary-work-articles current-prefix-arg))
 846                  ;; actual code
 847
 848                  ;; if this is called and the user doesn't want the
 849                  ;; registry enabled, we'll ask anyhow
 850                  (when (eq gnus-registry-install nil)
 851                    (setq gnus-registry-install 'ask))
 852
 853                  ;; now the user is asked if gnus-registry-install is 'ask
 854                  (when (gnus-registry-install-p)
 855                    (gnus-registry-set-article-mark-internal
 856                     ;; all this just to get the mark, I must be doing it wrong
 857                     (intern ,(symbol-name mark))
 858                     articles ,remove t)
 859                    (gnus-message
 860                     9
 861                     "Applying mark %s to %d articles"
 862                     ,(symbol-name mark) (length articles))
 863                    (dolist (article articles)
 864                      (gnus-summary-update-article
 865                       article
 866                       (assoc article (gnus-data-list nil)))))))
 867              (push (intern function-name) keys-plist)
 868              (push shortcut keys-plist)
 869              (push (vector (format "%s %s"
 870                                    (upcase-initials variant-name)
 871                                    (symbol-name mark))
 872                            (intern function-name) t)
 873                    gnus-registry-misc-menus)
 874              (gnus-message
 875               9
 876               "Defined mark handling function %s"
 877               function-name))))))
 878     (gnus-define-keys-1
 879      '(gnus-registry-mark-map "M" gnus-summary-mark-map)
 880      keys-plist)
 881     (add-hook 'gnus-summary-menu-hook
 882               (lambda ()
 883                 (easy-menu-add-item
 884                  gnus-summary-misc-menu
 885                  nil
 886                  (cons "Registry Marks" gnus-registry-misc-menus))))))
 887
 888 ;;; use like this:
 889 ;;; (defalias 'gnus-user-format-function-M
 890 ;;;           'gnus-registry-user-format-function-M)
 891 (defun gnus-registry-user-format-function-M (headers)
 892   (let* ((id (mail-header-message-id headers))
 893          (marks (when id (gnus-registry-get-id-key id 'mark))))
 894     (apply 'concat (mapcar (lambda (mark)
 895                              (let ((c
 896                                     (plist-get
 897                                      (cdr-safe
 898                                       (assoc mark gnus-registry-marks))
 899                                      :char)))
 900                                (if c
 901                                    (list c)
 902                                  nil)))
 903                            marks))))
 904
 905 (defun gnus-registry-read-mark ()
 906   "Read a mark name from the user with completion."
 907   (let ((mark (gnus-completing-read
 908                "Label"
 909                (mapcar 'symbol-name (mapcar 'car gnus-registry-marks))
 910                nil nil nil
 911                (symbol-name gnus-registry-default-mark))))
 912     (when (stringp mark)
 913       (intern mark))))
 914
 915 (defun gnus-registry-set-article-mark (&rest articles)
 916   "Apply a mark to process-marked ARTICLES."
 917   (interactive (gnus-summary-work-articles current-prefix-arg))
 918   (gnus-registry-set-article-mark-internal (gnus-registry-read-mark)
 919                                            articles nil t))
 920
 921 (defun gnus-registry-remove-article-mark (&rest articles)
 922   "Remove a mark from process-marked ARTICLES."
 923   (interactive (gnus-summary-work-articles current-prefix-arg))
 924   (gnus-registry-set-article-mark-internal (gnus-registry-read-mark)
 925                                            articles t t))
 926
 927 (defun gnus-registry-set-article-mark-internal (mark
 928                                                 articles
 929                                                 &optional remove
 930                                                 show-message)
 931   "Apply or remove MARK across a list of ARTICLES."
 932   (let ((article-id-list
 933          (mapcar 'gnus-registry-fetch-message-id-fast articles)))
 934     (dolist (id article-id-list)
 935       (let* ((marks (delq mark (gnus-registry-get-id-key id 'mark)))
 936              (marks (if remove marks (cons mark marks))))
 937         (when show-message
 938           (gnus-message 1 "%s mark %s with message ID %s, resulting in %S"
 939                         (if remove "Removing" "Adding")
 940                         mark id marks))
 941         (gnus-registry-set-id-key id 'mark marks)))))
 942
 943 (defun gnus-registry-get-article-marks (&rest articles)
 944   "Get the Gnus registry marks for ARTICLES and show them if interactive.
 945 Uses process/prefix conventions.  For multiple articles,
 946 only the last one's marks are returned."
 947   (interactive (gnus-summary-work-articles 1))
 948   (let* ((article (last articles))
 949          (id (gnus-registry-fetch-message-id-fast article))
 950          (marks (when id (gnus-registry-get-id-key id 'mark))))
 951     (when (interactive-p)
 952       (gnus-message 1 "Marks are %S" marks))
 953     marks))
 954
 955 (defun gnus-registry-group-count (id)
 956   "Get the number of groups of a message, based on the message ID."
 957   (length (gnus-registry-get-id-key id 'group)))
 958
 959 (defun gnus-registry-get-or-make-entry (id)
 960   (let* ((db gnus-registry-db)
 961          ;; safe if not found
 962          (entries (registry-lookup db (list id))))
 963
 964     (when (null entries)
 965       (gnus-registry-insert db id (list (list 'creation-time (current-time))
 966                                         '(group) '(sender) '(subject)))
 967       (setq entries (registry-lookup db (list id))))
 968
 969     (nth 1 (assoc id entries))))
 970
 971 (defun gnus-registry-delete-entries (idlist)
 972   (registry-delete gnus-registry-db idlist nil))
 973
 974 (defun gnus-registry-get-id-key (id key)
 975   (cdr-safe (assq key (gnus-registry-get-or-make-entry id))))
 976
 977 (defun gnus-registry-set-id-key (id key vals)
 978   (let* ((db gnus-registry-db)
 979          (entry (gnus-registry-get-or-make-entry id)))
 980     (registry-delete db (list id) nil)
 981     (setq entry (cons (cons key vals) (assq-delete-all key entry)))
 982     (gnus-registry-insert db id entry)
 983     entry))
 984
 985 (defun gnus-registry-insert (db id entry)
 986   "Just like `registry-insert' but tries to prune on error."
 987   (when (registry-full db)
 988     (message "Trying to prune the registry because it's full")
 989     (registry-prune db))
 990   (registry-insert db id entry)
 991   entry)
 992
 993 (defun gnus-registry-import-eld (file)
 994   (interactive "fOld registry file to import? ")
 995   ;; example content:
 996   ;;   (setq gnus-registry-alist '(
 997   ;; ("<messageID>" ((marks nil)
 998   ;;                 (mtime 19365 1776 440496)
 999   ;;                 (sender . "root (Cron Daemon)")
1000   ;;                 (subject . "Cron"))
1001   ;;  "cron" "nnml+private:cron")
1002   (load file t)
1003   (when (boundp 'gnus-registry-alist)
1004     (let* ((old (symbol-value 'gnus-registry-alist))
1005            (count 0)
1006            (expected (length old))
1007            entry)
1008       (while (car-safe old)
1009         (incf count)
1010         ;; don't use progress reporters for backwards compatibility
1011         (when (and (< 0 expected)
1012                    (= 0 (mod count 100)))
1013           (message "importing: %d of %d (%.2f%%)"
1014                    count expected (/ (* 100 count) expected)))
1015         (setq entry (car-safe old)
1016               old (cdr-safe old))
1017         (let* ((id (car-safe entry))
1018                (new-entry (gnus-registry-get-or-make-entry id))
1019                (rest (cdr-safe entry))
1020                (groups (loop for p in rest
1021                              when (stringp p)
1022                              collect p))
1023                extra-cell key val)
1024           ;; remove all the strings from the entry
1025           (dolist (elem rest)
1026             (if (stringp elem) (setq rest (delq elem rest))))
1027           (gnus-registry-set-id-key id 'group groups)
1028           ;; just use the first extra element
1029           (setq rest (car-safe rest))
1030           (while (car-safe rest)
1031             (setq extra-cell (car-safe rest)
1032                   key (car-safe extra-cell)
1033                   val (cdr-safe extra-cell)
1034                   rest (cdr-safe rest))
1035             (when (and val (atom val))
1036               (setq val (list val)))
1037             (gnus-registry-set-id-key id key val))))
1038       (message "Import done, collected %d entries" count))))
1039
1040 (ert-deftest gnus-registry-misc-test ()
1041   (should-error (gnus-registry-extract-addresses '("" "")))
1042
1043   (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
1044                    "noname <ed@you.me>"
1045                    "noname <cyd@stupidchicken.com>"
1046                    "noname <tzz@lifelogs.com>")
1047                  (gnus-registry-extract-addresses
1048                   (concat "Ted Zlatanov <tzz@lifelogs.com>, "
1049                           "ed <ed@you.me>, " ; "ed" is not a valid name here
1050                           "cyd@stupidchicken.com, "
1051                           "tzz@lifelogs.com")))))
1052
1053 (ert-deftest gnus-registry-usage-test ()
1054   (let* ((n 100)
1055          (tempfile (make-temp-file "gnus-registry-persist"))
1056          (db (gnus-registry-make-db tempfile))
1057          (gnus-registry-db db)
1058          back size)
1059     (message "Adding %d keys to the test Gnus registry" n)
1060     (dotimes (i n)
1061       (let ((id (number-to-string i)))
1062         (gnus-registry-handle-action id
1063                                      (if (>= 50 i) "fromgroup" nil)
1064                                      "togroup"
1065                                      (when (>= 70 i)
1066                                        (format "subject %d" (mod i 10)))
1067                                      (when (>= 80 i)
1068                                        (format "sender %d" (mod i 10))))))
1069     (message "Testing Gnus registry size is %d" n)
1070     (should (= n (registry-size db)))
1071     (message "Looking up individual keys (registry-lookup)")
1072     (should (equal (loop for e
1073                          in (mapcar 'cadr
1074                                     (registry-lookup db '("20" "83" "72")))
1075                          collect (assq 'subject e)
1076                          collect (assq 'sender e)
1077                          collect (assq 'group e))
1078                    '((subject "subject 0") (sender "sender 0") (group "togroup")
1079                      (subject) (sender) (group "togroup")
1080                      (subject) (sender "sender 2") (group "togroup"))))
1081
1082     (message "Looking up individual keys (gnus-registry-id-key)")
1083     (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
1084     (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
1085     (message "Trying to insert a duplicate key")
1086     (should-error (gnus-registry-insert db "55" '()))
1087     (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
1088     (should (gnus-registry-get-or-make-entry "22"))
1089     (message "Saving the Gnus registry to %s" tempfile)
1090     (should (gnus-registry-save tempfile db))
1091     (setq size (nth 7 (file-attributes tempfile)))
1092     (message "Saving the Gnus registry to %s: size %d" tempfile size)
1093     (should (< 0 size))
1094     (with-temp-buffer
1095       (insert-file-contents-literally tempfile)
1096       (should (looking-at (concat ";; Object "
1097                                   "Gnus Registry"
1098                                   "\n;; EIEIO PERSISTENT OBJECT"))))
1099     (message "Reading Gnus registry back")
1100     (setq back (eieio-persistent-read tempfile))
1101     (should back)
1102     (message "Read Gnus registry back: %d keys, expected %d==%d"
1103              (registry-size back) n (registry-size db))
1104     (should (= (registry-size back) n))
1105     (should (= (registry-size back) (registry-size db)))
1106     (delete-file tempfile)
1107     (message "Pruning Gnus registry to 0 by setting :max-soft")
1108     (oset db :max-soft 0)
1109     (registry-prune db)
1110     (should (= (registry-size db) 0)))
1111   (message "Done with Gnus registry usage testing."))
1112
1113 ;;;###autoload
1114 (defun gnus-registry-initialize ()
1115 "Initialize the Gnus registry."
1116   (interactive)
1117   (gnus-message 5 "Initializing the registry")
1118   (setq gnus-registry-install t)        ; in case it was 'ask or nil
1119   (gnus-registry-install-hooks)
1120   (gnus-registry-install-shortcuts)
1121   (gnus-registry-read))
1122
1123 ;;;###autoload
1124 (defun gnus-registry-install-hooks ()
1125   "Install the registry hooks."
1126   (interactive)
1127   (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
1128   (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
1129   (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
1130   (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
1131
1132   (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
1133   (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
1134
1135   (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
1136
1137 (defun gnus-registry-unload-hook ()
1138   "Uninstall the registry hooks."
1139   (interactive)
1140   (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
1141   (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
1142   (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
1143   (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
1144
1145   (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
1146   (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
1147
1148   (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
1149
1150 (add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
1151
1152 (defun gnus-registry-install-p ()
1153   (interactive)
1154   (when (eq gnus-registry-install 'ask)
1155     (setq gnus-registry-install
1156           (gnus-y-or-n-p
1157            (concat "Enable the Gnus registry?  "
1158                    "See the variable `gnus-registry-install' "
1159                    "to get rid of this query permanently. ")))
1160     (when gnus-registry-install
1161       ;; we just set gnus-registry-install to t, so initialize the registry!
1162       (gnus-registry-initialize)))
1163 ;;; we could call it here: (customize-variable 'gnus-registry-install)
1164   gnus-registry-install)
1165
1166 ;; TODO: a few things
1167
1168 (provide 'gnus-registry)
1169
1170 ;;; gnus-registry.el ends here