;;; gnus-registry.el --- article registry for Gnus
-;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news registry
(require 'easymenu)
(require 'registry)
+;; Silence XEmacs byte compiler, which will otherwise complain about
+;; call to `eieio-persistent-read'.
+(when (featurep 'xemacs)
+ (byte-compiler-options
+ (warnings (- callargs))))
+
(defvar gnus-adaptive-word-syntax-table)
(defvar gnus-registry-dirty t
(make-obsolete-variable 'gnus-registry-max-track-groups nil "23.4")
(make-obsolete-variable 'gnus-registry-entry-caching nil "23.4")
(make-obsolete-variable 'gnus-registry-trim-articles-without-groups nil "23.4")
+(make-obsolete-variable 'gnus-registry-max-pruned-entries nil "24.4")
(defcustom gnus-registry-track-extra '(subject sender recipient)
"Whether the registry should track extra data about a message.
(defcustom gnus-registry-cache-file
(nnheader-concat
(or gnus-dribble-directory gnus-home-directory "~/")
- ".gnus.registry.eioio")
+ ".gnus.registry.eieio")
"File where the Gnus registry will be stored."
:group 'gnus-registry
:type 'file)
:type '(radio (const :format "Unlimited " nil)
(integer :format "Maximum number: %v")))
-(defcustom gnus-registry-max-pruned-entries nil
- "Maximum number of pruned entries in the registry, nil for unlimited."
- :version "24.1"
+(defcustom gnus-registry-prune-factor 0.1
+ "When pruning, try to prune back to this factor less than the maximum size.
+
+In order to prevent constant pruning, we prune back to a number
+somewhat less than the maximum size. This option controls
+exactly how much less. For example, given a maximum size of
+50000 and a prune factor of 0.1, the pruning process will try to
+cut the registry back to \(- 50000 \(* 50000 0.1\)\) -> 45000
+entries. The pruning process is constrained by the presence of
+\"precious\" entries."
+ :version "24.4"
:group 'gnus-registry
- :type '(radio (const :format "Unlimited " nil)
- (integer :format "Maximum number: %v")))
+ :type 'float)
+
+(defcustom gnus-registry-default-sort-function
+ #'gnus-registry-sort-by-creation-time
+ "Sort function to use when pruning the registry.
+
+Entries which sort to the front of the list will be pruned
+first.
+
+This can slow pruning down. Set to nil to perform no sorting."
+ :version "24.4"
+ :group 'gnus-registry
+ :type 'symbol)
+
+(defun gnus-registry-sort-by-creation-time (l r)
+ "Sort older entries to front of list."
+ ;; Pruning starts from the front of the list.
+ (time-less-p
+ (cadr (assq 'creation-time r))
+ (cadr (assq 'creation-time l))))
(defun gnus-registry-fixup-registry (db)
(when db
(oset db :precious
(append gnus-registry-extra-entries-precious
'()))
- (oset db :max-hard
+ (oset db :max-size
(or gnus-registry-max-entries
most-positive-fixnum))
(oset db :prune-factor
- 0.1)
- (oset db :max-soft
- (or gnus-registry-max-pruned-entries
- most-positive-fixnum))
+ (or gnus-registry-prune-factor
+ 0.1))
(oset db :tracked
(append gnus-registry-track-extra
'(mark group keyword)))
"Gnus Registry"
:file (or file gnus-registry-cache-file)
;; these parameters are set in `gnus-registry-fixup-registry'
- :max-hard most-positive-fixnum
- :max-soft most-positive-fixnum
+ :max-size most-positive-fixnum
+ :version registry-db-version
:precious nil
:tracked nil)))
(gnus-message 4 "Remaking the Gnus registry")
(setq gnus-registry-db (gnus-registry-make-db))))
-(defun gnus-registry-read ()
- "Read the registry cache file."
+(defun gnus-registry-load ()
+ "Load the registry from the cache file."
(interactive)
(let ((file gnus-registry-cache-file))
(condition-case nil
- (progn
- (gnus-message 5 "Reading Gnus registry from %s..." file)
- (setq gnus-registry-db (gnus-registry-fixup-registry
- (eieio-persistent-read file)))
- (gnus-message 5 "Reading Gnus registry from %s...done" file))
+ (gnus-registry-read file)
+ (file-error
+ ;; Fix previous mis-naming of the registry file.
+ (let ((old-file-name
+ (concat (file-name-sans-extension
+ gnus-registry-cache-file)
+ ".eioio")))
+ (if (and (file-exists-p old-file-name)
+ (yes-or-no-p
+ (format "Rename registry file from %s to %s? "
+ old-file-name file)))
+ (progn
+ (gnus-registry-read old-file-name)
+ (oset gnus-registry-db :file file)
+ (gnus-message 1 "Registry filename changed to %s" file))
+ (gnus-registry-remake-db t))))
(error
(gnus-message
1
file)
(gnus-registry-remake-db t)))))
+(defun gnus-registry-read (file)
+ "Do the actual reading of the registry persistence file."
+ (gnus-message 5 "Reading Gnus registry from %s..." file)
+ (setq gnus-registry-db
+ (gnus-registry-fixup-registry
+ (condition-case nil
+ (with-no-warnings
+ (eieio-persistent-read file 'registry-db))
+ ;; Older EIEIO versions do not check the class name.
+ ('wrong-number-of-arguments
+ (eieio-persistent-read file)))))
+ (gnus-message 5 "Reading Gnus registry from %s...done" file))
+
(defun gnus-registry-save (&optional file db)
"Save the registry cache file."
(interactive)
(db (or db gnus-registry-db)))
(gnus-message 5 "Saving Gnus registry (%d entries) to %s..."
(registry-size db) file)
- (registry-prune db)
+ (registry-prune
+ db gnus-registry-default-sort-function)
;; TODO: call (gnus-string-remove-all-properties v) on all elements?
(eieio-persistent-save db file)
(gnus-message 5 "Saving Gnus registry (size %d) to %s...done"
(let* ((article (last articles))
(id (gnus-registry-fetch-message-id-fast article))
(marks (when id (gnus-registry-get-id-key id 'mark))))
- (when (interactive-p)
+ (when (gmm-called-interactively-p 'any)
(gnus-message 1 "Marks are %S" marks))
marks))
"Just like `registry-insert' but tries to prune on error."
(when (registry-full db)
(message "Trying to prune the registry because it's full")
- (registry-prune db))
+ (registry-prune
+ db gnus-registry-default-sort-function))
(registry-insert db id entry)
entry)
(gnus-message 5 "Initializing the registry")
(gnus-registry-install-hooks)
(gnus-registry-install-shortcuts)
- (gnus-registry-read))
+ (gnus-registry-load))
;; FIXME: Why autoload this function?
;;;###autoload
(add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
(add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
- (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
+ (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)
(add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
(remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
(remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
- (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
+ (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)
(remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)
(setq gnus-registry-enabled nil))
(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
(defun gnus-registry-install-p ()
- "If the registry is not already enabled, and `gnus-registry-install' is t,
-the registry is enabled. If `gnus-registry-install' is `ask',
-the user is asked first. Returns non-nil iff the registry is enabled."
+ "Return non-nil if the registry is enabled (and maybe enable it first).
+If the registry is not already enabled, then if `gnus-registry-install'
+is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it."
(interactive)
(unless gnus-registry-enabled
(when (if (eq gnus-registry-install 'ask)
;; Try to activate the group. If that fails, just move
;; along. We may have more groups to work with
- (ignore-errors
- (gnus-select-group-with-message-id group message-id))
- (throw 'found t)))))))
+ (when
+ (ignore-errors
+ (gnus-select-group-with-message-id group message-id) t)
+ (throw 'found t))))))))
+
+(defun gnus-registry-remove-extra-data (extra)
+ "Remove tracked EXTRA data from the gnus registry.
+EXTRA is a list of symbols. Valid symbols are those contained in
+the docs of `gnus-registry-track-extra'. This command is useful
+when you stop tracking some extra data and now want to purge it
+from your existing entries."
+ (interactive (list (mapcar 'intern
+ (completing-read-multiple
+ "Extra data: "
+ '("subject" "sender" "recipient")))))
+ (when extra
+ (let ((db gnus-registry-db))
+ (registry-reindex db)
+ (loop for k being the hash-keys of (oref db :data)
+ using (hash-value v)
+ do (let ((newv (delq nil (mapcar #'(lambda (entry)
+ (unless (member (car entry) extra)
+ entry))
+ v))))
+ (registry-delete db (list k) nil)
+ (gnus-registry-insert db k newv)))
+ (registry-reindex db))))
;; TODO: a few things