I find, especially when I am using the BBDB for newsgroups, that it
rapidly gets *really* bloated with loads of entries for people most of
whom you'll never care about.
So I implemented expiry for BBDB. BDBB records have a `last-access'
field updated by noticing it (which does not affect the `timestamp'
field); whenever `bbdb-expire-now' is called, any that are older than
`bbdb-expire-this-old' days are deleted. If you have entries that you
don't want to delete, put a `permanent' field on it.
This works with BBDB-2.00.06 as distributed with XEmacs 21; I'm not sure
about later releases. It is very new, and in places a bit kludgy; in
particular, adding the last-access timestamp entries in the first place
has to be done by hand; in future, this will be done with format
migration, but I wanted to make this first version without touching the
BBDB sources (it is all done with advisements), and I can't see how to
extend the migration code without modifying the sources.
Note that this package violates XEmacs packaging guidelines, and common
sense, in that loading it actually *does* things, like attaching things
to hooks, and it doesn't have many things that real packages have. This
reflects its origins (a quick hack in my .emacs) and will be fixed in
the next release.
Really, this is not a release, just a testing of the waters to see if
people think this is a total waste of time or fantastically ugly or
something.
It's not even commented. It might not run. It might not even compile. It
might eat your BBDB, melt down your hard disk, or lose all moral sense
and run for President. Worst of all, it *uses* dynamic scope, rather
than running from it in fear.
Anyway, with that comprehensive disclaimer, here it is:
-- begin
;;; expire-bbdb.el --- expiry and expire-proof entries for the BBDB
;;; Copyright (C) 2000 Nix <[EMAIL PROTECTED]>.
;; Author: Nix <[EMAIL PROTECTED]>
;; Created: 2000-09-17
;; Keywords: lisp
;; Version: $Revision$
;; This file is not part of XEmacs.
;; This library is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2.1, or (at your option)
;; any later version.
;; It is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
;; License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this library; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;; Commentary:
;; This file implements expiry of BBDB databases, to stop them getting too
;; fantastically bloated. Only entries that are newer than `bbdb-expire-this-old'
;; or which have a `permanent' field are retained across expiry. (You might
;; want the `permanent' field to be set on personal emails and cleared on
;; everything else, for instance.)
;; To use:
;; Do a `bbdb-expire-add-last-access-time'. This attaches the last access time
;; field to all the BBDB entries, and assumes they were last accessed *right
;; now*.
;; WARNING: If you forget to do this, only entries that you have accessed,
;; and then left for more than `bbdb-expire-this-old' days, will be expired;
;; entries that have been left since before you used this package will be
;; left alone, which is suboptimal.
;; A `bbdb-expire-bbdb' is automatically done whenever the BBDB buffer
;; is displayed, to actually do the expiry. (I'd like to do it when
;; the BBDB buffer is read in, but I can't do that because you cannot
;; call `bbdb-records' from that hook.)
;;; Requirements:
(require 'advice)
(require 'bbdb)
(require 'bbdb-com)
(require 'bbdb-hooks)
(require 'time-date)
;;; Code:
(defvar bbdb-expire-this-old 90
"Expire entries in the BBDB that have not been referenced for this many days.
Entries are not expired if the `permanent' field is t for that entry.")
(defun bbdb-expire-update-last-access-time (record)
"Update the (non-displayed) last-access field in the BBDB, for `bbdb-expire-bbdb'.
Do not let this update affect the changed-records list in any way.
FIXME: How do we stop `bbdb-changed-records' from updating in a less stone-age
fashion?"
(let ((bbdb-expire-updating-last-access-time t)
(real-bbdb-changed-records (bbdb-with-db-buffer bbdb-changed-records)))
(bbdb-record-putprop record 'last-access
(format-time-string bbdb-time-internal-format
(current-time)))
(bbdb-with-db-buffer (setq bbdb-changed-records real-bbdb-changed-records))))
(let ((byte-compile-warnings nil))
(defadvice bbdb-timestamp-hook (around bbdb-expire-access-time-elision activate)
"Do not update the timestamp if `bbdb-expire-updating-last-access-time' is t.
This ensures that updating the last access time does not update the timestamp
too, which would render the timestamp field thoroughly useless."
(or (and (boundp 'bbdb-expire-updating-last-access-time)
bbdb-expire-updating-last-access-time)
ad-do-it)))
(defun bbdb-refile-notes-string-most (string1 string2)
"Returns the string that is not lessp."
(if (not (string-lessp string1 string2))
string1
string2))
(setq bbdb-elided-display (nconc bbdb-elided-display '(last-access permanent)))
(setq bbdb-refile-notes-generate-alist
(append '((last-access . bbdb-refile-notes-string-most)
(permanent . bbdb-refile-notes-string-most))
bbdb-refile-notes-generate-alist))
(add-hook 'bbdb-notice-hook 'bbdb-expire-update-last-access-time)
(defun bbdb-expire-add-last-access-time ()
(interactive)
"Add last access times to BBDB records that do not yet have them.
The last access time is set to the current time, because this is safest."
(let ((bbdb-expire-updating-last-access-time t)
(bbdb-notice-hook bbdb-notice-hook))
(remove-hook 'bbdb-notice-hook 'bbdb-expire-update-last-access-time)
(mapc #'(lambda (record)
(or (bbdb-record-getprop record 'last-access)
(bbdb-record-putprop record 'last-access
(format-time-string bbdb-time-internal-format
(current-time)))))
(bbdb-records))))
(defun bbdb-expire-bbdb ()
(interactive)
"Expire old records from the BBDB.
Entries are not expired if they are newer than `bbdb-expire-this-old' days, or
if they have the `permanent' field set to t.
FIXME: Is it necessary to use `bbdb-records'?"
(let ((bbdb-expire-updating-last-access-time t)
(bbdb-notice-hook bbdb-notice-hook))
(remove-hook 'bbdb-notice-hook 'bbdb-expire-update-last-access-time)
(mapc #'(lambda (record)
(let ((last-access (bbdb-record-getprop record 'last-access)))
(and last-access
(string< last-access
(format-time-string bbdb-time-internal-format
(subtract-time (current-time)
(days-to-time
bbdb-expire-this-old))))
(not (bbdb-record-getprop record 'permanent))
(bbdb-delete-record-internal record))))
(bbdb-records))))
(run-hooks 'expire-bbdb-load-hook)
(add-hook 'bbdb-mode-hook 'bbdb-expire-bbdb)
(provide 'expire-bbdb)
-- end
--
`no amount of Zen contemplation will ever make you at one
with a 3c905B ethernet card.' --- Alan Cox
_______________________________________________
bbdb-info mailing list
[EMAIL PROTECTED]
http://lists.sourceforge.net/mailman/listinfo/bbdb-info
