diff options
120 files changed, 42365 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9f93b6b --- /dev/null +++ b/.gitignore @@ -0,0 +1,8 @@ +*.elc +/*-stamp +/Makefile +/bits.tar.gz +/bits/extern/ +/config.log +/config.status +/loadpath.el diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..16fe08e --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "extern/bbdb-vcard"] + path = extern/bbdb-vcard + url = git://github.com/trebb/bbdb-vcard.git diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..291b9b0 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,3470 @@ +2010-04-20 Barak A. Pearlmutter <barak@cs.nuim.ie> + + * README: Emacs, meaning both GNU Emacs and XEmacs. + * lisp/bbdb.el: By the powers vested in me by git cvsimport and + the state of inebriation, I declare this to be BBDB version 2.36. + BBDB-2.36 - Let the games begin. + +2010-03-09 Barak A. Pearlmutter <barak@cs.nuim.ie> + + * texinfo/bbdb.texinfo: remove @ifinfo guard to eliminate + texi2html error. + +2009-11-18 Barak A. Pearlmutter <barak@cs.nuim.ie> + + * lisp/bbdb-rmail.el (bbdb/rmail-get-header-content): Fix RMAIL + insinuation in GNU Emacs23 by using rmail-get-header when + available, thus avoiding rmail-narrow-to-non-pruned-header, which + no longer exists in GNU Emacs 23. + +2008-01-29 Didier Verna <didier@xemacs.org> + + * lisp/bbdb-gnus.el (bbdb/gnus-summary-get-author): Use the proper + nnheader interface for retrieving header values. + +2008-01-29 Didier Verna <didier@xemacs.org> + + Handle recent type change of gnus-ignored-from-addresses. + * lisp/bbdb-gnus.el (bbdb/gnus-ignored-from-addresses): New. + * lisp/bbdb-gnus.el (bbdb/gnus-update-records): Use it. + * lisp/bbdb-gnus.el (bbdb/gnus-summary-get-author): Ditto. + +2008-01-29 Didier Verna <didier@xemacs.org> + + * lisp/bbdb-com.el (bbdb-define-all-aliases): Rewrite docstring + and format it properly for describe-function. + +2008-01-29 Didier Verna <didier@xemacs.org> + + * lisp/bbdb-com.el (bbdb-collect-all-aliases): Fix infite loop due + to misplaced iteration. This occurred when triggering the warning. + +2007-12-08 Kousik Nandy <kousik.nandy@gmail.com> + + * lisp/bbdb-gnus.el (bbdb/gnus-summary-get-author): + bbdb/gnus-summary-get-author() fails if no To/Cc/Newsgroup is + present (in newer Gnus) + +2007-12-05 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb-com.el (bbdb-dwim-net-address-title-field): New field + controlling if a title is prepended to an email address. The + default value is 'title. + +2007-11-26 Leo <sdl.web@gmail.com> + + * lisp/bbdb-com.el (bbdb-get-addresses): Minor cleanup and fix an + bug (unquoted leading "(")in a doc string. + +2007-11-26 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb.el (bbdb-annotate-message-sender): Normalize and unify + names before comparing them to avoid detecting a name change where + none is. + +2007-11-02 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb.el (bbdb-prin1): Added BBDB version of prin1 and + prin1-to-string binding print-level and print-length to nil to + avoid abbreviation when writing records. + +2007-09-18 Jim Blandy <jimb@codesourcery.com> + + * texinfo/bbdb.texinfo (bbdb-always-add-addresses): Document new + meanings of 'ask', nil, and function symbols. + + * texinfo/bbdb.texinfo (Manual Record Addition): Use @pxref, not + @xref. + +2007-07-03 Robert Widhopf-Fenk <fenk@forwiss.de> + + * lisp/bbdb-gnus.el (bbdb/gnus-summary-get-author): Added handling + of `gnus-ignored-from-addresses' and `gnus-summary-to-prefix'. + +2007-05-12 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb-com.el (bbdb-define-all-aliases): Rewrite to handle + magic aliases which expand to all nets of a records when ending in + "*", pick the nth net of a records when ending in "[NTH]" and + recursively expanding aliases if a net has no "@" and exists as + alias. + +2007-03-04 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb.el (bbdb-pop-up-bbdb-buffer): Rewrote the function to + use PREDICATE regardless of the split mode selected by + `bbdb-use-pop-up'. + + `bbdb-use-pop-up' can be used to select the split mode. + + Also added the new variable `bbdb-pop-up-target-columns' which is + the number of columns for the BBDB buffer window when splitting + vertically. + +2007-02-18 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb.el (bbdb-quiet-about-name-mismatches): Can be + a function or sexp to allow user tweak-able name updates. + +2007-02-14 Robert Widhopf-Fenk <fenk@forwiss.de> + + * lisp/bbdb.el (bbdb-use-pop-up): Changed the default to 'horiz. + (bbdb-pop-up-display-layout): Changed the default to 'one-line. + Some code linting here and there. + + * lisp/bbdb-com.el (bbdb-complete-name-allow-cycling): changed + default to t. + (bbdb-get-only-first-address-p): changed default to nil. + (bbdb-get-addresses): Added a doc string. + +2007-02-06 Robert Widhopf-Fenk <bbdb@robf.de> + + * Added support for completion on "lastname firstname". Before + completion only worked on "first lastname". Eventually one will + get more choices now! The order of "firstname lastname" in the + completions buffer is still preserved, which might look a bit + odd. + +2007-02-03 Tom Tromey <tromey@redhat.com> + + * lisp/Makefile.in (bbdb-hooks.elc): Put lisp on a single line. + +2007-01-01 Waider <waider@waider.ie> + + * lisp/bbdb.el: + fixed version of primep (Patrick Campbell-Preston) + +2006-12-15 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb-com.el (bbdb-display-completion-list): Bugfix for + correctly replacing completed string in GNU Emacs when selection + a completion for bbdb-complete-name from the completions buffer. + This fixes the bug reported by Svend Tollak Munk. + +2006-05-26 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb-snarf.el (bbdb-snarf-region): Bugfix where snarfing on + a region only containing a net caused an infinite loop. Also try + to extract real name from the email address if there was none in + the snarf region. + + * lisp/bbdb.el (bbdb-format-record-one-line-notes): Remove line + breaks and trim white space for one line format. Also fixed some + doc strings. + +2005-08-11 Waider <waider@waider.ie> + + * texinfo/bbdb.texinfo, lisp/bbdb-print.el, lisp/bbdb-migrate.el: + trivial cleanups + +2005-08-02 Waider <waider@waider.ie> + + * lisp/bbdb.el: rewrite the coding cookie on save. This makes sure + that the setting of bbdb-file-coding-system is reflected in the + file. I'm still not sure that this coding system hacking about is + a good idea OR correct, however. + * lisp/bbdb.el: fix docstring for bbdb-invoke-hook-for-value + * lisp/bbdb-mhe.el, lisp/bbdb.el, lisp/bbdb-rmail.el: if + bbdb/mail-auto-create-p is set to 'prompt (or a function that + returns 'prompt) then prompt the user before creating the record. + +2005-08-02 Jochen Küpper <jochen@fhi-berlin.mpg.de> + + * lisp/bbdb-gnus.el, lisp/bbdb-hooks.el, lisp/bbdb.el: Change GNUS + to Gnus, assuming nobody cares for GNUS support anymore... + +2005-07-23 Waider <waider@waider.ie> + + * lisp/bbdb-sc.el: remove RCS keywords, replace with Id tag + + * lisp/bbdb-reportmail.el: remove Log tag + + * lisp/bbdb-ftp.el: nuke RCS tags and replace with an Id tag + + * INSTALL: sync with XEmacs CVS + +2005-05-22 Waider <waider@waider.ie> + + * html/index.html: update links for PilotManager + +2005-03-19 Waider <waider@waider.ie> + + * lisp/bbdb.el: * coding system guessing for emacs 22 (Frederik Fouvry) + +2005-02-28 Waider <waider@waider.ie> + + * lisp/bbdb-gnus.el (bbdb/gnus-nnimap-folder-list-from-bbdb): + new function from Uwe Brauer + +2005-02-22 Waider <waider@waider.ie> + + * lisp/bbdb-hooks.el: + get Gnus data from the raw article buffer (Nix/David Goldberg) + * lisp/bbdb.el: include prefixes in bbdb-name-gubbish + +2005-02-13 Waider <waider@waider.ie> + + * texinfo/bbdb.texinfo (Manual Record Addition): + * add pointer to bbdb-snarf + + * bits/bbdb-ldif.el: + * added new file, with minor abuse to make it work with current BBDB + +2004-11-09 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: * bury completion buffer when completion is done + +2004-10-13 Waider <waider@waider.ie> + + * texinfo/bbdb.texinfo (bbdb-print): + Correct variable name + Change copyright date to include 2004 + + * lisp/bbdb-print.el: + Correct variable name in comment + + * lisp/bbdb-com.el (bbdb): + Don't open a new window for BBDB if there are no records to + display. + +2004-10-10 Alex Schroeder <alex@gnu.org> + + * texinfo/bbdb.texinfo (Database Fields): New entry for the + concept index: mail-alias definition. + (Mail Sending Interfaces): New entry for the concept index: + mail-alias usage. New subheading: Mailing Lists and Mail Aliases. + (Known Bugs): New section on using M-x bbdb-submit-bug-report + replacing the old bug reporting section. + +2004-05-28 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb.el (bbdb-record-set-net): added a hack to detect that + aliases require rebuilding. + + * lisp/bbdb.el (bbdb-mode-map): added del/space binding for + scrolling. + +2004-04-29 Robert Widhopf-Fenk <bbdb@robf.de> + + * lisp/bbdb-rmail.el: Just define rmail-buffer if not defined and + require other packages only during compilation. + +2004-03-22 Waider <waider@waider.ie> + + * lisp/bbdb-migrate.el: * Minor docstring fix (Stefan Monnier) + * Catch error if attempting to kill only window in frame + (Stefan Monnier) + + * lisp/bbdb-snarf.el: + Namespace pollution fix (digit => bbdb-digit) (Stefan Monnier) + + * lisp/bbdb.el: * restore auto-create behaviour (Robert Widhopf-Fenk) + + * lisp/bbdb-com.el: + * Bugfix for bug caused by previous patch (Robert Widhopf-Fenk) + * Additions to alias generation (Robert Widhopf-Fenk) + +2004-02-01 Waider <waider@waider.ie> + + * lisp/bbdb-snarf.el (bbdb-merge-interactively): + If the specified value of 'nets' isn't a list, make it so. + +2004-01-23 Waider <waider@waider.ie> + + * lisp/bbdb.el: + Handle surnames with prefixes (Adrian Lanz <lanz@fowi.ethz.ch>) + +2003-10-10 Robert Widhopf <bbdb@robf.de> + + * lisp/bbdb-com.el (bbdb-edit-current-field): Handle field + detection gracefully at line-end of one-line display. + (reported by Dan Jacobson) + + * lisp/bbdb-gnus.el (bbdb/gnus-split-method): Honor Resent-* + headers if present. (Reported by Thomas Gerds) + + * lisp/bbdb-com.el (bbdb-help): Added colons to separate help + items and thus avoid confusion (reported by Dan Jacobson) + + * lisp/bbdb.el (bbdb-annotate-message-sender): Honor create-p for + creating new records if a similar record already exists. + + * lisp/bbdb-com.el (bbdb-prompt-for-create): Slightly changed the + semantics of the returned value to honor create-p. + +2003-08-01 Robert Widhopf <bbdb@robf.de> + + * lisp/bbdb-com.el (bbdb-dwim-net-address-allow-redundancy): + (bbdb-dwim-net-address): *shurg* added 'netonly thus allowing to + have no real-names being shown for expanded aliases and completed + names. + +2003-08-05 Waider <waider@waider.ie> + + * lisp/bbdb.el: + * bbdb-default-area-code: fix customize hook to recognize integers + + * texinfo/bbdb.texinfo: + * Rewrite doco for bbdb-electric-p to make it a little clearer. + + * testing/Makefile.in: * Use GREP and GREPCONTEXT autoconfs + + * configure.ac: + * Added a check for grep, and a test to figure out grep's context argument + + * testing/bbdb-test: * Added a record to test completion stuff + + * testing/bbdb-test.el: + Updated to reflect small change in completion logic + +2003-07-24 Jochen Küpper <bbdb@jochen-kuepper.de> + + * bits/bbdb-pgp.el: No error if mailcrypt isn't available. + (bbdb/pgp-quiet): Added. + (bbdb/pgp-hook-fun): Be quiet if bbdb/pgp-quiet is set. + +2003-07-24 Robert Fenk <bbdb@robf.de> + + * lisp/bbdb-com.el (bbdb-send-mail-internal): + * lisp/bbdb.el (bbdb-send-mail-style): Patch to support sending + mail via gnus (Scott Lawrence) + + * lisp/bbdb-com.el (bbdb-update-records): Ignore empty/broken + addresses, e.g. extraction on "foo@bar.baz<>" results in (nil nil) + which should be ignored. (reported by Neil W. Van Dyke) + +2003-07-23 Robert Fenk <bbdb@robf.de> + + * lisp/bbdb.el (bbdb-annotate-message-sender): Invoke the + prompt-to-create hook just if it has a value. (fixes MH not + honoring 'prompt for bbdb/mail-auto-create-p) + + * lisp/bbdb-hooks.el (bbdb-force-record-create): A fix for the + mhe-mode case (from Vladimir G. Ivanovic) + +2003-06-25 Robert Fenk <bbdb@robf.de> + + * lisp/bbdb.el (bbdb-pop-up-bbdb-buffer): Some fixes for special + cases of the multiple *BBDB* buffers hack. + + * lisp/bbdb-gui.el (bbdb-user-menu-commands): Is defcustom now + instead of defvar. + (build-bbdb-menu): If bbdb-user-menu-commands is a functionp we + call it in order to get a menu. + +2003-04-09 Dave Love <fx@gnu.org> + + * lisp/bbdb.el (bbdb-file-coding-system): Make it defconst, test + for utf-8-Emacs and doc fix. + +2003-04-01 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-multiple-buffers-default): Modified to nicely + interact with bbdb-display-records-1. + (bbdb-display-records-1): Honor bbdb-multiple-buffers by calling + bbdb-pop-up-bbdb-buffer. + +2003-03-31 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-display-records-1): + * lisp/bbdb-com.el (bbdb-mail-abbrev-expand-hook): + Trying to fix the problem with with-output-to-temp-buffer caused + several new bugs, thus we do a roll back to the old code. + +2003-03-28 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: Call bbdb-complete-name-hooks after name completion + +2003-03-27 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-mail-abbrev-expand-hook): save-excursion + to avoid getting into the *BBDB* buffer accidently. + +2003-03-15 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-display-records-1): erase buffer when + appending, since we are redisplaying the records, not just one + (with-output-to-temp-buffer was doing that before ...) + (bbdb-multiple-buffers-default): Default/example function for *BBDB* + buffer name generation for Gnus, VM, and compositions. + (bbdb-pop-up-bbdb-buffer): code move to bbdb-multiple-buffers-default + +2003-03-13 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-gnus.el: + * lisp/bbdb-hooks.el: + * lisp/bbdb.el: Droped support for GNUS versions <= 3.14 + + * lisp/bbdb-hooks.el (bbdb-header-start): There is no + gnus-subject-mode, its called gnus-summary-mode. + + * lisp/bbdb.el (bbdb-display-records-1): removed call to + bbdb-pop-up-bbdb-buffer to avoid problems with special-display-*, + still we are not back to the old behavior, i.e. if calling BBDB + from an frame without *BBDB* buffer while other frames are + displaying it we will not get it on the current frame, but that is + how it used to be. + +2003-03-11 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-frob-mode-line): show the BBDB buffer name. + + * lisp/bbdb-gnus.el (bbdb/gnus-summary-show-all-recipients): + Throwing away old code and use bbdb/gnus-update-records now. + (bbdb/gnus-update-records): Do not toggle headers to gain access + to the hidden headers, since gnus-fetch-field is doing this for us. + +2003-03-10 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-multiple-buffers): Yet another new variable. + Enables the creation of multiple *BBDB* buffers. + (bbdb-pop-up-bbdb-buffer): if bbdb-multiple-buffers is enabled + created new *BBDB: <BUFNAME>* buffer and set it up correctly. + +2003-03-07 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-gnus.el (bbdb/gnus-update-records): use + gnus-fetch-field instead of mail-fetch-field. Fixes problems + reported by Klaus Zeitler. + + * lisp/bbdb.el (bbdb-display-records-1): Do not use the function + with-output-to-temp-buffer since on recent GNU Emacses the local + variables get killed. + (bbdb-encache-message): Fix from Dan Debertin to avoid caching of + nil, i.e. empty record list, causing problems later. + (bbdb-canonicalize-address): Use equal instead of eq, since this + is the right thing to do! Fix from Matt Armstrong. + (bbdb-display-records-1): call bbdb-pop-up-buffer to ensure we get + a buffer in the current frame. + + * lisp/bbdb-vm.el (bbdb/vm-set-auto-folder-alist): added missing + local vars to avoid cluttering global namespace. + +2003-03-04 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-delete-current-record): fixed docs and + bbdb-apply-next-command-to-all-records handling. + +2003-01-31 Alex Schroeder <alex@emacswiki.org> + + * lisp/bbdb.el (bbdb-resort-database): Make interactive. + +2003-01-30 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-snarf.el (bbdb-snarf-extract-label): added safety check + for backward movement. + (bbdb-snarf-region): Added label completion for phones and addresses. + + * lisp/bbdb-mhe.el (bbdb/mh-update-record): Do a sanity check + to avoid adding a nil record to the cache causing trouble + afterwards. + + * lisp/bbdb-com.el: Removed ".el" from VM loads to allow Emacs + also loading .elc files if they are present. + (bbdb-edit-current-field): mark mail-aliases for rebuilt when we are + editing the aliases field of a record. + (bbdb-add-or-remove-mail-alias): mark mail-aliases for rebuilt + when creating new records or deleting a record. + (bbdb-prompt-for-create): delete help window when it is not needed + anymore. + +2003-01-30 Greg Troxel <gdt@ir.bbn.com> + + * bbdb-com.el, bbdb.el: + Clean up stray uses of mapc (replace with bbdb-mapc) + +2003-01-02 Waider <waider@waider.ie> + + * lisp/bbdb-com.el (bbdb-complete-name): + Fix completion in the case of multiple addresses matching from a + single record. Basically behaves as if you'd matched on the + primary name. + +2002-12-25 Alex Schroeder <alex@emacswiki.org> + + * lisp/bbdb.el (bbdb-phones-label-list): Doc. + (bbdb-addresses-label-list): Doc. + (bbdb-label-completion-list): Doc. + (bbdb-label-completion-default): Doc. + (bbdb-data-completion-list): Doc. + (bbdb-data-completion-default): Doc. + +2002-12-24 Alex Schroeder <alex@emacswiki.org> + + * lisp/bbdb-com.el (bbdb-complete-name): Handle the case where the + only exact match does not have a net field, instead of looping + forever. + +2002-12-22 Alex Schroeder <alex@emacswiki.org> + + * lisp/bbdb-com.el (bbdb-display-record-with-layout): New. + (bbdb-toggle-all-records-display-layout): Print layout used. + + * lisp/bbdb.el (bbdb-display-layout-alist): Extended custom type + to include primary and test, and fixed phone to phones, and + address to addresses. + (bbdb-format-record-layout-one-line): Take primary into account. + (bbdb-format-record-layout-multi-line): Take primary into account. + (bbdb-format-record): Take test into account, use multi-line + layout function if none was found. + +2002-11-02 Dave Love <fx@gnu.org> + + * lisp/bbdb.el (bbdb-have-re-char-classes): New constant. + (bbdb-clean-username): Use it. + (bbdb-buffer): Don't bind coding-system-for-read -- rely on coding + cookie. + (bbdb-records, parse-bbdb-internal): Write coding cookie. + (bbdb-write-file-hook-fn): Insert coding cookie if necessary. + +2002-10-30 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-vm.el (bbdb/vm-set-auto-folder-alist): Some fixes for + the generation of vm-auto-folder-alist when using a function as + folder name. + + * lisp/bbdb.el (bbdb-display-layout): + (bbdb-pop-up-display-layout): Fixed a toggling bug reported by + Patrick Campbell-Preston caused by missing defaults. + (bbdb-display-layout-alist): Fixed docs and added layout + pop-up-multi-line to the list of layouts. + +2002-10-19 Steve Youngs <youngs@xemacs.org> + + * bits/bbdb-pgp.el + (bbdb-utilities-pgp): New. + (bbdb/pgp-field): defvar -> defcustom. + (bbdb/pgp-method): Ditto. + (bbdb/pgp-default-action): Ditto. + +2002-10-20 Waider <waider@waider.ie> + + * bits/bbdb-pgp.el: + Allow bbdb-pgp.el to be configured to use message.el MML tags to + perform the signing and encryption, instead of only plain + Mailcrypt which is not MIME-aware. (Michael Shields) + +2002-09-17 Waider <waider@waider.ie> + + * lisp/bbdb.el: + Treat bbdb-canonicalize-net-hook as an actual hook. Some prompting & + code from Micha Wiedenmann. NB documentation not yet updated. + + * texinfo/bbdb.texinfo: + Added dircategory (Jochen Küpper) + +2002-08-19 Jim Blandy <jimb@redhat.com> + + * lisp/bbdb-com.el (bbdb-complete-name): Don't choke if the + record's name is nil. + + * lisp/bbdb-migrate.el (bbdb-migrate-change-dates, + bbdb-unmigrate-change-dates): The raw notes field isn't always an + alist; it can also be a simple string. + +2002-07-26 Simon Josefsson <jas@extundo.com> + + * lisp/bbdb.el (bbdb-quiet-about-name-mismatches): Fix typo. + +2002-07-03 Waider <waider@waider.ie> + + * texinfo/bbdb.texinfo (Customization Parameters): + bbdb-complete-name-allow-cycling /does/ work in GNUmacs. + + * Eli Tziperman's fix for rmail expunge problem + +2002-06-30 Waider <waider@waider.ie> + + * lisp/bbdb-ftp.el + (bbdb-read-new-ftp-site-record): Parse URL or ange-ftp style names + for username and directory. + + * bits/bbdb-obsolete.el + Added. This is some code from Colin Rafferty which allows you to + keep track of obsolete network addresses while preventing you from + completing on them. + + * lisp/bbdb-snarf.el + (bbdb-snarf-phone-regexp): Don't escape '.' in [] (Howard Melman) + + * lisp/bbdb-com.el + (bbdb-phone-main-regexp): Allow '.' as a separator (Howard Melman) + (bbdb-finger): Don't try to finger if there are no addresses + +2002-06-29 Waider <waider@waider.ie> + + * configure.ac: + Don't configure the testing directory if it doesn't exist. + +2002-06-28 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-rebuilt-all-aliases): applied a fix from + Andre Srinivasan + +2002-04-30 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-play-sound): argument NUM is integer now. + (bbdb-sound-player): If set use this programm, otherwise try + native sound support. + (bbdb-dial-number): Calculate the right integer, i.e. do not use + char-int. + +2002-04-18 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-gui.el (build-bbdb-insert-field-menu): Added record to + the arguments for bbdb-insert-new-field. + + * lisp/bbdb-com.el (bbdb-read-new-record): Added completion for + labels. + + * lisp/bbdb-vm.el (bbdb/vm-show-all-recipients), + (bbdb/vm-show-sender), + lisp/bbdb-gnus.el (bbdb/gnus-show-sender), + (bbdb/gnus-show-all-recipients): + Fixed */show-all-reciepients to always do what it should do! + +2002-04-10 Dave Love <fx@gnu.org> + + * lisp/bbdb-gnus.el (bbdb/gnus-summary-show-all-recipients) + (bbdb/gnus-update-records): Revert last change + but use gnus-summary-toggle-header. + + * lisp/bbdb.el: Require cl only when compiling. + Use defalias, not fset generally. + (bbdb-mapc): Define instead of aliasing mapcar. + (bbdb-submit-bug-report): Avoid useless lambda. + (bbdb-format-streets, bbdb-records): Use bbdb-mapc. + (bbdb-gui): Fix default, doc. + (bbdb-have-re-char-classes): New. + (bbdb-clean-username): Use it. + + * lisp/bbdb-srv.el (bbdb-srv): Defalias, not fset. + (bbdb-header-start): Autoload. + + * lisp/bbdb-snarf.el + (bbdb-extract-address-components): Avoid cadar, caddar. + + * lisp/bbdb-rmail.el (bbdb-insinuate-rmail): Use defalias, not + fset. + + * lisp/bbdb-migrate.el (bbdb-migrate, bbdb-migrate-change-dates): + Use bbdb-mapc. + (bbdb-migrate-record-lambda): Avoid caddr. + (bbdb-unmigrate-change-dates): Doc fix. Use bbdb-mapc. + + * lisp/bbdb-gui.el: Use defalias, not fset generally. + (scrollbar-height, highlight-headers-hack-x-face-p): Defvar when + compiling. + (build-bbdb-insert-field-menu): Fix generation of actions. + + * lisp/bbdb-com.el: Require cl and defvar + bbdb-extract-address-components-func only when compiling. + (bbdb-send-mail-internal): Try compose-mail first. + (auto-fill-hook): Defvar when compiling. + (bbdb-complete-name, bbdb-dial, bbdb-get-addresses): Avoid cadar. + (char-int): Don't fset it -- unused. + (bbdb-play-sound): Provide Emacs 21 case. Fix fallback case. + + * lisp/bbdb.el (bbdb-file-coding-system): New variable. + (bbdb-buffer, bbdb-write-file-hook-fn): Use it. + +2002-03-20 Waider <waider@waider.ie> + + * texinfo/bbdb.texinfo: + Rewrote the section on bbdb-dial and its associated variables. + Updated copyright notice and version information. + Added note about VM integration requiring VM source. + Added bbdb-initialize detail to subsection on VM. + +2002-03-13 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-complete-name): Create a popup buffer + before displaying records in order to make sure it has the right + size. + (bbdb-redisplay-one-record): Care for the case when a record is + not present any more in the BBDB buffer. + (bbdb-insert-new-field): get the current records before doing + anything else to ensure that we do not lose the context. + +2002-03-12 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-snarf.el (bbdb-snarf-region): use the function + buffer-substring-no-properties instead of buffer-substring + to ensure that we do not add some garbage into BBDB. + + * lisp/bbdb-rmail.el: removed defuns for bbdb-orig-rmail-expunge + and bbdb-orig-undigestify-rmail-message since they seem to cause + problems and are not required. + + * lisp/bbdb-com.el (bbdb-complete-name): fixed completion bug + for case where name and primary net are identical. + +2002-03-11 Waider <waider@waider.ie> + + * lisp/bbdb.el (bbdb-annotate-message-sender): + Only invoke bbdb-notice-hook when we have noticed a record. + + * lisp/bbdb-com.el (bbdb-update-records): + Docstring fix + +2002-03-03 Waider <waider@waider.ie> + + * lisp/bbdb-gnus.el (bbdb/gnus-get-message-id): + (bbdb/gnus-update-records): + (bbdb/gnus-snarf-signature): + (bbdb/gnus-summary-show-all-recipients): + Use original gnus article buffer rather than the display one + (with its hidden headers and so forth) + + * lisp/bbdb.el + prologue: + Warn about not being able to find message, not Gnus + + * lisp/bbdb-com.el + (bbdb-dial): + Code documentation + documentation fix. + (bbdb-dial-number): + memq takes two args, not three! + prologue: + add autoload for bbdb-fontify-buffer + +2002-02-05 Waider <waider@waider.ie> + + * lisp/bbdb-com.el (bbdb dialing stuff): + Documentation fixes. + (bbdb-dial-number): + According to what docs I can find, it's quite okay to pass * and # + to a modem as part of a dial string + (bbdb-next-event): + Made work on emacs (using read-event instead of next-event) + (bbdb-play-sound): + New function: plays a sound using internal feature, if available, + otherwise it falls back to an external sound player. + (bbdb-dial-local-prefix-alist): + Fix default mapping to allow a string or an integer for default + area code. + +2002-02-04 Waider <waider@waider.ie> + + * lisp/bbdb-gui.el (bbdb-fontify-buffer): + Remove 'Fontifying...' message + + * lisp/bbdb-com.el (bbdb-search-invert-set): + Documentation fix + +2002-02-04 Robert Fenk <Robert.Fenk@gmx.de> + + * bbdb.el (bbdb-format-address-default): + (bbdb-format-address-continental): do not ouput the label. This + is done by `bbdb-format-record-layout-multi-line' + + * bbdb.el (bbdb-format-record-layout-multi-line): Fixed buggy setting of + text-property for 'bbdb-field for addresses and phones. + +2002-02-01 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-address-edit-continental): Asking for the + ZIP code before the city and do not ask for a state. + + * lisp/bbdb.el (bbdb-format-record-layout-multi-line): + (bbdb-format-record-layout-one-line): Set text-property bbdb-field + with element 'field-name for labels of phones and addresses. + + * lisp/bbdb-com.el (bbdb-redisplay-one-record): Remove + text-property bbdb-field before redisplaying to avoid extending + the new properties. + + * lisp/bbdb-gui.el (bbdb-fontify-buffer): Use test properties also + for name, company and labels of phones and addresses. Highlight + them also in one-line layout. + +2002-01-31 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-redisplay-one-record): remove bbdb-field + text-properties before redisplaying. + +2002-01-30 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-vm.el (bbdb/vm-set-auto-folder-alist): Fixed some + comments and creation of vm-auto-folder-alist to match headers in + the order of (bbdb/vm-set-auto-folder-alist-headers): a new variable. + +2002-01-29 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-sc.el (bbdb/sc-consult-attr): Fixed to really use + recipient when logged in user sent this. + + * lisp/bbdb-com.el (bbdb-phones): Prompt indicates inverted search now. + (bbdb-update-records): No useless "Updating of BBDB records + finished" message any more. + (bbdb-define-all-aliases): Fixed warning message for records + without net, but with alias field. + + * lisp/bbdb.el (bbdb-display-layout-alist): Fixed the docs, typos + and default values. + + * lisp/bbdb-gui.el (bbdb-fontify-buffer): Fixed fontification to + use text-properties (bbdb-field) rather than regexps, which fixes + indentations problems with non standard indentation. + +2002-01-22 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-delete-current-record): honor the + bbdb-do-all-records-p! + + * lisp/bbdb.el (bbdb-mode-map): Bind bbdb-search-invert-set to "!" + + * lisp/bbdb-com.el (bbdb): Reflect inverted search in search prompt. + +2002-01-21 Alex Schroeder <kensanata@yahoo.com> + + * lisp/bbdb-com.el (bbdb-search-invert): New variable. + (bbdb-search-invert-p): New function. + (bbdb-search-invert-set): New function. + (bbdb-search): Use bbdb-search-invert-p to maybe invert the + search result. + +2002-01-18 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-gui.el (bbdb-fontify-buffer): is now more efficent + when redisplaying records. button2 work now again as intended. + + * lisp/bbdb.el: Removed the old elide code stuff. + (bbdb-display-records-1): see bbdb-fontify-buffer. + + * lisp/bbdb-com.el (bbdb-append-records-p): + (bbdb-append-records): (prefix) command (like "*") bound + to "+" which forces the display/search command to add its content to + the BBDB buffer rather than replacing it. + Appending can be once, always or a given number of times. + + * lisp/bbdb-gnus.el: removed binding of unused variabe `error'. + + * lisp/bbdb-snarf.el + (bbdb-extract-address-component-regexps): Fixed regexp. + (bbdb-rfc822-addresses): Fixed autoload string. + + * lisp/bbdb.el (bbdb-display-records-1): enable appending of records. + (bbdb-search-intertwingle): Search also for records when no name + was given, but just a net. + (bbdb-mode-map): bbdb-add-next-search-results bound to + + + * lisp/bbdb-com.el: eval-and-compile otherwise the fsets do not + get evaluated on. + (bbdb-redisplay-one-record): Try to preserve the position during + redisplay. + (bbdb-completion-check-record): removed the dependency on + `bbdb-case-fold-search' since completions from the bbdb-hashtable + are always lower case. + (bbdb-complete-name): fixed cycling when the + current completion is equal to one of the nets. + Added code for C-u M-TAB which lists all possible nets of current + completed addess. Fixed some special cases by rewriting some too + complex parts of the code. Thanks to the new testing code. + When will this function finnaly do exactly what it should do? + (bbdb-define-all-aliases-mode): new variable controling special + aliases, i.e. alias<NUMBER> & alias*. + (bbdb-define-all-aliases): (XEmacs only sofar) Clear abbrev-table + before defining abbreves and honor new aliases-mode. + Automatice rebuilt of aliases if necessary. + (bbdb-add-or-remove-mail-alias): after adding or removing an + alias, set a flag for rebuilting.. + +2002-01-15 Waider <waider@waider.ie> + + * lisp/bbdb.el: + BBDB-2.35 - Let the games begin. + + * html/bbdb_abt.html, html/bbdb_fot.html, html/bbdb_ovr.html, + html/bbdb_toc.html, html/bbdb_3.html, html/bbdb_4.html, + html/bbdb_1.html, html/bbdb_2.html, html/bbdb.html: + Updated manual for 2.34 + + * html/index.html: + 2.34 release changes + + * lisp/bbdb.el: + 2.34 Release. Whee! + + * testing/bbdb-test.el: + New file + + * bits/make.bat: + Merged in some changes from the mailing list. Note, this is + still experimental. + + * lisp/bbdb-com.el: + Don't fset things that aren't ours + Last of compiler warning cleanup + Fixed one more completion bug + + * Makefile.in: + Ignore 'testing' directory when making tarball + +2002-01-14 Waider <waider@waider.ie> + + * lisp/bbdb-hooks.el: + Conditionalise the rmail load + + * lisp/bbdb-gui.el: + Make X/Emacs compatibility less intrusive + +2002-01-13 Waider <waider@waider.ie> + + * lisp/bbdb-hooks.el: + Don't force VM on people, even if it is a great mailer... + +2002-01-10 Waider <waider@waider.ie> + + * bbdb-com.el: + Last few fixes (hopefully) to completion + + * lisp/bbdb-snarf.el: + Make bbdb-rfc822-addresses the default address parser + Remove test-harness code to elsewhere (i.e. not in user code!) + + * lisp/bbdb.el: + Changed the workaround for set-keymap-prompt, as it seemed to be + clashing with VM. Ideally, all this Emacs/XEmacs stuff should go + in a separate file, or at least all in one part of bbdb.el. + +2002-01-06 Waider <waider@waider.ie> + + * lisp/bbdb-xemacs.el, lisp/bbdb-srv.el, lisp/bbdb-sc.el, + lisp/bbdb-gui.el, lisp/bbdb-ftp.el, lisp/bbdb-com.el, + lisp/bbdb-hooks.el, lisp/bbdb-w3.el, lisp/bbdb.el, + lisp/bbdb-snarf.el: + Compiler cleanup + + * lisp/Makefile.in: + Put the 'custom' hacks in bbdb-autoloads + Less noise while building + +2002-01-04 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-snarf.el (bbdb-extract-address-component-regexps): + Replaced the call of bbdb-clean-username by a call to + mail-extract-address-components in order to handle addresses of + the form "Lastname, Firstname" and "Firstname Lastname, Jr" in the + right way. + (bbdb-test/bbdb-extract-address-components): New test function to + check if everything is working as it should. + +2002-01-01 Waider <waider@waider.ie> + + * lisp/bbdb-com.el (bbdb-complete-name): + Two fixes based on further testing with completion-type. + +2001-12-27 Waider <waider@waider.ie> + + * lisp/bbdb-com.el + (bbdb-completing-read-one-record): + Correctly handle case where no records are selected + (bbdb-complete-name): + Whoops. Small logic error in cycling code + + * lisp/bbdb.el (bbdb-send-mail-style), + lisp/bbdb-com.el (bbdb-send-mail-internal): + Add Mew as an option for bbdb-send-mail-style + +2001-12-27 Jeff Bigler <jcb@mit.edu> + + * lisp/bbdb-com.el (bbdb-phone-area-regexp): + Allow / and . as separators when parsing a phone number. + +2001-12-26 Waider <waider@waider.ie> + + * lisp/bbdb-com.el (bbdb-complete-name): + Mostly rewritten to consolidate the last four years(!) of code + glomming. + + * lisp/bbdb.el (bbdb-search-intertwingle): + New function. More stringent version of bbdb-search-simple, + intended for internal bbdb use only + +2001-12-10 Karl Fogel <kfogel@red-bean.com> + + * bbdb.texinfo + (Mail Sending Interfaces): + Use `add-hook' instead of `setq' in the examples, so users won't + clobber existing hooks. + (Known Bugs): + Reference mailing lists, as is done in other places where the + `bbdb-info' list is mentioned. + +2001-11-19 Waider <waider@waider.ie> + + * lisp/bbdb.el (bbdb-format-address): + Several people contributed a patch to fix this. Alex Schroeder's + was the most general as it handles both printing and + non-printing situations. + + * lisp/bbdb-print.el + Some more fixes from Alex. + + * aclocal.m4: + Use EMACS_PROG instead of EMACS to solve all problems related to + that variable. + + * configure.ac: + Default XEmacs package dir to /usr/blah rather than + /usr/local/blah + Improve switches for MH-E, RMAIL, VM and GNUS + +2001-11-12 Waider <waider@waider.ie> + + * lisp/bbdb-snarf.el (bbdb-extract-address-component-regexps): + Allow '+' as part of an email address + + * lisp/bbdb-com.el (bbdb-complete-name-allow-cycling): + Documentation fix + (bbdb-get-help-window): + Removed dead code + + * lisp/bbdb.el + Try to autoload the message-mode and mail-mode keymaps rather than + defining them as nil. + +2001-11-11 Waider <waider@waider.ie> + + * lisp/bbdb-vm.el (bbdb/vm-set-auto-folder-alist-field): + Move into mua-specific group + (bbdb/vm-set-auto-folder-alist): + Documentation typo + +2001-11-06 Waider <waider@waider.ie> + + * texinfo/bbdb.texinfo (Mail Sending Interfaces): + Mention message-setup-hook in the mail aliases section + (Raymond Scholz) + +2001-10-14 Waider <waider@waider.ie> + + * lisp/bbdb-gnus.el + (bbdb/gnus-pop-up-bbdb-buffer): + Move the call to bbdb-display-records back inside the (when...) + I had two bug reports for this (Sudesh Joseph and Michael + Totschnig). + + * lisp/bbdb.el: + Added Nix's patch to make inside-bbdb-notice-hook work as + advertised, also other bbdb-expire support. + (bbdb-search-simple): + Try company name if record name is unset, before falling back to + "". (Martin Schwenke) + + * lisp/bbdb-com.el + (bbdb-complete-name): + Restored the original code to handle making sure primary addresses + get picked first, since the code I'd replaced it with had some + dubious side-effects. + (bbdb-create-internal): + Documentation fix. (Ueli Schläpfer) + +2001-09-20 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-create-hook), (bbdb-notice-hook): + Added a note that hook functions might use the new variables + bbdb-update-address-class and bbdb-update-address-header to obtain + information about the currently processed email address. + + * lisp/bbdb-com.el (bbdb-get-addresses-headers): merged + bbdb-get-addresses-from-headers and bbdb-get-addresses-to-headers + into this variable. + (bbdb-get-addresses): new generic function for extraction of email + addresses from header, which is used by Gnus and VM + (bbdb-update-address-class), (bbdb-update-address-header): new + variable providing additional information to hook functions about + the currently processed email address. + + * lisp/bbdb-gnus.el (bbdb/gnus-update-records): uses + bbdb-get-addresses instead of bbdb/gnus-get-addresses which was + removed. + (bbdb/gnus-show-sender), (bbdb/gnus-show-all-recipients), + (bbdb/gnus-show-records): modified to use new style of + bbdb-get-addresses-headers + + * lisp/bbdb-vm.el (bbdb/vm-get-header-content): VM specific header + extraction function. + (bbdb/vm-update-records): bbdb-get-addresses instead of + bbdb/vm-get-addresses which was removed. + (bbdb/vm-show-all-recipients), + (bbdb/vm-show-sender), (bbdb/vm-show-records): modified to use new + style of bbdb-get-addresses-headers + + * lisp/bbdb-hooks.el (bbdb-auto-notes-alist): Additional element + type to allow actions also on recipients of an message + (bbdb-auto-notes-hook): Fixed to perfom auto-note actions only for + authors of a message. Support for new features of + bbdb-auto-notes-alist. Honor bbdb-silent-running. + +2001-09-18 Waider <waider@waider.ie> + + * lisp/bbdb-snarf.el (bbdb-rfc822-addresses): + Cope with rfc822-addresses returning nil as the car. + +2001-09-11 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-print.el (bbdb-print-field-shown-p): Added as a + replacement for bbdb-field-shown-p. + (bbdb-print-omit-fields): Added as a replacement for + bbdb-print-elided-display. + + * lisp/bbdb-com.el (bbdb-get-addresses-headers): + bbdb-auto-notes-alist does not know if a address comes form a + author or recipient of a message and therefore might update wrong + records, e.g. the organization of recipients to that of the + author. + Therfore the default is now bbdb-get-addresses-from-headers until + the hook functions are able to tell the type (author/recp) of an + address. + +2001-09-09 Waider <waider@waider.ie> + + * lisp/bbdb-gui.el: + Fixed bogus fset (fsetting variable instead of 'variable) + (bbdb-hack-x-face): + use bbdb-find-face, not find-face + + * configure.ac: + If $(RM) is actually rm, add the -f flag + Add --with-<insinuation target>. Needs work, though. + + * Makefile.in + Default target is now 'all' + Added configure and Makefile targets + + * lisp/Makefile.in + Added Makefile target + Call expand-file-name when building load-path + + * lisp/bbdb.el + (bbdb-initialize): + Fixed vm entry. vm-load-hook no longer exists! + (bbdb-mode): + Removed references to bbdb-elide-record + +2001-09-05 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-complete-name-hooks): Fixed the + documentation. + (bbdb-get-only-first-address-p): fixed the default value, which + should have been t + +2001-09-04 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-annotate-message-sender): calling of + bbdb-create-hook functions moved to the end of function + (bbdb-display-layout-alist): replaced by the nice version + provided by Alex Schroeder <alex@gnu.org> + +2001-08-31 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-hooks.el (bbdb-auto-notes-alist): applied posted + patch of better customization. + + * lisp/bbdb-srv.el, lisp/bbdb-rmail.el, lisp/bbdb-mhe.el, + lisp/bbdb-vm.el, lisp/bbdb-gnus.el, lisp/bbdb.el, + lisp/bbdb-com.el: replaced occureneces of bbdb-elided-display and + bbdb-pop-up-elided-display. + + * lisp/bbdb-gui.el (build-bbdb-menu): Fix menus to use new display + layout toggeling functions. + + * lisp/bbdb-com.el (bbdb-change-records-state-and-redisplay), + (bbdb-toggle-all-records-display-layout), + (bbdb-toggle-records-display-layout), + (bbdb-display-all-records-completely), + (bbdb-display-record-completely): modified functions for toggeling + the display layout of records. Old functions bbdb-elide-record + and bbdb-unelide-records have been removed. + + * lisp/bbdb.el + (bbdb-display-layout-alist): variable controling options for + display layouts, support for user defines format functions still + missing. + (bbdb-display-layout): variable controling the default display layout + (bbdb-pop-up-display-layout): variable controling the default display + layout for pop-up buffers. + (bbdb-elided-display), (bbdb-pop-up-elided-display): are obsolete + variables now. + (bbdb-elided-display-sanity-setup): function which sets up the + layout variables from the obsolete bbdb-elided-display and + bbdb-pop-up-elided-display variables. Might be removed along with + the variables in the future. + (bbdb-format-record): rewitten to support multiple + layouts according to bbdb-display-layout-alist + (bbdb-format-record-layout-multi-line), + (bbdb-format-record-layout-one-line), + (bbdb-format-record-one-line-*): Function specific to certain + layouts. + +2001-08-26 Steve Youngs <youngs@xemacs.org> + + * lisp/bbdb.el (bbdb-initialize): Autoload it. + +2001-08-13 Jeff Mincy <jeff@delphioutpost.com> + + * fix bbdb-hack-x-face call to make-glyph + +2001-08-01 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-unelide-record), + (bbdb-elide-record-internal): Modified for more convenient + toggeling of the omitted display mode. + +2001-07-31 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-gui.el (build-bbdb-menu): Added an "(Un)Elide All + Records entry" and content of variable `global-bbdb-menu-commands' + moved into the defun. + (bbdb-user-menu-commands): New variable with user menu commands + appended to default menu. + (build-bbdb-menu): Add extra menu entry for displaying all fields + when `bbdb-display-omit-fields' is set. + (bbdb-menu): Added detection of fields for menu commands. + + * lisp/bbdb.el (bbdb-field-shown-p): Changed the defsubst to a defun. + (bbdb-format-record-elided), (bbdb-format-record-full): Replace + bbdb-format-record. They add text-properties to the fields in + order to know fields for editing. + (bbdb-display-omit-fields): New variable which is a list fields + omitted during full display of a record. + (bbdb-display-fields-order): New variable specifying to order of + fields for during full display of a record. + (bbdb-format-elided-phones), (bbdb-format-elided-net): Formating + functions for elided display. + + * lisp/bbdb-com.el + (bbdb-elide-all-records): New function for the BBDB menu + (bbdb-unelide-record): New function for showing fileds hidden by + `bbdb-display-omit-fields' + (bbdb-record-edit-field-internal): Added location arg and company + field. + (bbdb-current-field): Simpified it ti use text-properties for + field recognition + (bbdb-record-edit-company): New function for editing the records + company + (bbdb-record-edit-address): Fixed the docs + (bbdb-record-edit-phone): Added optional location arg + (bbdb-prompt-for-create): Use characters instead of integers for + the key-presses and avoid calling char-int. + +2001-07-29 Waider <waider@waider.ie> + + * lisp/bbdb-com.el (bbdb-complete-name): + Make it respect the order in which net addresses are listed. + + * lisp/bbdb-srv.el (bbdb-srv-add-phone): + Make less interactive, autoload it, and make sure it requires + anything it needs. + + * lisp/bbdb-snarf.el (bbdb-rfc822-addresses): + This should take an optional ignore-errors parameter. + +2001-07-08 Waider <waider@waider.ie> + + * lisp/bbdb-com.el, lisp/bbdb.el: + More work on the completion-of-labels stuff. NB I've changed some + variable names. Sorry if you actually used this already, but + hey. Bleeding edge. + + * lisp/Makefile.in: + Made quieter, so it's easier to see compilation problems + Fixed gnuserv/bbdb-srv build + +2001-07-07 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: + Use bbdb-extract-field-value + Minor compiler cleanup + + * lisp/bbdb-vm.el: + Use bbdb-extract-address-components-func + + * lisp/bbdb-gnus.el: + 19.34 support mods. + Use bbdb-extract-address-components-func. + + * lisp/bbdb-snarf.el: + New customization variable: bbdb-extract-address-components-func - + this tells BBDB what function you'd like to use to attempt parsing of + the mail addresses. + + New function for use with the above: bbdb-rfc822-addresses. Brute + force, but does a pretty good job. + + Fixed some comment and documentation typos. + +2001-07-01 Waider <waider@waider.ie> + + * lisp/bbdb-gui.el: + Whoops. eval-and-compile, not eval-when-compile. + +2001-06-28 Waider <waider@waider.ie> + + * lisp/bbdb-mhe.el: + bbdb/mh-cache-key: cope with big inode numbers + + * lisp/bbdb-vm.el: + Added Robert Fenk's bbdb/vm-force-create + + * html/index.html: Added link to freshmeat page + + * lisp/bbdb-gui.el: + Cleaned up a whole bunch of compiler warnings through judicious use of + eval-and-compile or eval-when-compile. If anyone has a good opinion on + use of these functions, please cast enlightenment in my direction. + + * lisp/bbdb-gnus.el: + Rearranged the compiled quieting to actually be more-or-less the right + thing, i.e. it loads packages instead of defining arbitrary + variables. + + Put in Matan Ninio's "From: " fix. + + * lisp/bbdb.el: + bbdb-search-simple: don't use bbdb-record-name's result if it's empty. + +2001-06-23 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-mhe.el (bbdb/mh-update-record): + * lisp/bbdb-rmail.el (bbd/rmail-update-records): + Fixed the faulty use of bbdb/prompt-for-create-p. + +2001-06-12 Waider <waider@waider.ie> + + * html/index.html: + Fix to yesterday's fixed URL. Not my fault, honest. + + * bbdb/html/faq.html: + Initial cut. This has been sitting on my drive for almost a year; + perhaps if I put it in CVS I'll be "encouraged" to develop it further. + +2001-06-11 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: + Better fix for char-int thing. This one works, for starters. Serves me + right for that comment about code testing. + +2001-06-10 Waider <waider@waider.ie> + + * bits/gnus-bbdb.el: + Obsolete; contents rolled into bbdb-gnus.el + + * lisp/bbdb.el + (bbdb-read-string): + Allow specifying a list of completions, which causes + completing-read to be invoked instead of read-string. + + * lisp/bbdb-com.el + (bbdb-prompt-for-create): + Fixed some XEmacsisms to work with GNUmacs. PLEASE TEST YOUR + CODE AGAINST BOTH EMACS VARIANTS BEFORE CHECKING IT IN. + * (bbdb-address-edit-default): + If no data is entered for the address, enter a spurious country + name. This is a temporary hack to get around a problem in + address display when the address has no data. + * (general) + Fixed the occasional documentation typo. + Added completion for Phone and Address labels. + Added bbdb-default-country as an attempt to stop you from + entering blank addresses. Also because it was requested. + + * html/index.html: Fixed URL for Martin Schwenke. + +2001-06-05 Waider <waider@waider.ie> + * Makefile.in: Fixed tarball build to work with new autoconf stuff + +2001-06-05 Didier Verna <didier@xemacs.org> + + * aclocal.m4: upgrade to Autoconf 2.50. + * aclocal.m4 (BBDB_PRE_INIT): new. + * aclocal.m4 (BBDB_ARG_SUBST): new. + * configure.ac: renamed from configure.in. Upgrade to Autoconf + 2.50. + +2001-06-01 "Albert L. Ting" <alt@artisan.com> + + * lisp/bbdb-vm.el (bbdb/vm-update-records): + * lisp/bbdb-gnus.el (bbdb/gnus-update-records): + Subject: bbdb-get-only-first-address-p patches + +2001-05-31 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-gnus.el (bbdb/gnus-get-addresses): Fixed the bug which + was not really fixed with the commit from the 2001-03-29. + +2001-05-23 Didier Verna <didier@xemacs.org> + + * aclocal.m4 (BBDB_PROG_EMACS): fix Emacs detection problem when + configuring from an Emacs shell buffer. + +2001-05-21 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb/news-auto-create-p): + (bbdb/mail-auto-create-p): + * lisp/bbdb-com.el (bbdb-update-records): + Fixed a typo. + + * lisp/bbdb-com.el (bbdb-complete-name): + (bbdb-complete-name-hooks): Instead of dinging when completing a + complete address (and with cycling disabled) call theses hook + (bbdb-update-records): Fixed a typo. + +2001-05-18 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-invoke-hook-for-value): Fix: Return symbols + BUT CALL FUNCTIONS! + +2001-05-17 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-invoke-hook-for-value): Return symbols just + as they are, do not eval them. + + * lisp/bbdb-com.el (bbdb-update-records-mode): + * lisp/bbdb-vm.el (bbdb/vm-update-records-mode): + * lisp/bbdb-gnus.el (bbdb/gnus-update-records-mode): + Removed extra quote from the defcustom arguments. + + * lisp/bbdb-com.el (bbdb-complete-clicked-name): Fixed a cycling + bug when choosing a completion which ia already complete. + +2001-05-14 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb/mail-auto-create-p): + (bbdb/news-auto-create-p): When set to 'promt then ask the user + before automatically creating a record. + + * lisp/bbdb.el (bbdb*prompt-for-auto-create-p): Removed the + variable and packed its functionality into the + bbdb/*-auto-create-p variables. + + * lisp/bbdb-snarf.el (bbdb-extract-address-components): Allow also + nil as name or email address, not only strings. + + * lisp/bbdb-rmail.el (bbdb/rmail-pop-up-bbdb-buffer): Remove the + BBDB buffer window when empty. + + * lisp/bbdb-migrate.el (bbdb-unmigrate-zip-codes-to-strings): + Fixed the faulty use of let instead of let*. + + * lisp/bbdb-hooks.el + (bbdb-ignore-selected-messages-confirmation): Added the missing + default value nil. + (bbdb-force-record-create): New hook function for automatic adding + of addresses when replying to a message. + + * lisp/bbdb-gnus.el (bbdb/gnus-update-records): + * lisp/bbdb-vm.el (bbdb/vm-update-records): Fixed documentation. + + * lisp/bbdb-com.el (bbdb-update-records): Fixed search for nets + and documentation. + +2001-04-19 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-gui.el (bbdb-fontify-buffer): + * lisp/bbdb.el (bbdb-elided-display-fields): + Renamed the variables bbdb-pop-up-elided-display-name-end and + bbdb-pop-up-elided-display-fields to bbdb-elided-display-name-end and + bbdb-elided-display-fields, as they are not related to the pop-up + feature. + + * texinfo/bbdb.texinfo: Added missing docs for the variables + bbdb-elided-display-name-end and bbdb-elided-display-fields + +2001-04-16 Waider <waider@waider.ie> + + * configure.in Makefile.in lisp/Makefile.in tex/Makefile.in + texinfo/Makefile.in utils/Makefile.in + Make sure RM is set, since apparently it's not set in BSD Make by + default. + + * lisp/bbdb-com.el: + Whoops. Stray quote mark. + +2001-04-15 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: + Added John F. Whitehead's default mail domain patch. + Hack around some silliness in GNU Emacs completion code + + * lisp/bbdb.el: + Added emacs-version to bug report text. + Added John F. Whitehead's default-domain patch. + +2001-03-30 Waider <waider@waider.ie> + + * lisp/bbdb-gnus.el: + Fix list-vs-not bug in bbdb/gnus-edit-notes + +2001-03-29 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-gnus.el (bbdb/gnus-get-addresses): Fixed a bug in + getting the header content. mail-fetch-field requires a final + newline! + +2001-03-26 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-message-cache-lookup): + * lisp/bbdb-gnus.el (bbdb/gnus-update-records): + * lisp/bbdb-vm.el (bbdb/vm-update-records): + Bugfix: first record was lost when looking it up from the + cache. + +2001-03-25 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-message-cache-lookup): + Removed the faulty single record code for Rmail/MHE + + * lisp/bbdb-mhe.el (bbdb/mh-update-record): + Bugfix for new caching functions + + * lisp/bbdb-rmail.el (bbdb/rmail-update-records): + Another bugfix: check for nil before caching + + * lisp/bbdb-gnus.el (bbdb/gnus-show-sender): + * lisp/bbdb-vm.el (bbdb/vm-show-sender): + Show recipients if we find no senders + + * lisp/bbdb-vm.el (bbdb/gnus-show-records): + * lisp/bbdb-vm.el (bbdb/vm-show-records): + Also show the records of uninteresting senders + +2001-03-25 Waider <waider@waider.ie> + + * lisp/bbdb-rmail.el: + Fix some bugs related to new message caching functions. + +2001-03-23 Waider <waider@waider.ie> + + * lisp/bbdb-com.el (bbdb-display-completion-list): + Make completion on GNU Emacs remove what you've typed before + inserting the completion data. + + * lisp/bbdb.el (bbdb-search-simple): + Fix silly bug with list-walking (Daniel Pittman) + + * lisp/bbdb-gui.el + Fix priorities thing so that you can access per-field menus on + GNU Emacs. + +2001-03-23 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-vm.el (bbdb/vm-update-records): + * lisp/bbdb-gnus.el (bbdb/gnus-update-records): + * lisp/bbdb-com.el (bbdb-update-records): honor the right + offer-to-create flag and removed the faulty *-auto-create-p which + was added by the last commit. + +2001-03-22 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-vm.el (bbdb/vm-show-records): bbdb/mail-auto-create-p + is loacally set to t in order to force creation of records when + explicitly showing them. + +2001-03-21 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-prompt-for-create): fix a bug with GNU + Emacs. + +2001-03-19 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-update-records): honors now + bbdb-gag-messages; fixed the overall number in the progress + message. + +2001-03-18 Waider <waider@waider.ie> + + * lisp/bbdb-gnus.el (bbdb/gnus-get-addresses): + gnus-ignored-from-addresses is not defined in the Gnus that + comes with Emacs 20.7. Check for boundness before using. + +2001-03-17 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-whois.el: Definition of some variable in order to + avoid warnings during compilation + + * lisp/bbdb-mhe.el: + * lisp/bbdb-rmail.el: uses the new caching functions + some + other minor changes + + * lisp/bbdb-snarf.el (bbdb-snarf-region): Unused variables + 'country and 'namebegin removed + + (bbdb-snarf-nice-real-name-regexp): + (bbdb-snarf-nice-real-name): removed and calls replaced by + bbdb-clean-username which is more sophisticated + + * lisp/bbdb-vm.el (bbdb/vm-get-addresses): was formally + bbdb/vm-get-from + (bbdb/vm-get-from-headers): + (bbdb/vm-get-only-first-from-p): + (bbdb/vm-message-cache-lookup): + (bbdb/vm-encache-message): have been removed, global variables and + functions are used now + + (bbdb/vm-show-sender): when called with a prefix call + bbdb/vm-show-all-recipients instead, so we use the same binding + for getting both. + (bbdb/vm-show-records): new function doing the bbdb/vm-show-* + thing and caring for updating the records. + + (bbdb/vm-snarf-all): + (bbdb/vm-snarf-all-headers): have been removed as the + bbdb/vm-show-* function provide the same functionality + + * lisp/bbdb-gnus.el: the same changes as for bbdb-vm.el + + * lisp/bbdb-xemacs.el (bbdb-load-touchtones): unused variale + 'error removed + + * lisp/bbdb.el (bbdb-pop-up-elided-display): + (bbdb-pop-up-elided-display): changed to require no unbound + bbdb-pop-up-elided-display + + (bbdb-message-cache-lookup): + (bbdb-encache-message): Once again functions to replace the old + macros. This was necessary as the old macros were not sufficient + for the new update mechanism, were we have a list of records. + + * lisp/bbdb-merge.el (bbdb-merge-file): unused variable + 'live-records removed + + * lisp/bbdb-com.el (bbdb-redisplay-records): unused variable + condition removed + + (bbdb-delete-current-field-or-record): unused variable do-all-p + removed + + (bbdb-refile-record): called with a prefix arg it tries to merge + with the corresponding duplicate record + + (bbdb-display-completion-list): Use the call back + 'bbdb-complete-clicked-name when running in Xemacs, thus to + further complete after the user selects a completion. + + (bbdb-complete-name): + (bbdb-complete-name-full-completion): new variable controlling + whether completion shows expanded entries or not. This avoids + the need for subsequent completions, but might generate more + completion alternatives. + + (bbdb-prompt-for-create): + (bbdb-prompt-for-create): + (bbdb-get-help-window): + (bbdb-update-records): functions used to update BBDB records from + headers of messages in Gnus and VM (RMail and MHE may eventually + follow). Those functions have been renamed and moved from + bbdb-vm.el to this location. + + (bbdb-update-records-mode): + (bbdb-offer-to-create): + (bbdb-address): + (bbdb-get-addresses-from-headers): + (bbdb-get-addresses-to-headers): + (bbdb-get-addresses-headers): + (bbdb-get-only-first-address-p): variables for generic + update-records support in Gnus and VM. Those variables have been + renamed and moved from bbdb-vm.el to this location. + + +2001-03-04 Waider <waider@waider.ie> + + * BBDB 2.32 tagged, bottled, and set free. + + * lisp/bbdb.el: Version number update for release. + + * lisp/bbdb-snarf.el: + Require bbdb-com (for bbdb-parse-phone-number) + Stop from loading .bbdb when compiling! + + * lisp/bbdb-sc.el: + Mark bbdb/sc-default for autoload. Not sure this is entirely the right thing. + + * lisp/Makefile.in: + ">>" and ">" transposed. (Yair Friedman) + +2001-03-03 Waider <waider@waider.ie> + + * lisp/bbdb.el: + bbdb-search-simple: check that the name actually matches (not company) + +2001-03-01 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-submit-bug-report): A function for submitting bug + reports, which should make it easier for reportes and maintaines + to give and have all necessary information. Additional variables + may have to be add and a remark in the documentation to use this + function when reporting problems. + +2001-02-25 Waider <waider@waider.ie> + + * html/bbdb-2.20.tar.gz: + Shouldn't have been in here in the first place. Sorry 'bout that. + + +2001-02-25 ShengHuo ZHU <zsh@cs.rochester.edu> + + * texinfo/bbdb.texinfo: Format it so that texinfo-format-buffer + can parse it. + + * texinfo/infohack.el: New. + + * texinfo/Makefile.in (Makefile): Add. + (bbdb.info): Use batch-makeinfo if there is no makeinfo. + +2001-02-21 Waider <waider@waider.ie> + * lisp/bbdb.el + Restore old bbdb-message-cache macros as replacement functions + were buggy. + Stop BBDB from adding AKAs when you tell it you don't want them. + +2001-02-21 Sam Steingold <sds@gnu.org> + *lisp/bbdb.el + New user option for GUI features + +2001-02-19 ShengHuo ZHU <zsh@cs.rochester.edu> + + * lisp/Makefile.in (bbdb-autoloads.el): + Insert (provide 'bbdb-autoloads) when generated by FSF Emacs. + +2001-02-19 Waider <waider@waider.ie> + + * lisp/bbdb-snarf.el: + doco typo fixo + + * lisp/bbdb.el: + bbdb-electric-p defaults to off. + require 'bbdb-autoloads instead of loading them. + bbdb-whois moved from M-w to W so you can do copies in *BBDB* + moved some XEmacs-stuff to bbdb-gui, where it's Emacs-agnostic + + * lisp/bbdb-xemacs.el: + Moved font and menu stuff to bbdb-gui.el + + * lisp/Makefile.in: + Added target for bbdb-gui + + * lisp/bbdb-gui.el: + Menu and font hackery. Works in Emacs as well as XEmacs. + + * Makefile.in: + Quick fix for LN_S not being defined. Perhaps it's even the + correct fix. + +2001-02-14 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-vm.el (bbdb/vm-update-records): Fixed bug of calling + message with wrong argument. + +2001-02-14 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: + Some more defcustom stuff (Alex Schroeder) + Empty string is a valid Zip code (Alex Schroeder) + + * lisp/bbdb.el: + Some defvars changed to defcustoms (Alex Schroeder) + bbdb-add-or-remove-mail-alias documented in mode help (Alex Schroeder) + + * texinfo/bbdb.texinfo + Zipcode stuff (Alex Schroeder) + +2001-02-13 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-vm.el + (bbdb/vm-update-records): replaced display-message calls by + message calls which is more portable. + + * lisp/bbdb.el: + Applied ShengHuos patch to fix the customize problems caused by + defining 'characterp as a mcaro im GNU Emacs. + + * lisp/bbdb-com.el (bbdb-complete-name): + (bbdb-complete-name-allow-cycling): Allow to enable/disable the + cycling of nets. Default is disabled, as there are some strange + problems with GNU Emacs. + +2001-02-10 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> + + * lisp/bbdb-snarf.el (replace-in-string): Fix the argument order + of replace-regexp-in-string. + +2001-02-10 Waider <waider@waider.ie> + + * bbdb/lisp/bbdb.el: + Fixed bbdb-undisplay-records. bbdb-buffer-name is /not/ a buffer! + + * bbdb/lisp/bbdb-vm.el: + Seems like the change to bbdb-undisplay-records fixes the VM + window problem. + +2001-02-08 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el: doc fix + + * lisp/bbdb-com.el: doc fixes + +2001-02-08 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb.el (bbdb-annotate-message-sender): + Applied bugfix for adding new net addresses, which was broken by + the new featue of creating a new record if the address does not + belong to the existing record. + (bbdb-display-records): + (bbdb-display-records-1): + run the hooks 'bbdb-list-hook in bbdb-display-records-1, instead + of bbdb-display-records, in order to call them also for electric + display. + +2001-02-07 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: + (ding) if there's nothing in mail-abbrevs either. + + * lisp/bbdb-vm.el: + Only call the sit-for bugfix in fsfemacs. + +2001-02-07 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-com.el (bbdb-complete-name): Fixed bug which showed + its effect only with GNU Emacs. + (bbdb-add-or-remove-mail-alias): Better prompt. + +2001-02-05 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/Makefile.in (bbdb-hooks.elc): removed need to load VM. + + * lisp/bbdb.el (bbdb-frob-mode-line): Removed faulty + replace-in-string. + +2001-02-03 Robert Fenk <Robert.Fenk@gmx.de> + + * lisp/bbdb-snarf.el (bbdb-extract-address-component-regexps): + removed bbdb-snarf-nice-real-name-* variables and function and + replaced it by a call to bbdb-clean-username which is more + sophisticated. + +2001-02-03 Robert.Fenk@gmx.de + + * lisp/bbdb.el (bbdb-message-cache-lookup), (bbdb-encache-message): + Replaced the unreadable macros by a function in order to use it + also for bbdb-vm.el. + (bbdb-decache-message): new function to remove an element from + the cache. + (bbdb-annotate-message-sender): Added creation of a new "duplicate" + record when the given email address does not belong to the + existing one. + +2001-02-02 Robert.Fenk@gmx.de + + * lisp/bbdb-com.el (bbdb-find-duplicates): Fixes records without a + name and adds additional messages in order to understand the + duplicates. + +2001-02-02 Didier Verna <didier@xemacs.org> + + * Makefile.in (SUBDIRS): new variable. + * Makefile.in (install-pkg): split in subdirs. + * Makefile.in (uninstall-pkg): new target. + * Makefile.in (local-clean): new target. + * Makefile.in (clean): depend on it. + * Makefile.in (local-distclean): new target. + * Makefile.in (distclean): depend on it, split in subdirs. + * Makefile.in (local-cvsclean): new target. + * Makefile.in (cvsclean): depend on it, split in dubdirs. + * configure.in: generate tex/Makefile and utils/Makefile. + * lisp/Makefile.in (INSTALL): new autoconf variable. + * lisp/Makefile.in (INSTALL_DATA): ditto. + * lisp/Makefile.in (LN_S): ditto. + * lisp/Makefile.in (PACKAGEDIR): ditto. + * lisp/Makefile.in (LINKPATH): ditto. + * lisp/Makefile.in (install-pkg): split from ../Makefile.in + * lisp/Makefile.in (uninstall-pkg): new target. + * texinfo/Makefile.in (INSTALL): new autoconf variable. + * texinfo/Makefile.in (INSTALL_DATA): ditto. + * texinfo/Makefile.in (LN_S): ditto. + * texinfo/Makefile.in (PACKAGEDIR): ditto. + * texinfo/Makefile.in (LINKPATH): ditto. + * texinfo/Makefile.in (install-pkg): split from ../Makefile.in + * texinfo/Makefile.in (uninstall-pkg): new target. + * texinfo/bbdb.texinfo (XEmacs Package): update documentation. + * tex/Makefile.in: new file. + * tex/.cvsignore: new file. + * utils/Makefile.in: new file. + * utils/.cvsignore: new file. + +2001-02-01 Robert.Fenk@gmx.de + + * lisp/bbdb-com.el (bbdb-mail-abbrev-expand-hook): honor the + pop-up settings, e.g. bbdb-pop-up-target-lines + + * lisp/bbdb-xemacs.el (bbdb-mode-map): Added elide-records binding + for button2 + + * lisp/bbdb-vm.el (bbdb/vm-pop-up-bbdb-buffer): Fixed the pop-up + behavior. + +2001-01-30 Robert.Fenk@gmx.de + + * lisp/bbdb-com.el (bbdb-complete-name): Fixes completion problem + slipped into with revision 1.89 + +2001-01-24 Waider <waider@waider.ie> + * RELEASED BBDB 2.2 + + * texinfo/Makefile.in: + Added distclean target + + * Makefile.in: + Removed test targets as they weren't helpful + Added some new cleaning targets, including distclean + + * lisp/Makefile.in: + New cleanup targets + + * Makefile, configure + Removed, as they're generated files. configure can be extracted + from the tarball if you don't have the tools to generate it; + Makefiles can be generated by running configure. + + * lisp/bbdb.el: + Define caddar if it's not found. Yeesh. How hard is it to do + (car (cdr ...)) anyway? + + * lisp/bbdb-whois.el: + Use geektools.com instead of rs.internic.net + Slightly smarter parsing of results + + * lisp/bbdb-com.el: + Add support for M-TAB to expand mail aliases + Don't look for email completions when there are none! + + * lisp/bbdb-xemacs.el: + Don't load touchtones if the touchtones directory is unset. + +2001-01-24 Sam Steingold <sds@gnu.org> + + * lisp/bbdb-snarf.el (replace-in-string): Emacs 21 has + `replace-regexp-in-string' - use it! + + * lisp/bbdb-merge.el (bbdb-merge-file): bugfix: + the parameter for `match-fun' is `rec', not `r' + +2001-01-22 Waider <waider@waider.ie> + + * lisp/bbdb.el: + Check that an AKA is not already in the list before adding it + +2001-01-18 Waider <waider@waider.ie> + + * html/index.html: Minor typo at page footer + + * lisp/bbdb-vm.el: Proper fix for VM windowing bug + +2001-01-17 Robert.Fenk@gmx.de + + * lisp/bbdb.el (bbdb-always-add-addresses): Docfix + + * lisp/bbdb-vm.el (bbdb/vm-update-record): + Restored old behavior of returning one record + (bbdb/vm-update-records-mode): + (bbdb/vm-update-records): + Enhanced in order to allow annotating only new messages, which is + now the default. This avoids the annoying questions repetition + weather to add records for unknown persons after restarting a + VM session. + + * lisp/bbdb-w3.el (bbdb-www-grab-homepage): + Fix to read just one record not a list of records + + * lisp/bbdb-xemacs.el (bbdb-sounds-directory): + (bbdb-sound-volume): + (bbdb-load-touchtones): + Added variables & functions for Xemacs native sound support + used by bbdb-dialing stuff + + * lisp/bbdb-com.el (bbdb-complete-name): + If the completion is done then cycle thru the nets or when called + with a prefix arg then display a list of all nets. + (bbdb-dial-local-prefix-alist): + Used to replace parts of the number depending on a regexp. + (bbdb-modem-dial): command used for dialing with the modem. + (bbdb-modem-device): the modem device + (bbdb-dial-number): new function which performs the dialing of a + number. Depending on the settings it uses the play command, + native Xemacs sound support or the modem device. + (bbdb-dial): modified in order to use the new stuff + +2001-01-08 Waider <waider@waider.ie> + + * lisp/bbdb-hooks.el: + Added Bill Carpenter-provided function + 'bbdb-ignore-selected-messages-confirmation' + +2001-01-03 Didier Verna <didier@xemacs.org> + + * aclocal.m4: new file (Autoconf support). + * configure.in: ditto. + * install-sh: ditto. + * Makefile.in: ditto. + * lisp/Makefile.in: ditto. + * texinfo/Makefile.in: ditto. + + * configure: new file (generated by Autoconf, but should be + present in the archive/distribution). + * Makefile: removed from the archive (generated by configure). + * lisp/Makefile: ditto. + * texinfo/Makefile: ditto. + + * INSTALL: update for the Autoconf support. + * texinfo/bbdb.texinfo (Normal User): ditto. + (XEmacs Package): ditto. + +2001-01-03 Waider <waider@waider.ie> + * lisp/bbdb-com.el (bbdb-dial): + Change docstring for bbdb-dial + Remove check for window system + + * texinfo/bbdb.texinfo: + Removed some things from the TODO list + Removed the Log section + Added xref from 'BBDB Mailing Lists' to 'Using BBDB to implement + Mailing Lists' + A few other minor tweaks + + * html/index.html: + Updated the links section; some other minor changes. + +2000-12-31 Waider <waider@waider.ie> + + * lisp/bbdb.el (bbdb-undisplay-records): + Don't mess with *BBDB* if it doesn't exist! + Some compile noise hushed. + +2000-12-18 Waider <waider@waider.ie> + + * lisp/bbdb.el: + Added definition for cadar. + Docu typo in bbdb-elided-display + If bbdb-display-records isn't appending, clear the buffer + bbdb-undisplay-records erases the buffer + bbdb-insinuate-message now hooks on message-setup-hook + + * lisp/bbdb-vm.el: + Small change to get around an apparent emacs windowing bug. + +2000-11-27 Alex Schroeder <alex@gnu.org> + + * lisp/bbdb-com.el (bbdb-check-zip-codes-p): New variable. + (bbdb-legal-zip-codes): New variable. + (bbdb-parse-zip-string): Use the two new variables instead of + hard-coding valid zip string regexps. + (bbdb-create-internal): Doc change. Check wether zip code is + stringp. + + * lisp/bbdb-migrate.el (bbdb-migration-features): Added + description for version 6. + (bbdb-migration-spec): Added version 5->6 stuff. + (bbdb-unmigration-spec): Added version 6->5 stuff. + (bbdb-migrate-zip-codes-to-strings): New function with code from + bbdb-address-zip-string. + (bbdb-unmigrate-zip-codes-to-strings): New function with code from + bbdb-parse-zip-string. + (bbdb-migrate-add-country-field): Doc typo. + (bbdb-unmigrate-add-country-field): Doc typo. + + * lisp/bbdb-print.el (bbdb-print-format-address-continental): Use + bbdb-address-zip instead of bbdb-address-zip-string. + (bbdb-print-format-address-default): Ditto. + + * lisp/bbdb.el (bbdb-file-format): Set to 6. + (bbdb-address-zip-string): defalised to bbdb-address-zip. + (bbdb-continental-zip-regexp): New option. + (bbdb-address-is-continental): Use bbdb-continental-zip-regexp. + (bbdb-format-address-continental): Use bbdb-address-zip instead of + bbdb-address-zip-string. + (bbdb-format-address-default): Ditto. + +2000-11-16 Robert.Fenk@gmx.de + + * lisp/bbdb-com.el (bbdb-show-all-recipients): simplified the + function and added missing headers + + * lisp/bbdb-hooks.el (bbdb-extract-field-value): added + (case-fold-search t) as headers should be checked case insensitive + + * lisp/bbdb-snarf.el (bbdb-extract-address-component-regexps): + added recognition of true names form addresses like + Robert.Fenk@gmx.de, in order to avoid creation of duplicate + records. + + * lisp/bbdb-vm.el (bbdb/vm-update-records): Uses display-message + for progress report and honor bbdb-silent-running. + (bbdb/vm-snarf-all): removed faulty "second" call of + bbdb-update-records + + * lisp/bbdb.el ((fboundp 'display-message)): added macro for + display-message (for GNU Emacs) used for progress reports in + bbdb-vm.el + (bbdb-format-record): fixed display for elided display + + * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): Fixed fontification + for elided display. + +2000-11-06 Waider <waider@waider.ie> + + * lisp/bbdb-vm.el: Respect value of bbdb-use-pop-up. + * html/index.html: Corrected mirror link. + +2000-11-02 Waider <waider@waider.ie> + + * lisp/bbdb.el: + Define characterp if it's not already bound. Used in bbdb-vm. + +2000-11-02 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-hashtable-size): call `bbdb-records' only + when it is defined (reported by John Wiegley <johnw@gnu.org>). + +2000-11-01 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-hashtable-size): new custom variable + (primep): define if not defined already + (bbdb-records): use `bbdb-hashtable-size' when initializing + `bbdb-hashtable' + +2000-10-27 Robert.Fenk@gmx.de + + * lisp/bbdb-mhe.el (bbdb/mh-update-record): + * lisp/bbdb-rmail.el (bbdb/rmail-update-record): + * lisp/bbdb-gnus.el (bbdb/gnus-update-record): + * lisp/bbdb-vm.el (bbdb/vm-update-records): + * lisp/bbdb.el (bbdb/prompt-for-create-p): + The new variable `bbdb/prompt-for-create-p' can be set to `t' in + order to force VM, Gnus, MHE, RMAIL to ask the user before adding a + new BBBD record, caused by the automatic update of the popup buffer. + (bbdb-pop-up-elided-display-name-end): A new variable which + controls for elided display where the "name - company" pair + usually ends and where we start to display phone numbers and the + like. + (bbdb-pop-up-elided-display-fields): A new variable controlling + what fields are displayed in elided display. Users may write + their own formating functions. + + * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): changed in order to + meet flexible `bbdb-pop-up-elided-display-name-end'. + + * lisp/bbdb-vm.el (bbdb/vm-update-records): Searching for existing + records is limited to the net, as a search for a name may no + return the right record. + Adding of new records can be controlled similar to query-replace, + with y,!,n,s,q + (vm-summary-function-B): Added decoding of mime-encoded strings. + (bbdb/vm-auto-add-label): Moved the docu on how to hook this + function into the function docu. + (bbdb/vm-update-records): + +2000-10-20 Robert.Fenk@gmx.de + + * lisp/bbdb-com.el (bbdb-complete-name): If there are multiple + nets and the address is already completed then cycle trough the + list of nets. + + * lisp/bbdb-snarf.el (bbdb-extract-address-components): Added an + optional argument `ignore-errors'. + +2000-10-15 Waider <waider@waider.ie> + + * lisp/Makefile: + Fix to allow building with Martin Schwenke's gnuserv. + + * lisp/bbdb-srv.el: + Fixed to work with newer version of gnuserv provided by Martin + Schwenke and downloadable from + http://linuxcare.com.au/people/martins/hacks/emacs/ + + * lisp/bbdb-vm.el: + Cleaned up some of the customization stuff. + Fixed handling of vm-uninteresting-senders + + * lisp/bbdb.el: + Cleaned up some of the customization stuff. + + * lisp/bbdb-gnus.el: + Added Brian Edmonds' filing hackery, modified to fit in bbdb's concept + of a namespace. + Cleaned up some compiler noise. + + * lisp/bbdb-com.el: + Fixed the compose-mail selection for bbdb-send-mail-style. Thanks to + Raymond Scholz for pointing out that it wasn't actually working. + +2000-10-04 Waider <waider@waider.ie> + + * lisp/bbdb-com.el (bbdb-send-mail-internal): + Added in compose-mail bits. Whoops. + +2000-09-20 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: + Fix primary-or-name search to pay attention to bbdb-case-fold-search + when checking names. (bug report: Eli Tziperman) + +2000-09-12 Robert.Fenk@gmx.de + + * lisp/bbdb-vm.el (bbdb/vm-snarf-all): + fixed wrong documentation + +2000-09-11 Waider <waider@stepstone.ie> + + * lisp/bbdb-vm.el: + Reinstated 2.00.06 behavior of creating a record if necessary + when : is pressed + Added new function, bbdb/vm-show-all-recipients, to do the + necessary fandango to show recipients for the current + message. Map it to something in vm-mode-map if you wish to use + it. I'd suggest "'". + +2000-09-08 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdbq-mk): + new function to create `subliminal' messages. Also, two new + messages. + +2000-09-08 Waider <waider@waider.ie> + + * lisp/bbdb.el: + Daniel Pittman's patch does indeed override Alex's! + +2000-09-07 Waider <waider@waider.ie> + + * lisp/bbdb-snarf.el: + Daniel Pittman's autoload patch. May make Alex's patch obsolete. + + * lisp/bbdb.el: + Alex Coventry's patch to fix compile-vs-runtime autoloads + +2000-09-03 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: + Default completed name to an empty string to avoid error + +2000-08-29 Waider <waider@waider.ie> + + * lisp/bbdb-vm.el: + Check if vm-summary-uninteresting-senders is a string before using it + +2000-08-28 Waider <waider@stepstone.ie> + + * lisp/Makefile: + Fix for bbdb-autoloads.el and Xemacs + + * lisp/bbdb-gnus.el: + Moved bbdb-insinuate-message out to bbdb.el to prevent gnus + startup looping + + * lisp/bbdb.el: + Moved bbdb-insinuate-message into this file to prevent gnus + startup looping + Changed \M-\t to [(meta tab)] + +2000-08-25 Waider <waider@stepstone.ie> + + * lisp/bbdb-vm.el: + Cache the fact that you didn't want to create an entry for someone, so + you don't get prompted repeatedly. + Also removed changelog from file. + +2000-08-25 Waider <waider@stepstone.ie> + + * html/bbdb*.html,html/index.html: + Updated the HTML version of the manual. + Fixed broken stylesheet reference in web page. + Added link for Noah Friedman's copy of jwz's bbdb-pilot.el + Fixed link to Alex's page. + Added link to Martin's bbdb-gnokii.el + + * lisp/bbdb-vm.el (bbdb/vm-update-records): + Fixed to remember that you didn't want to create an entry for a + particular message, so you don't get asked every time. + Removed Log entry at top of file. + +2000-08-18 Robert.Fenk@gmx.de + + * texinfo/bbdb.texinfo (VM Features): Documentation of new VM + features. + + * lisp/bbdb-vm.el (bbdb/vm-get-only-first-from-p): was formally + `bbdb/vm-get-first-from-p' which is not so self explanatory. The + default value is now `t' in order to keep the old BBDB behavior. + (bbdb/vm-get-from): partially rewritten in order to make it more + readable. + +2000-08-14 Sam Steingold <sds@gnu.org> + + * lisp/bbdb-com.el: require `cl' at compile time for `flet' + (bbdb-add-or-remove-mail-alias): use `let', not `setq' + (bbdb-send-mail-internal): fixed call to `vm-mail-internal' + +2000-08-11 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-save-db): fixed the calling sequence of + `y-or-n-p-with-timeout' + + * lisp/bbdb-snarf.el (bbdb-extract-address-components): use + `bbdb-warn' instead of `warn' + (replace-in-string): check for `boundp', not `functionp' + (bbdb-snarf-nice-real-name-regexp, bbdb-snarf-nice-real-name): doc fix + + * lisp/bbdb.el: removed the `defsubst' kludge - we do not support + emaxen without `defsubst' anyway; + also pacify the compiler a little bit + + +2000-08-10 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-join): dropped an unused variable + (save-current-buffer): fset to `save-excursion' if not present + (with-current-buffer): defmacro if not present + (bbdb-save-buffer-excursion): dumped + (bbdb-with-db-buffer, bbdb-records, bbdb-write-file-hook-fn): use + `with-current-buffer' instead of `bbdb-save-buffer-excursion' + (bbdb-initialize): `load', not `require' "bbdb-autoloads" + (bbdb-modified-p): dumped + (bbdb-read-string): removed minibuffer-resizing code: all + supported emaxen can resize minibuffers themselves + + Remote DB synchronization: + (bbdb-file-remote, bbdb-file-remote-save-always): new user variables + (bbdb-buffer): a function now; copy `bbdb-file-remote' to + `bbdb-file' when it is newer + (bbdb-write-file-hook-fn): maybe write `bbdb-file-remote' + +2000-08-10 Robert.Fenk@gmx.de + + * lisp/bbdb.el (bbdb-quiet-about-name-mismatches): if a number it + will be the number of seconds to sit-for when displaying the + notification about a name mismatch. + (bbdb-join): inverse function of bbdb-split. + (bbdb-annotate-message-sender): tries to guess a reasonable + default name when creating new records. + + * lisp/bbdb-com.el (bbdb-define-all-aliases): Records without a + net nolonger cause a error, one will get just a waring when not + running in silent mode. + (bbdb-delete-current-field-or-record): added + handling of "*" in order to delete multiple records and 'noprompt'. + (bbdb-send-mail-internal): added missing call of vm hooks. + (bbdb-add-or-remove-mail-alias): returns all mail aliases in a format + suitable for completing read. + (bbdb-add-or-remove-mail-alias): convenience function for adding + or removing mail aliases from one or multiple records. This makes + it much simpler to define groups. + + * lisp/bbdb-snarf.el (bbdb-snarf-nice-real-name-regexp): regexp + matching unwanted characters used by + (bbdb-snarf-nice-real-name): removes unwanted characters from real + names/email addresses. + (bbdb-extract-address-component-regexps): alist of regexps and + transformation-instructions used by + (bbdb-extract-address-components): is for the extraction of full + name and email address from headers. This function is a bit more + configurable than `mail-extract-address-components' and it will + return a list of all found address components. + + * lisp/bbdb-vm.el (bbdb/vm-get-from): uses now + bbdb-extract-address-components to extract all recipients and uses + vm-summary-uninteresting-senders for ignoring senders, which is + more consistently with respect VM. One can set the variable + `bbdb/vm-get-from-headers' and `bbdb/vm-get-first-from-p' in order + to control what headers are processed and what is display is what + order. + (bbdb/vm-message-cache-lookup): + (bbdb/vm-encache-message): We use our own caching functions + instead of the bbdb default functions since we are handling a set + of records and not a single one. + (bbdb/vm-update-record): is now just a call to + (bbdb/vm-update-records): which performs the actual work of + finding and updating records. + (bbdb/vm-set-auto-folder-alist): Is a function from Mark Thomas + <mthomas@jprc.com> which sets `vm-auto-folder-alist' according to + the field `bbdb/vm-set-auto-folder-alist-field'. + +2000-08-10 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-annotate-notes): `regexp-quote' the + annotation before matching it on existing notes + +2000-08-03 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-notes-default-separator): new user option + (bbdb-annotate-notes): use it + (notes, company): put `field-separator' property + * lisp/bbdb-hooks.el (bbdb-auto-notes-hook): search the whole + notes string for the new note before adding + +2000-08-01 Robert.Fenk@gmx.de + + * lisp/Makefile (bbdb-autoloads.el): Added setting of variable + autoload-package-name and deletion of bbdb-autoloads.el file before + creation. + +2000-08-01 Waider <waider@stepstone.ie> + + * lisp/bbdb.el: + Add compose-mail as an option for bbdb-send-mail-style (Kai Großjohann) + + * lisp/bbdb-vm.el: + Added Howard Melman's VM labelling code. It's switched off by default; + use (add-hook 'bbdb-notice-hook 'bbdb/vm-auto-add-label) to enable it. + + * lisp/bbdb.el: + Added Thomas DeWeese's May 19 (!) fix for bbdb-build-name. + +2000-07-27 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el: dropped bbdb-add-hook + + * lisp/bbdb.el: + limited `bbdb-init-forms' to hooks to protect the innocent + +2000-07-27 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-init-forms): hook adding only + (bbdb-initialize): ditto + (bbdb-add-hook): dropped + +2000-07-25 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-init-forms): new variable + (bbdb-initialize): use it; actually run `bbdb-initialize-hook' + do not define autoloads here, load `bbdb-autoloads' instead + * lisp/Makefile: removed auto-autoloads, generate bbdb-autoloads + +2000-07-21 Waider <waider@stepstone.ie> + + * lisp/bbdb.el: More bbdb-silent-running edits. + +2000-07-20 Sam Steingold <sds@gnu.org> + + * lisp/bbdb-com.el (bbdb-finger): use `bbdb-get-record' + * lisp/bbdb-whois.el (bbdb-whois): use `bbdb-get-record' + * lisp/bbdb-ftp.el (bbdb-ftp): use `bbdb-get-record' + +2000-07-18 Sam Steingold <sds@gnu.org> + + * lisp/bbdb-com.el (bbdb-define-all-aliases): distinguish between + `mail-abbrevs' and `mail-aliases' in a uniform way + +2000-07-13 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (bbdb-write-file-hooks): new variable + (bbdb-records): use it + +2000-07-11 16:19:29 ShengHuo ZHU <zsh@cs.rochester.edu> + + * lisp/bbdb-snarf.el (bbdb-snarf-address-lines): Support v5. + (bbdb-snarf-make-address): New function. + (bbdb-snarf-region): Remove properties. Use bbdb-snarf-make-address. + +2000-07-05 Sam Steingold <sds@gnu.org> + + * lisp/bbdb-migrate.el: rewrote migration in a modular way + (bbdb-[un]migration-spec): new consts + (bbdb-migrate-record-lambda): replaces `bbdb-migrate-record' + (bbdb-migrate-versions-lambda): new function + (bbdb-migrate, bbdb-unmigrate-record): use it + (bbdb-[un]migrate-change-dates): use mapcar + (bbdb-[un]migrate-add-country-field, + bbdb-[un]migrate-streets-to-list): new functions + +2000-07-05 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el (parse-bbdb-internal): bind, not setq the version. + +2000-07-03 Jochen Küpper <Jochen@Jochen-Kuepper.de> + + * texinfo/bbdb.texinfo: Various little changes, including ml info, + TeX output changes, thanks. + Added info-directory information. + Added detailed node list. + +2000-06-30 Sam Steingold <sds@gnu.org> + + * lisp/bbdb-migrate.el (bbdb-migrate): + re-wrote using `mapcar' instead of `append' + this is linear instead of quadratic and avoids much consing + +2000-06-30 Jochen Küpper <Jochen@Jochen-Kuepper.de> + + * lisp/Makefile: Add everything to build bbdb-merge.elc. + +2000-06-14 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: + Fixed bbdb-current-field properly. Note that if you define a new + address formatting function, this code may not work correctly. + + * lisp/bbdb-vm.el: + Trying another way to get the from field, since the Presentation + buffer hack seems to be somewhat unusable. + + * lisp/bbdb.el: + Fixed docstring for bbdb-quiet-about-name-mismatches + + * texinfo/bbdb.texinfo: + Documented changes in database structure + Changed web address, email addresses + Some minor typos corrected & details added + + * Makefile: + Added CVS revision discards to tarball exclude list. + + * lisp/bbdb-merge.el: + made notes merging use bbdb-merge-strings. + +2000-05-26 Alex Schroeder <alex@gnu.org> + + * lisp/bbdb-com.el (bbdb-parse-zip-string): Match brazilian zip + codes as well. + +2000-05-25 Alex Schroeder <alex@gnu.org> + + * lisp/bbdb-migrate.el (bbdb-unmigrate-record): Fixed a paren typo + and tried to work some more on the backmigration code from 5 -> 4. + + * lisp/bbdb-com.el (bbdb-address-edit-default): Fixed assignment + to free variable. Rewrote street input. + * lisp/bbdb.el (bbdb-format-address-continental): Fixed assignment + to free variable. + (bbdb-format-address-default): Fixed assignment + to free variable. + +2000-05-02 Sam Steingold <sds@gnu.org> + + * lisp/bbdb.el, lisp/bbdb-com.el: define `unless' and `when' if + necessary, do not quote `lambda' in code, do quote (`') functions + and variables in doc strings. + * lisp/bbdb.el (bbdb-get-field): new helper function. + * lisp/bbdb-com.el (bbdb-notes-sort-order): new variable + (bbdb-sort-notes, bbdb-sort-phones, bbdb-sort-addresses): new + functions, suitable for `bbdb-change-hook'. + (bbdb-get-record): new helper function. + * lisp/bbdb-w3.el (bbdb-www): do not browse to multiple URLs + simultaneously, allow multiple URLs for the same record instead. + (bbdb-www-grab-homepage): add the URL if there is such a fields + already. + +2000-05-01 Waider <waider@waider.ie> + + * lisp/bbdb-merge.el: + "API" is a little more settled, also a little more obvious. + Making use of more of the existing functions in bbdb-com + + * html/index.html: + Tweaked layout and added a CVS revision tag. + + * Initial creation of the bits/ and html/ trees. + +2000-04-21 Waider <waider@waider.ie> + + * lisp/bbdb-com.el: * documentation corrections + Added timestamp compare to bbdb-refile-notes-generate-alist + + * lisp/bbdb-merge.el: + Refined so it works a little better, particularly with merging + timestamps + Added bbdb-merge-file, so you can now import another bbdb and + merge it. + +2000-04-19 Waider <waider@waider.ie> + + * lisp/bbdb-merge.el: + First cut at merging with a view towards syncing, as opposed to + simply cramming everything together a la refile. + +2000-04-17 Waider <waider@waider.ie> + + * lisp/bbdb-migrate.el: + omitted bracket on unmigrate for v5->v4 + +2000-04-16 kuepper <kuepper@gonzo.waider.ie> + + * tex/bbdb-print-brief.tex, texinfo/bbdb.texinfo, tex/bbdb-print.tex + bbdb-print documentation + Fix \bigbf + +2000-04-16 Jochen Küpper <Jochen@Jochen-Kuepper.de> + + * tex/bbdb-print.tex, tex/bbdb-print-brief.tex: Define \bigbf + relative to the given base-size. + +2000-04-15 Jochen Küpper <Jochen@Jochen-Kuepper.de> + + * lisp/bbdb-print.el (bbdb-print-format-address-continental) : + (bbdb-print-format-address-default): Adopt street output to new + file format v5. + +2000-04-13 Jochen Küpper <Jochen@Jochen-Kuepper.de> + + * tex/bbdb-print-brief.tex, tex/bbdb-print.tex: Use ec fonts + instead of cm. Set tt-fonts, before these weren't specified at all + ( ectt for ec, pcrr ( = Courier ) for Postscript ). + + * lisp/bbdb-print.el (bbdb-print-format-record): Put a + "\goodbreak" in front of every "\separator" to avoid breaks right + after the separator and to get a better overall formatting of + tex-output. + (bbdb-print): Insert catcodes (I need) for ec-fonts. This needs to + be done for Postscript as well. Also more catcodes need to be + inserted. + +2000-04-13 Waider <waider@waider.ie> + + * Makefile: + Made the dist target work again, and started fixing/adding a few + more targets to help testing. + + * lisp/bbdb-com.el: + Thomas Deweese's multiple-same-name-records patch + "streets" is now a list, not street1 street2 street3 + relaxed zip checking a little. + new function: bbdb-add-new-field. allows you to programatically + add properties to the bbdb file. + + * lisp/bbdb-migrate.el + streets -> list patch + + * lisp/bbdb-whois.el + commented out streets code. This code mostly fails to work right now. + + * lisp/bbdb.el + Thomas's duplicates patch + streets patch + + * lisp/bbdb-gnus.el: + Added keymap C-: for bbdb/gnus-summary-show-all-recipients + + * lisp/bbdb-print.el: + Address layout patch, including Euro addresses and the + streets->list thing + +2000-04-05 Waider <waider@waider.ie> + + * lisp/bbdb-gnus.el: + Colin's show-all-recipients + +2000-04-02 Waider <waider@waider.ie> + + * lisp/bbdb-com.el (bbdb-dwim-net-address): + updated docstring to mention bbdb-dwim-net-address-allow-redundancy + (it's been asked about!) + + * texinfo/bbdb.texinfo: + started updating to account for changes since 2.00.03 + +2000-04-01 Waider <waider@waider.ie> + + * lisp/bbdb-hooks.el: + autoload cookie for bbdb-header-start (Yair Friedman) + + * Alex Schroeder's country patch. I've taken all his ChangeLog + entries and added them in here; everything from here down to the + next datestamp is his. PLEASE NOTE this changes the bbdb file + format and will most likely break all your tools that depend on + the old format. + + * lisp/bbdb-com.el (bbdb-address-editing-function): New variable. + (bbdb-record-edit-address): Use bbdb-address-editing-function. + (bbdb-address-edit-default): New function. + + * lisp/bbdb.el (bbdb-version): Version updated. + (bbdb-version-date): Version updated. + (bbdb-format-address-continental): Bugfix, removed binding for f. + (bbdb-format-address-default): dito. + + * lisp/bbdb-print.el (bbdb-print-format-address-continental): dito. + (bbdb-print-format-address-default): dito. + + * lisp/bbdb.el (bbdb-address-formatting-alist): New variable. + (bbdb-address-is-continental): New function. + (bbdb-format-streets): New function. + (bbdb-format-address-continental): New function. + (bbdb-format-address-default): New formatting function. + (bbdb-format-address): New function. + (bbdb-format-record): Uses bbdb-format-address. + + * lisp/bbdb-print.el (bbdb-address-print-formatting-alist): New + variable. + (bbdb-print-format-address-continental): New function. + (bbdb-print-format-address-default): New function. + (bbdb-print-format-record): Uses bbdb-format-address. + + * lisp/bbdb.el (bbdb-address-format): Match zip codes from Sweden. + * lisp/bbdb-com.el (bbdb-parse-zip-string): Match zip codes from Sweden + where the five digits are grouped 3+2 at the request from Mats + Lofdahl <MLofdahl@solar.stanford.edu>. + + * lisp/bbdb.el (bbdb-version): Changed version strings. + (bbdb-version-date): Changed date. + + * lisp/bbdb-migrate.el (bbdb-unmigrate-record): Added migration from + version 4 back to version 3 by removing the country field. Some + version 4 zip codes will be illegal version 3 (as used in 2.00.06) + zip codes. This problem has not been solved! + (bbdb-migrate): Fixed migration from version 3 forward to version + 4. The bug affected all records with more than one address. + + * lisp/bbdb-com.el (bbdb-parse-zip-string): Support russian zip codes + which have 6 digits. Removed some existing checks. + + * lisp/bbdb-snarf.el (bbdb-snarf-region): Added country field. + + * lisp/bbdb.el (bbdb-address-format): New, required for continental zip + codes. + (bbdb-file-format): New file format with country field. + (bbdb-address-): Added country field. + (bbdb-address-zip-string): Added continental zip codes. + (bbdb-address-format): New, indicates wether an address is + continental or not, based on the zip code. + (bbdb-format-record): Added continental zip codes and country + field. + + * lisp/bbdb-print.el (bbdb-print): Fixed a bug (?) when reading the + file name. + (bbdb-print-format-record): Added country field. + + * lisp/bbdb-migrate.el (bbdb-migration-features): New file format with + country field. + (bbdb-migrate): Added country field. + (bbdb-migrate-record): Fixed typo in doc string. + + * lisp/bbdb-com.el (bbdb-parse-zip-string): Added continental zip + codes. + (bbdb-create-internal): Added country field. + (bbdb-current-field): Added country field. + (bbdb-record-edit-address): Added country field. + +2000-03-30 Waider <waider@waider.ie> + + * lisp/bbdb.el (bbdb-annotate-notes): do not add a repeated + annotation (Sam Steingold) + + * lisp/bbdb.el: + Added gareth rees' patch to improve bbdb-mode documentation. + + * lisp/bbdb-com.el: + Added Noah Friedman's patch to make completion work as documented. + + * texinfo/bbdb.texinfo: + Fixed xref entries per mail from gareth rees. + +1999-01-26 simmonmt <simmonmt@acm.org> + + * lisp/bbdb-gnus.el: + Don't freak out on 0-line Article buffers (pgnus) + + * tex/bbdb-print.tex: + Make e-mail addresses scale properly + +1999-01-25 simmonmt <simmonmt@acm.org> + + * lisp/bbdb-snarf.el: + Add autoload cookie for bbdb-snarf-region + + * lisp/auto-autoloads.el: + Added bbdb/gnus-snarf-signature + + * lisp/bbdb.el: + Set-text-properties to nil in bbdb-string-trim + + * lisp/bbdb-com.el: + Protect mark in bbdb-redisplay-records + + * lisp/bbdb-com.el: Use Info-directory-list + + * lisp/bbdb.el: + Nil out hooks to keep view-mode from interfering with bbdb-mode + + * lisp/bbdb-gnus.el: Don't use concat with integers + + * lisp/bbdb-gnus.el: Added bbdb/gnus-snarf-signature + +1999-01-24 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 2.00.06 released + +1999-01-24 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb-gnus.el: (bbdb/gnus-score-as-text) Handle the fact + that `score' could be either an int or a string. + +1999-01-21 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb-com.el (bbdb-info): Made it work with Info-directory-list + +1999-01-21 Sam Steingold <sds@goems.com> + + * lisp/bbdb.el (bbdb-display-records-1): bind + `temp-buffer-setup-hook' and `temp-buffer-show-hook' to nil. + This fixes the problem of `view-mode' conflicting with + `bbdb-mode'. + +1999-01-08 Jean-Yves Perrier <perrier@nagra-kudelski.ch> + + * lisp/bbdb-comp.el (bbdb-redisplay-records): Don't bug out + with mark. + +1999-01-08 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb.el (bbdb-string-trim): Make it remove *all* text + properties from the string instead of just a few select ones. + Inspired by Sam Steingold <sds@goems.com>. + +1999-01-08 Sam Steingold <sds@goems.com> + + * lisp/bbdb.el (bbdb-save-db-timeout): Correct comment. + +1998-12-31 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb-snarf.el (bbdb-snarf-region): Autoload + +1998-12-31 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb-gnus.el (bbdb/gnus-snarf-signature): Created + +1998-12-31 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 2.00.05 released + +1998-12-31 Matt Simmons <simmonmt@acm.org> + + * INSTALL: Added documentation for those without make + * lisp/bbdb-snarf.el: Merge in 1.8.1.x subtree + +1998-12-30 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 2.00.04 released + +1998-12-29 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb-com.el (bbdb-current-field): Made it handle the + blank user. + +1998-12-24 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb.el (bbdb-version): Made it take an option to output in + current buffer. + +1998-12-10 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb.el (bbdb-load-hook): Moved after the provide. + * lisp/bbdb.el (bbdb-display-records-1): Fix bug so that it + doesn't blow out on null records parameter. + +1998-12-07 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb-snarf.el (bbdb-snarf-web-prop): Fix it to be a symbol. + * lisp/bbdb-snarf.el (bbdb-merge-internally): Use + bbdb-record-set-raw-notes. + +1998-12-05 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 2.00.03 released + +1998-12-03 Adam C. Finnefrock <adam@bigbro.biophys.cornell.edu> + + * lisp/bbdb-gnus.el (bbdb/gnus-update-record): Honor + bbdb-user-mail-names. + +1998-11-17 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb-gnus.el (bbdb/gnus-show-sender): Use currently + selected summary line rather than what may be in *Article* + buffer. + * lisp/bbdb-gnus.el (bbdb/gnus-edit-notes): ditto + * lisp/bbdb-gnus.el (bbdb/gnus-annotate-sender): ditto + +1998-11-09 Didier Verna <verna@inf.enst.fr> + + * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): extent-data is + obsolete (and gone in XEmacs 21.2+). Replace it. + * lisp/bbdb-xemacs.el (bbdb-menu): ditto. + +1998-10-27 Colin Rafferty <colin@xemacs.org> + + * bbdb-com.el (bbdb-dwim-net-address-allow-redundancy): Created. + * bbdb-com.el (bbdb-dwim-net-address): As inspired by Xavier Francois + Vigouroux, use `bbdb-dwim-net-address-allow-redundancy'. + +1998-10-23 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb.el: Changed mail list name from info-bbdb to + bbdb-info. + + * lisp/bbdb-print.el: Changed mail list name from info-bbdb to + bbdb-info. + + * texinfo/bbdb.texinfo: Changed mail list name from info-bbdb to + bbdb-info. + +1998-10-13 Colin Rafferty <colin@xemacs.org> + + * bbdb-snarf.el (bbdb-snarf-web-prop): Made it a symbol. + +1998-10-13 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb-com.el (bbdb-read-new-record): Check for integerp + explicitly with bbdb-default-area-code, instead of relying on + condition-case. + + * lisp/bbdb-print.el (bbdb-print-alist-widget): ditto. + * lisp/bbdb-print.el (bbdb-print-alist): ditto. + +1998-10-12 Adam C. Finnefrock <adam@bigbro.biophys.cornell.edu> + + * lisp/bbdb-com.el (bbdb-info-file): Made it a choice, since nil didn't + match the type: file. + +1998-10-08 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb.el (bbdb-version): BBDB 2.00.02 released + +1998-07-19 SL Baur <steve@altair.xemacs.org> + + * lisp/bbdb-migrate.el (bbdb-migration-query): Don't pass an + integer to concat. + + * lisp/bbdb.el (bbdb-y-or-n-p): raise-screen -> raise-frame, + screen-visible-p -> frame-visible-p, selected-screen -> + selected-frame. + * lisp/bbdb.el (bbdb-pop-up-bbdb-buffer-horizontally): + screen-width -> frame-width. + + * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): set-extent-attribute + -> set-extent-property, set-extent-data -> set-extent-property. + * lisp/bbdb-xemacs.el (bbdb-hack-x-face): set-extent-data -> + set-extent-property. + + * lisp/bbdb-srv.el (bbdb/srv-handle-headers): Use new name for + set-window-buffer-dedicated. + +Sat Apr 11 00:28:17 1998 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 2.00.01 released + * lisp/bbdb.el (bbdb-mode-map): Added bindings + * lisp/bbdb.el (bbdb-mode-search-map): Created, bound search + functions to it. + * lisp/bbdb.el (bbdb-initialize): Gutted + * lisp/bbdb.el (bbdb-initialize-hook): Created + * lisp/bbdb.el (bbdb-load-hook): Changed documentation + * lisp/bbdb.el (advertized-bbdb-delete-current-field-or-record): + Began to remove support + * lisp/bbdb-com.el (bbdb-changed): Syntax error in comment + * lisp/bbdb-com.el (bbdb-phones): Changed prompt + * lisp/bbdb-com.el (bbdb-net): Changed prompt + * lisp/bbdb-com.el (bbdb-company): Changed prompt + * lisp/bbdb-com.el (bbdb-name): Changed prompt + * lisp/bbdb-com.el (bbdb): Changed prompt + * lisp/bbdb-com.el (advertized-bbdb-delete-current-field-or-record): + Began to remove support + * texinfo/bbdb.texinfo: Added EOL list. + * texinfo/bbdb.texinfo: EOL'd + advertized-bbdb-delete-current-field-or-record. + * texinfo/bbdb.texinfo: EOL'd GNUS support. + * texinfo/bbdb.texinfo: Documented bbdb-initialize-hook + * texinfo/bbdb.texinfo: Documented new bindings + +Fri Mar 13 00:00:00 1998 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb.el (bbdb-initialize): Made the autoloads be + conditionally loaded. + * lisp/bbdb-com.el: Added ###autoload cookies. + * lisp/bbdb-ftp.el: Added ###autoload cookies. + * lisp/bbdb-gnus.el: Added ###autoload cookies. + * lisp/bbdb-hooks.el: Added ###autoload cookies. + * lisp/bbdb-mhe.el: Added ###autoload cookies. + * lisp/bbdb-migrate.el: Added ###autoload cookies. + * lisp/bbdb-print.el: Added ###autoload cookies. + * lisp/bbdb-reportmail.el: Added ###autoload cookies. + * lisp/bbdb-rmail.el: Added ###autoload cookies. + * lisp/bbdb-sc.el: Added ###autoload cookies. + * lisp/bbdb-snarf.el: Added ###autoload cookies. + * lisp/bbdb-srv.el: Added ###autoload cookies. + * lisp/bbdb-vm.el: Added ###autoload cookies. + * lisp/bbdb-w3.el: Added ###autoload cookies. + * lisp/bbdb-whois.el: Added ###autoload cookies. + * lisp/bbdb-xemacs.el: Added ###autoload cookies. + * lisp/auto-autoloads.el: Regenerated with new autoloads. + +Tue Mar 31 23:46:05 1998 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb-migrate.el (bbdb-migrate-change-dates-change-field): + Use %S instead of %s for error messages. + +Tue Mar 17 00:00:00 1998 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb-hooks.el (bbdb-timestamp-hook): Made + `format-time-string' take two arguments for XEmacs 19.15. + * lisp/bbdb-hooks.el (bbdb-creation-date-hook): Same. + +Mon Mar 16 20:02:00 1998 Matt Simmons <simmonmt@acm.org> + + * Makefile: Fix for compatibility with other makes + +Sun Mar 15 23:46:00 1998 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 2.00 released + +Fri Mar 13 01:52:00 1998 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 1.91unoff released + +Wed Mar 12 15:37:86 1998 Colin Rafferty <colin@xemacs.org> + + * lisp/bbdb.el (parse-bbdb-internal): Fixed the error message on + mismatched bbdb-file-format. + +Fri Feb 06 00:00:00 1998 Colin Rafferty <colin@xemacs.org> + + * bbdb-com.el (bbdb-current-field): Made it correctly count the + number of lines of a specially-formatted note field. + +Mon Mar 09 23:25:00 1998 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 1.90unoff released + * lisp/bbdb.el (defface): Fixed defface standin + * lisp/bbdb.el (bbdb-alist-with-header): Created widget for + bbdb-auto-notes-alist custom fix. + * lisp/bbdb.el (bbdb-create-hook): Default to bbdb-creation-date-hook + * lisp/bbdb.el (bbdb-change-hook): Default to bbdb-timestamp-hook + * lisp/bbdb.el (bbdb-initialize): Added autoload for bbdb-srv + * Makefile: Removed my paths + * Makefile: Added 19.34 comment about Custom + * Makefile: Started test harness for 19.34 and 20.2 + * INSTALL: Added 19.34 comment about Custom + * lisp/Makefile: Fixed 19.34 problem with custom (:link bug) + * lisp/bbdb-hooks.el (bbdb-auto-notes-alist): Fixed customization + * lisp/bbdb-srv.el (bbdb/srv-handle-headers): buffer-disable-undo + doesn't always return the argument + * texinfo/bbdb.texinfo: Finished revisions. + +Mon Mar 09 03:03:21 1998 Carsten Leonhardt <leo@arioch.oche.de> + + * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): don't access + scrollbars on XEmacsen without scrollbars + +Mon Mar 02 00:00:00 1998 Colin Rafferty <colin@xemacs.org> + + * bbdb-com.el (bbdb-refile-notes-generate-alist): Created. + * bbdb-com.el (bbdb-refile-notes-default-merge-function): Created. + * bbdb-com.el (bbdb-refile-notes-remove-duplicates): Created. + * bbdb-com.el (bbdb-refile-notes-string-least): Create. + * bbdb-com.el (bbdb-refile-record): Use `bbdb-refile-notes-generate-alist' + and `bbdb-refile-notes-default-merge-function' for merging notes. + +Wed Feb 25 23:35:00 1998 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb-print.el (bbdb-print-alist-widget): Protect bbdb-default-area-code + * lisp/bbdb-print.el (bbdb-print-alist): Protect bbdb-default-area-code + * lisp/bbdb-com.el (bbdb-read-new-record): Protect bbdb-default-area-code + * lisp/bbdb-com.el (bbdb-prompt-for-new-field-value): Protect bbdb-default-area-code + * lisp/bbdb-com.el (bbdb-dial): Protect bbdb-default-area-code + +Sat Jan 16 00:00:00 1998 Colin Rafferty <colin@xemacs.org> + + * lisp/Makefile (extras): fixed typo in bbdb-migrate.elc + +Sun Feb 22 20:58:00 1998 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 1.59unoff released + * lisp/bbdb.el: Created defface stand-in macro + * lisp/bbdb.el (bbdb-initialize): Reword + * lisp/bbdb.el (bbdb-initialize): Add keybinding for bbdb-print + * lisp/bbdb.el (bbdb-initialize): Add autoloads for + bbdb-show-all-recipients (bbdb-com), bbdb-ftp, bbdb-print + * lisp/bbdb.el (bbdb-initialize): Use bbdb-add-hook if none in Emacs + * lisp/bbdb-ftp.el: Changed comment - can use EFS + * lisp/bbdb-gnus.el: Changed GNUS/Gnus stuff around to reflect docs + * lisp/bbdb-gnus.el (bbdb/gnus-summary-author-in-bbdb): Now uses + `bbdb-message-marker-field' as documented + * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Use `add-hook', not + `bbdb-add-hook' + * lisp/bbdb-hooks.el: Use add-hook, not bbdb-add-hook + * lisp/bbdb-mhe.el: Use add-hook, not bbdb-add-hook + * lisp/bbdb-rmail.el: Use add-hook, not bbdb-add-hook + * lisp/bbdb-vm.el: Use add-hook, not bbdb-add-hook + * lisp/bbdb-xemacs.el: Use add-hook, not bbdb-add-hook + * lisp/bbdb-print.el: Moved key binding to bbdb.el + * lisp/bbdb-print.el: Changed default of `bbdb-print-elide' + * lisp/bbdb-print.el (bbdb-print-alist-widget): Fixed problem with + nil `bbdb-default-area-code' + * lisp/bbdb-sc.el: Fixed intro comments + * lisp/bbdb-sc.el: Use add-hook, not bbdb-add-hook + * Makefile: Alphabetized MUA directory variables, added OTHERDIR + variable + * lisp/Makefile: Support for OTHERDIR, rearranged flags to Emacs + so we can use bbdb-split-string (19.34 doesn't have split-string) + * texinfo/bbdb.texinfo: Almost finished doc rewrite + * misc/bbdb_gnus-summary-get-author.fig: Created + +Fri Feb 20 19:31:00 1998 Christopher Kline <ckline@media.mit.edu> + + * texinfo/bbdb.texinfo: Documentation for BBDB-Reportmail + +Thu Feb 19 13:41:17 1998 Sam Steingold <sds@usa.net> + + * lisp/bbdb.el (bbdb-version): Return a string if non-interactive + +Mon Jan 5 20:40:03 1998 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 1.58unoff released + * lisp/auto-autoloads.el: Removed all autoloads except `bbdb-initialize' + * lisp/bbdb-com.el: Fixed copyright + * lisp/bbdb-com.el: Removed autoloads + * lisp/bbdb-com.el: Finger group changed + * lisp/bbdb-com.el (bbdb-compare-records): Changed to backquote notation + * lisp/bbdb-ftp.el: Customized + * lisp/bbdb-ftp.el: Added provide of bbdb-ftp + * lisp/bbdb-gnus.el: Removed autoloads + * lisp/bbdb-gnus.el (bbdb/gnus-summary-prefer-real-names): Reformatted doc + * lisp/bbdb-gnus.el (bbdb/gnus-score-as-text): Remove `when' + * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Remove `when' + * lisp/bbdb-hooks.el: Added provide of bbdb-hooks + * lisp/bbdb-hooks.el (bbdb-time-internal-format): Replaces bbdb-time-string + * lisp/bbdb-hooks.el (bbdb-ignore-most-messages-alist): Fixed custom spec + * lisp/bbdb-hooks.el (bbdb-ignore-some-messages-alist): Fixed custom spec + * lisp/bbdb-hooks.el (bbdb-auto-notes-alist): Fixed custom spec + * lisp/bbdb-hooks.el (bbdb-auto-notes-ignore): Fixed custom spec + * lisp/bbdb-hooks.el (bbdb-auto-notes-ignore-all): Fixed custom spec + * lisp/bbdb-migrate.el: Created from migrate code in bbdb.el + * lisp/bbdb-print.el: Customized + * lisp/bbdb-print.el: Removed autoloads + * lisp/bbdb-reportmail.el: Changed setup docs, added RCS ID and Log strings + * lisp/bbdb-sc.el: Fixed jwz's e-mail address + * lisp/bbdb-sc.el: Customized + * lisp/bbdb-sc.el: Removed autoloads + * lisp/bbdb-sc.el: Added provide of bbdb-sc + * lisp/bbdb-snarf.el: Customized + * lisp/bbdb-snarf.el: Removed autoloads + * lisp/bbdb-srv.el: Rearranged copyright + * lisp/bbdb-srv.el: Customized + * lisp/bbdb-w3.el: Removed autoloads + * lisp/bbdb-w3.el: Added provide of bbdb-w3 + * lisp/bbdb-whois.el: Added to copyright + * lisp/bbdb-whois.el: Customized + * lisp/bbdb-xemacs.el: Removed autoloads + * lisp/bbdb.el: Added define-widget definition for users without Custom + * lisp/bbdb.el: Added utilities custom groups + * lisp/bbdb.el: Removed migration code + * lisp/bbdb.el: Commented some code + * lisp/bbdb.el (bbdb-string-trim): Delete still more text properties + * lisp/bbdb.el (bbdb-save-db): Made error message slightly more obvious + * lisp/bbdb.el (bbdb-initialize): Added symbols for selective insinuation + * lisp/bbdb.el (bbdb-initialize): Rearranged and added some autoloads + * Makefile: Added migrate.el + * Makefile: Added deploy target + * texinfo/bbdb.texinfo: Changed `setq' to `add-hook' in setup instructions + * texinfo/bbdb.texinfo: Added to Internals section + +Mon Dec 1 09:00:12 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 1.57Aunoff released + * texinfo/bbdb.texinfo: Documented new startup procedure + * INSTALL: Documented new startup procedure + +Sun Nov 30 23:26:21 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 1.57unoff released + +Sun Nov 30 22:47:04 1997 Sam Steingold <sshteingold@cctrading.com> + + * lisp/bbdb-hooks.el (bbdb-time-string): Uses format string now + * lisp/bbdb-com.el (bbdb-display-some): Added + * lisp/bbdb-com.el (bbdb-kill-older): Created + * lisp/bbdb-com.el (bbdb-timestamp-older): Created + * lisp/bbdb-com.el (bbdb-timestamp-newer): Created + * lisp/bbdb-com.el (bbdb-creation-older): Created + * lisp/bbdb-com.el (bbdb-creation-newer): Created + +Sun Nov 30 22:44:42 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/auto-autoloads.el: Autoloads for date functions + * lisp/bbdb-com.el (bbdb-complete-clicked-name): Make 19.34 happy + * lisp/bbdb-com.el (bbdb-compare-records): Created + * lisp/bbdb-com.el: Customized variables + * lisp/bbdb-gnus.el: Customized variables + * lisp/bbdb-hooks.el: Customized variables + * lisp/bbdb.el: Customized variables + * lisp/bbdb.el: Added timezone require to support date functions + * lisp/bbdb.el: Added migration functions, changed database version + * lisp/bbdb.el: Added definitions for utility functions that don't + appear in all Emacsen (in the case of string>, in none) + * lisp/bbdb.el (defstruct): Added documentation + * lisp/bbdb.el (bbdb-format-record): Can now define printing + functions for each note field + (bbdb-format-record-fieldname) + * lisp/bbdb.el (bbdb-copy-thing): Created + * lisp/bbdb.el (bbdb-initialize): Created - Use it to initialize + * texinfo/Makefile (clean): Changed since we now distribute *.info* + * texinfo/Makefile (reallyclean): clean + removes *.info* + * texinfo/bbdb.texinfo: Removed `BBDB database' per jwz, added + prereq section, more special fields, some + internals. + * INSTALL: Created + +Thu Oct 30 07:06:15 1997 Hrvoje Niksic <hniksic@srce.hr> + + * lisp/bbdb.el: Custom blob to make defcustom and defgroup + transparent in non-customized Emacsen + +Sun Nov 30 12:03:41 1997 Soren Dayton <csdayton@cs.uchicago.edu> + + * lisp/bbdb-print.el (bbdb-print-tex-quote): Escape tildes properly + +Tue Nov 10 20:10:53 1997 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp> + + * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Improve output of + warning messages. + * lisp/bbdb-gnus.el (bbdb/gnus-summary-known-poster-mark): Correct + docstring. + +Sat Nov 8 17:00:21 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el (bbdb-string-trim): Just remove 'face property. + * lisp/bbdb.el: Define `defvaralias' as empty function if it's not + defined. (GNU Emacs doesn't have it) + +Sun Nov 2 01:32:23 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 1.56unoff released + * lisp/bbdb-sc.el: Added + * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Commented back in score + hook addition, can now set up format functions one at a time + (latter based on function from Christoph Wedler) + * lisp/bbdb-gnus.el (bbdb/gnus-score-default-internal): Added to + automagically catch changes to `bbdb/gnus-score-default'. + * lisp/bbdb-gnus.el (bbdb/gnus-annotate-sender): Now takes REPLACE + argument. + * lisp/bbdb-vm.el (bbdb/vm-annotate-sender): Ditto + * lisp/bbdb-mhe.el (bbdb/mh-annotate-sender): Ditto + * lisp/bbdb-rmail.el (bbdb/rmail-annotate-sender): Ditto + * lisp/auto-autoloads.el: Support for bbdb-sc, housekeeping for others. + * Makefile (install-pkg): Bug fix. + * texinfo/bbdb.texinfo: More rewriting, documentation for the + Summary Buffer stuff in bbdb-gnus.el + +Tue Oct 28 16:08:54 1997 Christoph Wedler <wedler@fmi.uni-passau.de> + + * lisp/bbdb-gnus.el (bbdb/gnus-define-format-functions): New + variable. + * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Use it. Only define user + functions the first time. Use `bbdb-warn' instead `error'. + * lisp/bbdb.el (bbdb-warn): New function. Use it. + +Sun Oct 26 20:47:20 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/auto-autoloads.el: Remove summary buffer autoloads + * lisp/bbdb-gnus.el: Variable aliases for backward compatibility + * lisp/bbdb-gnus.el (bbdb/gnus-summary-user-format-letter): Add + more descriptive documentation. + * lisp/bbdb-gnus.el (bbdb/gnus-summary-in-bbdb-format-letter): Added + * lisp/bbdb-gnus.el (bbdb/gnus-lines-and-from): Variable name change + * lisp/bbdb-gnus.el (bbdb/gnus-summary-author-in-bbdb): Added + * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Commented out score + insinuation, add %ub summary line code creation + * lisp/bbdb.el: Remove summary buffer autoloads + +Sun Oct 26 00:14:36 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb.el: BBDB 1.55unoff released + * texinfo/bbdb.texinfo: Partial rewrite + * lisp/bbdb.el: new autoloads. Override bbdb-display-completion-list + for XEmacs users. + * lisp/bbdb-w3.el (bbdb-www): Uses browse-url-browser-function + instead of a manual funcall + * lisp/bbdb-snarf.el (bbdb-snarf-region): Toss trailing space too + +Sat Oct 25 23:47:40 1997 Brian Edmonds <edmonds@cs.ubc.ca> +Sat Oct 25 23:47:40 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb-gnus.el: Changed *everything* beginning with + `gnus-bbdb' to `bbdb/gnus' + * lisp/bbdb-gnus.el (bbdb/gnus-summary-get-author): Integrated (along + with associated variables and functions) + * lisp/bbdb-gnus.el (bbdb/gnus-score): Integrated (along with + associated variables and functions) + * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Activate above new + features + +Sat Oct 25 17:54:26 1997 Marco Walther <Marco.Walther@mch.sni.de> +Sat Oct 25 17:54:26 1997 Matt Simmons <simmonmt@acm.org> + + * lisp/bbdb-com.el (bbdb-complete-name): Clicking on name in + completion buffer now restores configuration (uses callback below) + * lisp/bbdb-com.el (bbdb-complete-clicked-name): Created. See above + * lisp/bbdb-com.el (bbdb-display-completion-list): Wrapper + * lisp/bbdb-xemacs.el (bbdb-xemacs-display-completion-list): + XEmacs version of bbdb-display-completion-list, allows callbacks + * lisp/auto-autoloads.el: autoload for XEmacs version of + bbdb-display-completion-list + +Mon Oct 20 18:38:28 1997 Colin Rafferty <craffert@ml.com> + + * Makefile (install-pkg): Made it install the el before the .elc. + +Mon Oct 20 12:15:15 1997 Christoph Wedler <wedler@fmi.uni-passau.de> + + * lisp/bbdb-xemacs.el (global-bbdb-menu-commands): Bug fix "Finger + All Records". + * lisp/bbdb-xemacs.el (build-bbdb-finger-menu): Use + `bbdb-record-finger-host'. + * lisp/bbdb-com.el (bbdb-finger): Doc string extension. + * texinfo/bbdb.texinfo (BBDB Mode): Add documentation for + `bbdb-finger'. + +Tue Oct 14 20:06:38 1997 david carlton <carlton@math.mit.edu> + + * Makefile (install-pkg): Fix info linking - use texinfo, not info + +Mon Oct 13 16:41:27 1997 Soren Dayton <csdayton@cs.uchicago.edu> + + * lisp/bbdb-w3.el (bbdb-www): Use browse-url instead of funcalling + contents of browse-url-browser-function. + +Sat Oct 11 19:19:27 1997 Matt Simmons <simmonmt@acm.org> + + * bbdb.el: BBDB 1.54unoff released + * lisp/Makefile: Changed VM, GNUS, and MHE definitions so they can + be blank if the packages are in load-path. Added bbdb-snarf and + bbdb-w3. Made bbdb-srv and bbdb-reportmail skipping messages more + informative. Added check for itimer for bbdb-srv. + * lisp/bbdb-w3.el (bbdb-insinuate-w3): Created from bare add-hook + statement found in David's version. Add this to w3-mode-hook + (yes, that's singular, not plural) + * lisp/bbdb-w3.el (bbdb-www): Modified to use + browse-url-browser-function instead of having two functions, one + for netscape and one for w3. + * lisp/bbdb-snarf.el: Fixed area code pattern to use [2-9] instead + of [0-9] for first digit. + * lisp/auto-autoloads.el: Autoloads for bbdb-snarf, bbdb-www, + changed package dir from `bbdb-1.52' to `bbdb', autoload for + bbdb-insinuate-message. + * lisp/bbdb.el: Added autoloads for bbdb-insinuate-message, + bbdb-www, bbdb-www-grab-homepage, bbdb-insinuate-w3, bbdb-snarf. + * lisp/bbdb.el (bbdb-mode): Documentation for bbdb-www `w' keystroke + * lisp/bbdb.el (bbdb-mode-map): bbdb-www invocation + * lisp/bbdb.el (bbdb-split): Documented. + * lisp/bbdb-gnus.el (bbdb-insinuate-message): Use it. Sets the + M-t binding for message-mode. This isn't in bbdb-insinuate-gnus + because some like to use message-mode before loading gnus. Add + it to `message-setup-hook', _not_ `message-load-hook'. + +Sat Oct 11 19:01:00 1997 David Carlton <carlton@math.mit.edu> + + * lisp/bbdb-w3.el: Added to bbdb distribution. I don't know who + the original author is, but David mailed it to me. + +Sat Oct 11 19:00:00 1997 John Heidemann <johnh@isi.edu> + + * lisp/bbdb-snarf.el: Added to bbdb distribution. Grabs text from + paragraph around point and makes a bbdb record out of it. See + the source for docs until I get around to adding to the texinfo + file. + +Sat Oct 11 18:50:52 1997 Kees de Bruin <kees_de_bruin@tasking.nl> + + * lisp/bbdb-vm.el (bbdb/vm-alternate-full-name): make VM use the + canonicalized net address instead of the default address. + * lisp/bbdb-com.el (bbdb-sendmail-internal): Still more + message-mode fixes. Default to message-mode if neither mh-e nor + vm are in `features'. If message-mode is to be used and it's not + loaded, autoload it. + +Thu Oct 9 06:37:00 1997 Matt Simmons <simmonmt@acm.org> + * lisp/Makefile: Check for itimer before building bbdb-srv. + Complain nicely when check fails. + +Sun Oct 5 20:16:00 1997 Matt Simmons <simmonmt@acm.org> + * bbdb.el: BBDB 1.53unoff released + +Sun Oct 5 19:53:12 1997 Boris Goldowsky <boris@gnu.ai.mit.edu> + * tex/bbdb-cols.tex, tex/bbdb-print-brief.tex, tex/bbdb-print.tex, + lisp/bbdb-print.el: New version of bbdb-print + +Sun Oct 5 19:51:21 1997 Jamie Zawinski <jwz@netscape.com> + * utils/bbdb-cid.pl, utils/bbdb-src.pl, utils/bbdb-to-netscape.el: + New utilities + * lisp/bbdb-com.el (bbdb-parse-phone-number): Changed comment to + reflect new area codes that don't have [012] as their second digit + * lisp/bbdb-srv.el (bbdb/srv-auto-create-mail-news-dispatcher): + Classification of messages as mail or news + * lisp/bbdb-srv.el (bbdb-src-add-phone): Supports caller ID util + * lisp/bbdb-srv.el (bbdb/srv-handle-headers): Make sure *BBDB* is + bottommost buffer + +Sun Oct 5 19:51:20 1997 Seth Golub <seth@cs.wustl.edu> + * utils/bbdb-areacode-split.pl: New utility + +Sun Oct 5 19:51:19 1997 Matt Simmons <simmonmt@acm.org> + + * A grand reorg: .tex files -> tex subdirectory, + .texinfo files -> texinfo subdirectory, + .el files -> lisp subdirectory, + * Makefile: modified all Makefiles to deal with reorg, + rewrote XEmacs package section + * lisp/bbdb.el (bbdb-frob-mode-line): I like version numbers on modelines + * lisp/bbdb.el (bbdb-version-date): Separate date from version number + * lisp/bbdb.el (bbdb-version): Modified to deal with version + number separate from date + +Mon Sep 29 18:49:47 1997 Matt Simmons <simmonmt@acm.org> + + * Makefile: patch to avoid building bbdb-srv and bbdb-reportmail + if gnuserv and reportmail (respectively) aren't present + * bbdb.el (bbdb-frob-mode-line): Print the version number on the + mode line + +Sun Sep 28 00:50:07 1997 Matt Simmons <simmonmt@acm.org> + + * bbdb.el: BBDB 1.52unoff released + * bbdb.el (bbdb-y-or-n-p): Fix obsolete functions + * bbdb-ftp.el: Added check for efs + * Makefile: renamed it, removed mail-extr and mail-abbrev, did + some reformatting + +Sun Sep 28 00:49:00 1997 Colin Rafferty <craffert@ml.com> + + * auto-autoloads.el, Makefile: Use BBDB as an XEmacs package + +Sun Sep 28 00:03:31 1997 Jens-Ulrik Hoger Petersen <petersen@kurims.kyoto-u.ac.jp> + + * bbdb-gnus.el (bbdb/gnus-update-record): Changed method for + referencing article buffer. Needed when + gnus-single-article-buffer is nil. + * bbdb-hooks.el (bbdb-header-start): See above. + +Sat Sep 27 23:56:35 1997 Christopher Kline <ckline@mitre.org> + + * bbdb-reportmail.el: Created + +Sat Sep 27 23:47:01 1997 Soren Dayton <csdayton+bbdb@cs.uchicago.edu> + + * bbdb-com.el (bbdb-send-mail-internal): Allow use of message-mail + * bbdb.el (bbdb-send-mail-style): Documentation change. See above. + +Sat Sep 27 23:44:43 1997 Colin Rafferty <craffert@ml.com> + + * bbdb.el (bbdb-annotate-message-sender): Use address for name if no name + +Sat Sep 27 23:39:09 1997 Christoph Wedler <wedler@fmi.uni-passau.de> + + * bbdb-com.el (bbdb-finger-host-field): Added code to check for + finger-host field. Finger is done on finger-host if it + exists, on net address otherwise. + +Sat Sep 27 20:06:05 1997 Matt Simmons <simmonmt@acm.org> + + * bbdb-com.el (bbdb-phone-area-regexp): Fix US area code pattern @@ -0,0 +1,166 @@ +This file has three sets of installation instructions: with `make', +without `make', and uncompiled. Please follow the appropriate set of +instructions. If you plan on running BBDB directly from CVS, please +check the additional instructions below. + +=============================================================================== + +Running BBDB from CVS: + + *** PLEASE NOTE **** + This applies to the master CVS tree at sourceforge, not the XEmacs CVS tree. + *** PLEASE NOTE *** + + This is not recommended, unless you're a BBDB developer. You will + need to either install the GNU autoconf package, or download the + pregenerated copy of configure from the BBDB website. If you choose + the former option, you'll need to run `autoconf' to generate the + configure script. Thereafter, follow the appropriate set of + instructions below. + +=============================================================================== + +To compile and install the BBDB on systems with `make': + + 1) Configure the compilation process: + + First of all, you should run the `configure' script at the toplevel of + the distribution. This script will perform a number of checks on your + system and generate the Makefile's accordingly. + + The `configure' script comes with a number of options that might be of + interest to you: + + `--with-emacs=PROG' lets you select an Emacs program to use. By + default, "emacs" and "xemacs" will be tried in that order. + + `--with-{gnus,mhe,vm}-dir=DIR' let you specify the paths where Gnus, + MH-E and VM can respectively be found, if Emacs can't find them by + itself (like, if they're not in the load-path by default). + + `--with-other-dirs=DIRS' lets you specify additional paths (space or + colon spearated) to find other libraries that might be needed (see + the "Byte Compiling the Lisp files" section of the BBDB manual for + more information). + + NOTE: Gnu Emacs 19.34 users should add the path to Custom 1.9962 + here if they plan to build Gnus support. Gnus support will not build + under Gnu Emacs 19.34 without Custom 1.9962. + + `--with-package-dir=DIR' lets you specify the installation path for + for XEmacs package installation. By default, + "/usr/local/lib/xemacs/site-packages" is used. + + `--with-symlinks' will make the installation process use symbolic links + to the sources instead of copying the files. + + `--with-linkpath=PATH' lets you specify the path to link from, if your + `pwd' command doesn't work properly. + + + 2) Build the BBDB: + + To build the BBDB with support for all of the supported mail + and news programs (gnus, mh-e, rmail, and vm), issue the + command 'make all'. (The BBDB also supports sendmail mode - + support for it is automatically compiled in, regardless of the + build options supplied) To build with support only for gnus, + mh-e, rmail, and/or vm, issue the 'make' command with one or + more of the following arguments: 'gnus', 'mh-e', 'rmail', + and/or 'vm'. To build the BBDB without support for any mail + program (except for sendmail mode), issue the command + 'make bbdb'. + + + 3) Install the BBDB: + + The three most typical installations are outlined below: + + a) In-place. + i) Follow steps 1 and 2 + ii) Add the lisp subdirectory to the Emacs load-path + iii) Add the tex subdirectory to the TeX + search path (can be done by adding the complete path + to the tex subdirectory to the environment variable + TEXINPUTS) + iv) Add the texinfo directory to the Info search path. + b) "Normal". + i) Follow steps 1 and 2. + ii) Copy the .el and .elc files from the lisp + subdirectory to a directory on the Emacs load-path + (or make a new directory, copy the files to it, and + add the new directory to the load-path). + iii) Copy the .tex files from the tex subdirectory to a + directory on the TeX search path (or make a new + directory, copy the files to it, and add the new + directory to the TeX search path. + iv) Copy the .info and .info-* files from the texinfo + subdirectory to a directory on the Info search path + (or make a new directory, copy the files to it, and + add the new directory to the Info search path) + c) XEmacs Package + NOTE: This installation option is only available to users + running XEmacs 20.3 or higher. + i) Follow steps 1 and 2. + ii) Issue the 'make install-pkg' command. + + + +To compile and install the BBDB on systems without `make': + + If at all possible, use make to automatically build the BBDB as + outlined above. While it looks like there are fewer steps in the + non-make instructions below, they're more tedious and involved. + + 1) Compile the .el files using the byte-compile-file function in + Emacs. + + 2) Install the BBDB as outlined in step 3 above. + +=============================================================================== + +To run BBDB uncompiled: + + Again, this is really not recommended, although it will generate a + more meaningful stacktrace if you happen to run into a problem. In + order to run BBDB uncompiled, you'll need to do two things: + + 1) Generate bbdb-autoloads.el + You can do this by typing 'make autoloads' in the main BBDB + directory. Note that this will require you to have previously run + configure to generate Makefiles. + + 2) Add .../bbdb/lisp to your load path + You need to make sure that the lisp subdirectory of the BBDB + source is in your load path so that Emacs can find the BBDB + files. + + Since arbitrary chunks of the BBDB are macros, you'll probably find + the uncompiled version slower than the compiled version. + +=============================================================================== + +*************************************************************************** +* * +* THE BBDB INITIALIZATION PROCEDURE CHANGED IN 1.57unoff. * +* * +* YOU *MUST* ADD * +* * +* (require 'bbdb) * +* (bbdb-initialize) * +* * +* TO YOUR BBDB INITIALIZATION CODE. THIS TAKES THE PLACE OF ALL BBDB * +* AUTOLOADS. IT DOES *NOT* TAKE THE PLACE OF THE INSINUATION CODE. * +* * +* If you do not add this code, you will receive keymap errors * +* (among other things) * +* * +*************************************************************************** + +For information on post-installation BBDB configuration and setup, see +the info file. (M-x bbdb, and press 'i' in the BBDB info window) + +Questions, Comments, Suggestions, and Bug Reports may be directed to +the BBDB mailing list at bbdb-info@lists.sourceforge.net. To +subscribe, send mail to bbdb-info-request@lists.sourceforge.net, with +'subscribe' as the subject. diff --git a/Makefile.in b/Makefile.in new file mode 100644 index 0000000..920aa4c --- /dev/null +++ b/Makefile.in @@ -0,0 +1,125 @@ +# Main Makefile for BBDB +@SET_MAKE@ + +TAR = @TAR@ +COMPRESS = @COMPRESS@ +COMPEXT = @COMPEXT@ +RM = @RM@ +LN_S = @LN_S@ + +ETAGS = @ETAGS@ +EMACS_PROG = @EMACS_PROG@ -no-site-file -no-init-file + +SUBDIRS = lisp texinfo tex utils + +TARFILES = ChangeLog INSTALL Makefile README \ + aclocal.m4 configure configure.ac install-sh Makefile.in \ + bits lisp misc tex texinfo utils + +all: Makefile bbdb info @BBDB_RMAIL@ @BBDB_VM@ @BBDB_MHE@ @BBDB_GNUS@ + +Makefile:: Makefile.in + ./config.status + +Makefile:: configure + @echo "Configure has changed, you may need to rerun configure!" + exit 1 + +configure: configure.ac + @echo "configure.ac has changed. Please rerun autoconf!" + exit 1 + +bbdb: + cd lisp; $(MAKE) bbdb + +rmail: + cd lisp; $(MAKE) rmail + +vm: + cd lisp; $(MAKE) vm + +mhe: + cd lisp; $(MAKE) mhe + +gnus: + cd lisp; $(MAKE) gnus + +info: + cd texinfo; $(MAKE) info + +autoloads: + cd lisp; $(MAKE) autoloads + +autoloadsc: + cd lisp; $(MAKE) autoloadsc + +install-pkg: + @for i in $(SUBDIRS) ; do \ + ( cd $$i && $(MAKE) install-pkg ) ; \ + done + +uninstall-pkg: + @for i in $(SUBDIRS) ; do \ + ( cd $$i && $(MAKE) uninstall-pkg ) ; \ + done + +clean: + -$(RM) loadpath.el + cd lisp; $(MAKE) clean + cd texinfo; $(MAKE) clean + +distclean: + @for i in $(SUBDIRS) ; do \ + ( cd $$i && $(MAKE) distclean ) ; \ + done + -$(RM) config.cache config.status config.log + -$(RM) -r autom4te.cache + -$(RM) *.tar.gz + -$(RM) .#* + +# Backward compatibility +reallyclean: distclean + +cvsclean: + @for i in $(SUBDIRS) ; do \ + ( cd $$i && $(MAKE) cvsclean ) ; \ + done + -$(RM) Makefile configure + + +# tarball +tar: $(TARFILES) + @if test "x$(TAR)" = "x" ; then \ + echo "Sorry, no \`tar' program available." ; \ + else \ + name=`sed -n 's/^(defconst bbdb-version "\([0-9]\.[0-9][0-9]*\).*/bbdb-\1/p' lisp/bbdb.el` ; \ + $(RM) $${name} ; @LN_S@ . $${name} ; \ + if test "x$(COMPRESS)" = "x" ; then \ + echo "Sorry, no compression program available." ; \ + echo "The tarball will not be compressed." ; \ + echo "creating tar file $${name}.tar..." ; \ + $(TAR) --exclude=CVS --exclude=testing --exclude=".*" \ + -vchf $${name}.tar \ + `echo $(TARFILES) | sed "s|^|$${name}/|g; s| | $${name}/|g"` ; \ + else \ + echo "creating tar file $${name}.tar.$(COMPEXT)..." ; \ + $(TAR) --exclude=CVS --exclude=".*" -vchf - `echo $(TARFILES) \ + | sed "s|^|$${name}/|g; s| | $${name}/|g"` \ + | $(COMPRESS) > $${name}.tar.$(COMPEXT) ; \ + fi ; \ + $(RM) $${name} ; \ + fi + +homepage: + rsync -rtO -v --exclude=CVS --rsh="ssh" html/ shell.sourceforge.net:/home/groups/b/bb/bbdb/htdocs/ + +dist: distclean info autoloads tar + +TAGS: tags + +tags: + @if test "x$(ETAGS)" = "x" ; then \ + echo "Sorry, no \`etags' program available." ; \ + else \ + $(ETAGS) */*.el ; \ + fi @@ -0,0 +1,5 @@ +BBDB (The Insidious Big Brother Database) is a rolodex-like database +program for Emacs. BBDB can hook into (insinuate) various Emacs +subsystems (email readers, news readers, etc) to automatically create, +display, and augment relevant entries from its database. Filters are +provided to import/export in a variety of formats. diff --git a/aclocal.m4 b/aclocal.m4 new file mode 100644 index 0000000..c403f9d --- /dev/null +++ b/aclocal.m4 @@ -0,0 +1,173 @@ +dnl aclocal.m4 --- More autoconf macros for BBDB + +dnl Author: Didier Verna <didier@xemacs.org> +dnl Maintainer: Didier Verna <didier@xemacs.org> +dnl Created: Tue Nov 14 18:28:52 2000 +dnl Last Revision: Tue Jan 2 16:53:50 2001 + +dnl Copyright (C) 2000-2001 Didier Verna + +dnl BBDB is free software; you can redistribute it and/or modify +dnl it under the terms of the GNU Library General Public License as published +dnl by the Free Software Foundation; either version 2 of the License, or (at +dnl your option) any later version. + +dnl BBDB is distributed in the hope that it will be useful, +dnl but WITHOUT ANY WARRANTY; without even the implied warranty of +dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +dnl GNU Library General Public License for more details. + +dnl You should have received a copy of the GNU Library General Public License +dnl along with this program; if not, write to the Free Software Foundation, +dnl Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + +dnl BBDB_PRE_INIT +dnl +dnl Find BBDB version number and put it in the m4 macro BBDB_VERSION +dnl +dnl I fought really hard, but finally I got it accepted to make autoconf load +dnl aclocal *before* AC_INIT is called. This is important for me, in +dnl situations like this precise one, where I want to dynamically compute the +dnl version number to pass to AC_INIT. +dnl There's one minor glitch however, the AC_DEFUN mechanism is not available +dnl before AC_INIT is called because of diversions. So this macro is defined +dnl only in terms of "m4 sugar". +m4_define([BBDB_PRE_INIT], +[ m4_define([_BBDB_VERSION], + m4_esyscmd([sed -n 's/^(defconst bbdb-version "\(.*\)")/\1/p' lisp/bbdb.el])) + m4_define([BBDB_VERSION], + m4_substr(_BBDB_VERSION, 0, decr(len(_BBDB_VERSION)))) + m4_undefine([_BBDB_VERSION]) +]) + +dnl BBDB_ARG_SUBST(VAR, OPTION, VAL, DESC[, DEFAULT[, ACTION]]) +dnl +dnl Substitute the autoconf variable VAR to a value specified by the user +dnl option --with-OPTION[=VAL] (described by DESC), or with a DEFAULT value. +dnl If an additional ACTION is given, it is executed at the top of the +dnl ACTION-IF-FOUND part of AC_ARG_WITH. +dnl #### WARNING: pay attention to the quoting of ACTION if given !!!!! +AC_DEFUN([BBDB_ARG_SUBST], +[ + AC_SUBST([$1]) + AC_ARG_WITH([$2], + AC_HELP_STRING([--with-][$2]ifelse($3, [], [], [=$3]), + [$4]ifelse($5, [], [], [ [[[$5]]]])), + [ + ifelse($6, [], [], $6) + $1="${withval}" + ], + ifelse($5, [], [], [$1="$5"])) +]) + +dnl BBDB_COLON_TO_SPACE(VAR) +dnl +dnl Transforms a (possibly) colon separated list VAR into a space separated +dnl one. VAR needs not be quoted. +AC_DEFUN([BBDB_COLON_TO_SPACE], +[ case "$$1" in *:*) + $1="`echo $$1 | sed -e 's/:/ /g'`";; + esac ]) + +dnl BBDB_PROG_GNU_TAR +dnl +dnl Find a (g)tar program and make sure it is GNU one. A failure is not fatal +dnl since tar is needed for non critical targets only. +AC_DEFUN([BBDB_PROG_GNU_TAR], + [ AC_CHECK_PROGS(TAR, gtar tar) + if test "x${TAR}" = "xtar" ; then + AC_MSG_CHECKING([that tar is GNU tar]) + ${TAR} --version > /dev/null 2>&1 || TAR= + if test "x${TAR}" = "x" ; then + AC_MSG_RESULT(no) + else + AC_MSG_RESULT(yes) + fi + fi + if test "x${TAR}" = "x" ; then + AC_MSG_WARN([*** No GNU tar program found.]) + AC_MSG_WARN([*** Some targets will be unavailable.]) + fi ]) + +dnl BBDB_PROG_COMPRESS +dnl +dnl Find a gzip / compress compression program. A failure is not fatal, only +dnl tarballs won't be compressed. +AC_DEFUN([BBDB_PROG_COMPRESS], + [ AC_CHECK_PROGS(COMPRESS, gzip compress) + AC_SUBST(COMPEXT) + if test "x${COMPRESS}" = "x" ; then + AC_MSG_WARN([*** No compression program found.]) + AC_MSG_WARN([*** Tarballs will not be compressed.]) + COMPEXT= + elif test "x${COMPRESS}" = "xgzip" ; then + COMPRESS="gzip --verbose --best" + COMPEXT=gz + else + COMPEXT=Z + fi ]) + +dnl BBDB_PROG_MAKEINFO +dnl +dnl Find a makeinfo program. A failure is not fatal, only info files won't be +dnl built. +AC_DEFUN([BBDB_PROG_MAKEINFO], + [ AC_CHECK_PROG(MAKEINFO, makeinfo, makeinfo) + if test "x${MAKEINFO}" = "x" ; then + AC_MSG_WARN([*** No makeinfo program found.]) + AC_MSG_WARN([*** Info files will not be built.]) + fi ]) + +dnl BBDB_PROG_TEXI2DVI +dnl +dnl Find a texi2dvi program. A failure is not fatal, only dvi and pdf files +dnl won't be built. +AC_DEFUN([BBDB_PROG_TEXI2DVI], + [ AC_CHECK_PROG(TEXI2DVI, texi2dvi, texi2dvi) + if test "x${TEXI2DVI}" = "x" ; then + AC_MSG_WARN([*** No texi2dvi program found.]) + AC_MSG_WARN([*** DVI and PDF files will not be built.]) + fi ]) + +dnl BBDB_PROG_ETAGS +dnl +dnl Find an etags program. A failure is not fatal, only TAGS file won't be +dnl built. +AC_DEFUN([BBDB_PROG_ETAGS], + [ AC_CHECK_PROG(ETAGS, etags, etags) + if test "x${ETAGS}" = "x" ; then + AC_MSG_WARN([*** No etags program found.]) + AC_MSG_WARN([*** Tags file will not be built.]) + fi ]) + +dnl BBDB_PROG_EMACS +dnl +dnl Choose an Emacs flavor according to the --with-emacs user option, or try +dnl emacs and xemacs. +dnl We use EMACS_PROG instead of EMACS to avoid colliding with Emacs' own +dnl internal environment. +AC_DEFUN([BBDB_PROG_EMACS], + [ AC_ARG_WITH([emacs], + AC_HELP_STRING([--with-emacs=PROG], + [choose which flavor of Emacs to use]), + [ EMACS_PROG="${withval}" ], + [ AC_PATH_PROGS(EMACS_PROG, emacs xemacs) ]) + if test "x${EMACS_PROG}" = "x" ; then + dnl This is critical enough to generate an error and not a warning... + AC_MSG_ERROR([*** No Emacs program found.]) + fi + if test -x "${EMACS_PROG}"; then + echo "yay" > /dev/null # because I don't know if 'if !' is portable + else + dnl AC_CHECK_PROGS only verifies this if you don't override manually + AC_MSG_ERROR([*** ${EMACS_PROG} isn't executable.]) + fi + dnl We do need to verify that it's not got spaces in the path + dnl (hello Windows, OS X) + if test "x`echo $EMACS_PROG | grep \" \"`" != "x"; then + EMACS_PROG=\"$EMACS_PROG\" + fi + AC_SUBST(EMACS_PROG) ]) + +dnl aclocal.m4 ends here diff --git a/bits/README b/bits/README new file mode 100644 index 0000000..cc941db --- /dev/null +++ b/bits/README @@ -0,0 +1,4 @@ +This is the collection of bits and pieces located on the net or mailed to me +by various folk that may or may not wind up in BBDB proper. They shouldn't +be considered part of the bbdb as-is, nor should you complain to me about +their failure to work. diff --git a/bits/bbdb-anniv.el b/bits/bbdb-anniv.el new file mode 100644 index 0000000..9e6205d --- /dev/null +++ b/bits/bbdb-anniv.el @@ -0,0 +1,206 @@ +;;; bbdb-anniv.el --- Get anniversaries from BBDB + +;; Copyright (C) 1998 Ivar Rummelhoff + +;; Author: Ivar Rummelhoff <ivarru@math.uio.no> +;; Maintainer: Ivar Rummelhoff <ivarru@math.uio.no> +;; Created: 11 March 1998 +;; Time-stamp: <00/08/07 10:52:12 ivarru> +;; Keywords: calendar + +;; This program 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, or (at your option) +;; any later version. +;; +;; This program 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. +;; +;; If you have not received a copy of the GNU General Public License +;; along with this software, it can be obtained from the GNU Project's +;; World Wide Web server (http://www.gnu.org/copyleft/gpl.html), from +;; its FTP server (ftp://ftp.gnu.org/pub/gnu/GPL), by sending an electronic +;; mail to this program's maintainer or by writing to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; (require 'bbdb-anniv) +;; (add-hook 'list-diary-entries-hook #'bbdb-include-anniversaries) +;; +;; will include BBDB-anniversaries when the diary is displayed +;; (fancy). The anniversaries are stored in the field `anniversary' +;; in the format +;; +;; [YYYY-MM-DD CLASS-OR-FORMAT-STRING] +;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}* +;; +;; CLASS-OR-FORMAT-STRING is one of two things: +;; +;; * an identifier for a class of anniversaries (eg. birthday or +;; wedding) from `bbdb-anniversary-format-alist'. +;; * the (format) string displayed in the diary. +;; +;; It defaults to the value of `bbdb-default-anniversary-format' +;; ("birthday" by default). +;; +;; The substitutions in the format string are (in order): +;; * the name of the record containing this anniversary +;; * the number of years +;; * an ordinal suffix (st, nd, rd, th) for the year +;; +;; See the documentation of `bbdb-anniversary-format-alist' for +;; further options. +;; +;; Example (my own record): +;; +;; 1973-06-22 +;; 20??-??-?? wedding +;; 1998-03-12 %s created bbdb-anniv.el %d years ago +;; +;; If you use the hook `sort-diary-entries', you should make sure that +;; it is executed after `bbdb-include-anniversaries'. +;; + +(require 'bbdb) +(require 'diary-lib) +(eval-when-compile (require 'cl)) + +;;;###autoload +(defgroup bbdb-utilities-anniversaries nil + "Customizations for including diary anniversaries from BBDB." + :link '(emacs-library-link :tag "Lisp File" "bbdb-anniv.el") + :group 'bbdb-utilities) + +;;;###autoload +(defcustom bbdb-anniversaries nil + "Should BBDB anniversaries be included when the diary is displayed (fancy)? +You must modify via \\[customize] for this variable to have an effect." + :set #'(lambda (symbol value) + (if value + (add-hook 'list-diary-entries-hook + #'bbdb-include-anniversaries) + (remove-hook 'list-diary-entries-hook + #'bbdb-include-anniversaries))) + :type 'boolean + :group 'bbdb-utilities-anniversaries + :require 'bbdb-anniv) + +(defcustom bbdb-default-anniversary-format "birthday" + "Default anniversary class" + :type 'string + :group 'bbdb-utilities-anniversaries + :require 'bbdb) + +(defcustom bbdb-anniversary-format-alist + '( ("birthday" . "Birthday: %s (%d%s)") + ("wedding" . "%s's %d%s wedding anniversary") ) + "How different types of anniversaries should be formatted. +An alist of elements (STRING . FORMAT) where STRING is the name of an +anniversary class and format is either: +1) A format string with the following substitutions (in order): + * the name of the record containing this anniversary + * the number of years + * an ordinal suffix (st, nd, rd, th) for the year + +2) A function to be called with three arguments: NAME YEARS SUFFIX + (string int string) returning a string for the diary or nil. + +3) An emacs lisp form that should evaluate to a string (or nil) in the + scope of variables NAME, YEARS and SUFFIX (among others)." + :type 'sexp + :group 'bbdb-utilities-anniversaries + :require 'bbdb) + +(defcustom bbdb-anniversary-field 'anniversary + "Which BBDB field contains anniversaries." + :type 'symbol + :group 'bbdb-utilities-anniversaries + :require 'bbdb) + +(defcustom bbdb-extract-date-fun 'bbdb-anniv-extract-date + "How to retrieve `month date year' from the anniversary field." + :type 'function + :group 'bbdb-utilities-anniversaries + :require 'bbdb) + +(defcustom bbdb-anniversary-reminder-days 0 + "Number of days warning you are given of an impending anniversary. +Modify this to give yourself a n-day warning of those important +anniversaries. This works in a naive fashion, extending (forwards) the +range of days for which diary entries are being listed. When set to 0, +the behaviour is to only list anniversaries on the day." + :type 'integer + :group 'bbdb-utilities-anniversaries + :require 'bbdb) + +;; YYYY-MM-DD => (month date year) +(defun bbdb-anniv-extract-date (time-str) + (multiple-value-bind (y m d) (bbdb-split time-str "-") + (list (string-to-number m) + (string-to-number d) + (string-to-number y)))) + +(defun bbdb-anniv-split (str) + (let ((pos (string-match "[ \t]" str))) + (if pos (list (substring str 0 pos) + (bbdb-string-trim (substring str pos))) + (list str nil)))) + + +(defvar number) +(defvar original-date) + +;;;###autoload +(defun bbdb-include-anniversaries () + (let ((dates (loop repeat (+ number bbdb-anniversary-reminder-days) + for num from (calendar-absolute-from-gregorian + original-date) + for date = original-date + then (calendar-gregorian-from-absolute num) + ;; ((MM . DD) . YYYY) + collect (cons (cons (extract-calendar-month date) + (extract-calendar-day date)) + (extract-calendar-year date)))) + annivs date years + split class form) + (dolist (rec (bbdb-records)) + (when (setq annivs (bbdb-record-getprop + rec bbdb-anniversary-field)) + (setq annivs (bbdb-split annivs "\n")) + (while annivs + (setq split (bbdb-anniv-split (pop annivs))) + (multiple-value-bind (m d y) + (funcall bbdb-extract-date-fun (car split)) + + (when (and (or (setq date (assoc (cons m d) dates)) + (and (= d 29) + (= m 2) + (setq date (assoc '(3 . 1) dates)) + (not (calendar-leap-year-p (cdr date))))) + (< 0 (setq years (- (cdr date) y)))) + (let* ((class (or (cadr split) + bbdb-default-anniversary-format)) + (form (or (cdr (assoc class + bbdb-anniversary-format-alist)) + class)) ; (as format string) + (name (bbdb-record-name rec)) + (suffix (diary-ordinal-suffix years)) + (text (cond + ((functionp form) + (funcall form name years suffix)) + ((listp form) (eval form)) + (t (format form name years suffix))))) + (when text + (bbdb-anniv-add + (list (caar date) (cdar date) (cdr date)) ; MM DD YYYY + text)))))))))) + +(defun bbdb-anniv-add (a b) + (add-to-diary-list a b "")) + +(provide 'bbdb-anniv) + +;;; bbdb-anniv.el ends here diff --git a/bits/bbdb-canonicalize-lt.el b/bits/bbdb-canonicalize-lt.el new file mode 100644 index 0000000..bb3d9c0 --- /dev/null +++ b/bits/bbdb-canonicalize-lt.el @@ -0,0 +1,41 @@ +;;; As per email to bbdb-info list from Len Trigg <len@netvalue.net> +;;; http://sourceforge.net/mailarchive/message.php?msg_name=hbr60bfmvt.wl%25len@netvalue.net.nz + +;;; Useful name canonicalizer; consider inclusion in main package. + +(defun bbdb-canonicalize-name-hook-lt (name) + "Function used to canonicalize the full names of bbdb entries." + ;; (message (format "canonicalize name %s" name)) + (cond + ;; strip extra quotes (Some MS mailer likes "'full name'") + ((string-match "\\`[`'\"]\\(.*\\)[`'\"]\\'" name) + (bbdb-match-substring name 1)) + ;; replace multiple whitespace with single + ((string-match "[ \f\t\n\r\v]\\{2,\\}" name) + (replace-match " " nil t name)) + ;; remove anything in round brackets, e.g.: "Firstname Surname (E-mail)" + ((string-match "[ ]+(.*)" name) + (replace-match "" nil t name)) + ;; strip leading whitespace (this is a bug in std11 libs?) + ((string-match "\\`[ \t]+\\(.*\\)" name) + (bbdb-match-substring name 1)) + ;; strip trailing whitespace + ((string-match "\\(.*\\)[ ]+\\'" name) + (bbdb-match-substring name 1)) + ;; strip Dr pronoun + ((string-match "\\`Dr\\.? \\(.*\\)" name) + (bbdb-match-substring name 1)) + ;; person and person -> person & person + ((string-match "\\`\\(\\w+\\) and \\(\\w.+\\)\\'" name) + (concat (bbdb-match-substring name 1) " & " (bbdb-match-substring name 2))) + ;; Surname, Firstname -> Firstname Surname + ((string-match "\\`\\(\\w.+\\), \\(\\w.+\\)\\'" name) + (concat (bbdb-match-substring name 2) " " (bbdb-match-substring name 1))) + ;; Sometimes get an email address in the name part. Map the username to a name: <Name@domain> -> Name + ((string-match "\\`<\\(.*\\)@.*\\'" name) + (bbdb-match-substring name 1)) + ;; replace name without any whitespace with empty; I don't want bbdb names containing only a single name + ((string-match "\\`\\(\\w+\\)\\'" name) + ;;(message (format "Eliding name %s" name)) + "") + (t name))) diff --git a/bits/bbdb-edit.el b/bits/bbdb-edit.el new file mode 100644 index 0000000..b22f308 --- /dev/null +++ b/bits/bbdb-edit.el @@ -0,0 +1,139 @@ +;;; bbdb-edit.el --- BBDB field edit +;; Copyright (C) 1999, 2000, 2001 Shenghuo ZHU + +;; Author: Shenghuo ZHU <zsh@cs.rochester.edu> +;; Created: Fri Aug 27 17:45:25 EDT 1999 +;; Keywords: BBDB field edit + +;; This file is not a part of GNU Emacs. +;; +;; This file 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, or (at your +;; option) any later version. +;; +;; This file 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; bbdb-field-edit-add (`insert') and bbdb-field-edit-del (`delete') +;; add/del a item to/from a certain field of the bbdb record. These +;; keys also support `*'. + +;;; Code: + +(require 'bbdb) + +(defun bbdb-field-edit-get-values (record field) + (cond + ((eq field 'net) (bbdb-record-net record)) + ((eq field 'AKA) (bbdb-record-aka record)) + ((eq field 'address) (bbdb-record-addresses record)) + ((eq field 'phone) (bbdb-record-phones record)) + (t (bbdb-split (or (bbdb-record-getprop record field) "") + (or (get field 'field-separator) + bbdb-notes-default-separator))))) + +(defun bbdb-field-edit-put-values (record field values) + (if values + (cond + ((eq field 'net) (bbdb-record-set-net record values)) + ((eq field 'AKA) (bbdb-record-set-aka record values)) + ((eq field 'address) (bbdb-record-set-addresses record values)) + ((eq field 'phone) (bbdb-record-set-phones record values)) + (t (bbdb-record-putprop record field + (bbdb-join values + (or (get field 'field-separator) + bbdb-notes-default-separator))))) + (if (memq field '(net AKA address)) + (bbdb-record-store-field-internal record field nil) + (bbdb-record-putprop record field nil))) + (bbdb-change-record record t) + (bbdb-redisplay-one-record record)) + +;;;###autoload +(defun bbdb-field-edit-add (bbdb-record field value) + "Add VALUE to FIELD of bbdb-record(s)." + (interactive (list (if (bbdb-do-all-records-p) + (mapcar 'car bbdb-records) + (list (bbdb-current-record))) + (completing-read + "Field: " + (append '(("net")("notes")("AKA")) + (bbdb-propnames)) + nil nil + (symbol-name + (let ((on-field (bbdb-current-field t))) + (cond ((null on-field) 'mail-alias) + ((eq (car on-field) 'property) + (car (nth 1 on-field))) + (t (car on-field)))))) + (bbdb-read-string "Value: "))) + (if (stringp field) (setq field (intern field))) + (if (memq field '(name address phone)) + (error "Use `e' to edit this field.")) + (while bbdb-record + (let ((values (bbdb-field-edit-get-values (car bbdb-record) field))) + (if (member value values) nil + (bbdb-field-edit-put-values (car bbdb-record) field + (cons value values)))) + (setq bbdb-record (cdr bbdb-record)))) + +;;;###autoload +(defun bbdb-field-edit-del (bbdb-record field value) + "Delete VALUE to FIELD of bbdb-record(s). +If prefix arg exists, delete all existing field values matching VALUE(regexp)." + (interactive (list (if (bbdb-do-all-records-p) + (mapcar 'car bbdb-records) + (list (bbdb-current-record))) + (completing-read + "Field: " + (append '(("net")("notes")("AKA")) + (bbdb-propnames)) + nil nil (symbol-name + (let ((on-field (bbdb-current-field t))) + (cond ((null on-field) 'mail-alias) + ((eq (car on-field) 'property) + (car (nth 1 on-field))) + (t (car on-field)))))) + (bbdb-read-string (if current-prefix-arg + "Regexp: " + "Value: ")))) + (if (stringp field) (setq field (intern field))) + (if (memq field '(name address phone)) + (error "Use `e' to edit this field.")) + (while bbdb-record + (let ((values (bbdb-field-edit-get-values (car bbdb-record) field))) + (cond + (current-prefix-arg + (let (nvalues found) + (while values + (if (string-match value (car values)) + (setq found t) + (setq nvalues (cons (car values) nvalues))) + (setq values (cdr values))) + (if found + (bbdb-field-edit-put-values (car bbdb-record) field + (nreverse nvalues))))) + (t + (if (member value values) + (bbdb-field-edit-put-values (car bbdb-record) field + (delete value values)))))) + (setq bbdb-record (cdr bbdb-record)))) + +;;; The key binding might be moved to somewhere else. + +(define-key bbdb-mode-map [(insert)] 'bbdb-field-edit-add) +(define-key bbdb-mode-map [(delete)] 'bbdb-field-edit-del) + +(provide 'bbdb-edit) + +;; bbdb-edit.el ends here diff --git a/bits/bbdb-filters/COPYING.LIB b/bits/bbdb-filters/COPYING.LIB new file mode 100644 index 0000000..eb685a5 --- /dev/null +++ b/bits/bbdb-filters/COPYING.LIB @@ -0,0 +1,481 @@ + GNU LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +General Public License (also called "this License"). Each licensee is +addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also compile or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + c) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + d) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the source code distributed need not include anything that is normally +distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Library General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + <one line to give the library's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library 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 + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + <signature of Ty Coon>, 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/bits/bbdb-filters/README b/bits/bbdb-filters/README new file mode 100644 index 0000000..a88c2fc --- /dev/null +++ b/bits/bbdb-filters/README @@ -0,0 +1,64 @@ + +BBDB is a rolodex-like database program for GNU Emacs. +BBDB stands for Insidious Big Brother Database. BBDB is written by: +Jamie Zawinski <jwz@mcom.com>. My current version is 1.50. + +We have prepared a family of filters for BBDB. Currently the output +filters include: + + - bbdb --> emacs lisp exporting (for exchanging business cards) + - bbdb --> HP100/200 LX Phone Book + - bbdb --> PC Eudora Nicknames + - bbdb --> CC Mail Nicknames + - bbdb --> PH/QI + +There is presently only one input filter: + + - bbdb <-- UNIX passwd files + +We hope that over time a variety of other input and output filters +will be added to this collection. + + +bbdb-export in particular, can be very useful over the net. +It provides a convenient way for exchanging business cards. + + +This is a preliminary release. This stuff has not been tested much +outside of our office. We do use most of these filters on an going basis +and they work fine for us. + +To install, just edit the makefile and run "make install". + +To run them, read the comments on top of each filter file. + +There is very skimpy documentation in latexinfo format. It is just +meant to be a starting point. + +In addition to the attached shar file, +you can also ftp this package from: + //anonymous@ftp.neda.com:/pub/eoe/bbdbPlus/bbdb-filters-0.2.tar + URL = ftp://ftp.neda.com/pub/eoe/bbdbPlus/bbdb-filters-0.2.tar + +Many of the filters require bbdb-tex-print package by: +Boris Goldowsky <boris@prodigal.psych.rochester.edu>. + +The one that we use can be found in: + //anonymous@ftp.neda.com:/pub/eoe/bbdbPlus/bbdb-tex-3.0.tar + URL = ftp://ftp.neda.com/pub/eoe/bbdbPlus/bbdb-tex-3.0.tar + +You can checkout the overview of this package by +browsing the manual (latex/info/html) at: + URL = http://www.neda.com/eoe/bbdbFilters/bbdbFilters.html + + +Send bug-reports, comments and suggestions to: + Mohsen Banan-neda <mohsen@neda.com> +and refer to: + bbdb-filters RCS: README,v 1.2 1995/08/08 02:59:15 mohsen Exp + + +Hope you find this helpful. + +...Mohsen. + diff --git a/bits/bbdb-filters/bbdb-ccmail.el b/bits/bbdb-filters/bbdb-ccmail.el new file mode 100644 index 0000000..d8ce4d9 --- /dev/null +++ b/bits/bbdb-filters/bbdb-ccmail.el @@ -0,0 +1,118 @@ +;;; This file is part of the BBDB Filters Package. BBDB Filters Package is a +;;; collection of input and output filters for BBDB. +;;; +;;; Copyright (C) 1995 Neda Communications, Inc. +;;; Prepared by Mohsen Banan (mohsen@neda.com) +;;; +;;; This library is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Library General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. This library 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 Library General Public +;;; License for more details. You should have received a copy of the GNU +;;; Library General Public License along with this library; if not, write +;;; to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, +;;; USA. +;;; +;;; This is bbdb-eudora.el +;;; +;;; +;;; RCS: bbdb-ccmail.el,v 1.1.1.1 1995/08/07 08:43:09 mohsen Exp +;;; +;;; a copy-and-edit job on bbdb-print.el + +;;; To use this, add the following to your .emacs +;;; and strip ";;;XXX" +;;; + +;;;XXX;; BBDB Filters +;;;XXX(load "bbdb-ccmail") + +;;;XXX(setq bbdb-ccmail-filename "~/privdir.ini") +;;;XXX;;; And then +;;;XXX;;; (bbdb-ccmail-output) + +;;; TODO +;;; Make the postoffice name optional as an argument +;;; + +(require 'bbdb-print) + +(defvar bbdb-ccmail-filename "~/privdir.ini" + "*Default file name for bbdb-output-ccmail printouts of BBDB database.") + +(defun bbdb-ccmail-output (to-file) + "Print the selected BBDB entries" + (interactive (list (read-file-name "Print To File: " bbdb-ccmail-filename))) + (setq bbdb-ccmail-filename (expand-file-name to-file)) + (let ((current-letter t) + (records (progn (set-buffer bbdb-buffer-name) + bbdb-records))) + (find-file bbdb-ccmail-filename) + (delete-region (point-min) (point-max)) + (let* ((ccmail-count 0)) + (while records + (setq current-letter + (boe-ccmail-format-record (car (car records)) + current-letter)) + (setq records (cdr records))) + (goto-char (point-min)) + (insert (format "[smtpgate]
\nEntryCount=%d
\n" ccmail-count)) + (goto-char (point-min))))) + +(defun boe-ccmail-output-this-record-p (name net) + "Examine NAME COMP NET PHONES ADDRS NOTES and return t if +the current record is to be output by bbdb-output-ccmail." + ;; if name is non-nil, output it + (cond ((and name net) t) + (t nil)) + ) + + +(defun boe-ccmail-format-record (record &optional current-letter brief) + "Insert the bbdb RECORD in Ccmail format. +Optional CURRENT-LETTER is the section we're in -- if this is non-nil and +the first letter of the sortkey of the record differs from it, a new section +heading will be output \(an arg of t will always produce a heading). +The new current-letter is the return value of this function. +Someday, optional third arg BRIEF will produce one-line format." + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "plus ungood: tex formatting deleted record"))) + + (let* ((bbdb-elided-display bbdb-print-elide) + (first-letter + (substring (concat (bbdb-record-sortkey record) "?") 0 1)) + (name (and (bbdb-field-shown-p 'name) + (or (bbdb-record-getprop record 'tex-name) + (bbdb-print-tex-quote + (bbdb-record-name record))))) + (net (and (bbdb-field-shown-p 'net) + (bbdb-record-net record))) + (begin (point)) + ) + + (if (and current-letter + (not (string-equal first-letter current-letter))) + (message "Now processing \"%s\" entries..." (upcase first-letter))) + + (if (boe-ccmail-output-this-record-p name net) + (progn + + ;; Email address -- just use their first address. + ;; Make all dots legal line-breaks. + ;; + ;; output in the following format: "<Pretty Name>" <email address> + (if net + (let ((net-addr (car net)) + (start 0)) + (setq ccmail-count (+ ccmail-count 1)) + (insert (format "Entry%d=" ccmail-count)) + (insert (format "\"%s\" <%s>
\n" name net-addr)))) + (setq current-letter first-letter)) + ) + + ;; return current letter + current-letter)) + diff --git a/bits/bbdb-filters/bbdb-eudora.el b/bits/bbdb-filters/bbdb-eudora.el new file mode 100644 index 0000000..2c2f848 --- /dev/null +++ b/bits/bbdb-filters/bbdb-eudora.el @@ -0,0 +1,284 @@ +;;; This file is part of the BBDB Filters Package. BBDB Filters Package is a +;;; collection of input and output filters for BBDB. +;;; +;;; Copyright (C) 1995 Neda Communications, Inc. +;;; Prepared by Mohsen Banan (mohsen@neda.com) +;;; +;;; This library is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Library General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. This library 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 Library General Public +;;; License for more details. You should have received a copy of the GNU +;;; Library General Public License along with this library; if not, write +;;; to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, +;;; USA. +;;; +;;; This is bbdb-eudora.el +;;; +;;; +;;; RCS: bbdb-eudora.el,v 1.1.1.1 1995/08/07 08:43:09 mohsen Exp +;;; +;;; a copy-and-edit job on bbdb-print.el + +;;; To use this, add the following to your .emacs +;;; and strip ";;;XXX" +;;; + +;;;XXX;; BBDB Filters +;;;XXX(load "bbdb-eudora") + +;;;XXX(setq bbdb-eudora-nndbase-filename +;;;XXX (concat "/dos/m/eudora.mai/" (user-login-name) "/nndbase.txt")) +;;;XXX;;; And then +;;;XXX;; (bbdb-eudora-nndbase-output) + +;;;XXX(setq bbdb-eudora-rcpdbase-filename +;;;XXX (concat "/dos/m/eudora.mai/" (user-login-name) "/rcpdbase.txt")) +;;;XXX;;; And then +;;;XXX;; (bbdb-eudora-rcpdbase-output) + +(require 'bbdb-print) +(require 'basic-ext) + +(defvar bbdb-eudora-nndbase-filename "~/nndbase.txt" + "*Default file name for bbdb-output-eudora printouts of BBDB database.") + +(defun bbdb-eudora-nndbase-output (to-file) + "Print the selected BBDB entries" + (interactive (list (read-file-name "Print To File: " bbdb-eudora-nndbase-filename))) + (setq bbdb-eudora-nndbase-filename (expand-file-name to-file)) + (let ((current-letter t) + (records (progn (set-buffer bbdb-buffer-name) + bbdb-records))) + (find-file bbdb-eudora-nndbase-filename) + (delete-region (point-min) (point-max)) + (while records + (setq current-letter + (boe-format-record (car (car records)) current-letter)) + (setq records (cdr records))) + (goto-char (point-min)) + (message "Eudora nickname file %s generated." bbdb-eudora-nndbase-filename))) + +(defsubst boe-print-if-not-blank (string prepend-string &rest more) + "If STRING is not null, then return it with PREPEND-STRING in front and concatenated +with rest of arguments. If it is null, then all arguments are +ignored and the null string is returned." + (if (or (null string) (equal "" string)) + "" + (apply 'concat prepend-string string more))) + +(defun boe-output-this-record-p (name comp net phones addrs notes) + "Examine NAME COMP NET PHONES ADDRS NOTES and return t if +the current record is to be output by bbdb-output-eudora." + ;; if name is non-nil, output it + (cond ((and name net) t) + (t nil)) + ) + + +(defun boe-format-record (record &optional current-letter brief) + "Insert the bbdb RECORD in Eudora format. +Optional CURRENT-LETTER is the section we're in -- if this is non-nil and +the first letter of the sortkey of the record differs from it, a new section +heading will be output \(an arg of t will always produce a heading). +The new current-letter is the return value of this function. +Someday, optional third arg BRIEF will produce one-line format." + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "plus ungood: formatting deleted record"))) + + (let* ((bbdb-elided-display bbdb-print-elide) + (first-letter + (substring (concat (bbdb-record-sortkey record) "?") 0 1)) + (name (and (bbdb-field-shown-p 'name) + (or (bbdb-record-getprop record 'tex-name) + (bbdb-record-name record)))) + (comp (and (bbdb-field-shown-p 'company) + (bbdb-record-company record))) + (net (and (bbdb-field-shown-p 'net) + (bbdb-record-net record))) + (phones (and (bbdb-field-shown-p 'phone) + (bbdb-record-phones record))) + (addrs (and (bbdb-field-shown-p 'address) + (bbdb-record-addresses record))) + (notes (bbdb-record-raw-notes record)) + (begin (point)) + (bare t)) + + ;; Section header, if neccessary. + + (if (and current-letter (not (string-equal first-letter current-letter))) + (message "Now processing \"%s\" entries..." (upcase first-letter))) + + (if (boe-output-this-record-p name comp net phones addrs notes) + (progn + + ;; Eudora nickname in canonical form (e.g., mohsen.banan) + ;; + (if name + (insert (format "<%s>
\n" name))) + + ;; Email address -- just use their first address. + ;; Make all dots legal line-breaks. + ;; + ;; output in the following format: "<Pretty Name>" <email address> + (if net + (let ((net-addr (car net)) + (start 0)) + (insert (format ">\"%s\" <%s>
\n" name net-addr)))) + + ;; start a Eudora nndbase.txt notes section for this nickname + ;; by inserting the nickname again + + (if name + (insert (format "<%s>
\n" name))) + + ;; Company + ;; + (if comp + (insert (format "> Company: %s
\n" + (boe-mangle-if-multi-line comp)))) + + ;; Phone numbers + ;; + (while phones + (let ((place (aref (car phones) 0)) + (number (bbdb-phone-string (car phones)))) + (setq bare nil) + (insert (format "> Telephone: %s%s
\n" + (boe-print-if-not-blank place "" ": ") + number)) + (setq phones (cdr phones)))) + + ;; Addresses + ;; + (while addrs + (let ((addr (car addrs))) + (setq bare nil) + (insert + (format + "> Address:
\n%s" + (concat + (boe-print-if-not-blank (bbdb-address-street1 addr) "> " "
\n") + (boe-print-if-not-blank (bbdb-address-street2 addr) "> " "
\n") + (boe-print-if-not-blank (bbdb-address-street3 addr) "> ") + (boe-print-if-not-blank (bbdb-address-city addr) "> ") + (if (and (not (equal "" (bbdb-address-city addr))) + (not (equal "" (bbdb-address-state addr)))) + ", ") + (boe-print-if-not-blank (bbdb-address-state addr) "" " ") + (boe-print-if-not-blank (bbdb-address-zip-string addr) "" "
\n"))))) + (setq addrs (cdr addrs))) + + ;; BBDB Notes + + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + (while notes + (let ((thisnote (car notes))) + (if (bbdb-field-shown-p (car thisnote)) + (progn + (setq bare nil) + (if (eq 'notes (car thisnote)) + (insert (format "> Notes: %s
\n" + (boe-mangle-if-multi-line (cdr thisnote)))) + (insert (format "> Note [%s]: %s
\n" + (symbol-name (car thisnote)) + (boe-mangle-if-multi-line (cdr thisnote)))))))) + (setq notes (cdr notes))) + + ;; If record is bare, delete anything we may have inserted. + ;; otherwise, mark the end of this record. + + (if bare + (delete-region begin (point)) + + (setq current-letter first-letter)) + + )) + + ;; return current letter + current-letter)) + + +(defun boe-mangle-if-multi-line (string) + "If STRING is has multiple lines, mangle it for output to Eudora" + (if (string-match "\n" string) + (string-replace-regexp string "\n" "
\n> ") + string)) + + +;;;;;;;;;;;; Eudora Receipient DataBase (rcpdbase.txt) ;;;;;;;;;;; + +;;;(setq bbdb-eudora-rcpdbase-filename "/dos/m/eudora.mai/mohsen/rcpdbase.txt") +(defvar bbdb-eudora-rcpdbase-filename "~/rcpdbase.txt" + "*Default file name for bbdb-output-eudora printouts of BBDB database.") + +(defun bbdb-eudora-rcpdbase-output (to-file) + "Print the selected BBDB entries" + (interactive (list (read-file-name "Print To File: " bbdb-eudora-rcpdbase-filename))) + (setq bbdb-eudora-rcpdbase-filename (expand-file-name to-file)) + (let ((current-letter t) + (records (progn (set-buffer bbdb-buffer-name) + bbdb-records))) + (find-file bbdb-eudora-rcpdbase-filename) + (delete-region (point-min) (point-max)) + (while records + (setq current-letter + (boe-rcpdbase-format-record (car (car records)) current-letter)) + (setq records (cdr records))) + (goto-char (point-min)) + (message "Eudora rcpt. file %s generated." bbdb-eudora-nndbase-filename))) + + + +(defun boe-rcpdbase-format-record (record &optional current-letter brief) + "Insert the bbdb RECORD in Eudora format. +Optional CURRENT-LETTER is the section we're in -- if this is non-nil and +the first letter of the sortkey of the record differs from it, a new section +heading will be output \(an arg of t will always produce a heading). +The new current-letter is the return value of this function. +Someday, optional third arg BRIEF will produce one-line format." + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "plus ungood: formatting deleted record"))) + + (let* ((bbdb-elided-display bbdb-print-elide) + (first-letter + (substring (concat (bbdb-record-sortkey record) "?") 0 1)) + (name (and (bbdb-field-shown-p 'name) + (or (bbdb-record-getprop record 'tex-name) + (bbdb-record-name record)))) + (comp (and (bbdb-field-shown-p 'company) + (bbdb-record-company record))) + (net (and (bbdb-field-shown-p 'net) + (bbdb-record-net record))) + (phones (and (bbdb-field-shown-p 'phone) + (bbdb-record-phones record))) + (addrs (and (bbdb-field-shown-p 'address) + (bbdb-record-addresses record))) + (notes (bbdb-record-raw-notes record)) + (begin (point)) + (bare t)) + + ;; Section header, if neccessary. + + (if (and current-letter + (not (string-equal first-letter current-letter))) + (message "Now processing \"%s\" entries..." (upcase first-letter))) + + (if (boe-output-this-record-p name comp net phones addrs notes) + (progn + + ;; Eudora nickname in canonical form (e.g., mohsen.banan) + ;; + (if name + (insert (format "%s
\n" name))) + + (setq current-letter first-letter) + + )) + + ;; return current letter + current-letter)) diff --git a/bits/bbdb-filters/bbdb-export.el b/bits/bbdb-filters/bbdb-export.el new file mode 100644 index 0000000..279238a --- /dev/null +++ b/bits/bbdb-filters/bbdb-export.el @@ -0,0 +1,140 @@ +;;; This file is part of the BBDB Filters Package. BBDB Filters Package is a +;;; collection of input and output filters for BBDB. +;;; +;;; Copyright (C) 1995 Neda Communications, Inc. +;;; Prepared by Mohsen Banan (mohsen@neda.com) +;;; +;;; This library is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Library General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. This library 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 Library General Public +;;; License for more details. You should have received a copy of the GNU +;;; Library General Public License along with this library; if not, write +;;; to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, +;;; USA. +;;; +;;; This is bbdb-export.el +;;; + +(defvar bbdb-export-buffer-name "*BBDB* Export" + "*Default buffer name for exporting the contents of the *BBDB* buffer.") + + +(defvar bbdb-export-compactly nil + "If nil, the exported records are compactly printed. +Otherwise the exported forms are indented for human-readability (at a +cost of somewhat longer processing time for exporting records. +The default value is nil.") + + +(defun bbdb-export () + "Print the selected BBDB entries" + (interactive) + (save-excursion + (let ((to-buffer (get-buffer-create bbdb-export-buffer-name)) + (records (progn (set-buffer bbdb-buffer-name) + bbdb-records)) + (current-letter "")) + ;; wipe to-buffer + (switch-to-buffer to-buffer) + (delete-region (point-min) (point-max)) + + ;; insert header, records, trailer + (bexp-buffer-insert-header) + (while records + (setq current-letter (bexp-do-record (car (car records)) current-letter)) + (setq records (cdr records))) + (bexp-buffer-insert-trailer) + + (goto-char (point-min)) + (search-forward "(progn") + (search-backward "(progn") + (indent-sexp) + )) + (message "BBDB export buffer %s generated." bbdb-export-buffer-name)) + + +(defun bexp-do-record (record current-letter) + "Insert the bbdb RECORD in export format." + (let* ((name (bbdb-record-name record)) + (comp (bbdb-record-company record)) + (net (bbdb-record-net record)) + (phones (bbdb-record-phones record)) + (addrs (bbdb-record-addresses record)) + (notes (bbdb-record-raw-notes record)) + (first-letter (upcase (substring (concat (bbdb-record-sortkey record) "?") 0 1)))) + + (if (not (string-equal first-letter current-letter)) + (progn (message "Now processing \"%s\" entries..." first-letter) + (sleep-for 1))) + (bexp-buffer-insert-record name comp net addrs phones notes) + first-letter)) + + +(defun bexp-buffer-insert-header() + (insert ";;; ======= Start of Exported BBDB Records =======\n") + (insert "(progn +(require 'bbdb-com) +(defun bbdb-maybe-create (name company net &optional addrs phones notes) + \"Try to add a record to BBDB if it does not already exist.\" + (condition-case err + (progn + (bbdb-create-internal name company net addrs phones notes) + (message \"%s %s added.\" name (if net (concat \"<\" net \">\") \"\")) + (sleep-for 1)) + (error (ding) + (message \"%s %s skipped. (%s)\" + name + (if net (concat \"<\" net \">\") \"\") + (car (cdr err))) + (sleep-for 1))))\n\n") + (normal-mode)) + + +(defun bexp-buffer-insert-trailer() + (insert ")\n") + (insert ";;; ======= End of Exported BBDB Records =======\n")) + + +(defun bexp-buffer-insert-record (name comp net addrs phones notes) + (let ((begin (point)) + end) + (message "Exporting %s" name) + (insert (format "(bbdb-maybe-create %s %s '%s '%s '%s '%s)\n" + (prin1-to-string (concat name "--IMPORTED")) + (prin1-to-string comp) + (prin1-to-string net) + (prin1-to-string addrs) + (prin1-to-string phones) + (prin1-to-string notes) + )) + (setq end (point)) + (if (not bbdb-export-compactly) + (progn + ;; format region + (narrow-to-region begin end) + (goto-char begin) + (replace-string " '(" "\n'(") + (goto-char begin) + (replace-string "\" \"" "\"\n\"") + (goto-char begin) + (replace-string "((" "(\n(") + (goto-char begin) + (replace-string "))" ")\n)") + (goto-char begin) + (replace-string "([" "(\n[") + (goto-char begin) + (replace-string "])" "]\n)") + (goto-char begin) + (replace-string ") (" ")\n(") + (goto-char begin) + (replace-string "] [" "]\n[") + (goto-char (point-max)) + (lisp-indent-region begin (point)) + (widen))) + )) + +(provide 'bbdb-export) diff --git a/bits/bbdb-filters/bbdb-hp200lx.el b/bits/bbdb-filters/bbdb-hp200lx.el new file mode 100644 index 0000000..fe3f00a --- /dev/null +++ b/bits/bbdb-filters/bbdb-hp200lx.el @@ -0,0 +1,348 @@ +;;; This file is part of the BBDB Filters Package. BBDB Filters Package is a +;;; collection of input and output filters for BBDB. +;;; +;;; Copyright (C) 1995 Neda Communications, Inc. +;;; Prepared by Mohsen Banan (mohsen@neda.com) +;;; +;;; This library is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Library General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. This library 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 Library General Public +;;; License for more details. You should have received a copy of the GNU +;;; Library General Public License along with this library; if not, write +;;; to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, +;;; USA. +;;; +;;; This is bbdb-hp200lx.el +;;; +;;; +;;; RCS: bbdb-hp200lx.el,v 1.1.1.1 1995/08/07 08:43:09 mohsen Exp +;;; +;;; a copy-and-edit job on bbdb-print.el + + +;;; To use this, add the following to your .emacs +;;; and strip ";;;XXX" +;;; + +;;;XXX;; BBDB HP200LX Filter +;;;XXX(load "bbdb-hp200lx") + +;;;XXX(setq bbdb-hp200lx-filename +;;;XXX (concat "/dos/u/" (user-login-name) "/bb-phone.cdf")) +;;;XXX;;; - to output the *BBDB* buffer in HP200LX comma-delimited-file (.CDF) +;;;XXX;;; format, invoke M-x bbdb-hp200lx-output +;;;XXX;;; +;;;XXX;;; - you may also want to modify default values of the following (use +;;;XXX;;; M-x describe-variable for details): +;;;XXX;;; bbdb-hp200lx-output-elide +;;;XXX;;; bbdb-hp200lx-output-requires +;;;XXX;;; bbdb-hp200lx-output-no-bare-names + + +(require 'bbdb-print) +(require 'basic-ext) + + +(defvar bbdb-hp200lx-filename "~/bb-phone.cdf" + "*Default file name for bbdb-output-hp200lx printouts of BBDB database.") + + +(defvar bbdb-hp200lx-output-elide '(net creation-date timestamp mail-alias) + "*List of symbols denoting BBDB fields NOT to be output. +Valid symbols are: name comp net phones addrs. You can also use the +tags for notes (e.g., creation-date). + e.g.: '(net creation-date) +See also variable bbdb-hp200lx-output-requires.") + + +(defvar bbdb-hp200lx-output-requires '(or name comp) + "*A boolean expression of 'and' and 'or' to be evaluated to determine if +the current record should be output. Valid symbols for use +in the boolean expression are: name comp net phones addrs notes. + e.g.: (and name (or comp addrs)) +See also variable bbdb-hp200lx-output-elide. +") + + +(defvar bbdb-hp200lx-output-no-bare-names t + "*A bare name is one with no information other than +that in bbdb-hp200lx-output-requires. To avoid printing +these set this variable to t") + + +(defun bbdb-hp200lx-output (to-file) + "Print the selected BBDB entries" + (interactive (list (read-file-name "Print To File: " bbdb-hp200lx-filename))) + (setq bbdb-hp200lx-filename (expand-file-name to-file)) + (let ((current-letter t) + (records (progn (set-buffer bbdb-buffer-name) + bbdb-records))) + (find-file bbdb-hp200lx-filename) + (delete-region (point-min) (point-max)) + (while records + (setq current-letter + (boh-maybe-format-record (car (car records)) current-letter)) + (setq records (cdr records))) + (goto-char (point-min)) + (message "HP 200LX comma-delimited phonebook file %s generated." bbdb-hp200lx-filename))) + + +(defun boh-maybe-format-record (record &optional current-letter brief) + "Insert the bbdb RECORD in Hp200lx format. +Optional CURRENT-LETTER is the section we're in -- if this is non-nil and +the first letter of the sortkey of the record differs from it, a new section +heading will be output \(an arg of t will always produce a heading). +The new current-letter is the return value of this function. +Someday, optional third arg BRIEF will produce one-line format." + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "plus ungood: formatting deleted record"))) + + + (let* ((bbdb-elided-display bbdb-hp200lx-output-elide) + (first-letter + (substring (concat (bbdb-record-sortkey record) "?") 0 1)) + (name (and (bbdb-field-shown-p 'name) + (or (bbdb-record-getprop record 'tex-name) + (bbdb-record-name record)))) + (comp (and (bbdb-field-shown-p 'company) + (bbdb-record-company record))) + (net (and (bbdb-field-shown-p 'net) + (bbdb-record-net record))) + (phones (and (bbdb-field-shown-p 'phone) + (bbdb-record-phones record))) + (addrs (and (bbdb-field-shown-p 'address) + (bbdb-record-addresses record))) + (notes (bbdb-record-raw-notes record)) + (begin (point)) + (bare t)) + + + ;; Section header, if neccessary. + + + (if (and current-letter (not (string-equal first-letter current-letter))) + (message "Now processing \"%s\" entries..." (upcase first-letter))) + + + (if (eval bbdb-hp200lx-output-requires) + (let (more-phones) + + + ;; HP 200LX last name field (maxlen 86 ??) -- used for BBDB name + ;; + (insert (format "\"%s\"," (boh-maybe-truncate name 86))) + + + ;; HP 200LX first name field (maxlen ??) -- unused + (insert ",") + + + ;; HP 200LX middle name field (maxlen ??) -- unused + ;; + (insert ",") + + + ;; Phone numbers + ;; + (let (business-phone home-phone fax-phone saved-case-fold) + (setq saved-case-fold case-fold-search + case-fold-search t) + (while phones + (let ((place (aref (car phones) 0)) + (number (bbdb-phone-string (car phones)))) + (cond ((or (string-match place "office") + (string-match place "work")) + (if (null business-phone) + (setq business-phone (list place number)) + (setq more-phones (cons (list place number) more-phones)))) + ((string-match place "home") + (if (null home-phone) + (setq home-phone (list place number)) + (setq more-phones (cons (list place number) more-phones)))) + ((or (string-match place "fax") + (string-match place "facsimile")) + (if (null fax-phone) + (setq fax-phone (list place number)) + (setq more-phones (cons (list place number) more-phones)))) + (t + (setq more-phones (cons (list place number) more-phones))))) + (setq phones (cdr phones))) + + + (setq case-fold-search saved-case-fold) + + + ;; HP 200LX business phone field (maxlen 29) + (if business-phone + (progn + (insert (format "\"%s\"," (boh-maybe-truncate + (format "%s" (car (cdr business-phone))) + 29))) + (setq bare nil)) + (insert ",")) + + + ;; HP 200LX home phone field (maxlen 29) + (if home-phone + (progn + (insert (format "\"%s\"," (boh-maybe-truncate + (format "%s" (car (cdr home-phone))) + 29))) + (setq bare nil)) + (insert ",")) + + + ;; HP 200LX alternate phone field (maxlen 29) -- unused + (insert ",") + + + ;; HP 200LX fax phone field (maxlen 29) + (if fax-phone + (progn + (insert (format "\"%s\"," (boh-maybe-truncate + (format "%s" (car (cdr fax-phone))) ; the description + 29))) + (setq bare nil)) + (insert ",")) + ) + + + ;; HP 200LX title field (maxlen 38) -- unused + (insert ",") + + + ;; HP 200LX category field (maxlen 127) -- unused + (insert ",") + + + ;; HP 200LX company field (maxlen 82) -- used for BBDB company + (if comp + (insert (format "\"%s\"," (boh-maybe-truncate comp 82))) + (insert ",")) + + + ;; Addresses + ;; + (let ((addr (car addrs)) ;just take the first bbdb address + hp-addr1 hp-addr2 hp-city hp-state hp-zip) + + (if addr + (progn + (setq hp-addr1 (bbdb-address-street1 addr)) + (setq hp-addr2 (concat (bbdb-address-street2 addr) + (if (and (> (length (bbdb-address-street2 addr)) 0) + (> (length (bbdb-address-street3 addr)) 0)) + ", " "") + (bbdb-address-street3 addr))) + (setq hp-city (bbdb-address-city addr)) + (setq hp-state (bbdb-address-state addr)) + (setq hp-zip (bbdb-address-zip-string addr)))) + + ;; HP 200LX address 1 field (maxlen 82) + (if hp-addr1 + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-addr1 82))) + (setq bare nil)) + (insert ",")) + + ;; HP 200LX address 2 field (maxlen 82) + (if hp-addr2 + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-addr2 82))) + (setq bare nil)) + (insert ",")) + + ;; HP 200LX city field (maxlen 34) + (if hp-city + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-city 34))) + (setq bare nil)) + (insert ",")) + + ;; HP 200LX state field (maxlen 39) + (if hp-state + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-state 39))) + (setq bare nil)) + (insert ",")) + + ;; HP 200LX zip field (maxlen 16) + (if hp-zip + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-zip 16))) + (setq bare nil)) + (insert ",")) + ) + + ;; BBDB Notes + + (let (hp-note) + (save-excursion + (set-buffer (get-buffer-create " *boh-scratch*")) + (kill-region (point-min) (point-max)) + + (while more-phones + (insert (format "%s: %s\t" + (car (car more-phones)) ; the tag + (car (cdr (car more-phones)))) ; the number + ) + (setq bare nil) + (setq more-phones (cdr more-phones))) + + ;; output BBDB email-addresses + (while net + (insert (format "%s\t" (car net))) + (setq bare nil) + (setq net (cdr net))) + + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + + (while notes + (let ((thisnote (car notes))) + (if (bbdb-field-shown-p (car thisnote)) + (progn + (setq bare nil) + (if (eq 'notes (car thisnote)) + (insert (format "Notes: %s\t" (boh-mangle-if-multi-line (cdr thisnote)))) + (insert (format "Note [%s]: %s\t" + (symbol-name (car thisnote)) + (boh-mangle-if-multi-line (cdr thisnote)))))))) + (setq notes (cdr notes))) + + (setq hp-note (buffer-string))) + + ;; HP 200LX notes field (32K for the entire record) + (if (> (length hp-note) 0) + (progn + (insert (format "\"%s\"" hp-note)) + (setq bare nil))) + ) + + ;; If record is bare, delete anything we may have inserted. + ;; otherwise, mark the end of this record. + (if (and bare bbdb-hp200lx-output-no-bare-names) + (delete-region begin (point)) + (insert "
\n")) ; HP 200LX end of record + )) + + ;; return current letter + current-letter)) + + +(defun boh-maybe-truncate (string maxlen) + "If STRING is longer than MAXLEN, returns a truncated version." + (if (> (length string) maxlen) + (substring string 0 maxlen) + string)) + + +(defun boh-mangle-if-multi-line (string) + "If STRING is has multiple lines, mangle it for output to HP200LX" + (if (string-match "\n" string) + (string-replace-regexp string "\n" "\t") ; tabs are used to denote new lines in the .cdf file + string)) diff --git a/bits/bbdb-filters/bbdb-passwd.el b/bits/bbdb-filters/bbdb-passwd.el new file mode 100644 index 0000000..74dc8fd --- /dev/null +++ b/bits/bbdb-filters/bbdb-passwd.el @@ -0,0 +1,192 @@ +;;; This file is part of the BBDB Filters Package. BBDB Filters Package is a +;;; collection of input and output filters for BBDB. +;;; +;;; Copyright (C) 1995 Neda Communications, Inc. +;;; Prepared by Mohsen Banan (mohsen@neda.com) +;;; +;;; This library is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Library General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. This library 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 Library General Public +;;; License for more details. You should have received a copy of the GNU +;;; Library General Public License along with this library; if not, write +;;; to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, +;;; USA. + +;;; This is bbdb-passwd.el + +;;; This file is a bbdb filter. It converts passwd files to the +;;; canonical bbdb input filter format (i.e., a file of +;;; bif-create-record expressions + + +(defvar bpf-default-bif-file "~/passwd-bif.el" + "*Default file name for bbdb-passwd-input.") + + +(defvar bpf-default-domain-name (if (boundp '*eoe-site-name*) *eoe-site-name*) + "*Default domain name for bbdb-passwd-input.") + + +(defvar bpf-default-org-name (if (boundp 'gnus-local-organization) gnus-local-organization + bpf-default-domain-name) + "*Default organization name for bbdb-passwd-input.") + + +(defvar bpf-omit-uid-limit 100 + "Skip UIDs below this value. Default is 100.") + +(defvar bpf-omit-user-name-regexp "\\(sl-\\\|guest\\)" + "Skip usernames that match this regular expression. +E.g., \"\\\\(sl-\\\\\\|guest\\\\)\" +") + +(defvar bpf-omit-user-name-list '("nobody" "noaccess") + "Skip usernames in this list. +E.g., '(\"noaccess\" \"nobody\") +") + +(defvar bpf-omit-pretty-name-regexp "\\(Slip \\\|Listserv\\\|PPP\\)" + "Skip pretty names that match this regular expression. +E.g., \"\\\\(Slip \\\\\\|Listserv\\\\\\|PPP\\\\)\" +") + +(defvar bpf-omit-pretty-name-list '() + "Skip pretty names that match this regular expression. +E.g., '(\"John Q. Public\") +") + + +(defun bbdb-passwd-input (domain-name org-name to-file) + "Parse current buffer which contains a UNIX passwd file to generate a .bif format file" + (interactive (list (setq bpf-default-domain-name (read-string "Domain name: " + bpf-default-domain-name)) + (setq bpf-default-org-name (read-string "Organization name: " + bpf-default-org-name)) + (setq bpf-default-bif-file + (read-file-name "Output To File: " + (concat + (file-name-directory bpf-default-bif-file) + (concat "bif-" bpf-default-domain-name ".el")) + (concat + (file-name-directory bpf-default-bif-file) + (concat "bif-" bpf-default-domain-name ".el")))))) + (let (to-buffer) + (save-excursion + (message (expand-file-name to-file)) + (set-buffer (find-file (expand-file-name to-file))) + (delete-region (point-min) (point-max)) + (bif-buffer-insert-header) + (setq to-buffer (current-buffer))) + + ;; walk the passwd file in the current buffer + (goto-char (point-min)) + (while (not (eobp)) + (beginning-of-line) + (bpf-parse-line domain-name org-name to-buffer) + (forward-line 1)) + + (message "Done.") + (set-buffer to-buffer) + )) + + +(defun bif-buffer-insert-header () + (insert "(require 'bbdb-passwd)\n\n")) + + +(defun bif-buffer-insert-record (pretty-name org-name email) + (insert (format "(bif-create-record")) + + (insert (format " \"%s\"" pretty-name)) ; NAME string + + (insert (format " \"%s\"" org-name)) ; COMPANY is a string or nil + + (insert (format " \"%s\"" email)) ; NET is a comma-separated list of email address, + ; or a list of strings + + ;; (insert " nil") ; ADDRS is a list of address objects. + ; An address is a vector of the form + ; ["location" "line1" "line2" "line3" "City" "State" zip] + + ;; (insert " nil") ; PHONES is a list of phone-number objects. + ; A phone-number is a vector of the form + ; ["location" areacode prefix suffix extension-or-nil] + ; or + ; ["location" "phone-number"] + + ;; (insert " nil") ; NOTES is a string, or an alist associating symbols with + ; strings. + + (insert ")\n") + ) + +(defun bpf-parse-line (domain-name org-name to-buffer) + "Parse the passwd file line. Point is assumed to be at the beginning of line." + (let (record-string uid user-name pretty-name email) + (setq record-string (buffer-substring (point) + (progn (end-of-line) (point)))) + + (message "Processing record: %s" record-string) + + ;; (setq record-string "mohsen:x:100:10:Mohsen Banan:/home/arash/mohsen:/bin/csh") + + ;; check for a valid and qualifying uid on line, else skip + (cond ((and + ;; + ;; extract and test uid + ;; + (string-match "^\\w*:\\w*:\\([0-9]+\\):" record-string) + (setq uid (read (substring record-string + (match-beginning 1) + (match-end 1)))) + (>= uid bpf-omit-uid-limit) + ;; + ;; extract and test user name + ;; + (string-match "^\\([^:]+\\):" record-string) + (setq user-name (substring record-string (match-beginning 1) (match-end 1))) + (or (null bpf-omit-user-name-regexp) + (not (string-match bpf-omit-user-name-regexp user-name))) + (or (null bpf-omit-user-name-list) + (not (member user-name bpf-omit-user-name-list))) + ;; + ;; extract and test pretty name + ;; + (string-match "^[^:]*:[^:]*:[^:]*:[^:]*:\\([^:]+\\):" record-string) + (setq pretty-name (substring record-string (match-beginning 1) (match-end 1))) + (or (null bpf-omit-pretty-name-regexp) + (not (string-match bpf-omit-pretty-name-regexp pretty-name))) + (or (null bpf-omit-pretty-name-list) + (not (member pretty-name bpf-omit-pretty-name-list))) + ) + + ;; synthesize email address + (setq email (concat user-name "@" domain-name)) + + ;; output bif record + (save-excursion + (set-buffer to-buffer) + (bif-buffer-insert-record pretty-name org-name email) + ) + ) + (t + ;; not a valid line, skip + nil)) + )) + +(defun bif-create-record (name company net &optional addrs phones notes) + "Try to add a record to BBDB; if one does not already exist." + (condition-case err + (progn + (bbdb-create-internal name company net addrs phones notes) + (message "%s <%s> added." name net)) + (error (message "%s" (car (cdr err))) + (sleep-for 1)))) + + +(provide 'bbdb-passwd) + diff --git a/bits/bbdb-filters/bbdb-ph.el b/bits/bbdb-filters/bbdb-ph.el new file mode 100644 index 0000000..fc21502 --- /dev/null +++ b/bits/bbdb-filters/bbdb-ph.el @@ -0,0 +1,253 @@ +;;; This file is part of the BBDB Filters Package. BBDB Filters Package is a +;;; collection of input and output filters for BBDB. +;;; +;;; Copyright (C) 1995 Neda Communications, Inc. +;;; Prepared by Mohsen Banan (mohsen@neda.com) +;;; +;;; This library is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Library General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. This library 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 Library General Public +;;; License for more details. You should have received a copy of the GNU +;;; Library General Public License along with this library; if not, write +;;; to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, +;;; USA. +;;; +;;; This is bbdb-ph.el +;;; +;;; +;;; RCS: bbdb-ph.el,v 1.1.1.1 1995/08/07 08:43:08 mohsen Exp +;;; +;;; a copy-and-edit job on bbdb-print.el + + +;;; To use this, add the following to your .emacs +;;; and strip ";;;XXX" +;;; + +;;;XXX;; BBDB PH Filter +;;;XXX(load "bbdb-ph") + +;;;XXX(setq bbdb-ph-filename +;;;XXX (concat "/dos/u/" (user-login-name) "/bb-phone.cdf")) +;;;XXX;;; - to output the *BBDB* buffer in PH tab-delimited-file (.CDF) +;;;XXX;;; format, invoke M-x bbdb-ph-output +;;;XXX;;; +;;;XXX;;; - you may also want to modify default values of the following (use +;;;XXX;;; M-x describe-variable for details): +;;;XXX;;; bbdb-ph-output-elide +;;;XXX;;; bbdb-ph-output-requires +;;;XXX;;; bbdb-ph-output-no-bare-names + + +(require 'bbdb-print) +(require 'basic-ext) + + +(defvar bbdb-ph-filename "~/data.out" + "*Default file name for bbdb-output-ph printouts of BBDB database.") + + +(defvar bbdb-ph-output-elide '(creation-date timestamp mail-alias) + "*List of symbols denoting BBDB fields NOT to be output. +Valid symbols are: name comp net phones addrs. You can also use the +tags for notes (e.g., creation-date). + e.g.: '(net creation-date) +See also variable bbdb-ph-output-requires.") + + +(defvar bbdb-ph-output-requires '(and name net) + "*A boolean expression of 'and' and 'or' to be evaluated to determine if +the current record should be output. Valid symbols for use +in the boolean expression are: name comp net phones addrs notes. + e.g.: (and name (or comp addrs)) +See also variable bbdb-ph-output-elide. +") + + +(defvar bbdb-ph-output-no-bare-names t + "*A bare name is one with no information other than +that in bbdb-ph-output-requires. To avoid printing +these set this variable to t") + + +(defun bbdb-ph-output (to-file) + "Print the selected BBDB entries" + (interactive (list (read-file-name "Print To File: " bbdb-ph-filename))) + (setq bbdb-ph-filename (expand-file-name to-file)) + (let ((current-letter t) + (records (progn (set-buffer bbdb-buffer-name) + bbdb-records))) + (find-file bbdb-ph-filename) + (delete-region (point-min) (point-max)) + (while records + (setq current-letter + (boph-maybe-format-record (car (car records)) current-letter)) + (setq records (cdr records))) + (goto-char (point-min)) + (message "PH tag and tab-delimited file %s generated." bbdb-ph-filename))) + + +(defun boph-maybe-format-record (record &optional current-letter brief) + "Insert the bbdb RECORD in Ph format. +Optional CURRENT-LETTER is the section we're in -- if this is non-nil and +the first letter of the sortkey of the record differs from it, a new section +heading will be output \(an arg of t will always produce a heading). +The new current-letter is the return value of this function. +Someday, optional third arg BRIEF will produce one-line format." + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "plus ungood: formatting deleted record"))) + + (let* ((bbdb-elided-display bbdb-ph-output-elide) + (first-letter + (substring (concat (bbdb-record-sortkey record) "?") 0 1)) + (name (and (bbdb-field-shown-p 'name) + (or (bbdb-record-getprop record 'tex-name) + (bbdb-record-name record)))) + (comp (and (bbdb-field-shown-p 'company) + (bbdb-record-company record))) + (net (and (bbdb-field-shown-p 'net) + (bbdb-record-net record))) + (phones (and (bbdb-field-shown-p 'phone) + (bbdb-record-phones record))) + (addrs (and (bbdb-field-shown-p 'address) + (bbdb-record-addresses record))) + (notes (bbdb-record-raw-notes record)) + (begin (point)) + (bare t) + ph-name ph-email ph-office-phone ph-skypager ph-portable + ph-title-notes-part + saved-case-fold) + + + ;; Section header, if neccessary. + + (if (and current-letter (not (string-equal first-letter current-letter))) + (message "Now processing \"%s\" entries..." (upcase first-letter))) + + + (if (eval bbdb-ph-output-requires) + (progn + + ;; ============================================================= + ;; grovel through BBDB record collecting ph-relevant information + ;; ============================================================= + + ;; grovel through name + ;; + (setq ph-name name) + + ;; grovel through phone numbers + ;; + (progn + (setq saved-case-fold case-fold-search + case-fold-search t) + (while phones + (let ((place (aref (car phones) 0)) + (number (bbdb-phone-string (car phones)))) + (cond ((or (string-match place "office") + (string-match place "work")) + (if (null ph-office-phone) + (setq ph-office-phone number))) + ((or (string-match place "mobile") + (string-match place "cellular")) + (if (null ph-portable) + (setq ph-portable number))) + (t nil))) + (setq phones (cdr phones))) + + + (setq case-fold-search saved-case-fold) + ) + + ;; grovel through BBDB email-addresses + ;; + (if net + (setq ph-email (car net))) + + ;; grovel through BBDB Notes + ;; + (progn + + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + + (while notes + (let ((curr-note (car notes))) + (if (bbdb-field-shown-p (car curr-note)) + (cond ((member (car curr-note) '(skypage pager)) + (setq ph-skypager (boph-mangle-if-multi-line (cdr curr-note)))) + ((equal (car curr-note) 'mobile) + (setq ph-portable (boph-mangle-if-multi-line (cdr curr-note)))) + ((equal (car curr-note) 'notes) + (setq ph-title-notes-part (boph-mangle-if-multi-line (cdr curr-note)))) + (t nil)) + )) + (setq notes (cdr notes))) + ) + + ;; grovel through comp + ;; + (setq ph-title-coname-part comp) + (setq ph-title (concat (or ph-title-coname-part "") + (if (and ph-title-coname-part ph-title-notes-part) " " "") + (if ph-title-notes-part (concat "[" ph-title-notes-part "]") ""))) + + ;; ==================== + ;; now output PH record + ;; ==================== + + ;; PH 'name' field (maxlen 256) + ;; + (insert (format "3:%s\t" (boph-maybe-truncate (or name "") 256))) + + ;; PH 'email' field (maxlen 25) (should be 128?) ** NOT YET ** + (if ph-email (setq bare nil)) + (insert (format "2:%s\t" (boph-maybe-truncate (or ph-email "") 25))) + + ;; PH 'office_phone' field (max len 60) + ;; + (if ph-office-phone (setq bare nil)) + (insert (format "32:%s\t" (boph-maybe-truncate (or ph-office-phone "") 60))) + + ;; PH 'title' field (maxlen 120) + (insert (format "98:%s\t" (boph-maybe-truncate ph-title 120))) + + ;; PH 'portable' field (maxlen 60) + (if ph-portable (setq bare nil)) + (insert (format "97:%s\t" (boph-maybe-truncate (or ph-portable "") 60))) + + ;; PH 'skypager' field (maxlen 64) + (if ph-skypager (setq bare nil)) + (insert (format "27:%s\t" (boph-maybe-truncate (or ph-skypager "") 64))) + + ;; ========== + ;; bare check + ;; ========== + + ;; If record is bare, delete anything we may have inserted. + ;; otherwise, mark the end of this record. + (if (and bare bbdb-ph-output-no-bare-names) + (delete-region begin (point)) + (insert "\n")) ; PH end of record + )) + + ;; return current letter + current-letter)) + + +(defun boph-maybe-truncate (string maxlen) + "If STRING is longer than MAXLEN, returns a truncated version." + (if (> (length string) maxlen) + (substring string 0 maxlen) + string)) + + +(defun boph-mangle-if-multi-line (string) + "If STRING is has multiple lines, mangle it for output to PH" + (if (string-match "\n" string) + (string-replace-regexp string "\n" "\t") ; tabs are used to denote new lines in the .cdf file + string)) diff --git a/bits/bbdb-filters/doc/formatted/bbdb-filters.info b/bits/bbdb-filters/doc/formatted/bbdb-filters.info new file mode 100644 index 0000000..c66edef --- /dev/null +++ b/bits/bbdb-filters/doc/formatted/bbdb-filters.info @@ -0,0 +1,1101 @@ +Info file: bbdb-filters.info, -*-Text-*- +produced by latexinfo-format-buffer +from file: main.tex + + + +File: bbdb-filters.info Node: Top, Prev: (dir), Up: (dir), Next: Introduction + +{BBDB Filters} + +{6} + +Copyright (C)1995 NEDA COMMUNICATIONS, INC. + + +* Menu: + +* Introduction:: +* Output Filters:: +* Input Filters:: +* Miscellany:: +* GNU LIBRARY GENERAL PUBLIC LICENSE:: +* Concept Index:: +* Command Index:: + + --- The Detailed Node Listing --- + +Introduction + +* About This Package:: +* About This Manual:: + +Output Filters + +* HP 200LX Phone Book:: +* PC Eudora:: +* Lotus cc:Mail Nicknames:: +* PH:: +* Emacs Lisp Export:: + +PC Eudora + +* PC Eudora Nickname Database:: +* PC Eudora Recipient Database:: + +Input Filters + +* General Facilities for Input Filtering:: +* UNIX Password Files:: + +Miscellany + +* TODO List:: +* Credits:: + +GNU LIBRARY GENERAL PUBLIC LICENSE + +* Preamble:: +* TERMS AND CONDITIONS FOR COPYING:: * +* NO WARRANTY:: +* END OF TERMS AND CONDITIONS:: +* How to Apply These Terms to Your New Libraries:: + + + +File: bbdb-filters.info Node: Introduction, Prev: Top, Up: Top, Next: Output Filters + +Introduction +************ + + +Over time much valuable data has been gathered in BBDB database files. +Many wish to share parts or all of this information with others. They +also wish to have access to this same information from other systems +(like personal digital assistants) lacking straightforward BBDB +access. + +For these reasons, we have prepared a family of filters that convert +the information in BBDB to and from a variety of other +formats. "Output filters" export BBDB information to other formats +while "input filters" import information from other formats into +BBDB. + +Our hope is that over time this collection of BBDB filters will grow +through contributed code. + + +* Menu: + +* About This Package:: +* About This Manual:: + + + +File: bbdb-filters.info Node: About This Package, Prev: Introduction, Up: Introduction, Next: About This Manual + +About This Package +================== + + +This package is a collection of filters and is called "BBDB Input and +Output Filters". It has been somewhat tested with BBDB version 1.50. +The present state of the software is still preliminary although it has +proved useful. + + +File: bbdb-filters.info Node: About This Manual, Prev: About This Package, Up: Introduction + +About This Manual +================= + + +This documentation applies to Version 0.2 of the "BBDB Input and +Output Filters" package. The documentation is presently skeletal and +very preliminary. It mostly provides the user with instructions for +use, and very little background is included. Familiarity with Emacs +Lisp is assumed for some sections. + + +File: bbdb-filters.info Node: Output Filters, Prev: Introduction, Up: Top, Next: Input Filters + +Output Filters +************** + + +"Output filters" are used to export BBDB information into formats +used by other systems. + +In general, an output filter uses the contents of your +`*BBDB*' buffer as input. Note that output filters do not use +BBDB files (typically ``~/.bbdb'') directly. + +An output filter is invoked by executing its associated lisp function. +The name of the function is conventionally named `bbdb-<system>-output' +(e.g., `M-x bbdb-hp200lx-output'). + +The result of running an output filter is to create a new buffer that +contains the `*BBDB*' information appropriately transformed into a +format suitable for use by the target system. The new buffer is given +a file name that you specify. + + +* Menu: + +* HP 200LX Phone Book:: +* PC Eudora:: +* Lotus cc:Mail Nicknames:: +* PH:: +* Emacs Lisp Export:: + + + +File: bbdb-filters.info Node: HP 200LX Phone Book, Prev: Output Filters, Up: Output Filters, Next: PC Eudora + +HP 200LX Phone Book +=================== + + +This package has only been tested on HP 200LX palmtop systems. It +also requires the "HP 200LX Connectivity Pack" for converting +comma-delimited ASCII files into binary .PDB files which are read by +the HP 200LX Phone Book application. Version 1.00 of the "HP 200LX +Connectivty Pack" was used for testing. + +The HP 200LX output filter is in file `bbdb-hp200lx.el'. + + + + 1. Invoke `M-x bbdb' to populate the `*BBDB*' buffer + with the contents you wish to export. + + 2. Invoke ` bbdb-hp200lx-output' to create an ASCII .CDF + (Comma Delimited File). + + 3. Using Xlate/Merge option of HP Connectivity Pack convert the + .CDF file into a binary .PDB file used by the Phone Book program. + + 4. Download the .PDB file to your palmtop's internal disk and + ensure that the Phone Book program is set use the newly downloaded + .PDB file. + + + + +File: bbdb-filters.info Node: PC Eudora, Prev: HP 200LX Phone Book, Up: Output Filters, Next: Lotus cc:Mail Nicknames + +PC Eudora +========= + + +BBDB information can be exported to PC Eudora in two formats--as a +nickname database file and as a recipients database file. + +The PC Eudora output filter is in file `bbdb-eudora.el'. + +* Menu: + +* PC Eudora Nickname Database:: +* PC Eudora Recipient Database:: + + + +File: bbdb-filters.info Node: PC Eudora Nickname Database, Prev: PC Eudora, Up: PC Eudora, Next: PC Eudora Recipient Database + +PC Eudora Nickname Database +--------------------------- + + + + 1. Invoke `M-x bbdb' to populate the `*BBDB*' buffer + with the contents you wish to export. + + 2. Invoke `bbdb-eudora-nndbase-output' to create a PC Eudora + Nickname database file. + + 3. Make the file accessible to PC Eudora. + + + + +File: bbdb-filters.info Node: PC Eudora Recipient Database, Prev: PC Eudora Nickname Database, Up: PC Eudora + +PC Eudora Recipient Database +---------------------------- + + + + 1. Invoke `M-x bbdb' to populate the `*BBDB*' buffer + with the contents you wish to export. + + 2. Invoke `bbdb-eudora-rcpdbase-output' to create a PC Eudora + recipient's database file. + + 3. Make the file accessible to PC Eudora. + + + + +File: bbdb-filters.info Node: Lotus cc:Mail Nicknames, Prev: PC Eudora, Up: Output Filters, Next: PH + +Lotus cc:Mail Nicknames +======================= + + +The Lotus cc:Mail output filter is in file `bbdb-ccmail.el'. + + + 1. Invoke `M-x bbdb' to populate the `*BBDB*' buffer + with the contents you wish to export. + + 2. Invoke ` bbdb-ccmail-output' to create a cc:Mail Nicknames file. + + 3. Make the file accessible to cc:Mail. + + + + +File: bbdb-filters.info Node: PH, Prev: Lotus cc:Mail Nicknames, Up: Output Filters, Next: Emacs Lisp Export + +PH +== + + +The PH output filter is in file `bbdb-ph.el'. + + + 1. Invoke `M-x bbdb' to populate the `*BBDB*' buffer + with the contents you wish to export. + + 2. Invoke `bbdb-ph-output' to create a `ph' data file for + use with the `maked' program. + + 3. Make the file accessible to `ph'. + + + + +File: bbdb-filters.info Node: Emacs Lisp Export, Prev: PH, Up: Output Filters + +Emacs Lisp Export +================= + + +The Emacs Lisp Export output filter is in file `bbdb-export.el'. + +This output filter uses the current contents of your +`*BBDB*' buffer to generate a new buffer (`*BBDB* Export') +that contains a single lisp `(progn ...)' expression. For +example, a `*BBDB*' buffer containing two records would result in +the following `*BBDB* Export' buffer: + + + ;;; ======= Start of Exported BBDB Records ======= + (progn + (require 'bbdb-com) + (defun bbdb-maybe-create (name company net &optional addrs phones notes) + "Try to add a record to BBDB if it does not already exist." + (condition-case err + (progn + (bbdb-create-internal name company net addrs phones notes) + (message "%s %s added." name (if net (concat "<" net ">") "")) + (sleep-for 1)) + (error (ding) + (message "%s %s skipped. (%s)" + name + (if net (concat "<" net ">") "") + (car (cdr err))) + (sleep-for 1)))) + + (bbdb-maybe-create "Jill Doe--IMPORTED" + "CBS Corporation" + '("jilld@cbs.com") + '( + ["Home" + "368 222ND PL" + "" + "" + "Springfield" + "MA" 2117] + ) + '( + ["Office" 617 555 9983 0] + ) '"Movie Mogul") + (bbdb-maybe-create "John Doe--IMPORTED" + "ABC Incorporated" + '("jdoe@abc.com") + '( + ["Office" + "123 Any Street" + "" + "" + "Any Town" + "WA" (98027 7758)] + ) + '( + ["Office" 206 555 1234 0] + ) '"TV Producer") + ) + ;;; ======= End of Exported BBDB Records ======= + + +This lisp expression can then be sent via email or some other +text-based messaging facility to another user who can then evaluate +the expression which will add the `BBDB' records to the +recipient's +`BBDB' database. + +Only new records are added. A record with the same name or net +address as one already existing in the `BBDB' is skipped +entirely. + +In the sample contents of a `*BBDB* Export' buffer presented, two +records are being exported--one for "John Doe" and the other for +"Jill Doe". Notice that their names have been appended with +`--IMPORTED'. This string can be used to quick locate each record +that is added to the database using this mechanism. + +The following steps are for exporting BBDB records into Emacs Lisp: + + + 1. Invoke `M-x bbdb' to populate the `*BBDB*' buffer + with the contents you wish to export. + + 2. Invoke `bbdb-export' to create a `*BBDB* Export' buffer which contains a + single `(progn ...)' can be evaluated to add the records to the + existing `BBDB' database (if the records do not already exist). + + 3. Use the contents of `*BBDB* Export' in email and other messaging systems. + + + +The following steps are for a user wishing to import the contents of a +`*BBDB* Export' buffer's expression into his or her own database: + + + 1. Evaluate the region bounded by the lines + `;;; ======= Start of Exported BBDB Records =======' + and + `;;; ======= End of Exported BBDB Records ======='. + You can use such commands as + `M-x eval-region' or `M-x eval-last-sexp'. + + 2. Review the newly imported entries. To see them, invoke `M-x + bbdb' and specify `--IMPORTED' at the `Regular Expression' + prompt. + + 3. After reviewing the contents of the imported records, you may + wish to remove the `--IMPORTED' that is appended to the name by + `bbdb-export'. + + + + +File: bbdb-filters.info Node: Input Filters, Prev: Output Filters, Up: Top, Next: Miscellany + +Input Filters +************* + + +"Input filters" are used to import into BBDB information from a +foreign system's data file. + +The name of the function is conventionally named +`bbdb-<system>-input' (e.g., `bbdb-passwd-input' is the name +of the Emacs Lisp function for the UNIX password file input filter). + +In general, an "input filter" expects the foreign system's data to +be in the current buffer. The contents of the current buffer are used +to create an Emacs Lisp file which when loaded will add new records +into your BBDB database if they don't yet exist--existing BBDB records +will not be modified. + + +* Menu: + +* General Facilities for Input Filtering:: +* UNIX Password Files:: + + + +File: bbdb-filters.info Node: General Facilities for Input Filtering, Prev: Input Filters, Up: Input Filters, Next: UNIX Password Files + +General Facilities for Input Filtering +====================================== + + +The result of running an input filter is to produce a new buffer a +series of `bif-create-record' +expressions, each corresponding to a single user's record. Notice +that input filters do not directly modify the contents of the BBDB +files (typically ``~/.bbdb''). + +To actually modify the contents of the BBDB database, you must +evaluated the expressions in the resultant buffer created by the input +filter. One way to do so is simply to invoke `M-x eval-buffer'. +Another way is to simply save the buffer to disk and load its contents +into Emacs Lisp using `M-x load-file'. + + +File: bbdb-filters.info Node: UNIX Password Files, Prev: General Facilities for Input Filtering, Up: Input Filters + +UNIX Password Files +=================== + + +The UNIX password file input filter is in file `bbdb-passwd.el'. + + + 1. Use `M-x find-file' to visit the UNIX password file you wish to import. + + 2. With the password file in the current buffer, invoke the input + filter `M-x bbdb-passwd-input'. You will be prompted for the + domain name associated with that host's password file; an organization + name; as well as the file name to be associated with the buffer of + `bif-create-record' expressions. + + 3. Evaluate the contents of the input filter's buffer to add records + into your BBDB database file. + + + + +File: bbdb-filters.info Node: Miscellany, Prev: Input Filters, Up: Top, Next: GNU LIBRARY GENERAL PUBLIC LICENSE + +Miscellany +********** + + + +* Menu: + +* TODO List:: +* Credits:: + + + +File: bbdb-filters.info Node: TODO List, Prev: Miscellany, Up: Miscellany, Next: Credits + +TODO List +========= + + + + * Move generic input filter functionality out of + `bbdb-passwd.el' and into, say, `bbdb-ifilt.el'. + The generic functionality code has names typically prefixed with `bif-'. + + * Add support for `gdbload' (as an alternative to the + Xlate/Merge application provided in the HP 200LX Connectivity Pack) + into the HP 200LX output filter. This is based on input from Robert + Nicholson `<robert@steffi.dircon.co.uk>'. + + * Add documentation for variables in the various input and output filters. + + * Check and document all dependencies on other packages. + + + + +File: bbdb-filters.info Node: Credits, Prev: TODO List, Up: Miscellany + +Credits +======= + + +Pean Lim `<pean@neda.com>' wrote most of this package. Mohsen +Banan `<mohsen@neda.com>' put it all together and guided the +work. Neda Communications, Inc. sponsored the work. The output +filters code is based on `bbdb-print' by Boris Goldowsky +`<boris@prodigal.psych.rochester.edu>'. + + + +File: bbdb-filters.info Node: GNU LIBRARY GENERAL PUBLIC LICENSE, Prev: Miscellany, Up: Top, Next: Concept Index + +GNU LIBRARY GENERAL PUBLIC LICENSE +********************************** + + + Version 2, June 1991 + + + + Copyright (C) 1991 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + [This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + + +* Menu: + +* Preamble:: +* TERMS AND CONDITIONS FOR COPYING:: * +* NO WARRANTY:: +* END OF TERMS AND CONDITIONS:: +* How to Apply These Terms to Your New Libraries:: + + + +File: bbdb-filters.info Node: Preamble, Prev: GNU LIBRARY GENERAL PUBLIC LICENSE, Up: GNU LIBRARY GENERAL PUBLIC LICENSE, Next: TERMS AND CONDITIONS FOR COPYING + +Preamble +======== + + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software---to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + + + 1. This License Agreement applies to any software library which + contains a notice placed by the copyright holder or other authorized + party saying it may be distributed under the terms of this Library + General Public License (also called "this License"). Each licensee is + addressed as "you". + + A "library" means a collection of software functions and/or data + prepared so as to be conveniently linked with application programs + (which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work + which has been distributed under these terms. A "work based on the + Library" means either the Library or any derivative work under + copyright law: that is to say, a work containing the Library or a + portion of it, either verbatim or with modifications and/or translated + straightforwardly into another language. (Hereinafter, translation is + included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for + making modifications to it. For a library, complete source code means + all the source code for all modules it contains, plus any associated + interface definition files, plus the scripts used to control compilation + and installation of the library. + + Activities other than copying, distribution and modification are not + covered by this License; they are outside its scope. The act of + running a program using the Library is not restricted, and output from + such a program is covered only if its contents constitute a work based + on the Library (independent of the use of the Library in a tool for + writing it). Whether that is true depends on what the Library does + and what the program that uses the Library does. + + 2. You may copy and distribute verbatim copies of the Library's + complete source code as you receive it, in any medium, provided that + you conspicuously and appropriately publish on each copy an + appropriate copyright notice and disclaimer of warranty; keep intact + all the notices that refer to this License and to the absence of any + warranty; and distribute a copy of this License along with the + Library. + + You may charge a fee for the physical act of transferring a copy, + and you may at your option offer warranty protection in exchange for a + fee. + + 3. You may modify your copy or copies of the Library or any portion + of it, thus forming a work based on the Library, and copy and + distribute such modifications or work under the terms of Section 1 + above, provided that you also meet all of these conditions: + + 1. The modified work must itself be a software library. + + 2. You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + 3. You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + 4. If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + + + These requirements apply to the modified work as a whole. If + identifiable sections of that work are not derived from the Library, + and can be reasonably considered independent and separate works in + themselves, then this License, and its terms, do not apply to those + sections when you distribute them as separate works. But when you + distribute the same sections as part of a whole which is a work based + on the Library, the distribution of the whole must be on the terms of + this License, whose permissions for other licensees extend to the + entire whole, and thus to each and every part regardless of who wrote + it. + + Thus, it is not the intent of this section to claim rights or contest + your rights to work written entirely by you; rather, the intent is to + exercise the right to control the distribution of derivative or + collective works based on the Library. + + In addition, mere aggregation of another work not based on the Library + with the Library (or with a work based on the Library) on a volume of + a storage or distribution medium does not bring the other work under + the scope of this License. + + 4. You may opt to apply the terms of the ordinary GNU General Public + License instead of this License to a given copy of the Library. To do + this, you must alter all the notices that refer to this License, so + that they refer to the ordinary GNU General Public License, version 2, + instead of to this License. (If a newer version than version 2 of the + ordinary GNU General Public License has appeared, then you can specify + that version instead if you wish.) Do not make any other change in + these notices. + + Once this change is made in a given copy, it is irreversible for + that copy, so the ordinary GNU General Public License applies to all + subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of + the Library into a program that is not a library. + + 5. You may copy and distribute the Library (or a portion or + derivative of it, under Section 2) in object code or executable form + under the terms of Sections 1 and 2 above provided that you accompany + it with the complete corresponding machine-readable source code, which + must be distributed under the terms of Sections 1 and 2 above on a + medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy + from a designated place, then offering equivalent access to copy the + source code from the same place satisfies the requirement to + distribute the source code, even though third parties are not + compelled to copy the source along with the object code. + + 6. A program that contains no derivative of any portion of the + Library, but is designed to work with the Library by being compiled or + linked with it, is called a "work that uses the Library". Such a + work, in isolation, is not a derivative work of the Library, and + therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library + creates an executable that is a derivative of the Library (because it + contains portions of the Library), rather than a "work that uses the + library". The executable is therefore covered by this License. + Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file + that is part of the Library, the object code for the work may be a + derivative work of the Library even though the source code is not. + Whether this is true is especially significant if the work can be + linked without the Library, or if the work is itself a library. The + threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data + structure layouts and accessors, and small macros and small inline + functions (ten lines or less in length), then the use of the object + file is unrestricted, regardless of whether it is legally a derivative + work. (Executables containing this object code plus portions of the + Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may + distribute the object code for the work under the terms of Section 6. + Any executables containing that work also fall under Section 6, + whether or not they are linked directly with the Library itself. + + 7. As an exception to the Sections above, you may also compile or + link a "work that uses the Library" with the Library to produce a + work containing portions of the Library, and distribute that work + under terms of your choice, provided that the terms permit + modification of the work for the customer's own use and reverse + engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the + Library is used in it and that the Library and its use are covered by + this License. You must supply a copy of this License. If the work + during execution displays copyright notices, you must include the + copyright notice for the Library among them, as well as a reference + directing the user to the copy of this License. Also, you must do one + of these things: + + 1. Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + 2. Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + 3. If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + 4. Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + + For an executable, the required form of the "work that uses the + Library" must include any data and utility programs needed for + reproducing the executable from it. However, as a special exception, + the source code distributed need not include anything that is normally + distributed (in either source or binary form) with the major + components (compiler, kernel, and so on) of the operating system on + which the executable runs, unless that component itself accompanies + the executable. + + It may happen that this requirement contradicts the license + restrictions of other proprietary libraries that do not normally + accompany the operating system. Such a contradiction means you cannot + use both them and the Library together in an executable that you + distribute. + + 8. You may place library facilities that are a work based on the + Library side-by-side in a single library together with other library + facilities not covered by this License, and distribute such a combined + library, provided that the separate distribution of the work based on + the Library and of the other library facilities is otherwise + permitted, and provided that you do these two things: + + 1. Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + 2. Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + + 9. You may not copy, modify, sublicense, link with, or distribute + the Library except as expressly provided under this License. Any + attempt otherwise to copy, modify, sublicense, link with, or + distribute the Library is void, and will automatically terminate your + rights under this License. However, parties who have received copies, + or rights, from you under this License will not have their licenses + terminated so long as such parties remain in full compliance. + + 10. You are not required to accept this License, since you have not + signed it. However, nothing else grants you permission to modify or + distribute the Library or its derivative works. These actions are + prohibited by law if you do not accept this License. Therefore, by + modifying or distributing the Library (or any work based on the + Library), you indicate your acceptance of this License to do so, and + all its terms and conditions for copying, distributing or modifying + the Library or works based on it. + + 11. Each time you redistribute the Library (or any work based on the + Library), the recipient automatically receives a license from the + original licensor to copy, distribute, link with or modify the Library + subject to these terms and conditions. You may not impose any further + restrictions on the recipients' exercise of the rights granted herein. + You are not responsible for enforcing compliance by third parties to + this License. + + 12. If, as a consequence of a court judgment or allegation of patent + infringement or for any other reason (not limited to patent issues), + conditions are imposed on you (whether by court order, agreement or + otherwise) that contradict the conditions of this License, they do not + excuse you from the conditions of this License. If you cannot + distribute so as to satisfy simultaneously your obligations under this + License and any other pertinent obligations, then as a consequence you + may not distribute the Library at all. For example, if a patent + license would not permit royalty-free redistribution of the Library by + all those who receive copies directly or indirectly through you, then + the only way you could satisfy both it and this License would be to + refrain entirely from distribution of the Library. + + If any portion of this section is held invalid or unenforceable under any + particular circumstance, the balance of the section is intended to apply, + and the section as a whole is intended to apply in other circumstances. + + It is not the purpose of this section to induce you to infringe any + patents or other property right claims or to contest validity of any + such claims; this section has the sole purpose of protecting the + integrity of the free software distribution system which is + implemented by public license practices. Many people have made + generous contributions to the wide range of software distributed + through that system in reliance on consistent application of that + system; it is up to the author/donor to decide if he or she is willing + to distribute software through any other system and a licensee cannot + impose that choice. + + This section is intended to make thoroughly clear what is believed to + be a consequence of the rest of this License. + + 13. If the distribution and/or use of the Library is restricted in + certain countries either by patents or by copyrighted interfaces, the + original copyright holder who places the Library under this License may add + an explicit geographical distribution limitation excluding those countries, + so that distribution is permitted only in or among countries not thus + excluded. In such case, this License incorporates the limitation as if + written in the body of this License. + + 14. The Free Software Foundation may publish revised and/or new + versions of the Library General Public License from time to time. + Such new versions will be similar in spirit to the present version, + but may differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the Library + specifies a version number of this License which applies to it and + "any later version", you have the option of following the terms and + conditions either of that version or of any later version published by + the Free Software Foundation. If the Library does not specify a + license version number, you may choose any version ever published by + the Free Software Foundation. + + 15. If you wish to incorporate parts of the Library into other free + programs whose distribution conditions are incompatible with these, + write to the author to ask for permission. For software which is + copyrighted by the Free Software Foundation, write to the Free + Software Foundation; we sometimes make exceptions for this. Our + decision will be guided by the two goals of preserving the free status + of all derivatives of our free software and of promoting the sharing + and reuse of software generally. + + + NO WARRANTY + + + + 16. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO + WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. + EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR + OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY + KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR + PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE + LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME + THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 17. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN + WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY + AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU + FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR + CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE + LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING + RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A + FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF + SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH + DAMAGES. + + + + END OF TERMS AND CONDITIONS + + + + + +File: bbdb-filters.info Node: How to Apply These Terms to Your New Libraries, Prev: END OF TERMS AND CONDITIONS, Up: GNU LIBRARY GENERAL PUBLIC LICENSE + +How to Apply These Terms to Your New Libraries +============================================== + + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + ONE LINE TO GIVE THE LIBRARY'S NAME AND AN IDEA OF WHAT IT DOES. + Copyright (C) YEAR NAME OF AUTHOR + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library 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 + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the + Free Software Foundation, Inc., 675 Mass Ave, Cambridge, + MA 02139, USA. + + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + + Yoyodyne, Inc., hereby disclaims all copyright interest in + the library `Frob' (a library for tweaking knobs) written + by James Random Hacker. + + SIGNATURE OF TY COON, 1 April 1990 + Ty Coon, President of Vice + + +That's all there is to it! + + + + +File: bbdb-filters.info Node: Concept Index, Prev: GNU LIBRARY GENERAL PUBLIC LICENSE, Up: Top, Next: Command Index + +Concept Index +************* + + + +* Menu: + +* About This Manual: About This Manual. +* About This Package: About This Package. +* .CDF file, HP 200LX Phone Book: HP 200LX Phone Book. +* Credits: Credits. +* Emacs Lisp Export: Emacs Lisp Export. +* General Facilities for Input Filtering: General Facilities for Input Filtering. +* GNU LIBRARY GENERAL PUBLIC LICENSE: GNU LIBRARY GENERAL PUBLIC LICENSE. +* How to Apply These Terms to Your New Libraries: How to Apply These Terms to Your New Libraries. +* HP 200LX Connectivity Pack: HP 200LX Phone Book. +* HP 200LX Phone Book: HP 200LX Phone Book. +* Input Filters: Input Filters. +* Introduction: Introduction. +* Lotus cc:Mail Nicknames: Lotus cc:Mail Nicknames. +* Miscellany: Miscellany. +* Output Filters: Output Filters. +* PC Eudora Nickname Database: PC Eudora Nickname Database. +* PC Eudora: PC Eudora. +* PC Eudora Recipient Database: PC Eudora Recipient Database. +* .PDF file, HP 200LX Phone Book: HP 200LX Phone Book. +* PH: PH. +* Preamble: Preamble. +* Sending BBDB records via email: Emacs Lisp Export. +* TODO List: TODO List. +* UNIX Password Files: UNIX Password Files. + + + + +File: bbdb-filters.info Node: Command Index, Prev: Concept Index, Up: Top + +Command Index +************* + + + +* Menu: + +* bbdb-ccmail-output: Lotus cc:Mail Nicknames. +* bbdb-eudora-nndbase-output: PC Eudora Nickname Database. +* bbdb-eudora-rcpdbase-output: PC Eudora Recipient Database. +* bbdb-export: Emacs Lisp Export. +* bbdb-hp200lx-output: HP 200LX Phone Book. +* bbdb-passwd-input: UNIX Password Files. +* bbdb-ph-output: PH. +* bif-create-record: General Facilities for Input Filtering. + + diff --git a/bits/bbdb-filters/doc/lgpl.tex b/bits/bbdb-filters/doc/lgpl.tex new file mode 100644 index 0000000..7427570 --- /dev/null +++ b/bits/bbdb-filters/doc/lgpl.tex @@ -0,0 +1,552 @@ +\c This LGPL is meant to be included from other files. +\c To format a standalone LGPL, use liblic.texi. + +\chapter{GNU LIBRARY GENERAL PUBLIC LICENSE} + +\begin{center} +Version 2, June 1991 +\end{center} + +\begin{example} +Copyright \copyright{} 1991 Free Software Foundation, Inc. +675 Mass Ave, Cambridge, MA 02139, USA +Everyone is permitted to copy and distribute verbatim copies +of this license document, but changing it is not allowed. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] +\end{example} + +\section*{Preamble} + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software---to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +``work based on the library'' and a ``work that uses the library''. The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + +\begin{iftex} +\section*{TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION} +\end{iftex} +\begin{ifinfo} +\begin{center} +TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION +\end{center} +\end{ifinfo} + +\begin{enumerate} +\item +This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +General Public License (also called ``this License''). Each licensee is +addressed as ``you''. + + A ``library'' means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The ``Library'', below, refers to any such software library or work +which has been distributed under these terms. A ``work based on the +Library'' means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term ``modification''.) + + ``Source code'' for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + +\item +You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + +\item +You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + +\begin{enumerate} +\item +The modified work must itself be a software library. + +\item +You must cause the files modified to carry prominent notices +stating that you changed the files and the date of any change. + +\item +You must cause the whole of the work to be licensed at no +charge to all third parties under the terms of this License. + +\item +If a facility in the modified Library refers to a function or a +table of data to be supplied by an application program that uses +the facility, other than as an argument passed when the facility +is invoked, then you must make a good faith effort to ensure that, +in the event an application does not supply such function or +table, the facility still operates, and performs whatever part of +its purpose remains meaningful. + +(For example, a function in a library to compute square roots has +a purpose that is entirely well-defined independent of the +application. Therefore, Subsection 2d requires that any +application-supplied function or table used by this function must +be optional: if the application does not supply it, the square +root function must still compute square roots.) +\end{enumerate} + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + +\item +You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + +\item +You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + +\item +A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a ``work that uses the Library''. Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a ``work that uses the Library'' with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a ``work that uses the +library''. The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a ``work that uses the Library'' uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + +\item +As an exception to the Sections above, you may also compile or +link a ``work that uses the Library'' with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + +\begin{enumerate} +\item +Accompany the work with the complete corresponding +machine-readable source code for the Library including whatever +changes were used in the work (which must be distributed under +Sections 1 and 2 above); and, if the work is an executable linked +with the Library, with the complete machine-readable ``work that +uses the Library'', as object code and/or source code, so that the +user can modify the Library and then relink to produce a modified +executable containing the modified Library. (It is understood +that the user who changes the contents of definitions files in the +Library will not necessarily be able to recompile the application +to use the modified definitions.) + +\item +Accompany the work with a written offer, valid for at +least three years, to give the same user the materials +specified in Subsection 6a, above, for a charge no more +than the cost of performing this distribution. + +\item +If distribution of the work is made by offering access to copy +from a designated place, offer equivalent access to copy the above +specified materials from the same place. + +\item +Verify that the user has already received a copy of these +materials or that you have already sent this user a copy. +\end{enumerate} + + For an executable, the required form of the ``work that uses the +Library'' must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the source code distributed need not include anything that is normally +distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + +\item +You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + +\begin{enumerate} +\item +Accompany the combined library with a copy of the same work +based on the Library, uncombined with any other library +facilities. This must be distributed under the terms of the +Sections above. + +\item +Give prominent notice with the combined library of the fact +that part of it is a work based on the Library, and explaining +where to find the accompanying uncombined form of the same work. +\end{enumerate} + +\item +You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + +\item +You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + +\item +Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + +\item +If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + +\item +If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + +\item +The Free Software Foundation may publish revised and/or new +versions of the Library General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +``any later version'', you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + +\item +If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + +\begin{iftex} +\section*{NO WARRANTY} +\end{iftex} +\begin{ifinfo} +\begin{center} +NO WARRANTY +\end{center} +\end{ifinfo} + +\item +BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY ``AS IS'' WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + +\item +IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. +\end{enumerate} + +\begin{iftex} +\section*{END OF TERMS AND CONDITIONS} +\end{iftex} +\begin{ifinfo} +\begin{center} +END OF TERMS AND CONDITIONS +\end{center} +\end{ifinfo} + +\clearpage + +\section*{How to Apply These Terms to Your New Libraries} + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +``copyright'' line and a pointer to where the full notice is found. + +\begin{smallexample} +\var{one line to give the library's name and an idea of what it does.} +Copyright (C) \var{year} \var{name of author} + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Library General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +This library 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 +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with this library; if not, write to the +Free Software Foundation, Inc., 675 Mass Ave, Cambridge, +MA 02139, USA. +\end{smallexample} + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a ``copyright disclaimer'' for the library, if +necessary. Here is a sample; alter the names: + +\begin{example} +Yoyodyne, Inc., hereby disclaims all copyright interest in +the library `Frob' (a library for tweaking knobs) written +by James Random Hacker. + +\var{signature of Ty Coon}, 1 April 1990 +Ty Coon, President of Vice +\end{example} + +That's all there is to it! diff --git a/bits/bbdb-filters/doc/main.texinfo b/bits/bbdb-filters/doc/main.texinfo new file mode 100644 index 0000000..7edb948 --- /dev/null +++ b/bits/bbdb-filters/doc/main.texinfo @@ -0,0 +1,492 @@ +% This is really LaTeXInfo, but some time LaTeX mode is more useful -*- LaTeX -*- +% This is really LaTeXInfo, but some time LaTeX mode is more useful -*- Latexinfo -*- +% +% Revision: main.texinfo,v 1.1.1.1 1995/08/07 08:43:10 mohsen Exp +% +%\documentstyle[12pt,latexinfo,format,smallverb,tabular]{book} +%\documentstyle[12pt,latexinfo,format]{book} +\documentstyle[12pt,format,hyperlatex,latexinfo]{book} +%\documentstyle[12pt,times,latexinfo,format]{book} +%\documentstyle[12pt,avantgarde,latexinfo,format]{book} +%\documentstyle[12pt,palatino,latexinfo,format]{book} +%\documentstyle[10pt,avantgarde,latexinfo,format]{book} + +\pagestyle{empty} + +\c \input{transfig} \c Used with eepic -- not needed when using psfig. +\input{epsf} + +\begin{document} + +\c \bibliographystyle{alpha} \c [banan92] +\c \bibliographystyle{plain} \c Numbers [1] + +\c \textwidth 5.2in \c for .tty generation + +\htmldirectory{bbdbFilters} +\htmlname{bbdbFilters} +\htmltitle{BBDB Filters} +\htmlmathitalics +\htmladdress{\htmlrule{}info@neda.com} + +\c Declare which indices you want to make use of. +\newindex{cp} +\newindex{fn} + +\title{BBDB Input and Output Filters\\ + \vspace{0.25in} {\large DRAFT}\\ + {\normalsize Version 0.2}} + +\author{{\normalsize Prepared by}\\ + Mohsen Banan \\ + \code{mohsen@neda.com}\\ + Neda Communications, Inc.\\ + 17005 SE 31st Place\\ + Bellevue, WA 98008} + +\c (current-time-string) +\date{July 26, 1995} +\c \date{\today} + +\maketitle + +\c The following commands start the copyright page for the printed manual. +\clearpage +\vspace*{0pt plus 1filll} + + +\bigskip +\bigskip +\bigskip + + +This document describes the ``BBDB Input and Output Filters'' package, +a utility which translates BBDB information to and from various other +formats. + +\begin{display} + +Copyright \copyright 1995 Neda Communications, Inc. + +Published by: +Neda Communications, Inc. +17005 SE 31st Place, +Bellevue, WA 98008 USA + +\end{display} + + +Permission is granted to make and distribute verbatim copies of this +manual provided the copyright notice and this permission notice are +preserved on all copies. + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided that the +entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + +Permission is granted to copy and distribute translations of this +manual into another language, under the above conditions for modified +versions, except that this permission notice may be stated in a +translation approved by the Foundation. + +\bigskip +\bigskip + +\clearpage +\pagestyle{headings} + +\c Use roman numerals for the page numbers and Insert the Table of Contents. +\pagenumbering{roman} +\tableofcontents + +\c \listoftables +\c \listoffigures + +\c End the Table of Contents and start numbering from 1 with Arabic numbers + +\clearpage +\pagenumbering{arabic} + +\c Anything before the setfilename will not appear in the Info file. +\setfilename{INFOFILE} + +\topnode{BBDB Filters} + +\htmlmenu{6} + +\begin{ifinfo} +Copyright \copyright \var{1995} \var{Neda Communications, Inc.} +\end{ifinfo} + +\c The Top node contains the master menu for the Info file. +\c This appears only in the Info file, not the printed manual. + +\chapter{Introduction} + +Over time much valuable data has been gathered in BBDB database files. +Many wish to share parts or all of this information with others. They +also wish to have access to this same information from other systems +(like personal digital assistants) lacking straightforward BBDB +access. + +For these reasons, we have prepared a family of filters that convert +the information in BBDB to and from a variety of other +formats. ``Output filters'' export BBDB information to other formats +while ``input filters'' import information from other formats into +BBDB. + +Our hope is that over time this collection of BBDB filters will grow +through contributed code. + +\section{About This Package} + +This package is a collection of filters and is called ``BBDB Input and +Output Filters''. It has been somewhat tested with BBDB version 1.50. +The present state of the software is still preliminary although it has +proved useful. + +\section{About This Manual} + +This documentation applies to Version 0.2 of the ``BBDB Input and +Output Filters'' package. The documentation is presently skeletal and +very preliminary. It mostly provides the user with instructions for +use, and very little background is included. Familiarity with Emacs +Lisp is assumed for some sections. + +\chapter{Output Filters} + +``Output filters'' are used to export BBDB information into formats +used by other systems. + +In general, an output filter uses the contents of your +\code{*BBDB*} buffer as input. Note that output filters do not use +BBDB files (typically `\code{~/.bbdb}') directly. + +An output filter is invoked by executing its associated lisp function. +The name of the function is conventionally named \code{bbdb-<system>-output} +(e.g., \code{M-x bbdb-hp200lx-output}). + +The result of running an output filter is to create a new buffer that +contains the \code{*BBDB*} information appropriately transformed into a +format suitable for use by the target system. The new buffer is given +a file name that you specify. + +\section{HP 200LX Phone Book} + +\cindex{HP 200LX Connectivity Pack} +This package has only been tested on HP 200LX palmtop systems. It +also requires the ``HP 200LX Connectivity Pack'' for converting +comma-delimited ASCII files into binary .PDB files which are read by +the HP 200LX Phone Book application. Version 1.00 of the ``HP 200LX +Connectivty Pack'' was used for testing. + +The HP 200LX output filter is in file \code{bbdb-hp200lx.el}. + +\begin{enumerate} + +\findex{bbdb-hp200lx-output} + +\item Invoke \code{M-x bbdb} to populate the \code{*BBDB*} buffer +with the contents you wish to export. + +\item Invoke \code{ bbdb-hp200lx-output} to create an ASCII .CDF +(Comma Delimited File). \cindex{.CDF file, HP 200LX Phone Book} + +\item Using Xlate/Merge option of HP Connectivity Pack convert the +.CDF file into a binary .PDB file used by the Phone Book program. +\cindex{.PDF file, HP 200LX Phone Book} + +\item Download the .PDB file to your palmtop's internal disk and +ensure that the Phone Book program is set use the newly downloaded +.PDB file. + +\end{enumerate} + +\section{PC Eudora} + +BBDB information can be exported to PC Eudora in two formats--as a +nickname database file and as a recipients database file. + +The PC Eudora output filter is in file \code{bbdb-eudora.el}. + +\subsection{PC Eudora Nickname Database} + +\begin{enumerate} + +\item Invoke \code{M-x bbdb} to populate the \code{*BBDB*} buffer +with the contents you wish to export. + +\findex{bbdb-eudora-nndbase-output} +\item Invoke \code{bbdb-eudora-nndbase-output} to create a PC Eudora +Nickname database file. + +\item Make the file accessible to PC Eudora. + +\end{enumerate} + +\subsection{PC Eudora Recipient Database} + +\begin{enumerate} + +\item Invoke \code{M-x bbdb} to populate the \code{*BBDB*} buffer +with the contents you wish to export. + +\findex{bbdb-eudora-rcpdbase-output} +\item Invoke \code{bbdb-eudora-rcpdbase-output} to create a PC Eudora +recipient's database file. + +\item Make the file accessible to PC Eudora. + +\end{enumerate} + +\section{Lotus cc:Mail Nicknames} + +The Lotus cc:Mail output filter is in file \code{bbdb-ccmail.el}. + +\begin{enumerate} + +\item Invoke \code{M-x bbdb} to populate the \code{*BBDB*} buffer +with the contents you wish to export. + +\findex{bbdb-ccmail-output} +\item Invoke \code{ bbdb-ccmail-output} to create a cc:Mail Nicknames file. + +\item Make the file accessible to cc:Mail. + +\end{enumerate} + +\section{PH} + +The PH output filter is in file \code{bbdb-ph.el}. + +\begin{enumerate} + +\item Invoke \code{M-x bbdb} to populate the \code{*BBDB*} buffer +with the contents you wish to export. + +\findex{bbdb-ph-output} +\item Invoke \code{bbdb-ph-output} to create a \code{ph} data file for +use with the \code{maked} program. + +\item Make the file accessible to \code{ph}. + +\end{enumerate} + +\section{Emacs Lisp Export} + +The Emacs Lisp Export output filter is in file \code{bbdb-export.el}. + +This output filter uses the current contents of your +\code{*BBDB*} buffer to generate a new buffer (\code{*BBDB* Export}) +that contains a single lisp \code{(progn ...)} expression. For +example, a \code{*BBDB*} buffer containing two records would result in +the following \code{*BBDB* Export} buffer: + +\begin{example} +;;; ======= Start of Exported BBDB Records ======= +(progn + (require 'bbdb-com) + (defun bbdb-maybe-create (name company net &optional addrs phones notes) + "Try to add a record to BBDB if it does not already exist." + (condition-case err + (progn + (bbdb-create-internal name company net addrs phones notes) + (message "%s %s added." name (if net (concat "<" net ">") "")) + (sleep-for 1)) + (error (ding) + (message "%s %s skipped. (%s)" + name + (if net (concat "<" net ">") "") + (car (cdr err))) + (sleep-for 1)))) + + (bbdb-maybe-create "Jill Doe--IMPORTED" + "CBS Corporation" + '("jilld@cbs.com") + '( + ["Home" + "368 222ND PL" + "" + "" + "Springfield" + "MA" 2117] + ) + '( + ["Office" 617 555 9983 0] + ) '"Movie Mogul") + (bbdb-maybe-create "John Doe--IMPORTED" + "ABC Incorporated" + '("jdoe@abc.com") + '( + ["Office" + "123 Any Street" + "" + "" + "Any Town" + "WA" (98027 7758)] + ) + '( + ["Office" 206 555 1234 0] + ) '"TV Producer") + ) +;;; ======= End of Exported BBDB Records ======= +\end{example} + +\cindex{Sending BBDB records via email} +This lisp expression can then be sent via email or some other +text-based messaging facility to another user who can then evaluate +the expression which will add the \code{BBDB} records to the +recipient's +\code{BBDB} database. + +Only new records are added. A record with the same name or net +address as one already existing in the \code{BBDB} is skipped +entirely. + +In the sample contents of a \code{*BBDB* Export} buffer presented, two +records are being exported--one for ``John Doe'' and the other for +``Jill Doe''. Notice that their names have been appended with +\code{--IMPORTED}. This string can be used to quick locate each record +that is added to the database using this mechanism. + +The following steps are for exporting BBDB records into Emacs Lisp: + +\begin{enumerate} + +\item Invoke \code{M-x bbdb} to populate the \code{*BBDB*} buffer +with the contents you wish to export. + +\findex{bbdb-export} +\item Invoke \code{bbdb-export} to create a \code{*BBDB* Export} buffer which contains a +single \code{(progn ...)} can be evaluated to add the records to the +existing \code{BBDB} database (if the records do not already exist). + +\item Use the contents of \code{*BBDB* Export} in email and other messaging systems. + +\end{enumerate} + +The following steps are for a user wishing to import the contents of a +\code{*BBDB* Export} buffer's expression into his or her own database: + +\begin{enumerate} + +\item Evaluate the region bounded by the lines \\ + \code{;;; ======= Start of Exported BBDB Records =======} \\ +and \\ + \code{;;; ======= End of Exported BBDB Records =======}. \\ +You can use such commands as +\code{M-x eval-region} or \code{M-x eval-last-sexp}. + +\item Review the newly imported entries. To see them, invoke \code{M-x +bbdb} and specify \code{--IMPORTED} at the \code{Regular Expression} +prompt. + +\item After reviewing the contents of the imported records, you may +wish to remove the \code{--IMPORTED} that is appended to the name by +\code{bbdb-export}. + +\end{enumerate} + +\chapter{Input Filters} + +``Input filters'' are used to import into BBDB information from a +foreign system's data file. + +The name of the function is conventionally named +\code{bbdb-<system>-input} (e.g., \code{bbdb-passwd-input} is the name +of the Emacs Lisp function for the UNIX password file input filter). + +In general, an ``input filter'' expects the foreign system's data to +be in the current buffer. The contents of the current buffer are used +to create an Emacs Lisp file which when loaded will add new records +into your BBDB database if they don't yet exist--existing BBDB records +will not be modified. + +\section{General Facilities for Input Filtering} + +The result of running an input filter is to produce a new buffer a +series of \code{bif-create-record} \findex{bif-create-record} +expressions, each corresponding to a single user's record. Notice +that input filters do not directly modify the contents of the BBDB +files (typically `\code{~/.bbdb}'). + +To actually modify the contents of the BBDB database, you must +evaluated the expressions in the resultant buffer created by the input +filter. One way to do so is simply to invoke \code{M-x eval-buffer}. +Another way is to simply save the buffer to disk and load its contents +into Emacs Lisp using \code{M-x load-file}. + +\section{UNIX Password Files} + +The UNIX password file input filter is in file \code{bbdb-passwd.el}. + +\begin{enumerate} + +\item Use \code{M-x find-file} to visit the UNIX password file you wish to import. + +\findex{bbdb-passwd-input} +\item With the password file in the current buffer, invoke the input +filter \code{M-x bbdb-passwd-input}. You will be prompted for the +domain name associated with that host's password file; an organization +name; as well as the file name to be associated with the buffer of +\code{bif-create-record} expressions. + +\item Evaluate the contents of the input filter's buffer to add records +into your BBDB database file. + +\end{enumerate} + +\chapter{Miscellany} + +\section{TODO List} + +\begin{itemize} + +\item Move generic input filter functionality out of +\code{bbdb-passwd.el} and into, say, \code{bbdb-ifilt.el}. +The generic functionality code has names typically prefixed with \code{bif-}. + +\item Add support for \code{gdbload} (as an alternative to the +Xlate/Merge application provided in the HP 200LX Connectivity Pack) +into the HP 200LX output filter. This is based on input from Robert +Nicholson \code{<robert@steffi.dircon.co.uk>}. + +\item Add documentation for variables in the various input and output filters. + +\item Check and document all dependencies on other packages. + +\end{itemize} + +\section{Credits} + +Pean Lim \code{<pean@neda.com>} wrote most of this package. Mohsen +Banan \code{<mohsen@neda.com>} put it all together and guided the +work. Neda Communications, Inc. sponsored the work. The output +filters code is based on \code{bbdb-print} by Boris Goldowsky\\ +\code{<boris@prodigal.psych.rochester.edu>}. + +\c ;;;;;;;;;;;;;;;; Appendix Starts Here ;;;;;;;;;;;;; +\appendix + +\mbinput{lgpl.tex} + +\begin{tex} +%\bibliography{/usr/local/lib/bib/gnu,/usr/local/lib/bib/networking,/usr/local/lib/bib/directory,/usr/local/lib/bib/rfcs} +\end{tex} + +\c \twocolumn +\node Concept Index, Top, First Chapter, Top +\unnumbered{Concept Index} + +\printindex{cp} + +\H \htmlprintindex + +\node Command Index, Top, First Chapter, Top +\unnumbered{Command Index} + +\printindex{fn} + +\end{document} + diff --git a/bits/bbdb-filters/doc/makefile b/bits/bbdb-filters/doc/makefile new file mode 100644 index 0000000..3feac99 --- /dev/null +++ b/bits/bbdb-filters/doc/makefile @@ -0,0 +1,159 @@ +# +# RCS makefile,v 1.1.1.1 1995/08/07 08:43:10 mohsen Exp +# + +# The name of the file +MANUAL=main +INFOFILE= bbdb-filters.info + +TEXPARTS = + +EPSFIGS = + +TGRINDS = + +EOEBASE = /usr/public/eoe/lisp/public/bbdbPlus +EOEINFO = /usr/public/eoe/info + +# The name of your DVI to PS filter +DVIPS=dvips -f + +# The name of your GNU Emacs +EMACS= xemacs + +LATEXINFO= /usr/public/tex/latexinfo1.7 + +### +### SHOUL NOT HAVE TO TOUCH ANYTHING BELOW HERE +### +SHELL=/bin/sh + +.SUFFIXES: +.SUFFIXES: .lpr .ps .tty .xdvi .dvi .tex .ptex .eps .fig .c + +.fig.eps: + fig2dev -L ps $< > $@ + +.c.tex: + tgrind -f $< > $@ + + +# DEFAULT TARGET +#all: $(INFOFILE) $(MANUAL).ps +all: fast.ps + +$(INFOFILE): $(MANUAL).tex $(TEXPARTS) + rm -f makeinfo.el + sed -e "s+MANUAL+$(MANUAL)+" \ + -e "s+LATEXINFO+$(LATEXINFO)+" $(LATEXINFO)/local/makeinfo.tmplt > makeinfo.el + $(EMACS) -batch -q -l makeinfo.el + #cp $(INFOFILE) /usr/public/eoe/info + +$(MANUAL).tex: $(MANUAL).texinfo $(TEXPARTS) + sed -e "s+INFOFILE+$(INFOFILE)+" $(MANUAL).texinfo | expand > $(MANUAL).tex + -rm -f maketex.el + sed -e "s+MANUAL+$(MANUAL)+" \ + -e "s+LATEXINFO+$(LATEXINFO)+" $(LATEXINFO)/local/maketex.tmplt > maketex.el + $(EMACS) -batch -q -l maketex.el + +$(MANUAL).hyperlatex: $(MANUAL).texinfo $(TEXPARTS) + sed -e "s+INFOFILE+$(INFOFILE)+" $(MANUAL).texinfo | expand > $(MANUAL).hyperlatex + -rm -f makehyperlatex.el + sed -e "s+MANUAL+$(MANUAL)+" \ + -e "s+LATEXINFO+$(LATEXINFO)+" $(LATEXINFO)/local/makehyperlatex.tmplt > makehyperlatex.el + $(EMACS) -batch -q -l makehyperlatex.el + +$(MANUAL).dvi: $(MANUAL).tex $(EPSFIGS) $(TGRINDS) + latex2dvi $(MANUAL).tex + +$(MANUAL).bbl: + latex $(MANUAL) + -bibtex $(MANUAL) + latex $(MANUAL) + +$(MANUAL).xdvi: $(MANUAL).dvi + xdvi $(MANUAL).dvi & + +$(MANUAL).ps: $(MANUAL).dvi + $(DVIPS) $(MANUAL) > $(MANUAL).ps + +$(MANUAL).lpr: $(MANUAL).ps + lpr $(MANUAL).ps + +info: $(INFOFILE) + -echo Built $(INFOFILE) + +$(MANUAL).html: $(MANUAL)/$(MANUAL).html + -echo Building $(MANUAL)/$(MANUAL).html + +$(MANUAL)/$(MANUAL).html: $(MANUAL).dvi $(MANUAL).htmlTex + /usr/public/src/Sol-2/networking/www/latex2html-95.1/latex2html $(MANUAL).tex + +EMACSBASE = /opt/public/networking/www/hyperlatex-1.3/emacs + +html: $(MANUAL).hyperlatex # $(MANUAL).dvi + -mkdir bbdbFilters + $(EMACS) -batch -no-init-file -no-site-file \ + -l $(EMACSBASE)/hyperlatex1.el -funcall batch-hyperlatex-format $(MANUAL).hyperlatex + echo latex \'\\def\\makegifs{}\\input{$(MANUAL).hyperlatex}\' > dolatex.sh + #sh dolatex.sh ; /bin/rm dolatex.sh + #sh $(MANUAL).makegif + +install: $(INFOFILE) + cp $(INFOFILE) $(EOEINFO)/$(INFOFILE) + +# +# Fast Processing +# + +fast.tex: $(MANUAL).texinfo $(TEXPARTS) + sed -e "s+INFOFILE+$(INFOFILE)+" -e "s+mbinput+input+" $(MANUAL).texinfo | expand > fast.tex + +fast.dvi: fast.tex $(EPSFIGS) $(TGRINDS) + latex fast.tex + +fast.xdvi: fast.dvi + xdvi fast.dvi & + +fast.ps: fast.dvi + $(DVIPS) fast > fast.ps + +fast.xps: fast.ps + pageview fast.ps & + +fast.lpr: fast.ps + lpr fast.ps + + +# TeX Figures for when dvi files are needed. Just an example +#XX.tex YY.tex: XX.fig YY.fig +# transfig -m 1.00 -L eepic -M fig.make XX.fig YY.fig +# make -f fig.make + +# Encapsulated PostScript figures -- Done by the Suffix rules +#XX.eps: XX.fig +# fig2dev -L ps -m 1.0 $< > $@ + +# Src Code +#cot-calling.tex: cot-calling.c +# tgrind -f $< > $@ + + +shar:: + split $(MANUAL).tex $(MANUAL)- + +clean: + rm -f $(MANUAL).log $(MANUAL).blg makeinfo.el maketex.el *~ #~ + +veryclean: clean + rm -f $(MANUAL).ps $(MANUAL).dvi $(MANUAL).dlog $(MANUAL).info + +realclean: veryclean + rm -f $(MANUAL).aux $(MANUAL).bbl $(MANUAL).blg $(MANUAL).cp \ + $(MANUAL).toc $(MANUAL).cps $(MANUAL).lot $(MANUAL).lof fig.make \ + $(MANUAL).auxO $(MANUAL).fn $(MANUAL).fns \ + transfig.tex $(MANUAL).tex $(INFOFILE) \ + $(MANUAL).hyperlatex makehyperlatex.el dolatex.sh \ + fast.aux fast.dvi fast.log fast.ps fast.tex fast.toc fast.cp fast.fn \ + $(EPSFIGS) $(TGRINDS) + diff --git a/bits/bbdb-filters/makefile b/bits/bbdb-filters/makefile new file mode 100644 index 0000000..9959f0e --- /dev/null +++ b/bits/bbdb-filters/makefile @@ -0,0 +1,67 @@ +# This file is part of the BBDB Filters Package. BBDB Filters Package is a +# collection of input and output filters for BBDB. +# +# Copyright (C) 1995 Neda Communications, Inc. +# Prepared by Mohsen Banan (mohsen@neda.com) +# +# This library is free software; you can redistribute it and/or modify +# it under the terms of the GNU Library General Public License as +# published by the Free Software Foundation; either version 2 of the +# License, or (at your option) any later version. This library 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 Library General Public +# License for more details. You should have received a copy of the GNU +# Library General Public License along with this library; if not, write +# to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, +# USA. +# +# + +# Makefile for the Insidious Big Brother Database -- Input and Output Filters +# +# RCS makefile,v 1.2 1995/08/08 01:20:32 mohsen Exp +# + +EOEBASE = /usr/public/eoe/lisp/public/bbdbPlus +EOEINFO = /usr/public/eoe/info +EMACS = xemacs + + +# You shouldn't need to change anything after this point. + +SRCS = bbdb-ccmail.el bbdb-eudora.el bbdb-export.el bbdb-hp200lx.el bbdb-ph.el bbdb-passwd.el + +SHELL=/bin/sh + +.SUFFIXES: +.SUFFIXES: .elc .el + +.el.elc: + $(EMACS) -batch -q -f batch-byte-compile $(@:.elc=.el) + +default: + @echo Targets: install clean shar + +install: + cp $(SRCS) $(EOEBASE) + cd doc; make EOEBASE=$(EOEBASE) EOEINFO=$(EOEINFO) install + +clean: + -/bin/rm *.elc package.shar + cd doc; make EOEBASE=$(EOEBASE) EOEINFO=$(EOEINFO) clean + + +shar: $(SRCS) makefile + shar -o package.shar $(SRCS) makefile COPYING.LIB README \ + doc doc/main.texinfo doc/lgpl.tex doc/makefile \ + doc/formatted doc/formatted/bbdb-filters.info + + +FORFTPING = /h8/var/ftp/pub/eoe/bbdbPlus/bbdb-filters-0.2.tar + +tar: $(SRCS) makefile + tar cvf $(FORFTPING) . + + + diff --git a/bits/bbdb-funcs.txt b/bits/bbdb-funcs.txt new file mode 100644 index 0000000..14a8180 --- /dev/null +++ b/bits/bbdb-funcs.txt @@ -0,0 +1,383 @@ +Navigation: Table of Contents, Index, next: .emacs file by Alex, prev: Emacs + +BBDB Elisp Code + +Overview: + + * Unmigrating from file format 4 + * Writing a .mailrc from BBDB + * Writing a Pine addressbook from BBDB, by Matt McClure + * Editing and formatting addresses with the country patch + o A new address editing function + o Adding a new formatting function + + The identifying function + + The formatting function + + Print formatting of addresses + +Unmigrating from file format 4 + +(defun bbdb-unmigrate-stuff (&optional new-version) + "Create a buffer with unmigrated BBDB data. +Usefull if you fooled around with BBDB file format 4 by Alex and want to +start using the official BBDB 2.00.06 again. In order to do that, you +have to save your .bbdb in BBDB file format 3 instead of the file format 4 +introduced by Alex. This function will create a *BBDB Version 3* buffer +for you, which you can examine and save as your new .bbdb. The unmigration +will strip the country fields of all entries in your BBDB as such a field +did not exist in the BBDB file format 3 used in BBDB 2.00.06." + (interactive "nUnmigrate to version (I recommend version 3): ") + (if (null new-version) + (setq new-version 3)) + (if (>= new-version bbdb-file-format) + (error "Current BBDB file format is version %d" bbdb-file-format) + (let* ((records (bbdb-records)) + (propnames (bbdb-with-db-buffer bbdb-propnames)) + (rec) + (bbdb-file-format-migration (cons bbdb-file-format new-version)) + (buf (get-buffer-create (format "*BBDB Version %d*" (cdr bbdb-file-format-migration))))) + (message "Unconverting the BBDB database...") + (set-buffer buf) + (erase-buffer) + (insert (format (concat ";;; file-version: %d\n" + ";;; user-fields: %S\n") + new-version (mapcar (function (lambda (x) (intern (car x)))) + propnames))) + (while records + (setq rec (copy-sequence (car records))) + (bbdb-unmigrate-record rec) + (aset rec 8 nil) + (insert (format "%S\n" rec)) + (setq records (cdr records))) + (pop-to-buffer buf) + (message "Unconverting the BBDB database...done")))) + +Writing a .mailrc from BBDB + +The following will export a very primitive version of your BBDB information +into a .mailrc file which is used for normal mail(1) and Emacs Rmail. + +Usually the main problem when exporting BBDB to other formats is the +creation of an ALIAS name. In my example below I just use LASTNAME. The +following function tries to write your BBDB into a .mailrc file, like this: + +alias LASTNAME "FULL_NAME <NETADDRESS>" + +mail-groups defined via the mail-alias field are not supported, but see Matt +McClure's code further down the page for an example on how to do this. + +I used the same code as bbdb-print for the file-name. Unfortunately this +very simple code must have a bug somewhere. It only occurs if you test it a +lot: When you are prompted for a file-name, "~/bbdb.tex" or "~/.mailrc" is +the default. Press RET. Sometimes this will find-file the correct file, and +sometimes you will overwrite your selected buffer instead. I haven't looked +into this, however. :( + +(defvar bbdb-mailrc-file-name ".mailrc" + "Filename to write mail aliases to.") + +(defun bbdb-write-mailrc (visible-records to-file) + (interactive (list (bbdb-do-all-records-p) + (read-file-name "Export To File: " bbdb-mailrc-file-name))) + (setq bbdb-mailrc-file-name (expand-file-name to-file)) + ;; `good' are people with netaddresses, `bad' are people without. The + ;; people are taken of the list records and put on either the good or + ;; the bad list. + (let ((good '()) (bad '()) + (records (if (not visible-records) + (bbdb-records) + (set-buffer bbdb-buffer-name) + (mapcar 'car bbdb-records)))) + ;; Open .mailrc file + (find-file bbdb-mailrc-file-name) + (widen) + (erase-buffer) + ;; Loop through records to print. + (while records + (if (bbdb-record-net (car records)) + (setq good (cons (car records) good)) + (setq bad (cons (car records) bad))) + (setq records (cdr records))) + ;; write all net-addresses into .mailrc + (insert (mapconcat (function (lambda (x) + (let ((name (bbdb-dwim-net-address x)) + (alias (bbdb-record-lastname x))) + (concat "alias " + alias + " \"" + (if (string-match "\"\\(.*\\)\"\\(.*\\)" name) + (format "%s%s" (match-string 1 name) + (match-string 2 name)) + name) + "\"")))) + (nreverse good) + "\n")) + ;; Mail groups + + ;; not implemented, yet + + ;; Feedback on the output quality. + (if bad + (message "There were %d people with bad or missing net addresses." + (length bad)) + (message "Done.")))) + +Writing a Pine addressbook from BBDB, by Matt McClure + +From: Matt McClure <matthew.mcclure.es.99@aya.yale.edu> +Subject: Re: conversion to pine addressbook? +Date: Wed, 25 Aug 1999 10:12:50 -0400 (EDT) + +It isn't pretty, but this will create a pine addressbook. +It also supports the mail-alias field (inefficiently, but it works). +I don't think it should be too difficult to modify to create mailrc +files instead. + +Thanks to Alex for the start. + +Matt + +;;;;; + +(defvar bbdb-mailrc-file-name "~/.addressbook" + "Filename to write mail aliases to.") + +(defun bbdb-write-dot-addressbook (to-file) + (interactive (list (read-file-name "Export To File: " "" nil nil bbdb-mailrc-file-name))) + (setq bbdb-mailrc-file-name (expand-file-name to-file)) + ;; `good' are people with netaddresses, `bad' are people without. The + ;; people are taken of the list records and put on either the good or + ;; the bad list. + (let ((good '()) (bad '()) + (records (bbdb-records)) + (grouped-good '()) (grouped-bad '()) + (grouped-records (bbdb-records)) + (mail-groups-alist '())) + ;; Open .mailrc file + (find-file bbdb-mailrc-file-name) + (widen) + (erase-buffer) + ;; Loop through records to print. + (while records + (if (bbdb-record-net (car records)) + (setq good (cons (car records) good)) + (setq bad (cons (car records) bad))) + (setq records (cdr records))) + ;; write all net-addresses into .mailrc + (insert (mapconcat + (function (lambda (x) + (let ((alias (concat (bbdb-record-firstname x) + " " + (bbdb-record-lastname x))) + (name (concat (bbdb-record-lastname x) + ", " + (bbdb-record-firstname x))) + (email (car (bbdb-record-net x))) + ) + (concat alias + "\t" + name + "\t" + email + ) + ))) + (nreverse good) + "\n")) + ;; Mail groups + ;; get the mail-aliases + (while grouped-records + (if (and + (bbdb-record-net (car grouped-records)) + (assoc 'mail-alias (bbdb-record-raw-notes (car grouped-records)))) + (setq grouped-good (cons (car grouped-records) grouped-good)) + (setq grouped-bad (cons (car grouped-records) grouped-bad))) + (setq grouped-records (cdr grouped-records))) + + (while grouped-good + (let ((aliases (split-string + (cdr (assoc 'mail-alias + (bbdb-record-raw-notes (car grouped-good)))) + "[, \f\t\n\r\v]+"))) + (while aliases + ;; store the name associated with alias somehow + (setq mail-groups-alist + (cons (cons (car aliases) + (concat "\"" + (bbdb-record-firstname (car grouped-good)) + " " + (bbdb-record-lastname (car grouped-good)) + "\"")) + mail-groups-alist)) + (setq aliases (cdr aliases)))) + (setq grouped-good (cdr grouped-good))) + + (setq mail-groups-alist (sort mail-groups-alist + (lambda (x y) + (string< (car x) (car y))))) + + ;; put each name from mail-groups-alist into the appropriate mail aliases + (setq assn '("" . "")) + (while mail-groups-alist + (let ((assn-new (car mail-groups-alist))) + (if (string= (car assn) "") + (insert (concat "\n" (car assn-new) "\t\t(")) + (if (not (string= (car assn) (car assn-new))) + (insert (concat ")\n" (car assn-new) "\t\t(")))) + (insert (concat (cdr assn-new) ",")) + (setq mail-groups-alist (cdr mail-groups-alist)) + (setq assn assn-new))) + + (if (not (string= (car assn) "")) + (insert ")\n")) + + ;; Feedback on the output quality. + (if bad + (message "There were %d people with bad or missing net addresses." + (length bad)) + (message "Done.")))) + +Editing and formatting addresses with the country patch + +If you are using my country patch to BBDB, you might want to use a different +address editing function or add new address formating functions. The +following shows you how to go about doing that. + +A new address editing function + +You can only have one active input function at the time. The name of the +active input function is stored in the variable +`bbdb-address-editing-function'. Therefore, you will have to write a new +address editing function and you will have to set +`bbdb-address-editing-function'. + +The easiest way to go about this, is using paste and copy: use +`bbdb-address-edit-default' as a starting point. + +(defun bbdb-address-edit-continental-german (addr) + "Function to use for address editing. +The sub-fields are queried using the continental order and using German +prompts. This is an alternate value for `bbdb-address-editing-function'. +It is used by German speaking users. + +The sub-fields and the prompts used are: +Strasse, Zeile 1: street1 +Strasse, Zeile 2: street2 +Strasse, Zeile 3: street3 +PLZ: zip +Stadt: city +Region/Staat: state +Land: country" + (let* ((st1 (bbdb-read-string "Strasse, Zeile 1: " (bbdb-address-street1 addr))) + (st2 (if (string= st1 "") "" + (bbdb-read-string "Strasse, Zeile 2: " (bbdb-address-street2 addr)))) + (st3 (if (string= st2 "") "" + (bbdb-read-string "Strasse, Zeile 3: " (bbdb-address-street3 addr)))) + (zip (bbdb-error-retry + (bbdb-parse-zip-string + (bbdb-read-string "PLZ: " (bbdb-address-zip-string addr))))) + (cty (bbdb-read-string "Stadt: " (bbdb-address-city addr))) + (ste (bbdb-read-string "Region/Staat: " (bbdb-address-state addr))) + (country (bbdb-read-string "Land: " (bbdb-address-country addr)))) + (bbdb-address-set-street1 addr st1) + (bbdb-address-set-street2 addr st2) + (bbdb-address-set-street3 addr st3) + (bbdb-address-set-city addr cty) + (bbdb-address-set-state addr ste) + (bbdb-address-set-zip addr zip) + (bbdb-address-set-country addr country) + nil)) +(setq bbdb-address-editing-function 'bbdb-address-edit-continental-german) + +Adding a new formatting function + +You will have to add a new entry to `bbdb-address-formatting-alist'. The new +entry must be a cons cell consisting of an identifying function and a +formatting function. + +I'll use a Japanese format as an example. Please note that I don't really +know how Japanese mail is formatted in Japan. The following reflects +international standards for mail from outside Japan being sent to a Japanese +address. + +First we'll start by adding the identifying function and the formatting +function to `bbdb-address-formatting-alist'. This will controll address +formatting in the *BBDB* buffer. + +(add-to-list 'bbdb-address-formatting-alist + '(bbdb-address-is-japanese . bbdb-format-address-japanese)) + +The identifying function + +The function can do any testing it likes with the address received. In this +case we just test for the country name "Japan". + +(defun bbdb-address-is-japanese (addr) + "Return non-nil if the address ADDR is a japanese address. + +This is a possible identifying function for +`bbdb-address-formatting-alist' and +`bbdb-address-print-formatting-alist'." + (and (string= (upcase (bbdb-address-country addr)) "JAPAN"))) + +The formatting function + +Another paste and copy event: use `bbdb-format-address-default' as a +starting point. + +(defun bbdb-format-address-japanese (addr) + "Insert formated Japanese address ADDR in current buffer. + +This is what it looks like: + location: street1 + street2 + street3 + city + state + zip country" + (insert (format " %14s: " (bbdb-address-location addr))) + (bbdb-format-streets addr) + (let ((c (bbdb-address-city addr)) + (s (bbdb-address-state addr)) + (z (bbdb-address-zip-string addr)) + (y (bbdb-address-country addr))) + (if (or (> (length c) 0) + (> (length s) 0) + (> (length z) 0) + (> (length y) 0)) + (progn + (if (> (length c) 0) + (progn + (indent-to 17) + (insert c "\n"))) + (if (> (length s) 0) + (progn + (indent-to 17) + (insert s "\n"))) + (if (or (> (length z) 0) + (> (length y) 0)) + (progn + (indent-to 17) + (if (> (length z) 0) + (insert z (if (> (length y) 0) " " ""))) + (if (> (length y) 0) + (insert y)) + (insert "\n" ""))))))) + +Print formatting of addresses + +This works just like the example above. Instead of adding the identifying +and formatting functions to `bbdb-address-formatting-alist', you add the two +functions to `bbdb-address-print-formatting-alist'. You can use the same +identifying function that you used in `bbdb-address-formatting-alist'. The +only thing you will have to code up is a print formatting function. It will +be very similar to the normal formatting function. Use +`bbdb-print-format-address-default' as a starting point. The details are +left as an exercise to the reader. +---------------------------------------------------------------------------- + +Navigation: Top, Table of Contents, Index, next: .emacs file by Alex, prev: +Emacs +---------------------------------------------------------------------------- +http://hammer.prohosting.com/~gumbart/bbdb-funcs.html / Alex Schroeder +<a.schroeder@bsiag.ch> / updated: 2000-03-10 / significant changes: +2000-02-11 +---------------------------------------------------------------------------- diff --git a/bits/bbdb-gnokii.el b/bits/bbdb-gnokii.el new file mode 100644 index 0000000..a730b2e --- /dev/null +++ b/bits/bbdb-gnokii.el @@ -0,0 +1,865 @@ +;; bbdb-gnokii.el --- Export phone entries from BBDB to gnokii contacts file. + +;; +;; Copyright (C) 2000, 2003, 2004, 2005, 2006 +;; Martin Schwenke, Reiner Steib, Len Trigg +;; Authors: Martin Schwenke <martin@meltin.net>, +;; Reiner Steib <Reiner.Steib@gmx.de>, +;; Len Trigg <len@reeltwo.com> +;; Maintainer: Martin Schwenke <martin@meltin.net> +;; Created: 23 August 2000 +;; $Id: bbdb-gnokii.el,v 1.16 2006/04/19 13:02:09 martins Exp $ +;; Keywords: BBDB, Nokia, gnokii +;; X-URL: http://meltin.net/hacks/emacs/ + +;; This program 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, or (at your option) +;; any later version. +;; +;; This program 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. +;; +;; If you have not received a copy of the GNU General Public License +;; along with this software, it can be obtained from the GNU Project's +;; World Wide Web server (http://www.gnu.org/copyleft/gpl.html), from +;; its FTP server (ftp://ftp.gnu.org/pub/gnu/GPL), by sending an electronic +;; mail to this program's maintainer or by writing to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + + +;;; Commentary: +;; +;; Exports BBDB phone entries to a contacts file that can be used by +;; gnokii to write them to a Nokia mobile phone. +;; +;; No responsibility for blowing up your phone... blah, blah, blah... +;; I recommend dumping your phone book to a file (using xgnokii, say) +;; and keeping it in a safe place until you are sure that +;; bbdb-gnokii.el doesn't do anything stupid. +;; +;; The latest version of this file is available via: +;; +;; http://meltin.net/hacks/emacs/ +;; +;; The gnokii web site is +;; +;; http://www.gnokii.org/ +;; +;; bbdb-gnokii.el is loosely based on JWZ's bbdb-pilot-jwz.el. +;; +;; gnokii expects a file with the following format: +;; +;; name;number;memory_type;entry_location;caller_group_number;\ +;; subentry_type;subentry_number_type;subentry_id;subentry_text +;; +;; The length and syntax of "name" and "number" are limited, so some +;; munging goes on. You can adjust the munging to your needs by +;; customizing the variables `bbdb-gnokii-firstname-transform', +;; `bbdb-gnokii-lastname-transform' and +;; `bbdb-gnokii-location-transform'. +;; +;; The default settings of these variables reflect Martin's preferences. +;; Here is a combination of alternative settings used by Reiner: +;; +;; (setq +;; ;; Use long firstnames and lastnames and a short location: +;; bbdb-gnokii-firstname-transform 'bbdb-gnokii-transform-word +;; bbdb-gnokii-lastname-transform 12 +;; bbdb-gnokii-location-transform 'bbdb-gnokii-transform-location +;; bbdb-gnokii-max-name-length 16) +;; +;; The memory_type specifies where to write the contacts (phone memory +;; or SIM card). See variable `bbdb-gnokii-default-memory-type' and +;; it's documentation for details. + +;; Configuration: +;; +;; Add this to your ~/.emacs or equivalent: +;; +;; (autoload +;; 'bbdb-gnokii-export +;; "bbdb-gnokii" +;; "Export phone entries from BBDB to a Gnokii contacts file." +;; t) +;; +;; If you want to add some standard entries to your phone, you can put +;; them in a file and set the following variable: +;; +;; (setq bbdb-gnokii-extras-file +;; (expand-file-name "~/.bbdb-gnokii-extras.txt")) +;; +;; The contents of the specified file get appended to the file +;; generated from the BBDB (cf. `bbdb-gnokii-extras-file-position'). +;; My phone vendor preloads a bunch of their numbers into the SIM +;; card, and I'm keeping them until I'm sure they're not useful! +;; +;; Entries are only extracted from the BBDB for entries that have a +;; gnokii field. In general, if this field is present, then all of +;; the phone numbers (except those that have locations listed in +;; `bbdb-gnokii-exclude-locations') will be exported. +;; +;; For example: +;; +;; Fred Smith - Widget, Inc. +;; mobile: (04) 1234 5678 +;; home: (02) 1234 5678 +;; gnokii: t +;; +;; will have 2 items exported: +;; +;; Fred S mobile;0412345678;... +;; Fred S home;0212345678;... +;; +;; For entries with a name, the default generated name is the first +;; word of firstname, space, first letter of lastname. +;; +;; For entries without a name, but with a company, the default +;; generated name is the first word of the company name. +;; +;; The phone number locations are only appended if there is more than +;; 1 phone entry exported. +;; +;; If the gnokii field contains a string in double-quotes, then it +;; will be used as the name. +;; +;; If the gnokii field contains something like location=X then the +;; number for location will be put into speed-dial location X. All +;; other entries are put between `bbdb-gnokii-general-min-location' +;; and `bbdb-gnokii-general-max-location'. +;; +;; If the gnokii field contains something like (Y) then the entry will +;; belong to caller group Y, otherwise +;; `bbdb-gnokii-default-caller-group' is used. +;; +;; So, +;; +;; Fred Smith - Widget, Inc. +;; mobile: (04) 1234 5678 +;; home: (02) 1234 5678 +;; fax: (02) 8765 4321 +;; gnokii: "Freddy" (0) mobile=2 home=3 +;; +;; will have 2 items exported: +;; +;; Freddy mobile;0412345678;...;0; +;; Freddy home;0212345678;...;0; +;; +;; No item is exported for the fax number because it is a member of +;; `bbdb-gnokii-exclude-locations'. +;; +;; If the gnokii field contains "skip=foo", the phone number corresponding to +;; the location "foo" will not be exported. +;; +;; You can also export a whole BBDB record to a single gnokii entry by +;; setting `bbdb-gnokii-phonebook-style' to `multi' or `mega'. In +;; this style the default phone number can be set by specifying the +;; associated location in the BBDB gnokii field. For example, if the +;; gnokii field contains "[work]" then the phone number with location +;; "work" will be the default one. If no default location is +;; specified in the gnokii field, then the order of preference is +;; determined by `bbdb-gnokii-preferred-phone-locations'. If +;; `bbdb-gnokii-phonebook-style' is set to `mega', an email address +;; and postal address are also added to the gnokii entry, when +;; available. + +;; See the variables and code below for more details. You may check all +;; customizable variables using `M-x customize-group RET bbdb-gnokii RET'. + + + +;;; History: + +;; $Log: bbdb-gnokii.el,v $ +;; Revision 1.16 2006/04/19 13:02:09 martins +;; Function bbdb-gnokii-do-name now just uses firstname if lastname is +;; not set. Suggested by Magnus Henoch <mange@freemail.hu>. +;; +;; Revision 1.15 2005/06/06 09:52:49 martins +;; Added support for gnokii entries with multiple phone numbers using +;; subentries, implemented using a variation and subset of code by Len +;; Trigg: new variables bbdb-gnokii-phonebook-style and +;; bbdb-gnokii-preferred-phone-locations; removed variable +;; bbdb-gnokii-insert-extra-fields (replaced by +;; bbdb-gnokii-phonebook-style); removed defstruct bbdb-gnokii; replaced +;; functions bbdb-gnokii-convert and bbdb-gnokii-format with new function +;; bbdb-gnokii-format-record, which has most of the implementation +;; details for this feature; new functions bbdb-gnokii-format-address, +;; bbdb-gnokii-phones-find-location, bbdb-gnokii-get-default-phone; +;; retain '+' in phone number in function bbdb-gnokii-fix-phone; +;; bbdb-gnokii-export just calls bbdb-gnokii-format-record for each +;; record, instead of converting and then formatting; added Len Trigg to +;; to copyright and authors. +;; +;; Revision 1.14 2004/03/30 12:01:29 martins +;; After discussion with Reiner, changed the names of the following +;; variables: +;; +;; bbdb-gnokii-default-group -> bbdb-gnokii-default-caller-group +;; bbdb-gnokii-default-memtype -> bbdb-gnokii-default-memory-type +;; bbdb-gnokii-general-maxpos -> bbdb-gnokii-general-max-location +;; bbdb-gnokii-general-minpos -> bbdb-gnokii-general-min-location +;; bbdb-gnokii-speed-maxpos -> bbdb-gnokii-speed-dial-max-location +;; bbdb-gnokii-speed-minpos -> bbdb-gnokii-speed-dial-min-location +;; +;; for consistency with gnokii documentation, and changed associated +;; documentation accordingly. In struct bbdb-gnokii- changed name of +;; member `mempos' to `location'. Also changed function names: +;; +;; bbdb-gnokii-do-mempos -> bbdb-gnokii-do-location +;; bbdb-gnokii-do-group -> bbdb-gnokii-do-caller-group +;; +;; Revision 1.13 2004/03/02 00:50:53 martins +;; Documentation cleanups by Reiner Steib <Reiner.Steib@gmx.de>. +;; +;; Revision 1.12 2004/02/27 03:40:59 martins +;; bbdb-gnokii-default-memtype now has default value of "SM" (for +;; compatibility with xgnokii >= 0.6) - documentation and customisation +;; choices have also been improved. bbdb-gnokii-default-group's +;; documentation and customisation choices have also been improved. +;; Changes implemented by Reiner Steib <Reiner.Steib@gmx.de>. +;; +;; Revision 1.11 2004/02/25 01:16:08 martins +;; Added RCS Log section in History and imported previous entries. +;; Thanks again to Reiner. +;; +;; Revision 1.10 2004/02/07 11:47:04 martins +;; Replaced uses of bbdb-gnokii-extra-tag with bbdb-gnokii-extra-tags. +;; Oops. + +;; Revision 1.9 2004/02/07 11:40:31 martins +;; `bbdb-gnokii-extra-tags': New variable for Siemens C35 used in +;; `bbdb-gnokii-export'. Exchanged defun and defalias: +;; bbdb-gnokii-export vs. bbdb-to-gnokii-file. Changed documentation +;; section to mention bbdb-gnokii-export, not bbdb-to-gnokii. Renamed +;; function bbdb-record-to-gnokii-records to bbdb-gnokii-convert. Minor +;; cosmetic fixes. Thanks to Reiner Steib <Reiner.Steib@gmx.de>. + +;; Revision 1.8 2004/02/06 03:07:33 martins +;; Merged changes from Reiner Steib <reiner.steib@gmx.de>: Made +;; variables customizable. Did some checkdoc fixes. Made many things +;; more flexible, especially the shortening of firstname, lastname and +;; location strings. Added `bbdb-gnokii-add-field'. Also replaced +;; variable `bbdb-gnokii-maxpos' with `bbdb-gnokii-general-minpos' and +;; `bbdb-gnokii-general-maxpos'. Added information about where to get +;; latest version. Various documentation fixes. Added variable +;; `bbdb-gnokii-insert-extra-fields'. Various documentation fixes. +;; Removed declarations of variables `bbdb-gnokii-mempos' and +;; `bbdb-gnokii-speed-done' (since they are bound in a `let'). + +;; Revision 1.7 2003/07/01 01:44:29 martins +;; Added extra fields to output, which seem to be required for newer +;; phones/gnokiis. + +;; Revision 1.6 2003/06/30 01:58:10 martins +;; (bbdb-gnokii-do-name): Handle case where lastname is empty. + +;; Revision 1.5 2001/02/12 00:10:45 martin +;; Changed e-mail address. + +;; Revision 1.4 2000/10/04 00:41:58 martins +;; Changed default-memtype back to "A". + +;; Revision 1.3 2000/08/25 02:58:15 martins +;; - Added documentation and stuff at top. +;; - Changed spelling from Gnokii to gnokii. +;; - Changed default memory type to work with command-line gnokii. +;; - Reduced allowable length of names. +;; - Added bbdb-gnokii-exclude-locations and associated filtering. +;; Thanks to Chris Yeoh. +;; - Added various comments. + +;; Revision 1.2 2000/08/24 11:52:57 martins +;; Fixed RCS Id string. + +;; Revision 1.1 2000/08/24 11:52:39 martins +;; Initial revision + + +;;; Code: +(require 'bbdb) + +;; Only for `bbdb-gnokii-add-field': +(autoload 'bbdb-merge-interactively "bbdb-snarf" nil nil) +(autoload 'bbdb-add-new-field "bbdb-com" nil nil) + +(defgroup bbdb-gnokii nil + "Sync BBDB and gnokii." + :group 'bbdb) + +(defcustom bbdb-gnokii-transform-word-regexp + (if (string-match "[[:word:]]" "x") + "[^-[:word:]]" + ;; old Emacsen (e.g. Emacs 20) don't support character classes. + "[^-A-Za-z]") + "Regexp used to shorten names in `bbdb-gnokii-transform-word'." + :group 'bbdb-gnokii + :type '(choice (const :tag "first word" "[^-[:word:]]") + (const :tag "ascii" "[^-A-Za-z]") + (regexp :tag "Other"))) + +(defun bbdb-gnokii-transform-max (name &optional limit) + "Limit NAME to LIMIT characters." + (if (> (length name) limit) + (substring name 0 limit) + name)) + +(defun bbdb-gnokii-transform-word (name &optional regexp) + "Shorten NAME to first word. +`bbdb-gnokii-transform-word-regexp' is used unless REGEXP is given." + (substring name + 0 (string-match (or regexp bbdb-gnokii-transform-word-regexp) name))) + +(defun bbdb-gnokii-transform-location (location) + "Shorten LOCATION field." + ;; The default BBDB location "Office" and "Other" both give "O" + (if (string= name "Other") + "o" + (bbdb-gnokii-transform-max location 1))) + +(defcustom bbdb-gnokii-firstname-transform 'bbdb-gnokii-transform-word + "How to transform the lastname field to short variant. +If a function, call it with the name as it's argument. If a number, use +substring with maximal length number." + :group 'bbdb-gnokii + :type '(choice (const bbdb-gnokii-transform-word) + (function) + (integer))) + +(defcustom bbdb-gnokii-lastname-transform 1 + "How to transform the lastname field to short variant. +If a function, call it with the name as it's argument. If a number, use +substring with maximal length number." + :group 'bbdb-gnokii + :type '(choice (const bbdb-gnokii-transform-word) + (function) + (integer))) + +(defcustom bbdb-gnokii-location-transform 10 + "Transform the location field to short variant. +If a function, call it with the name as it's argument. If a number, use +substring with maximal length number." + :group 'bbdb-gnokii + :type '(choice (const bbdb-gnokii-transform-location) + (function) + (integer))) + +(defun bbdb-gnokii-apply-transform (transform name) + "Apply transformation TRANSFORM to NAME and return a shortened name." + (cond + ((functionp transform) + (funcall transform name)) + ((natnump transform) + (bbdb-gnokii-transform-max name transform)) + (t name))) + +(defcustom bbdb-gnokii-extras-file nil + "Name of file containing extra entries to add to gnokii." + :group 'bbdb-gnokii + :type '(choice (const :tag "None" nil) + (file))) + +(defcustom bbdb-gnokii-extra-tags nil + "List of two string elements: \"\(\"tag\" \"indicator\"\)\" or nil. +For each occurance of the form \"location=tag\" in the BBDB gnokii field, the +gnokii string \"indicator\" will be appended to the generated name in the +gnokii file. In some Siemens phones \(C35 and possibly others\), the +indicator \"!\" is used to specify a \"VIP entry\"." + :group 'bbdb-gnokii + :type '(choice (const :tag "Siemens C35 style" ("vip" "!")) + (list (symbol :tag "BBDB tag") + (symbol :tag "Gnokii string")))) + +(defcustom bbdb-gnokii-default-output-file nil + "Name of the default output file. +If the filename contains the string \"%s\", it will be replaced +with the current date in ISO format (YYYY-MM-DD)." + :group 'bbdb-gnokii + :type '(choice (const :tag "None" nil) + (file))) + +(defcustom bbdb-gnokii-extras-file-position 'bottom + "Where to insert `bbdb-gnokii-extras-file'." + :group 'bbdb-gnokii + :type '(choice (const :tag "Top" top) + (const :tag "Bottom" bottom))) + +(defcustom bbdb-gnokii-inserted-hook nil + "Hook run after all records from BBDB were inserted into the output buffer. +The hook is called in the output buffer immediately before saving the buffer." + :group 'bbdb-gnokii + :type 'hook) + +(defcustom bbdb-gnokii-confirm-kill nil + "Ask for confirmation before killing the output buffer." + :group 'bbdb-gnokii + :type 'boolean) + +(defcustom bbdb-gnokii-phonebook-style 'single + "Style for phonebook entries. +This affects the number of phone numbers per gnokii entry and the way +the name is constructed. `single' (the default) allows only a single +phone number per gnokii entry, and also generates a subentry for that +phone number. `ancient' also allows only a single phone number per +gnokii entry, but generates no subentry - older versions of gnokii +seem to work like this. `multiple' causes all phone numbers for a +BBDB entry to be put into a single gnokki entry, using multiple +subentries - in this case the location is also never appended to the +name. `mega' is like multiple but causes the 1st email address and +postal address to also be put into the gnokii entry. Note that +`multiple' and `mega' probably won't work well with +`bbdb-gnokii-default-memory-type' set to \"SM\"." + :type '(choice (const :tag "Single with subentry" single) + (const :tag "Single without subentry" ancient) + (const :tag "Multiple subentries" multiple) + (const :tag "Subentries, email, postal" mega))) + +(defcustom bbdb-gnokii-speed-dial-min-location 1 + "Minimum memory location allowed for speed dial entries. +See also `bbdb-gnokii-general-min-location', +`bbdb-gnokii-general-max-location' and +`bbdb-gnokii-speed-dial-max-location'. The range for speed dial +entries should not overlap with the range for general entries, or +entries found in `bbdb-gnokii-extras-file'." + :group 'bbdb-gnokii + :type 'integer) + +(defcustom bbdb-gnokii-speed-dial-max-location 9 + "Maximum memory location allowed for speed dial entries. +See also `bbdb-gnokii-general-min-location', +`bbdb-gnokii-general-max-location' and +`bbdb-gnokii-speed-dial-min-location'. The range for speed dial +entries should not overlap with the range for general entries, or +entries found in `bbdb-gnokii-extras-file'." + :group 'bbdb-gnokii + :type 'integer) + +(defcustom bbdb-gnokii-general-min-location 10 + "Minimum memory location allowed for general BBDB to gnokii entries. +See also `bbdb-gnokii-general-max-location', +`bbdb-gnokii-speed-dial-min-location' and +`bbdb-gnokii-speed-dial-max-location'. The range for speed dial +entries should not overlap with the range for general entries, or +entries found in `bbdb-gnokii-extras-file'." + :group 'bbdb-gnokii + :type 'integer) + +(defcustom bbdb-gnokii-general-max-location 89 + "Maximum memory location allowed for general BBDB to gnokii entries. +See also `bbdb-gnokii-general-min-location', +`bbdb-gnokii-speed-dial-min-location' and +`bbdb-gnokii-speed-dial-max-location'. The range for speed dial +entries should not overlap with the range for general entries, or +entries found in `bbdb-gnokii-extras-file'." + :group 'bbdb-gnokii + :type 'integer) + +(defcustom bbdb-gnokii-default-memory-type "SM" + "Default type of phone memory to use for BBDB to gnokii entries. +\"SM\" is for SIM card, \"ME\" for the phone memory. In versions prior to +0.6, `xgnokii' used \"A\" is for SIM card and \"B\" for the phone memory. +Please see the documentation of gnokii and xgnokii for valid values." + :group 'bbdb-gnokii + :type '(choice (const :tag "SIM card" "SM") + (const :tag "phone memory" "ME") + (const :tag "SIM card (for old xgnokii)" "A") + (const :tag "phone memory (for old xgnokii)" "B") + ;; Other valid memory types probably aren't writable. + (string :tag "Other"))) + +(defcustom bbdb-gnokii-default-caller-group 5 + "Default caller group to put BBDB to gnokii entries into. + +If the gnokii field contains something like \"\(N\)\" then the entry will +belong to caller group N, otherwise `bbdb-gnokii-default-caller-group' +is used. Possible values are 0 \(Family\), 1 \(VIP\), 2 \(Friends\), +3 \(Colleagues\), 4 \(Other group\), 5 \(No group\). Note that these +are defaults, you are able to change these manually in your phone. +See also \"caller_group_number\" in the documentation of gnokii." + :group 'bbdb-gnokii + :type '(choice (const :tag "0 (Family)" 0) + (const :tag "1 (VIP)" 1) + (const :tag "2 (Friends)" 2) + (const :tag "3 (Colleagues)" 3) + (const :tag "4 (Other group)" 4) + (const :tag "5 (No group)" 5) + (integer :tag "Other"))) + +(defcustom bbdb-gnokii-max-name-length 17 + "Maximum allowable length of name field." + :group 'bbdb-gnokii + :type 'integer) + +(defcustom bbdb-gnokii-exclude-locations '("fax") + "List of locations for phone numbers to exclude." + :group 'bbdb-gnokii + :type '(choice (const :tag "None" nil) + (const :tag "Fax" '("fax")) + (repeat (string :tag "Field")))) + +(defcustom bbdb-gnokii-preferred-phone-locations '("mobile" "home" "work") + "List of locations for choosing default phone number in multi-phone entries. +The phone number associated with earliest location in this list is used. +Otherwise, the first phone number is used." + :group 'bbdb-gnokii + :type '(choice (repeat (string :tag "Field")))) + +(defconst bbdb-gnokii-label-type-alist + '(("home" . 2) + ("mobile" . 3) + ("fax" . 4) + ("office" . 6) + ("work" . 6) + ("." . 10)) + "Alist mapping BBDB phones labels to gnokii phone number types.") + +(defun bbdb-gnokii-format-record (record) + "Convert a BBDB RECORD to text in the current buffer." + + (let ((allphones (bbdb-record-phones record)) + (allnet (bbdb-record-net record)) + (alladdresses (bbdb-record-addresses record)) + (stuff (if (listp (bbdb-record-raw-notes record)) + (cdr (assq 'gnokii (bbdb-record-raw-notes record))))) + (subentry-id 0) + name useloc phones default-phone print-escape-newlines) + + (setq name (bbdb-gnokii-do-name (bbdb-record-lastname record) + (bbdb-record-firstname record) + (bbdb-record-company record) + stuff)) + + ;; Filter out unwanted phone locations and find default phone number. + (while allphones + (let ((p (car allphones))) + (if (not (or (member (bbdb-phone-location p) + bbdb-gnokii-exclude-locations) + (string-match (concat "\\<skip=\\(" + (bbdb-phone-location p) + "\\)\\>") + (or stuff "")))) + (add-to-list 'phones p))) + (setq allphones (cdr allphones))) + + (if (memq bbdb-gnokii-phonebook-style '(multiple mega)) + (setq default-phone (bbdb-gnokii-get-default-phone phones stuff))) + + ;; Only continue if they have a name, a gnokii field and some + ;; phone numbers. + (if (and name stuff phones) + (progn + ;; Only add the location to name if there is >1 phone number + ;; and we're not doing multiple-subentries. + (setq useloc (and (> (length phones) 1) + (memq bbdb-gnokii-phonebook-style + '(ancient single)))) + ;; Create records. + (while phones + (let* ((location (bbdb-phone-location (car phones))) + (loc (bbdb-gnokii-apply-transform + bbdb-gnokii-location-transform + location)) + (num (bbdb-gnokii-fix-phone + (bbdb-phone-string (car phones)))) + (default-loc (or (and default-phone + (bbdb-gnokii-apply-transform + bbdb-gnokii-location-transform + (bbdb-phone-location default-phone))) + loc)) + (default-num (or (and default-phone + (bbdb-gnokii-fix-phone + (bbdb-phone-string default-phone))) + num)) + (name (if useloc (concat name " " loc) name))) + (if (> (length name) bbdb-gnokii-max-name-length) + ;; Don't error out on long entries, truncate them instead. + (progn + (message + (concat + "Name \"%s\" is too long. " + "Maybe you want to edit gnokii field.") + name) + (setq + name + (cond + ;; Make sure we don't strip location: + (useloc + (concat + (bbdb-gnokii-transform-max + name (- bbdb-gnokii-max-name-length + (1+ (length loc)))) + " " loc)) + (t + (bbdb-gnokii-transform-max + name bbdb-gnokii-max-name-length)))))) + ;; Checking for bbdb-gnokii-extra-tags: + (when (and (car bbdb-gnokii-extra-tags) + (cadr bbdb-gnokii-extra-tags) + location + (string-match + (concat + "\\<" location + "=" + (regexp-quote (car bbdb-gnokii-extra-tags)) + "\\>") + stuff)) + ;; extra entry found, changing label: + (setq name + (concat (bbdb-gnokii-transform-max + name (- bbdb-gnokii-max-name-length 1)) + (cadr bbdb-gnokii-extra-tags)))) + + (if (= subentry-id 0) + (insert (format "%s;%s;%s;%s;%s" + name + default-num + bbdb-gnokii-default-memory-type + (bbdb-gnokii-do-location stuff default-loc) + (bbdb-gnokii-do-caller-group stuff)))) + (if (not (eq bbdb-gnokii-phonebook-style 'ancient)) + (insert (format ";11;%d;%d;%s" + (assoc-default location + bbdb-gnokii-label-type-alist + 'string-match nil) + subentry-id + num))) + + ;; Continute along list of phone numbers. + (setq phones (cdr phones)) + ;; If doing multiple per entry, increment subentry-id count. + (if (memq bbdb-gnokii-phonebook-style '(multiple mega)) + (setq subentry-id (1+ subentry-id)) + (insert "\n")))) + + (when (eq bbdb-gnokii-phonebook-style 'mega) + ;; First email address? + (when allnet + (insert (format ";8;0;%d;%s" subentry-id (car allnet))) + (setq subentry-id (1+ subentry-id))) + ;; First postal address? + (when alladdresses + (insert (format ";9;0;%d;%s" subentry-id + (bbdb-gnokii-format-address (car alladdresses)))) + (setq subentry-id (1+ subentry-id)))) + (if (memq bbdb-gnokii-phonebook-style '(multiple mega)) + (insert "\n")) + )))) + +(defun bbdb-gnokii-format-address (address) + "Generates a single-line representation of an address." + (let (st field) + (cond ((>= bbdb-file-format 6) + (setq st (bbdb-join (bbdb-address-streets address) "\\n"))) + (t + (setq st (bbdb-address-street1 address)) + (if (> (length (bbdb-address-street2 address)) 0) + (setq st (concat st "\\n" (bbdb-address-street2 address)))) + (if (> (length (bbdb-address-street3 address)) 0) + (setq st (concat st "\\n" (bbdb-address-street3 address)))))) + (setq field (bbdb-address-city address)) + (if (> (length field) 0) (setq st (concat st "\\n" field))) + (setq field (bbdb-address-state address)) + (if (> (length field) 0) (setq st (concat st "\\n" field))) + (setq field (bbdb-address-zip-string address)) + (if (> (length field) 0) (setq st (concat st "\\n" field))) + (setq field (bbdb-address-country address)) + (if (> (length field) 0) (setq st (concat st "\\n" field))) + st)) + +(defun bbdb-gnokii-do-name (lastname firstname company stuff) + "Construct a name from the given arguments." + + (let (name) + + (cond + + ((and stuff + (string-match "\"\\([^\"]+\\)\"" stuff)) + (setq name (substring stuff (match-beginning 1) (match-end 1)))) + + (firstname + ;; Yay, they have a name! Default is first word of firstname, + ;; space, first letter of lastname. + (setq name + (bbdb-gnokii-apply-transform + bbdb-gnokii-firstname-transform firstname)) + (when (> (length lastname) 0) + (setq name + (concat name + " " + (setq name + (bbdb-gnokii-apply-transform + bbdb-gnokii-lastname-transform lastname)))))) + (company + ;; Yay, first word of company name! + ;; Maybe this should be made customizable, too (Reiner Steib). + (setq name (substring company 0 (string-match " " company))))) + name)) + + +(defun bbdb-gnokii-do-location (stuff loc) + "Calculate the `location' field for a gnokii record. +The field content STUFF and the location LOC are used." + + (let (num) + (if (and stuff + (string-match (concat "\\<" loc "=\\([0-9]+\\)") stuff)) + (progn + (setq num (string-to-number + (substring stuff (match-beginning 1) (match-end 1)))) + (if (or (< num bbdb-gnokii-speed-dial-min-location) + (> num bbdb-gnokii-speed-dial-max-location) + (member num bbdb-gnokii-speed-done)) + (error + "Speed dial location %d out of range or duplicate for %s" + num name) + (add-to-list 'bbdb-gnokii-speed-done num))) + (if (> bbdb-gnokii-location bbdb-gnokii-general-max-location) + (error "Too many records to fit in SIM card!")) + (setq num bbdb-gnokii-location) + (setq bbdb-gnokii-location (+ bbdb-gnokii-location 1))) + num)) + +(defun bbdb-gnokii-do-caller-group (bbdb-field) + "Calculate the caller `group' field for given BBDB-FIELD." + + (let (group) + (if (and bbdb-field + (string-match "(\\([0-9]+\\))" bbdb-field)) + (setq group (string-to-number + (substring bbdb-field (match-beginning 1) (match-end 1)))) + (setq group bbdb-gnokii-default-caller-group)) + group)) + +(defun bbdb-gnokii-phones-find-location (location phones) + "Return the phone element in PHONES with given LOCATION, nil if not found." + (let ((ps phones) + ret) + (while (and (not ret) ps) + (if (string= location (bbdb-phone-location (car ps))) + (setq ret (car ps))) + (setq ps (cdr ps))) + ret)) + +(defun bbdb-gnokii-get-default-phone (phones stuff) + "Get the default phone entry for a record." + + (let* ((loc (and stuff + (string-match "\\[\\([^]]+\\)\\]" stuff) + (substring stuff (match-beginning 1) (match-end 1)))) + (locs bbdb-gnokii-preferred-phone-locations) + ret) + + (if loc + (setq ret (bbdb-gnokii-phones-find-location loc phones))) + + (while (and (not ret) locs) + (setq ret (bbdb-gnokii-phones-find-location (car locs) phones)) + (setq locs (cdr locs))) + (or ret (car phones)))) + +(defun bbdb-gnokii-fix-phone (phone) + "Change phone number PHONE to gnokii compatible form." + + (let ((chars phone) + out) + (while (> (length chars) 0) + (let ((h (substring chars 0 1))) + (if (string-match "[+0-9]" h) + (setq out (concat out h))) + (setq chars (substring chars 1)))) + out)) + +;;;###autoload +(defalias 'bbdb-to-gnokii-file 'bbdb-gnokii-export) + +;;;###autoload +(defun bbdb-gnokii-export (filename &optional records) + "Export phone entries from BBDB to a gnokii contacts file FILENAME. +Unless RECORDS is given, all BBDB entries are processed." + (interactive + (list (let ((default (if (stringp bbdb-gnokii-default-output-file) + (format bbdb-gnokii-default-output-file + (format-time-string "%Y-%m-%d" (current-time))) + default-directory))) + (read-file-name "Output file: " + (file-name-directory default) + default + nil + (file-name-nondirectory default))))) + (or records (setq records (bbdb-records))) + (save-excursion + (set-buffer (find-file-noselect filename)) + (erase-buffer) + (let ((len (length records)) + (i 0) + (bbdb-gnokii-location bbdb-gnokii-general-min-location) + bbdb-gnokii-speed-done) + (while records + (message "%d%%..." (/ (* 100 i) len)) + (bbdb-gnokii-format-record (car records)) + (setq records (cdr records) + i (1+ i)))) + (when (and bbdb-gnokii-extras-file + (file-readable-p bbdb-gnokii-extras-file)) + (cond ((eq bbdb-gnokii-extras-file-position 'top) + (goto-char (point-min))) + ((eq bbdb-gnokii-extras-file-position 'bottom) + (goto-char (point-max)))) + (insert-file-contents bbdb-gnokii-extras-file)) + (run-hooks 'bbdb-gnokii-inserted-hook) + (save-buffer) + ;; Useful especially when testing. + (when (or (not bbdb-gnokii-confirm-kill) + (y-or-n-p "Kill output buffer? ")) + (kill-buffer (current-buffer)))) + filename) + +;;;###autoload +(defun bbdb-gnokii-add-field (&optional records) + "Go through all RECORDS and ask for adding a gnokii field. +If RECORDS is nil, go thru all records. If a BBDB record has an +expire field in YYYY-MM-DD format \(e.g. \"expire=2003-12-31\"\), +the record is skipped if it is older than today." + (interactive) + (or records (setq records (bbdb-records))) + (bbdb-add-new-field 'gnokii) + (dolist (record records) + ;; Go thru all records, check if we have a phone and no gnokii field. + (if (bbdb-record-phones record) + (let* ((have-gnokii + (and (listp (bbdb-record-raw-notes record)) + (cdr (assq 'gnokii (bbdb-record-raw-notes record))))) + (expire + (and (listp (bbdb-record-raw-notes record)) + (cdr (assq 'expire (bbdb-record-raw-notes record))))) + (name (bbdb-record-name record)) + (is-expired (and + expire + (string-lessp expire + (format-time-string + "%Y-%m-%d" (current-time)))))) + (message "In record `%s': gnokii=`%s', expire=`%s', is-exp=`%s'" + name have-gnokii expire is-expired) + (cond + (is-expired + (message "In record `%s': is expired." name)) + (have-gnokii + (message "In record `%s': already has gnokii field." name)) + ((y-or-n-p (format "Add gnokii field to `%s'? " name)) + (bbdb-merge-interactively name;; name + nil ;; company + nil ;; net + nil ;; addrs + nil ;; phones + '((gnokii . "t"))) + (message "In record `%s': gnokii field added." name)) + (t + (message "In record `%s': gnokii refused interactively." name)))) + (message "In record `%s': no phone found." (bbdb-record-name record))))) + +(provide 'bbdb-gnokii) + +;;; bbdb-gnokii.el ends here diff --git a/bits/bbdb-ldif.el b/bits/bbdb-ldif.el new file mode 100644 index 0000000..7f6df8c --- /dev/null +++ b/bits/bbdb-ldif.el @@ -0,0 +1,821 @@ +;;; Copyright (C) 1998,2000 by Niels Elgaard Larsen <elgaard@diku.dk> + +;;; $Log: bbdb-ldif.el,v $ +;;; Revision 1.1 2006/02/04 15:35:15 joerg +;;; Added +;;; +;;; Revision 1.1 2005/02/13 14:16:03 waider +;;; * added new file, with minor abuse to make it work with current BBDB +;;; +;;; Revision 1.7 2000/03/15 14:16:44 elgaard +;;; Fixed problem with concatenation of strings/integers +;;; Changed mobiletelephonenumber to cellphone to follow Netscape :-( +;;; Added support for pagerphone +;;; +;;; Revision 1.6 1998/09/08 12:35:27 elgaard +;;; Works with xemacs, emacs, emacs-19.34, bbdb-2 and bbdb-1.51 +;;; Bugfixes +;;; +;; Rev 0.3 +;; Can export mail-alias'es and .mailrc aliases to Netscape Mailing List +;;Bugfix. +;; + +;; Rev. 0.2.1 +;; Compiles without MEL + +;; Rev. 0.2 +;; Notes work better now +;; added 'bbdb-elided-export-ldif' +;; Fixed base64 bug + +;; This program 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 of the License, or +;; (at your option) any later version. + +;; This program 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 program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Niels Elgaard Larsen, <URL:mailto:elgaard@diku.dk> +;; July 18, 1998 + +;; bbdb-import-ldif imports LDIF entries +;; bbdb-to-ldif export bbdb to LDIF. + +;; Both functions are somewhat specialized for Netscape Communicator (and Mozilla) + + + +;;; Installation: + +;;; Put (add-hook 'bbdb-load-hook (function (lambda () (require 'bbdb-ldif)))) +;;; into your .emacs, or autoload it. + + +;; If you use non-ASCII characters recode the output file from emacs: +;; "recode ..UTF-8 output.ldif" +;; and the input file from Netscape: +;; "recode UTF-8.. i2.ldif " +;;;;;; Does not work for base-64 encoded text. + +(require 'bbdb) + +;; WAIDER MOD FEB 2005 +;; deprecated functions. I should fix the code rather than do this, but. +(defun bbdb-address-street1(addr) + (nth 0 (bbdb-address-streets addr))) +(defun bbdb-address-street2(addr) + (nth 1 (bbdb-address-streets addr))) +(defun bbdb-address-street3(addr) + (nth 2 (bbdb-address-streets addr))) + +(if (locate-library "mel") (require 'mel) + (message "We try without MEL (base64 operation), multiline fields will not work" + ) + ) + +(if (fboundp 'split-string) nil + (defun split-string (string &optional pattern) + "Return a list of substrings of STRING which are separated by PATTERN. +If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." + (or pattern + (setq pattern "[ \f\t\n\r\v]+")) + ;; The FSF version of this function takes care not to cons in case + ;; of infloop. Maybe we should synch? + (let (parts (start 0)) + (while (string-match pattern string start) + (setq parts (cons (substring string start (match-beginning 0)) parts) + start (match-end 0))) + (nreverse (cons (substring string start) parts)))) + ) + +(if (fboundp 'caadr) nil (defun caadr (foo) (car (car (cdr foo))))) + + + +(defvar bbdb-ldif-nsnil "?" "Null name for Netscape") + +(defun tnsnil (st) + (if (equal st bbdb-ldif-nsnil) + nil + st)) + +(defvar bbdb-elided-export-ldif nil "Set this to a list of some +of the symbols '(address phone net notes) to select those fields to be left +out when exporting to LDIF format" +) + +;(require 'bbdb-snarf) +(require 'bbdb-com) + + +(defvar bbdb-ldif-prefix "xbbdb") +(defvar bbdb-ldif-prefixh "xhbbdb") + +;;;; From bbdb-snarf with bugfix: +(defun bbdb-merge-internally-ldif (old-record new-record) + "Merge two records. NEW-RECORDS wins over OLD in cases of ties." + (if (and (null (bbdb-record-firstname new-record)) + (bbdb-record-firstname old-record)) + (bbdb-record-set-firstname new-record (bbdb-record-firstname old-record))) + (if (and (null (bbdb-record-lastname new-record)) + (bbdb-record-lastname old-record)) + (bbdb-record-set-lastname new-record (bbdb-record-lastname old-record))) + (if (and (null (bbdb-record-company new-record)) + (bbdb-record-company old-record)) + (bbdb-record-set-company new-record (bbdb-record-company old-record))) + ;; nets + (let ((old-nets (bbdb-record-net old-record)) + (new-nets (bbdb-record-net new-record))) + (while old-nets + (if (not (member (car old-nets) new-nets)) + (setq new-nets (append new-nets (list (car old-nets))))) + (setq old-nets (cdr old-nets))) + (bbdb-record-set-net new-record new-nets)) + ;; addrs + (let ((old-addresses (bbdb-record-addresses old-record)) + (new-addresses (bbdb-record-addresses new-record))) + (while old-addresses + (if (not (member (car old-addresses) new-addresses)) + (setq new-addresses (append new-addresses (list (car old-addresses))))) + (setq old-addresses (cdr old-addresses))) + (bbdb-record-set-addresses new-record new-addresses)) + ;; phones + (let ((old-phones (bbdb-record-phones old-record)) + (new-phones (bbdb-record-phones new-record))) + (while old-phones + (if (not (member (car old-phones) new-phones)) + (setq new-phones (append new-phones (list (car old-phones))))) + (setq old-phones (cdr old-phones))) + (bbdb-record-set-phones new-record new-phones)) + ;; notes + (let ((old-notes (bbdb-ensure-list (bbdb-record-raw-notes old-record))) + (new-notes (bbdb-ensure-list (bbdb-record-raw-notes new-record)))) + (while old-notes + (if (not (member (car old-notes) new-notes)) + (setq new-notes (append new-notes (list (car old-notes))))) + (setq old-notes (cdr old-notes))) + (bbdb-record-set-raw-notes new-record new-notes)) + ;; return + new-record) + +(defun bbdb-ensure-list (foo) + (if (lisp foo) foo + (list foo) + ) + ) + +(defun bbdb-zulu (date) + (if (fboundp 'bbdb-time-convert) + (bbdb-time-convert date "%Y%m%d%H%Mz") + date ;; bbdb1.51 does not use it anyway. + ) +) + +(defun bbdb-unzulu (date) + (if (eq (length date) 13) + (format "%s-%s-%s" (substring date 0 4) (substring date 4 6) (substring date 6 8)) + date) +) +(defun bbdb-ldif-indent (str) + (if (> (length str) 70) + (concat (substring str 0 65) "\n " (bbdb-ldif-indent (substring str 65))) + str) +) + +(defun addnote (nrec nname note) + (bbdb-record-set-raw-notes + nrec (cons (cons nname note) (bbdb-record-raw-notes nrec) ) + ) + ) + +(defmacro alias-update () + (if (fboundp 'bbdb-define-all-aliases) (list 'bbdb-define-all-aliases)) +) + +(defmacro alias-setup () + (if (fboundp 'mail-aliases-setup) (list 'mail-aliases-setup)) +) + +(defmacro domailaliases () + (fboundp 'mail-aliases-setup) +) + + +(defmacro dodenote (st) + (if (fboundp 'base64-decode-string) + (list 'base64-decode-string st) + "?" + ) +) + +(defun addtonote (ton str) + (cond + ((and ton str) (concat ton "\n" str)) + (str (concat "--bbdb--\n" str)) + (ton) + ) + ) + +(defun setaddr (nrec afun val) + (if (not (bbdb-record-addresses nrec)) + (let ((addr(make-vector bbdb-address-length ""))) + (bbdb-record-set-addresses nrec (list addr)) + (bbdb-address-set-location addr "address") + ) + ) + (eval (list afun (car (bbdb-record-addresses nrec)) val)) + ) + + +(defun setphone (nrec iloc pno np) + (let ((nov (bbdb-parse-phone-number pno)) + (pv (make-vector bbdb-phone-length "")) + (ploc iloc) + ) + (if (and np (equal (car np) (concat bbdb-ldif-prefixh "PhoneLoc"))) + (setq ploc (cdr np)) + ) + + (if (and nov bbdb-north-american-phone-numbers-p) + (progn + (bbdb-phone-set-location pv ploc) + (bbdb-phone-set-area pv (nth 0 nov)) + (bbdb-phone-set-exchange pv (nth 1 nov)) + (bbdb-phone-set-suffix pv (nth 2 nov)) + (bbdb-phone-set-extension pv (or (nth 3 nov) 0)) + ) + (setq pv (vector ploc pno)) + ) + (bbdb-record-set-phones nrec(append (bbdb-record-phones nrec)(list pv))) + ) + ) + +(defun bbdb-string-fetch (key mls) + (let ((tmls (car mls)) res) + (while (and (not res) (car tmls)) + (if (string-match (format "%s= *\\(.+\\)" key) (car tmls)) + (setq res (match-string 1 (car tmls)))) + (setq tmls (cdr tmls))) + res + ) + ) + +(defun bbdb-ldif-get-phone (atts df) + (if (and (cdr atts) (equal (concat bbdb-ldif-prefixh "phoneloc") (caadr atts))) + (cdr (cadr atts)) + df) +) + +(defun bbdb-import-ldif () + "import LDIF entries for current buffer +Mailinglists \(groupOfNames\) are imported as entries in bbdb mail-alias fields." + (interactive) +; (message (concat (/(* 100 (point)) (point-max)) " pct\n")) +;; (message (concat "\nnew rec at" (point))) + (let ((reclist (split-string (buffer-substring 1 (point-max)) "\n[ \t\r]*\n")) + (numr 0) maxr (opct 0) pct mailinglists (emptyrec (make-vector bbdb-record-length nil)) + ) + (setq maxr (length reclist)) + (mapcar + (lambda (rec) + (if (not (equal "" rec)) + (let ( + (atts (mapcar (lambda (at) + (if (equal (string-to-char at) ?\ ) + (cons 'continuation (substring at 1)) + (let ( (cpos (string-match ":" at))) + (if cpos + (let ((cpos2 ( string-match "[^ \t]" at (1+ cpos)))) + (if cpos2 + (cons (substring at 0 cpos) (substring at cpos2)) + ) + ) + ) + ) + ) + ) + (split-string rec "[\n\r]+")) + ) + ) + (setq pct (/ (* 100 numr) maxr)) + (if (/= opct pct) + (progn + (setq opct pct) + (message (concat pct " pct")) + ) + ) + (setq numr (1+ numr)) + + (if (member '("objectclass" . "groupOfNames") atts) + (let (mlcn lmlist) + (while atts + (if (car atts) + (let ((attName (downcase (caar atts))) + (attVal (cdar atts)) + ) + (while (and (cdr atts) (equal (caadr atts) 'continuation)) + (setq atts (cdr atts)) + (setq attVal (concat attVal (cdar atts))) + ) + (if (equal (string-to-char attVal) ?:) + (setq attVal (dodenote (substring attVal (string-match "[^: \t]" attVal))))) + + (cond + ((or (equal attName "cn") (equal attName "commonname")) (setq mlcn attVal)) + ((equal attName "member") + (setq lmlist (cons (bbdb-split attVal ",") lmlist)) + ) + ) + ) + ) + (setq atts (cdr atts)) + ) ; while + (setq mailinglists (cons (cons mlcn lmlist) mailinglists)) + ) + (let ( + (new-record (make-vector bbdb-record-length nil))) + (while atts + (if (stringp (car-safe (car-safe atts))) + (let ( + (attName (downcase (caar atts))) + (attVal (cdar atts)) + (nextAtt (car-safe (cdr-safe atts))) + ) + + (while (and (cdr atts) (equal (caadr atts) 'continuation)) + (setq atts (cdr atts)) + (setq attVal (concat attVal (cdar atts))) + ) + (if (equal (string-to-char attVal) ?:) + (setq attVal + (dodenote (substring attVal (string-match "[^: \t]" attVal)))) + ) + (cond + ;((or (equal attName "cn") (equal attName "commonname")) hmm) + ((or (equal attName "sn") (equal attName "surname")) (bbdb-record-set-lastname new-record attVal)) + ((equal attName "givenname") (bbdb-record-set-firstname new-record attVal)) + ((equal attName "o") (bbdb-record-set-company new-record attVal)) + ((equal attName "locality") (setaddr new-record 'bbdb-address-set-city attVal)) + ((equal attName "postalcode") (setaddr new-record 'bbdb-address-set-zip attVal)) + ((equal attName "st") (setaddr new-record 'bbdb-address-set-state attVal)) + ((equal attName (concat bbdb-ldif-prefixh "mainaddrloc")) + (setaddr new-record 'bbdb-address-set-location attVal)) + + ;; This is ugly. But is it the only way Netscape understands. + ((equal attName "postofficebox") (setaddr new-record 'bbdb-address-set-street1 attVal)) + ((equal attName "streetaddress") (setaddr new-record 'bbdb-address-set-street2 attVal)) + + ((equal attName "mail") + (bbdb-record-set-net new-record (cons attVal (bbdb-record-net new-record)))) + + ((equal attName "mailalternateaddress") + (bbdb-record-set-net new-record (append (bbdb-record-net new-record) + (list attVal))) + ) + + ((equal attName "postaladdress") + (let ( + (alines (split-string (concat (bbdb-ldif-renl attVal) "\n")"[\n\r]")) + (addr (make-vector bbdb-address-length ""))) + (if (and (string-match "^bbdb=" (nth 0 alines )) + (> (length alines) 6)) + (progn + (bbdb-address-set-location addr (substring (nth 0 alines) 5)) + (bbdb-address-set-street1 addr (nth 1 alines)) + (bbdb-address-set-street2 addr (nth 2 alines)) + (bbdb-address-set-street3 addr (nth 3 alines)) + (bbdb-address-set-zip addr (nth 4 alines)) + (bbdb-address-set-city addr (nth 5 alines)) + (bbdb-address-set-state addr (nth 6 alines)) + (bbdb-record-set-addresses + new-record + (append (bbdb-record-addresses new-record) (list addr)) + ) + ) + ) + ) + ) + + + ((equal attName "homephone") + (setphone new-record (bbdb-ldif-get-phone atts "Private") attVal nextAtt) ) + ((equal attName "facsimiletelephonenumber") + (setphone new-record (bbdb-ldif-get-phone atts "Fax") attVal nextAtt)) + ((equal attName "pagerphone") + (setphone new-record (bbdb-ldif-get-phone atts "pagerphone") attVal nextAtt)) + ((equal attName "cellphone") + (setphone new-record (bbdb-ldif-get-phone atts "cellphone") attVal nextAtt)) + ((equal attName "mobiletelephonenumber") + (setphone new-record (bbdb-ldif-get-phone atts "cellphone") attVal nextAtt)) + ((equal attName "telephonenumber") + (setphone new-record (bbdb-ldif-get-phone atts "Work") attVal nextAtt)) + ((equal attName "xmozillanickname") (bbdb-record-set-aka new-record (list attVal))) + ((or (equal attName "description") (equal attName "multilinedescription")) + (if (equal attName "multilinedescription") + (setq attVal (bbdb-ldif-renl attVal))) + (let ((thenote (substring attVal 0 (string-match "\n?--bbdb--\n" attVal)))) + (if (not (equal "" thenote)) + (addnote new-record 'notes thenote) + ) + ) + ) + + ((equal attName "createTimestamp") + (addnote new-record 'creation-date (bbdb-unzulu attVal))) + ((equal attName "modifyTimestamp") + (addnote new-record 'timestamp (bbdb-unzulu attVal))) + ((eq (string-match bbdb-ldif-prefix attName) 0) + (let ( + (bbdb-ldif-note (make-symbol (substring attName (length bbdb-ldif-prefix))))) + (bbdb-record-set-raw-notes new-record + (cons (cons bbdb-ldif-note attVal) + (bbdb-record-raw-notes new-record))) + ) + ) + ) + ) + ) + (setq atts (cdr atts)) + ) + ; (print new-record) + (if (not (equal new-record emptyrec)) + (progn + (bbdb-record-set-cache new-record (make-vector bbdb-cache-length nil)) + (let ((old-record +;; (and (bbdb-record-net new-record) + (bbdb-search-simple (tnsnil (bbdb-record-name new-record)) + (car (bbdb-record-net new-record))) +;; ) + ) + ) + (if old-record + (progn + (setq new-record (bbdb-merge-internally-ldif old-record new-record)) + (bbdb-delete-record-internal old-record))) + ;; create new record + (bbdb-invoke-hook 'bbdb-create-hook new-record) + (bbdb-change-record new-record t) + (bbdb-hash-record new-record) + ) + ) + ) + ) + ) + + ) + ) ; if + ) ; lambda + reclist + ) + (mapcar + (lambda (mlist) + (let ( + (mlcn (car mlist)) (lmlist (cdr mlist))) + (if mlcn + (while lmlist + (let ( + (mnet (bbdb-string-fetch"mail" lmlist)) + (mname (bbdb-string-fetch"cn" lmlist)) + (mcomp (bbdb-string-fetch"o" lmlist)) +;; (mou (bbdb-string-fetch"ou" lmlist)) + (therecs (bbdb-records)) + therec + mal + ) + (if mnet (setq therecs (bbdb-search therecs nil nil mnet nil))) + (if mname (setq therecs (bbdb-search therecs mname nil nil nil ))) + (if mcomp (setq therecs (bbdb-search therecs nil mcomp nil nil nil ))) + + (cond ((not therecs) + (message (concat "Mailing list member not found: " mname " " mnet))) + ((= (length therecs) 1) + (setq therec (car therecs)) + (setq mal (assq 'mail-alias (bbdb-record-raw-notes therec))) + (if (not mal) + (progn + (setq mal (cons 'mail-alias "")) + (bbdb-record-set-raw-notes therec (cons mal (bbdb-record-raw-notes therec)))) + (bbdb-change-record therec nil) + (bbdb-hash-record therec) + ) + (if (not (member mlcn (split-string (cdr mal) "[, ]"))) + (setcdr mal (concat mlcn (if (> (length (cdr-safe mal)) 0) "," "") (cdr mal) ))) + ) + (t (message "Mailing List member not unique %s, %s" mname mnet)) + ) + ) + (setq lmlist (cdr lmlist)) + ) + ; (define-mail-alias cn lmlist) + ) + ) + ) + mailinglists + ) + ) +(message nil) +) + + + +(defun rmspace (str) + (apply 'concat (bbdb-split str "\n\r"))) + +(defun bbdb-ldif-replace-string (str frs tos) + (let ((start 0)) + (while (string-match frs str start) + (setq str + (concat (substring str 0 (match-beginning 0)) + tos + (substring str (match-end 0)))) + (setq start (+ (length tos) (match-beginning 0)))) + ) +str +) + + +(defun bbase64-encode-string (st) + (concat ":" (bbdb-ldif-indent (rmspace st)) + ) + ) + +(defun bbdb-ldif-rmnl (str) + (bbdb-ldif-replace-string (bbdb-ldif-replace-string str "\\$" "\\24") "\n" "$") +) + +(defun bbdb-ldif-renl (str) + (bbdb-ldif-replace-string (bbdb-ldif-replace-string str "\\$" "\n") "\\\\24" "$") +) + +(defmacro donote (st) + (if (fboundp 'base64-encode-string) + (list 'bbase64-encode-string (list 'base64-encode-string st)) + (list 'bbdb-ldif-rmnl st) + ) +) + +(defun base64IfMulti (st) + (if (string-match "\n" st) + (donote st) + (concat " " (bbdb-ldif-indent st)) + ) +) + +(defun nsloc (pl) "Guess mapping from userdefined bbdb locations to NS Work/Home/Fax" + (let ( + (pld (and pl (downcase pl))) + (fc (and pl (not (equal pl "")) (string-to-char (downcase pl)))) + ) + (cond ( (not fc) "telephonenumber") + ((or (= fc ?a) (= fc ?w)) "telephonenumber") + ( (= fc ?h) "homephone") +;; ( (= fc ?m) "mobileTelephoneNumber") + ( (equal pld "private") "homephone") + ( (= fc ?m) "cellphone") + ( (and (= fc ?p) (> (length pld) 1) (= (aref pld 1) ?a)) "pagerphone") + ( (equal pld "fax") "facsimiletelephonenumber") + ( t "telephonenumber") + ) + ) +) + +(defun tnil(tt) + (if tt tt "?")) + +(defvar ldifbuffer "*LDIF*" "Name of buffer for LDIF output") + +(defun bbdb-to-ldif (visible-records) "Converts BBDB to LDIF format. Can be used to export bbdb to Netscape +Communicator Address book.\\<bbdb-mode-map> +If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb2ldif]\" is \ +used instead of simply \"\\[bbdb2ldif]\", then includes only the +people currently in the *BBDB* buffer. +The result is placed in a buffer name \"*LDIF*\" +If MEL is installed Multiline notes/descriptions work with Netscape address book. +Mail-aliases from mailrc file or bbdb mail-aliases fields are exported as mainglists +\(GroupOfNames\) +" + (interactive (list + (bbdb-do-all-records-p) + ) + ) + (let* ( + (target (cons bbdb-define-all-aliases-field ".")) + (ldif-records + (bbdb-search + (if (not visible-records) + (bbdb-records) + (mapcar 'car bbdb-records) + ) + nil nil nil target) + ) + tmps + record + ) + + + (setq ldif-records + (if (not visible-records) + (bbdb-records) + (mapcar 'car bbdb-records) + ) + ) + + (set-buffer (get-buffer-create ldifbuffer)) + (setq fill-column 1000) + (erase-buffer) + + (while ldif-records + (setq record (car ldif-records)) + (insert "\nxmozillausehtmlmail: FALSE\n") + (let ( + (net (car (bbdb-record-net record))) + (rnet (bbdb-record-net record)) + ) + (insert (format "dn: cn=%s" (tnil (bbdb-record-name record)))) + (if net + (insert (format ",mail=%s" net)) + ) + (insert "\n") + + (setq tmps (bbdb-record-firstname record)) (insert "givenname: " (tnil tmps) "\n") + (setq tmps (bbdb-record-lastname record)) (if tmps (insert "sn: " tmps "\n")) + (insert "objectclass: top\nobjectclass: person\n") + (setq tmps (bbdb-record-company record)) (if tmps (insert "o: " tmps "\n")) + (setq tmps (bbdb-record-name record)) (if tmps (insert "cn: " tmps "\n")) + + (if net (insert "mail: " net "\n")) + (while (cdr rnet) + (insert "mailAlternateAddress: " (cadr rnet) "\n") + (setq rnet (cdr rnet)) + ) + ) + (let ( + (phones (bbdb-record-phones record)) + (addrs (bbdb-record-addresses record)) + (aka (bbdb-record-aka record)) + (firstaddr t) + tonote + phone + (elide nil) + ) + + (while phones + (setq phone (car phones)) + (if (equal (nsloc (bbdb-phone-location phone))"cellphone") + (setq tonote (addtonote tonote (concat "M:" (bbdb-phone-string phone) ))) + ) + (if (equal (nsloc (bbdb-phone-location phone))"pagerphone") + (setq tonote (addtonote tonote (concat "P:" (bbdb-phone-string phone) ))) + ) + (insert (format "%s: " (nsloc (bbdb-phone-location phone))) (bbdb-phone-string phone) "\n") + (insert bbdb-ldif-prefixh "PhoneLoc:" (bbdb-phone-location phone)"\n") + (setq phones (cdr phones))) + + (let (addr tmps) + (while addrs + (setq addr (car addrs)) + (if firstaddr (progn + (if (= 0 (length (setq tmps (bbdb-address-street1 addr)))) nil (insert "postOfficeBox: " tmps "\n")) + (if (= 0 (length (setq tmps (bbdb-address-street2 addr)))) nil (insert "streetaddress: " tmps "\n")) + (if (= 0 (length (setq tmps (bbdb-address-street3 addr)))) nil (insert "streetaddress: " tmps "\n" )) + + ; This does not work with Netscape + ; (if (= 0 (length (setq tmps (bbdb-address-street1 addr)))) nil (insert "homePostalAddress:" tmps )) + ; (if (= 0 (length (setq tmps (bbdb-address-street2 addr)))) nil (insert "$" tmps)) + ; (if (= 0 (length (setq tmps (bbdb-address-street3 addr)))) nil (insert "$" tmps )) + ; (insert "\n") + + (insert "locality:" (bbdb-address-city addr) "\n") + (setq tmps (bbdb-address-state addr)) + (if (and tmps (not (equal tmps ""))) (insert "st:" tmps "\n")) + (if (bbdb-address-zip-string addr) + (insert "postalcode:" (bbdb-address-zip-string addr) "\n")) + (setq firstaddr nil) + ) + (progn + (setq tonote (addtonote tonote (concat (bbdb-address-street1 addr)))) + (setq tonote (addtonote tonote (concat (bbdb-address-street2 addr)))) + (setq tonote (addtonote tonote (concat (bbdb-address-street3 addr)))) + (setq tonote (addtonote tonote (concat (bbdb-address-zip-string addr) " " (bbdb-address-city addr) ))) + (insert (concat "postalAddress: " + (base64IfMulti (concat "bbdb=" (bbdb-address-location addr) "\n" + (bbdb-address-street1 addr) "\n" + (bbdb-address-street2 addr) "\n" + (bbdb-address-street3 addr) "\n" + (bbdb-address-zip-string addr) "\n" + (bbdb-address-city addr) "\n" + (bbdb-address-state addr) + ) + ) + "\n" + ) + ) + ) + ) + (setq addrs (cdr addrs))) + ) + (cond (aka + (insert (format "%s: %s\n" "xmozillanickname" + (mapconcat (function identity) aka ", "))) + )) + (let ((notes (bbdb-record-raw-notes record))) + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + (while notes + (setq elide nil) + (cond + ((member (caar notes) bbdb-elided-export-ldif) (setq elide t)) + ((eq (car (car notes)) 'creation-date) + (insert "createTimestamp: " (bbdb-zulu (cdar notes))"\n") + (setq elide t) + ) + ((eq (car (car notes)) 'timestamp) + (setq elide t) + (insert "modifyTimestamp: "(bbdb-zulu (cdar notes))"\n") + ) + ((eq (car (car notes)) 'notes) (setq elide t)) + ((eq (car (car notes)) 'mail-alias) (setq elide t)) + (t + ;; Netscape cannot display this. So we also put it in the notes field. + (setq tonote (addtonote tonote (format "%s:%s" (caar notes) (cdar notes)))) + (insert (format "%s%s:" bbdb-ldif-prefix (car (car notes)))) + ) + ) + (if (eq (caar notes) 'notes) + (if tonote + (setq tonote (concat (cdar notes) "\n" tonote)) + (setq tonote (cdar notes))) + (if (not elide) + (insert (base64IfMulti (tnil (cdar notes))) "\n")) + ) + (setq notes (cdr notes)) + ) + (if tonote + (if (and (string-match "\n" tonote) (not (fboundp 'base64-encode-string))) + (insert "multilineDescription:" (bbdb-ldif-rmnl tonote ) "\n") + (insert "description:" (base64IfMulti tonote ) "\n") + ) + ) + ) + (if (bbdb-record-addresses record) + (insert bbdb-ldif-prefixh "mainAddrLoc:" (bbdb-address-location (car (bbdb-record-addresses record)))"\n") + ) + + ) + (setq ldif-records (cdr ldif-records)) + ) + ) + (if (and (not visible-records) (domailaliases)) + (progn + (alias-update) + (alias-setup) + ;; (bbdb-define-all-aliases) + (let ((mai 0) mae alist (malen (length mail-aliases) + )) + (while (< mai malen) + (setq mae (aref mail-aliases mai) ) + (if (and mae (symbolp mae )) + (progn + (insert (format "\ndn: cn=%s\n" mae)) + (insert (format "cn: %s\n" mae)) + (insert "objectclass: top\n") + (insert "objectclass: groupOfNames\n") + (setq alist (symbol-value mae )) + (if alist + (mapcar + (lambda (an) + (let ((trec (bbdb-search-simple nil an)) + ) + (if trec + (insert (format "member: cn=%s,mail=%s\n" + (tnil (bbdb-record-name trec)) + (tnil (car (bbdb-record-net trec))) + ) + ) + ) + ) + ) + (split-string alist ", ") + ) + ) + ) + ) + (setq mai (1+ mai)) + ) + ) + ) + (alias-update) + ) + (set-window-buffer (get-lru-window) ldifbuffer ) +) +;;(add-hook 'bbdb-load-hook (lambda () (define-key bbdb-mode-map "L" 'bbdb-to-ldif))) +(define-key bbdb-mode-map "L" 'bbdb-to-ldif) +(provide 'bbdb-ldif) diff --git a/bits/bbdb-mail-folders.el b/bits/bbdb-mail-folders.el new file mode 100644 index 0000000..701a2c9 --- /dev/null +++ b/bits/bbdb-mail-folders.el @@ -0,0 +1,122 @@ +;;; From: Geoffroy Ville <ville@isr.umd.edu> +;;; Subject: bbdb/mail-folders +;;; Date: 20 Nov 1998 00:00:00 GMT +;;; Message-ID: <6azlnl56h9v.fsf@einstein.isr.umd.edu> +;;; Sender: ville@einstein.isr.umd.edu +;;; Organization: University of Maryland, College Park +;;; X-Url: http://www.cenaath.cena.dgac.fr/~ville/ +;;; Newsgroups: gnu.emacs.sources,gnu.emacs.vm.info + + +;;; Just thought I would repost this piece of code after today's +;;; improvement. Cengiz told me he does not use it hence does not maintain it +;;; anymore. + +;;; I do not remember where I got it from originally, thus this post in sources +;;; and vm.info. + +;;; For BBDB users, this code allows you to have several mail-folder by default +;;; for a given author. Saving one mail creates automaically the entry if none, or +;;; allows you to select which among the existing one you want, or add a new one. +;;; Very useful when several people you know are involved in many different +;;; projects. After a while, a typical entry would look like this: + +;;; mail-folders: ("~/Mail/project1" "~/Mail/project2" "~/Mail/personal") + +;;; My 2 cts addition is an expand file-name to get rid of possible duplicate +;;; paths to the same file and a file-name-abbrevation to keep it ~/Mail for +;;; example (very useful for me because I changed sites twice in the recent years +;;; and had different home directories). + +;;; I'm just *sharing* the code and will not have time to maintain it further. But +;;; if it's buggy or outdated by some new feature of I_do_not_know_what, please +;;; tell me :-) + +;;; --- bbdb-mail-folders.el --- + +;A while back Roland posted advices to enable a mail-folder +;property. This property was used as the default folder name while +;saving messages in vm. + +;I have improved that in two ways: +;1. It is now a list of folder names, the first one on this list +; becomes the default folder name and the other names are pushed to +; the file-name history so that one can scroll through them using the +; history mechanisms. This is useful if you are saving mail from a +; person to more than one folder. +;2. This property is created and updated automatically when a message +; is saved to a folder so that the list is in MRU (most recently +; used) order. This is useful, because I am lazy to set the +; mail-folder property by hand. + +;I renamed the property to mail-folders so that it does not break with +;the existing mail-folder property. + +;Enjoy. Bug fixes are welcome. + +;Cengiz + +;-- +;Cengiz Alaettinoglu Information Sciences Institute +;(310) 822-1511 University of Southern California +;http://www.isi.edu/div7/people/cengiz.home + +;$Modified: Fri Nov 20 11:41:56 1998 by ville@isr.umd.edu $ +; GV: - always expand filename to avoid duplicate similar path +; - use abbreviation alist for home directory (comes from mode-line) + +(defvar bbdb/vm-mail-folders-file-name-history nil "") + +(defvar bbdb/file-name-abbreviation-alist + (list + (cons (concat "^" (expand-file-name "~") "/") "~/") + ) +) + +(defadvice vm-save-message (around bbdb/vm-mail-folders activate compile) + "cache" + (let* ((folder-name "") + (record (bbdb/vm-update-record nil)) + (mail-folders (and record (bbdb-record-getprop record 'mail-folders))) + (folder-list (and mail-folders (car (read-from-string mail-folders))))) + ad-do-it + (setq folder-name (ad-get-arg 0)) + (setq folder-name (expand-file-name folder-name vm-folder-directory)) + (setq folder-name (string-replace-regexp-alist + folder-name bbdb/file-name-abbreviation-alist)) + (setq file-name-history + (append (list folder-name) bbdb/vm-mail-folders-file-name-history)) + (and record + (progn + (setq folder-list (delete folder-name folder-list)) + (setq folder-list (append (list folder-name) folder-list)) + (bbdb-record-putprop record 'mail-folders + (prin1-to-string folder-list)) + ) + ) + ) + ) + +(defadvice vm-auto-select-folder (around bbdb/vm-mail-folders activate compile) + "If the message sender's BBDB entry has a `mail-folder' property, use that." + (let* ((record (bbdb/vm-update-record nil)) + (mail-folders (and record (bbdb-record-getprop record 'mail-folders))) + (folder-list (and mail-folders (car (read-from-string mail-folders)))) + (folder-name (and folder-list (car folder-list)))) + (setq bbdb/vm-mail-folders-file-name-history file-name-history) + (and (cdr folder-list) + (setq file-name-history + (append (cdr folder-list) file-name-history))) + (if folder-name + (setq ad-return-value (file-name-nondirectory folder-name)) + ad-do-it) + ) + ) + +(provide 'bbdb-mail-folders) + +;;; --- end --- + +;;; Enjoy, + +;;; -- Geoffroy diff --git a/bits/bbdb-mew.el b/bits/bbdb-mew.el new file mode 100644 index 0000000..5f8b63b --- /dev/null +++ b/bits/bbdb-mew.el @@ -0,0 +1,248 @@ +;;; bbdb-mew.el --- BBDB interface to Mew + +;; Copyright (C) 1991, 1992 Jamie Zawinski +;; Copyright (C) 1996 Shuhei KOBAYASHI +;; Copyright (C) 1996 Daisuke Kanda +;; Copyright (C) 1999 Mitsuo Nishizawa + +;; Author: Jamie Zawinski <jwz@netscape.com> +;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> +;; Daisuke Kanda <small@first.tsukuba.ac.jp> +;; Mitsuo Nishizawa <mitsuo@phys2.med.osaka-u.ac.jp> +;; Maintenance: Chris Beggy +;; Created: 1996/11/04 +;; Version: $Id: bbdb-mew.el,v 1.5 2001/12/29 16:12:20 chrisb Exp $ + +;; Keywords: mail, BBDB + +;; This file is not part of BBDB (Insidious Big Brother Database). + +;; This program 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, or (at your option) +;; any later version. + +;; This program 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 program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; 2002-12-28 checked and edited for bbdb CVS version + mew 3.0.51 + emacs 21.1 + +;; Installation: +;; +;; Put bbdb-mew.el in your load path, so that emacs can find it. +;; +;; Run a patched bbdb-com.el to allow mew to be the mailer bbdb +;; uses if bbdb-send-mail-style is set to 'mew +;; +;; Insert the following lines in your ~/.emacs: +;; (other BBDB stuff comes here) +;; : +;; (autoload 'bbdb-insinuate-mew "bbdb-mew" "Hook BBDB into Mew") +;; (add-hook 'mew-init-hook 'bbdb-insinuate-mew) +;; (setq bbdb-send-mail-style 'mew) +;; +;; To use BBDB name at From: field of header in citation, please set +;; (setq mew-cite-bbdb-header t) +;; +;; Chris Beggy started doing some maintenance. + +;;; Codes: + +(require 'bbdb) +(require 'mew) + +(defvar mew-cite-bbdb-header nil) +(defvar mew-cite-bbdb-enable nil) + +(or (fboundp 'mew-header-get-value) + (fset 'mew-header-get-value (symbol-function 'mew-field-get-value)) + ) + +(defun bbdb/mew-update-record (&optional offer-to-create) + "Returns the record corresponding to the current mew message, +creating or modifying it as necessary. A record will be created if +bbdb/mail-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and +the user confirms the creation." + (save-excursion + (set-buffer (mew-buffer-message)) + (if bbdb-use-pop-up + (bbdb/mew-pop-up-bbdb-buffer offer-to-create) + (let* ((from (mew-header-get-value mew-from:)) + (addr (and from + (car (cdr (mail-extract-address-components from)))))) + (if (or (null from) + (null addr) + (string-match (bbdb-user-mail-names) addr)) + (setq from (or (mew-header-get-value mew-to:) from))) + (if from + (bbdb-annotate-message-sender + from t + (or (bbdb-invoke-hook-for-value + bbdb/mail-auto-create-p) + offer-to-create) + offer-to-create)))))) + +(defun bbdb/mew-annotate-sender (string) + "Add a line to the end of the Notes field of the BBDB record +corresponding to the sender of this message." + (interactive + (list (if bbdb-readonly-p + (error "The Insidious Big Brother Database is read-only.") + (read-string "Comments: ")))) + (bbdb-annotate-notes (bbdb/mew-update-record t) string)) + +(defun bbdb/mew-edit-notes (&optional arg) + "Edit the notes field or (with a prefix arg) a user-defined field +of the BBDB record corresponding to the sender of this message." + (interactive "P") + (let ((record (or (bbdb/mew-update-record t) (error "")))) + (bbdb-display-records (list record)) + (if arg + (bbdb-record-edit-property record nil t) + (bbdb-record-edit-notes record t)))) + +(defun bbdb/mew-show-sender () + "Display the contents of the BBDB for the sender of this message. +This buffer will be in bbdb-mode, with associated keybindings." + (interactive) + (let ((record (bbdb/mew-update-record t))) + (if record + (bbdb-display-records (list record)) + (error "unperson")))) + +(defun bbdb/mew-pop-up-bbdb-buffer (&optional offer-to-create) + "Make the *BBDB* buffer be displayed along with the mew windows, +displaying the record corresponding to the sender of the current message." + (let ((framepop (eq temp-buffer-show-function 'framepop-display-buffer))) + (or framepop + (bbdb-pop-up-bbdb-buffer + (function + (lambda (w) + (let ((b (current-buffer))) + (set-buffer (window-buffer w)) + (prog1 (eq major-mode 'mew-message-mode) + (set-buffer b))))))) + (let ((bbdb-gag-messages t) + (bbdb-use-pop-up nil) + (bbdb-electric-p nil)) + (let ((record (bbdb/mew-update-record offer-to-create)) + (bbdb-display-layout bbdb-pop-up-display-layout) + (b (current-buffer))) + (if framepop + (if record + (bbdb-display-records (list record)) + (framepop-banish)) + (bbdb-display-records (if record (list record) nil))) + (set-buffer b) + record)))) + +;;; Utilities +;;; + +(defun bbdb-record-field (record field) + (cond + ((eq field 'firstname) (bbdb-record-firstname record)) + ((eq field 'lastname) (bbdb-record-lastname record)) + ((eq field 'aka) (bbdb-record-aka record)) + ((eq field 'company) (bbdb-record-company record)) + ((eq field 'phones) (bbdb-record-phones record)) + ((eq field 'addresses) (bbdb-record-addresses record)) + ((eq field 'net) (bbdb-record-net record)) + ((eq field 'raw-notes) (bbdb-record-raw-notes record)) + ((eq field 'cache) (bbdb-record-cache record)) + (t + (and (consp (bbdb-record-raw-notes record)) + (cdr (assq field (bbdb-record-raw-notes record))) + )))) + +(defun bbdb-record-fields (record fields) + (let (value) + (while (and fields (null value)) + (setq value (bbdb-record-field record (car fields))) + (setq fields (cdr fields))) + value)) + +;;; Register citation attribution in BBDB +;;; + +(defvar mew-cite-bbdb-fields '(attribution lastname firstname)) + +(defun mew-cite-prefix-bbdb () + (if mew-cite-bbdb-enable + (let (from petname prefix) + (setq from (mew-header-get-bbdb-name)) + (if (and mew-use-petname mew-petname-alist + (setq petname + (cdr (mew-assoc-case-equal from mew-petname-alist 0)))) + (setq prefix petname) + (setq prefix (mew-addrstr-extract-user from))) + (if mew-ask-cite-prefix + (setq prefix (read-string "Citation prefix: " prefix))) + (format "%s> " prefix) + ))) + +(defun mew-header-get-bbdb-name () + (if mew-cite-bbdb-enable + (let* ((from (mew-header-parse-address mew-from:)) + (addr from) + (name nil) + (net addr) + (record (and addr + (bbdb-search-simple name + (if (and net bbdb-canonicalize-net-hook) + (bbdb-canonicalize-address net) + net))))) + (or (and record + (bbdb-record-fields record mew-cite-bbdb-fields)) + net)))) + +(or (fboundp 'bbdb:mew-cite-strings) + (fset 'bbdb:mew-cite-strings (symbol-function 'mew-cite-strings))) + +(defun mew-cite-strings-bbdb () + (if mew-cite-bbdb-enable + (let (fields) + (if mew-cite-bbdb-header + (setq fields + (mapcar + (function + (lambda (x) + (or (if (string= x mew-from:) + (mew-header-get-bbdb-name) + (mew-header-get-value x)) + ""))) + mew-cite-fields)) + (setq fields + (mapcar (function mew-header-get-value) mew-cite-fields))) + (setq fields (mapcar (lambda (x) (or x "")) fields)) + (if mew-use-petname + (setq fields (mew-cite-strings-with-petname fields mew-cite-fields)) + ) + (if mew-use-bbdb + (apply (function format) mew-cite-format fields) + (bbdb:mew-cite-strings))))) + +;;; Installation +;;; + +(defun bbdb-insinuate-mew () + "Call this function to hook BBDB into Mew." + (if (string-match "2.3" (bbdb-version)) + (add-hook 'mew-message-hook 'bbdb/mew-update-record) + (bbdb-add-hook 'mew-message-hook 'bbdb/mew-update-record)) + (define-key mew-summary-mode-map ":" 'bbdb/mew-show-sender) + (define-key mew-summary-mode-map ";" 'bbdb/mew-edit-notes) + ) + +(provide 'bbdb-mew) + +;;; bbdb-mew.el ends here. diff --git a/bits/bbdb-obsolete.el b/bits/bbdb-obsolete.el new file mode 100644 index 0000000..18ac88c --- /dev/null +++ b/bits/bbdb-obsolete.el @@ -0,0 +1,67 @@ +;;; bbdb-obsolete-net.el -- Handle obsolete-net addresses. + +;; Copyright (C) 2001 Colin Rafferty + +;; Author: Colin Rafferty <colin@xemacs.org> +;; Keywords: bbdb, net, obsolete +;; Version: $Id: bbdb-obsolete.el,v 1.3 2006/02/04 15:34:30 joerg Exp $ + +;; This program 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, or (at your option) +;; any later version. + +;; This program 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. + +;; A copy of the GNU General Public License can be obtained from this +;; program's author (send electronic mail to colin@xemacs.org) or from +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; Send bug reports to colin@xemacs.org + +;;; Commentary: + +;; My ~/.bbdb is seven years old. People change jobs, change ISPs, +;; and change nyms. Their email addresses change. + +;; While I no longer want to send someone email at an old address, I +;; still have old messages with the old addresses, and I want to match +;; up. + +;; Move the old addresses into the field `obsolete-net', and: + +;; (setq 'bbdb-obsolete-net-canonicalize-net-hook 'bbdb-canonicalize-net-hook) + +;; If you already have a `bbdb-obsolete-net-canonicalize-net-hook', +;; then call `bbdb-canonicalize-net-hook' from within your function. + +;;; Code: + +(require 'bbdb-com) + +(defgroup bbdb-obsolete-net nil + "Customizations for setting up obsolete network addresses." + :group 'bbdb) + +(defcustom bbdb-obsolete-net-field 'obsolete-net + "*Field in which to add the obsolete net addresses." + :group 'bbdb-obsolete-net + :type 'symbol) + +;;;###autoload +(defun bbdb-obsolete-net-canonicalize-net-hook (addr) + "Return user's current net address given obsolete ADDR. + +Return ADDR if it is not obsolete anywhere, or there is no net address +in the matching record. The field is set in `bbdb-obsolete-net-field'." + (let* ((notes (cons bbdb-obsolete-net-field (concat "\\<" (regexp-quote addr) "\\>"))) + (records (bbdb-search (bbdb-records) nil nil nil notes))) + (or (and (not (null records)) (car (bbdb-record-net (car records)))) addr))) + +(provide 'bbdb-obsolete-net) + +;;; bbdb-obsolete-net.el ends here diff --git a/bits/bbdb-pgp.el b/bits/bbdb-pgp.el new file mode 100644 index 0000000..f6558f7 --- /dev/null +++ b/bits/bbdb-pgp.el @@ -0,0 +1,217 @@ +;;; bbdb-pgp.el --- use BBDB to store PGP preferences + +;; Copyright (C) 1997,1999 Kevin Davidson + +;; Author: Kevin Davidson tkld@quadstone.com +;; Maintainer: Kevin Davidson tkld@quadstone.com +;; Created: 10 Nov 1997 +;; Version: $Revision: 1.6 $ +;; Keywords: PGP BBDB message mailcrypt + + +;; This program 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, or (at your option) +;; any later version. + +;; This program 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. + +;; A copy of the GNU General Public License can be obtained from this +;; program's author (send electronic mail to tkld@quadstone.com) or +;; from the Free Software Foundation, Inc.,59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; LCD Archive Entry: +;; bbdb-pgp|Kevin Davidson|tkld@quadstone.com +;; |Use BBDB to store PGP preferences +;; |$Date: 2003/08/11 08:54:35 $|$Revision: 1.6 $|~/packages/bbdb-pgp.el + +;;; Commentary: +;; +;; It is believed that encrypted mail works best if all mail between +;; individuals is encrypted - even concerning matters that are not +;; confidential. The reasoning is that confidential messages cannot +;; then be easily spotted and decryption efforts concentrated on them. +;; Some people therefore prefer to have all their email encrypted. +;; This package allows you to mark the BBDB entries for those +;; individuals so that messages will be encrypted when they are sent. +;; +;; These packages are required: BBDB, mailcrypt, message +;; +;; message.el is included with recent versions of Emacs. +;; You can use mail-mode as well as message-mode to send mail. + +;;; Usage: +;; (require 'bbdb-pgp) +;; +;; Then for all users who you want to send encrypted mail to, add the field +;; pgp-mail with the value `encrypt'. Alternatively you can add the value +;; `sign' if you just want to send signed messages. +;; +;; and possibly (if you do not want the PGP field printed out) +;; (add-hook 'bbdb-print-elide bbdb-pgp-field) +;; +;; The variable bbdb/pgp-default-action defines what to do if the recipient +;; is not in the BBDB. + +;;; TODO +;; Spot incoming PGP mail by hooking into mc-verify/decrypt and adding pgp-mail +;; field to BBDB entry (creating one if necessary); like bbdb-sc.el maintains +;; attribution prefs. + +;;; PGP Public Key +;; The author's public key is available from any public PGP keyserver +;; eg http://www.pgp.net/pgpnet/ +;; Fingerprint: 1F A9 3F 3E 90 F7 85 64 55 35 32 C8 75 91 3A E3 + + +;;; Code: + +(require 'message) +(require 'bbdb) +(condition-case nil (require 'mailcrypt) (error nil)) + +(defconst bbdb/pgp-version (substring "$Revision: 1.6 $" 11 -2) + "$Id: bbdb-pgp.el,v 1.6 2003/08/11 08:54:35 waider Exp $ + +Report bugs to: Kevin Davidson tkld@quadstone.com") + +;;;###autoload +(defgroup bbdb-utilities-pgp nil + "Automatically sign and/or encrypt outgoing messages." + :link '(emacs-library-link :tag "Lisp Source File" "bbdb-pgp.el") + :group 'bbdb-utilities) + + +(defcustom bbdb/pgp-field 'pgp-mail + "*Field to use in BBDB to store PGP preferences. + +If this field's value in a record is \"encrypt\" then messages are +encrypted. If it is \"sign\" then messages are signed." + :type 'symbol + :tag "BBDB Field" + :require 'bbdb + :group 'bbdb-utilities-pgp) + +(defcustom bbdb/pgp-method 'mailcrypt + "*How to sign or encrypt messages. + +'mailcrypt means use Mailcrypt. +'mml-pgp means add MML tags for Message to use old PGP format +'mml-pgpmime means add MML tags for Message to use PGP/MIME +'mml-smime means add MML tags for Message to use S/MIME" + :type '(choice + (const :tag "Mailcrypt" mailcrypt :require 'mailcrypt) + (const :tag "MML PGP" mml-pgp :require 'mml) + (const :tag "MML PGP/MIME" mml-pgpmime :require 'mml) + (const :tag "MML S/MIME" mml-smime :require 'mml)) + :tag "Signing/Encryption Method" + :group 'bbdb-utilities-pgp) + +(defcustom bbdb/pgp-default-action nil + "*Default action when sending a message and the recipient is not in BBDB. + +nil means do nothing. +'encrypt means encrypt message. +'sign means sign message." + :type '(choice + (const :tag "Do Nothing") + (const :tag "Encrypt" encrypt) + (const :tag "Sign" sign)) + :tag "Default Action" + :group 'bbdb-utilities-pgp) + +(defcustom bbdb/pgp-quiet nil + "*Do not ask for confirmation on pgp-action. + +nil means normal messages/questions. +'t means to be quiet." + :type '(choice + (const :tag "normal") + (const :tag "quiet" t)) + :tag "Quietness" + :group 'bbdb-utilities-pgp) + +(defun bbdb/pgp-get-pgp (name address) + "Look up user NAME and ADDRESS in BBDB and return the PGP preference." + (let* ((record (bbdb-search-simple name address)) + (pgp (and record + (bbdb-record-getprop record bbdb/pgp-field)))) + pgp)) + +(defun bbdb/pgp-sign () + "Sign a message. +bbdb/pgp-method controls the method used." + (cond + ((eq bbdb/pgp-method 'mailcrypt) + (mc-sign 0)) + ((eq bbdb/pgp-method 'mml-pgp) + (mml-secure-message-sign-pgp)) + ((eq bbdb/pgp-method 'mml-pgpmime) + (mml-secure-message-sign-pgpmime)) + ((eq bbdb/pgp-method 'mml-smime) + (mml-secure-message-sign-smime)) + (t + (error 'invalid-state "bbdb/pgp-method")))) + +(defun bbdb/pgp-encrypt () + "Encrypt and sign a message. +bbdb/pgp-method controls the method used." + (cond + ((eq bbdb/pgp-method 'mailcrypt) + (mc-encrypt 0)) + ((eq bbdb/pgp-method 'mml-pgp) + (mml-secure-message-encrypt-pgp)) + ((eq bbdb/pgp-method 'mml-pgpmime) + (mml-secure-message-encrypt-pgpmime)) + ((eq bbdb/pgp-method 'mml-smime) + (mml-secure-message-encrypt-smime)) + (t + (error 'invalid-state "bbdb/pgp-method")))) + +(defun bbdb/pgp-hook-fun () + "Function to be added to message-send-hook +Uses PGP to encrypt messages to users marked in the BBDB with the +field `bbdb/pgp-field'. +The user is prompted before encryption or signing." + (save-restriction + (save-excursion + (message-narrow-to-headers) + (and (featurep 'mailalias) + (not (featurep 'mailabbrev)) + mail-aliases + (expand-mail-aliases (point-min) (point-max))) + (let* ((to-field (mail-fetch-field "To" nil t)) + (address (mail-extract-address-components (or to-field "")))) + (widen) + (if (not (equal address '(nil nil))) + (let ((pgp-p (bbdb/pgp-get-pgp (car address) (car (cdr address))))) + (cond + ((string= "encrypt" pgp-p) + (and (or bbdb/pgp-quiet + (y-or-n-p "Encrypt message? ")) + (bbdb/pgp-encrypt))) + ((string= "sign" pgp-p) + (and (or bbdb/pgp-quiet + (y-or-n-p "Sign message? ")) + (bbdb/pgp-sign))) + (t + (cond + ((eq bbdb/pgp-default-action 'encrypt) + (and (y-or-n-p "Encrypt message? ") + (bbdb/pgp-encrypt))) + ((eq bbdb/pgp-default-action 'sign) + (and (y-or-n-p "Sign message? ") + (bbdb/pgp-sign))) + (t + nil)))))))))) + +(add-hook 'message-send-hook 'bbdb/pgp-hook-fun) +(add-hook 'mail-send-hook 'bbdb/pgp-hook-fun) + +(provide 'bbdb-pgp) + +;;; bbdb-pgp.el ends here diff --git a/bits/bbdb-signature.el b/bits/bbdb-signature.el new file mode 100644 index 0000000..f229063 --- /dev/null +++ b/bits/bbdb-signature.el @@ -0,0 +1,193 @@ +;;; MAIL-SIGNATURE.EL - Add context sensitive signature +;;; Copyright (C) 1997 Kevin Davidson +;;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc + +;;; Maintainer: tkld@quadstone.com +;;; Keywords: mail + +;;; This program 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, or (at your option) +;;; any later version. + +;;; This program 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. + +;;; A copy of the GNU General Public License can be obtained from this +;;; program's author (send electronic mail to <tkld@quadstone.com>) +;;; or from the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. + +;;; LCD Archive Entry: +;;; mail-signature|Kevin Davidson|<tkld@quadstone.com> +;;; |Add context sensitive signature +;;; |$Date: 2001/03/01 15:38:31 $|$Revision: 1.1 $|~/packages/mail-signature.el + +;;; Commentary: + +;;; This is a reworking of the function mail-signature in sendmail.el +;;; (part of the Emacs distribution) to insert a context sensitive signature. +;;; Using regular expressions, appropriate signatures can be inserted +;;; for different audiences. +;;; Repeated calls removes the current signature from the message and cycles +;;; through all applicable signatures. +;;; Use with something like this in .emacs: +;;; (eval-after-load "sendmail" +;;; (progn +;;; (load "mail-signature") +;;; (setq mail-signature-alist +;;; (append '((bbdb) +;;; ("Newsgroups" "^sci" "-scientific") +;;; ("To" "^[^@]+$" "-local") +;;; ("To" "friend" "-friendly")) mail-signature-alist)))) +;;; And create a file called ~/.signature-friendly that has a +;;; signature appropriate for the user `friend' to receive, a +;;; ~/.signature-local for users at the same site and a +;;; ~/.signature-scientific that contains a signature suitable for sci.* +;;; newsgroups. +;;; Any users in your BBDB that have a `signature' property will get that +;;; signature. Obviously you need to have installed the Insidious Big Brother +;;; Database (BBDB) for this to work. +;;; If using message-mode (included with Emacs 19.34/GNUS 5.3 or later) +;;; (setq message-signature 'mail-signature) + +;;; Change log: +;; $Log: bbdb-signature.el,v $ +;; Revision 1.1 2001/03/01 15:38:31 waider +;; More bits, possibly incompatible with 2.00.06. Use at own risk. +;; +;; Revision 1.11 1997/11/11 11:18:29 tkld +;; Updated email address. +;; +;; Revision 1.10 1997/10/22 14:44:33 tkld +;; Remove dependency on cl. More sanity checking. Checked out on emacs +;; -q. +;; +;; Revision 1.9 1997/10/22 12:42:49 tkld +;; Use bbdb-signature if magic entry 'bbdb is present in +;; mail-signature-alist +;; +;; Revision 1.8 1997/10/21 13:16:04 tkld +;; Off by one error caused first entry in alist to be ignored. +;; +; Revision 1.7 1997/04/18 09:14:51 tkld +; Add change log. Update GPL version and FSF address. Cycle through all +; possible signatures, not just toggle between two. +; + +;;; Code: + +(defconst mail-signature-version (substring "$Revision: 1.1 $" 11 -2) + "$Id: bbdb-signature.el,v 1.1 2001/03/01 15:38:31 waider Exp $ + +Report bugs to: Kevin Davidson <tkld@quadstone.com>") + + +(defvar bbdb-signature-field 'signature + "*BBDB field used to store signature for") + +(defvar mail-signature-last-signature -1 + "Record index of last signature used for repeated calls of mail-signature +Buffer local") +(make-variable-buffer-local 'mail-signature-last-signature) + +(defvar mail-signature-base "~/.signature" + "*The base part of signature filename. +Entries from mail-signature-alist will be added to this.") + +(defvar mail-signature-alist + '(("" "" "")) + "*List of extensions to add to mail-signature-base to form name of sig file. +Format is: (HEADER REGEX EXTENSION), where REGEX is a regular expression +that should match the contents of the mail or news header HEADER. +The first to match is used. In REGEX, ^ and $ mark the beginning and end +of just the text in the header, not the whole line. +If HEADER is the symbol 'bbdb then search for a matching entry and use the +field specified by bbdb-signature-field as the suffix.") + +(defun mail-signature (&optional atpoint) + "Sign letter with context sensitive signature, based on mail-signature-alist. +Argument ATPOINT says whether to insert signature at point, or at end of +buffer." + (interactive "P") + (save-excursion + (or atpoint + (goto-char (point-max))) + ;; First search for previous signature to delete + ;; or delete trailing whitespace + (if (null (search-backward "\n-- \n" (point-min) t)) + (progn + (skip-chars-backward " \t\n") + (end-of-line)) + (skip-chars-backward " \t\n")) + (or atpoint + (delete-region (point) (point-max))) + (insert "\n\n-- \n") + (let ((sig-file (expand-file-name (mail-find-signature)))) + (if (file-exists-p sig-file) + (insert-file-contents sig-file) + (error "Signature file %s does not exist. Check mail-signature-alist." + sig-file))))) + +(defun mail-find-signature () + "Find an appropriate signature file." + (let* ((elist mail-signature-alist) + (found nil) + (sind 0) + (entry (car elist)) + (header (car entry)) + (regex (car (cdr entry))) + (file (car (cdr (cdr entry))))) + (save-excursion + (if (>= mail-signature-last-signature (length mail-signature-alist)) + (setq mail-signature-last-signature -1)) + (while (and (not found) elist) + (if (equal header 'bbdb) + (if (and (> sind mail-signature-last-signature) + (setq file (bbdb-frob-signature))) + (setq found t) + (setq elist (cdr elist) + entry (car elist) + header (car entry) + sind (1+ sind) + regex (car (cdr entry)) + file (car (cdr (cdr entry))))) + (if (and (> sind mail-signature-last-signature) + (mail-position-on-field header 'soft) + (re-search-backward (concat "^" header ":[ \t]*\\(.*\\)$") + (point-min) t) + (string-match regex (buffer-substring-no-properties + (match-beginning 1) (match-end 1)))) + (setq found t) + (setq elist (cdr elist) + entry (car elist) + header (car entry) + sind (1+ sind) + regex (car (cdr entry)) + file (car (cdr (cdr entry)))))))) + (setq mail-signature-last-signature sind) + (concat mail-signature-base file))) + +(defun bbdb-find-signature (name address) + "Look up user NAME and ADDRESS in BBDB and return the appropriate signature." + (let* ((record (bbdb-search-simple name address)) + (sig (and record + (bbdb-record-getprop record bbdb-signature-field)))) + sig)) + +(defun bbdb-frob-signature () + "Parse current message to get recipients and generate signature" + (save-restriction + (save-excursion + (message-narrow-to-headers) + (let* ((to-field (mail-fetch-field "To" nil t)) + (address (mail-extract-address-components (or to-field "")))) + (if (not (equal address '(nil nil))) + (bbdb-find-signature (car address) (car (cdr address))) + nil))))) + +(provide 'mail-signature) + +;; mail-signature.el ends here diff --git a/bits/bbdb-sort-mailrc.el b/bits/bbdb-sort-mailrc.el new file mode 100644 index 0000000..c465f14 --- /dev/null +++ b/bits/bbdb-sort-mailrc.el @@ -0,0 +1,322 @@ +;;; >>>>> Ronan Waide writes: + +;;; >> * birthdays/anniversaries + +;;; RW> This /is/ venturing into calendar land. Still, go to yer bbdb buffer +;;; RW> and create a field with C-o. Again, I prefer not to add baggage to the +;;; RW> file format unless it's absolutely necessary. Also, you should be able +;;; RW> to attach bbdb to calendar.el using the bbdb record-dinking hooks so +;;; RW> that it auto-fills your calendar with goop for you. And maybe get +;;; RW> working on calendar-pilot.el... + +;;; Well, this isn't really release-ready -- but since someone asks, it +;;; could be a good starting point for someone. Feel free to +;;; redistribute, or chop up and use the useful bits. + +;;; Bng + +;;; BBDB-BNG +;;; Various functions I have added to enhance the big brother database. +;;; Boris Goldowsky, <boris@cs.rochester.edu> +;;; $Revision: 1.1 $ $Date: 2001/01/24 21:19:08 $ +;;; +;;; This file allows you to do the following things: +;;; * Sort by firstname or company rather than last name. +;;; * Mark people's birthdays in emacs's calendar and diary displays. +;;; * Maintains a file of mail aliases, for use by other mailers, +;;; automatically updated when the information changes in your database. +;;; * Make sure that everyone has their username defined as an alias +;;; for their complete net addresses. +;;; +;;; INSTALLATION: +;;; Put this file in emacs's load-path, and make sure it gets loaded whenever +;;; you load BBDB. +;;; * To use alternate sorting, evaluate (bbdb-sort-by ...) whenever you load +;;; bbdb. YOU MUST EITHER ALWAYS DO THIS, OR NEVER DO IT. When you switch +;;; over, evaluate (bbdb-resort-database). +;;; * To make a file of mail-aliases, set bbdb-mail-alias-file to a filename, +;;; and source that file from your .mailrc. +;;; * Username-aliases are enabled by default. Set +;;; `bbdb-auto-username-alias' to nil if you don't want them. +;;; You can also use the function `bbdb-add-user-name-as-alias' to +;;; add such aliases manually. +;;; * The bbdb/calendar stuff is under development, and may not work. +;;; +;;; EXAMPLE: +;;; The following code could go in your .emacs: +;;; (add-hook 'bbdb-load-hook +;;; (function (lambda () +;;; (setq bbdb-mail-alias-file +;;; (expand-file-name "~/.mail_aliases") +;;; (require 'bbdb-bng) +;;; (bbdb-sort-by 'firstname)))) + +;;; USE: +;;; If installed as above, these functions operate automatically. + +;;; DEPENDENCIES: +;;; BBDB, of course. +;;; calendar.el and diary-lib.el are built into recent emacs versions. +;;; dates.el is available from me. + +(provide 'bbdb-bng) + +;;; +;;; New birthday stuff. +;;; + +(require 'calendar) +(require 'dates) + +(if (not (featurep 'diary)) ; the library of many names. + (or (load "diary-lib" t) + (load "diary"))) + +(defvar bbdb/calendar-marker + (if (not window-system) + "^" + (require 'faces) + 'bold-italic) + "*How to mark birthdays in calendar. +Can be either a single-character string or a face.") + +(add-hook 'list-diary-entries-hook 'bbdb/calendar-list-entries) +(add-hook 'mark-diary-entries-hook 'bbdb/calendar-mark-entries) + +(defun bbdb/calendar-mark-entries () + (save-excursion + (set-buffer calendar-buffer) + (let ((month displayed-month) + (year displayed-year)) + (bbdb/calendar-mark-month month year) + (increment-calendar-month month year -1) + (bbdb/calendar-mark-month month year) + (increment-calendar-month month year 2) + (bbdb/calendar-mark-month month year)))) + +(defun bbdb/calendar-mark-month (month year) + (message "Marking birthdays..." + (let ((days (aref (bbdb/calendar-birthdays) month))) + (while days + (mark-visible-calendar-date (list month (car (car days)) year) + bbdb/calendar-marker) + (setq days (cdr days)))) + (message nil))) + +(defun bbdb/calendar-list-entries () + (message "Listing birthdays..." + (let* ((bdays (bbdb/calendar-birthdays)) + (start-date (calendar-absolute-from-gregorian original-date)) + (end-date (+ number start-date))) + (calendar-for-loop abs-date from start-date to end-date do + (let* ((date (calendar-gregorian-from-absolute abs-date)) + (entries (cdr (assoc (extract-calendar-day date) + (aref bdays + (extract-calendar-month date)))))) + (while entries + (add-to-diary-list date (car entries)) + (setq entries (cdr entries)))))) + (message nil))) + +(defvar bbdb/calendar-birthdays nil + "Used by function of the same name, which see.") + +(defun bbdb/calendar-birthdays () + "Returns a vector containing the birthdays in your BBDB. +This is a vector with one element per month: + [birthdays ; identifier in spot 0 + ((4 \"Isaac Newton's birthday\")) ; Newton's birthday is Jan 4. + ((11 \"Thomas Edison's birthday\") ; Edison's is Feb 11. + (15 \"Galileo's birthday\" \"Susan B. Anthony's birthday\")) ; Both Feb 15. + ...march through dec... + ]" + (or bbdb/calendar-birthdays + (setq bbdb/calendar-birthdays + (let ((cal (make-vector 13 nil)) + (recs (bbdb-records)) + birthday-string) + (aset cal 0 'birthdays) + (while recs + (if (setq birthday-string + (bbdb-record-getprop (car recs) 'birthday)) + (let ((events (bbdb-split birthday-string ",")) + (name (bbdb-record-name (car recs)))) + (while events + (let ((bday (date-parse (car events)))) + (if (null bday) + (message "Unparsable birthday: %s" (car events)) + (let* ((date-end (parse-string-end)) + (eventname (if (eq t date-end) + "birthday" + (substring (car events) + date-end))) + (event (concat name "'s " + (if (equal "" eventname) + "birthday" + eventname))) + (month (extract-calendar-month bday)) + (day (extract-calendar-day bday)) + (monthlist (aref cal month)) + (daylist (assoc day monthlist))) + (if daylist + (setcdr daylist (cons event (cdr daylist))) + (aset cal month (cons (list day event) + monthlist)))))) + (setq events (cdr events))))) + (setq recs (cdr recs))) + cal)))) + +;;; +;;; Mail alias code +;;; + +(defvar bbdb-mail-alias-file nil + "*File to save mail-aliases into. +Aliases are also kept in the database proper; this is just for the convenience +of other programs that are interested in mail aliases. For example, you can +use your bbdb mail aliases with ucb mail by including the line +source ~/.mail_aliases +in your .mailrc file. +Set this to nil to avoid storing mail aliases in a file.") + +(defvar bbdb-auto-username-alias t + "*If t, always have a person's username as a mail-alias for them.") + +(if bbdb-mail-alias-file + (add-hook 'bbdb-after-change-hook (function bbdb-check-mail-alias))) + +(defun bbdb-add-user-name-as-alias () + (interactive) + (let ((bbdb-auto-username-alias t) + (this(bbdb-current-record))) + (bbdb-check-mail-alias this) + (bbdb-redisplay-one-record this))) + +(defun bbdb-record-username (record) + "Return just the username part of RECORD's first net address, +if it looks like a well-formed internet address; nil otherwise." + (let ((addr (car (bbdb-record-net record)))) + (if (and addr (string-match "^[a-zA-z0-9]+@" addr)) + (substring addr 0 (1- (match-end 0)))))) + +(defun bbdb-record-mail-aliases (record) + (let ((all (bbdb-record-getprop record bbdb-define-all-aliases-field))) + (if all (bbdb-split all ",")))) + +(defun bbdb-check-mail-alias (record) + "Makes sure the person's username is defined as a mail abbrev +for them, and makes sure all their mail abbreves are ready for use." + (let ((username (bbdb-record-username record)) + (current (bbdb-record-getprop record bbdb-define-all-aliases-field))) + (if (and current (string-match "\\(,\\)? *\n" current)) + (setq current (replace-match ", " nil nil current))) + (if (and bbdb-auto-username-alias + username + (not (and (boundp 'mail-abbrevs) + (intern-soft username mail-abbrevs))) + (not (member username (bbdb-record-mail-aliases record)))) + (setq current + (if current (concat current ", " username) + username))) + (if current + (bbdb-record-putprop record bbdb-define-all-aliases-field current)) + + ;; And make sure aliases are all defined (if any are) + (if (boundp 'mail-abbrevs) + (mapcar (function + (lambda (alias) + (if (not (intern-soft alias mail-abbrevs)) + (my-define-mail-abbrev + alias (bbdb-dwim-net-address record))))) + (bbdb-record-mail-aliases record))))) + +(defun my-define-mail-abbrev (abbrev address) + "Defines abbrev, and marks bbdb-mail-alias-file as modified." + (define-mail-abbrev abbrev address) + (save-excursion + (set-buffer (find-file-noselect bbdb-mail-alias-file)) + (setq buffer-read-only t) + (set-buffer-modified-p t) + (make-variable-buffer-local 'local-write-file-hooks) + (if (not (memq 'bbdb-mail-alias-file-write-hook + local-write-file-hooks)) + (setq local-write-file-hooks '(bbdb-mail-alias-file-write-hook))))) + +(defun bbdb-insert-mail-aliases () + (let ((begin (point))) + (if (not (boundp 'mail-abbrevs)) + (bbdb-define-all-aliases)) + (insert-abbrev-table-description 'mail-abbrevs nil) + (goto-char begin) + (let ((abbrevs (nth 1 (nth 2 (read (current-buffer)))))) + (setq abbrevs (sort abbrevs (function + (lambda (x y) + (string-lessp (car x) (car y)))))) + (delete-region begin (point)) + (mapcar (function + (lambda (abbrev) + (let ((alias (car abbrev)) + (addr (mapconcat (function simplify-address) + (bbdb-split (nth 1 abbrev) ",") " "))) + (if (not (string-equal alias addr)) + (insert (format "alias %s\t%s\n" alias addr)))))) + abbrevs)))) + +(defun simplify-address (addr) + (let ((addr (car (cdr (mail-extract-address-components addr))))) + (if (string-match (concat "@" (system-name) "$") addr) + (substring addr 0 (match-beginning 0)) + addr))) + +(defun bbdb-mail-alias-file-write-hook () + "Regenerate mail-aliases if necc. +Call from local-write-file-hooks." + (let ((buffer-read-only nil)) + (message "Writing aliases...") + (delete-region (point-min) (point-max)) + (bbdb-insert-mail-aliases) + (message "Writing aliases...done") + nil)) + +;;; +;;; sorting frobnification. +;;; + +(defun bbdb-sort-by (field) + "Tell BBDB which field is the primary sort key. +Currently FIELD must be one of 'firstname 'lastname or 'company. +The first time you use this, use bbdb-resort-database immediately +afterwards. Then put \(bbdb-sort-by 'firstname), or whichever field is +your choice, on your bbdb-after-load-db-hook." + (cond ((eq field 'lastname) + (defun bbdb-record-sortkey (record) + (or (bbdb-cache-sortkey (bbdb-record-cache record)) + (bbdb-cache-set-sortkey + (bbdb-record-cache record) + (downcase + (concat (bbdb-record-lastname record) + (bbdb-record-firstname record) + (bbdb-record-company record))))))) + ((eq field 'firstname) + (defun bbdb-record-sortkey (record) + (or (bbdb-cache-sortkey (bbdb-record-cache record)) + (bbdb-cache-set-sortkey + (bbdb-record-cache record) + (downcase + (concat (bbdb-record-firstname record) + (bbdb-record-lastname record) + (bbdb-record-company record))))))) + ((eq field 'company) + (defun bbdb-record-sortkey (record) + (or (bbdb-cache-sortkey (bbdb-record-cache record)) + (bbdb-cache-set-sortkey + (bbdb-record-cache record) + (downcase + (concat (bbdb-record-company record) + (bbdb-record-lastname record) + (bbdb-record-firstname record))))))) + (t (error "Can only sort by firstname lastname or company!")))) + +;;; Local Variables: +;;; eval:(put 'calendar-for-loop 'lisp-indent-hook 6) +;;; End: diff --git a/bits/bbdb-to-outlook.el b/bits/bbdb-to-outlook.el new file mode 100644 index 0000000..a8dd6bf --- /dev/null +++ b/bits/bbdb-to-outlook.el @@ -0,0 +1,261 @@ +;;; This is bbdb-to-outlook.el, version 0.11 +;;; +;;; Author: Bin Mu <mubin@cs.uchicago.edu> +;;; <http://www.cs.uchicago.edu/~mubin> +;;; Created: 30 Oct 1997 +;;; Version: 0.11 +;;; +;;; Updated: 26 May 2004 +;;; Frank J. Christophersen <FJC@control.ee.ethz.ch> +;;; <http://www.control.ee.ethz.ch/~christop/> +;;; +;;; The Insidious Big Brother Database 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 1, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; +;;; This module is for exporting BBDB databases into a comma delimited +;;; text file, which can be imported into microsoft outlook contact forms and +;;; ms address book. +;;; +;;; USE: In the *BBDB* buffer, type O to convert the listing to text format. +;;; It will prompt you for a filename. And then you can import the file +;;; into Microsoft outlook contacts and outlook express address boook +;;; etc. +;;; +;;; INSTALLATION: Put this file somewhere on your load-path. +;;; Put (require 'bbdb-to-outlook) in your .emacs, or autoload it. +;;; +;;; + +(require 'bbdb) +(require 'bbdb-com) + +(define-key bbdb-mode-map "O" 'bbdb-to-outlook) + +(autoload 'bbdb-print-field-shown-p "bbdb-print") +(defalias 'bbdb-field-shown-p 'bbdb-print-field-shown-p) + +;;; +;;; Variables +;;; + +(defvar bbdb-to-outlook-file-name "~/bbdb.txt" + "*Default file name for printouts of BBDB database.") + +(defvar bbdb-to-outlook-prolog + (concat "\"First Name\"" + ",\"Last Name\"" + ",\"Company\"" + + ;; phones + ",\"Business Phone\"" + ",\"Home Phone\"" + ",\"Business Fax\"" + ",\"Mobile Phone\"" + ",\"Pager\"" + + ;; EMAIL + ",\"E-mail Address\"" + ",\"E-mail 2 Address\"" + ",\"E-mail 3 Address\"" + + ;; addresses + ",\"Business Street\"" + ",\"\"Business Street 2\"" + ",\"\"Business Street 3\"" + ",\"Business City\"" + ",\"Business State\"" + ",\"Business Postal Code\"" + ",\"Business Country\"" + + ",\"Home Street\"" + ",\"\"Home Street 2\"" + ",\"\"Home Street 3\"" + ",\"Home City\"" + ",\"Home State\"" + ",\"Home Postal Code\"" + ",\"Home Country\"" + + ;; notes + ; ",\"Nickname\"" doesn't work + ",\"Notes\"" + + ;; end of prolog + "\n" + ) + "*TeX statements to include at the beginning of the bbdb-to-outlook file.") + +(defvar bbdb-to-outlook-epilog "" + "*TeX statements to include at the end of the bbdb-to-outlook file.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun bbdb-to-outlook (to-file) + "Outlook the selected BBDB entries" + (interactive (list (read-file-name "To File: " bbdb-to-outlook-file-name))) + (setq bbdb-to-outlook-file-name (expand-file-name to-file)) + (let ((current-letter t) + (records (progn (set-buffer bbdb-buffer-name) + bbdb-records))) + (find-file bbdb-to-outlook-file-name) + (erase-buffer) + (while records + (setq current-letter + (bbdb-to-outlook-format-record (car (car records)) current-letter)) + (setq records (cdr records))) + (goto-char (point-min)) (insert bbdb-to-outlook-prolog) + (goto-char (point-max)) (insert bbdb-to-outlook-epilog) + (goto-char (point-min)))) + +(defun bbdb-to-outlook-format-record (record &optional current-letter brief) + "Insert the bbdb RECORD in TeX format. +Optional CURRENT-LETTER is the section we're in -- if this is non-nil and +the first letter of the sortkey of the record differs from it, a new section +heading will be outlook \(an arg of t will always produce a heading). +The new current-letter is the return value of this function. +Someday, optional third arg BRIEF will produce one-line format." + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "plus ungood: tex formatting deleted record"))) + + (let* ((first-letter + (substring (concat (bbdb-record-sortkey record) "?") 0 1)) + (lname (and (bbdb-field-shown-p 'name) + (bbdb-record-lastname record))) + (fname (and (bbdb-field-shown-p 'name) + (bbdb-record-firstname record))) + (comp (and (bbdb-field-shown-p 'company) + (bbdb-record-company record))) + (net (and (bbdb-field-shown-p 'net) + (bbdb-record-net record))) + (phones (and (bbdb-field-shown-p 'phone) + (bbdb-record-phones record))) + (addrs (and (bbdb-field-shown-p 'address) + (bbdb-record-addresses record))) + (aka (and (bbdb-field-shown-p 'aka) + (bbdb-record-aka record))) + (notes (bbdb-record-raw-notes record)) +;; notes;; skip notes + (begin (point))) + + ;; Section header, if neccessary. + + ;; name + (insert (format "\"%s\"" (bbdb-to-outlook-if-not-blank fname))) + (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank lname))) + (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank comp))) + + ;; Phone numbers + (insert (bbdb-to-outlook-phone phones "work\\|office")) + (insert (bbdb-to-outlook-phone phones "home")) + (insert (bbdb-to-outlook-phone phones "fax")) + (insert (bbdb-to-outlook-phone phones "car\\|mobile")) + (insert (bbdb-to-outlook-phone phones "page")) + + ;; Email address + ;; at most three email address + (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank (car net)))) + (setq net (cdr net)) + (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank (car net)))) + (setq net (cdr net)) + (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank (car net)))) + (setq net (cdr net)) + + ;; Addresses + (insert (bbdb-to-outlook-address addrs "work\\|office")) + (insert (bbdb-to-outlook-address addrs "home")) + + ;; Notes + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + +; (if aka +; (insert (format ",\"%s\"" +; (mapconcat (function identity) aka ", "))) +; (insert ",\"\"")) +; + (insert ",\"") + (while notes + (let ((thisnote (car notes))) + (if (bbdb-field-shown-p (car thisnote)) + (progn + (if (eq 'notes (car thisnote)) + (insert (format "Note: %s\n" + (bbdb-print-outlook-quote (cdr thisnote)))) + (if (not (eq 'mail-folders (car thisnote))) + (insert (format "%s: %s\n" + (bbdb-print-outlook-quote + (symbol-name (car thisnote))) + (bbdb-print-outlook-quote + (cdr thisnote))))))))) + (setq notes (cdr notes))) + + (if aka (insert (format "AKA: %s\n" + (mapconcat (function identity) aka ", ")))) + + (insert "\"") + + ;; end of everything + (insert "\n") + ;; If record is bare, delete anything we may have inserted. + ;; otherwise, mark the end of this record. + current-letter)) + +(defun bbdb-to-outlook-if-not-blank (string &rest more) + "If STRING is not null, then return it concatenated +with rest of arguments. If it is null, then all arguments are +ignored and the null string is returned." + (if (or (null string) (equal "" string)) + "" + (apply 'concat string more))) + +(defun bbdb-print-outlook-quote (string) + "replace \" with \' in the string" + (let (i) + (while (setq i (string-match "\"" string i)) + (setq string (concat (substring string 0 i) "\'" (substring string (1+ i)))))) + string) + +(defun bbdb-to-outlook-phone (phones pattern) + (let ((found nil) + (result ",\"\"")) + (while (and phones (not found)) + (let ((place (downcase (aref (car phones) 0))) + (number (bbdb-phone-string (car phones)))) + (if (setq found (string-match pattern place)) + (setq result (format ",\"%s\"" number))) + (setq phones (cdr phones)))) + result)) + + +(defun bbdb-to-outlook-address (addrs pattern) + (let ((found nil) + (result ",\"\",\"\",\"\",\"\",\"\",\"\",\"\"")) + (while addrs + (let ((place (downcase (aref (car addrs) 0))) + (addr (car addrs))) + (if (setq found (string-match pattern place)) + (setq result + (format + ",\"%s\",\"%s\",\"%s\",\"%s\",\"%s\",\"%s\",\"%s\"" + (bbdb-to-outlook-if-not-blank (nth 0 (bbdb-address-streets addr))) + (bbdb-to-outlook-if-not-blank (nth 1 (bbdb-address-streets addr))) + (bbdb-to-outlook-if-not-blank (nth 2 (bbdb-address-streets addr))) + (bbdb-to-outlook-if-not-blank (bbdb-address-city addr)) + (bbdb-to-outlook-if-not-blank (bbdb-address-state addr)) + (bbdb-to-outlook-if-not-blank (bbdb-address-zip-string addr)) + (bbdb-to-outlook-if-not-blank (bbdb-address-country addr)) + ))) + (setq addrs (cdr addrs)))) + result)) + +(provide 'bbdb-to-outlook)
\ No newline at end of file diff --git a/bits/bbdb-vcard-export.el b/bits/bbdb-vcard-export.el new file mode 100644 index 0000000..9d77024 --- /dev/null +++ b/bits/bbdb-vcard-export.el @@ -0,0 +1,239 @@ +;;; bbdb-vcard-export.el -- export BBDB as vCard files +;; +;; Copyright (c) 2002 Jim Hourihan +;; Copyright (c) 2005 Alex Schroeder +;; +;; bbdb-vcard-export.el 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, or (at +;; your option) any later version. +;; +;; This software 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;; Author: Jim Hourihan <jimh@panix.com> +;; Created: 2002-08-08 +;; Version: $Id: bbdb-vcard-export.el,v 1.3 2006/03/14 00:00:00 malcolmp Exp $ +;; Keywords: vcard ipod + +;;; Commentary + +;; I use this code to sync my ipod with bbdb under OS X. To do so: +;; +;; M-x bbdb-vcard-export-update-all +;; +;; and enter `/Volumes/IPOD_NAME/Contacts/' at the prompt +;; +;; vCard documentated in RFC 2426 <http://www.faqs.org/rfcs/rfc2426.html> +;; Value types documented in RFC 2425 <http://www.faqs.org/rfcs/rfc2425.html> + +;; The coding system used for writing the files is UTF-16 by default. +;; To use anything else, use a prefix argument: C-u M-x +;; bbdb-vcard-export-update-all. You will be prompted for another +;; coding system to use. Latin-1 is probably a good choice. +;; bbdb-file-coding-system's default value is iso-2022-7bit, which is +;; probably useless for vCard exports. + +;;; Code: + +(require 'bbdb) + +; XEmacs prior to 21.5 is not dumped with replace-regexp-in-string. In those +; cases it can be found in the xemacs-base package. +(eval-and-compile + (if (and (not (fboundp 'replace-regexp-in-string)) (featurep 'xemacs)) + (require 'easy-mmode))) + +(defvar bbdb-translation-table + '(("Mobile" . "Cell")) + "Translations of text items, typically for labels.") + +(defun bbdb-translate (str) + "Translate STR into some other string based on `bbdb-translation-table'." + (let ((translation (assoc str bbdb-translation-table))) + (if translation + (cdr translation) + str))) + +;; 2.3 Predefined VALUE Type Usage + +;; The predefined data type values specified in [MIME-DIR] MUST NOT be +;; repeated in COMMA separated value lists except within the N, +;; NICKNAME, ADR and CATEGORIES value types. + +;; The text value type defined in [MIME-DIR] is further restricted such +;; that any SEMI-COLON character (ASCII decimal 59) in the value MUST be +;; escaped with the BACKSLASH character (ASCII decimal 92). + +(defun bbdb-vcard-export-escape (str) + "Return a copy of STR with ; , and newlines escaped." + (setq str (bbdb-translate str) + str (or str ""); get rid of nil values + str (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str) + str (replace-regexp-in-string "\n" "\\\\n" str))) + +;; (insert (bbdb-vcard-export-escape "this is, not \\ or \n true")) + +(defun bbdb-vcard-export-several (list) + "Return a comma-separated list of escaped unique elements in LIST." + (let ((hash (make-hash-table :test 'equal)) + result) + (dolist (item list) + (puthash (bbdb-vcard-export-escape item) t hash)) + (maphash (lambda (key val) + (setq result (cons key result))) + hash) + (bbdb-join result ","))) + +;; The component values MUST be specified in +;; their corresponding position. The structured type value corresponds, +;; in sequence, to the post office box; the extended address; the street +;; address; the locality (e.g., city); the region (e.g., state or +;; province); the postal code; the country name. When a component value +;; is missing, the associated component separator MUST still be +;; specified. + +;; The text components are separated by the SEMI-COLON character (ASCII +;; decimal 59). Where it makes semantic sense, individual text +;; components can include multiple text values (e.g., a "street" +;; component with multiple lines) separated by the COMMA character +;; (ASCII decimal 44). +(defun bbdb-vcard-export-address-string (address) + "Return the address string" + (let ((streets (bbdb-address-streets address)) + (city (bbdb-address-city address)) + (state (bbdb-address-state address)) + (country (bbdb-address-country address)) + (zip (bbdb-address-zip address))) + (concat + "adr;type=" (bbdb-vcard-export-escape (bbdb-address-location address)) ":" + ";;" ;; no post office box, no extended address + (bbdb-vcard-export-several streets) ";" + (bbdb-vcard-export-escape city) ";" + (bbdb-vcard-export-escape state) ";" + (bbdb-vcard-export-escape zip) ";" + (bbdb-vcard-export-escape country)))) + +(defun bbdb-vcard-export-record-insert-vcard (record) + "Insert a vcard formatted version of RECORD into the current buffer" + (let ((name (bbdb-record-name record)) + (first-name (bbdb-record-firstname record)) + (last-name (bbdb-record-lastname record)) + (aka (bbdb-record-aka record)) + (company (bbdb-record-company record)) + (notes (bbdb-record-notes record)) + (phones (bbdb-record-phones record)) + (addresses (bbdb-record-addresses record)) + (net (bbdb-record-net record)) + (categories (bbdb-record-getprop + record + bbdb-define-all-aliases-field))) + (insert "begin:vcard\n" + "version:3.0\n") + ;; Specify the formatted text corresponding to the name of the + ;; object the vCard represents. The property MUST be present in + ;; the vCard object. + (insert "fn:" (bbdb-vcard-export-escape name) "\n") + ;; Family Name, Given Name, Additional Names, Honorific + ;; Prefixes, and Honorific Suffixes + (when (or last-name first-name) + (insert "n:" + (bbdb-vcard-export-escape last-name) ";" + (bbdb-vcard-export-escape first-name) ";;;\n")) + ;; Nickname of the object the vCard represents. One or more text + ;; values separated by a COMMA character (ASCII decimal 44). + (when aka + (insert "nickname:" (bbdb-vcard-export-several aka) "\n")) + ;; FIXME: use face attribute for this one. + ;; PHOTO;ENCODING=b;TYPE=JPEG:MIICajCCAdOgAwIBAgICBEUwDQYJKoZIhvcN + ;; AQEEBQAwdzELMAkGA1UEBhMCVVMxLDAqBgNVBAoTI05ldHNjYXBlIENvbW11bm + ;; ljYXRpb25zIENvcnBvcmF0aW9uMRwwGgYDVQQLExNJbmZvcm1hdGlvbiBTeXN0 + + ;; FIXME: use birthday attribute if there is one. + ;; BDAY:1996-04-15 + ;; BDAY:1953-10-15T23:10:00Z + ;; BDAY:1987-09-27T08:30:00-06:00 + + ;; A single structured text value consisting of components + ;; separated the SEMI-COLON character (ASCII decimal 59). But + ;; BBDB doesn't use this. So there's just one level: + (when company + (insert "org:" (bbdb-vcard-export-escape company) "\n")) + (when notes + (insert "note:" (bbdb-vcard-export-escape notes) "\n")) + (dolist (phone phones) + (insert "tel;type=" (bbdb-vcard-export-escape (bbdb-phone-location phone)) ":" + (bbdb-vcard-export-escape (bbdb-phone-string phone)) "\n")) + (dolist (address addresses) + (insert (bbdb-vcard-export-address-string address) "\n")) + (dolist (mail net) + (insert "email;type=internet:" (bbdb-vcard-export-escape mail) "\n")) + ;; Use CATEGORIES based on mail-alias. One or more text values + ;; separated by a COMMA character (ASCII decimal 44). + (when categories + (insert "categories:" + (bbdb-join (mapcar 'bbdb-vcard-export-escape + (bbdb-split categories ",")) ",") "\n")) + (insert "end:vcard\n"))) + +(defun bbdb-vcard-export-vcard-name-from-record (record) + "Come up with a vcard name given a record" + (let ((name (bbdb-record-name record)) + (first-name (elt record 0)) + (last-name (elt record 1))) + (concat first-name "_" last-name ".vcf"))) + +(defun bbdb-vcard-export-make-vcard (record vcard-name) + "Make a record buffer and write it" + (let ((buffer (get-buffer-create "*bbdb-vcard-export*"))) + (save-excursion + (set-buffer buffer) + (kill-region (point-min) (point-max)) + (bbdb-vcard-export-record-insert-vcard record) + (write-region (point-min) (point-max) vcard-name)) + (kill-buffer buffer))) + +(defun bbdb-vcard-do-record (record output-dir coding-system) + "Update the vcard of one bbdb record" + (setq coding-system (or coding-system 'utf-16)) + (let ((coding-system-for-write coding-system)) + (message "Updating %s" (bbdb-record-name record)) + (bbdb-vcard-export-make-vcard + record + (concat output-dir + (bbdb-vcard-export-vcard-name-from-record record))))) + +(defun bbdb-vcard-export-update-all (output-dir coding-system) + "Update the vcard Contacts directory from the bbdb database" + (interactive "DDirectory to update: \nZCoding system: ") + (bbdb ".*" nil) + (dolist (record (bbdb-records)) + (bbdb-vcard-do-record record output-dir coding-system))) + +(defun bbdb-vcard-export (regexp output-dir coding-system) + "Update the vcard Contacts directory from records matching REGEXP" + (interactive "sExport records matching: \nDDirectory to update: \nZCoding system: ") + (bbdb regexp nil) + (let ((notes (cons '* regexp))) + (dolist (record (bbdb-search (bbdb-records) regexp regexp regexp notes nil)) + (message "Updating %s" (bbdb-record-name record)) + (bbdb-vcard-do-record record output-dir coding-system)))) + +(defun bbdb-vcard-export-current (output-dir coding-system) + "Update the vcard of the current record" + (interactive "DDirectory to update: \nZCoding system: ") + (let ((record (bbdb-current-record nil))) + (bbdb-vcard-do-record record output-dir coding-system))) + +(define-key bbdb-mode-map [(v)] 'bbdb-vcard-export-current) + + +(provide 'bbdb-vcard-export) + +;;; bbdb-vcard-export.el ends here diff --git a/bits/bbdb-vcard-import.el b/bits/bbdb-vcard-import.el new file mode 100644 index 0000000..27f592d --- /dev/null +++ b/bits/bbdb-vcard-import.el @@ -0,0 +1,199 @@ +;;; bbdb-vcard-import.el -- import vCards into BBDB +;; +;; Copyright (c) 2008 Marcus Crestani +;; +;; bbdb-vcard-import.el 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, or (at +;; your option) any later version. +;; +;; This software 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;; Author: Marcus Crestani <crestani@informatik.uni-tuebingen.de> +;; Created: 2008-01-03 +;; Version: $Id: bbdb-vcard-import.el,v 1.6 2008/01/31 16:19:15 cvs Exp $ +;; Keywords: vcard bbdb +;; +;; This requires vcard.el by NoahFriedman for the importer to work. +;; +;; http://www.splode.com/~friedman/software/emacs-lisp/src/vcard.el +;; +;; The implementation is based on Christopher Smiths very simple +;; version of `bbdb-vcard-snarf-buffer': +;; +;; http://www.emacswiki.org/cgi-bin/wiki/BbdbImporters#toc3 +;; + +;;; Commentary + +;; +;; To import all vCards that are in the file ~/vCards.vcf do: +;; +;; M-x bbdb-vcard-import RET ~/vCards.vcf RET +;; + +;;; Todo + +;; +;; STREET ADDRESSES and PHONE NUMBERS are not yet imported. See +;; comment in `bbdb-vcard-merge'. +;; + +;;; ChangeLog + +;; +;; 2008-01-31 Marcus Crestani <crestani@informatik.uni-tuebingen.de> +;; - Do not enforce (type . "internet") for email addresses. +;; +;; 2008-01-03 Marcus Crestani <crestani@informatik.uni-tuebingen.de> +;; - Initial version. +;; + +;;; Code: + +(require 'vcard) +(require 'bbdb) + +(defvar bbdb-vcard-merged-records nil) + +(defun bbdb-vcard-filter-empty-values (values) + "Filter out empty values." + (if (consp values) + (if (string= "" (car values)) + (bbdb-vcard-filter-empty-values (cdr values)) + (cons (car values) (bbdb-vcard-filter-empty-values (cdr values)))))) + +(defun bbdb-vcard-values (record field) + "Return the values of an RECORD's FIELD; empty string entries are filtered out." + (let ((values (vcard-values record (list field)))) + (if values + (mapconcat 'identity + (bbdb-vcard-filter-empty-values (car values)) + ", ") + ""))) + +(defun bbdb-vcard-get-emails (record) + "Return a list of email addresses." + (let ((pref (vcard-ref record '("email" ("type" . "pref")))) + (rest (vcard-ref record '("email") '(("type" . "pref"))))) + (mapcar (lambda (entry) (car (cdr entry))) + (if pref + (cons (car pref) rest) + rest)))) + +(defun bbdb-vcard-get-phones (record) + "Return a list of phone number objects." + (let ((pref (vcard-ref record '("tel" ("type" . "pref")))) + (rest (vcard-ref record '("tel") '(("type" . "pref"))))) + (mapcar (lambda (entry) + (let ((proplist (car entry)) + (phone (car (cdr entry)))) + (vector + (vcard-get-property proplist "type") + phone))) + (if pref + (cons (car pref) rest) + rest)))) + +(defun bbdb-vcard-get-addresses (record) + "Return a list of adress objects." + (let ((pref (vcard-ref record '("adr" ("type" . "pref")))) + (rest (vcard-ref record '("adr") '(("type" . "pref"))))) + (mapcar (lambda (entry) + (let ((proplist (car entry)) + (phone (car (cdr entry)))) + (vector + (vcard-get-property proplist "type") + phone))) + (if pref + (cons (car pref) rest) + rest)))) + +(defun bbdb-vcard-merge-interactively (name company nets addrs phones notes) + "Interactively add a new record; see \\[bbdb-merge-interactively]." + (let* + ((f-l-name (bbdb-divide-name name)) + (firstname (car f-l-name)) + (lastname (nth 1 f-l-name)) + (aka nil) + (new-record + (vector firstname lastname aka company phones addrs + (if (listp nets) nets (list nets)) notes + (make-vector bbdb-cache-length nil))) + (old-record (bbdb-search-simple name nets))) + (if old-record + (progn + (setq new-record (bbdb-merge-internally old-record new-record)) + (bbdb-delete-record-internal old-record))) + ;; create new record + (bbdb-invoke-hook 'bbdb-create-hook new-record) + (bbdb-change-record new-record t) + (bbdb-hash-record new-record) + new-record)) + +(defun bbdb-vcard-merge (record) + "Merge data from vcard interactively into bbdb." + (let* ((name (bbdb-vcard-values record "fn")) + (company (bbdb-vcard-values record "org")) + (net (bbdb-vcard-get-emails record)) + (addrs (bbdb-vcard-get-addresses record)) + (phones (bbdb-vcard-get-phones record)) + (categories (bbdb-vcard-values record "categories")) + (notes (and (not (string= "" categories)) + (list (cons 'categories categories)))) + ;; TODO: addrs and phones are not yet imported. To do this + ;; right, figure out a way to map the several labels to + ;; `bbdb-default-label-list'. Also, some phone number + ;; conversion may break the format of numbers. + (new-record (bbdb-vcard-merge-interactively name company net nil nil notes))) + (setq bbdb-vcard-merged-records (append bbdb-vcard-merged-records + (list new-record))))) + +(defun bbdb-vcard-snarf-region (begin end) + "Bbdb-snarf each match." + (let ((record (vcard-parse-region begin end))) + (bbdb-vcard-merge record))) + +(defun bbdb-vcard-snarf-buffer (buf) + "Traverse BUF via regex. Bbdb-snarf against each match." + (setq bbdb-vcard-merged-records nil) + (let ((bbdb-current-buffer (current-buffer)) + (bbdb-current-point (point-min)) + (bbdb-next-point (point-min))) + (switch-to-buffer buf) + (goto-char bbdb-current-point) + (while (re-search-forward "END:VCARD" nil (message "%s done" buf)) + (setq bbdb-next-point (point)) + (bbdb-vcard-snarf-region bbdb-current-point (point)) + (switch-to-buffer buf) + (goto-char bbdb-next-point) + (setq bbdb-current-point (point))) + (switch-to-buffer bbdb-current-buffer) + (bbdb-display-records bbdb-vcard-merged-records))) + +(defun bbdb-vcard-snarf-current-buffer () + "Snarf the vcards in the current buffer." + (interactive) + (bbdb-vcard-snarf-buffer (current-buffer))) + +(defun bbdb-vcard-import-current-buffer () + "Import the vcards in the current buffer into your bbdb." + (interactive) + (bbdb-vcard-snarf-current-buffer)) + +(defun bbdb-vcard-import (file) + "Import the vcards in FILE into your bbdb." + (interactive "FvCard file to read from: ") + (let ((buffer (find-file file))) + (bbdb-vcard-snarf-buffer buffer) + (revert-buffer buffer) + (kill-buffer buffer))) + +(provide 'bbdb-vcard-import) diff --git a/bits/bbdbpalm.el b/bits/bbdbpalm.el new file mode 100644 index 0000000..4a308fb --- /dev/null +++ b/bits/bbdbpalm.el @@ -0,0 +1,501 @@ +;;; bbdbpalm.el -- BBDBpalm exporter of BBDB database to Palm(R) address book + +;; Copyright (C) 1999,2002,2006 Neil W. Van Dyke + +;; Author: Neil W. Van Dyke <neil@neilvandyke.org> +;; Version: 0.3 +;; X-URL: http://www.neilvandyke.org/bbdbpalm/ +;; X-CVS: $Id: bbdbpalm.el,v 1.26 2006-11-12 04:46:58 neil Exp $ + +;; This 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, or (at your option) any later version. This +;; 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 +;; Emacs; see the file `COPYING'. If not, write to the Free Software +;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.") + +;;; Commentary: + +;; ABOUT: +;; +;; BBDBpalm exports your BBDB address database to your Palm/USR/3Com +;; Pilot/PalmPilot/Palm-Connected-Organizer (hereinafter simply "Palm"). +;; BBDB is a sort of electronic address book written by Jamie Zawinsky +;; <jwz@jwz.org> that integrates nicely with Emacs-based E-mail and Usenet +;; clients. BBDBpalm lets you bring that address book with you if you +;; don't have the luxury of 24/7 network access to a remote Emacs session +;; from your Palm. +;; +;; The Web page is `http://www.neilvandyke.org/bbdbpalm/'. +;; +;; This package is no longer being maintained. + +;; REQUIREMENTS: +;; +;; BBDBpalm was developed with BBDB 1.51, which is available at +;; `http://www.jwz.org/bbdb/' if you don't already have it. It has also +;; been reported to work with BBDB 2.00.02. +;; +;; BBDBpalm uses the `pilot-addresses' program, which is part of the +;; Pilot-Link package. Pilot-Link is freely available on the 'net, and is +;; included with some GNU/Linux distributions. The master sources are +;; available at `ftp://ryeham.ee.ryerson.ca/pub/PalmOS/', although you may +;; wish to instead find a pre-compiled distribution for your operating +;; system. BBDBpalm was tested with version 0.9.0. +;; +;; BBDBpalm was developed under GNU Emacs 20.3 running atop the GNU/Linux +;; platform. It will probably work with Emacs 19 and has been reported to +;; work under XEmacs 21.2b17. It will probably work under Emacs on other +;; Unix variants. Please let me know if you encounter any problems with +;; other Emacsen or Unixen. + +;; INSTALLATION: +;; +;; If you're Emacs-savvy enough to be using BBDB, then you probably don't +;; need much install instructions. The only three non-obvious things you +;; need to do are: +;; +;; 1. On your Palm, add an Address List category called "BBDB", in all +;; caps. (Reason: Unfortunately, `pilot-addresses' does not presently +;; create categories on your Palm, or overwrite duplicate entries. +;; So, every time we upload to the Palm, we blast everything in the +;; "BBDB" category and put all the BBDB-exported records into that +;; category.) If you change entries on the Palm side of things, +;; change their category so that you remember to manually propagate +;; the change to BBDB. +;; +;; 2. If you don't want to export everything in your BBDB to the Palm, +;; then do both of: +;; +;; a. Put the following your `.emacs' file or wherever you put your +;; Emacs customizations: +;; +;; (setq bbdbpalm-export-all-p nil) +;; +;; b. Add a field called `palm' to each BBDB record that you wish to +;; export (by pressing `C-o' in the `*BBDB*' buffer with the +;; point on the desired record). Give each `palm' field a value +;; of `yes' for now. Note that a later version of BBDBpalm might +;; put something else in that field. +;; +;; 3. If you wish to have titles for people be exported to the Palm, add +;; a field called `title' to BBDB and use it. + +;; ALTERNATIVES: +;; +;; Tom Fawcett <fawcett@basit.com> wrote `bbdb-pilot', which is available +;; at `ftp://ftp.croftj.net/usr/fawcett/bbdb-pilot.el'. The version I +;; found, dated 1998, didn't seem to do what I wanted (I'm so picky) but +;; you may prefer it. +;; +;; Neale Picket <zephyr@roguetrader.com> hacked up a small convertor in +;; Feb-1998. See `http://acm.rpi.edu/~albert/pilot/Feb98/0039.html'. + +;; THINGS TO DO: +;; +;; * Add support for custom fields. +;; +;; * Add special support for `Web' custom field. +;; +;; * Maybe someday do bidirectional sync-ing. For now, users should just +;; keep all the BBDB-exported records in the `BBDB' category on their +;; Palm, and manually change those records on the BBDB end rather than on +;; the Palm end. +;; +;; * Maybe I should make it fix certain family names that BBDB has +;; mis-parsed, such as, well... I dunno... how about... "Van Dyke"? +;; Better yet, I should move to BBDB 2.x and make sure it's fixed there. +;; +;; * Make it be smarter about which address it picks if there are multiple +;; ones. +;; +;; * Add BBDB extension so that it prompts you for `palm' field. +;; +;; * Make it reformat phone numbers. +;; +;; * Add completion-percentage indicator for file-exporting and uploading. +;; +;; * Check for error from `pilot-addresses' and maybe do something with it. +;; +;; * ``I think it would be nice if the order of phone numbers as they +;; appear in the BBDB was preserved in the Pilot. Same thing for multiple +;; email addresses; they are now listed in reverse order.'' [Mark Moll +;; <mmoll@cs.cmu.edu>, 24-Jun-1999] +;; +;; * ``Maybe it's a good idea to put in a message "Please press the HotSync +;; button" at the appropiate time.'' [Mark Moll <mmoll@cs.cmu.edu>, +;; 24-Jun-1999] + +;;; Change Log: + +;; [Version 0.3, 2006-11-12] Made `bbdbpalm-format-record' work with newer BBDB +;; versions by use of `bbdb-address-streets'. Thanks to Christoph Conrad for +;; the patch. Note that I do not have access to a Palm and cannot test this +;; myself. +;; +;; [Version 0.2, 2002-10-15] I no longer have access to a Palm, so I am not +;; maintaining this package. This release is a snapshot of my last modified +;; version, which fixes a typo in jwz's name (writes one observant BBDBpalm +;; user: ``jwz's spelling of his last name differs a bit from yours. If +;; "Zawinksy" an in-joke, it's probably funny.''), and updates my email +;; address. +;; +;; [Version 0.1, 1999-06-23] Initial release. + +;;; Code: + +(defconst bbdbpalm-name "BBDBpalm") +(defconst bbdbpalm-version "0.3") + +;; Package Dependencies: + +(require 'bbdb) +(require 'cl) + +;; Options: + +(defvar bbdbpalm-category + "BBDB" + "*Name of the category under which the exported address records are to be +filed. Note that all addresses in this category will be removed from the Palm +when the new addresses are uploaded by `pilot-addresses'.") + +(defvar bbdbpalm-export-all-p + t + "*If non-nil, export all records, rather than exporting only those records +that that have a `palm' field.") + +(defvar bbdbpalm-export-file + (expand-file-name ".bbdbpalm-export" "~") + "*Filename of the file into which BBDB-Palm puts the exported address data +for `pilot-addresses'.") + +(defvar bbdbpalm-leave-work-field-p + t + "*If non-nil, never put anything in the first contact field (which defaults +to the Work phone number) except Work.") + +(defvar bbdbpalm-pilot-addresses-program + "pilot-addresses" + "*Command to invoke the `pilot-addresses' program. The program should either +be in the executable search path, or this variable should be set to a +fully-qualified pathname to the program file.") + +;; Constants: + +(defconst bbdbpalm-contactcode-strings + '((email . "E-Mail") + (fax . "Fax") + (home . "Home") + (mail . "Main") + (mobile . "Mobile") + (other . "Other") + (pager . "Pager") + (work . "Work"))) + +(defconst bbdbpalm-octal-700 448) + +;; Macros: + +(defmacro bbdbpalm-assq-del (key alist) + (assert (symbolp alist)) + (let ((cell (gensym)) + (eval-key (gensym)) + (head (gensym)) + (lasthead (gensym))) + `(let ((,eval-key ,key) + (,cell nil) + (,head ,alist) + (,lasthead nil)) + (while (and ,head (not ,cell)) + (setq ,cell (car ,head)) + (if (eq (car ,cell) ,eval-key) + (if ,lasthead + (setcdr ,lasthead (cdr ,head)) + (setq ,alist (cdr ,head))) + (setq ,cell nil) + (setq ,lasthead ,head) + (setq ,head (cdr ,head)))) + ,cell))) + +(defmacro bbdbpalm-log-activity (what &rest body) + ;; Note: This function was adapted from `jomtool-log-activity' in Neil's + ;; Jomtool package. + (let ((eval-what (gensym))) + `(let ((,eval-what ,what)) + (bbdbpalm-log (concat ,eval-what "...")) + (prog1 (progn ,@body) + (bbdbpalm-log (concat ,eval-what "...done")))))) + +;; Functions: + +(defun bbdbpalm () + (interactive) + (bbdbpalm-log-activity + "Exporting BBDB data to the Palm" + (bbdbpalm-export-to-file bbdbpalm-export-file) + (bbdbpalm-upload-export-file bbdbpalm-export-file))) + +(defun bbdbpalm-contactcode-string (contactcode) + (cdr (assq contactcode bbdbpalm-contactcode-strings))) + +(defun bbdbpalm-export-to-file (export-file) + (let (buf + old-default-file-modes + record) + (bbdbpalm-log-activity + (format "Exporting to file \"%s\"" export-file) + (unwind-protect + (progn + ;; Make sure created files are only readable by user. + (setq old-default-file-modes (default-file-modes)) + (set-default-file-modes bbdbpalm-octal-700) + ;; Find the file and empty it. + (setq buf (find-file-noselect export-file)) + (set-buffer buf) + (goto-char (point-min)) + (delete-region (point-min) (point-max)) + ;; Write the records. + (mapc (function + (lambda (record) + (let ((notes (bbdb-record-raw-notes record))) + (if (or bbdbpalm-export-all-p + (and (listp notes) (assq 'palm notes))) + (insert (bbdbpalm-format-record record)))))) + (bbdb-records)) + ;; Save the file and get rid of the buffer. + (save-buffer buf) + (kill-buffer buf)) + ;; unwind-protect cleanup: Restore default-file-modes. + (set-default-file-modes old-default-file-modes))))) + +(defun bbdbpalm-format-contact-field (contact-field) + (if contact-field + (list (bbdbpalm-contactcode-string (car contact-field)) + (cdr contact-field)) + nil)) + +(defun bbdbpalm-format-field (field) + (cond ((null field) "\"\"") + ((stringp field) (bbdbpalm-format-field-string field)) + ((listp field) (mapconcat 'bbdbpalm-format-field-string + field + ";")) + (t (error "Can't handle type of this field: " + field)))) + +(defun bbdbpalm-format-field-list (list) + (concat (mapconcat 'bbdbpalm-format-field + list + ",") + "\n")) + +(defun bbdbpalm-format-field-string (field) + (if field + ;; Note: This is a grossly slow way to do it. + (concat "\"" + (mapconcat (function + (lambda (c) + (cond ((= c 34) "\"\"") + ((and (> c 31) (< c 128)) (char-to-string c)) + ((= c 9) "\\t") + ((= c 10) "\\n") + (t "")))) + field + "") + "\"") + "\"\"")) + +(defun bbdbpalm-format-record (record) + (let ((city nil) + (contact-fields nil) + (country nil) + (custom-1 nil) + (custom-2 nil) + (custom-3 nil) + (custom-4 nil) + (group nil) + (show-field nil) + (state nil) + (street nil) + (title nil) + (zip nil)) + + ;; Prepare the contact fields. + (let ((contact-cands '())) + + ;; Add phone numbers to contact-cands. + (mapcar + (function + (lambda (phone) + (let ((code (bbdbpalm-location-to-contactcode + (bbdb-phone-location phone)))) + (if code + (setq contact-cands + (nconc contact-cands + (list (cons code + (bbdb-phone-string phone))))))))) + (bbdb-record-phones record)) + + ;; Add E-mail addresses to contact-cands (note that we want these + ;; added after the phone numbers, so that phone numbers get higher + ;; priority when we're filling up extra contact fields). + (mapcar (function (lambda (net) + (setq contact-cands + (nconc contact-cands + (list (cons 'email net)))))) + (bbdb-record-net record)) + + ;; Set the contact fields, giving preference to one of each and to the + ;; Palm default ordering. Fill the remaining empty contact fields with + ;; other contact info. + (setq contact-fields (list (bbdbpalm-assq-del 'work contact-cands) + (bbdbpalm-assq-del 'home contact-cands) + (bbdbpalm-assq-del 'fax contact-cands) + (bbdbpalm-assq-del 'other contact-cands) + (bbdbpalm-assq-del 'email contact-cands))) + (let ((probe contact-fields)) + (if bbdbpalm-leave-work-field-p + (setq probe (cdr probe))) + (while (and probe contact-cands) + (if (not (car probe)) + (progn + (setcar probe (car contact-cands)) + (setq contact-cands (cdr contact-cands)))) + (setq probe (cdr probe)))) + + ;; Set show-field. + (setq show-field (if (and (not (assq 'work contact-fields)) + (assq 'home contact-fields)) + "Home" + "Work"))) + + ;; Prepare address fields. + (let ((addr nil) + (addrs (bbdb-record-addresses record))) + (setq addr (car addrs)) + (if addr + (setq street (mapconcat + 'identity + (delq nil + (mapcar (function + (lambda (s) + (if (= (length s) 0) nil s))) + (bbdb-address-streets addr) + ;; Note: Old code. Replaced by above + ;; line for newer BBDB. + ;; + ;; (list (bbdb-address-street1 addr) + ;; (bbdb-address-street2 addr) + ;; (bbdb-address-street3 addr)) + )) + ", ") + city (bbdb-address-city addr) + state (bbdb-address-state addr) + zip (bbdb-address-zip-string addr) + country nil))) + + ;; Get information from the raw notes fields. + (mapcar (function (lambda (field) + (if (consp field) + (case (car field) + ('title (setq title (cdr field))) + ('group (setq group (cdr field))))))) + (bbdb-record-raw-notes record)) + + ;; Return the formatted record. + (bbdbpalm-format-field-list + (list + ;; 1. <FileCategory> SEMI <DisplayField> SEMI <LastName> + ;; "Unfiled";"Fax";"ALastName", + (list bbdbpalm-category show-field (bbdb-record-lastname record)) + ;; 2. <FirstName> + ;; "AFirstName", + (bbdb-record-firstname record) + ;; 3. <Title> + ;; "ATitle", + title + ;; 3. <Company> + ;; "ACompany", + (bbdb-record-company record) + ;; 4-8. ( <ContactAttr> SEMI <ContactValue> ) | ( <emptystring> ) + ;; "","","Fax";"zFax","Other";"zOther, with ""quotes""", + ;; "E-mail";"zEmail", + (bbdbpalm-format-contact-field (nth 0 contact-fields)) + (bbdbpalm-format-contact-field (nth 1 contact-fields)) + (bbdbpalm-format-contact-field (nth 2 contact-fields)) + (bbdbpalm-format-contact-field (nth 3 contact-fields)) + (bbdbpalm-format-contact-field (nth 4 contact-fields)) + ;; 9. <Street> + ;; "zAddress", + street + ;; 10. <City> + ;; "zCity", + city + ;; 11. "zState", + state + ;; 12. "zZip", + zip + ;; 13. "zCountry", + country + ;; 14. "zGroup", + custom-1 + ;; 15. "zWeb", + custom-2 + ;; 16. "zIrc", + custom-3 + ;; 17. "zC4", + custom-4 + ;; 18. <Notes> + ;; "", + (bbdb-record-notes record) + ;; 19. <Unknown2> + ;; "0" + "0")))) + +(defun bbdbpalm-location-to-contactcode (loc) + (let ((s (assoc (downcase loc) + '(("cell" . mobile) + ("fax" . fax) + ("home" . home) + ("main" . main) + ("mobile" . mobile) + ("office" . work) + ("pad" . home) + ("work" . work))))) + (if s (cdr s) 'other))) + +(defun bbdbpalm-log (format &rest args) + (apply 'message (concat bbdbpalm-name ": " format) args)) + +(defun bbdbpalm-upload-export-file (export-file) + (bbdbpalm-log-activity + (format "Uploading file \"%s\" to Palm" export-file) + (save-excursion + (save-window-excursion + (let ((buf (get-buffer-create "*BBDBpalm*"))) + (set-buffer buf) + (setq buffer-read-only nil) + (delete-region (point-min) (point-max)) + (insert bbdbpalm-name + " will now run \"" + bbdbpalm-pilot-addresses-program + "\" to upload the data to your Palm.\n\n") + (or (getenv "PILOTRATE") + (insert "You may be able to speed up uploads by setting your" + " \"PILOTRATE\" environment\n" + "variable. See your Pilot-Link documentation for" + " details.\n\n")) + (pop-to-buffer buf) + (call-process bbdbpalm-pilot-addresses-program + nil buf t + "-d" bbdbpalm-category + "-r" bbdbpalm-export-file) + (setq buffer-read-only t)))))) + +(provide 'bbdbpalm) + +;;; bbdbpalm.el ends here diff --git a/bits/make.bat b/bits/make.bat new file mode 100644 index 0000000..0e5248d --- /dev/null +++ b/bits/make.bat @@ -0,0 +1,106 @@ +@echo off + +rem Written by Yair Friedman (yair@MailAndNews.com) +rem Based upon the gnus make.bat by David Charlap (shamino@writeme.com) +rem +rem There are two possible problems with this batch file. The emacs.bat batch +rem file may not exist in all distributions. It is part of the GNU build of +rem Emacs 20.4 (http://www.gnu.org/softare/emacs/windows.ntemacs.html) If you +rem install BBDB with some other build, you may have to replace calls to +rem %1\emacs.bat with something else. +rem +rem Also, the emacs.bat file that comes with Emacs does not accept more than 9 +rem parameters, so the attempts to compile the .texi files will fail. To +rem fix that (at least on NT. I don't know about Win95), the following +rem change should be made to emacs.bat: +rem +rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 +rem +rem should become +rem +rem %emacs_dir%\bin\emacs.exe %* +rem +rem which will allow the batch file to accept an unlimited number of +rem parameters. + +rem For the meaning of these look at the Makefile. +rem Notice that you have to double any backslashes in the path. +set GNUSDIR=E:\\emacs-20.7\\lisp\\gnus +set MHEDIR= +set VMDIR= +set OTHERDIR= +rem give it any value if you want to use rmail with bbdb +set RMAIL= +rem This is where you bbdb lisp is going +set BBDBDIR=D:\\emacs-20.7\\site-lisp\\bbdb-2.2\\lisp + +rem Clear PWD so emacs doesn't get confused +set BBDB_PWD_SAVE=%PWD% +set PWD= + +if "%1" == "" goto usage + +rem Emacs 20.7 no longer includes emacs.bat. Use emacs.exe if the batch file is +rem not present -- this also fixes the problem about too many parameters on Win9x. +set emacs=emacs.exe +if exist %1\bin\emacs.bat set emacs=emacs.bat + +set VM=-eval "(progn (if (not (string-match \"%VMDIR%\" \"\")) (setq load-path (cons \"%VMDIR%\" load-path))) (if (load \"vm-version\" t) (cond ((> (string-to-number vm-version) 5.31) (load \"vm\")) (t (load \"vm-vars\") (load \"vm\")))))" +set GNUS=-eval "(if (not (string-match \"%GNUSDIR%\" \"\")) (setq load-path (cons \"%GNUSDIR%\" load-path)))" +set MHE=-eval "(progn (if (not (string-match \"%MHEDIR%\" \"\")) (setq load-path (cons \"%MHEDIR%\" load-path))) (load \"mh-e\"))" +set PUSHPATH=-eval "(setq load-path (delete \"\" (append (list \".\" \"%OTHERDIR%\") load-path)))" + +cd lisp + +call %1\bin\%emacs% -batch -q -no-site-file -f batch-byte-compile ./bbdb.el +call %1\bin\%emacs% -batch -q -no-site-file %PUSHPATH% -l ./bbdb.elc -f batch-byte-compile bbdb-com.el bbdb-hooks.el bbdb-print.el bbdb-ftp.el bbdb-whois.el bbdb-srv.el bbdb-reportmail.el bbdb-snarf.el bbdb-w3.el bbdb-sc.el bbdb-merge.el bbdb-migrate.el + +IF "%RMAIL%" == "" goto afterrmail +call %1\bin\%emacs% -batch -q -no-site-file %PUSHPATH% -l ./bbdb.elc -f batch-byte-compile bbdb-rmail.el +:afterrmail + +IF "%GNUSDIR%" == "" goto aftergnus +call %1\bin\%emacs% -batch -q -no-site-file %PUSHPATH% -l ./bbdb.elc %GNUS% -f batch-byte-compile bbdb-gnus.el +:aftergnus + +IF "%VMDIR%"=="" goto aftervm +call %1\bin\%emacs% -batch -q -no-site-file %PUSHPATH% -l ./bbdb.elc %VM% -f batch-byte-compile bbdb-vm.el +:aftervm + +IF "%MHEDIR%"=="" goto aftermhe +call %1\bin\%emacs% -batch -q -no-site-file %PUSHPATH% -l ./bbdb.elc %MHE% -f batch-byte-compile bbdb-mhe.el +:aftermhe + +echo home is where the heart is. + +rem echo > bbdb-autoloads.el +rem call %1\bin\%emacs% -batch -q -no-site-file -l autoload -eval "(setq generated-autoload-file \"%BBDBDIR%\\bbdb-autoloads.el\")" -eval "(setq make-backup-files nil)" -eval "(setq autoload-package-name \"bbdb\")" -f batch-update-autoloads %BBDBDIR% +call %1\bin\%emacs% -batch -q -no-site-file -f batch-byte-compile bbdb-autoloads.el + +if not "%2%"=="copy" goto info +attrib -r %1\lisp\bbdb\* +copy *.el* %1\lisp\bbdb + +:info +set EMACSINFOHACK="(while (re-search-forward \"@\\(end \\)?ifnottex\" nil t) (replace-match \"\"))" +cd ..\texinfo +call %1\bin\%emacs% -batch -q -no-site-file bbdb.texinfo -eval %EMACSINFOHACK% -eval "(setq max-lisp-eval-depth 600)" -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +if not "%2" == "copy" goto done +copy bbdb.info %1\info + +:done +cd .. +goto end + +:usage +echo Usage: make :emacs-dir: [copy] +echo. +echo where: :emacs-dir: is the directory you installed emacs in +echo eg. d:\emacs\20.4 +echo copy indicates that the compiled files should be copied to your +echo emacs lisp, info, and etc directories + +rem Restore PWD so whoever called this batch file doesn't get confused +set PWD=%BBDB_PWD_SAVE% +set BBDB_PWD_SAVE= +:end diff --git a/bits/vcard.el b/bits/vcard.el new file mode 100644 index 0000000..27eb3df --- /dev/null +++ b/bits/vcard.el @@ -0,0 +1,704 @@ +;;; vcard.el --- vcard parsing and display routines + +;; Copyright (C) 1997, 1999, 2000 Noah S. Friedman + +;; Author: Noah Friedman <friedman@splode.com> +;; Maintainer: friedman@splode.com +;; Keywords: vcard, mail, news +;; Created: 1997-09-27 + +;; $Id: vcard.el,v 1.11 2000/06/29 17:07:55 friedman Exp $ + +;; This program 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, or (at your option) +;; any later version. +;; +;; This program 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 program; if not, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Unformatted vcards are just plain ugly. But if you live in the MIME +;; world, they are a better way of exchanging contact information than +;; freeform signatures since the former can be automatically parsed and +;; stored in a searchable index. +;; +;; This library of routines provides the back end necessary for parsing +;; vcards so that they can eventually go into an address book like BBDB +;; (although this library does not implement that itself). Also included +;; is a sample pretty-printer which MUAs can use which do not provide their +;; own vcard formatters. + +;; This library does not interface directly with any mail user agents. For +;; an example of bindings for the VM MUA, see vm-vcard.el available from +;; +;; http://www.splode.com/~friedman/software/emacs-lisp/index.html#mail +;; +;; Updates to vcard.el should be available there too. + +;; The main entry point to this package is `vcard-pretty-print' although +;; any documented variable or function is considered part of the API for +;; operating on vcard data. + +;; The vcard 2.1 format is defined by the versit consortium. +;; See http://www.imc.org/pdi/vcard-21.ps +;; +;; RFC 2426 defines the vcard 3.0 format. +;; See ftp://ftp.rfc-editor.org/in-notes/rfc2426.txt + +;; A parsed vcard is a list of attributes of the form +;; +;; (proplist value1 value2 ...) +;; +;; Where proplist is a list of property names and parameters, e.g. +;; +;; (property1 (property2 . parameter2) ...) +;; +;; Each property has an associated implicit or explicit parameter value +;; (not to be confused with attribute values; in general this API uses +;; `parameter' to refer to property values and `value' to refer to attribute +;; values to avoid confusion). If a property has no explicit parameter value, +;; the parameter value is considered to be `t'. Any property which does not +;; exist for an attribute is considered to have a nil parameter. + +;; TODO: +;; * Finish supporting the 3.0 extensions. +;; Currently, only the 2.1 standard is supported. +;; * Handle nested vcards and grouped attributes? +;; (I've never actually seen one of these in use.) +;; * Handle multibyte charsets. +;; * Inverse of vcard-parse-string: write .VCF files from alist +;; * Implement a vcard address book? Or is using BBDB preferable? +;; * Improve the sample formatter. + +;;; Code: + +(defgroup vcard nil + "Support for the vCard electronic business card format." + :group 'vcard + :group 'mail + :group 'news) + +;;;###autoload +(defcustom vcard-pretty-print-function 'vcard-format-sample-box + "*Formatting function used by `vcard-pretty-print'." + :type 'function + :group 'vcard) + +;;;###autoload +(defcustom vcard-standard-filters + '(vcard-filter-html + vcard-filter-adr-newlines + vcard-filter-tel-normalize + vcard-filter-textprop-cr) + "*Standard list of filters to apply to parsed vcard data. +These filters are applied sequentially to vcard attributes when +the function `vcard-standard-filter' is supplied as the second argument to +`vcard-parse'." + :type 'hook + :group 'vcard) + + +;;; No user-settable options below. + +;; XEmacs 21 ints and chars are disjoint types. +;; For all else, treat them as the same. +(defalias 'vcard-char-to-int + (if (fboundp 'char-to-int) 'char-to-int 'identity)) + +;; This is just the version number for this package; it does not refer to +;; the vcard format specification. Currently, this package does not yet +;; support the full vcard 3.0 specification. +;; +;; Whenever any part of the API defined in this package change in a way +;; that is not backward-compatible, the major version number here should be +;; incremented. Backward-compatible additions to the API should be +;; indicated by increasing the minor version number. +(defconst vcard-api-version "2.0") + +;; The vcard standards allow specifying the encoding for an attribute using +;; these values as immediate property names, rather than parameters of the +;; `encoding' property. If these are encountered while parsing, associate +;; them as parameters of the `encoding' property in the returned structure. +(defvar vcard-encoding-tags + '("quoted-printable" "base64" "8bit" "7bit")) + +;; The vcard parser will auto-decode these encodings when they are +;; encountered. These methods are invoked via vcard-parse-region-value. +(defvar vcard-region-decoder-methods + '(("quoted-printable" . vcard-region-decode-quoted-printable) + ("base64" . vcard-region-decode-base64))) + +;; This is used by vcard-region-decode-base64 +(defvar vcard-region-decode-base64-table + (let* ((a "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + (len (length a)) + (tbl (make-vector 123 nil)) + (i 0)) + (while (< i len) + (aset tbl (vcard-char-to-int (aref a i)) i) + (setq i (1+ i))) + tbl)) + + +;;; This function can be used generically by applications to obtain +;;; a printable representation of a vcard. + +;;;###autoload +(defun vcard-pretty-print (vcard) + "Format VCARD into a string suitable for display to user. +VCARD can be an unparsed string containing raw VCF vcard data +or a parsed vcard alist as returned by `vcard-parse-string'. + +The result is a string with formatted vcard information suitable for +insertion into a mime presentation buffer. + +The function specified by the variable `vcard-pretty-print-function' +actually performs the formatting. That function will always receive a +parsed vcard alist." + (and (stringp vcard) + (setq vcard (vcard-parse-string vcard))) + (funcall vcard-pretty-print-function vcard)) + + +;;; Parsing routines + +;;;###autoload +(defun vcard-parse-string (raw &optional filter) + "Parse RAW vcard data as a string, and return an alist representing data. + +If the optional function FILTER is specified, apply that filter to each +attribute. If no filter is specified, `vcard-standard-filter' is used. + +Filters should accept two arguments: the property list and the value list. +Modifying in place the property or value list will affect the resulting +attribute in the vcard alist. + +Vcard data is normally in the form + + begin: vcard + prop1a: value1a + prop2a;prop2b;prop2c=param2c: value2a + prop3a;prop3b: value3a;value3b;value3c + end: vcard + +\(Whitespace around the `:' separating properties and values is optional.\) +If supplied to this function an alist of the form + + \(\(\(\"prop1a\"\) \"value1a\"\) + \(\(\"prop2a\" \"prop2b\" \(\"prop2c\" . \"param2c\"\)\) \"value2a\"\) + \(\(\"prop3a\" \"prop3b\"\) \"value3a\" \"value3b\" \"value3c\"\)\) + +would be returned." + (let ((vcard nil) + (buf (generate-new-buffer " *vcard parser work*"))) + (unwind-protect + (save-excursion + (set-buffer buf) + ;; Make sure last line is newline-terminated. + ;; An extra trailing newline is harmless. + (insert raw "\n") + (setq vcard (vcard-parse-region (point-min) (point-max) filter))) + (kill-buffer buf)) + vcard)) + +;;;###autoload +(defun vcard-parse-region (beg end &optional filter) + "Parse the raw vcard data in region, and return an alist representing data. +This function is just like `vcard-parse-string' except that it operates on +a region of the current buffer rather than taking a string as an argument. + +Note: this function modifies the buffer!" + (or filter + (setq filter 'vcard-standard-filter)) + (let ((case-fold-search t) + (vcard-data nil) + (pos (make-marker)) + (newpos (make-marker)) + properties value) + (save-restriction + (narrow-to-region beg end) + (save-match-data + ;; Unfold folded lines and delete naked carriage returns + (goto-char (point-min)) + (while (re-search-forward "\r$\\|\n[ \t]" nil t) + (goto-char (match-beginning 0)) + (delete-char 1)) + + (goto-char (point-min)) + (re-search-forward "^begin:[ \t]*vcard[ \t]*\n") + (set-marker pos (point)) + (while (and (not (looking-at "^end[ \t]*:[ \t]*vcard[ \t]*$")) + (re-search-forward ":[ \t]*" nil t)) + (set-marker newpos (match-end 0)) + (setq properties + (vcard-parse-region-properties pos (match-beginning 0))) + (set-marker pos (marker-position newpos)) + (re-search-forward "[ \t]*\n") + (set-marker newpos (match-end 0)) + (setq value + (vcard-parse-region-value properties pos (match-beginning 0))) + (set-marker pos (marker-position newpos)) + (goto-char pos) + (funcall filter properties value) + (setq vcard-data (cons (cons properties value) vcard-data))))) + (nreverse vcard-data))) + +(defun vcard-parse-region-properties (beg end) + (downcase-region beg end) + (let* ((proplist (vcard-split-string (buffer-substring beg end) ";")) + (props proplist) + split) + (save-match-data + (while props + (cond ((string-match "=" (car props)) + (setq split (vcard-split-string (car props) "=" 2)) + (setcar props (cons (car split) (car (cdr split))))) + ((member (car props) vcard-encoding-tags) + (setcar props (cons "encoding" (car props))))) + (setq props (cdr props)))) + proplist)) + +(defun vcard-parse-region-value (proplist beg end) + (let* ((encoding (vcard-get-property proplist "encoding")) + (decoder (cdr (assoc encoding vcard-region-decoder-methods))) + result pos match-beg match-end) + (save-restriction + (narrow-to-region beg end) + (cond (decoder + ;; Each `;'-separated field needs to be decoded and saved + ;; separately; if the entire region were decoded at once, we + ;; would not be able to distinguish between the original `;' + ;; chars and those which were encoded in order to quote them + ;; against being treated as field separators. + (goto-char beg) + (setq pos (set-marker (make-marker) (point))) + (setq match-beg (make-marker)) + (setq match-end (make-marker)) + (save-match-data + (while (< pos (point-max)) + (cond ((search-forward ";" nil t) + (set-marker match-beg (match-beginning 0)) + (set-marker match-end (match-end 0))) + (t + (set-marker match-beg (point-max)) + (set-marker match-end (point-max)))) + (funcall decoder pos match-beg) + (setq result (cons (buffer-substring pos match-beg) result)) + (set-marker pos (marker-position match-end)))) + (setq result (nreverse result)) + (vcard-set-property proplist "encoding" nil)) + (t + (setq result (vcard-split-string (buffer-string) ";"))))) + (goto-char (point-max)) + result)) + + +;;; Functions for retrieving property or value information from parsed +;;; vcard attributes. + +(defun vcard-values (vcard have-props &optional non-props limit) + "Return the values in VCARD. +This function is like `vcard-ref' and takes the same arguments, but return +only the values, not the associated property lists." + (mapcar 'cdr (vcard-ref vcard have-props non-props limit))) + +(defun vcard-ref (vcard have-props &optional non-props limit) + "Return the attributes in VCARD with HAVE-PROPS properties. +Optional arg NON-PROPS is a list of properties which candidate attributes +must not have. +Optional arg LIMIT means return no more than that many attributes. + +The attributes in VCARD which have all properties specified by HAVE-PROPS +but not having any specified by NON-PROPS are returned. The first element +of each attribute is the actual property list; the remaining elements are +the values. + +If a specific property has an associated parameter \(e.g. an encoding\), +use the syntax \(\"property\" . \"parameter\"\) to specify it. If property +parameter is not important or it has no specific parameter, just specify +the property name as a string." + (let ((attrs vcard) + (result nil) + (count 0)) + (while (and attrs (or (null limit) (< count limit))) + (and (vcard-proplist-all-properties (car (car attrs)) have-props) + (not (vcard-proplist-any-properties (car (car attrs)) non-props)) + (setq result (cons (car attrs) result) + count (1+ count))) + (setq attrs (cdr attrs))) + (nreverse result))) + +(defun vcard-proplist-all-properties (proplist props) + "Returns nil unless PROPLIST contains all properties specified in PROPS." + (let ((result t)) + (while (and result props) + (or (vcard-get-property proplist (car props)) + (setq result nil)) + (setq props (cdr props))) + result)) + +(defun vcard-proplist-any-properties (proplist props) + "Returns `t' if PROPLIST contains any of the properties specified in PROPS." + (let ((result nil)) + (while (and (not result) props) + (and (vcard-get-property proplist (car props)) + (setq result t)) + (setq props (cdr props))) + result)) + +(defun vcard-get-property (proplist property) + "Return the value from PROPLIST of PROPERTY. +PROPLIST is a vcard attribute property list, which is normally the first +element of each attribute entry in a vcard." + (or (and (member property proplist) t) + (cdr (assoc property proplist)))) + +(defun vcard-set-property (proplist property value) + "In PROPLIST, set PROPERTY to VALUE. +PROPLIST is a vcard attribute property list. +If VALUE is nil, PROPERTY is deleted." + (let (elt) + (cond ((null value) + (vcard-delete-property proplist property)) + ((setq elt (member property proplist)) + (and value (not (eq value t)) + (setcar elt (cons property value)))) + ((setq elt (assoc property proplist)) + (cond ((eq value t) + (setq elt (memq elt proplist)) + (setcar elt property)) + (t + (setcdr elt value)))) + ((eq value t) + (nconc proplist (cons property nil))) + (t + (nconc proplist (cons (cons property value) nil)))))) + +(defun vcard-delete-property (proplist property) + "Delete from PROPLIST the specified property PROPERTY. +This will not succeed in deleting the first member of the proplist, but +that element should never be deleted since it is the primary key." + (let (elt) + (cond ((setq elt (member property proplist)) + (delq (car elt) proplist)) + ((setq elt (assoc property proplist)) + (delq (car (memq elt proplist)) proplist))))) + + +;;; Vcard data filters. +;;; +;;; Filters receive both the property list and value list and may modify +;;; either in-place. The return value from the filters are ignored. +;;; +;;; These filters can be used for purposes such as removing HTML tags or +;;; normalizing phone numbers into a standard form. + +(defun vcard-standard-filter (proplist values) + "Apply filters in `vcard-standard-filters' to attributes." + (vcard-filter-apply-filter-list vcard-standard-filters proplist values)) + +;; This function could be used to dispatch other filter lists. +(defun vcard-filter-apply-filter-list (filter-list proplist values) + (while filter-list + (funcall (car filter-list) proplist values) + (setq filter-list (cdr filter-list)))) + +;; Some lusers put HTML (or even javascript!) in their vcards under the +;; misguided notion that it's a standard feature of vcards just because +;; Netscape supports this feature. That is wrong; the vcard specification +;; does not define any html content semantics and most MUAs cannot do +;; anything with html text except display them unparsed, which is ugly. +;; +;; Thank Netscape for abusing the standard and damned near rendering it +;; useless for interoperability between MUAs. +;; +;; This filter does a very rudimentary job. +(defun vcard-filter-html (proplist values) + "Remove HTML tags from attribute values." + (save-match-data + (while values + (while (string-match "<[^<>\n]+>" (car values)) + (setcar values (replace-match "" t t (car values)))) + (setq values (cdr values))))) + +(defun vcard-filter-adr-newlines (proplist values) + "Replace newlines with \"; \" in `adr' values." + (and (vcard-get-property proplist "adr") + (save-match-data + (while values + (while (string-match "[\r\n]+" (car values)) + (setcar values (replace-match "; " t t (car values)))) + (setq values (cdr values)))))) + +(defun vcard-filter-tel-normalize (proplist values) + "Normalize telephone numbers in `tel' values. +Spaces and hyphens are replaced with `.'. +US domestic telephone numbers are replaced with international format." + (and (vcard-get-property proplist "tel") + (save-match-data + (while values + (while (string-match "[\t._-]+" (car values)) + (setcar values (replace-match " " t t (car values)))) + (and (string-match "^(?\\(\\S-\\S-\\S-\\))? ?\ +\\(\\S-\\S-\\S- \\S-\\S-\\S-\\S-\\)" + (car values)) + (setcar values + (replace-match "+1 \\1 \\2" t nil (car values)))) + (setq values (cdr values)))))) + +(defun vcard-filter-textprop-cr (proplist values) + "Strip carriage returns from text values." + (and (vcard-proplist-any-properties + proplist '("adr" "email" "fn" "label" "n" "org" "tel" "title" "url")) + (save-match-data + (while values + (while (string-match "\r+" (car values)) + (setcar values (replace-match "" t t (car values)))) + (setq values (cdr values)))))) + + +;;; Decoding methods. + +(defmacro vcard-hexstring-to-ascii (s) + (if (string-lessp emacs-version "20") + `(format "%c" (car (read-from-string (format "?\\x%s" ,s)))) + `(format "%c" (string-to-number ,s 16)))) + +(defun vcard-region-decode-quoted-printable (&optional beg end) + (save-excursion + (save-restriction + (save-match-data + (narrow-to-region (or beg (point-min)) (or end (point-max))) + (goto-char (point-min)) + (while (re-search-forward "=\n" nil t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-min)) + (while (re-search-forward "=[0-9A-Za-z][0-9A-Za-z]" nil t) + (let ((s (buffer-substring (1+ (match-beginning 0)) (match-end 0)))) + (replace-match (vcard-hexstring-to-ascii s) t t))))))) + +(defun vcard-region-decode-base64 (&optional beg end) + (save-restriction + (narrow-to-region (or beg (point-min)) (or end (point-max))) + (save-match-data + (goto-char (point-min)) + (while (re-search-forward "[ \t\r\n]+" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (goto-char (point-min)) + (let ((count 0) + (n 0) + (c nil)) + (while (not (eobp)) + (setq c (char-after (point))) + (delete-char 1) + (cond ((char-equal c ?=) + (if (= count 2) + (insert (lsh n -10)) + ;; count must be 3 + (insert (lsh n -16) (logand 255 (lsh n -8)))) + (delete-region (point) (point-max))) + (t + (setq n (+ n (aref vcard-region-decode-base64-table + (vcard-char-to-int c)))) + (setq count (1+ count)) + (cond ((= count 4) + (insert (logand 255 (lsh n -16)) + (logand 255 (lsh n -8)) + (logand 255 n)) + (setq n 0 count 0)) + (t + (setq n (lsh n 6)))))))))) + + +(defun vcard-split-string (string &optional separator limit) + "Split STRING at occurences of SEPARATOR. Return a list of substrings. +Optional argument SEPARATOR can be any regexp, but anything matching the + separator will never appear in any of the returned substrings. + If not specified, SEPARATOR defaults to \"[ \\f\\t\\n\\r\\v]+\". +If optional arg LIMIT is specified, split into no more than that many + fields \(though it may split into fewer\)." + (or separator (setq separator "[ \f\t\n\r\v]+")) + (let ((string-list nil) + (len (length string)) + (pos 0) + (splits 0) + str) + (save-match-data + (while (<= pos len) + (setq splits (1+ splits)) + (cond ((and limit + (>= splits limit)) + (setq str (substring string pos)) + (setq pos (1+ len))) + ((string-match separator string pos) + (setq str (substring string pos (match-beginning 0))) + (setq pos (match-end 0))) + (t + (setq str (substring string pos)) + (setq pos (1+ len)))) + (setq string-list (cons str string-list)))) + (nreverse string-list))) + +(defun vcard-copy-tree (tree) + "Make a deep copy of nested conses." + (cond + ((consp tree) + (cons (vcard-copy-tree (car tree)) + (vcard-copy-tree (cdr tree)))) + (t tree))) + +(defun vcard-flatten (l) + (if (consp l) + (apply 'nconc (mapcar 'vcard-flatten l)) + (list l))) + + +;;; Sample formatting routines. + +(defun vcard-format-sample-box (vcard) + "Like `vcard-format-sample-string', but put an ascii box around text." + (let* ((lines (vcard-format-sample-lines vcard)) + (len (vcard-format-sample-max-length lines)) + (edge (concat "\n+" (make-string (+ len 2) ?-) "+\n")) + (line-fmt (format "| %%-%ds |" len)) + (formatted-lines + (mapconcat (function (lambda (s) (format line-fmt s))) lines "\n"))) + (if (string= formatted-lines "") + formatted-lines + (concat edge formatted-lines edge)))) + +(defun vcard-format-sample-string (vcard) + "Format VCARD into a string suitable for display to user. +VCARD should be a parsed vcard alist. The result is a string +with formatted vcard information which can be inserted into a mime +presentation buffer." + (mapconcat 'identity (vcard-format-sample-lines vcard) "\n")) + +(defun vcard-format-sample-lines (vcard) + (let* ((name (vcard-format-sample-get-name vcard)) + (title (vcard-format-sample-values-concat vcard '("title") 1 "; ")) + (org (vcard-format-sample-values-concat vcard '("org") 1 "; ")) + (addr (vcard-format-sample-get-address vcard)) + (tel (vcard-format-sample-get-telephone vcard)) + (lines (delete nil (vcard-flatten (list name title org addr)))) + (col-template (format "%%-%ds%%s" + (vcard-format-sample-offset lines tel))) + (l lines)) + (while tel + (setcar l (format col-template (car l) (car tel))) + ;; If we stripped away too many nil slots from l, add empty strings + ;; back in so setcar above will work on next iteration. + (and (cdr tel) + (null (cdr l)) + (setcdr l (cons "" nil))) + (setq l (cdr l)) + (setq tel (cdr tel))) + lines)) + +(defun vcard-format-sample-get-name (vcard) + (let ((name (car (car (vcard-values vcard '("fn") nil 1)))) + (email (car (vcard-format-sample-values + vcard '((("email" "pref")) + (("email" "internet")) + (("email"))) 1)))) + (cond ((and name email) + (format "%s <%s>" name email)) + (email) + (name) + ("")))) + +(defun vcard-format-sample-get-telephone (vcard) + (let ((fields '(("Work: " + (("tel" "work" "pref") . ("fax" "pager" "cell")) + (("tel" "work" "voice") . ("fax" "pager" "cell")) + (("tel" "work") . ("fax" "pager" "cell"))) + ("Home: " + (("tel" "home" "pref") . ("fax" "pager" "cell")) + (("tel" "home" "voice") . ("fax" "pager" "cell")) + (("tel" "home") . ("fax" "pager" "cell")) + (("tel") . ("fax" "pager" "cell" "work"))) + ("Cell: " + (("tel" "cell" "pref")) + (("tel" "cell"))) + ("Fax: " + (("tel" "pref" "fax")) + (("tel" "work" "fax")) + (("tel" "home" "fax")) + (("tel" "fax"))))) + (phones nil) + result) + (while fields + (setq result (vcard-format-sample-values vcard (cdr (car fields)))) + (while result + (setq phones + (cons (concat (car (car fields)) (car (car result))) phones)) + (setq result (cdr result))) + (setq fields (cdr fields))) + (nreverse phones))) + +(defun vcard-format-sample-get-address (vcard) + (let* ((addr (vcard-format-sample-values vcard '((("adr" "pref" "work")) + (("adr" "pref")) + (("adr" "work")) + (("adr"))) 1)) + (street (delete "" (list (nth 0 addr) (nth 1 addr) (nth 2 addr)))) + (city-list (delete "" (nthcdr 3 addr))) + (city (cond ((null (car city-list)) nil) + ((cdr city-list) + (format "%s, %s" + (car city-list) + (mapconcat 'identity (cdr city-list) " "))) + (t (car city-list))))) + (delete nil (if city + (append street (list city)) + street)))) + +(defun vcard-format-sample-values-concat (vcard have-props limit sep) + (let ((l (car (vcard-values vcard have-props nil limit)))) + (and l (mapconcat 'identity (delete "" (vcard-copy-tree l)) sep)))) + +(defun vcard-format-sample-values (vcard proplists &optional limit) + (let ((result (vcard-format-sample-ref vcard proplists limit))) + (if (equal limit 1) + (cdr result) + (mapcar 'cdr result)))) + +(defun vcard-format-sample-ref (vcard proplists &optional limit) + (let ((result nil)) + (while (and (null result) proplists) + (setq result (vcard-ref vcard + (car (car proplists)) + (cdr (car proplists)) + limit)) + (setq proplists (cdr proplists))) + (if (equal limit 1) + (vcard-copy-tree (car result)) + (vcard-copy-tree result)))) + +(defun vcard-format-sample-offset (row1 row2 &optional maxwidth) + (or maxwidth (setq maxwidth (frame-width))) + (let ((max1 (vcard-format-sample-max-length row1)) + (max2 (vcard-format-sample-max-length row2))) + (if (zerop max1) + 0 + (+ max1 (min 5 (max 1 (- maxwidth (+ max1 max2)))))))) + +(defun vcard-format-sample-max-length (strings) + (let ((maxlen 0)) + (while strings + (setq maxlen (max maxlen (length (car strings)))) + (setq strings (cdr strings))) + maxlen)) + +(provide 'vcard) + +;;; vcard.el ends here. diff --git a/configure b/configure new file mode 100755 index 0000000..fb3e848 --- /dev/null +++ b/configure @@ -0,0 +1,3627 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.65 for BBDB 2.36. +# +# Report bugs to <bbdb-info@lists.sourceforge.net>. +# +# +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, +# Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +# +# Copyright (C) 2000-2001 Didier Verna <didier@xemacs.org>. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + # We cannot yet assume a decent shell, so we have to provide a + # neutralization value for shells without unset; and this also + # works around shells that cannot unset nonexistent variables. + BASH_ENV=/dev/null + ENV=/dev/null + (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org and +$0: bbdb-info@lists.sourceforge.net about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error ERROR [LINENO LOG_FD] +# --------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with status $?, using 1 if that was 0. +as_fn_error () +{ + as_status=$?; test $as_status -eq 0 && as_status=1 + if test "$3"; then + as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 + fi + $as_echo "$as_me: error: $1" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 </dev/null +exec 6>&1 + +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='BBDB' +PACKAGE_TARNAME='bbdb' +PACKAGE_VERSION='2.36' +PACKAGE_STRING='BBDB 2.36' +PACKAGE_BUGREPORT='bbdb-info@lists.sourceforge.net' +PACKAGE_URL='' + +ac_unique_file="configure.ac" +ac_subst_vars='LTLIBOBJS +LIBOBJS +GREPCONTEXT +EMACS_FLAVOR +HUSHMAKE +BBDB_SRV +BBDB_REPORTMAIL +BBDB_SC +BBDB_LOADPATH +BBDB_MHE +BBDB_GNUS +BBDB_VM +BBDB_RMAIL +LINKPATH +SYMLINKS +PACKAGEDIR +OTHERDIRS +VMDIR +MHEDIR +GNUSDIR +EMACS_PROG +ETAGS +TEXI2DVI +MAKEINFO +COMPEXT +COMPRESS +TAR +GREP +RM +LN_S +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +SET_MAKE +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_emacs +with_gnus_dir +with_mhe_dir +with_vm_dir +enable_vm +enable_rmail +enable_gnus +enable_mhe +enable_developer +with_other_dirs +with_package_dir +with_symlinks +with_linkpath +' + ac_precious_vars='build_alias +host_alias +target_alias' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information." + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures BBDB 2.36 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/bbdb] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of BBDB 2.36:";; + esac + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-vm enable VM hooks (default depends on --with-vm-dir) + --enable-rmail enable RMAIL hooks [[no]] + --enable-gnus enable GNUS hooks [[yes]] + --enable-mhe enable MH-E hooks (default depends on + --with-mhe-dir) + --enable-developer enable developer hooks [[no]] + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-emacs=PROG choose which flavor of Emacs to use + --with-gnus-dir=DIR set the location of Gnus to DIR + --with-mhe-dir=DIR set the location of Mh-E to DIR + --with-vm-dir=DIR set the location of VM to DIR + --with-other-dirs=DIRS set other needed directories (a list of space or + colon separated paths) + --with-package-dir=DIR set the XEmacs package directory to DIR + [[/usr/lib/xemacs/site-packages]] + --with-symlinks install BBDB by linking instead of copying [[no]] + --with-linkpath=PATH path to symlink from if `pwd' does not work + +Report bugs to <bbdb-info@lists.sourceforge.net>. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +BBDB configure 2.36 +generated by GNU Autoconf 2.65 + +Copyright (C) 2009 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. + +Copyright (C) 2000-2001 Didier Verna <didier@xemacs.org>. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by BBDB $as_me 2.36, which was +generated by GNU Autoconf 2.65. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------------- ## +## File substitutions. ## +## ------------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + ac_site_file1=$CONFIG_SITE +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + +ac_config_files="$ac_config_files Makefile lisp/Makefile texinfo/Makefile tex/Makefile utils/Makefile" + + +if [ -d testing ] +then + ac_config_files="$ac_config_files testing/Makefile" + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + +ac_aux_dir= +for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do + for ac_t in install-sh install.sh shtool; do + if test -f "$ac_dir/$ac_t"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/$ac_t -c" + break 2 + fi + done +done +if test -z "$ac_aux_dir"; then + as_fn_error "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } +if test -z "$INSTALL"; then +if test "${ac_cv_path_install+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in #(( + ./ | .// | /[cC]/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + fi + done + done + ;; +esac + + done +IFS=$as_save_IFS + +rm -rf conftest.one conftest.two conftest.dir + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + INSTALL=$ac_install_sh + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 +$as_echo_n "checking whether ln -s works... " >&6; } +LN_S=$as_ln_s +if test "$LN_S" = "ln -s"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 +$as_echo "no, using $LN_S" >&6; } +fi + +# Extract the first word of "rm", so it can be a program name with args. +set dummy rm; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_RM+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $RM in + [\\/]* | ?:[\\/]*) + ac_cv_path_RM="$RM" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_RM="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_RM" && ac_cv_path_RM="/bin/rm" + ;; +esac +fi +RM=$ac_cv_path_RM +if test -n "$RM"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RM" >&5 +$as_echo "$RM" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +# Extract the first word of "grep", so it can be a program name with args. +set dummy grep; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_GREP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $GREP in + [\\/]* | ?:[\\/]*) + ac_cv_path_GREP="$GREP" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_GREP="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_GREP" && ac_cv_path_GREP="/bin/grep" + ;; +esac +fi +GREP=$ac_cv_path_GREP +if test -n "$GREP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GREP" >&5 +$as_echo "$GREP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for my keys" >&5 +$as_echo_n "checking for my keys... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 +$as_echo "not found" >&6; } +echo "Damn! I'm locked outside :-(" + + for ac_prog in gtar tar +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_TAR+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$TAR"; then + ac_cv_prog_TAR="$TAR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_TAR="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +TAR=$ac_cv_prog_TAR +if test -n "$TAR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TAR" >&5 +$as_echo "$TAR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$TAR" && break +done + + if test "x${TAR}" = "xtar" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking that tar is GNU tar" >&5 +$as_echo_n "checking that tar is GNU tar... " >&6; } + ${TAR} --version > /dev/null 2>&1 || TAR= + if test "x${TAR}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + fi + fi + if test "x${TAR}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No GNU tar program found." >&5 +$as_echo "$as_me: WARNING: *** No GNU tar program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** Some targets will be unavailable." >&5 +$as_echo "$as_me: WARNING: *** Some targets will be unavailable." >&2;} + fi + for ac_prog in gzip compress +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_COMPRESS+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$COMPRESS"; then + ac_cv_prog_COMPRESS="$COMPRESS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_COMPRESS="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +COMPRESS=$ac_cv_prog_COMPRESS +if test -n "$COMPRESS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $COMPRESS" >&5 +$as_echo "$COMPRESS" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$COMPRESS" && break +done + + + if test "x${COMPRESS}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No compression program found." >&5 +$as_echo "$as_me: WARNING: *** No compression program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** Tarballs will not be compressed." >&5 +$as_echo "$as_me: WARNING: *** Tarballs will not be compressed." >&2;} + COMPEXT= + elif test "x${COMPRESS}" = "xgzip" ; then + COMPRESS="gzip --verbose --best" + COMPEXT=gz + else + COMPEXT=Z + fi + # Extract the first word of "makeinfo", so it can be a program name with args. +set dummy makeinfo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_MAKEINFO+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MAKEINFO"; then + ac_cv_prog_MAKEINFO="$MAKEINFO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_MAKEINFO="makeinfo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MAKEINFO=$ac_cv_prog_MAKEINFO +if test -n "$MAKEINFO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAKEINFO" >&5 +$as_echo "$MAKEINFO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + if test "x${MAKEINFO}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No makeinfo program found." >&5 +$as_echo "$as_me: WARNING: *** No makeinfo program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** Info files will not be built." >&5 +$as_echo "$as_me: WARNING: *** Info files will not be built." >&2;} + fi + # Extract the first word of "texi2dvi", so it can be a program name with args. +set dummy texi2dvi; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_TEXI2DVI+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$TEXI2DVI"; then + ac_cv_prog_TEXI2DVI="$TEXI2DVI" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_TEXI2DVI="texi2dvi" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +TEXI2DVI=$ac_cv_prog_TEXI2DVI +if test -n "$TEXI2DVI"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEXI2DVI" >&5 +$as_echo "$TEXI2DVI" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + if test "x${TEXI2DVI}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No texi2dvi program found." >&5 +$as_echo "$as_me: WARNING: *** No texi2dvi program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** DVI and PDF files will not be built." >&5 +$as_echo "$as_me: WARNING: *** DVI and PDF files will not be built." >&2;} + fi + # Extract the first word of "etags", so it can be a program name with args. +set dummy etags; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ETAGS+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ETAGS"; then + ac_cv_prog_ETAGS="$ETAGS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ETAGS="etags" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ETAGS=$ac_cv_prog_ETAGS +if test -n "$ETAGS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ETAGS" >&5 +$as_echo "$ETAGS" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + if test "x${ETAGS}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No etags program found." >&5 +$as_echo "$as_me: WARNING: *** No etags program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** Tags file will not be built." >&5 +$as_echo "$as_me: WARNING: *** Tags file will not be built." >&2;} + fi + +# Check whether --with-emacs was given. +if test "${with_emacs+set}" = set; then : + withval=$with_emacs; EMACS_PROG="${withval}" +else + for ac_prog in emacs xemacs +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_EMACS_PROG+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $EMACS_PROG in + [\\/]* | ?:[\\/]*) + ac_cv_path_EMACS_PROG="$EMACS_PROG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_EMACS_PROG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +EMACS_PROG=$ac_cv_path_EMACS_PROG +if test -n "$EMACS_PROG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_PROG" >&5 +$as_echo "$EMACS_PROG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$EMACS_PROG" && break +done + +fi + + if test "x${EMACS_PROG}" = "x" ; then + as_fn_error "*** No Emacs program found." "$LINENO" 5 + fi + if test -x "${EMACS_PROG}"; then + echo "yay" > /dev/null # because I don't know if 'if !' is portable + else + as_fn_error "*** ${EMACS_PROG} isn't executable." "$LINENO" 5 + fi + if test "x`echo $EMACS_PROG | grep \" \"`" != "x"; then + EMACS_PROG=\"$EMACS_PROG\" + fi + + + + + +# Check whether --with-gnus-dir was given. +if test "${with_gnus_dir+set}" = set; then : + withval=$with_gnus_dir; + enable_gnus=gnus + GNUSDIR="${withval}" + +fi + + + + + +# Check whether --with-mhe-dir was given. +if test "${with_mhe_dir+set}" = set; then : + withval=$with_mhe_dir; + enable_mhe=mhe + MHEDIR="${withval}" + +fi + + + + + +# Check whether --with-vm-dir was given. +if test "${with_vm_dir+set}" = set; then : + withval=$with_vm_dir; + enable_vm=vm + VMDIR="${withval}" + +fi + + + +# Various MTAs and other optional bits +# Default Gnus to on +enable_gnus=gnus + +# this seems far messier and more complex than I'd expect from autoconf... +# Check whether --enable-vm was given. +if test "${enable_vm+set}" = set; then : + enableval=$enable_vm; if test "x$enableval" = "xno"; then BBDB_VM=; enable_vm=; else BBDB_VM=vm; fi +fi + + +# Check whether --enable-rmail was given. +if test "${enable_rmail+set}" = set; then : + enableval=$enable_rmail; if test "x$enableval" = "xno"; then BBDB_RMAIL=; enable_rmail=; else BBDB_RMAIL=rmail; fi +else + BBDB_RMAIL= +fi + + +# Check whether --enable-gnus was given. +if test "${enable_gnus+set}" = set; then : + enableval=$enable_gnus; if test "x$enableval" = "xno"; then BBDB_GNUS=; enable_gnus=; else BBDB_GNUS=gnus; fi +else + BBDB_GNUS= +fi + + +# Check whether --enable-mhe was given. +if test "${enable_mhe+set}" = set; then : + enableval=$enable_mhe; if test "x$enableval" = "xno"; then BBDB_MHE=; enable_mhe=; else BBDB_MHE=mhe; fi +else + BBDB_MHE= +fi + + +# Check whether --enable-developer was given. +if test "${enable_developer+set}" = set; then : + enableval=$enable_developer; if test "x$enable" = "xno"; then HUSHMAKE=; fi +else + HUSHMAKE=@ +fi + + + + + +# Check whether --with-other-dirs was given. +if test "${with_other_dirs+set}" = set; then : + withval=$with_other_dirs; + case "$withval" in *:*) + withval="`echo $withval | sed -e 's/:/ /g'`";; + esac + OTHERDIRS="${withval}" + +fi + + + +echo "(setq load-path (append (list " > ${ac_confdir}/loadpath.el +for dir in . "${VMDIR}" "${GNUSDIR}" "${MHEDIR}" "${OTHERDIRS}" +do + if test "x$dir" != "x" + then + echo "(expand-file-name \"$dir\") " >> ${ac_confdir}/loadpath.el + fi +done +echo ") load-path))" >> ${ac_confdir}/loadpath.el + +BBDB_LOADPATH="${ac_confdir}/loadpath.el" + +if test "x$enable_vm" != "x"; then + BBDB_VM=`${EMACS_PROG} --no-site-file --no-init-file -batch -q -l ${BBDB_LOADPATH} -eval "(if (locate-library \"vm-autoload\") (message \"vm\"))" 2>&1` + if test "x$BBDB_VM" = "x"; then + as_fn_error "*** Cannot build VM support without VM's source." "$LINENO" 5 + fi +fi + +BBDB_SC=`${EMACS_PROG} -no-site-file -no-init-file -batch -q -l ${BBDB_LOADPATH} -eval "(if (locate-library \"supercite\") (message \"bbdb-sc.elc\"))" 2>&1` +BBDB_REPORTMAIL=`${EMACS_PROG} -no-site-file -no-init-file -batch -q -l ${BBDB_LOADPATH} -eval "(if (locate-library \"reportmail\") (message \"bbdb-reportmail.elc\"))" 2>&1` +BBDB_SRV=`${EMACS_PROG} -no-site-file -no-init-file -batch -q -l ${BBDB_LOADPATH} -eval "(progn (or (fboundp (quote define-obsolete-variable-alias)) (if (locate-library \"gnuserv-compat\") (load \"gnuserv-compat\" t t))) (if (and (locate-library \"gnuserv\") (locate-library \"itimer\")) (message \"bbdb-srv.el\")))" 2>&1` + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking checking emacs-type of ${EMACS_PROG}" >&5 +$as_echo_n "checking checking emacs-type of ${EMACS_PROG}... " >&6; } +cat > conftest.el <<TEST +(princ (format "%s" (if (featurep 'xemacs ) 'xemacs 'emacs))) +TEST +EMACS_FLAVOR=`${EMACS_PROG} --no-site-file --batch -l conftest.el | ${GREP} .` +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${EMACS_FLAVOR}" >&5 +$as_echo "${EMACS_FLAVOR}" >&6; } + + + + +# Check whether --with-package-dir was given. +if test "${with_package_dir+set}" = set; then : + withval=$with_package_dir; + + PACKAGEDIR="${withval}" + +else + PACKAGEDIR="/usr/lib/xemacs/site-packages" +fi + + + + + + +# Check whether --with-symlinks was given. +if test "${with_symlinks+set}" = set; then : + withval=$with_symlinks; + + SYMLINKS="${withval}" + +else + SYMLINKS="no" +fi + + + + + + +# Check whether --with-linkpath was given. +if test "${with_linkpath+set}" = set; then : + withval=$with_linkpath; + + LINKPATH="${withval}" + +fi + + + +# Switch on some targets + + + + + + + + + + + +if test "${RM}" = "/bin/rm" -o "${RM}" = "/usr/bin/rm"; then + RM="${RM} -f" +fi + +if test "x$enable_developer" != "x"; then + if ${GREP} -C foo configure.ac > /dev/null 2>&1; then + GREPCONTEXT="-C" + else + GREPCONTEXT="-C5" + fi +fi + + + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + test "x$cache_file" != "x/dev/null" && + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + cat confcache >$cache_file + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: ${CONFIG_STATUS=./config.status} +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error ERROR [LINENO LOG_FD] +# --------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with status $?, using 1 if that was 0. +as_fn_error () +{ + as_status=$?; test $as_status -eq 0 && as_status=1 + if test "$3"; then + as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 + fi + $as_echo "$as_me: error: $1" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by BBDB $as_me 2.36, which was +generated by GNU Autoconf 2.65. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to <bbdb-info@lists.sourceforge.net>." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +BBDB config.status 2.36 +configured by $0, generated by GNU Autoconf 2.65, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2009 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +INSTALL='$INSTALL' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "lisp/Makefile") CONFIG_FILES="$CONFIG_FILES lisp/Makefile" ;; + "texinfo/Makefile") CONFIG_FILES="$CONFIG_FILES texinfo/Makefile" ;; + "tex/Makefile") CONFIG_FILES="$CONFIG_FILES tex/Makefile" ;; + "utils/Makefile") CONFIG_FILES="$CONFIG_FILES utils/Makefile" ;; + "testing/Makefile") CONFIG_FILES="$CONFIG_FILES testing/Makefile" ;; + + *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= + trap 'exit_status=$? + { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5 + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' <conf$$subs.awk | sed ' +/^[^""]/{ + N + s/\n// +} +' >>$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ + || as_fn_error "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/ +s/:*\${srcdir}:*/:/ +s/:*@srcdir@:*/:/ +s/^\([^=]*=[ ]*\):*/\1/ +s/:*$// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$tmp/stdin" \ + || as_fn_error "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \ + || as_fn_error "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&2;} + + rm -f "$tmp/stdin" + case $ac_file in + -) cat "$tmp/out" && rm -f "$tmp/out";; + *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; + esac \ + || as_fn_error "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit $? +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..6183e42 --- /dev/null +++ b/configure.ac @@ -0,0 +1,190 @@ +dnl configure.ac --- configuration setup for BBDB + +dnl Author: Didier Verna <didier@xemacs.org> +dnl Maintainer: Didier Verna <didier@xemacs.org>, Waider <waider@waider.ie> +dnl Created: Tue Nov 14 18:28:52 2000 + +dnl Copyright (C) 2000-2001 Didier Verna + +dnl BBDB is free software; you can redistribute it and/or modify +dnl it under the terms of the GNU Library General Public License as published +dnl by the Free Software Foundation; either version 2 of the License, or (at +dnl your option) any later version. + +dnl BBDB is distributed in the hope that it will be useful, +dnl but WITHOUT ANY WARRANTY; without even the implied warranty of +dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +dnl GNU Library General Public License for more details. + +dnl You should have received a copy of the GNU Library General Public License +dnl along with this program; if not, write to the Free Software Foundation, +dnl Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + +dnl Process this file with autoconf to produce a new configure script + +AC_PREREQ(2.65) + +BBDB_PRE_INIT +AC_INIT([BBDB],[BBDB_VERSION],[bbdb-info@lists.sourceforge.net]) + +AC_COPYRIGHT([Copyright (C) 2000-2001 Didier Verna <didier@xemacs.org>.]) + +AC_CONFIG_SRCDIR([configure.ac]) +dnl We only have install-sh right now, so it's not worth adding an aux +dnl directory just for that file. +dnl AC_ CONFIG_AUX_DIR +dnl The following macro is incompatible with the current Automake, but we +dnl don't use it for now. +AC_CONFIG_FILES([Makefile + lisp/Makefile + texinfo/Makefile + tex/Makefile + utils/Makefile]) + +dnl Make sure we don't accidentally try to configure a testing directory if +dnl one doesn't exist. +if [[ -d testing ]] +then + AC_CONFIG_FILES([testing/Makefile]) +fi + +dnl Common system utilities checking: +AC_PROG_MAKE_SET +AC_PROG_INSTALL +AC_PROG_LN_S +AC_PATH_PROG(RM, rm, /bin/rm) +AC_PATH_PROG(GREP, grep, /bin/grep) + +dnl ah ah ah. +AC_MSG_CHECKING([for my keys]) +AC_MSG_RESULT([not found]) +echo "Damn! I'm locked outside :-(" + +dnl External programs checking: +BBDB_PROG_GNU_TAR +BBDB_PROG_COMPRESS +BBDB_PROG_MAKEINFO +BBDB_PROG_TEXI2DVI +BBDB_PROG_ETAGS +BBDB_PROG_EMACS + +dnl Some customizations: +BBDB_ARG_SUBST([GNUSDIR], [gnus-dir], [DIR], [set the location of Gnus to DIR], + [], [[ enable_gnus=gnus ]]) +BBDB_ARG_SUBST([MHEDIR], [mhe-dir], [DIR], [set the location of Mh-E to DIR], + [], [[ enable_mhe=mhe ]]) +BBDB_ARG_SUBST([VMDIR], [vm-dir], [DIR], [set the location of VM to DIR], + [], [[ enable_vm=vm ]]) + +# Various MTAs and other optional bits +# Default Gnus to on +enable_gnus=gnus + +# this seems far messier and more complex than I'd expect from autoconf... +AC_ARG_ENABLE([vm], + AS_HELP_STRING([--enable-vm],[enable VM hooks (default depends on --with-vm-dir)]), + [if test "x$enableval" = "xno"; then BBDB_VM=; enable_vm=; else BBDB_VM=vm; fi]) + +AC_ARG_ENABLE(rmail, + AS_HELP_STRING([--enable-rmail],[enable RMAIL hooks [[no]]]), + [if test "x$enableval" = "xno"; then BBDB_RMAIL=; enable_rmail=; else BBDB_RMAIL=rmail; fi], [BBDB_RMAIL=]) + +AC_ARG_ENABLE(gnus, + AS_HELP_STRING([--enable-gnus],[enable GNUS hooks [[yes]]]), + [if test "x$enableval" = "xno"; then BBDB_GNUS=; enable_gnus=; else BBDB_GNUS=gnus; fi], [BBDB_GNUS=]) + +AC_ARG_ENABLE(mhe, + AS_HELP_STRING([--enable-mhe],[enable MH-E hooks (default depends on --with-mhe-dir)]), + [if test "x$enableval" = "xno"; then BBDB_MHE=; enable_mhe=; else BBDB_MHE=mhe; fi], [BBDB_MHE=]) + +dnl All this does for now is allows you to see the compile commands +AC_ARG_ENABLE(developer, + AS_HELP_STRING([--enable-developer],[enable developer hooks [[no]]]), + [if test "x$enable" = "xno"; then HUSHMAKE=; fi], [HUSHMAKE=@]) + +BBDB_ARG_SUBST([OTHERDIRS], [other-dirs], [DIRS], + [set other needed directories (a list of space or colon separated paths)], + [], + dnl #### WARNING: pay attention to the quoting of ACTION if given !!!!! + [[ BBDB_COLON_TO_SPACE(withval) ]]) + +dnl Set up load path file +echo "(setq load-path (append (list " > ${ac_confdir}/loadpath.el +for dir in . "${VMDIR}" "${GNUSDIR}" "${MHEDIR}" "${OTHERDIRS}" +do + if test "x$dir" != "x" + then + echo "(expand-file-name \"$dir\") " >> ${ac_confdir}/loadpath.el + fi +done +echo ") load-path))" >> ${ac_confdir}/loadpath.el + +BBDB_LOADPATH="${ac_confdir}/loadpath.el" + +dnl if VM was requested, make sure we have access to the source +if test "x$enable_vm" != "x"; then + BBDB_VM=`${EMACS_PROG} --no-site-file --no-init-file -batch -q -l ${BBDB_LOADPATH} -eval "(if (locate-library \"vm-autoload\") (message \"vm\"))" 2>&1` + if test "x$BBDB_VM" = "x"; then + AC_MSG_ERROR([*** Cannot build VM support without VM's source.]) + fi +fi + +dnl Now go looking for auxilliary packages (supercite, reportmail and gnuserv) +BBDB_SC=`${EMACS_PROG} -no-site-file -no-init-file -batch -q -l ${BBDB_LOADPATH} -eval "(if (locate-library \"supercite\") (message \"bbdb-sc.elc\"))" 2>&1` +BBDB_REPORTMAIL=`${EMACS_PROG} -no-site-file -no-init-file -batch -q -l ${BBDB_LOADPATH} -eval "(if (locate-library \"reportmail\") (message \"bbdb-reportmail.elc\"))" 2>&1` +BBDB_SRV=`${EMACS_PROG} -no-site-file -no-init-file -batch -q -l ${BBDB_LOADPATH} -eval "(progn (or (fboundp (quote define-obsolete-variable-alias)) (if (locate-library \"gnuserv-compat\") (load \"gnuserv-compat\" t t))) (if (and (locate-library \"gnuserv\") (locate-library \"itimer\")) (message \"bbdb-srv.el\")))" 2>&1` + +AC_MSG_CHECKING([checking emacs-type of ${EMACS_PROG}]) +cat > conftest.el <<TEST +(princ (format "%s" (if (featurep 'xemacs ) 'xemacs 'emacs))) +TEST +EMACS_FLAVOR=`${EMACS_PROG} --no-site-file --batch -l conftest.el | ${GREP} .` +AC_MSG_RESULT([${EMACS_FLAVOR}]) + +dnl XEmacsery +dnl is there a sane way to set this to a useful default? +BBDB_ARG_SUBST([PACKAGEDIR], [package-dir], [DIR], + [set the XEmacs package directory to DIR], + [/usr/lib/xemacs/site-packages]) + +BBDB_ARG_SUBST([SYMLINKS], [symlinks], [], + [install BBDB by linking instead of copying], [no]) + +BBDB_ARG_SUBST([LINKPATH], [linkpath], [PATH], + [path to symlink from if `pwd' does not work]) + +# Switch on some targets +AC_SUBST([BBDB_RMAIL]) +AC_SUBST([BBDB_VM]) +AC_SUBST([BBDB_GNUS]) +AC_SUBST([BBDB_MHE]) +AC_SUBST([BBDB_LOADPATH]) +AC_SUBST([BBDB_SC]) +AC_SUBST([BBDB_REPORTMAIL]) +AC_SUBST([BBDB_SRV]) +AC_SUBST([HUSHMAKE]) +AC_SUBST([EMACS_FLAVOR]) + +dnl Hacky Hacky. If RM really /is/ rm (i.e. we're not on DOS, for example) +dnl then make it 'quiet'. +if test "${RM}" = "/bin/rm" -o "${RM}" = "/usr/bin/rm"; then + RM="${RM} -f" +fi + +dnl More Hacky. Figure out the correct way to get contextual grep. +dnl this should only be switched on for developers since it's +dnl only required by the test stuff. +if test "x$enable_developer" != "x"; then + if ${GREP} -C foo configure.ac > /dev/null 2>&1; then + GREPCONTEXT="-C" + else + GREPCONTEXT="-C5" + fi +fi + +AC_SUBST(GREPCONTEXT) + +AC_OUTPUT + +dnl configure.ac ends here diff --git a/debian/.gitignore b/debian/.gitignore new file mode 100644 index 0000000..af44839 --- /dev/null +++ b/debian/.gitignore @@ -0,0 +1,5 @@ +/*.debhelper +/*.log +/*.substvars +/bbdb/ +/files diff --git a/debian/README.Debian b/debian/README.Debian new file mode 100644 index 0000000..26c2617 --- /dev/null +++ b/debian/README.Debian @@ -0,0 +1,79 @@ +To enable bbdb support add a call to bbdb-initialize in your .emacs: + +bbdb-initialize is a compiled Lisp function in `bbdb'. +(bbdb-initialize &rest TO-INSINUATE) + +*Initialize the BBDB. One or more of the following symbols can be +passed as arguments to initiate the appropriate insinuations. + + Initialization of mail/news readers: + + Gnus Initialize BBDB support for the Gnus version 3.14 or + older. + gnus Initialize BBDB support for the Gnus mail/news reader + version 3.15 or newer. If you pass the `gnus' symbol, + you should probably also pass the `message' symbol. + mh-e Initialize BBDB support for the MH-E mail reader. + rmail Initialize BBDB support for the RMAIL mail reader. + sendmail Initialize BBDB support for sendmail (M-x mail). + vm Initialize BBDB support for the VM mail reader. + NOTE: For the VM insinuation to work properly, you must + either call `bbdb-initialize' with the `vm' symbol from + within your VM initialization file ("~/.vm") or you + must call `bbdb-insinuate-vm' manually from within your + VM initialization file. + + Initialization of miscellaneous package: + + message Initialize BBDB support for Message mode. + reportmail Initialize BBDB support for the Reportmail mail + notification package. + sc Initialize BBDB support for the Supercite message + citation package. + w3 Initialize BBDB support for Web browsers. + +---+++--- + +In bits.tar.gz is the bits/ Subdir of the bbdb-Source packaged. +The README there states this: + +This is the collection of bits and pieces located on the net or mailed to me +by various folk that may or may not wind up in BBDB proper. They shouldn't +be considered part of the bbdb as-is, nor should you complain to me about +their failure to work. + +Look at it if you find something useful. If there is enough demand for some of the +files i can install them with bbdb. Just ask me. :) + +---------------------------------------------------------------- + +Trying to bring up-to-date, and make compatible with Emacs23 RMAIL. + +Imported via: + git cvsimport -v -C bbdb -s -k -u -a bbdb -d :pserver:anonymous@bbdb.cvs.sourceforge.net:/cvsroot/bbdb +on 17-Nov-2009 + +(the -s -k was a bug, as it substitutes "-k" for "/" in tags, oops, +thus disabling the -k, double oops.) + +Manually merged Debian patches and tagged Debian releases. + +Note that the upstream CVS repo did not contain the ./configure file, +while the upstream .orig tarballs do. I have left these out. + +To do an incremental update with upstream changes: + cd src/git/bbdb + git cvsimport -v -i -r origin -k -u -a -d :pserver:anonymous@bbdb.cvs.sourceforge.net:/cvsroot/bbdb bbdb + gitk --all; git merge origin/origin + + +The default upstream build process compiles the .el files, and +therefore needs a working emacs. The debian packaging process leaves +this to install time, so at build time we do not actually need an +emacs. But the configure script looks for one anyway, in order to +produce a proper lisp/Makefile, whose execution is however deferred +until installation time. Tweaking things to cause configuration to +not bail when no emacs is present is more trouble than just requiring +one at build time. So that's what we do. + + -- Barak A. Pearlmutter <bap@debian.org>, Tue, 9 Mar 2010 16:04:29 +0000 diff --git a/debian/bbdb-areacode-split.1 b/debian/bbdb-areacode-split.1 new file mode 100644 index 0000000..8410d5f --- /dev/null +++ b/debian/bbdb-areacode-split.1 @@ -0,0 +1,46 @@ +.\" Hey, EMACS: -*- nroff -*- +.\" First parameter, NAME, should be all caps +.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection +.\" other parameters are allowed: see man(7), man(1) +.TH BBDB-AREACODE-SPLIT.PL 1 "March 31, 2002" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +bbdb-areacode-split \- Looks for phone numbers in your .bbdb +.SH SYNOPSIS +.B bbdb-areacode-split +<old-code> <new-code> <exchanges-file> [bbdb] +.SH DESCRIPTION +Looks for phone numbers in your .bbdb with a particular area code +and one of a set of exchanges and changes the area code. The old +and new area codes are specified on the command line, as is the +location of a file that contains the exchanges that are being +changed. (The format of that file is very loose. Every three digit +sequence will be used.) + +This manual page was written for the Debian distribution +because the original program does not have a manual page. +Instead, it has documentation in the GNU Info format; see below. +.SH SEE ALSO +.BR bbdb-cid (1), +.BR bbdb-unlazy-lock (1). +.BR bbdb-srv (1). +.br +The bbdb is fully documented by +.IR "The insidious Big Brother Database for mail and news" , +available via the Infonode +.BR bbdb +. +.SH AUTHOR +This manual page was written by Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net>, +for the Debian GNU/Linux system (but may be used by others). diff --git a/debian/bbdb-cid.1 b/debian/bbdb-cid.1 new file mode 100644 index 0000000..4280dbd --- /dev/null +++ b/debian/bbdb-cid.1 @@ -0,0 +1,45 @@ +.\" Hey, EMACS: -*- nroff -*- +.\" First parameter, NAME, should be all caps +.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection +.\" other parameters are allowed: see man(7), man(1) +.TH BBDB-CID.PL 1 "March 31, 2002" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +bbdb-cid \- Caller-ID-logger +.SH SYNOPSIS +.B bbdb-cid +.SH DESCRIPTION +Opens the modem and waits for it to print caller-ID data. When it does, +it logs it to a file, parses it, and pops up a window using "xmessage". +If the number is present in your .bbdb file, it shows the name (or company) +associated with it. + +.IR "You have to edit the Skript and change it to fit into your System!" + +This manual page was written for the Debian distribution +because the original program does not have a manual page. +Instead, it has documentation in the GNU Info format; see below. +.SH SEE ALSO +.BR bbdb-areacode-split (1), +.BR bbdb-unlazy-lock (1). +.BR bbdb-srv (1). +.br +The bbdb is fully documented by +.IR "The insidious Big Brother Database for mail and news" , +available via the Infonode +.BR bbdb +. +.SH AUTHOR +This manual page was written by Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net>, +for the Debian GNU/Linux system (but may be used by others). diff --git a/debian/bbdb-pilot-jwz.el b/debian/bbdb-pilot-jwz.el new file mode 100644 index 0000000..07f6ff5 --- /dev/null +++ b/debian/bbdb-pilot-jwz.el @@ -0,0 +1,584 @@ +;;; bbdb-pilot-jwz.el --- bbdb to palmos address book conduit + +;; Copyright (C) 1999 Jamie Zawinski <jwz@jwz.org>, all rights reserved. + +;; Maintainer: Noah Friedman <friedman@splode.com> +;; Created: 2000-01-21 + +;; $Id: bbdb-pilot-jwz.el,v 1.8 2001/06/19 03:45:37 friedman Exp $ + +;; This program 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, or (at your option) +;; any later version. +;; +;; This program 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 program; if not, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; pilot-addresses expects a file with the following 19 fields: +;; +;; Last Name +;; First Name +;; Title +;; Company +;; Named Field 1 (default: Work) +;; Named Field 2 (default: Home) +;; Named Field 3 (default: Fax) +;; Named Field 4 (default: Other) +;; Named Field 5 (default: E-mail) +;; Address +;; City +;; State +;; Zip +;; Country +;; Custom 1 +;; Custom 2 +;; Custom 3 +;; Custom 4 +;; Note +;; +;; The "named fields" are the ones that have a field title that can be set +;; with a popup menu. The available titles are: +;; +;; Work +;; Home +;; Fax +;; Other +;; E-mail +;; Main +;; Pager +;; Mobile +;; +;; A record in the file consists of 19 fields followed by a newline. +;; Field values are enclosed in double-quotes and are separated by commas. +;; The "named" fields may also be preceeded by the field name and a +;; semicolon, e.g.: +;; "Home";"(415) 555-1212", +;; +;; Strings may contain newlines, and are read with backslash-decoding +;; (for \n, \t and so on.) +;; +;; Embedded quotes are double-quoted in csv output, e.g. " -> "" + +;;; Code: + +(require 'bbdb) +(require 'cl) + +(defconst bbdb-pilot-field-names + '["Work" "Home" "Fax" "Other" "E-mail" "Main" "Pager" "Mobile"]) + +;; `title' is in this list since, if present, it is handled specially and +;; we do not want to duplicate it in the notes section of each entry. +;; But it's still a user-defined "notes" field as far as bbdb is concerned. +(defconst bbdb-pilot-ignored-notes + '(mail-name mail-alias face mark-char title creation-date timestamp)) + + +(bbdb-defstruct bbdb-pilot- + lastname ; 1 + firstname ; 2 + title ; 3 + company ; 4 + name-1 value-1 ; 5 + name-2 value-2 ; 6 + name-3 value-3 ; 7 + name-4 value-4 ; 8 + name-5 value-5 ; 9 + address ; 10 + city ; 11 + state ; 12 + zip ; 13 + country ; 14 + custom-1 ; 15 + custom-2 ; 16 + custom-3 ; 17 + custom-4 ; 18 + note ; 19 + ) + + +(defun bbdb-pilot-format (pilot) + "Inserts a `pilot-addresses'-compatible description of the `pilot' struct +into the current buffer." + (let ((print-escape-newlines nil) + (print-escape-nonascii nil) + (standard-output (current-buffer))) + (save-restriction + (narrow-to-region (point) (point)) + (prin1 (or (bbdb-pilot-lastname pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-firstname pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-title pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-company pilot) "")) (insert ",") + + (prin1 (or (bbdb-pilot-name-1 pilot) "Other")) (insert ";") + (prin1 (or (bbdb-pilot-value-1 pilot) "")) (insert ",") + + (prin1 (or (bbdb-pilot-name-2 pilot) "Other")) (insert ";") + (prin1 (or (bbdb-pilot-value-2 pilot) "")) (insert ",") + + (prin1 (or (bbdb-pilot-name-3 pilot) "Other")) (insert ";") + (prin1 (or (bbdb-pilot-value-3 pilot) "")) (insert ",") + + (prin1 (or (bbdb-pilot-name-4 pilot) "Other")) (insert ";") + (prin1 (or (bbdb-pilot-value-4 pilot) "")) (insert ",") + + (prin1 (or (bbdb-pilot-name-5 pilot) "Other")) (insert ";") + (prin1 (or (bbdb-pilot-value-5 pilot) "")) (insert ",") + + (prin1 (or (bbdb-pilot-address pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-city pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-state pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-zip pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-country pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-custom-1 pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-custom-2 pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-custom-3 pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-custom-4 pilot) "")) (insert ",") + (prin1 (or (bbdb-pilot-note pilot) "")) (insert "\n") + + ;; Replace escaped double quotes (\") with "". + (goto-char (point-min)) + (while (re-search-forward "\\\\\"" nil t) + (replace-match "\"\"" nil t)) + (goto-char (point-max)))) + nil) + + +(defun bbdb-pilot-pretty-print (pilot) + ;; for debugging + (let ((i 0) + (names '["lastname" "firstname" "title" "company" + "name-1" "value-1" "name-2" "value-2" "name-3" "value-3" + "name-4" "value-4" "name-5" "value-5" "address" "city" + "state" "zip" "country" "custom-1" "custom-2" "custom-3" + "custom-4" "note"])) + (while (< i bbdb-pilot-length) + (insert (format "%12s: " (aref names i))) + (let ((s (aref pilot i)) + (print-escape-newlines t)) + (if (null s) (setq s "")) + (insert (format "%S\n" s))) + (setq i (1+ i)))) + nil) + + +(defun bbdb-record-to-pilot-record (record) + "Converts a BBDB record to a Pilot record." + (let ((pilot (make-vector bbdb-pilot-length nil)) + (phones (bbdb-record-phones record)) + (notes (bbdb-record-raw-notes record))) + + (if (stringp notes) + (setq notes (list (cons 'notes notes))) + ;; may be destructively modified later + (setq notes (copy-alist notes))) + + (if (bbdb-record-aka record) + (setq notes + (append notes + (list (cons 'AKA + (mapconcat 'identity + (bbdb-record-aka record) + ",\n")))))) + + ;; These fields are easy... + ;; + (bbdb-pilot-set-lastname pilot (bbdb-record-lastname record)) + (bbdb-pilot-set-firstname pilot (bbdb-record-firstname record)) + (bbdb-pilot-set-title pilot (bbdb-record-getprop record 'title)) + (bbdb-pilot-set-company pilot (bbdb-record-company record)) + + ;; Now do the phone numbers... + ;; + (let ((pilot-phones '())) + (while phones + (let ((loc (bbdb-phone-location (car phones))) + (num (bbdb-phone-string (car phones))) + field) + (cond ((string-match "\\b\\(work\\|office\\)" loc) + (setq field "Work")) + ((string-match "\\b\\(home\\)" loc) + (setq field "Home")) + ((string-match "\\b\\(fax\\|facs?imile\\)" loc) + (setq field "Fax")) + ((string-match "\\b\\(pager?\\|beeper\\)" loc) + (setq field "Pager")) + ((string-match "\\b\\(cell\\|mobile\\)" loc) + (setq field "Mobile")) + ((string-match "\\b\\(voice\\|main\\|phone\\)\\b" loc) + (setq field "Main")) + (t + ;; If we don't recognise the phone label, then call it + ;; "Other" but preserve the original label in the field + ;; itself. + (setq field "Other" + num (concat loc ": " num)))) + + ;; If this phone number is the same type as one previously seen + ;; (e.g. there are two pager numbers), append with a newline to + ;; the existing entry. This makes it possible to group multiple + ;; numbers in the same pilot field and make room for more numbers + ;; of different loc types. + (let ((seen (assoc field pilot-phones))) + (if seen + (setcdr seen (concat (cdr seen) "\n" num)) + (setq pilot-phones (cons (cons field num) pilot-phones)))) + (setq phones (cdr phones)))) + (setq pilot-phones (nreverse pilot-phones)) + + ;; The email field goes last in the list of phone fields + (if (bbdb-record-net record) + (let ((c (cons "E-mail" (car (bbdb-record-net record))))) + (setq pilot-phones (nconc pilot-phones (list c))))) + + (if (cdr (bbdb-record-net record)) + (setq notes + (cons (cons 'other-email + (mapconcat 'identity + (cdr (bbdb-record-net record)) + ",\n")) + notes))) + + (let (pp) + (setq pp (pop pilot-phones)) + (bbdb-pilot-set-name-1 pilot (car pp)) + (bbdb-pilot-set-value-1 pilot (cdr pp)) + + (setq pp (pop pilot-phones)) + (bbdb-pilot-set-name-2 pilot (car pp)) + (bbdb-pilot-set-value-2 pilot (cdr pp)) + + (setq pp (pop pilot-phones)) + (bbdb-pilot-set-name-3 pilot (car pp)) + (bbdb-pilot-set-value-3 pilot (cdr pp)) + + ;; We've filled in three phone-number fields. + ;; If there are more than 2 phone numbers left (not counting the + ;; email field), put remaining numbers in 4th field (with their + ;; headings) and put the email address in the 5th field. + (cond ((< (length pilot-phones) 3) + (setq pp (pop pilot-phones)) + (bbdb-pilot-set-name-4 pilot (car pp)) + (bbdb-pilot-set-value-4 pilot (cdr pp)) + + (setq pp (pop pilot-phones)) + (bbdb-pilot-set-name-5 pilot (car pp)) + (bbdb-pilot-set-value-5 pilot (cdr pp))) + (t + (let* ((email (assoc "E-mail" pilot-phones)) + (val + (mapconcat + #'(lambda (pp) + (let ((p 0) s) + ;; If there are newlines in the data, make sure + ;; each new line begins with the field name + ;; since this record is heterogenous. + (while (string-match "\n" (cdr pp) p) + (setq s (concat "\n" (car pp) ": ")) + (setq p (+ (match-end 0) (length s))) + (setcdr pp (replace-match s t t (cdr pp))))) + (concat (car pp) ": " (cdr pp))) + (delq email pilot-phones) "\n"))) + (bbdb-pilot-set-name-4 pilot "Other") + (bbdb-pilot-set-value-4 pilot val) + + (bbdb-pilot-set-name-5 pilot (car email)) + (bbdb-pilot-set-value-5 pilot (cdr email))))))) + + ;; Now do the addresses... + ;; Put the first address in the address field, and the others + ;; in the "custom" fields. + ;; + (let* ((addrs (bbdb-record-addresses record)) + (addr1 (pop addrs))) + (cond + (addr1 + (let (st) + (cond ((>= bbdb-file-format 6) + (setq st (bbdb-join (bbdb-address-streets addr1) "\n"))) + (t + (setq st (bbdb-address-street1 addr1)) + (if (> (length (bbdb-address-street2 addr1)) 0) + (setq st (concat st "\n" (bbdb-address-street2 addr1)))) + (if (> (length (bbdb-address-street3 addr1)) 0) + (setq st (concat st "\n" (bbdb-address-street3 addr1)))))) + + (setq st (concat (bbdb-address-location addr1) ":\n" st)) + + (bbdb-pilot-set-address pilot st) + (bbdb-pilot-set-city pilot (bbdb-address-city addr1)) + (bbdb-pilot-set-state pilot (bbdb-address-state addr1)) + (bbdb-pilot-set-zip pilot (bbdb-address-zip-string addr1)) + (bbdb-pilot-set-country pilot nil)))) + + (cond + (addrs + (let ((indent-tabs-mode nil) + (formatted '()) + addr c s) + (while addrs + (setq addr (car addrs)) + (save-excursion + (set-buffer (get-buffer-create "*bbdb-tmp*")) + (erase-buffer) + (insert (bbdb-address-location addr) ":\n") + (cond + ((>= bbdb-file-format 6) + (let ((sts (bbdb-address-streets addr))) + (while sts + (indent-to 8) + (insert (car sts) "\n") + (setq sts (cdr sts))))) + (t + (if (= 0 (length (setq s (bbdb-address-street1 addr)))) nil + (indent-to 8) (insert s "\n")) + (if (= 0 (length (setq s (bbdb-address-street2 addr)))) nil + (indent-to 8) (insert s "\n")) + (if (= 0 (length (setq s (bbdb-address-street3 addr)))) nil + (indent-to 8) (insert s "\n")))) + (indent-to 8) + (insert (setq c (bbdb-address-city addr))) + (setq s (bbdb-address-state addr)) + (if (and (> (length c) 0) (> (length s) 0)) (insert ", ")) + (insert s " ") + (insert (bbdb-address-zip-string addr)) + + (setq formatted (cons (buffer-string) formatted)) + (setq addrs (cdr addrs)))) + (setq formatted (nreverse formatted)) + + (bbdb-pilot-set-custom-1 pilot (pop formatted)) + (bbdb-pilot-set-custom-2 pilot (pop formatted)) + (bbdb-pilot-set-custom-3 pilot (pop formatted)) + (if (null (cdr formatted)) + (bbdb-pilot-set-custom-4 pilot (pop formatted)) + (bbdb-pilot-set-custom-4 pilot + (mapconcat 'identity formatted "\n")))))) + ) + + ;; Now handle the notes... + ;; + (let ((losers bbdb-pilot-ignored-notes)) + (while losers + (let ((c (assq (car losers) notes))) + (if c (setq notes (delete c notes)))) + (setq losers (cdr losers)))) + + (bbdb-pilot-set-note pilot + (mapconcat + #'(lambda (cons) + (save-excursion + (set-buffer (get-buffer-create "*bbdb-tmp*")) + (erase-buffer) + (insert (format "%s:\n%s" (car cons) (cdr cons))) + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (replace-match "\n " t t)) + (goto-char (point-max)) + (skip-chars-backward "\n\t ") + (buffer-substring (point-min) (point)))) + notes + "\n\n")) + + pilot)) + + +(defun bbdb-pilot-make-phone (location phone-string) + (let* ((num (make-vector + (if bbdb-north-american-phone-numbers-p + bbdb-phone-length + 2) + nil)) + (p (bbdb-parse-phone-number phone-string))) + (bbdb-phone-set-location num location) + (bbdb-phone-set-area num (nth 0 p)) ; euronumbers too. + (if (= (length num) 2) + nil + (bbdb-phone-set-exchange num (nth 1 p)) + (bbdb-phone-set-suffix num (nth 2 p)) + (bbdb-phone-set-extension num (or (nth 3 p) 0))) + num)) + + +(defun pilot-record-to-bbdb-record (pilot) + "Converts a Pilot record to a BBDB record." + (let ((firstname (bbdb-pilot-firstname pilot)) + (lastname (bbdb-pilot-lastname pilot)) + (company (bbdb-pilot-company pilot)) + (title (bbdb-pilot-title pilot)) ; #### + ;; #### AKA + (net nil) + (addrs '()) + (phones '()) + (pphones '()) + (notes '()) + ) + (if (equal company "") (setq company nil)) + (if (equal title "") (setq title nil)) + (if (equal notes "") (setq notes nil)) + + ;; Process the phone numbers and primary net address... + ;; + (setq pphones (list (cons (bbdb-pilot-name-1 pilot) + (bbdb-pilot-value-1 pilot)) + (cons (bbdb-pilot-name-2 pilot) + (bbdb-pilot-value-2 pilot)) + (cons (bbdb-pilot-name-3 pilot) + (bbdb-pilot-value-3 pilot)) + (cons (bbdb-pilot-name-4 pilot) + (bbdb-pilot-value-4 pilot)) + (cons (bbdb-pilot-name-5 pilot) + (bbdb-pilot-value-5 pilot)))) + (while pphones + (cond ((equal (car (car pphones)) "E-mail") + (setq net (list (cdr (car pphones))))) + ((and (equal (car (car pphones)) "Other") + (string-match "^\\([^ \t\n:]+\\):[ \t]*" + (cdr (car pphones)))) + (let ((a (substring (cdr (car pphones)) + (match-beginning 1) (match-end 1))) + (b (substring (cdr (car pphones)) (match-end 0)))) + (setq phones (cons (bbdb-pilot-make-phone a b) + phones)))) + ((> (length (cdr (car pphones))) 0) + (setq phones (cons (bbdb-pilot-make-phone (car (car pphones)) + (cdr (car pphones))) + phones)))) + (setq pphones (cdr pphones))) + (setq phones (nreverse phones)) + + ;; Now parse the primary address... + ;; + (cond ((> (length (bbdb-pilot-address pilot)) 0) + (let ((addr (make-vector bbdb-address-length nil)) + loc sts st1 st2 st3 + (street (bbdb-pilot-address pilot)) + (cty (bbdb-pilot-city pilot)) + (ste (bbdb-pilot-state pilot)) + (zip (bbdb-pilot-zip pilot)) + ) + (if (equal cty "") (setq cty nil)) + (if (equal ste "") (setq ste nil)) + (if (equal zip "") (setq zip nil)) + (if zip (setq zip (bbdb-parse-zip-string zip))) + + (if (string-match "^\\([^ \t\n:]+\\):[ \t\n]*" street) + (setq loc (substring street 0 (match-end 1)) + street (substring street (match-end 0)))) + + (bbdb-address-set-location addr loc) + + (cond + ((>= bbdb-file-format 6) + (while (string-match "^\\([^\n]+\\)\\(\n\\|$\\)" street) + (setq sts (append + sts + (list (substring street 0 (match-end 1)))) + street (substring street (match-end 0)))) + (bbdb-address-set-streets addr sts)) + (t + (if (string-match "^\\([^\n]+\\)\\(\n\\|$\\)" street) + (setq st1 (substring street 0 (match-end 1)) + street (substring street (match-end 0)))) + (if (string-match "^\\([^\n]+\\)\\(\n\\|$\\)" street) + (setq st2 (substring street 0 (match-end 1)) + street (substring street (match-end 0)))) + (if (string-match "^\\([^\n]+\\)\\(\n\\|$\\)" street) + (setq st3 (substring street 0 (match-end 1)) + street (substring street (match-end 0)))) + (bbdb-address-set-street1 addr (or st1 "")) + (bbdb-address-set-street2 addr (or st2 "")) + (bbdb-address-set-street3 addr (or st3 "")))) + + (bbdb-address-set-city addr (or cty "")) + (bbdb-address-set-state addr (or ste "")) + (bbdb-address-set-zip addr zip) + (setq addrs (list addr)) + ))) + + ;; Now parse the secondary addresses... + ;; + (let ((paddrs (list (bbdb-pilot-custom-1 pilot) + (bbdb-pilot-custom-2 pilot) + (bbdb-pilot-custom-3 pilot) + (bbdb-pilot-custom-4 pilot)))) + (while paddrs + (cond + ((car paddrs) + ;; #### parse text to address. fmh. + )) + (setq paddrs (cdr paddrs)))) + + ;; Now parse the notes field. + ;; + ;; #### + + (let ((record + (vector firstname lastname nil company phones addrs net notes + (make-vector bbdb-cache-length nil)))) + record))) + + +;;;###autoload +(defun bbdb-to-pilot-file (filename &optional records) + (interactive "FWrite pilot-addresses file: ") + (or records (setq records (bbdb-records))) + (save-excursion + (set-buffer (find-file-noselect filename)) + (erase-buffer) + (let ((len (length records)) + (i 0)) + (while records + (message "%d%%..." (/ (* 100 i) len)) + (bbdb-pilot-format (bbdb-record-to-pilot-record (car records))) + (setq records (cdr records) + i (1+ i)))) + (save-buffer) + (kill-buffer (current-buffer))) + filename) + + +(defun bbdb-to-pilot () + "Push the current contents of BBDB out to the Pilot." +; (interactive) + (bbdb-records) ; load bbdb + (message "Selecting records...") + (let ((records + (remove-if-not + #'(lambda (record) + (and (or (bbdb-record-name record) + (bbdb-record-company record)) + (let ((phones-p nil) + (phones (bbdb-record-phones record))) + (while phones + (let ((loc (bbdb-phone-location (car phones)))) + (if (and (not (string-match "cid" loc)) + (not (string-match "[?]" loc))) + (setq phones-p t))) + (setq phones (cdr phones))) + phones-p))) + (bbdb-records))) + + (file (format "/tmp/pilot-bbdb-%s-%d-%s" + (user-login-name) (emacs-pid) (float-time)))) + + (bbdb-to-pilot-file file records) + (shell-command (concat "pilot-addresses -p /dev/pilot " + "-d BBDB -c BBDB -r " file + ;;"; rm " file + " &")) + )) + +(provide 'bbdb-pilot-jwz) + +;;; bbdb-pilot-jwz.el ends here diff --git a/debian/bbdb-srv.1 b/debian/bbdb-srv.1 new file mode 100644 index 0000000..6fd0ef2 --- /dev/null +++ b/debian/bbdb-srv.1 @@ -0,0 +1,60 @@ +.\" Hey, EMACS: -*- nroff -*- +.\" First parameter, NAME, should be all caps +.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection +.\" other parameters are allowed: see man(7), man(1) +.TH BBDB-SRV.PL 1 "March 31, 2002" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +bbdb-srv \- Converts Mail-Headers to an Emacs-Lisp String. +.SH SYNOPSIS +.B echo "Some Headers" | bbdb-srv +.SH DESCRIPTION +This script reads a block of message headers on stdin, and converts them +to an emacs-lisp string (quoting all dangerous characters) and then +uses the `gnudoit' program to cause a running Emacs process to invoke +the `bbdb-srv' function with that string. + +This has the effect of causing the running Emacs to display the BBDB +record corresponding to these headers. + +See the Emacs side of things in bbdb-srv.el for more info. + +A trivial application of this is the shell command: + + echo 'From: Jamie Zawinski <jwz@netscape.com>' | bbdb-srv.perl + +which will cause the corresponding record to be displayed. +A more interesting application of this is: + + setenv NS_MSG_DISPLAY_HOOK bbdb-srv.perl + +which will hook BBDB up to Mozilla (Unix Netscape Mail and Netscape News +versions 3.0b2 and later only.) + +This manual page was written for the Debian distribution +because the original program does not have a manual page. +Instead, it has documentation in the GNU Info format; see below. +.SH SEE ALSO +.BR bbdb-areacode-split (1), +.BR bbdb-unlazy-lock (1). +.BR bbdb-srv (1). +.br +The bbdb is fully documented by +.IR "The insidious Big Brother Database for mail and news" , +available via the Infonode +.BR bbdb +. +.SH AUTHOR +This manual page was written by Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net>, +for the Debian GNU/Linux system (but may be used by others). diff --git a/debian/bbdb-unlazy-lock.1 b/debian/bbdb-unlazy-lock.1 new file mode 100644 index 0000000..06dd15d --- /dev/null +++ b/debian/bbdb-unlazy-lock.1 @@ -0,0 +1,41 @@ +.\" Hey, EMACS: -*- nroff -*- +.\" First parameter, NAME, should be all caps +.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection +.\" other parameters are allowed: see man(7), man(1) +.TH BBDB-UNLAZY-LOCK.PL 1 "March 31, 2002" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +bbdb--unlazy-lock \- Removes crap from lazy-lock from your .bbdb +.SH SYNOPSIS +.B bbdb-unlazy-lock +.SH DESCRIPTION +Lazy-lock-mode has (had) a nasty habit of munging .bbdb files if you +visited them with it on. This script removes the lazy-lock mung + +This manual page was written for the Debian distribution +because the original program does not have a manual page. +Instead, it has documentation in the GNU Info format; see below. +.SH SEE ALSO +.BR bbdb-areacode-split (1), +.BR bbdb-unlazy-lock (1). +.BR bbdb-srv (1). +.br +The bbdb is fully documented by +.IR "The insidious Big Brother Database for mail and news" , +available via the Infonode +.BR bbdb +. +.SH AUTHOR +This manual page was written by Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net>, +for the Debian GNU/Linux system (but may be used by others). diff --git a/debian/bbdb.doc-base b/debian/bbdb.doc-base new file mode 100644 index 0000000..9e1e563 --- /dev/null +++ b/debian/bbdb.doc-base @@ -0,0 +1,14 @@ +Document: bbdb +Title: Insidious Big Brother Database User Manual +Author: Jamie Zawinski, Matt Simmons and the BBDB Development Team +Abstract: BBDB is a rolodex-like database program for GNU Emacs and + XEmacs. BBDB stands for Insidious Big Brother Database, and is not, + repeat, not an obscure reference to the Buck Rogers TV series. +Section: Editors + +Format: HTML +Index: /usr/share/doc/bbdb/html/bbdb.html +Files: /usr/share/doc/bbdb/html/*.html + +Format: PDF +Files: /usr/share/doc/bbdb/bbdb.pdf.gz diff --git a/debian/bbdb.docs b/debian/bbdb.docs new file mode 100644 index 0000000..0871102 --- /dev/null +++ b/debian/bbdb.docs @@ -0,0 +1,2 @@ +bits.tar.gz +texinfo/bbdb.pdf diff --git a/debian/bbdb.emacsen-install b/debian/bbdb.emacsen-install new file mode 100755 index 0000000..3855114 --- /dev/null +++ b/debian/bbdb.emacsen-install @@ -0,0 +1,120 @@ +#!/bin/sh +# /usr/lib/emacsen-common/packages/install/bbdb + +FLAVOR=$1 +PACKAGE="bbdb" + +if [ "X${FLAVOR}" = "X" ]; then + echo Need argument to determine FLAVOR of emacs; + exit 1 +fi + +if [ "X${PACKAGE}" = "X" ]; then + echo Internal error: need package name; + exit 1; +fi + +ELDIR=/usr/share/emacs/site-lisp/${PACKAGE} +ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE} + +COMPILE="-q -batch -f batch-byte-compile" + +case "${FLAVOR}" in + emacs) + echo "install/${PACKAGE}: Ignoring Flavor ${FLAVOR} ..." + ;; + *) + + echo "install/${PACKAGE}: Byte-compiling for ${FLAVOR} ..." + + rm -rf ${ELCDIR} + cd ${ELDIR} + TARGETS="rmail mhe gnus bbdb" + + if [ -d /usr/share/${FLAVOR}/site-lisp/vm ]; then + TARGETS="$TARGETS vm" + elif [ ${FLAVOR} = xemacs20 -o ${FLAVOR} = xemacs21 ]; then + TARGETS="$TARGETS vm" + fi + + if [ ${FLAVOR} = emacs19 -o ${FLAVOR} = mule2 ]; then + MHEDIR=/usr/share/${FLAVOR}/site-lisp/../lisp + elif [ ${FLAVOR} = xemacs20 -o ${FLAVOR} = xemacs21 ]; then + MHEDIR=/usr/share/${FLAVOR}/site-lisp/../lisp/mh-e + else # emacs20 + MHEDIR=/usr/share/${FLAVOR}/site-lisp/../lisp/mail + fi + + ## for Gnus + if [ -d /usr/share/${FLAVOR}/site-lisp/gnus ]; then + GNUSDIR=/usr/share/${FLAVOR}/site-lisp/gnus + elif [ -d /usr/share/${FLAVOR}/site-lisp/semi-gnus ]; then + GNUSDIR=/usr/share/${FLAVOR}/site-lisp/semi-gnus + elif [ -d /usr/share/${FLAVOR}/site-lisp/t-gnus ]; then + GNUSDIR=/usr/share/${FLAVOR}/site-lisp/t-gnus + elif [ -d /usr/share/${FLAVOR}/site-lisp/chaos ]; then + GNUSDIR=/usr/share/${FLAVOR}/site-lisp/chaos + fi + + if [ -z ${GNUSDIR} ]; then + if [ ${FLAVOR} = emacs19 -o ${FLAVOR} = mule2 ]; then + GNUSDIR=/usr/share/emacs/19.34/lisp + elif [ ${FLAVOR} = xemacs20 ]; then + GNUSDIR=/usr/lib/xemacs-20.4/lisp/gnus + elif [ ${FLAVOR} = xemacs21 ]; then + GNUSDIR=/usr/share/xemacs21/packages/lisp/gnus + else + GNUSDIR=/usr/share/${FLAVOR}/site-lisp/../lisp/gnus + fi + fi + + LOG=`tempfile` + + rm -rf ${ELCDIR} && cp -a ${ELDIR} ${ELCDIR} + + # at ELCDIR + ( cd ${ELCDIR} + echo "Generating bbdb-autoloads..." + echo "Generating bbdb-autoloads" >> $LOG + make autoloads >> $LOG 2>&1 + if [ $FLAVOR != xemacs20 -a $FLAVOR != xemacs21 ]; then + echo "(provide 'bbdb-autoloads)" >> lisp/bbdb-autoloads.el + fi + echo "Byte-compiling bbdb. This takes looooooong..." + make $TARGETS EMACS_PROG=${FLAVOR} VMDIR=/usr/share/${FLAVOR}/site-lisp/vm GNUSDIR=${GNUSDIR} MHEDIR=${MHEDIR} >> $LOG 2>&1 + mv lisp/*.elc utils/*.el . + rm -rf tex utils lisp Makefile + ${FLAVOR} ${COMPILE} *.el >> $LOG 2>&1 + ) + cat > ${ELCDIR}/load-path.el <<EOF +(setq load-path (cons (concat "/usr/share/${FLAVOR}/site-lisp/bbdb") load-path)) +(provide 'bbdb/load-path) +EOF + if [ ! -e ${ELCDIR}/bbdb-gnus.elc ]; then + echo "*** installing not-compiled bbdb-gnus.el ***" >> $LOG + echo "install -m 644 ${ELDIR}/lisp/bbdb-gnus.el ${ELCDIR}" >> $LOG + install -m 644 ${ELDIR}/lisp/bbdb-gnus.el ${ELCDIR} + fi + + # a hack to fix #179821, #210248, #233904 + # If bbdb gets installed before vm then the bbdb doesnt have the bbdb-vm compiled.... + install -m 644 ${ELDIR}/lisp/bbdb-vm.el ${ELCDIR} + + # make -k clean >> $LOG + mv $LOG ${ELCDIR}/CompilationLog + gzip -9 ${ELCDIR}/CompilationLog + chmod 644 ${ELCDIR}/CompilationLog.gz + + # make symlinks for source files that were not copied over to ELCDIR + # this makes find-function and find-library work properly + cd ${ELDIR}/lisp + for f in *.el; do + if [ -e ${ELCDIR}/${f}c ] && [ ! -e ${ELCDIR}/${f} ]; then + ln -sf ${ELDIR}/lisp/${f} ${ELCDIR}/${f} + fi + done + + echo " done." + ;; +esac + diff --git a/debian/bbdb.emacsen-remove b/debian/bbdb.emacsen-remove new file mode 100755 index 0000000..f912bd1 --- /dev/null +++ b/debian/bbdb.emacsen-remove @@ -0,0 +1,36 @@ +#!/bin/sh +# /usr/lib/emacsen-common/packages/remove/bbdb + +# I don't think that remove scripts should have -e set, because +# that makes the package unremovable if the script fails. +# set -e + +FLAVOR=$1 +PACKAGE="bbdb" + +if [ "X${FLAVOR}" = "X" ]; then + echo Need argument to determine FLAVOR of emacs; + exit 1 +fi + +if [ "X${PACKAGE}" = "X" ]; then + echo Internal error: need package name; + exit 1; +fi + +ELDIR=/usr/share/emacs/site-lisp/${PACKAGE} +ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE} + +case "${FLAVOR}" in + emacs) + echo "remove/${PACKAGE}: Ignoring Flavor ${FLAVOR} ..." + ;; + *) + echo -n "remove/${PACKAGE}: Handling removal of emacsen flavor ${FLAVOR} ..." + rm -rf ${ELCDIR} + + echo " done." + ;; +esac + +exit 0; diff --git a/debian/bbdb.emacsen-startup b/debian/bbdb.emacsen-startup new file mode 100644 index 0000000..b0902dc --- /dev/null +++ b/debian/bbdb.emacsen-startup @@ -0,0 +1,29 @@ +;; bbdb startup file for Debian. + +;; Modified by Peter S Galbraith <psg@debian.org> to skip loading when +;; bbdb is not fully installed, as this file still exists when the +;; package is removed but not purged. + +(cond + ((not (file-exists-p "/usr/share/emacs/site-lisp/bbdb")) + (message "Package bbdb removed but not purged. Skipping setup.")) + ((not (file-exists-p (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/bbdb/bbdb-autoloads.elc"))) + (message "Package bbdb not fully installed. Skipping setup.")) + (t + + (debian-pkg-add-load-path-item + (concat "/usr/share/" (symbol-name debian-emacs-flavor) "/site-lisp/bbdb")) + + ;; (require 'message) + + ;; http://bugs.debian.org/85019 + (setq bbdb-sound-files nil) + (setq bbdb-sound-player nil) + (setq bbdb-sounds-directory nil) + + ;; (require 'bbdb) + ;; (bbdb-initialize) + + (require 'bbdb-autoloads))) diff --git a/debian/bbdb.info b/debian/bbdb.info new file mode 100644 index 0000000..8b0c148 --- /dev/null +++ b/debian/bbdb.info @@ -0,0 +1 @@ +texinfo/bbdb.info diff --git a/debian/bbdb.install b/debian/bbdb.install new file mode 100644 index 0000000..d9a2e4e --- /dev/null +++ b/debian/bbdb.install @@ -0,0 +1,8 @@ +Makefile usr/share/emacs/site-lisp/bbdb +lisp/*.el usr/share/emacs/site-lisp/bbdb/lisp +lisp/Makefile usr/share/emacs/site-lisp/bbdb/lisp +utils/*.el usr/share/emacs/site-lisp/bbdb/utils +debian/bbdb-pilot-jwz.el usr/share/emacs/site-lisp/bbdb +tex/*.tex usr/share/texmf/tex/bbdb +texinfo/bbdb/*.html usr/share/doc/bbdb/html +utils/*.pl usr/bin diff --git a/debian/bbdb.manpages b/debian/bbdb.manpages new file mode 100644 index 0000000..c283681 --- /dev/null +++ b/debian/bbdb.manpages @@ -0,0 +1,4 @@ +debian/bbdb-areacode-split.1 +debian/bbdb-cid.1 +debian/bbdb-srv.1 +debian/bbdb-unlazy-lock.1 diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..23aaf77 --- /dev/null +++ b/debian/changelog @@ -0,0 +1,455 @@ +bbdb (2.36-1) unstable; urgency=low + + * New "upstream" release. + * Look for upstream in github repo (debian/watch) + + -- Barak A. Pearlmutter <bap@debian.org> Tue, 20 Apr 2010 20:18:13 +0100 + +bbdb (2.35.cvs20080316-7) unstable; urgency=low + + * Update to bbdb-vcard 0.2, which no longer uses convcard + * Switch to dpkg-source 3.0 (quilt) format + * Build dependency on texlive-latex-base (closes: #577860) + + -- Barak A. Pearlmutter <bap@debian.org> Mon, 19 Apr 2010 09:59:29 +0100 + +bbdb (2.35.cvs20080316-6) unstable; urgency=low + + * Update bbdb-vcard + * Suggest multisync-tools for convcard used (default) by bbdb-vcard + * Use dpkg-source 1.0 format, as 3.0 (git) cannot handle submodules + + -- Barak A. Pearlmutter <bap@debian.org> Sat, 27 Mar 2010 10:31:32 +0000 + +bbdb (2.35.cvs20080316-5) unstable; urgency=low + + * fiddle with info stuff for robustness + * require emacs at build, avoiding extras install problem (closes: #571686) + * include bbdb-vcard in bits tarball + + -- Barak A. Pearlmutter <bap@debian.org> Tue, 09 Mar 2010 16:20:16 +0000 + +bbdb (2.35.cvs20080316-4) unstable; urgency=low + + * prevent debian build-time error when emacs not installed (closes: #571434) + * rev deb std + + -- Barak A. Pearlmutter <bap@debian.org> Fri, 26 Feb 2010 09:04:09 +0000 + +bbdb (2.35.cvs20080316-3) unstable; urgency=low + + * chmod +x configure patch, thanks to Kumar Appaiah (closes: #567197) + + -- Barak A. Pearlmutter <bap@debian.org> Wed, 03 Feb 2010 13:43:30 +0000 + +bbdb (2.35.cvs20080316-2) unstable; urgency=low + + * Misc additional files in bits/ + * Minor packaging tweaks + * Build dependency for /usr/bin/tex (closes: #560582) + + -- Barak A. Pearlmutter <bap@debian.org> Sun, 27 Dec 2009 20:26:22 -0500 + +bbdb (2.35.cvs20080316-1) unstable; urgency=low + + * Merge ongoing changes from upstream. (Closes: #440191) + - Includes menu commands (Closes: #96300) + - Fixes lisp/Makefile.in target extras mixing .el .elc (Closes: #366059) + * Bring into GIT. + * Regenerate debian/Makepatch to accommodate upstream changes. + * Fix RMAIL insinuation in Emacs 23. (Closes: #556993) + * Apply bbdb startup patch from Peter S Galbraith. (Closes: #353937) + * Correct typo. (Closes: #488729) + * Update backquote style in file lisp/bbdb-com.el. (Closes: #475600) + * Update Debian packaging. + - Avoiding double-installing bbdb-pilot-jwz.el file. (Closes: #557356) + - Avoiding double-installing .tex files. + - dh 7. + - rev deb std. + - debian/copyright updates: FSF address, common license location, expand. + - Misc housekeeping and tracking policy. + - Give debian patch files consistent names and locations. + * Switch scripts from /usr/bin/bbdb-FOO.pl to /usr/bin/bbdb-FOO. + * Merge Ununtu patch that symlinks some .el files at emacsen-install time. + * Include PDF documentation. + * Add Barak A. Pearlmutter <bap@debian.org> as co-maintainer. + + -- Barak A. Pearlmutter <bap@debian.org> Tue, 01 Dec 2009 22:10:39 -0500 + +bbdb (2.35.cvs20060204-1.2) unstable; urgency=low + + * NMU with the permission of the maintainer to adjust the dependencies + to accommodate the removal of emacs21. Change the emacs21 dependency + to emacs23 and the emacs21 build dependency to emacs22 or emacs23. + Thanks to Sven Joachim <svenjoac@gmx.de>. (Closes: #478799) + + -- Rob Browning <rlb@defaultvalue.org> Sat, 01 Aug 2009 12:16:02 -0700 + +bbdb (2.35.cvs20060204-1.1) unstable; urgency=low + + * NMU with the permission of the maintainer. + * Set coding system when writing .bbdb file to prevent data corruption. + (Closes: #351778) + + -- Hubert Chan <hubert@uhoreg.ca> Thu, 13 Apr 2006 15:42:40 +0200 + +bbdb (2.35.cvs20060204-1) unstable; urgency=low + + * New CVS co + - Bug fix: "bbdb-news-auto-create-p with 'prompt doesn't work" (Closes: #296577). + * Bug fix: "bbdb: File error: "Cannot open load file", + 'bbdb-autoloads'" (Closes: #344032, #345186, #345297, #350449, #308336, #279920). + * Bug fix: "bbdb does not work with gnus-5.10", (works for me [TM]) (Closes: #192904). + + -- Joerg Jaspert <joerg@debian.org> Sat, 4 Feb 2006 16:32:31 +0100 + +bbdb (2.35.cvs20040528-1) unstable; urgency=low + + * CVS co - last changes there are from 28.05.2004 + * Bug fix: "fails to load : missing bbdb-vm.el". (Closes: #179821, #180024, #210248, #233904). + * Removed | emacs20 from Depends. (Closes: #232731) + * Removed old w3-el-e{20|19} Suggests. + * Bug fix: "bbdb: Include /usr/share/emacs/site-lisp/bbdb/tex/", thanks + to Mario Lang (Closes: #243211). + + -- Joerg Jaspert <joerg@debian.org> Wed, 11 Aug 2004 23:12:05 +0200 + +bbdb (2.35.cvs20030801-1) unstable; urgency=low + + * CVS from 01 August 2003. + + -- Joerg Jaspert <joerg@debian.org> Sun, 24 Aug 2003 14:51:51 +0200 + +bbdb (2.34.cvs20030503-1) unstable; urgency=low + + * CVS from 03 Mai 2003. + * Removed a suggestion about charsets in .bbdb. It should work without + that (closes: #177625) + + -- Joerg Jaspert <joerg@debian.org> Sat, 3 May 2003 20:16:15 +0200 + +bbdb (2.34.cvs20030102-1) unstable; urgency=low + + * CVS checkout from 02 Januar 2003. + * A note in README.Debian about charsets and .bbdb. + (closes: #174006,173817) + * This patch for encoding issues is included upstream (closes: #159339) + * Standards 3.5.8 + + -- Joerg Jaspert <joerg@debian.org> Sun, 5 Jan 2003 15:38:42 +0100 + +bbdb (2.34.cvs20021102-1) unstable; urgency=low + + * Newest CVS Checkout. Well, new.... + + -- Joerg Jaspert <joerg@debian.org> Wed, 13 Nov 2002 21:02:25 +0100 + +bbdb (2.34.cvs20021027-1) unstable; urgency=low + + * Newest CVS checkout. This is really 2.35 :) + * Standards-Version: 3.5.7 + * Removed mk-binary from debian/ dir, it is not used. + + -- Joerg Jaspert <joerg@debian.org> Sun, 27 Oct 2002 16:09:56 +0100 + +bbdb (2.34.cvs20020819-1) unstable; urgency=low + + * Newest CVS checkout. + + -- Joerg Jaspert <joerg@debian.org> Tue, 20 Aug 2002 22:20:26 +0200 + +bbdb (2.34.cvs20020703-1) unstable; urgency=low + + * Newest cvs checkout. + * (require 'bbdb-autloads) in startup file (closes: #152435) + + -- Joerg Jaspert <joerg@debian.org> Wed, 10 Jul 2002 12:03:34 +0200 + +bbdb (2.34.cvs20020418-3) unstable; urgency=low + + * Added bbdb-pilot-jwz.el as suggested in (closes: #144465) + I dont have a handheld, so i cant test it. (Hint :) ) + + -- Joerg Jaspert <joerg@debian.org> Fri, 26 Apr 2002 00:13:03 +0200 + +bbdb (2.34.cvs20020418-2) unstable; urgency=high + + * Urgency=high because the Bugfix for #143463 should really go into + woody. I have not made any other changes in the emacsen-install files, + and there are no Bug Reports since my last Upload, so i think this is OK. + * I now generate some html Pages from the texinfo Source and install the + doc-base things. So you can read the bbdb documentation from your + Webbrowser if you want that. + + -- Joerg Jaspert <joerg@debian.org> Sun, 21 Apr 2002 20:02:31 +0200 + +bbdb (2.34.cvs20020418-1) unstable; urgency=low + + * New Upstream release. This fixes bbdb-gui which (closes: #143463) + * Changed my Email Address. + + -- Joerg Jaspert <joerg@debian.org> Thu, 18 Apr 2002 20:53:56 +0200 + +bbdb (2.34.cvs20020404-2) unstable; urgency=low + + * Changed emacsen-install: + Hide make autoloads output for the user and redirect it to the Compile-Log + Tell the User that the Byte-Compile of bbdb could be a long-running process. + + -- Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net> Mon, 8 Apr 2002 15:42:46 +0200 + +bbdb (2.34.cvs20020404-1) unstable; urgency=low + + * If a Variable in Makefile changes between two releases it is very + helpful to change it in the calling installscript too. Thx to + James LewisMoss for this. This (closes: #141207) + * New CVS checkout. bbdb-merge.el changed. + * I now package the bits/ subdir with bbdb. It is *not* official part + of bbdb. So i only make a .tar.gz of it and place it into + /usr/share/doc/bbdb. Have a look at it and see if you find some + things useful. If there is enough demand for one thing i can install it with + bbdb (if License is clear). + + -- Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net> Thu, 4 Apr 2002 23:48:32 +0200 + +bbdb (2.34.cvs20020330-4) unstable; urgency=low + + * Im so stupid blind. bbdb needs bbdb-autoloads.el. I must generate it before i compile + the package at install-time. If not we have a not existing bbdb-autoloads.el so bbdb + cant load anything and crashes. Argh, i hate me. I shold read INSTALL full. Next time... + I now generate bbdb-autoloads.el and bbdb works again. Sorry for this stupidity. + It (closes: #140968) + + -- Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net> Wed, 3 Apr 2002 19:45:36 +0200 + +bbdb (2.34.cvs20020330-3) unstable; urgency=low + + * Hmm, i should look if I really remove all installed files between my tests. I left some + crap and all worked fine. So i cant see that Makefile.in is neccessary. + Added it again. + * Apply a patch to the Makefile in /usr/share/emacs/site-lisp which really should remove + checking for configure.ac. This two should (closes: #140868) + + -- Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net> Tue, 2 Apr 2002 12:38:53 +0200 + +bbdb (2.34.cvs20020330-2) unstable; urgency=low + + * It now works to look at the bbdb info files with emacs, so this + should (closes: #111769) + * It should also (closes: #139287) + * Argh. If i want to install the info files without dh_installinfo i + have to copy them to the Packagedir. + * Suggest tetex-base. + * Install the .tex files for bbdb-print in /usr/share/texmf/tex/bbdb so + one can use bbdb-print without any extra work required. This two + changes are for this: (closes: #101282) + * -1 was not uploaded. So i just close the bug here again. + New Maintainer. (closes: #140041) + * gzip -9 for Readme.Debain + * Remove unneccessary Makefile.in from bbdb/lisp dir. + + -- Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net> Mon, 1 Apr 2002 13:44:19 +0200 + +bbdb (2.34.cvs20020330-1) unstable; urgency=low + + * New Maintainer. (closes: #140041) + * My first Emacs-addon Package. Hope it works. + * New Version. Used CVS from 30 March 2002 + * Added w3-el-e21 to Suggests. + * Changed URL in debian/copyright to point to right Site. + * Changed Path for License to /usr/share/common-license + * Disabled dh_installinfo in debian/rules. We do it manually so we dont need + to double it. + * Dont install Upstream README. Its just four words: Read the INSTALL file. We + dont need this for a Debian Package. :) + * Remove Files generated by configure or build-process which are not removed by + Upstream Makefiles clean target. + * Changed Depends to emacs21 | emacsen to make Lintian happy. + * Wrote manpages for the 4 Perlskripts. Better than a link to dh_undocumented. + * Use sed to change the Target all in the Makefiles so emacs-install could work. + We dont want to check for configure there so we dont check for it. :) + + -- Joerg Jaspert (JJ) <joerg@goliathbbs.dnsalias.net> Sun, 31 Mar 2002 20:15:42 +0200 + +bbdb (2.32-2) unstable; urgency=low + + * don't install FLAVOR/etc/bbdb (closes: #123612) + tex be isntalled into document directory + utils/*.el be installed into site-lisp/bbdb with byte-compile + utils/*.pl be installed into /usr/bin/ + * install /etc/emacs/site-start.d/50bbdb.el as conffile + * Build-Depends: debhelper (>> 3.0.0) + * Standards-Version: 3.5.2 + * DH_COMPAT=3 + + -- Takuo KITAME <kitame@northeye.org> Thu, 13 Dec 2001 00:45:23 +0900 + +bbdb (2.32-1) unstable; urgency=low + + * New upstream release + * fixed bashizm of emacsen-install (closes: Bug#98574) + * remove (require 'message) from init.el (closes: Bug#109062) + + -- Takuo KITAME <kitame@northeye.org> Sat, 25 Aug 2001 11:23:09 +0900 + +bbdb (2.3-2) unstable; urgency=low + + * debian/emacsen-install: insert (provide 'bbdb-autoloads) if not xemacs20 or xemacs21. (closes: Bug#88471) + + -- Takuo KITAME <kitame@northeye.org> Mon, 5 Mar 2001 00:24:20 +0900 + +bbdb (2.3-1) unstable; urgency=low + + * New upstream release + * some upstream bug ware fixed (closes: Bug#86816,Bug#83920,Bug#83601) + * fix #85283: bbdb doesn't load bbdb-autoload (closes: Bug#85283) + * fix #82338: bbdb: upgrade leaves files behind (closes: Bug#82338) + * fix #85019: bbdb complains about nonexistent directory (closes: Bug#85019) + * fix #78721: calls switch-to-buffer(-1) on exit, xemacs doesn't like this (closes: Bug#78721) + + -- Takuo KITAME <kitame@northeye.org> Sun, 4 Mar 2001 02:51:34 +0900 + +bbdb (2.2-1) unstable; urgency=low + + * New upstream release + * cloese: #82338: bbdb: upgrade leaves files behind + * closes: #81653: bbdb-complete-name fails, + * closes: #78564: bbdb breaks gnus + * closes: #80838: bbdb: perl scripts broken + + -- Takuo KITAME <kitame@northeye.org> Fri, 26 Jan 2001 11:57:09 +0900 + +bbdb (2.00.06.20001116cvs-1) unstable; urgency=low + + * New upstream release + + -- Takuo KITAME <kitame@northeye.org> Wed, 29 Nov 2000 08:22:33 +0900 + +bbdb (2.00.06.20001015cvs-3) unstable; urgency=low + + * Support xemacs21 (clsoes: Bug#76254) + + -- Takuo KITAME <kitame@northeye.org> Mon, 13 Nov 2000 10:21:54 +0900 + +bbdb (2.00.06.20001015cvs-2) unstable; urgency=low + + * install info + * debian/bbdb-init.el: + (require 'bbdb) + (bbdb-initialize) + * lisp/bbdb.el: at defun bbdb-insinuate-message, + (if (not (boundp 'message-mode-map)) + (require 'message)) + (closes: Bug#74998) + + -- Takuo KITAME <kitame@northeye.org> Wed, 18 Oct 2000 11:04:30 +0900 + +bbdb (2.00.06.20001015cvs-1) unstable; urgency=low + + * New upstream release (CVS snapshot) + * closes: Bug#72315 bbdb 2.00 is known not to work with Emacs 20. + * debian/control: Suggests: w3-el-e20|w3-el-e19 instead of w3-el. + (closes: Bug#74194) + * put perl script. (closes: Bug#72481) + * from lisp/bbdb-hooks.el, + ;; Revision 1.58 2000/04/05 17:09:06 bbdb-writer + ;; * Autoload cookie for bbdb-header-start + It seems Bug#69182 was fixed. (closes: Bug#69182) + * (setq bbdb-electric-p t) is worked. I think it was fixed by Upstream. + (closes: Bug#52453) + * applied view-mode -1 patch. (closes: Bug#48805) + + -- Takuo KITAME <kitame@northeye.org> Tue, 17 Oct 2000 16:06:12 +0900 + +bbdb (2.00.06-1) unstable; urgency=low + + * New upstream release (closes: Bug#48316, Bug#19262) + * Work well on XEmacs (closes: Bug#12086) + * removing usr/share/xemacs20/etc/bbdb when package remove. + It was fixed in previous release. (closes: Bug#52527) + * install.log will be created as mode 644. (closes: Bug#55433) + + -- Takuo KITAME <kitame@northeye.org> Wed, 29 Mar 2000 03:09:33 +0900 + +bbdb (2.00-6) frozen unstable; urgency=high + + * Maintainer was changed. + * Fixed install script for bbdb-gnus.el (closes: Bug#59177) + + -- Takuo KITAME <kitame@northeye.org> Tue, 28 Mar 2000 13:30:34 +0900 + +bbdb (2.00-5) unstable frozen; urgency=high + + * ignore xemacs21 in the install stage. Closes: Bug#55432. + + -- Frederic Lepied <Lepied@debian.org> Thu, 24 Feb 2000 09:36:47 +0100 + +bbdb (2.00-4) unstable; urgency=low + + * applied documentation fixes from <jrv@vanzandt.mv.com>. Closes: Bug#36225. + * (bbdb-print.el): corrected invalid condition-case. Closes: Bug#36846, Bug#44355, Bug#44364. + * removed itimer Suggests:. + * really install README.debian. Closes: Bug#26687. + * (bbdb-print.el): hard code the location of TeX files. CLoses: Bug#36844. + * (bbdb-print.tex): applied patch from Mattia Monga to correct the + size of tt fonts. Closes: Bug#41268. + * avoid aborting the install when a file failed to compile. Closes: Bug#37373, Bug#40379. + + -- Frederic Lepied <Lepied@debian.org> Tue, 14 Sep 1999 21:57:24 +0200 + +bbdb (2.00-3) frozen unstable; urgency=low + + * (install): added vm target for xemacs19 and xemacs20. Fixes Bug#21940. + * (install): corrected echo placement. Fixes Bug#21496. + * (install): suppressed duplicate. Fixes Bug#21497. + * (README.debian): new file to explain how to initialize bbdb. Fixes Bug#21497. + + -- Frederic Lepied <Lepied@debian.org> Mon, 4 May 1998 05:56:21 +0200 + +bbdb (2.00-2) frozen unstable; urgency=low + + * (control): added a dependency on make. + * (control): priority optional. + * (control): suggests vm, w3-el, gnuserv and itimer. + * (install): byte compile with -no-site-file. + + -- Frederic Lepied <Lepied@debian.org> Sun, 19 Apr 1998 08:11:15 +0200 + +bbdb (2.00-1) unstable; urgency=low + + * new upstream version. + + -- Frederic Lepied <Lepied@Debian.org> Wed, 18 Mar 1998 21:45:28 +0100 + +bbdb (1.55unoff-1.1) unstable; urgency=low + + * Non-maintainer release. + + * Updated for new emacsen requirements. + + * Removed empty README.Debian file. + + * Removed debmake dependencies--made it easier to fix everything else. + + * Updated to standards 2.4.0.0. + + -- Ben Pfaff <pfaffben@pilot.msu.edu> Thu, 5 Mar 1998 11:48:24 -0500 + +bbdb (1.55unoff-1) unstable; urgency=low + + * upstream release. + * removed gnus-bbdb.el for lack of copyright and integration into + upstream bbdb-gnus. + + -- Frederic Lepied <Lepied@debian.org> Sun, 26 Oct 1997 11:34:06 +0100 + +bbdb (1.54unoff-1) unstable; urgency=low + + * new maintainer. + * new upstream release. + * Added the missing P binding for bbdb-print in bbdb.el. + * Added gnus-bbdb.el to work with newer version of gnus. + + -- Frederic Lepied <Lepied@debian.org> Fri, 17 Oct 1997 22:54:11 +0200 + + diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..7f8f011 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +7 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..0d2dfe1 --- /dev/null +++ b/debian/control @@ -0,0 +1,22 @@ +Source: bbdb +Section: mail +Priority: optional +Maintainer: Joerg Jaspert <joerg@debian.org> +Uploaders: Barak A. Pearlmutter <bap@debian.org> +Build-Depends: debhelper (>= 7.2.5) +Build-Depends-Indep: texinfo, texi2html, ghostscript, + texlive-base, texlive-latex-base, + emacs23-nox | emacs23 | emacs +Standards-Version: 3.8.4 +Vcs-Git: git://github.com/barak/BBDB.git +Vcs-Browser: http://github.com/barak/BBDB +Homepage: http://bbdb.sourceforge.net/ + +Package: bbdb +Architecture: all +Depends: make, emacs23 | emacsen, ${misc:Depends}, ${perl:Depends} +Suggests: vm, w3m-el, gnuserv, gnus|t-gnus, perl +Description: The Insidious Big Brother Database (email rolodex) for Emacs + BBDB is a rolodex-like database program for GNU Emacs. BBDB stands + for Insidious Big Brother Database, and is not, repeat, *not* an + obscure reference to the Buck Rogers TV series. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..031940c --- /dev/null +++ b/debian/copyright @@ -0,0 +1,70 @@ +This package was debianized by Frederic Lepied <Lepied@debian.org> on +Mon, 17 Oct 1997 23:09:25 +0200. + +Actual Maintainer: Joerg Jaspert <joerg@debian.org> + +It was downloaded from http://bbdb.sourceforge.net/ + +Authors: Jamie Zawinski, Ronan Waide (Waider), Todd Kaufmann, + Boris Goldowsky, Christopher Kline, John Heidemann, + Roland McGrath + +Current Upstream: Ronan Waide + +Copyright: + +Copyright subsets of 1991-2001, subsets of Jamie Zawinski, Ronan Waide (Waider), + Todd Kaufmann, Boris Goldowsky, Christopher Kline, John Heidemann, + Roland McGrath + lisp/* + texinfo/* + tex/* + utils/* + +Copyright (c) 1997-1999 Matt Simmons <simmonmt@@acm.org> + texinfo/bbdb.texinfo + +Copyright (c) 2000 Alex Schroeder + misc/bbdb-unmigrate-stuff.el + +Copyright 1995 Neda Communications, Inc. + bits/bbdb-filters/doc/main.texinfo + bits/bbdb-filters/bbdb-filters-0.2.sh + +Copyright (C) 1998 Ivar Rummelhoff + bits/bbdb-anniv.el + +Copyright (C) 1999, 2000, 2001 Shenghuo ZHU + bits/bbdb-edit.el + +Copyright (C) 1998,2000 by Niels Elgaard Larsen <elgaard@diku.dk> + bits/bbdb-ldif.el + +Copyright (C) 2001 Colin Rafferty + bits/bbdb-obsolete.el + +Copyright (C) 1997,1999 Kevin Davidson + bits/bbdb-pgp.el + bits/bbdb-signature.el + +Copyright (C) 1997 Kevin Davidson +Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc + bits/bbdb-signature.el + +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, +;;; MA 02110-1301, USA. + +On Debian systems, the complete text of the GNU General Public License +version 2 can be found in /usr/share/common-licenses/GPL-2 file. diff --git a/debian/patches/Makefile.patch b/debian/patches/Makefile.patch new file mode 100644 index 0000000..820fb8a --- /dev/null +++ b/debian/patches/Makefile.patch @@ -0,0 +1,22 @@ +--- Makefile.orig 2009-11-17 16:13:19.000000000 -0500 ++++ Makefile 2009-11-17 16:16:25.000000000 -0500 +@@ -16,18 +16,7 @@ + aclocal.m4 configure configure.ac install-sh Makefile.in \ + bits lisp misc tex texinfo utils + +-all: Makefile bbdb info gnus +- +-Makefile:: Makefile.in +- ./config.status +- +-Makefile:: configure +- @echo "Configure has changed, you may need to rerun configure!" +- exit 1 +- +-configure: configure.ac +- @echo "configure.ac has changed. Please rerun autoconf!" +- exit 1 ++all: bbdb info gnus + + bbdb: + cd lisp; $(MAKE) bbdb diff --git a/debian/patches/lisp/Makefile.patch b/debian/patches/lisp/Makefile.patch new file mode 100644 index 0000000..f27ff91 --- /dev/null +++ b/debian/patches/lisp/Makefile.patch @@ -0,0 +1,14 @@ +*** lisp/Makefile 2009-11-21 19:43:53.000000000 -0500 +--- debian/bbdb/usr/share/emacs/site-lisp/bbdb/lisp/Makefile 2009-11-21 20:27:35.000000000 -0500 +*************** +*** 56,64 **** + + all: Makefile gnus bbdb autoloadsc + +- Makefile: Makefile.in +- cd ..; ./config.status +- + install-pkg: uninstall-pkg bbdb autoloadsc + @if test "x$(SYMLINKS)" = "xno" ; then \ + mkdir -p -m 0755 $(PACKAGEDIR)/lisp/bbdb; \ +--- 56,61 ---- diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..3b01ba4 --- /dev/null +++ b/debian/rules @@ -0,0 +1,32 @@ +#!/usr/bin/make -f + +build clean install binary-arch binary-indep binary: + dh $@ + +.PHONY: build clean install binary-arch binary-indep binary + +override_dh_auto_configure: + if [ ! -x configure ]; then chmod +x configure; fi # debian.diff fails to +x + dh_auto_configure + +override_dh_auto_build: bits.tar.gz + $(MAKE) -C texinfo bbdb.info bbdb.pdf + texi2html --split=chapter --output=texinfo/bbdb texinfo/bbdb.texinfo + +override_dh_install: + dh_install + @echo Give perl executables to implementation-agnostic filenames + cd debian/bbdb/usr/bin && \ + for f in *.pl; do \ + mv $$f $$(basename $$f .pl); \ + done + @echo Apply Debian patches + for f in $$(find debian/patches -name '*.patch'); do \ + echo applying patch: $$f ; \ + d=debian/bbdb/usr/share/emacs/site-lisp/bbdb ; \ + patch $$d/$$(echo $$f | sed 's|^debian/patches/\(.*\)[.]patch$$|\1|') $$f; \ + done + +bits.tar.gz: + tar -cf - extern/*/* | tar -C bits -xvf - + tar -czf bits.tar.gz bits/ diff --git a/debian/source/format b/debian/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/debian/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/debian/watch b/debian/watch new file mode 100644 index 0000000..b9fa30d --- /dev/null +++ b/debian/watch @@ -0,0 +1,5 @@ +version=3 +http://githubredir.debian.net/github/barak/BBDB \ + /github/barak/BBDB/BBDB\.([0-9].*).tar.gz +http://githubredir.debian.net/github/barak/BBDB \ + /github/barak/BBDB/upstream/(.*).tar.gz diff --git a/html/bbdb.css b/html/bbdb.css new file mode 100644 index 0000000..98b81d3 --- /dev/null +++ b/html/bbdb.css @@ -0,0 +1,3 @@ +body { + background-color: #faebd7; +} diff --git a/html/faq.html b/html/faq.html new file mode 100644 index 0000000..1aceb33 --- /dev/null +++ b/html/faq.html @@ -0,0 +1,337 @@ +<html> + <head> + <title>BBDB FAQ</title> + <link rel="stylesheet" href="bbdb.css" type="text/css"> + </head> + + <body> + <h1>The BBDB FAQ</h1> + + The FAQ is unmaintained, but you probably find an answer to your question + in the mailing list archives. Feel free to mail me any things that should + be on this list. + + <p>This is the BBDB FAQ, $Revision: 1.6 $.</p> + + <dl> + <dt>About BBDB and this document</dt> + <dd> + <dl> + <dt>What is the BBDB?</dt> + <dd>Updated: 21 July 2000<br> + <br> + The BBDB is an addressbook for Emacs[1] users. It integrates + tightly with Emacs-based mail and news readers, and + provides some support for Netscape Mail and News. It is + intended to be as unobtrusive in use as possible.<br> + <br> + The full name of BBDB is "The Insidious Big Brother + Database".<br><br> + <em>[1] In this FAQ, "Emacs" refers to both <a + href="ftp://ftp.gnu.org/pub/gnu/emacs/">GNU Emacs</a> and + <a href="http://www.xemacs.org/">XEmacs</a>.</em><br><br></dd> + + <dt>What is the most current version of the BBDB?</dt> + <dd>Updated: 20 April 2010<br> + <br> + The current version is 2.36. Generally speaking, the + development version is the preferred version.<br><br></dd> + + <dt>Where can I get the most current version of the BBDB?</dt> + <dd>Updated: 21 July 2000<br> + <br> + BBDB is hosted, developed and maintained at <a + href="http://bbdb.sourceforge.net/">http://bbdb.sourceforge.net/</a>. + The current stable and development releases are posted + there.<br><br></dd> + <dd>Updated: 20 April 2010<br> + <br> + But you might want to check out + <a href="http://github.com/barak/BBDB">http://github.com/barak/BBDB</a> + or <tt>git clone git://github.com/barak/BBDB.git</tt> +.<br><br></dd> + + <dt>About the FAQ<dt> + <dd>Updated: 25 February 2001<br> + <br> + This FAQ is currently being constructed from a + backlog of saved email messages from the bbdb-info mailing + list. It is part of the BBDB CVS tree and thus can be + updated by anyone with write access to the + tree. Suggestions for additional questions (and answers!) + can be sent to <a + href="mailto:bbdb-faq@waider.ie">bbdb-faq@waider.ie</a>.<br> + <br> + The FAQ answers assume you have some familiarity with + Emacs. Where configuration variables are mentioned, + there's usually a <tt>customize</tt> interface that allows + you to do point-and-click option setting.<br><br></dd> + </dl> + </dd> + + <dt>Installing the BBDB</dt> + <dd> + <dl> + <dt>How do I install BBDB?</dt> + <dd>Updated: 25 February 2001<br> + <br> + Read the file INSTALL in the distribution<br><br></dd> + + <!-- integrate with VM, Gnus, MH-E, RMail --> + + </dl> + </dd> + + <dt>Configuring the BBDB</dt> + <dd> + <dl> + <dt>BBDB sometimes displays the user's full name along with + some names, and not with others.</dt> + <dd>Updated: 25 February 2001<br> + <br> + Set <tt>bbdb-dwim-net-address-allow-redundancy</tt> to + <tt>t</tt>. This tells BBDB it's okay to add full names to + addresses of the form + <Firstname.Lastname@wherever><br><br></dd> + + <dt>Is there a way to insert literal strings in the phone + number field?</dt> + <dd>Updated: July 28 2001<br> + <br> + Set <tt>bbdb-north-american-phone-numbers-p</tt> to + nil. This tells BBDB to not try parsing numbers, but to + simply accept whatever the user types in.<br><br></dd> + + <dt>How to I get BBDB to not keep changing the name field + for a record?</dt> + <dd>Updated: August 20 2005<br> + Probably the easiest way to do this is to use + <tt>bbdb-ignore-some-messages-alist</tt>; see the + documentation on this for more details. You'll also need + to set <tt>bbdb/{mail,news}-auto-create-p</tt> to + <tt>bbdb-ignore-some-messages-hook</tt>, or invoke the + latter from whatever your <tt>auto-create-p</tt> + variables currently point at.</dd> + + <!-- I guess this question came off the mailing list. It should be + reformatted & answered. + + "One question I ask me since begin: How can I insert new fields (say + for signatures or v-card's) and how the hooks to set/get those new + fields? Now, is this a FAQ?" + + Answer: bbdb-notice-hook, bbdb-auto-notes-hook + --> + <dt>How do I make BBDB do something not covered in the FAQ??</dt> + <dd>Updated: 20 August 2005<br> + <br> + Read The Fine Manual, and then if you're still unsure ask + on the bbdb-info list.<br><br></dd> + </dl> + </dd> + + <dt>Using BBDB</dt> + <dd> + <dl> + <dt>How do I get BBDB to fill out an email address for + me?</dt> + <dd>Updated: 28 June 2001<Br> + <br> + Type as much of the address as you feel necessary, then + hit <tt>M-TAB</tt> to get BBDB to attempt to complete what + you've typed. If it finds several matches, you can loop + through them by repeatedly pressing <tt>M-TAB</tt>; you can + also select from a completion-buffer of + choices.<br><Br></dd> <!-- this isn't strictly true; check + config --> + + <dt>I have 42 records for Douglas Adams. How do I delete the + duplicates?</dt> + <dd>Updated: 20 August 2005<br> + <br> + <tt>M-x bbdb-show-duplicates</tt>, and delete or merge the + ones you don't want.<br><br></dd> + + <dt>Every time I modifiy bbdb mail-alias fields, I need to + quit and restart before <a + href="http://www.gnus.org/">Gnus</a> sees the changes!</dt> + <dd>Updated: 28 June 2001<br> + <br> + (Thanks to John Hunter)<br> + <tt>(add-hook 'message-setup-hook 'bbdb-define-all-aliases)</tt> + <Br><br></dd> + </dl> + </dd> + + <dt>Troubleshooting</dt> + <dd> + <dl> + <dt>How do I submit a bug report?</dt> + <dd>Updated: 20 August 2005<br> + Use <tt>bbdb-submit-bug-report</tt>. This extracts + version information and settings from your running copy + of BBDB and prepares an email message including + them. The default address for this mail is the bbdb-info + list, so that all developers can see it, but if you've + got privacy issues with that then you can send it + directly to me (waider@waider.ie). A few essential + notes:<ul> + <li>Check the mailing list archives to see if your bug + has previously been discussed.</li> + <li>Make sure you've tried out the latest CVS version, + in case your bug has already been solved.</li> + <li>Be as precise as you can. Do <b>not</b> use + wording like "I got an error message about some + file"; include the exact text of the error message + and the filename it referred to.</li> + <li>If you can, try and provide a minimal <tt>.bbdb</tt> + file that illustrates the problem. There is apparently + an ongoing issue with completion not providing all + possible expansions, but since noone has yet provided a + <tt>.bbdb</tt> file that demonstrates the problem, I've + been unable to reproduce it.</li> + </ul> + </dd> + + <!-- this one's actually no longer an issue, I believe --> + <dt>XEmacs is giving me an error about BBDB being already + loaded.</dt> + <dd>Updated: 25 February 2001 (David S. Goldman)<br> + <br> + Add the following before you call (bbdb-initialize): + <pre> + (unload-feature 'bbdb-autoloads t) + </pre> + This is fixed in the developer release, and should be + available in the next stable release.<br><br></dd> + + <dt>I downloaded the developer release from CVS and I can't + build it.</dt> + <dd>Updated: 25 February 2001<br> + <br> + The developer version from CVS does not include the + <tt>configure</tt> script; this should be generated using + <tt>autoconf</tt>. The <tt>configure</tt> script is included + in the nightly tarball, so you can get it there if you + wish. Alternatively, it may be downloaded from the <a + href="http://bbdb.sourceforge.net/">BBDB Web Site</a>.<br> + <br> + The other problem you may have is that you're on a Win32 + system with no support for Makefiles or scripts in + general. Your options are to install the Cygwin environment + (XXX there is a known issue with building under Cygwin XXX) + or to check the mailing list archives for a recent + <tt>make.bat</tt> file. The latter will probably migrate to + the BBDB bits section of CVS once the author has nailed it + down to his satisfaction.<br><br></dd> + <!-- also Alex's stub Makefile for bbdb-autoloads --> + </dl> + </dd> + + <dt>Talking to the world outside Emacs</dt> + <dd> + <dl> + <dt>BBDB with Gnus is asking me if I want to update + <non-ASCII-name> to <non-ASCII-name<</dt> + <dd>Updated: 20 August 2005<br> + <br> + This should be (mostly) solved in CVS. If you encounter + this, please submit a bug report. + <br><br></dd> + + <!-- bbdb-whois, bbdb-ftp, + bbdb-talk-to-great-deities-seeking-enlightenment --> + <dt>How do I get BBDB and supercite to play together?</dt> + <dd>Updated: 28 June 2001<br> + <br> + (Thanks to Kevin Davidson, quoted here) + <pre> + Take a look at bbdb-sc.el that comes with BBDB. + + I found I also needed to patch supercite.el (up to at least version + 3.1 as supplied with Xemacs 20.3) otherwise it stops using your + sc-preferred-attribution-list and starts using a broken default one. + + Patch here: + +*** supercite.el Wed May 6 10:45:12 1998 +--- supercite.el.orig Wed May 6 10:43:11 1998 +*************** +*** 1250,1259 **** + (setq attribution attrib + attriblist nil)) + ((listp attrib) +! (setq attribution (eval attrib)) +! (if attribution +! (setq attriblist nil) +! (setq attriblist (cdr attriblist)))) + (t (error "%s did not evaluate to a string or list!" + "sc-attrib-selection-list")) + ))) +--- 1250,1257 ---- + (setq attribution attrib + attriblist nil)) + ((listp attrib) +! (setq attribution (eval attrib) +! attriblist nil)) + (t (error "%s did not evaluate to a string or list!" + "sc-attrib-selection-list")) + ))) + </pre><br><br> + You might also need the following, from Sergei Pokrovsky: +<pre> + '(sc-citation-nonnested-root-regexp "\\([-._]\\|\\w\\)+") + '(sc-citation-root-regexp "\\([-._]\\|\\w\\)*") +</pre> + <br><br></dd> + + <dt>How do I get my Pilot/Addressbook/Phone/Widget to sync + with BBDB?</dt> + <dd>Updated: 28 June 2001<br> + <br> + Run screaming, waving hands in air.<br><br> + Still here? Okay. This is a problem complicated by some + basic differences in the respective tools' approach to + addressbooks, <a + href="http://www.mail-archive.com/bbdb-info%40xemacs.org/msg00571.html">neatly + summarised in a message from Jamie + Zawinski</a>. The solutions to date are at least three + different <tt>bbdb-pilot.el</tt> files, <a + href="http://home.rochester.rr.com/tsdeweese/SyncBBDB.html">SyncBBDB</a> + and <a href="http://www.valente.de/aldo/palm/">SyncAB + + BBDB</a>. The latter two are quite good, although + personally I don't use anything to keep my bits in sync at + present.</dd> + </dl> + </dd> + + <dt>Miscellany</dt> + <dd> + <dl> + <dt>Credits</dt> + <dd>Updated: 25 February 2001<br> + <br> + The BBDB was originally created by <a + href="http://www.jwz.org/">Jamie Zawinski</a>. The + cast of characters involved since then is listed in the + BBDB documentation. The current maintainer is <a + href="http://www.waider.ie/">Waider</a>, assisted by + whoever's got write access on the <a + href="http://www.sourceforge.net/projects/bbdb/">SourceForge + tree</a> and a supporting cast on the bbdb-info mailing + list.<br><br></dd> + </dl> + </dd> + </dl> + + <!-- to add: (other than per-section notes) + LINKS! + Mailing List + Developer FAQs - making contributions, etc. + --> + + <hr> + <address>bbdb-faq@waider.ie</address> + $Date: 2007/01/30 22:05:41 $ + </body> +</html> diff --git a/html/images/bbi.gif b/html/images/bbi.gif Binary files differnew file mode 100644 index 0000000..afc503e --- /dev/null +++ b/html/images/bbi.gif diff --git a/html/images/headleft.gif b/html/images/headleft.gif Binary files differnew file mode 100644 index 0000000..bd44bf4 --- /dev/null +++ b/html/images/headleft.gif diff --git a/html/images/headright.gif b/html/images/headright.gif Binary files differnew file mode 100644 index 0000000..ee42108 --- /dev/null +++ b/html/images/headright.gif diff --git a/html/index.html b/html/index.html new file mode 100644 index 0000000..2ba4498 --- /dev/null +++ b/html/index.html @@ -0,0 +1,275 @@ +<!doctype html public "-//W3C//DTD HTML 3.2//EN"> +<html> +<head> +<title>The Insidious Big Brother DataBase @ SourceForge</title> +<link rel="stylesheet" href="bbdb.css"> +</head> + +<body> + +<h1 align="center" +><img src="images/headright.gif" alt="head" width="50" height="25"> +The Insidious Big Brother Database +<img src="images/headleft.gif" alt="head" width="50" height="25"></h1> + +<p align="center">Quicklinks: + <a href="#get">get the bbdb</a> +| <a href="#lists">mailing lists</a> +| <a href="#links">links</a> +| <a href="#manual">manual</a> +| <a href="faq.html">FAQ</a> +| <a href="http://sourceforge.net/projects/bbdb/">project home</a> +| <a href="http://freshmeat.net/projects/bbdb/">freshmeat entry</a> +</p> + +<h2>What is The Insidious Big Brother Database?</h2> + +<p>The Insidious Big Brother Database (BBDB) is a contact management +utility created by <a href="http://www.jwz.org/">Jamie Zawinski</a> for +use with <a href="http://www.gnu.org/emacs">Emacs</a>. For many years it was +maintained by <a href="http://www.waider.ie/">Waider</a>. Since February 2007 +BBDB is maintained by <a href="http://www.robf.de">Robert Widhopf-Fenk</a>.</p> + +<p>It is tightly +integrated with several mail and news readers (see below), allowing it +to create database entries directly from mail and news messages. As is +usual with applications for Emacs, this record creation can be +configured in many ways, ranging from a boolean create/don't create +setting to creation based on the result of a user-supplied function.</p> + +<p>Database records can be used to store many types of +information, from name and address to URLs and X-Face images. +This information can be displayed when a message from an entity +named in a database record is recieved. In addition, messages +from database members can be tagged in the Gnus Summary Buffer, +and Gnus scoring can be configured based on the contents of +database records. Supercite citations can even be preset +through the use of records in the BBDB.</p> + +<h2>Requirements:</h2> + +<h3>Supported versions of Emacs</h3> + +Starting with 2.35 there is no active support for Emacsens < 21.4! +<dl> + <dt><strong><a href="http://www.gnu.org/">Gnu</a> + <a href="http://www.gnu.org/software/emacs/emacs.html">Emacs</a></strong> + <dd>versions 21.4 and above</dd> + <dt><strong><a href="http://www.xemacs.org/">XEmacs</a></strong> + <dd>versions 21.4 and above</dd> +</dl> + +<h3>Supported Mail and News readers</h3> + +<p>The BBDB can be used without a mail- or news-reader. It has, +however, been optimized for use with one.</p> +<ul> + <li><a href="http://www.gnus.org/">Gnus</a></li> + <li><a href="http://www.wonderworks.com/vm/">VM</a></li> + <li>MH-e</li> + <li>Rmail</li> + <li>UNIX <a href="http://www.netscape.com/">Netscape</a> Mail + (via bbdb-srv)</li> + <li>UNIX <a href="http://www.netscape.com/">Netscape</a> News + (via bbdb-srv)</li> +</ul> + +<h2><a name="get">Getting the BBDB</a></h2> + +<p><a href="bbdb-2.35.tar.gz">BBDB 2.35</a> is the current +stable released version, released on January 30, 2007.</p> + +<p>The current version, 2.36, is tagged on the git repository + git://github.com/barak/BBDB.git which also holds the development + version. At least, those doing development there think so. + </p> + +<h3>Compilation notes:</h3> + +<ol> + <li>BBDB uses autoconf to generate its Makefiles, so it should work + anywhere that autoconf works. The tarballed version comes with + prebuilt configure script and Makefiles; the CVS version will + require you to use autoconf to generate the configure + script. If you don't have autoconf, you can get download a <a + href="configure">prebuilt configure script</a>. Please note that + the Makefiles in the tarball are built using the defaults, + i.e. Emacs to compile with and no extra directories + specified.</li> + + <li>Texinfo 3.11 (or later) is required to compile the texinfo + documentation. It is available at <a + href="ftp://ftp.gnu.org/pub/gnu">the GNU FTP + site</a>. Precompiled info files are included in the + tarball. Some work has been done by ShengHuo ZHU to make this + unnecessary.</li> + + <li>Building on platforms without <tt>make</tt> or running BBDB + uncompiled can be assisted by downloading a <a + href="bbdb-autoloads.el">prebuilt bbdb-autoloads.el</a>. A + <tt>make.bat</tt> for Windows platforms is in the works; see the + mailing list archives for more details. +</ol> + +<h2>CVS tree</h2> + +<p>The development and release versions are available via Anon-CVS +to the CVS tree at <code>bbdb.cvs.sourceforge.net</code>. To access the +tree, log in with the following command: + +<pre> +cvs -d :pserver:anonymous@bbdb.cvs.sourceforge.net:/cvsroot/bbdb login +</pre> + +The password is blank; just hit return at the prompt.</p> + +To check out a version of the BBDB, use one of the following commands: + +<pre> +cvs -d :pserver:anonymous@bbdb.cvs.sourceforge.net:/cvsroot/bbdb checkout bbdb +cvs -d :pserver:anonymous@bbdb.cvs.sourceforge.net:/cvsroot/bbdb checkout -r rev bbdb +</pre> + +<p>The first command will check out a copy of the latest version. +Usually this latest version will be a development version, but it may +fetch a release version if the command is executed soon enough after a +release version is made available.</p> + +<p>The second command allows control of the version retrieved, through +the <code>-r rev</code> argument. The <code>rev</code> portion of the +argument should be replaced with a word of the form:</p> + +<center><code>BBDB_</code><var>x</var><code>_</code><var>yy</var></center> + +<p><var>x</var> and <var>yy</var> are components of the version to be +retrieved, as in <var>x</var>.<var>yy</var>. +<strong>Note:</strong> <code>unoff</code> should be appended to the +above word for all versions prior to 2.00.</p> + +To retrieve version 1.90, use the following argument:<br> + +<pre> +-r BBDB_1_90unoff +</pre> + +To retrieve version 2.34, use the following argument:<br> + +<pre> +-r BBDB_2_34 +</pre> + +<h2><a name="manual">Manual</a></h2> + +<p>You may browse <a href="bbdb.html">HTML version of the texinfo +manual that accompanies BBDB</a>, which is generated by <a +href="http://www.mathematik.uni-kl.de/~obachman/Texi2html" +><code>texi2html</code></a>.</p> + +<h2><a name="lists">Mailing Lists</a></h2> + +<p>There are two mailing lists for the BBDB:</p> + +<dl> + <dt><strong>bbdb-info</strong></dt> + <dd>General discussion about the BBDB, both for users and developers. + The archive for mails up to end of April 2000 can be found at + <a + href="http://www.mail-archive.com/bbdb-info%40xemacs.org/">http://www.mail-archive.com/bbdb-info%40xemacs.org/</a>. Since April 2000 mails are archived at + <a + href="http://www.mail-archive.com/bbdb-info%40lists.sourceforge.net/">http://www.mail-archive.com/bbdb-info%40lists.sourceforge.net/</a>. + + <p>SourceForge has built-in archiving which didn't initially + seem to be working, but is apparently okay now. You can find this + linked off the <a + href="http://sourceforge.net/projects/bbdb/">project home</a> on + SourceForge.</p> + + <dt><strong>bbdb-announce</strong></dt> + <dd>Announcements of new BBDB versions. This list is moderated, and + has very low volume.</dd> +</dl> + +To subscribe to either mailing list, send mail to +<var>listname</var><code>-request@lists.sourceforge.net</code> with +<code>subscribe</code> as the body. You will receive a reply +requesting confirmation of your subscription; return the confirmation +as described in the email, and you're on the list. Alternatively you +can visit the list signup page, linked from the <a +href="http://sourceforge.net/projects/bbdb">project page</a>. + +<h2><a name="links">Links</a></h2> + +<p>Several people have been hacking at BBDB and have pages describing +what they're at. Please check which version of BBDB they apply to +before attempting to use them!</p> + +<ul> + <li><a href="http://www.emacswiki.org/cgi-bin/alex/">Alex Schroeder</a> + has done some work on <a + href="http://www.geocities.com/kensanata/bbdb-funcs.html">address + formats and pine/mailrc integration</a>. He's also responsible for + making BBDB handle non-US addresses a lot better.</li> + + <li><a href="http://www.Jochen-Kuepper.de/">Jochen + Küpper</a> has done some work on + <code>bbdb-print</code>, which is now in CVS.</li> + + <li>Thomas DeWeese</a> wrote a <a + href="http://pilotmanager.sourceforge.net/">PilotManager</a> plugin + called SyncBBDB, and also implemented the + multiple-same-name-records support. <a + href="http://syncbbdb2.sourceforge.net/">SyncBBDB</a> is now + maintained by Aaron Kaplan.</li> + + <li><a href="http://www.splode.com/~friedman/">Noah Friedman</a> is + currently maintaining <a href="http://www.jwz.org/">jwz</a>'s <a + href="http://www.splode.com/~friedman/software/emacs-lisp/index.html#bbdb-pilot-jwz">bbdb-pilot.el</a>.</li> + + <li><a href="http://meltin.net/people/martin/">Martin + Schwenke</a> has written some code to export BBDB records to a Nokia + phone via <a href="http://www.gnokii.org/">gnokii</a>. You can find + it at <a href="http://meltin.net/hacks/emacs/">Martin's web + site</a>.</li> + + <li>Broken: <a href="http://www.valente.de/aldo/palm/">Aldo Valente</a> has + done some work on making SyncAB (from PilotManager) work with + BBDB.</li> + + <li>Broken:<a href="http://t2100cdt.kippona.net/linux/emacs/mew/">Chris + Beggy</a> has managed to get BBDB working with Mew, a mailreader + with Japanese language support. There's a bbdb-mew.el on his page + which should probably make it into the official tree at some + point.</li> + + <li>Broken:<a href="http://www.esperi.demon.co.uk/nix/">Nix</a> has some + expiry code for BBDB which allows you to automatically discard old + BBDB records.</li> + + <li><a + href="http://www.inf.tu-dresden.de/~s1010824/data/lbdb2bbdb.tar.gz">lbdb2bdb</a> + is some code by Steffen Liebergeld to migrate lbdb data to bbdb.</li> + + <li><a + href="http://www.neilvandyke.org/bbdb2tbird/">bbdb2tbird</a> + is some code by Neil Van Dyke to migrate BBDB data to the Thunderbird + address book.</li> + + <li>The <code>bits</code> subdirectory in the source tree contains + random bits and pieces that I've collected but not + integrated, including a generic export filter of sorts and PGP and + Outlook integration/interaction. Please note that at least some of + this hasn't been modfied to work with versions later than + 2.00.06.</li> + +</ul> + +<hr> +<address><a href="http://www.robf.de/">Robert Widhopf-Fenk</a> (based on +<a href="http://www.waider.ie/">Waiders</a> and Matt Simmons' BBDB page</a>)</address> + + +<p align="center">Hosted by<br><a href="http://sourceforge.net/"><img +src="http://sourceforge.net/images/sflogo2-steel.png" vspace="0" +border=0 width="143" height="70" alt="sourceforge.net"></a></p> +</body> +</html> diff --git a/html/patches/bbdb-print.patch b/html/patches/bbdb-print.patch new file mode 100644 index 0000000..8bcf89f --- /dev/null +++ b/html/patches/bbdb-print.patch @@ -0,0 +1,27 @@ +--- bbdb-print.el-orig Mon Feb 28 10:42:52 2000 ++++ bbdb-print.el Mon Feb 28 12:39:02 2000 +@@ -489,12 +489,18 @@ + (bbdb-print-if-not-blank(bbdb-address-street1 addr) "\\\\\n") + (bbdb-print-if-not-blank(bbdb-address-street2 addr) "\\\\\n") + (bbdb-print-if-not-blank(bbdb-address-street3 addr) "\\\\\n") +- (bbdb-address-city addr) +- (if (and (not (equal "" (bbdb-address-city addr))) +- (not (equal "" (bbdb-address-state addr)))) +- ", ") +- (bbdb-print-if-not-blank (bbdb-address-state addr) " ") +- (bbdb-address-zip-string addr) ++ (if (or (null (bbdb-address-state addr)) (equal "" (bbdb-address-state addr))) ++ (concat ++ (bbdb-address-zip-string addr) ++ " " ++ (bbdb-address-city addr)) ++ (concat ++ (bbdb-address-city addr) ++ (if (and (not (equal "" (bbdb-address-city addr))) ++ (not (equal "" (bbdb-address-state addr)))) ++ ", ") ++ (bbdb-print-if-not-blank (bbdb-address-state addr) " ") ++ (bbdb-address-zip-string addr))) + "\\\\") + ""))))) + (setq address (cdr address))) diff --git a/html/patches/multi-record.patch b/html/patches/multi-record.patch new file mode 100644 index 0000000..e664ea2 --- /dev/null +++ b/html/patches/multi-record.patch @@ -0,0 +1,1493 @@ +I have split all my diffs into three sets: + +#1 Removed a number of unused variables (cleaned up builds so I + could see real errors). Small changes in a few auxiliary bbdb files. + Very low risk, but very little gain. + +#2 Small patch to bbdb-print.el adds support for abbreviating 'places' + in phone numbers. Fairly low risk, moderate gain. + +#3 Large patch to bbdb-com.el and bbdb.el (small patch to bbdb-gnus.el) + To support 'duplicate' entries in bbdb. This defines a new variable + bbdb-no-duplicates-p, when true bbdb will not allows new duplicate + records to be defined. + + The largest single change is to the completing read support. + The format of the hash table is also changed. + + Moderate risk (I've been using it daily for almost a year now), + significant gain in functionality. + +diff -ur bbdb-2.00.06/lisp/bbdb-gnus.el bbdb-2.01/lisp/bbdb-gnus.el +--- bbdb-2.00.06/lisp/bbdb-gnus.el Tue Sep 28 09:56:40 1999 ++++ bbdb-2.01/lisp/bbdb-gnus.el Tue Sep 28 11:01:14 1999 +@@ -42,8 +42,7 @@ + (or (search-forward "\n\n" nil t) + (error "message unexists")) + (- (point) 2))) +- (let ((from (mail-fetch-field "from")) +- name net) ++ (let ((from (mail-fetch-field "from"))) + (if (or (null from) + (string-match (bbdb-user-mail-names) + (mail-strip-quoted-names from))) +diff -ur bbdb-2.00.06/lisp/bbdb-mhe.el bbdb-2.01/lisp/bbdb-mhe.el +--- bbdb-2.00.06/lisp/bbdb-mhe.el Tue Sep 28 09:56:40 1999 ++++ bbdb-2.01/lisp/bbdb-mhe.el Tue Sep 28 11:01:17 1999 +@@ -71,8 +71,7 @@ + (let ((msg (bbdb/mh-cache-key buffer-file-name))) + (if (eq msg 0) (setq msg nil)) ; 0 could mean trouble; be safe. + (or (bbdb-message-cache-lookup msg nil) ; nil = current-buffer +- (let ((from (bbdb/mh-get-field "^From[ \t]*:")) +- name net) ++ (let ((from (bbdb/mh-get-field "^From[ \t]*:"))) + (if (or (string= "" from) + (string-match (bbdb-user-mail-names) + (mail-strip-quoted-names from))) +diff -ur bbdb-2.00.06/lisp/bbdb-migrate.el bbdb-2.01/lisp/bbdb-migrate.el +--- bbdb-2.00.06/lisp/bbdb-migrate.el Tue Sep 28 09:56:40 1999 ++++ bbdb-2.01/lisp/bbdb-migrate.el Tue Sep 28 11:01:17 1999 +@@ -97,7 +97,7 @@ + (cond + ;; Version 2 -> 3 + ((= (car bbdb-file-format-migration) 2) +- (let (newrecs currec) ++ (let (newrecs) + (while records + (setq newrecs (append newrecs + (list (bbdb-migrate-record +diff -ur bbdb-2.00.06/lisp/bbdb-rmail.el bbdb-2.01/lisp/bbdb-rmail.el +--- bbdb-2.00.06/lisp/bbdb-rmail.el Tue Sep 28 09:56:40 1999 ++++ bbdb-2.01/lisp/bbdb-rmail.el Tue Sep 28 11:01:18 1999 +@@ -51,8 +51,7 @@ + (if rmail-current-message + (or (bbdb-message-cache-lookup rmail-current-message nil) + (save-excursion +- (let ((from (mail-fetch-field "from")) +- name net) ++ (let ((from (mail-fetch-field "from"))) + (if (or (null from) + (string-match (bbdb-user-mail-names) + (mail-strip-quoted-names from))) + +--OqlPABmjKp +Content-Type: text/plain +Content-Description: Add support for 'places' abbreviations (ala palm) +Content-Disposition: inline; + filename="bbdb-print-diffs" +Content-Transfer-Encoding: 7bit + +diff -ur bbdb-2.00.06/lisp/bbdb-print.el bbdb-2.01/lisp/bbdb-print.el +--- bbdb-2.00.06/lisp/bbdb-print.el Tue Sep 28 09:56:40 1999 ++++ bbdb-2.01/lisp/bbdb-print.el Tue Sep 28 11:01:17 1999 +@@ -241,6 +241,11 @@ + which should be a valid regular expression. + - n-phones: maximum number of phone numbers to include. + - n-addresses: maximum number of addresses to include. ++ - place-abbrev: Abbreviation for phone number 'places'. This is a ++ list of pairs the first element is the full string to be matched ++ the second element is the replacement text. This can be used in ++ any of the bbdb-print-*-alist variables. This allows you to ++ expand as well as contract 'place' names. + - include-files: list of TeX files to \\input. If these filenames are not + absolute, the files must be located somewhere that TeX will find them. + - ps-fonts: nonnil means to use them, nil to use standard TeX fonts. +@@ -270,6 +275,8 @@ + (separator . 1) + (n-phones . 2) + (n-addresses . 1) ++ (place-abbrev ("Work" . "W") ++ ("Home" . "H")) + (include-files "bbdb-print-brief" "bbdb-cols")) + "*Extra Options for bbdb-print, brief format. + These supplement or override entries in `bbdb-print-alist'; see description +@@ -403,8 +410,7 @@ + (bbdb-record-phones record))) + (address (and (bbdb-field-shown-p 'address) + (bbdb-record-addresses record))) +- (notes (bbdb-record-raw-notes record)) +- (begin (point))) ++ (notes (bbdb-record-raw-notes record))) + + (if (not (eval bbdb-print-require)) + nil ; lacks required fields +@@ -423,7 +429,10 @@ + (setq name (bbdb-print-tex-quote company) + company nil)) + +- (let ((rightside "") p) ++ ;; Expand Phone numbers if needed... ++ (if n-phones (setq phone (bbdb-print-firstn n-phones phone brief))) ++ ++ (let ((rightside "")) + (cond ((null phone)) + ((eq t pofl) + (setq rightside (bbdb-print-phone-string (car phone)) +@@ -431,7 +440,7 @@ + ((stringp pofl) + (let ((p (bbdb-print-front-if + (function (lambda (ph) +- (string-match pofl (aref ph 0)))) ++ (if ph (string-match pofl (aref ph 0))))) + phone))) + (if p + (setq rightside (bbdb-print-phone-string (car p)) +@@ -443,19 +452,16 @@ + (if company + (insert (format "\\comp{%s}\n" (bbdb-print-tex-quote company)))) + +- ;; Phone numbers +- +- (if n-phones +- (setq phone (bbdb-print-firstn (- n-phones (if pofl 1 0)) +- phone brief))) + (while phone + (if (car phone) +- (let ((place (aref (car phone) 0)) ++ (let ((place (bbdb-print-abbrev-place (aref (car phone) 0) brief)) + (number (bbdb-print-phone-string (car phone)))) + (insert (format "\\phone{%s%s}\n" + (bbdb-print-tex-quote +- (bbdb-print-if-not-blank place ": ")) +- (bbdb-print-tex-quote number)))) ++ (bbdb-print-if-not-blank place ":")) ++ (bbdb-print-tex-quote number) ++ )) ++ ) + (insert (format "\\phone{}\n"))) + (setq phone (cdr phone))) + +@@ -522,6 +528,27 @@ + (setq current-letter first-letter))) + + current-letter) ++ ++(defun bbdb-print-abbrev-place (place &optional brief) ++ "See if there is an abbreviation for PLACE if so return that" ++ ++ (let* ((alist (append (if brief bbdb-print-brief-alist bbdb-print-full-alist) ++ bbdb-print-alist)) ++ (abbrevs (cdr (assoc 'place-abbrev alist))) ++ (ret place) ++ abbrev) ++ (while abbrevs ++ (setq abbrev (car abbrevs)) ++ (if (string-match (car abbrev) place) ++ (setq abbrevs '() ++ ret (cdr abbrev)) ++ (setq abbrevs (cdr abbrevs)) ++ ) ++ ) ++ ret ++ ) ++ ) ++ + + (defun bbdb-print-phone-string (phone) + "Format PHONE-NUMBER as a string, obeying omit-area-code setting. + +--OqlPABmjKp +Content-Type: text/plain +Content-Description: Add support for duplicate records to bbdb. +Content-Disposition: inline; + filename="bbdb-duplicate-diffs" +Content-Transfer-Encoding: 7bit + +diff -ur bbdb-2.00.06/lisp/bbdb-com.el bbdb-2.01/lisp/bbdb-com.el +--- bbdb-2.00.06/lisp/bbdb-com.el Tue Sep 28 09:56:39 1999 ++++ bbdb-2.01/lisp/bbdb-com.el Tue Feb 29 11:20:07 2000 +@@ -201,10 +201,10 @@ + (bbdb-with-db-buffer + bbdb-changed-records)))) + +-(defun bbdb-display (record) ++(defun bbdb-display (records) + "Prompts for and displays a single record (this is faster than searching.)" + (interactive (list (bbdb-completing-read-record "Display record of: "))) +- (bbdb-display-records (list record))) ++ (bbdb-display-records records)) + + (defun bbdb-display-some (function) + "Display records according to FUNCTION. FUNCTION is called with one +@@ -366,9 +366,10 @@ + lastname (nth 1 names)))) + (if (string= firstname "") (setq firstname nil)) + (if (string= lastname "") (setq lastname nil)) +- (if (bbdb-gethash (downcase (if (and firstname lastname) (concat firstname " " lastname) +- (or firstname lastname "")))) +- (error "%s %s is already in the database" (or firstname "") (or lastname ""))))) ++ (if (and bbdb-no-duplicates-p ++ (bbdb-gethash (bbdb-build-name firstname lastname))) ++ (error "%s %s is already in the database" ++ (or firstname "") (or lastname ""))))) + (let ((company (bbdb-read-string "Company: ")) + (net (bbdb-split (bbdb-read-string "Network Address: ") ",")) + (addrs (let (L L-tail str addr) +@@ -456,26 +457,28 @@ + [\"location\" \"phone-number\"] + NOTES is a string, or an alist associating symbols with strings." + (let (firstname lastname aka) +- (while (progn +- (setq name (and name (bbdb-divide-name name))) +- (setq firstname (car name) lastname (nth 1 name)) +- (bbdb-gethash (downcase (if (and firstname lastname) +- (concat firstname " " lastname) +- (or firstname lastname ""))))) ++ (while (and (progn ++ (setq name (and name (bbdb-divide-name name)) ++ firstname (car name) ++ lastname (nth 1 name)) ++ (bbdb-gethash (bbdb-build-name firstname lastname))) ++ bbdb-no-duplicates-p) + (setq name (signal 'error + (list (format "%s %s is already in the database" + (or firstname "") (or lastname "")))))) + (and company (bbdb-check-type company stringp)) + (if (stringp net) + (setq net (bbdb-split net ","))) +- (let ((rest net)) +- (while rest +- (while (bbdb-gethash (downcase (car rest))) +- (setcar rest +- (signal 'error (list (format +- "%s is already in the database" +- (car rest)))))) +- (setq rest (cdr rest)))) ++ (if bbdb-no-duplicates-p ++ (let ((rest net)) ++ (while rest ++ (while (bbdb-gethash (downcase (car rest))) ++ (setcar rest ++ (signal 'error (list (format ++ "%s is already in the database" ++ (car rest)))))) ++ (setq rest (cdr rest)))) ++ ) + (setq addrs + (mapcar + (function (lambda (addr) +@@ -587,7 +590,8 @@ + ;; get to beginning of this record + (beginning-of-line) + (let ((p (point))) +- (while (not (or (eobp) (bobp) (looking-at "^[^ \t\n]"))) ++ ;; ' - ' is the start of a record with no name. ++ (while (not (or (eobp) (bobp) (looking-at "^\\([^ \t\n]\\| - \\)"))) + (forward-line -1)) + (let* ((record (or (bbdb-current-record planning-on-modifying) + (error "unperson"))) +@@ -704,14 +708,17 @@ + (if (stringp contents) + (setq contents (bbdb-split contents ","))) + ;; first detect any conflicts.... +- (let ((nets contents)) +- (while nets +- (let ((old (bbdb-gethash (downcase (car nets))))) +- (if (and old (not (eq old record))) +- (error "net address \"%s\" is used by \"%s\"" +- (car nets) +- (or (bbdb-record-name old) (car (bbdb-record-net old)))))) +- (setq nets (cdr nets)))) ++ (if bbdb-no-duplicates-p ++ (let ((nets contents)) ++ (while nets ++ (let ((old (bbdb-gethash (downcase (car nets))))) ++ (if (and old (not (eq old record))) ++ (error "net address \"%s\" is used by \"%s\"" ++ (car nets) ++ (or (bbdb-record-name old) ++ (car (bbdb-record-net old)))))) ++ (setq nets (cdr nets)))) ++ ) + ;; then store. + (let ((nets contents)) + (while nets +@@ -725,15 +732,17 @@ + (if (stringp contents) + (setq contents (bbdb-split contents ";"))) + ;; first detect any conflicts.... +- (let ((aka contents)) +- (while aka +- (let ((old (bbdb-gethash (downcase (car aka))))) +- (if (and old (not (eq old record))) +- (error "alternate name \"%s\" is used by \"%s\"" +- (car aka) +- (or (bbdb-record-name old) +- (car (bbdb-record-net old)))))) +- (setq aka (cdr aka)))) ++ (if bbdb-no-duplicates-p ++ (let ((aka contents)) ++ (while aka ++ (let ((old (bbdb-gethash (downcase (car aka))))) ++ (if (and old (not (eq old record))) ++ (error "alternate name \"%s\" is used by \"%s\"" ++ (car aka) ++ (or (bbdb-record-name old) ++ (car (bbdb-record-net old)))))) ++ (setq aka (cdr aka)))) ++ ) + ;; then store. + (let ((aka contents)) + (while aka +@@ -832,7 +841,8 @@ + (setq new-name (if (and fn ln) (concat fn " " ln) + (or fn ln)) + old-name (bbdb-record-name bbdb-record)) +- (if (and new-name ++ (if (and bbdb-no-duplicates-p ++ new-name + (not (and old-name (string= (downcase new-name) + (downcase old-name)))) + (bbdb-gethash (downcase new-name))) +@@ -847,8 +857,13 @@ + "")))))) + ;; + ;; delete the old hash entry +- (and (bbdb-record-name bbdb-record) +- (bbdb-remhash (downcase (bbdb-record-name bbdb-record)))) ++ (let ((name (bbdb-record-name bbdb-record)) ++ (company (bbdb-record-company bbdb-record))) ++ (if (> (length name) 0) ++ (bbdb-remhash (downcase name) bbdb-record)) ++ (if (> (length company) 0) ++ (bbdb-remhash (downcase company) bbdb-record)) ++ ) + (bbdb-record-set-namecache bbdb-record nil) + (bbdb-record-set-firstname bbdb-record fn) + (bbdb-record-set-lastname bbdb-record ln) +@@ -906,17 +921,19 @@ + (let ((oldnets (bbdb-record-net bbdb-record)) + (newnets (bbdb-split str ","))) + ;; first check for any conflicts... +- (let ((rest newnets)) +- (while rest +- (let ((old (bbdb-gethash (downcase (car rest))))) +- (if (and old (not (eq old bbdb-record))) +- (error "net address \"%s\" is used by \"%s\"" +- (car rest) (bbdb-record-name old)))) +- (setq rest (cdr rest)))) ++ (if bbdb-no-duplicates-p ++ (let ((rest newnets)) ++ (while rest ++ (let ((old (bbdb-gethash (downcase (car rest))))) ++ (if (and old (not (eq old bbdb-record))) ++ (error "net address \"%s\" is used by \"%s\"" ++ (car rest) (bbdb-record-name old)))) ++ (setq rest (cdr rest)))) ++ ) + ;; then update. + (let ((rest oldnets)) + (while rest +- (bbdb-remhash (downcase (car rest))) ++ (bbdb-remhash (downcase (car rest)) bbdb-record) + (setq rest (cdr rest)))) + (let ((nets newnets)) + (while nets +@@ -934,17 +951,19 @@ + (let ((oldaka (bbdb-record-aka bbdb-record)) + (newaka (bbdb-split str ";"))) + ;; first check for any conflicts... +- (let ((rest newaka)) +- (while rest +- (let ((old (bbdb-gethash (downcase (car rest))))) +- (if (and old (not (eq old bbdb-record))) +- (error "alternate name address \"%s\" is used by \"%s\"" +- (car rest) (bbdb-record-name old)))) +- (setq rest (cdr rest)))) ++ (if bbdb-no-duplicates-p ++ (let ((rest newaka)) ++ (while rest ++ (let ((old (bbdb-gethash (downcase (car rest))))) ++ (if (and old (not (eq old bbdb-record))) ++ (error "alternate name address \"%s\" is used by \"%s\"" ++ (car rest) (bbdb-record-name old)))) ++ (setq rest (cdr rest)))) ++ ) + ;; then update. + (let ((rest oldaka)) + (while rest +- (bbdb-remhash (downcase (car rest))) ++ (bbdb-remhash (downcase (car rest)) bbdb-record) + (setq rest (cdr rest)))) + (let ((aka newaka)) + (while aka +@@ -1115,7 +1134,7 @@ + ((memq type '(net aka)) + (let ((rest (bbdb-record-get-field-internal record type))) + (while rest +- (bbdb-remhash (downcase (car rest))) ++ (bbdb-remhash (downcase (car rest)) record) + (setq rest (cdr rest)))) + (bbdb-record-store-field-internal record type nil)) + ((eq type 'property) +@@ -1276,6 +1295,140 @@ + string1 + string2)) + ++(defun bbdb-merge-lists! (l1 l2 cmp &optional mod) ++ "Merge two lists l1 l2 (modifies l1) only adds elements from l2 ++if cmp returns false for all elements of l1. If optional mod ++is provided it is applied to each element of l1 and l2 prior to cmp" ++ (if (null l1) ++ l2 ++ (let ((end (last l1)) ++ (src2 l2) ++ (chk (if mod (mapcar mod l1) (append l1 '())))) ++ (while src2 ++ (let ((fail '()) ++ (src1 chk) ++ (val (if mod (apply mod (car src2) '()) (car src2)))) ++ (while src1 ++ (if (apply cmp (car src1) val '()) ++ (setq src1 '() ++ fail 't) ++ (setq src1 (cdr src1)))) ++ (if fail '() ++ (setcdr end (cons (car src2) '())) ++ (setq end (cdr end))) ++ (setq src2 (cdr src2)))) ++ l1))) ++ ++(defun bbdb-merge-records (old-record new-record) ++"Merge the contents of old-record into new-record, old-record ++remains unchanged. For name and company it queries about which to use ++if they differ. All other fields are concatinated. Idealy this would ++be better about checking for duplicate entires in other fields, as ++well as possibly querying about differing values. ++ ++This function does nothing to ensure the integrity of the rest of the ++database, that is somebody elses problem (something like ++bbdb-refile-record)." ++ ++ (if (or (null new-record) (eq old-record new-record)) ++ (error "those are the same")) ++ (let ((new-name (bbdb-record-name new-record)) ++ (new-co (bbdb-record-company new-record)) ++ (old-name (bbdb-record-name old-record)) ++ (old-co (bbdb-record-company old-record)) ++ (old-nets (bbdb-record-net old-record)) ++ (old-aka (bbdb-record-aka old-record)) ++ extra-name) ++ (let ((name ++ (cond ((= 0 (length old-name)) ++ (cons (bbdb-record-firstname new-record) ++ (bbdb-record-lastname new-record))) ++ ((= 0 (length new-name)) ++ (cons (bbdb-record-firstname old-record) ++ (bbdb-record-lastname old-record))) ++ ((string-equal (downcase old-name) (downcase new-name)) ++ (cons (bbdb-record-firstname new-record) ++ (bbdb-record-lastname new-record))) ++ (t (prog1 ++ (if (bbdb-y-or-n-p ++ (format "Use name \"%s\" instead of \"%s\"? " ++ old-name new-name)) ++ (progn ++ (setq extra-name new-record) ++ (cons (bbdb-record-firstname old-record) ++ (bbdb-record-lastname old-record))) ++ (setq extra-name old-record) ++ (cons (bbdb-record-firstname new-record) ++ (bbdb-record-lastname new-record))) ++ (or (and bbdb-use-alternate-names ++ (bbdb-y-or-n-p ++ (format "Keep \"%s\" as an alternate name? " ++ (bbdb-record-name extra-name)))) ++ (setq extra-name nil)) ++ )) ++ )) ++ (comp (cond ((= 0 (length old-co)) new-co) ++ ((= 0 (length new-co)) old-co) ++ ((string-equal old-co new-co) new-co) ++ (t (if (bbdb-y-or-n-p ++ (format "Use company \"%s\" instead of \"%s\"? " ++ old-co new-co)) ++ old-co new-co)))) ++ ) ++ ++ (if extra-name ++ (setq old-aka (cons (bbdb-record-name extra-name) old-aka))) ++ ++ (bbdb-record-set-phones new-record ++ (bbdb-merge-lists! ++ (bbdb-record-phones new-record) ++ (bbdb-record-phones old-record) ++ 'equal)) ++ (bbdb-record-set-addresses new-record ++ (bbdb-merge-lists! ++ (bbdb-record-addresses new-record) ++ (bbdb-record-addresses old-record) ++ 'equal)) ++ (bbdb-record-set-company new-record comp) ++ ++ (let ((n1 (bbdb-record-raw-notes new-record)) ++ (n2 (bbdb-record-raw-notes old-record)) ++ tmp) ++ (or (equal n1 n2) ++ (progn ++ (or (listp n1) (setq n1 (list (cons 'notes n1)))) ++ (or (listp n2) (setq n2 (list (cons 'notes n2)))) ++ (while n2 ++ (if (setq tmp (assq (car (car n2)) n1)) ++ (setcdr tmp ++ (funcall (or (cdr (assq (car (car n2)) ++ bbdb-refile-notes-generate-alist)) ++ bbdb-refile-notes-default-merge-function) ++ (cdr tmp) (cdr (car n2)))) ++ (setq n1 (nconc n1 (list (car n2))))) ++ (setq n2 (cdr n2))) ++ (bbdb-record-set-raw-notes new-record n1) ++ ) ++ ) ++ ) ++ ++ (bbdb-record-set-firstname new-record (car name)) ++ (bbdb-record-set-lastname new-record (cdr name)) ++ (bbdb-record-set-namecache new-record nil) ++ ++ (bbdb-record-set-net new-record ++ (bbdb-merge-lists! ++ (bbdb-record-net new-record) old-nets ++ 'string= 'downcase)) ++ (bbdb-record-set-aka new-record ++ (bbdb-merge-lists! ++ (bbdb-record-aka new-record) old-aka ++ 'string= 'downcase)) ++ new-record ++ ) ++ ) ++ ) ++ + ;;;###autoload + (defun bbdb-refile-record (old-record new-record) + "Merge the current record into some other record; that is, delete the +@@ -1290,99 +1443,27 @@ + (interactive + (let ((r (bbdb-current-record))) + (list r +- (bbdb-completing-read-record ++ (bbdb-completing-read-one-record + (format "merge record \"%s\" into: " + (or (bbdb-record-name r) (car (bbdb-record-net r)) +- "???")))))) ++ "???")) (list r))))) + (if (or (null new-record) (eq old-record new-record)) + (error "those are the same")) +- (let*(extra-name +- (name +- (cond ((and (/= 0 (length (bbdb-record-name old-record))) +- (/= 0 (length (bbdb-record-name new-record)))) +- (prog1 +- (if (bbdb-y-or-n-p +- (format "Use name \"%s\" instead of \"%s\"? " +- (bbdb-record-name old-record) +- (bbdb-record-name new-record))) +- (progn +- (setq extra-name new-record) +- (cons (bbdb-record-firstname old-record) +- (bbdb-record-lastname old-record))) +- (setq extra-name old-record) +- (cons (bbdb-record-firstname new-record) +- (bbdb-record-lastname new-record))) +- (or (and bbdb-use-alternate-names +- (bbdb-y-or-n-p +- (format "Keep \"%s\" as an alternate name? " +- (bbdb-record-name extra-name)))) +- (setq extra-name nil)) +- )) +- ((= 0 (length (bbdb-record-name old-record))) +- (cons (bbdb-record-firstname new-record) +- (bbdb-record-lastname new-record))) +- (t (cons (bbdb-record-firstname old-record) +- (bbdb-record-lastname old-record))))) +- (comp +- (cond ((and (/= 0 (length (bbdb-record-company old-record))) +- (/= 0 (length (bbdb-record-company new-record)))) +- (if (bbdb-y-or-n-p (format +- "Use company \"%s\" instead of \"%s\"? " +- (bbdb-record-company old-record) +- (bbdb-record-company new-record))) +- (bbdb-record-company old-record) +- (bbdb-record-company new-record))) +- ((= 0 (length (bbdb-record-company old-record))) +- (bbdb-record-company new-record)) +- (t (bbdb-record-company old-record)))) +- (old-nets (bbdb-record-net old-record)) +- (old-aka (bbdb-record-aka old-record)) +- ) +- (if extra-name +- (setq old-aka (cons (bbdb-record-name extra-name) old-aka))) +- (bbdb-record-set-phones new-record +- (nconc (bbdb-record-phones new-record) +- (bbdb-record-phones old-record))) +- (bbdb-record-set-addresses new-record +- (nconc (bbdb-record-addresses new-record) +- (bbdb-record-addresses old-record))) +- (bbdb-record-set-company new-record comp) +- (let ((n1 (bbdb-record-raw-notes new-record)) +- (n2 (bbdb-record-raw-notes old-record)) +- tmp) +- (or (equal n1 n2) +- (progn +- (or (listp n1) (setq n1 (list (cons 'notes n1)))) +- (or (listp n2) (setq n2 (list (cons 'notes n2)))) +- (while n2 +- (if (setq tmp (assq (car (car n2)) n1)) +- (setcdr tmp +- (funcall (or (cdr (assq (car (car n2)) +- bbdb-refile-notes-generate-alist)) +- bbdb-refile-notes-default-merge-function) +- (cdr tmp) (cdr (car n2)))) +- (setq n1 (nconc n1 (list (car n2))))) +- (setq n2 (cdr n2))) +- (bbdb-record-set-raw-notes new-record n1)))) +- (bbdb-delete-current-record old-record 'noprompt) +- (bbdb-record-set-net new-record +- (nconc (bbdb-record-net new-record) old-nets)) +- (bbdb-record-set-firstname new-record (car name)) +- (bbdb-record-set-lastname new-record (cdr name)) +- (bbdb-record-set-namecache new-record nil) +- (bbdb-record-set-aka new-record +- (nconc (bbdb-record-aka new-record) old-aka)) +- (bbdb-change-record new-record t) ; don't always need-to-sort... +- (let ((bbdb-elided-display nil)) +- (if (assq new-record bbdb-records) +- (bbdb-redisplay-one-record new-record)) +- (bbdb-with-db-buffer +- (if (not (memq new-record bbdb-changed-records)) +- (setq bbdb-changed-records +- (cons new-record bbdb-changed-records)))) +- (if (null bbdb-records) ; nothing displayed, display something. +- (bbdb-display-records (list new-record))))) +- (message "records merged.")) ++ (setq new-record (bbdb-merge-records old-record new-record)) ++ ++ (bbdb-delete-current-record old-record 'noprompt) ++ (bbdb-change-record new-record t) ; don't always need-to-sort... ++ (let ((bbdb-elided-display nil)) ++ (if (assq new-record bbdb-records) ++ (bbdb-redisplay-one-record new-record)) ++ (bbdb-with-db-buffer ++ (if (not (memq new-record bbdb-changed-records)) ++ (setq bbdb-changed-records ++ (cons new-record bbdb-changed-records)))) ++ (if (null bbdb-records) ; nothing displayed, display something. ++ (bbdb-display-records (list new-record)))) ++ (message "records merged.") ++ ) + + + ;;; Send-Mail interface +@@ -1613,47 +1694,97 @@ + + ;;; completion + ++(defun bbdb-completion-check-record (sym rec) ++ (let ((name (downcase (or (bbdb-record-name rec) ++ (bbdb-record-company rec)))) ++ (nets (bbdb-record-net rec)) ++ ok) ++ ++ (if (null bbdb-completion-type) ++ (setq ok 't) ++ (if (memq bbdb-completion-type ++ '(name primary-or-name name-or-primary)) ++ (setq ok (string= sym name))) ++ ++ ;; #### handle AKA, mail-name or mail-alias here? ++ (if ok '() ++ (if (eq bbdb-completion-type 'net) ++ (while (and nets (not ok)) ++ (setq ok (string= sym (downcase (car nets))) ++ nets (cdr nets)))) ++ (if (memq bbdb-completion-type ++ '(primary primary-or-name name-or-primary)) ++ (setq ok (string= sym (downcase (car nets)))) ++ ) ++ ) ++ ) ++ ok ++ ) ++ ) ++ ++ + ;;;###autoload + (defun bbdb-completion-predicate (symbol) + "For use as the third argument to completing-read, to obey the + semantics of bbdb-completion-type." +- (let (name r n) +- (and (boundp symbol) +- (setq name (symbol-name symbol) +- r (symbol-value symbol)) +- (or (null bbdb-completion-type) +- (and (memq bbdb-completion-type +- '(name primary-or-name name-or-primary)) +- (setq n (or (bbdb-record-name r) +- (bbdb-record-company r))) +- (string= name (downcase n))) +- ;; #### do something about AKA or mail-name or mail-alias here? +- (and (setq n (bbdb-record-net r)) +- (or (and (memq bbdb-completion-type +- '(primary primary-or-name name-or-primary)) +- (string= name (downcase (car n)))) +- (and (eq bbdb-completion-type 'net) +- (let ((done nil)) +- (while (and n (not done)) +- (if (string= name (downcase (car n))) +- (setq done t)) +- (setq n (cdr n))) +- done)))))))) ++ (cond ((null bbdb-completion-type) 't) ++ ((not (boundp symbol)) '()) ++ (t (let ((sym (symbol-name symbol)) ++ (recs (symbol-value symbol)) ++ ok) ++ (while (and recs (not ok)) ++ (setq ok (bbdb-completion-check-record sym (car recs)) ++ recs (cdr recs))) ++ ok)) ++ )) + +-(defun bbdb-completing-read-record (prompt) ++(defun bbdb-completing-read-record (prompt &optional omit-records) + "Prompt for and return a record from the bbdb; completion is done according + to bbdb-completion-type. If the user just hits return, nil is returned. + Otherwise, a valid response is forced." + (let* ((ht (bbdb-hashtable)) ++ (completion-ignore-case 't) + (string (completing-read prompt ht 'bbdb-completion-predicate t)) + (symbol (and (not (= 0 (length string))) + (intern-soft string ht)))) + (if symbol + (if (and (boundp symbol) (symbol-value symbol)) +- (symbol-value symbol) +- (error "selecting deleted (unhashed) record \"%s\"!" symbol)) ++ (let ((recs (symbol-value symbol)) ret) ++ (while recs ++ (if (and (not (memq (car recs) omit-records)) ++ (bbdb-completion-check-record (symbol-name symbol) ++ (car recs))) ++ (setq ret (cons (car recs) ret))) ++ (setq recs (cdr recs))) ++ ret) ++ (error "selecting deleted (unhashed) record \"%s\"!" symbol)) + nil))) + ++(defun bbdb-completing-read-one-record (prompt &optional omit-records) ++ "Prompt for and return a single record from the bbdb; ++completion is done according to bbdb-completion-type. If the user ++just hits return, nil is returned. Otherwise, a valid response is forced. ++if omit-records is non-nil it should be a list of records to dis-allow ++completion with." ++ (let ((records (bbdb-remove-memq-duplicates ++ (bbdb-completing-read-record prompt omit-records)))) ++ (if (eq (length records) 1) ++ (car records) ++ (let ((count (length records)) ++ prompts result) ++ (bbdb-display-records records) ++ (while (> count 0) ++ (setq prompts (cons (list (number-to-string count) count) prompts) ++ count (1- count))) ++ (setq result ++ (completing-read (format "Which duplicate record (1-%s): " ++ (length records)) ++ prompts nil t "1")) ++ (nth (1- (string-to-number result)) records) ++ ) ++ ) ++ ) ++ ) + + (defvar bbdb-read-addresses-with-completion-map + (let ((map (copy-keymap minibuffer-local-completion-map))) +@@ -1697,7 +1828,23 @@ + (insert (extent-string extent)) + (bbdb-complete-name beg))) + +- ++ ++(defun bbdb-list-overlap (l1 l2) ++ (let (ok) ++ (while (and (not ok) l1) ++ (if (memq (car l1) l2) (setq ok t l1 '()) ++ (setq l1 (cdr l1)))) ++ ok)) ++ ++(defun bbdb-remove-assoc-duplicates (l) ++ (if (null l) '() ++ (if (assoc (car (car l)) (cdr l)) ++ (bbdb-remove-assoc-duplicates (cdr l)) ++ (cons (car l) (bbdb-remove-assoc-duplicates (cdr l))) ++ ) ++ ) ++) ++ + ;;;###autoload + (defun bbdb-complete-name (&optional start-pos) + "Complete the user full-name or net-address before point (up to the +@@ -1724,19 +1871,26 @@ + (yeah-yeah-this-one nil) + (only-one-p t) + (all-the-completions nil) +- (pred (function (lambda (sym) +- (and (bbdb-completion-predicate sym) +- (let* ((rec (symbol-value sym)) +- (net (bbdb-record-net rec))) +- (if (and yeah-yeah-this-one +- (not (eq rec yeah-yeah-this-one))) +- (setq only-one-p nil)) +- (setq all-the-completions +- (cons sym all-the-completions)) +- (if (eq rec yeah-yeah-this-one) +- nil +- (and net (setq yeah-yeah-this-one rec)) +- net)))))) ++ (pred (function ++ (lambda (sym) ++ (and (bbdb-completion-predicate sym) ++ (let* ((recs (and (boundp sym) (symbol-value sym))) ++ nets) ++ (while (and (not nets) recs) ++ (if (not (setq nets (bbdb-record-net (car recs)))) ++ () ++ (if (memq (car recs) yeah-yeah-this-one) ++ (setq nets '()) ;; already have it... ++ (setq only-one-p nil ++ yeah-yeah-this-one ++ (cons (car recs) yeah-yeah-this-one))) ++ (if (not (memq sym all-the-completions)) ++ (setq all-the-completions ++ (cons sym all-the-completions))) ++ ) ++ (setq recs (cdr recs))) ++ nets)) ++ ))) + (completion (try-completion pattern ht pred))) + ;; If there were multiple completions for this record, the one that was + ;; picked is random (hash order.) So canonicalize that to be the one +@@ -1744,8 +1898,12 @@ + (if (and (stringp completion) + yeah-yeah-this-one + only-one-p) +- (let ((addrs (bbdb-record-net yeah-yeah-this-one)) +- (rest all-the-completions)) ++ (let ((rest all-the-completions) addrs) ++ (while yeah-yeah-this-one ++ (setq addrs (append addrs ++ (bbdb-record-net (car yeah-yeah-this-one))) ++ yeah-yeah-this-one (cdr yeah-yeah-this-one)) ++ ) + (while rest + (if (member (symbol-name (car rest)) addrs) + (setq completion (symbol-name (car rest)) +@@ -1753,94 +1911,146 @@ + (setq rest (cdr rest))))) + (setq yeah-yeah-this-one nil + all-the-completions nil) +- (cond ((eq completion t) +- (let* ((sym (intern-soft pattern ht)) +- (val (symbol-value sym))) +- (delete-region beg end) +- (insert (bbdb-dwim-net-address val +- (if (string= (symbol-name sym) +- (downcase (or (bbdb-record-name val) ""))) +- nil +- ;; get the case right +- (let ((nets (bbdb-record-net val)) +- (want (symbol-name sym)) +- (the-one nil)) +- (while (and nets (not the-one)) +- (if (string= want (downcase (car nets))) +- (setq the-one (car nets)) +- (setq nets (cdr nets)))) +- the-one)))) +- ;; +- ;; if we're past fill-column, wrap at the previous comma. +- (if (and +- (if (boundp 'auto-fill-function) ; the emacs19 name. +- auto-fill-function +- auto-fill-hook) +- (>= (current-column) fill-column)) +- (let ((p (point)) +- bol) +- (save-excursion +- (beginning-of-line) +- (setq bol (point)) +- (goto-char p) +- (if (search-backward "," bol t) +- (progn +- (forward-char 1) +- (insert "\n ")))))) +- ;; +- ;; Update the *BBDB* buffer if desired. +- (if bbdb-completion-display-record +- (let ((bbdb-gag-messages t)) +- (bbdb-display-records-1 (list val) t))) +- (bbdb-complete-name-cleanup) +- )) +- ((null completion) +- (bbdb-complete-name-cleanup) +- (message "completion for \"%s\" unfound." pattern) +- (ding)) +- ((not (string= pattern completion)) +- (delete-region beg end) +- (insert completion) +- (setq end (point)) +- (let ((last "")) +- (while (and (stringp completion) +- (not (string= completion last)) +- (setq last completion +- pattern (downcase (buffer-substring beg end)) +- completion (try-completion pattern ht pred))) +- (if (stringp completion) +- (progn (delete-region beg end) +- (insert completion)))) +- (bbdb-complete-name beg) +- )) +- (t +- (or (eq (selected-window) (minibuffer-window)) +- (message "Making completion list...")) +- (let* ((list (all-completions pattern ht pred)) +-;; (recs (delq nil (mapcar (function (lambda (x) +-;; (symbol-value (intern-soft x ht)))) +-;; list))) ++ (cond ++ ;; No match ++ ((null completion) ++ (bbdb-complete-name-cleanup) ++ (message "completion for \"%s\" unfound." pattern) ++ (ding)) ++ ++ ;; Perfect match... ++ ((eq completion t) ++ (let* ((sym (intern-soft pattern ht)) ++ (recs (symbol-value sym)) ++ the-net match-recs lst primary matched) ++ (while recs ++ (if (not (bbdb-record-net (car recs))) () ++ ++ (if (string= pattern ++ (downcase (or (bbdb-record-name (car recs)) ""))) ++ (setq match-recs (cons (car recs) match-recs) ++ matched t)) ++ ++ ;; put aka's at end of match list... ++ (setq lst (bbdb-record-aka (car recs))) ++ (if (not matched) ++ (while lst ++ (if (string= pattern (downcase (car lst))) ++ (setq match-recs (append match-recs (list (car recs))) ++ matched t ++ lst '()) ++ (setq lst (cdr lst)) ++ ) + ) +- (if (and (not (eq bbdb-completion-type 'net)) +- (= 2 (length list)) +- (eq (symbol-value (intern (car list) ht)) +- (symbol-value (intern (nth 1 list) ht))) +- (not (string= completion (car list)))) +- (progn +- (delete-region beg end) +- (insert (car list)) +- (message " ") +- (bbdb-complete-name beg)) +- (if (not (get-buffer-window "*Completions*")) +- (setq bbdb-complete-name-saved-window-config +- (current-window-configuration))) +- (let ((arg (list (current-buffer) +- (set-marker (make-marker) beg) +- (set-marker (make-marker) end)))) +- (with-output-to-temp-buffer "*Completions*" +- (bbdb-display-completion-list list 'bbdb-complete-clicked-name arg))) +- (or (eq (selected-window) (minibuffer-window)) +- (message "Making completion list...done")))))))) ++ ) ++ ++ ;; Name didn't match name so check net matching ++ (setq lst (bbdb-record-net (car recs))) ++ (setq primary 't);; primary wins over secondary... ++ (if (not matched) ++ (while lst ++ (if (string= pattern (downcase (car lst))) ++ (setq the-net (car lst) ++ lst nil ++ match-recs ++ (if primary (cons (car recs) match-recs) ++ (append match-recs (list (car recs)))))) ++ (setq lst (cdr lst) ++ primary nil))) ++ ) ++ (setq recs (cdr recs) ++ matched nil)) ++ ++ (if (and (null the-net) ++ (> (length match-recs) 1)) ++ (let ((lst (mapcar (lambda (x) ++ (cons (car (bbdb-record-net x)) x)) ++ match-recs)) ++ (completion-ignore-case 't) ++ comp) ++ (setq lst (bbdb-remove-assoc-duplicates lst) ++ comp (completing-read "Which primary net: " lst '() 't ++ (cons (car (car lst)) 0)) ++ match-recs (list (cdr (assoc comp lst))) ++ the-net comp) ++ ) ++ ) ++ ++ ++ (delete-region beg end) ++ (insert (bbdb-dwim-net-address (car match-recs) the-net)) ++ ;; ++ ;; if we're past fill-column, wrap at the previous comma. ++ (if (and ++ (if (boundp 'auto-fill-function) ; the emacs19 name. ++ auto-fill-function ++ auto-fill-hook) ++ (>= (current-column) fill-column)) ++ (let ((p (point)) ++ bol) ++ (save-excursion ++ (beginning-of-line) ++ (setq bol (point)) ++ (goto-char p) ++ (if (search-backward "," bol t) ++ (progn ++ (forward-char 1) ++ (insert "\n ")))))) ++ ++ ;; ++ ;; Update the *BBDB* buffer if desired. ++ (if bbdb-completion-display-record ++ (let ((bbdb-gag-messages t)) ++ (bbdb-display-records-1 match-recs t))) ++ (bbdb-complete-name-cleanup) ++ )) ++ ++ ;; Partial match ++ ((not (string= pattern completion)) ++ (delete-region beg end) ++ (insert completion) ++ (setq end (point)) ++ (let ((last "")) ++ (while (and (stringp completion) ++ (not (string= completion last)) ++ (setq last completion ++ pattern (downcase (buffer-substring beg end)) ++ completion (try-completion pattern ht pred))) ++ (if (stringp completion) ++ (progn (delete-region beg end) ++ (insert completion)))) ++ (bbdb-complete-name beg) ++ )) ++ ++ ;; Matched again and got no new chars so show options... ++ (t ++ (or (eq (selected-window) (minibuffer-window)) ++ (message "Making completion list...")) ++ (let* ((list (all-completions pattern ht pred)) ++ ;; (recs (delq nil (mapcar (function (lambda (x) ++ ;; (symbol-value (intern-soft x ht)))) ++ ;; list))) ++ ) ++ (if (and (not (eq bbdb-completion-type 'net)) ++ (= 2 (length list)) ++ (eq (symbol-value (intern (car list) ht)) ++ (symbol-value (intern (nth 1 list) ht))) ++ (not (string= completion (car list)))) ++ (progn ++ (delete-region beg end) ++ (insert (car list)) ++ (message " ") ++ (bbdb-complete-name beg)) ++ (if (not (get-buffer-window "*Completions*")) ++ (setq bbdb-complete-name-saved-window-config ++ (current-window-configuration))) ++ (let ((arg (list (current-buffer) ++ (set-marker (make-marker) beg) ++ (set-marker (make-marker) end)))) ++ (with-output-to-temp-buffer "*Completions*" ++ (bbdb-display-completion-list list 'bbdb-complete-clicked-name arg))) ++ (or (eq (selected-window) (minibuffer-window)) ++ (message "Making completion list...done")))))))) + + ;;;###autoload + (defun bbdb-yank () +@@ -2135,6 +2345,61 @@ + (setq bbdb-remaining-addrs-to-finger (cdr addrs)) + (bbdb-finger-internal (car addrs)))))) + ++ ++(defun bbdb-find-duplicates (&optional fields) ++ "*Find all records that have duplicate entries for given FIELDS. ++FIELDS should be a list of the symbols `name', `net', and/or `aka'. ++Note that overlap between these fields is noted if either is selected ++(most common case `aka' and `name'). If FIELDS is not given it ++defaults to all of them. ++ ++The results of the search is returned as a list of records." ++ (setq fields (or fields '(name net aka))) ++ (let ((records (bbdb-records)) ++ rec hash ret) ++ (while records ++ (setq rec (car records)) ++ ++ (and (memq 'name fields) ++ (setq hash (bbdb-gethash (downcase (bbdb-record-name rec)))) ++ (> (length hash) 1) ++ (setq ret (append hash ret))) ++ ++ (if (memq 'net fields) ++ (let ((nets (bbdb-record-net rec))) ++ (while nets ++ (setq hash (bbdb-gethash (downcase (car nets)))) ++ (if (> (length hash) 1) ++ (setq ret (append hash ret))) ++ (setq nets (cdr nets)) ++ ))) ++ ++ (if (memq 'aka fields) ++ (let ((aka (bbdb-record-aka rec))) ++ (while aka ++ (setq hash (bbdb-gethash (downcase (car aka)))) ++ (if (> (length hash) 1) ++ (setq ret (append hash ret))) ++ (setq aka (cdr aka)) ++ ))) ++ (setq records (cdr records)) ++ ) ++ (bbdb-remove-memq-duplicates ret) ++ ) ++) ++ ++(defun bbdb-show-duplicates (&optional fields) ++"*Find all records that have duplicate entries for given FIELDS. ++FIELDS should be a list of the symbols `name', `net', and/or `aka'. ++Note that overlap between these fields is noted if either is selected ++(most common case `aka' and `name'). If FIELDS is not given it ++defaults to all of them. ++ ++The results are displayed in the bbdb buffer." ++ (interactive) ++ (setq fields (or fields '(name net aka))) ++ (bbdb-display-records (bbdb-find-duplicates fields)) ++) + + ;;; Time-based functions + (defun bbdb-kill-older (date &optional compare function) +diff -ur bbdb-2.00.06/lisp/bbdb-ftp.el bbdb-2.01/lisp/bbdb-ftp.el +--- bbdb-2.00.06/lisp/bbdb-ftp.el Tue Sep 28 09:56:40 1999 ++++ bbdb-2.01/lisp/bbdb-ftp.el Tue Sep 28 11:01:14 1999 +@@ -172,7 +172,8 @@ + (progn + (setq site (bbdb-read-string "Ftp Site: ")) + (setq site (concat bbdb-ftp-site-name-designator-prefix site)) +- (if (bbdb-gethash (downcase site)) ++ (if (and bbdb-no-duplicates-p ++ (bbdb-gethash (downcase site))) + (error "%s is already in the database" site)))) + (let* ((dir (bbdb-read-string "Ftp Directory: " + bbdb-default-ftp-dir)) +diff -ur bbdb-2.00.06/lisp/bbdb.el bbdb-2.01/lisp/bbdb.el +--- bbdb-2.00.06/lisp/bbdb.el Tue Sep 28 09:56:42 1999 ++++ bbdb-2.01/lisp/bbdb.el Tue Feb 29 09:09:18 2000 +@@ -49,6 +49,11 @@ + nil if the database was read in and is to be written in the current + version.") + ++(defvar bbdb-no-duplicates-p '() ++ "Should BBDB allow entries with duplicate names. This may lead to ++confusion when doing completion. If 't it will prompt the users on how ++to merge records when duplicates are detected.") ++ + ;; This nonsense is to get the definition of defsubst loaded in when this file + ;; is loaded,without necessarily forcing the compiler to be loaded if we're + ;; running in an emacs with bytecomp-runtime.el predumped. We are using +@@ -900,11 +905,15 @@ + (save-window-excursion + (if (and (boundp 'epoch::version) epoch::version) + nil ; this breaks epoch... +- (let ((w (selected-window))) +- (select-window (minibuffer-window)) +- (enlarge-window (max 0 (- n (window-height)))) +- (sit-for 0) ; avoid redisplay glitch +- (select-window w))) ++ (let ((w (selected-window)) ++ (mini (minibuffer-window))) ++ (if (eq mini (next-window mini 't (window-frame mini))) ++ nil ;; Can't enlarge if only window in frame... ++ (select-window mini) ++ (enlarge-window (max 0 (- n (window-height)))) ++ (sit-for 0) ; avoid redisplay glitch ++ (select-window w) ++ ))) + (bbdb-string-trim + (read-string prompt default)))))) + +@@ -1186,7 +1195,7 @@ + (catch 'Blow-off-the-error + (setq bbdb-electric-completed-normally nil) + (unwind-protect +- (progn ++ (progn + (catch 'electric-bbdb-list-select + (Electric-command-loop 'electric-bbdb-list-select + "-> " t)) +@@ -1268,37 +1277,95 @@ + (defun bbdb-changed-records () + (bbdb-with-db-buffer (bbdb-records nil t) bbdb-changed-records)) + ++(defmacro bbdb-build-name (f l) ++ (list 'downcase ++ (list 'if (list 'and f l) ++ (list 'concat f " " l) ++ (list 'or f l ""))) ++ ) ++ ++(defun bbdb-remove! (e l) ++ (if (null l) l ++ (let ((ret l) ++ (n (cdr l))) ++ (while n ++ (if (eq e (car n)) ++ (setcdr l (cdr n)) ; skip n ++ (setq l n)) ; keep n ++ (setq n (cdr n)) ++ ) ++ (if (eq e (car ret)) (cdr ret) ++ ret) ++ )) ++ ) ++ ++(defun bbdb-remove-memq-duplicates (l) ++ (let (ret tail) ++ (setq ret (cons '() '()) ++ tail ret) ++ (while l ++ (if (not (memq (car l) ret)) ++ (setq tail (setcdr tail (cons (car l) '())))) ++ (setq l (cdr l))) ++ (cdr ret) ++ ) ++) ++ + (defmacro bbdb-gethash (name &optional ht) + (list 'symbol-value + (list 'intern-soft name + (or ht '(bbdb-hashtable))))) + + (defmacro bbdb-puthash (name record &optional ht) +- (list 'set (list 'intern name +- (or ht '(bbdb-hashtable))) +- record)) ++ (list 'let (list (list 'sym (list 'intern name (or ht '(bbdb-hashtable))))) ++ (list 'set 'sym (list 'cons record ++ '(and (boundp sym) (symbol-value sym)))) ++ ) ++ ) + +-(defmacro bbdb-remhash (name &optional ht) ++(defmacro bbdb-remhash (name record &optional ht) + (list 'let (list (list 's (list 'intern-soft name + (or ht '(bbdb-hashtable))))) +- '(and s (set s nil)))) +- ++ (list 'and 's (list 'set 's (list 'bbdb-remove! record ++ (list 'symbol-value 's)))))) + + (defsubst bbdb-search-simple (name net) + "name is a string; net is a string or list of strings." + (if (eq 0 (length name)) (setq name nil)) + (if (eq 0 (length net)) (setq net nil)) + (bbdb-records t) ; make sure db is parsed; don't check disk (faster) +- (or (and name (bbdb-gethash (downcase name))) +- (and net +- (if (stringp net) +- (bbdb-gethash (downcase net)) +- (let ((answer nil)) +- (while (and net (null answer)) +- (setq answer (bbdb-gethash (downcase (car net))) +- net (cdr net))) +- answer))))) +- ++ (let ((name-recs (and name ++ (bbdb-gethash (downcase name)))) ++ (net-recs (if (stringp net) (bbdb-gethash (downcase net)) ++ (let (answer) ++ (while (and net (null answer)) ++ (setq answer (bbdb-gethash (downcase (car net))) ++ net (cdr net))) ++ answer))) ++ ret) ++ (if (not (and name-recs net-recs)) ++ (or (and name-recs (car name-recs)) ++ (and net-recs (car net-recs))) ++ ++ (while name-recs ++ (let ((name-rec (car name-recs)) ++ (nets net-recs)) ++ (while nets ++ (if (eq (car nets) name-rec) ++ (setq nets '() ++ name-recs '() ++ ret name-rec) ++ (setq nets (cdr nets)) ++ ) ++ ) ++ (if name-recs (setq name-recs (cdr name-recs)) ++ name-rec) ++ ) ++ ) ++ ret ++ ) ++ ) ++ ) + + (defun bbdb-net-convert (record) + "Given a record whose net field is a comma-separated string, convert it to +@@ -1333,25 +1400,21 @@ + (defsubst bbdb-hash-record (record) + "Insert the record in the appropriate hashtables. This must be called + while the .bbdb buffer is selected." +- (let ((name (bbdb-record-name-1 record)) ; faster version ++ (let ((name (bbdb-record-name-1 record)) ; faster version + (company (bbdb-record-company record)) +- (aka (bbdb-record-aka record)) +- (net (bbdb-record-net record))) +- (if (not (= 0 (length name))) ; could be nil or "" +- (bbdb-puthash (downcase name) record bbdb-hashtable)) +- ;; #### we don't do hash collision detection on company names, so this +- ;; is a potentially dangerous thing to do I guess. But it's useful. +- ;; This makes completion possible on company fields of records that +- ;; have a company but no name. +- (if (and (= 0 (length name)) +- (not (= 0 (length company)))) ++ (aka (bbdb-record-aka record)) ++ (net (bbdb-record-net record))) ++ (if (> (length name) 0) ++ (bbdb-puthash (downcase name) record bbdb-hashtable)) ++ (if (> (length company) 0) + (bbdb-puthash (downcase company) record bbdb-hashtable)) + (while aka + (bbdb-puthash (downcase (car aka)) record bbdb-hashtable) + (setq aka (cdr aka))) + (while net + (bbdb-puthash (downcase (car net)) record bbdb-hashtable) +- (setq net (cdr net))))) ++ (setq net (cdr net))) ++ )) + + + ;;; Reading the BBDB +@@ -1568,36 +1631,45 @@ + (forward-line 1)) + (widen) + (bbdb-debug (message "Parsing BBDB... (frobnicating...)")) +- (let ((rest records) ++ (setq bbdb-records records) ++ (let* ((head (cons '() records)) ++ (rest head) + record) +- (while rest +- (setq record (car rest)) ++ (while (cdr rest) ++ (setq record (car (cdr rest))) + ;; yow, are we stack-driven yet?? Damn byte-compiler... + ;; Make a cache. Put it in the record. Put a marker in the cache. + ;; Add record to hash tables. + (bbdb-cache-set-marker + (bbdb-record-set-cache record (make-vector bbdb-cache-length nil)) + (point-marker)) +- (bbdb-debug +- (let ((name (bbdb-record-name record)) +- tmp) +- (if (and name +- (setq tmp (bbdb-gethash (setq name (downcase name)) +- bbdb-hashtable))) +- (signal 'error (list "duplicate bbdb entries" record tmp))))) +- (bbdb-hash-record record) + (forward-line 1) +- (setq rest (cdr rest)) ++ ++ (if bbdb-no-duplicates-p ++ ;; warn the user that there is a duplicate... ++ (let* ((name (bbdb-record-name record)) ++ (tmp (and name (bbdb-gethash (downcase name) ++ bbdb-hashtable)))) ++ (if tmp (message "Duplicate BBDB record encountered: %s" name)) ++ ) ++ ) ++ ++ (bbdb-hash-record record) ++ (setq rest (cdr rest)) ++ + (bbdb-debug +- (if (and rest (not (looking-at "[\[]"))) ++ (if (and (cdr rest) (not (looking-at "[\[]"))) + (error "bbdb corrupted: junk between records at %s" (point)))) +- )) ++ ) ++ ;; In case we removed some of the leading entries... ++ (setq bbdb-records (cdr head)) ++ ) + ;; all done. +- (setq bbdb-records records) + (setq bbdb-end-marker (point-marker)) + (run-hooks 'bbdb-after-read-db-hook) + (bbdb-debug (message "Parsing BBDB... (frobnicating...done)")) +- records) ++ bbdb-records ++) + + (defmacro bbdb-user-mail-names () + "Returns a regexp matching the address of the logged-in user" +@@ -1632,17 +1704,21 @@ + (if (cdr tail) + (bbdb-record-marker (car (cdr tail))) + bbdb-end-marker)) +- (if (bbdb-record-name record) +- (let ((name (downcase (bbdb-record-name record)))) +- (bbdb-remhash name bbdb-hashtable))) +- (let ((nets (bbdb-record-net record))) ++ (let ((name (bbdb-record-name record)) ++ (company (bbdb-record-company record)) ++ (aka (bbdb-record-aka record)) ++ (nets (bbdb-record-net record))) ++ (if (> (length name) 0) ++ (bbdb-remhash (downcase name) record bbdb-hashtable)) ++ (if (> (length company) 0) ++ (bbdb-remhash (downcase company) record bbdb-hashtable)) + (while nets +- (bbdb-remhash (downcase (car nets)) bbdb-hashtable) +- (setq nets (cdr nets)))) +- (let ((aka (bbdb-record-aka record))) ++ (bbdb-remhash (downcase (car nets)) record bbdb-hashtable) ++ (setq nets (cdr nets))) + (while aka +- (bbdb-remhash (downcase (car aka)) bbdb-hashtable) +- (setq aka (cdr aka)))) ++ (bbdb-remhash (downcase (car aka)) record bbdb-hashtable) ++ (setq aka (cdr aka))) ++ ) + (bbdb-record-set-sortkey record nil) + (setq bbdb-modified-p t)))) + +@@ -2333,7 +2409,7 @@ + old-name)) + (bbdb-record-set-aka record + (cons old-name (bbdb-record-aka record))) +- (bbdb-remhash (downcase old-name)))) ++ (bbdb-remhash (downcase old-name) record))) + (bbdb-record-set-namecache record nil) + (bbdb-record-set-firstname record fname) + (bbdb-record-set-lastname record lname) +@@ -2820,6 +2896,7 @@ + (defun bbdb-insinuate-sendmail () + "Call this function to hook BBDB into sendmail (that is, M-x mail)." + (define-key mail-mode-map "\M-\t" 'bbdb-complete-name) ++ (define-key mail-mode-map [(meta tab)] 'bbdb-complete-name) + ) + + diff --git a/install-sh b/install-sh new file mode 100755 index 0000000..e9de238 --- /dev/null +++ b/install-sh @@ -0,0 +1,251 @@ +#!/bin/sh +# +# install - install a program, script, or datafile +# This comes from X11R5 (mit/util/scripts/install.sh). +# +# Copyright 1991 by the Massachusetts Institute of Technology +# +# Permission to use, copy, modify, distribute, and sell this software and its +# documentation for any purpose is hereby granted without fee, provided that +# the above copyright notice appear in all copies and that both that +# copyright notice and this permission notice appear in supporting +# documentation, and that the name of M.I.T. not be used in advertising or +# publicity pertaining to distribution of the software without specific, +# written prior permission. M.I.T. makes no representations about the +# suitability of this software for any purpose. It is provided "as is" +# without express or implied warranty. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. It can only install one file at a time, a restriction +# shared with many OS's install programs. + + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit="${DOITPROG-}" + + +# put in absolute paths if you don't have them in your path; or use env. vars. + +mvprog="${MVPROG-mv}" +cpprog="${CPPROG-cp}" +chmodprog="${CHMODPROG-chmod}" +chownprog="${CHOWNPROG-chown}" +chgrpprog="${CHGRPPROG-chgrp}" +stripprog="${STRIPPROG-strip}" +rmprog="${RMPROG-rm}" +mkdirprog="${MKDIRPROG-mkdir}" + +transformbasename="" +transform_arg="" +instcmd="$mvprog" +chmodcmd="$chmodprog 0755" +chowncmd="" +chgrpcmd="" +stripcmd="" +rmcmd="$rmprog -f" +mvcmd="$mvprog" +src="" +dst="" +dir_arg="" + +while [ x"$1" != x ]; do + case $1 in + -c) instcmd="$cpprog" + shift + continue;; + + -d) dir_arg=true + shift + continue;; + + -m) chmodcmd="$chmodprog $2" + shift + shift + continue;; + + -o) chowncmd="$chownprog $2" + shift + shift + continue;; + + -g) chgrpcmd="$chgrpprog $2" + shift + shift + continue;; + + -s) stripcmd="$stripprog" + shift + continue;; + + -t=*) transformarg=`echo $1 | sed 's/-t=//'` + shift + continue;; + + -b=*) transformbasename=`echo $1 | sed 's/-b=//'` + shift + continue;; + + *) if [ x"$src" = x ] + then + src=$1 + else + # this colon is to work around a 386BSD /bin/sh bug + : + dst=$1 + fi + shift + continue;; + esac +done + +if [ x"$src" = x ] +then + echo "install: no input file specified" + exit 1 +else + true +fi + +if [ x"$dir_arg" != x ]; then + dst=$src + src="" + + if [ -d $dst ]; then + instcmd=: + chmodcmd="" + else + instcmd=mkdir + fi +else + +# Waiting for this to be detected by the "$instcmd $src $dsttmp" command +# might cause directories to be created, which would be especially bad +# if $src (and thus $dsttmp) contains '*'. + + if [ -f $src -o -d $src ] + then + true + else + echo "install: $src does not exist" + exit 1 + fi + + if [ x"$dst" = x ] + then + echo "install: no destination specified" + exit 1 + else + true + fi + +# If destination is a directory, append the input filename; if your system +# does not like double slashes in filenames, you may need to add some logic + + if [ -d $dst ] + then + dst="$dst"/`basename $src` + else + true + fi +fi + +## this sed command emulates the dirname command +dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` + +# Make sure that the destination directory exists. +# this part is taken from Noah Friedman's mkinstalldirs script + +# Skip lots of stat calls in the usual case. +if [ ! -d "$dstdir" ]; then +defaultIFS=' +' +IFS="${IFS-${defaultIFS}}" + +oIFS="${IFS}" +# Some sh's can't handle IFS=/ for some reason. +IFS='%' +set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` +IFS="${oIFS}" + +pathcomp='' + +while [ $# -ne 0 ] ; do + pathcomp="${pathcomp}${1}" + shift + + if [ ! -d "${pathcomp}" ] ; + then + $mkdirprog "${pathcomp}" + else + true + fi + + pathcomp="${pathcomp}/" +done +fi + +if [ x"$dir_arg" != x ] +then + $doit $instcmd $dst && + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi +else + +# If we're going to rename the final executable, determine the name now. + + if [ x"$transformarg" = x ] + then + dstfile=`basename $dst` + else + dstfile=`basename $dst $transformbasename | + sed $transformarg`$transformbasename + fi + +# don't allow the sed command to completely eliminate the filename + + if [ x"$dstfile" = x ] + then + dstfile=`basename $dst` + else + true + fi + +# Make a temp file name in the proper directory. + + dsttmp=$dstdir/#inst.$$# + +# Move or copy the file name to the temp name + + $doit $instcmd $src $dsttmp && + + trap "rm -f ${dsttmp}" 0 && + +# and set any options; do chmod last to preserve setuid bits + +# If any of these fail, we abort the whole thing. If we want to +# ignore errors from any of these, just make sure not to ignore +# errors from the above "$doit $instcmd $src $dsttmp" command. + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && + +# Now rename the file to the real destination. + + $doit $rmcmd -f $dstdir/$dstfile && + $doit $mvcmd $dsttmp $dstdir/$dstfile + +fi && + + +exit 0 diff --git a/lisp/.gitignore b/lisp/.gitignore new file mode 100644 index 0000000..2aee78a --- /dev/null +++ b/lisp/.gitignore @@ -0,0 +1,2 @@ +/Makefile +/bbdb-autoloads.el diff --git a/lisp/Makefile.in b/lisp/Makefile.in new file mode 100644 index 0000000..80d620b --- /dev/null +++ b/lisp/Makefile.in @@ -0,0 +1,194 @@ +@SET_MAKE@ + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_DATA = @INSTALL_DATA@ + +RM = @RM@ +LN_S = @LN_S@ + +EMACS_PROG = @EMACS_PROG@ -no-site-file -no-init-file +EMACS_FLAVOR = @EMACS_FLAVOR@ + +GNUSDIR = @GNUSDIR@ +MHEDIR = @MHEDIR@ +VMDIR = @VMDIR@ +OTHERDIRS = @OTHERDIRS@ + +PACKAGEDIR = @PACKAGEDIR@ +SYMLINKS = @SYMLINKS@ +LINKPATH = @LINKPATH@ + +# this is lovely, isn't it? Surprisingly enough, it seems to work... +VM = -eval '(if (> (length "$(VMDIR)") 0) \ + (setq load-path (cons "$(VMDIR)" load-path)))' + +GNUS = -eval '(if (> (length "$(GNUSDIR)") 0) \ + (setq load-path (cons "$(GNUSDIR)" load-path)))' + +MHE = -eval '(if (> (length "$(MHEDIR)") 0) \ + (setq load-path (cons "$(MHEDIR)" load-path)))' + +PUSHPATH= -eval "`\ + dir=\". $(OTHERDIRS)\"; \ + echo \(setq load-path \(append \(list ; \ + for i in $$dir ; do \ + echo \(expand-file-name \\"$$i\\"\)\ ; \ + done ;\ + echo \) load-path\)\) ; \ + `" + +.SUFFIXES: .elc .el .tar .Z .gz .uu + +DEPSRCS= bbdb-com.el bbdb-hooks.el bbdb-gnus.el bbdb-mhe.el \ + bbdb-rmail.el bbdb-vm.el bbdb-ftp.el bbdb-whois.el \ + bbdb-print.el bbdb-srv.el bbdb-reportmail.el \ + bbdb-merge.el bbdb-migrate.el bbdb-gui.el + +ifeq ($(EMACS_FLAVOR),xemacs) +DEPSRCS+= bbdb-xemacs.el +endif + +DEPBINS= ${DEPSRCS:.el=.elc} +SRCS= bbdb.el $(DEPSRCS) +BINS= bbdb.elc $(DEPBINS) + +all: Makefile @BBDB_RMAIL@ @BBDB_GNUS@ @BBDB_VM@ @BBDB_MHE@ bbdb autoloadsc + +Makefile: Makefile.in + cd ..; ./config.status + +install-pkg: uninstall-pkg bbdb autoloadsc + @if test "x$(SYMLINKS)" = "xno" ; then \ + mkdir -p -m 0755 $(PACKAGEDIR)/lisp/bbdb; \ + for i in `ls *.elc` ; do \ + $(INSTALL_DATA) `echo $$i | sed 's/c$$//g'` \ + $(PACKAGEDIR)/lisp/bbdb ; \ + $(INSTALL_DATA) $$i $(PACKAGEDIR)/lisp/bbdb ; \ + done ; \ + else \ + if test "x$(LINKPATH)" = "x" ; then \ + $(LN_S) `pwd` $(PACKAGEDIR)/lisp/bbdb ; \ + else \ + $(LN_S) $(LINKPATH)/lisp $(PACKAGEDIR)/lisp/bbdb ; \ + fi ; \ + fi + +uninstall-pkg: + -$(RM) -r $(PACKAGEDIR)/lisp/bbdb + +bbdb-autoloads.el: $(DEPSRCS) + @-$(RM) $@; + @echo "(provide 'bbdb-autoloads)" > $@; + @echo "(eval-when-compile" >> $@; + @echo " (condition-case ()" >> $@; + @echo " (require 'custom)" >> $@; + @echo " (error nil))" >> $@; + @echo " (if (and (featurep 'custom) (fboundp 'custom-declare-variable))()" >> $@; + @echo " (defmacro defgroup (&rest args)" >> $@; + @echo " nil)" >> $@; + @echo " (defmacro defcustom (var value doc &rest args)" >> $@; + @echo " \`(defvar ,var ,value ,doc))" >> $@; + @echo " (defmacro defface (var value doc &rest args)" >> $@; + @echo " \`(make-face ,var))" >> $@; + @echo " (defmacro define-widget (&rest args)" >> $@; + @echo " nil)))" >> $@; + @echo "" >> $@; + $(EMACS_PROG) -batch -q -l autoload \ + --eval '(setq generated-autoload-file "'`pwd`'/$@")' \ + --eval "(if (featurep 'xemacs) (delete-file generated-autoload-file))" \ + --eval '(setq make-backup-files nil)' \ + --eval '(setq autoload-package-name "bbdb")' \ + -f batch-update-autoloads `pwd` + +bbdb-autoloads.elc: bbdb-autoloads.el + $(EMACS_PROG) -batch -q -f batch-byte-compile ./$^ + +bbdb.elc: bbdb.el +bbdb-com.elc: bbdb.elc bbdb-com.el +bbdb-ftp.elc: bbdb.elc bbdb-ftp.el +bbdb-gui.elc: bbdb.elc bbdb-gui.el +bbdb-merge.elc: bbdb-merge.el +bbdb-migrate.elc: bbdb.elc bbdb-migrate.el +bbdb-print.elc: bbdb.elc bbdb-print.el +bbdb-snarf.elc: bbdb.elc bbdb-snarf.el +bbdb-whois.elc: bbdb.elc bbdb-whois.el +bbdb-w3.elc: bbdb.elc bbdb-w3.el +bbdb-xemacs.elc: bbdb.elc bbdb-xemacs.el + +.el.elc: + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc -f batch-byte-compile $< + +bbdb.elc: bbdb.el + $(EMACS_PROG) -batch -q -f batch-byte-compile ./bbdb.el + +bbdb-gnus.elc: bbdb.elc bbdb-gnus.el + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc $(GNUS) \ + -f batch-byte-compile $(@:.elc=.el) +bbdb-mhe.elc: bbdb.elc bbdb-mhe.el + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc $(MHE) \ + -f batch-byte-compile $(@:.elc=.el) +bbdb-rmail.elc: bbdb.elc bbdb-rmail.el + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc $(RMAIL) \ + -f batch-byte-compile $(@:.elc=.el) +bbdb-vm.elc: bbdb.elc bbdb-vm.el + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc $(VM) \ + -f batch-byte-compile $(@:.elc=.el) + +bbdb-srv.elc: bbdb.elc bbdb-srv.el + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc -eval '(progn (or (fboundp (quote define-obsolete-variable-alias)) (if (locate-library "gnuserv-compat") (load "gnuserv-compat" t t))) (if (and (locate-library "gnuserv") (locate-library "itimer")) (byte-compile-file "bbdb-srv.el") (message "Optional package bbdb-srv skipped - gnuserv not found")))' + +bbdb-reportmail.elc: bbdb.elc bbdb-reportmail.el + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc -eval '(if (locate-library "reportmail") (byte-compile-file "bbdb-reportmail.el") (message "Optional package bbdb-reportmail skipped - reportmail not found"))' + +bbdb-sc.elc: bbdb.elc bbdb-sc.el + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc -eval '(if (locate-library "supercite") (byte-compile-file "bbdb-sc.el") (message "Optional package bbdb-sc skipped - supercite not found"))' + +# bbdb-hooks uses VM macros if it can find VM. + +bbdb-hooks.elc: bbdb.elc bbdb-hooks.el + $(EMACS_PROG) -batch -q $(PUSHPATH) -l ./bbdb.elc \ + -eval "(and (not (string= \"$(VMDIR)\" \"\")) \ + (setq load-path (cons \"$(VMDIR)\" load-path)) \ + (load \"vm\" t t) \ + (load \"vm-vars\" t t))" \ + -f batch-byte-compile $(@:.elc=.el) + +autoloads: bbdb-autoloads.el + +autoloadsc: bbdb-autoloads.elc + +extras:: bbdb-print.elc bbdb-ftp.elc bbdb-whois.elc \ + @BBDB_SRV@ @BBDB_REPORTMAIL@ bbdb-snarf.elc bbdb-w3.elc \ + @BBDB_SC@ bbdb-merge.elc bbdb-migrate.elc bbdb-gui.elc +ifeq ($(EMACS_FLAVOR),xemacs) +extras:: bbdb-xemacs.elc +endif + +bbdb: bbdb.elc bbdb-com.elc bbdb-hooks.elc autoloadsc extras + +rmail: bbdb bbdb-rmail.elc + +vm: bbdb bbdb-vm.elc + +mhe: bbdb bbdb-mhe.elc + +gnus: bbdb bbdb-gnus.elc + +# aliases +mh: mhe +mh-e: mhe + +# Assorted clean-up targets +clean: + -$(RM) bbdb*.elc + +distclean: clean + +# Backward compatibility +reallyclean: distclean + +cvsclean: distclean + -$(RM) bbdb-autoloads.el # Generated file + -$(RM) Makefile diff --git a/lisp/bbdb-com.el b/lisp/bbdb-com.el new file mode 100644 index 0000000..1939bd7 --- /dev/null +++ b/lisp/bbdb-com.el @@ -0,0 +1,3746 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski <jwz@netscape.com>. +;;; It contains most of the user-level interactive commands for BBDB. +;;; See bbdb.texinfo. + +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(require 'cl) +(require 'bbdb) +;;(require 'bbdb-snarf) causes recursive compile, which I should fix. + +;; ARGH. fmh, dammit. +(require + (eval-and-compile + (if (locate-library "mailabbrev") + (quote mailabbrev) + (quote mail-abbrevs)))) + +;; compiler placating. +;; not sure BBDB runs on anything old enough to use auto-fill-hook, mind. +(eval-and-compile + (if (boundp 'auto-fill-function) + (fset 'bbdb-auto-fill-function 'auto-fill-function) + (fset 'bbdb-auto-fill-function 'auto-fill-hook)) + + (autoload 'mh-send "mh-e") + (autoload 'vm-session-initialization "vm-startup") + (autoload 'vm-mail-internal "vm-reply") + (autoload 'vm-mail "vm") + (autoload 'mew-send "mew") + (autoload 'bbdb-header-start "bbdb-hooks") + (autoload 'bbdb-extract-field-value "bbdb-hooks") + (autoload 'bbdb-fontify-buffer "bbdb-gui") + (autoload 'Info-goto-node "info") + ;; this is very unpleasant, but saves me doing a lot of rewriting + ;; for now. a big cleanup will happen for the next release, maybe. + ;; NB if emacs 21 or older emacsen or even things you bolt on have + ;; any of these functions, bad things will happen. Again, FITNR. + (if (featurep 'xemacs) + (progn + (fset 'bbdb-extent-string 'extent-string) + (fset 'bbdb-display-message 'display-message) + (fset 'bbdb-event-to-character 'event-to-character)) + (fset 'bbdb-extent-string 'ignore) + (fset 'bbdb-display-message 'ignore) + (fset 'bbdb-event-to-character 'ignore))) + +(defvar bbdb-define-all-aliases-needs-rebuilt nil) + +(defcustom bbdb-extract-address-components-func + 'bbdb-rfc822-addresses + "Function called to parse one or more email addresses. +See bbdb-extract-address-components for an example." + :group 'bbdb-noticing-records + :type 'function) + +(defcustom bbdb-default-country + '"Emacs";; what do you mean, it's not a country? + "*Default country to use if none is specified." + :group 'bbdb-record-creation + :type 'string) ;; wonder if there's a smart place to get this? TZ, maybe? + +(defmacro bbdb-grovel-elide-arg (arg) + (list 'if arg + (list 'not (list 'eq arg 0)) + 'bbdb-display-layout)) + +(defvar bbdb-search-invert nil + "Bind this variable to t in order to invert the result of `bbdb-search'. + +\(let ((bbdb-search-invert t)) + \(bbdb-search records foo foo))") + +(defun bbdb-search-invert-p () + "Return `bbdb-search-invert' and set it to nil. +To set it on again, use `bbdb-search-invert-set'." + (let ((result bbdb-search-invert)) + (setq bbdb-search-invert nil) + result)) + +;;;###autoload +(defun bbdb-search-invert-set () + "Typing \\<bbdb-mode-map>\\[bbdb-search-invert-set] inverts the meaning of the next search command. +Sets `bbdb-search-invert' to t. +You will have to call this function again, if you want to +do repeated inverted searches." + (interactive) + (setq bbdb-search-invert t) + (message (substitute-command-keys + "\\<bbdb-mode-map>\\[bbdb-search-invert-set] - "))) + +(defmacro bbdb-search (records &optional name company net notes phone) + "Search RECORDS for optional arguments NAME, COMPANY, NET, NOTES, PHONE. +This macro only emits code for those things being searched for; +literal nils at compile-time cause no code to be emitted. + +If you want to reverse the search, bind `bbdb-search-invert' to t." + (let (clauses) + ;; I didn't protect these vars from multiple evaluation because that + ;; actually generates *less efficient code* in elisp, because the extra + ;; bindings can't easily be optimized away without lexical scope. fmh. + (or (stringp name) (symbolp name) (error "name must be atomic")) + (or (stringp company) (symbolp company) (error "company must be atomic")) + (or (stringp net) (symbolp net) (error "net must be atomic")) + (or (stringp notes) (symbolp notes) (error "notes must be atomic")) + (or (stringp phone) (symbolp phone) (error "phone must be atomic")) + (if phone + (setq clauses + (cons + `(let ((rest-of-phones (bbdb-record-phones record)) + (done nil)) + (if rest-of-phones + (while (and rest-of-phones (not done)) + (setq done (string-match ,phone + ;; way way wasteful... + (bbdb-phone-string + (car rest-of-phones))) + rest-of-phones (cdr rest-of-phones))) + ;; so that "^$" can be used to find entries that + ;; have no phones + (setq done (string-match ,phone ""))) + done) + clauses))) + (if notes + (setq clauses + (cons + (` (if (stringp (, notes)) + (string-match (, notes) + (or (bbdb-record-notes record) "")) + (if (eq (car (, notes)) '*) + (let ((fields all-fields) done tmp) + (if (bbdb-record-raw-notes record) + (while (and (not done) fields) + (setq tmp (bbdb-record-getprop + record (car fields)) + done (and tmp (string-match + (cdr (, notes)) + tmp)) + fields (cdr fields))) + ;; so that "^$" can be used to find entries that + ;; have no notes + (setq done (string-match (cdr (, notes)) ""))) + done) + (string-match (cdr (, notes)) + (or (bbdb-record-getprop + record (car (, notes))) ""))))) + clauses))) + (if name + (setq clauses + (append + (` ((string-match (, name) (or (bbdb-record-name record) "")) + (let ((rest-of-aka (bbdb-record-aka record)) + (done nil)) + (while (and rest-of-aka (not done)) + (setq done (string-match (, name) (car rest-of-aka)) + rest-of-aka (cdr rest-of-aka))) + done))) + clauses))) + (if net + (setq clauses + (cons + (` (let ((rest-of-nets (bbdb-record-net record)) + (done nil)) + (if rest-of-nets + (while (and rest-of-nets (not done)) + (setq done (string-match (, net) (car rest-of-nets)) + rest-of-nets (cdr rest-of-nets))) + ;; so that "^$" can be used to find entries that + ;; have no net addresses. + (setq done (string-match (, net) ""))) + done)) + clauses))) + (if company + (setq clauses + (cons + (` (string-match (, company) + (or (bbdb-record-company record) ""))) + clauses))) + + (` (let ((matches '()) + (,@ (if notes + '((all-fields (cons 'notes + (mapcar (lambda (x) (intern (car x))) + (bbdb-propnames))))) + nil)) + (case-fold-search bbdb-case-fold-search) + (records (, records)) + (invert (bbdb-search-invert-p)) + record) + (while records + (setq record (car records)) + (if (or (and invert + (not (or (,@ clauses)))) + (and (not invert) + (or (,@ clauses)))) + (setq matches (cons record matches))) + (setq records (cdr records))) + (nreverse matches))))) + +(defun bbdb-search-prompt (prompt &rest rest) + (if (string-match "%m" prompt) + (setq prompt (replace-match (if bbdb-search-invert + "not matching" + "matching") + nil nil prompt))) + (read-string (apply 'format prompt rest))) + +;;;###autoload +(defun bbdb (string elidep) + "Display all entries in the BBDB matching the regexp STRING +in either the name(s), company, network address, or notes." + (interactive + (list (bbdb-search-prompt "Search records %m regexp: ") + current-prefix-arg)) + (let* ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)) + (notes (cons '* string)) + (records + (bbdb-search (bbdb-records) string string string notes + nil))) + (if records + (bbdb-display-records records) + ;; we could use error here, but it's not really an error. + (message "No records matching '%s'" string)))) + +;;;###autoload +(defun bbdb-name (string elidep) + "Display all entries in the BBDB matching the regexp STRING in the name +\(or ``alternate'' names\)." + (interactive + (list (bbdb-search-prompt "Search records with names %m regexp: ") + current-prefix-arg)) + (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))) + (bbdb-display-records (bbdb-search (bbdb-records) string)))) + +;;;###autoload +(defun bbdb-company (string elidep) + "Display all entries in BBDB matching STRING in the company field." + (interactive + (list (bbdb-search-prompt "Search records with company %m regexp: ") + current-prefix-arg)) + (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))) + (bbdb-display-records (bbdb-search (bbdb-records) nil string)))) + +;;;###autoload +(defun bbdb-net (string elidep) + "Display all entries in BBDB matching regexp STRING in the network address." + (interactive + (list (bbdb-search-prompt "Search records with net address %m regexp: ") + current-prefix-arg)) + (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))) + (bbdb-display-records (bbdb-search (bbdb-records) nil nil string)))) + +;;;###autoload +(defun bbdb-notes (which string elidep) + "Display all entries in BBDB matching STRING in the named notes field." + (interactive + (let (field) + (list (setq field (completing-read "Notes field to search (RET for all): " + (append '(("notes")) (bbdb-propnames)) + nil t)) + (bbdb-search-prompt "Search records with %s %m regexp: " + (if (string= field "") + "one field" + field)) + current-prefix-arg))) + (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)) + (notes (if (string= which "") + (cons '* string) + (cons (intern which) string)))) + (bbdb-display-records (bbdb-search (bbdb-records) nil nil nil notes)))) + +(defun bbdb-phones (string elidep) + "Display all entries in BBDB matching the regexp STRING in the phones field." + (interactive + (list (bbdb-search-prompt "Search records with phone %m regexp: ") + current-prefix-arg)) + (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))) + (bbdb-display-records + (bbdb-search (bbdb-records) nil nil nil nil string)))) + +;;;###autoload +(defun bbdb-changed (elidep) + "Display all entries in the bbdb database which have been changed since +the database was last saved." + (interactive "P") + (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)) + (changed-records (bbdb-with-db-buffer bbdb-changed-records))) + (if (bbdb-search-invert-p) + (let ((recs (bbdb-records)) + unchanged-records + r) + (while recs + (setq r (car recs) + recs (cdr recs)) + (when (not (member r changed-records)) + (setq changed-records (delete r changed-records) + unchanged-records (cons r unchanged-records)))) + (bbdb-display-records unchanged-records)) + (bbdb-display-records changed-records)))) + +(defun bbdb-display (records) + "Prompts for and displays a single record (this is faster than searching.)" + (interactive (list (bbdb-completing-read-record "Display record of: "))) + (bbdb-display-records records)) + +(defun bbdb-display-some (function) + "Display records according to FUNCTION. FUNCTION is called with one +argument, the record, and should return nil if the record is not to be +displayed. If the record is to be displayed, it (the record) should +be returned." + (bbdb-display-records (delq nil (mapcar function (bbdb-records))))) + +;;; fancy redisplay + +;;;###autoload +(defun bbdb-redisplay-records () + "Regrinds the contents of the *BBDB* buffer, without scrolling. +If possible, you should call `bbdb-redisplay-one-record' instead." + (let ((p (point)) + (m (condition-case nil (mark) (error nil)))) + (goto-char (window-start)) + (let ((p2 (point))) + (bbdb-display-records-1 bbdb-records) + (goto-char p2) + (if m (set-mark m))) + (recenter 0) + (goto-char p) + (save-excursion + (run-hooks 'bbdb-list-hook)))) + +(defun bbdb-redisplay-one-record (record &optional record-cons next-record-cons + delete-p) + "Regrind one record. The *BBDB* buffer must be current when this is called." + (bbdb-debug (if (not (eq (not (not delete-p)) + (not (not (bbdb-record-deleted-p record))))) + (error "splorch."))) + (if (null record-cons) (setq record-cons (assq record bbdb-records))) + (if (null next-record-cons) + (setq next-record-cons (car (cdr (memq record-cons bbdb-records))))) + (if (null record-cons) + (bbdb-display-records (list record) nil t) + (let ((position (point)) + (marker (nth 2 record-cons)) + next-marker + (buffer-read-only nil)) + (bbdb-debug + (if (null record-cons) (error "doubleplus ungood: record unexists!")) + (if (null marker) (error "doubleplus ungood: marker unexists!"))) + (beginning-of-line) + (goto-char marker) + (remove-text-properties marker (or (nth 2 next-record-cons) (point-max)) + '(bbdb-field nil)) + (if delete-p nil + (bbdb-format-record (car record-cons) (car (cdr record-cons)))) + (setq next-marker (or (nth 2 next-record-cons) (point-max))) + (delete-region (point) next-marker) + (if (< position next-marker) + (goto-char position)) + + (if (and bbdb-gui (not delete-p)) + (bbdb-fontify-buffer (list record-cons + ;; the record ends here + (list nil nil next-marker)))) + (save-excursion + (run-hooks 'bbdb-list-hook))))) + +;;; Parsing phone numbers +;;; XXX this needs expansion to handle international prefixes properly +;;; i.e. +353-number without discarding the +353 part. Problem being +;;; that this will necessitate yet another change in the database +;;; format for people who are using north american numbers. + + +(defconst bbdb-phone-area-regexp "(?[ \t]*\\+?1?[ \t]*[-\(]?[ \t]*[-\(]?[ \t]*\\([2-9][0-9][0-9]\\)[ \t]*)?[-./ \t]*") +(defconst bbdb-phone-main-regexp "\\([1-9][0-9][0-9]\\)[ \t]*[-.]?[ \t]*\\([0-9][0-9][0-9][0-9]\\)[ \t]*") + +(defconst bbdb-phone-ext-regexp "x?[ \t]*\\([0-9]+\\)[ \t]*") + +(defconst bbdb-phone-regexp-1 (concat "^[ \t]*" bbdb-phone-area-regexp bbdb-phone-main-regexp bbdb-phone-ext-regexp "$")) +(defconst bbdb-phone-regexp-2 (concat "^[ \t]*" bbdb-phone-area-regexp bbdb-phone-main-regexp "$")) +(defconst bbdb-phone-regexp-3 (concat "^[ \t]*" bbdb-phone-main-regexp bbdb-phone-ext-regexp "$")) +(defconst bbdb-phone-regexp-4 (concat "^[ \t]*" bbdb-phone-main-regexp "$")) +(defconst bbdb-phone-regexp-5 (concat "^[ \t]*" bbdb-phone-ext-regexp "$")) + +(defun bbdb-parse-phone-number (string &optional number-type) + "Parse a phone number from STRING and return a list of integers the form +\(area-code exchange number) or (area-code exchange number extension). +This is both lenient and strict in what it will parse - whitespace may +appear (or not) between any of the groups of digits, parentheses around the +area code are optional, as is a dash between the exchange and number, and +a '1' preceeding the area code; but there must be three digits in the area +code and exchange, and four in the number (if they are present). An error +will be signalled if unparsable. All of these are unambigously parsable: + + ( 415 ) 555 - 1212 x123 -> (415 555 1212 123) + (415)555-1212 123 -> (415 555 1212 123) + (1-415) 555-1212 123 -> (415 555 1212 123) + 1 (415)-555-1212 123 -> (415 555 1212 123) + 555-1212 123 -> (0 555 1212 123) + 555 1212 -> (0 555 1212) + 415 555 1212 -> (415 555 1212) + 1 415 555 1212 -> (415 555 1212) + 5551212 -> (0 555 1212) + 4155551212 -> (415 555 1212) + 4155551212123 -> (415 555 1212 123) + 5551212x123 -> (0 555 1212 123) + 1234 -> (0 0 0 1234) + +Note that \"4151212123\" is ambiguous; it could be interpreted either as +\"(415) 121-2123\" or as \"415-1212 x123\". + +\(And uh, oh yeah, this does little if `bbdb-north-american-phone-numbers-p' +is nil...\)" + + (cond ((if number-type + (eq number-type 'euro) + (not bbdb-north-american-phone-numbers-p)) + (list (bbdb-string-trim string))) + ((string-match bbdb-phone-regexp-1 string) + ;; (415) 555-1212 x123 + (list (bbdb-subint string 1) (bbdb-subint string 2) + (bbdb-subint string 3) (bbdb-subint string 4))) + ((string-match bbdb-phone-regexp-2 string) + ;; (415) 555-1212 + (list (bbdb-subint string 1) (bbdb-subint string 2) + (bbdb-subint string 3))) + ((string-match bbdb-phone-regexp-3 string) + ;; 555-1212 x123 + (list 0 (bbdb-subint string 1) (bbdb-subint string 2) + (bbdb-subint string 3))) + ((string-match bbdb-phone-regexp-4 string) + ;; 555-1212 + (list 0 (bbdb-subint string 1) (bbdb-subint string 2))) + ((string-match bbdb-phone-regexp-5 string) + ;; x123 + (list 0 0 0 (bbdb-subint string 1))) + (t (error "phone number unparsable.")))) + +;;; Parsing other things + +(defcustom bbdb-expand-mail-aliases t + "If non-nil, expand mail aliases in `bbdb-complete-name'." + :group 'bbdb-record-use + :type 'boolean) + +(defcustom bbdb-check-zip-codes-p t + "If non-nil, require legal zip codes when entering an address. +The format of legal zip codes is determined by the variable +`bbdb-legal-zip-codes'." + :group 'bbdb-record-creation + :type 'boolean) + +(defcustom bbdb-legal-zip-codes + '(;; empty string + "^$" + ;; Matches 1 to 6 digits. + "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$" + ;; Matches 5 digits and 3 or 4 digits. + "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[ \t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$" + ;; Match zip codes for Canada, UK, etc. (result is ("LL47" "U4B")). + "^[ \t\n]*\\([A-Za-z0-9]+\\)[ \t\n]+\\([A-Za-z0-9]+\\)[ \t\n]*$" + ;; Match zip codes for continental Europe. Examples "CH-8057" + ;; or "F - 83320" (result is ("CH" "8057") or ("F" "83320")). + ;; Support for "NL-2300RA" added at request from Carsten Dominik + ;; <dominik@astro.uva.nl> + "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+ ?[A-Z]*\\)[ \t\n]*$" + ;; Match zip codes from Sweden where the five digits are grouped 3+2 + ;; at the request from Mats Lofdahl <MLofdahl@solar.stanford.edu>. + ;; (result is ("SE" (133 36))) + "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+\\)[ \t\n]+\\([0-9]+\\)[ \t\n]*$") + "List of regexps that match legal zip codes. +Whether this is used at all depends on the variable `bbdb-check-zip-codes-p'." + :group 'bbdb-record-creation + :type '(repeat regexp)) + +(defun bbdb-parse-zip-string (string) + "Check whether STRING is a legal zip code. +Do this only if `bbdb-check-zip-codes-p' is non-nil." + (if (and bbdb-check-zip-codes-p + (not (memq t (mapcar (lambda (regexp) + ;; if it matches, (not (not index-of-match)) returns t + (not (not (string-match regexp string)))) + bbdb-legal-zip-codes)))) + (error "not a valid zip code.") + string)) + +(defun bbdb-read-new-record () + "Prompt for and return a completely new BBDB record. +Doesn't insert it in to the database or update the hashtables, but does +ensure that there will not be name collisions." + (bbdb-records) ; make sure database is loaded + (if bbdb-readonly-p + (error "The Insidious Big Brother Database is read-only.")) + (let (firstname lastname) + (bbdb-error-retry + (progn + (if current-prefix-arg + (setq firstname (bbdb-read-string "First Name: ") + lastname (bbdb-read-string "Last Name: ")) + (let ((names (bbdb-divide-name (bbdb-read-string "Name: ")))) + (setq firstname (car names) + lastname (nth 1 names)))) + (if (string= firstname "") (setq firstname nil)) + (if (string= lastname "") (setq lastname nil)) + (if (and bbdb-no-duplicates-p + (bbdb-gethash (bbdb-build-name firstname lastname))) + (error "%s %s is already in the database" + (or firstname "") (or lastname ""))))) + (let ((company (bbdb-read-string "Company: ")) + (net (bbdb-split (bbdb-read-string "Network Address: ") ",")) + (addrs + (let (L L-tail str addr) + (while (not (string= + "" + (setq str + (bbdb-read-string + "Address Description [RET when no more]: " + "" + (mapcar (function (lambda(x) (list x))) + (bbdb-label-completion-list + "addresses")))))) + (setq addr (make-vector bbdb-address-length nil)) + (bbdb-record-edit-address addr str) + (if L + (progn (setcdr L-tail (cons addr nil)) + (setq L-tail (cdr L-tail))) + (setq L (cons addr nil) + L-tail L))) + L)) + (phones + (let (L L-tail str) + (while (not (string= + "" + (setq str + (bbdb-read-string + "Phone Location [RET when no more]: " + "" + (mapcar (function (lambda(x) (list x))) + (bbdb-label-completion-list + "phones")))))) + (let* ((phonelist + (bbdb-error-retry + (bbdb-parse-phone-number + (read-string "Phone: " + (and (integerp bbdb-default-area-code) + (format "(%03d) " + bbdb-default-area-code)))))) + (phone (apply 'vector str + (if (= 3 (length phonelist)) + (nconc phonelist '(0)) + phonelist)))) + (if L + (progn (setcdr L-tail (cons phone nil)) + (setq L-tail (cdr L-tail))) + (setq L (cons phone nil) + L-tail L)))) + L)) + (notes (bbdb-read-string "Additional Comments: "))) + (if (string= company "") (setq company nil)) + (if (string= notes "") (setq notes nil)) + (let ((record + (vector firstname lastname nil company phones addrs net notes + (make-vector bbdb-cache-length nil)))) + record)))) + +;;;###autoload +(defun bbdb-create (record) + "Add a new entry to the bbdb database ; prompts for all relevant info +using the echo area, inserts the new record in the db, sorted alphabetically, +and offers to save the db file. DO NOT call this from a program. Call +bbdb-create-internal instead." + (interactive (list (bbdb-read-new-record))) + (bbdb-invoke-hook 'bbdb-create-hook record) + (bbdb-change-record record t) + (bbdb-display-records (list record))) + + +(defmacro bbdb-check-type (place predicate) + (list 'while (list 'not (list predicate place)) + (nconc (cond ((eq (car-safe place) 'aref) + (list 'aset (nth 1 place) (nth 2 place))) + ((eq (car-safe place) 'car) + (list 'setcar (nth 1 place))) + ((eq (car-safe place) 'cdr) + (list 'setcdr (nth 1 place))) + (t (list 'setq place))) + (list + (list 'signal ''wrong-type-argument + (list 'list (list 'quote predicate) place)))))) + +(defun bbdb-create-internal (name company net addrs phones notes) + "Adds a record to the database; this function does a fair amount of +error-checking on the passed in values, so it's safe to call this from +other programs. + +NAME is a string, the name of the person to add. An error is signalled +if that name is already in use and `bbdb-no-duplicates-p' is t. +COMPANY is a string or nil. +NET is a comma-separated list of email addresses, or a list of strings. +An error is signalled if that name is already in use. +ADDRS is a list of address objects. An address is a vector of the form + [\"location\" (\"line1\" \"line2\" ... ) \"City\" \"State\" \"Zip\" \"Country\"]. +PHONES is a list of phone-number objects. A phone-number is a vector of +the form + [\"location\" areacode prefix suffix extension-or-nil] +or + [\"location\" \"phone-number\"] +NOTES is a string, or an alist associating symbols with strings." + (let (firstname lastname aka) + (while (and (progn + (setq name (and name (bbdb-divide-name name)) + firstname (car name) + lastname (nth 1 name)) + (bbdb-gethash (bbdb-build-name firstname lastname))) + bbdb-no-duplicates-p) + (setq name (signal 'error + (list (format "%s %s is already in the database" + (or firstname "") (or lastname "")))))) + (and company (bbdb-check-type company stringp)) + (if (stringp net) + (setq net (bbdb-split net ","))) + (if bbdb-no-duplicates-p + (let ((rest net)) + (while rest + (while (bbdb-gethash (downcase (car rest))) + (setcar rest + (signal 'error (list (format + "%s is already in the database" + (car rest)))))) + (setq rest (cdr rest))))) + (setq addrs + (mapcar + (lambda (addr) + (while (or (not (vectorp addr)) + (/= (length addr) bbdb-address-length)) + (setq addr (signal 'wrong-type-argument (list 'vectorp addr)))) + (bbdb-check-type (aref addr 0) stringp) ;;; XXX use bbdb-addresses + (bbdb-check-type (aref addr 1) listp) + (bbdb-check-type (aref addr 2) stringp) + (bbdb-check-type (aref addr 3) stringp) + (bbdb-check-type (aref addr 4) stringp) + (bbdb-check-type (aref addr 5) stringp) + addr) + addrs)) + (setq phones + (mapcar + (lambda (phone) + (while (or (not (vectorp phone)) + (and (/= (length phone) 2) + (/= (length phone) bbdb-phone-length))) + (setq phone + (signal 'wrong-type-argument (list 'vectorp phone)))) + (bbdb-check-type (aref phone 0) stringp) + (if (= 2 (length phone)) + (bbdb-check-type (aref phone 1) stringp) + (bbdb-check-type (aref phone 1) integerp) + (bbdb-check-type (aref phone 2) integerp) + (bbdb-check-type (aref phone 3) integerp) + (and (aref phone 4) (bbdb-check-type (aref phone 4) integerp)) + (if (eq 0 (aref phone 4)) (aset phone 4 nil))) + phone) + phones)) + (or (stringp notes) + (setq notes + (mapcar (lambda (note) + (bbdb-check-type note consp) + (bbdb-check-type (car note) symbolp) + (if (consp (cdr note)) + (setq note (cons (car note) (car (cdr note))))) + (bbdb-check-type (cdr note) stringp) + note) + notes))) + (let ((record + (vector firstname lastname aka company phones addrs net notes + (make-vector bbdb-cache-length nil)))) + (bbdb-invoke-hook 'bbdb-create-hook record) + (bbdb-change-record record t) + record))) + + +;;; bbdb-mode stuff + +(defun bbdb-current-record (&optional planning-on-modifying) + "Returns the record which the point is point at. In linear time, man..." + (if (and planning-on-modifying bbdb-readonly-p) + (error "The Insidious Big Brother Database is read-only.")) + (if (not (equal bbdb-buffer-name (buffer-name (current-buffer)))) + (error "this command only works while in the \"%s\" buffer." + bbdb-buffer-name)) + (let ((p (point)) + (rest bbdb-records) + (rec nil)) + (while (and (cdr rest) (not rec)) + (if (> (nth 2 (car (cdr rest))) p) + (setq rec (car (car rest)))) + (setq rest (cdr rest))) + (or rec (car (car rest))))) + + +;; yow, are we object oriented yet? +(defun bbdb-record-get-field-internal (record field) + (cond ((eq field 'name) (bbdb-record-name record)) + ((eq field 'net) (bbdb-record-net record)) + ((eq field 'aka) (bbdb-record-aka record)) + ((eq field 'phone) (bbdb-record-phones record)) + ((eq field 'address) (bbdb-record-addresses record)) + ((eq field 'property) (bbdb-record-raw-notes record)) + (t (error "doubleplus ungood: unknown field type %s" field)))) + +(defun bbdb-record-store-field-internal (record field value) + (cond ((eq field 'name) (error "doesn't work on names")) + ((eq field 'net) (bbdb-record-set-net record value)) + ((eq field 'aka) (bbdb-record-set-aka record value)) + ((eq field 'phone) (bbdb-record-set-phones record value)) + ((eq field 'address) (bbdb-record-set-addresses record value)) + ((eq field 'property) (bbdb-record-set-raw-notes record value)) + (t (error "doubleplus ungood: unknown field type %s" field)))) + +(defun bbdb-record-edit-field-internal (record field &optional which location) + (cond ((eq field 'name) (bbdb-record-edit-name record)) + ((eq field 'company) (bbdb-record-edit-company record)) + ((eq field 'net) (bbdb-record-edit-net record)) + ((eq field 'aka) (bbdb-record-edit-aka record)) + ((eq field 'phone) (bbdb-record-edit-phone which location)) + ((eq field 'address) (bbdb-record-edit-address which location)) + ((eq field 'property) (bbdb-record-edit-property record (car which))) + (t (error "doubleplus ungood: unknown field type %s" field)))) + + +(defun bbdb-current-field (&optional planning-on-modifying) + (or (bbdb-current-record planning-on-modifying) + (error "unperson")) + (delete 'field-name (get-text-property (point) 'bbdb-field))) + +;;;###autoload +(defun bbdb-apply-next-command-to-all-records () + "Typing \\<bbdb-mode-map>\\[bbdb-apply-next-command-to-all-records] \ +in the *BBDB* buffer makes the next command operate on all +of the records currently displayed. \(Note that this only works for +certain commands.\)" + (interactive) + (message (substitute-command-keys + "\\<bbdb-mode-map>\\[bbdb-apply-next-command-to-all-records] - ")) + (setq prefix-arg current-prefix-arg + last-command this-command) + nil) + +(defmacro bbdb-do-all-records-p () + "Whether the last command was `bbdb-apply-next-command-to-all-records'." + '(eq last-command 'bbdb-apply-next-command-to-all-records)) + + +(defvar bbdb-append-records nil) + +;;;###autoload +(defun bbdb-append-records-p () + (cond ((eq t bbdb-append-records)) + ((numberp bbdb-append-records) + (setq bbdb-append-records + (1- bbdb-append-records)) + (when (= 0 bbdb-append-records) + (when (not bbdb-silent-running) + (message "No further search results will be appended.") + (sit-for 2)) + (setq bbdb-append-records nil)) + t) + (bbdb-append-records + (setq bbdb-append-records nil) + t) + (t nil))) + +;;;###autoload +(defun bbdb-append-records (arg) + "Typing \\<bbdb-mode-map>\\[bbdb-append-records] \ +in the *BBDB* buffer makes the next search/display command to append +new records to those in the *BBDB* buffer. + +With an prefix arg (C-u) toggle between always append and no append. +With an prefix arg that is a positive number append will be enabled for that +many times. +With any other argument append will be enabled once." + (interactive "P") + (message (substitute-command-keys + "\\<bbdb-mode-map>\\[bbdb-append-records] - ")) + (setq bbdb-append-records + (cond ((and arg (listp arg)) + (if (not bbdb-silent-running) + (if (not bbdb-append-records) + (message "Always append records.") + (message "Do not append records."))) + (not bbdb-append-records)) + ((and (numberp arg) (< 1 arg)) + (if (not bbdb-silent-running) + (message "Append records for the next %d times." arg)) + arg) + (t 'once)))) + +;;;###autoload +(defun bbdb-insert-new-field (record name contents) + "Add a new field to the current record; the field type and contents +are prompted for if not supplied. + +If you are inserting a new phone-number field, you can control whether +it is a north american or european phone number by providing a prefix +argument. A prefix arg of ^U means it's to be a euronumber, and any +other prefix arg means it's to be a a structured north american number. +Otherwise, which style is used is controlled by the variable +`bbdb-north-american-phone-numbers-p'. + +If you are inserting a new net address, you can have BBDB append a +default domain to any net address that does not contain one. Set +`bbdb-default-domain' to a string such as \"mycompany.com\" (or, +depending on your environment, (getenv \"DOMAINNAME\")), and +\"@mycompany.com\" will be appended to an address that is entered as +just a username. A prefix arg of ^U (or a `bbdb-default-domain' +value of \"\", the default) means do not alter the address." + (interactive (let ((record (or (bbdb-current-record t) + (error "current record unexists!"))) + (name "") + (completion-ignore-case t)) + (while (string= name "") + (setq name + (downcase + (completing-read "Insert Field: " + (append '(("phone") ("address") + ("net") ("AKA") ("notes")) + (bbdb-propnames)) + nil + nil ; used to be t + nil)))) + (setq name (intern name)) + (list record name (bbdb-prompt-for-new-field-value name)))) + (if (null contents) + (setq contents (bbdb-prompt-for-new-field-value name))) + + (cond ((eq name 'phone) + (bbdb-record-set-phones record + (nconc (bbdb-record-phones record) + (list contents)))) + ((eq name 'address) + (bbdb-record-set-addresses record + (nconc (bbdb-record-addresses record) + (list contents)))) + ((eq name 'net) + (if (bbdb-record-net record) + (error "There already are net addresses!")) + (if (stringp contents) + (setq contents (bbdb-split contents ","))) + ;; first detect any conflicts.... + (if bbdb-no-duplicates-p + (let ((nets contents)) + (while nets + (let ((old (bbdb-gethash (downcase (car nets))))) + (if (and old (not (eq old record))) + (error "net address \"%s\" is used by \"%s\"" + (car nets) + (or (bbdb-record-name old) + (car (bbdb-record-net old)))))) + (setq nets (cdr nets))))) + ;; then store. + (let ((nets contents)) + (while nets + (bbdb-puthash (downcase (car nets)) record) + (setq nets (cdr nets)))) + (bbdb-record-set-net record contents)) + ((eq name 'aka) + (if (bbdb-record-aka record) + (error "there already are alternate names!")) + (if (stringp contents) + (setq contents (bbdb-split contents ";"))) + ;; first detect any conflicts.... + (if bbdb-no-duplicates-p + (let ((aka contents)) + (while aka + (let ((old (bbdb-gethash (downcase (car aka))))) + (if (and old (not (eq old record))) + (error "alternate name \"%s\" is used by \"%s\"" + (car aka) + (or (bbdb-record-name old) + (car (bbdb-record-net old)))))) + (setq aka (cdr aka))))) + ;; then store. + (let ((aka contents)) + (while aka + (bbdb-puthash (downcase (car aka)) record) + (setq aka (cdr aka)))) + (bbdb-record-set-aka record contents)) + ((eq name 'notes) + (if (bbdb-record-notes record) (error "there already are notes!")) + (bbdb-record-set-notes record contents)) + ((assoc (symbol-name name) (bbdb-propnames)) + (if (and (consp (bbdb-record-raw-notes record)) + (assq name (bbdb-record-raw-notes record))) + (error "there is already a \"%s\" note!" name)) + (bbdb-record-putprop record name contents)) + (t (error "doubleplus ungood: unknow how to set slot %s" name))) + (bbdb-change-record record nil) +; (bbdb-offer-save) + (let ((bbdb-display-layout nil)) + (bbdb-redisplay-one-record record))) + +(defun bbdb-prompt-for-new-field-value (name) + (cond ((eq name 'net) + (let + ((n (bbdb-read-string "Net: "))) + (if (string-match "^mailto:" n) + (setq n (substring n (match-end 0)))) + (if (or (eq nil bbdb-default-domain) + current-prefix-arg (string-match "[@%!]" n)) + n + (concat n "@" bbdb-default-domain)))) + ((eq name 'aka) (bbdb-read-string "Alternate Names: ")) + ((eq name 'phone) + (let ((p (make-vector + (if (if current-prefix-arg + (numberp current-prefix-arg) + bbdb-north-american-phone-numbers-p) + bbdb-phone-length + 2) + 0))) + (aset p 0 nil) + (aset p 1 + (if (= bbdb-phone-length (length p)) + (if (integerp bbdb-default-area-code) + bbdb-default-area-code + 0) + nil)) + (bbdb-record-edit-phone p) + p)) + ((eq name 'address) + (let ((a (make-vector bbdb-address-length nil))) + (bbdb-record-edit-address a) + a)) + ((eq name 'notes) (bbdb-read-string "Notes: ")) + ((assoc (symbol-name name) (bbdb-propnames)) + (bbdb-read-string (format "%s: " name))) + (t + (if (bbdb-y-or-n-p + (format "\"%s\" is an unknown field name. Define it? " name)) + (bbdb-set-propnames + (append (bbdb-propnames) (list (list (symbol-name name))))) + (error "unknown field \"%s\"" name)) + (bbdb-read-string (format "%s: " name))))) + +(defun bbdb-add-new-field (name) + "Programmatically add a new field called NAME. Returns the list of propnames." + ;; check that we don't have one already; if we do, return quietly. + (if (assoc (symbol-name name) (append '(("phone") ("address") ("net") + ("AKA") ("notes")) + (bbdb-propnames))) + bbdb-propnames + (bbdb-set-propnames (append (bbdb-propnames) + (list (list (symbol-name name))))))) + +;;;###autoload +(defun bbdb-edit-current-field () + "Edit the contents of the Insidious Big Brother Database field displayed on +the current line (this is only meaningful in the \"*BBDB*\" buffer.) If the +cursor is in the middle of a multi-line field, such as an address or comments +section, then the entire field is edited, not just the current line." + (interactive) + ;; when at the end of the line take care of it + (if (and (eolp) (not (bobp)) (not (bbdb-current-field t))) + (backward-char 1)) + + (let* ((record (bbdb-current-record t)) + (field (bbdb-current-field t)) + need-to-sort) + (or field (error "on an unfield")) + (setq need-to-sort + (apply 'bbdb-record-edit-field-internal record field)) + (bbdb-change-record record need-to-sort) + (bbdb-redisplay-one-record record) + ;; (bbdb-offer-save) + (if (and (eq 'property (car field)) + (or (eq 'mail-alias (caadr field)) + (eq 'net (caadr field)))) + (setq bbdb-define-all-aliases-needs-rebuilt 'edit)) + )) + +(defun bbdb-record-edit-name (bbdb-record) + (let (fn ln co need-to-sort new-name old-name) + (bbdb-error-retry + (progn + (if current-prefix-arg + (setq fn (bbdb-read-string "First Name: " + (bbdb-record-firstname bbdb-record)) + ln (bbdb-read-string "Last Name: " + (bbdb-record-lastname bbdb-record))) + (let ((names (bbdb-divide-name + (bbdb-read-string "Name: " + (bbdb-record-name bbdb-record))))) + (setq fn (car names) + ln (nth 1 names)))) + (setq need-to-sort + (or (not (string= fn + (or (bbdb-record-firstname bbdb-record) ""))) + (not (string= ln + (or (bbdb-record-lastname bbdb-record) ""))))) + (if (string= "" fn) (setq fn nil)) + (if (string= "" ln) (setq ln nil)) + ;; check for collisions + (setq new-name (if (and fn ln) (concat fn " " ln) + (or fn ln)) + old-name (bbdb-record-name bbdb-record)) + (if (and bbdb-no-duplicates-p + new-name + (not (and old-name (string= (downcase new-name) + (downcase old-name)))) + (bbdb-gethash (downcase new-name))) + (error "%s is already in the database!" new-name)))) + (setq co (bbdb-read-string "Company: " + (bbdb-record-company bbdb-record))) + (if (string= "" co) (setq co nil)) + (setq need-to-sort + (or need-to-sort + (not (equal (if co (downcase co) "") + (downcase (or (bbdb-record-company bbdb-record) + "")))))) + ;; + ;; delete the old hash entry + (let ((name (bbdb-record-name bbdb-record)) + (lfname (bbdb-record-lfname bbdb-record)) + (company (bbdb-record-company bbdb-record))) + (if (> (length name) 0) + (bbdb-remhash (downcase name) bbdb-record)) + (if (> (length lfname) 0) + (bbdb-remhash (downcase lfname) bbdb-record)) + (if (> (length company) 0) + (bbdb-remhash (downcase company) bbdb-record))) + (bbdb-record-set-namecache bbdb-record nil) + (bbdb-record-set-firstname bbdb-record fn) + (bbdb-record-set-lastname bbdb-record ln) + (bbdb-record-set-company bbdb-record co) + ;; add a new hash entry + (when (or fn ln) + (bbdb-puthash (downcase (bbdb-record-name bbdb-record)) + bbdb-record) + (if (and fn ln) + (bbdb-puthash (downcase (bbdb-record-lfname bbdb-record)) + bbdb-record))) + need-to-sort)) + +(defun bbdb-record-edit-company (bbdb-record) + (let ((co (bbdb-read-string "Company: " (bbdb-record-company bbdb-record))) + need-to-sort) + + (if (string= "" co) (setq co nil)) + (setq need-to-sort + (or need-to-sort + (not (equal (if co (downcase co) "") + (downcase (or (bbdb-record-company bbdb-record) + "")))))) + + ;; delete the old hash entry + (let ((company (bbdb-record-company bbdb-record))) + (if (> (length company) 0) + (bbdb-remhash (downcase company) bbdb-record))) + + (bbdb-record-set-company bbdb-record co) + ;; add a new hash entry + (bbdb-puthash (downcase (bbdb-record-name bbdb-record)) + bbdb-record) + + need-to-sort)) + +(defun bbdb-address-edit-default (addr) + "Function to use for address editing. +The sub-fields are queried using the default order and using the +default names. Set `bbdb-address-editing-function' to an alternate +address editing function if you don't like this function. It is +mostly used for US style addresses. + +The sub-fields and the prompts used are: +Street, line n: (nth n street) +City: city +State: state +Zip Code: zip +Country: country" + (let* ((str (let ((l) (s) (n 0)) + (while (not (string= "" (setq s (bbdb-read-string + (format "Street, line %d: " (+ 1 n)) + (nth n (bbdb-address-streets addr)))))) + (setq l (append l (list s))) + (setq n (1+ n))) + l)) + (cty (bbdb-read-string "City: " (bbdb-address-city addr))) + (ste (bbdb-read-string "State: " (bbdb-address-state addr))) + (zip (bbdb-error-retry + (bbdb-parse-zip-string + (bbdb-read-string "Zip Code: " (bbdb-address-zip-string addr))))) + (country (bbdb-read-string "Country: " (or (bbdb-address-country addr) + bbdb-default-country)))) + (bbdb-address-set-streets addr str) + (bbdb-address-set-city addr cty) + (bbdb-address-set-state addr ste) + (bbdb-address-set-zip addr zip) + (if (string= "" (concat cty ste zip country (mapconcat 'identity str ""))) + ;; user didn't enter anything. this causes a display bug. this + ;; is a temporary fix. Ideally, we'd simply discard the entire + ;; address entry, but that's going to require bigger hacking. + (bbdb-address-set-country addr "Emacs") + (bbdb-address-set-country addr country)) + nil)) + +(defun bbdb-address-edit-continental (addr) + "Function to use for address editing. +The sub-fields are queried using the default order and using the +default names. Set `bbdb-address-editing-function' to an alternate +address editing function if you don't like this function. It is +mostly used for US style addresses. + +The sub-fields and the prompts used are: +Street, line n: (nth n street) +City: city +State: state +Zip Code: zip +Country: country" + (let* ((str (let ((l) (s) (n 0)) + (while (not (string= "" (setq s (bbdb-read-string + (format "Street, line %d: " (+ 1 n)) + (nth n (bbdb-address-streets addr)))))) + (setq l (append l (list s))) + (setq n (1+ n))) + l)) + (zip (bbdb-error-retry + (bbdb-parse-zip-string + (bbdb-read-string "Zip Code: " (bbdb-address-zip-string addr))))) + (cty (bbdb-read-string "City: " (bbdb-address-city addr))) + (ste "") + (country (bbdb-read-string "Country: " (or (bbdb-address-country addr) + bbdb-default-country)))) + (bbdb-address-set-streets addr str) + (bbdb-address-set-city addr cty) + (bbdb-address-set-state addr ste) + (bbdb-address-set-zip addr zip) + (if (string= "" (concat cty ste zip country (mapconcat 'identity str ""))) + ;; user didn't enter anything. this causes a display bug. this + ;; is a temporary fix. Ideally, we'd simply discard the entire + ;; address entry, but that's going to require bigger hacking. + (bbdb-address-set-country addr "Emacs") + (bbdb-address-set-country addr country)) + nil)) + +(defcustom bbdb-address-editing-function 'bbdb-address-edit-default + "Function to use for address editing. +The function must accept a BBDB address as parameter and allow the +user to edit it. This variable is called from `bbdb-record-edit-address'. +The default value is the symbol `bbdb-address-edit-default'." + :group 'bbdb-record-creation + :type 'function) + +(defun bbdb-record-edit-address (addr &optional location) + "Edit an address ADDR. +If optional parameter LOCATION is nil, edit the location sub-field +of the address as well. The address itself is edited using the editing +function in `bbdb-address-editing-function'." + (let ((loc + (or location (bbdb-read-string "Location: " + (or (bbdb-address-location addr) + (bbdb-label-completion-default + "addresses")) + (mapcar (function (lambda(x) (list x))) + (bbdb-label-completion-list + "addresses")))))) + (bbdb-address-set-location addr loc)) + (if current-prefix-arg + (bbdb-address-edit-default addr) + (funcall bbdb-address-editing-function addr))) + +(defun bbdb-record-edit-phone (phone-number &optional location) + (let ((newl (or location + (bbdb-read-string "Location: " + (or (bbdb-phone-location phone-number) + (bbdb-label-completion-default + "phones")) + (mapcar (function (lambda(x) (list x))) + (bbdb-label-completion-list + "phones"))))) + (newp (let ((bbdb-north-american-phone-numbers-p + (= (length phone-number) bbdb-phone-length))) + (bbdb-error-retry + (bbdb-parse-phone-number + (read-string "Phone: " (bbdb-phone-string phone-number))))))) + (bbdb-phone-set-location phone-number newl) + (bbdb-phone-set-area phone-number (nth 0 newp)) ; euronumbers too. + (if (= (length phone-number) 2) + nil + (bbdb-phone-set-exchange phone-number (nth 1 newp)) + (bbdb-phone-set-suffix phone-number (nth 2 newp)) + (bbdb-phone-set-extension phone-number (or (nth 3 newp) 0)))) + nil) + +(defun bbdb-record-edit-net (bbdb-record) + (let ((str (bbdb-read-string "Net: " + (mapconcat (function identity) + (bbdb-record-net bbdb-record) + ", ")))) + (let ((oldnets (bbdb-record-net bbdb-record)) + (newnets (bbdb-split str ","))) + ;; first check for any conflicts... + (if bbdb-no-duplicates-p + (let ((rest newnets)) + (while rest + (let ((old (delete bbdb-record (bbdb-gethash (downcase (car rest)))))) + (if old + (error "net address \"%s\" is used by \"%s\"" + (car rest) (mapconcat (lambda (r) (bbdb-record-name r)) + old ", ")))) + (setq rest (cdr rest))))) + ;; then update. + (let ((rest oldnets)) + (while rest + (bbdb-remhash (downcase (car rest)) bbdb-record) + (setq rest (cdr rest)))) + (let ((nets newnets)) + (while nets + (bbdb-puthash (downcase (car nets)) bbdb-record) + (setq nets (cdr nets)))) + (bbdb-record-set-net bbdb-record newnets))) + nil) + +(defun bbdb-record-edit-aka (bbdb-record) + (let ((str (bbdb-read-string "AKA: " + (mapconcat (function identity) + (bbdb-record-aka bbdb-record) + "; ")))) + (let ((oldaka (bbdb-record-aka bbdb-record)) + (newaka (bbdb-split str ";"))) + ;; first check for any conflicts... + (if bbdb-no-duplicates-p + (let ((rest newaka)) + (while rest + (let ((old (bbdb-gethash (downcase (car rest))))) + (if (and old (not (eq old bbdb-record))) + (error "alternate name address \"%s\" is used by \"%s\"" + (car rest) (bbdb-record-name old)))) + (setq rest (cdr rest))))) + ;; then update. + (let ((rest oldaka)) + (while rest + (bbdb-remhash (downcase (car rest)) bbdb-record) + (setq rest (cdr rest)))) + (let ((aka newaka)) + (while aka + (bbdb-puthash (downcase (car aka)) bbdb-record) + (setq aka (cdr aka)))) + (bbdb-record-set-aka bbdb-record newaka))) + nil) + +;;;###autoload +(defun bbdb-record-edit-notes (bbdb-record &optional regrind) + (interactive (list (bbdb-current-record t) t)) + (let ((notes (bbdb-read-string "Notes: " (bbdb-record-notes bbdb-record)))) + (bbdb-record-set-notes bbdb-record (if (string= "" notes) nil notes))) + (if regrind + (save-excursion + (set-buffer bbdb-buffer-name) + (bbdb-redisplay-one-record bbdb-record))) + nil) + +;;;###autoload +(defun bbdb-record-edit-property (bbdb-record &optional prop regrind) + (interactive (list (bbdb-current-record t) nil t)) + (let* ((propnames (bbdb-propnames)) + (propname (if prop (symbol-name prop) + (completing-read + (format "Edit property of %s: " + (bbdb-record-name bbdb-record)) + (cons '("notes") propnames)))) + (propsym (or prop (if (equal "" propname) 'notes (intern propname)))) + (string (bbdb-read-string (format "%s: " propname) + (bbdb-record-getprop bbdb-record propsym)))) + (bbdb-record-putprop bbdb-record propsym + (if (string= "" string) nil string))) + (if regrind + (save-excursion + (set-buffer bbdb-buffer-name) + (bbdb-redisplay-one-record bbdb-record))) + nil) + + +(defsubst bbdb-field-equal (x y) + (if (and (consp x) (consp y)) + (and (eq (car x) (car y)) + (eq (car (cdr x)) (car (cdr y))) + (eq (car (cdr (cdr x))) (car (cdr (cdr y))))) + (eq x y))) + +(defun bbdb-next-field (&optional count planning-on-modifying) + (or count (setq count 1)) + (beginning-of-line) + (let* ((record (bbdb-current-record planning-on-modifying)) + (field (bbdb-current-field planning-on-modifying)) + (next-record record) + (next-field field) + (signum (if (< count 0) -1 1)) + (i 0)) + (if (< count 0) (setq count (- count))) + (if field + (while (and next-field (< i count)) + (while (bbdb-field-equal next-field field) + (forward-line signum) + (setq next-record (bbdb-current-record planning-on-modifying) + next-field (bbdb-current-field planning-on-modifying)) + (or (eq next-record record) + (setq next-field nil))) + (setq i (1+ i)) + (setq field next-field))) + next-field)) + +;;;###autoload +(defun bbdb-transpose-fields (&optional arg) + "This is like the `transpose-lines' command, but it is for BBDB fields. +If the cursor is on a field of a BBDB record, that field and the previous +field will be transposed. + +With argument ARG, takes previous line and moves it past ARG fields. +With argument 0, interchanges field point is in with field mark is in. + +Both fields must be in the same record, and must be of the same basic type +\(that is, you can use this command to change the order in which phone-number +fields are listed, but you can't use it to make an address appear before a +phone number; the order of field types is fixed.\)" + (interactive "p") + (let ((record (bbdb-current-record t)) + moving-field position-after position-before + swap-p type list) + (if (/= arg 0) + (setq moving-field (or (bbdb-next-field -1 t) + (error "no previous field")) + position-after (bbdb-next-field arg t) + position-before (bbdb-next-field (if (< arg 0) -1 1) t)) + ;; if arg is 0, swap fields at point and mark + (setq swap-p t) + (setq position-after (bbdb-current-field)) + (save-excursion + (goto-char (mark)) + (setq moving-field (bbdb-current-field)) + (or (eq record (bbdb-current-record)) (error "not in the same record")))) + (if (< arg 0) + (let ((x position-after)) + (setq position-after position-before + position-before x) + (forward-line 2))) + (setq type (car moving-field)) + (or position-after position-before + (error "that would be out of the record!")) + (or (eq type (car position-after)) + (eq type (car position-before)) + (error "can't transpose fields of different types (%s and %s)" + type (if (eq type (car position-after)) + (car position-before) (car position-after)))) + (or (eq type (car position-after)) (setq position-after nil)) + (or (eq type (car position-before)) (setq position-before nil)) + (setq moving-field (nth 1 moving-field) + position-after (nth 1 position-after) + position-before (nth 1 position-before)) + (cond ((memq type '(name aka net)) + (error "there is only one %s field, so you can't transpose it" + type)) + ((memq type '(phone address property)) + (setq list (bbdb-record-get-field-internal record type))) + (t (error "doubleplus ungood: unknown field %s" type))) + (if swap-p + (let ((rest list)) + (while rest + (cond ((eq (car rest) moving-field) (setcar rest position-after)) + ((eq (car rest) position-after) (setcar rest moving-field))) + (setq rest (cdr rest)))) + (if (eq position-before (car list)) + (setq list (cons moving-field (delq moving-field list))) + (let ((rest list)) + (while (and rest (not (eq position-after (car rest)))) + (setq rest (cdr rest))) + (or rest (error "doubleplus ungood: couldn't reorder list")) + (let ((inhibit-quit t)) + (setq list (delq moving-field list)) + (setcdr rest (cons moving-field (cdr rest))))))) + (bbdb-record-store-field-internal record type list) + (bbdb-change-record record nil) + (bbdb-redisplay-one-record record))) + + +;;;###autoload +(defun bbdb-delete-current-field-or-record (&optional records noprompt) + "Delete the line which the cursor is on; actually, delete the field which +that line represents from the database. If the cursor is on the first line +of a database entry (the name/company line) then the entire entry will be +deleted." + (interactive (list (if (bbdb-do-all-records-p) + (mapcar 'car bbdb-records) + (list (bbdb-current-record))) + current-prefix-arg)) + (let* ((field (bbdb-current-field t)) + (type (car field)) + record + (name (cond ((null field) (error "on an unfield")) + ((eq type 'property) (symbol-name (car (nth 1 field)))) + (t (symbol-name type))))) + (while records + (setq record (car records)) + (if (eq type 'name) + (bbdb-delete-current-record record noprompt) + (if (not (or noprompt + (bbdb-y-or-n-p (format "delete this %s field (of %s)? " + name + (bbdb-record-name record))))) + nil + (cond ((memq type '(phone address)) + (bbdb-record-store-field-internal + record type + (delq (nth 1 field) + (bbdb-record-get-field-internal record type)))) + ((memq type '(net aka)) + (let ((rest (bbdb-record-get-field-internal record type))) + (while rest + (bbdb-remhash (downcase (car rest)) record) + (setq rest (cdr rest)))) + (bbdb-record-store-field-internal record type nil)) + ((eq type 'property) + (bbdb-record-putprop record (car (nth 1 field)) nil)) + (t (error "doubleplus ungood: unknown field type"))) + (bbdb-change-record record nil) + (bbdb-redisplay-one-record record))) + (setq records (cdr records))))) + +;;;###autoload +(defun bbdb-delete-current-record (recs &optional noprompt) + "Delete the entire bbdb database entry which the cursor is within. +Pressing \\<bbdb-mode-map>\\[bbdb-apply-next-command-to-all-records] will +delete all records listed in the BBDB buffer." + (interactive (list (if (bbdb-do-all-records-p) + (mapcar 'car bbdb-records) + (list (bbdb-current-record t))) + current-prefix-arg)) + (if (not (listp recs)) + (setq recs (list recs))) + (while recs + (let ((r (car recs))) + (setq recs (cdr recs)) + (bbdb-debug (if (bbdb-record-deleted-p r) + (error "deleting deleted record"))) + (if (or noprompt + (bbdb-y-or-n-p (format "delete the entire db entry of %s? " + (or (bbdb-record-name r) + (bbdb-record-company r) + (car (bbdb-record-net r)))))) + (let* ((record-cons (assq r bbdb-records)) + (next-record-cons (car (cdr (memq record-cons + bbdb-records))))) + (bbdb-debug (if (bbdb-record-deleted-p r) + (error "deleting deleted record"))) + (bbdb-record-set-deleted-p r t) + (bbdb-delete-record-internal r) + (if (eq record-cons (car bbdb-records)) + (setq bbdb-records (cdr bbdb-records)) + (let ((rest bbdb-records)) + (while (cdr rest) + (if (eq record-cons (car (cdr rest))) + (progn + (setcdr rest (cdr (cdr rest))) + (setq rest nil))) + (setq rest (cdr rest))))) + (bbdb-redisplay-one-record r record-cons next-record-cons t) + (bbdb-with-db-buffer + (setq bbdb-changed-records (delq r bbdb-changed-records))) + ;; (bbdb-offer-save) + ))))) + +(defun bbdb-change-records-state-and-redisplay (desired-state records) + (let (rec) + (while records + (setq rec (car records)) + (unless (eq desired-state (nth 1 rec)) + (setcar (cdr rec) desired-state) + (bbdb-redisplay-one-record (car rec) rec)) + (setq records (cdr records))))) + +;;;###autoload +(defun bbdb-toggle-all-records-display-layout (arg &optional records) + "Show all the fields of all visible records. +Like `bbdb-toggle-records-display-layout' but for all visible records." + (interactive "P") + (if (null records) + (setq records bbdb-records)) + (let* ((record (bbdb-current-record)) + (cons (assq record bbdb-records)) + (current-state (nth 1 cons)) + (layout-alist + (or (delete nil (mapcar (lambda (l) + (if (and (assoc 'toggle l) + (cdr (assoc 'toggle l))) + l)) + bbdb-display-layout-alist)) + bbdb-display-layout-alist)) + (desired-state (assoc current-state layout-alist))) + (setq desired-state + (cond ((eq arg 0) + 'one-line) + ((null current-state) + 'multi-line) + ((null (cdr (memq desired-state layout-alist))) + (caar layout-alist)) + (t + (caadr (memq desired-state layout-alist))))) + (message "Using %S layout" desired-state) + (bbdb-change-records-state-and-redisplay desired-state records))) + +;;;###autoload +(defun bbdb-toggle-records-display-layout (arg) + "Toggle whether the current record is displayed expanded or elided +\(multi-line or one-line display.\) With a numeric argument of 0, the +current record will unconditionally be made elided; with any other argument, +the current record will unconditionally be shown expanded. +\\<bbdb-mode-map> +If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-toggle-records-display-layout]\" is \ +used instead of simply \"\\[bbdb-toggle-records-display-layout]\", then the state of all \ +records will +be changed instead of just the one at point. In this case, an argument +of 0 means that all records will unconditionally be made elided; any other +numeric argument means that all of the records will unconditionally be shown +expanded; and no numeric argument means that the records are made to be in +the opposite state of the record under point." + (interactive "P") + (bbdb-toggle-all-records-display-layout + arg + (if (not (bbdb-do-all-records-p)) + (list (assq (bbdb-current-record) bbdb-records))))) + +;;;###autoload +(defun bbdb-display-all-records-completely + (arg &optional records) + "Show all the fields of all currently displayed records. +The display layout `full-multi-line' is used for this." + (interactive "P") + (if (null records) + (setq records bbdb-records)) + (let* ((record (bbdb-current-record)) + (cons (assq record bbdb-records)) + (current-state (nth 1 cons)) + (desired-state + (cond ((not (eq current-state 'full-multi-line)) + 'full-multi-line) + (t + 'multi-line)))) + (bbdb-change-records-state-and-redisplay desired-state records))) + +;;;###autoload +(defun bbdb-display-record-completely (arg) + "Show all the fields of the current record. +The display layout `full-multi-line' is used for this." + (interactive "P") + (bbdb-display-all-records-completely + arg + (if (not (bbdb-do-all-records-p)) + (list (assq (bbdb-current-record) bbdb-records))))) + +;;;###autoload +(defun bbdb-display-record-with-layout (layout &optional records) + "Show all the fields of the current record using LAYOUT." + (interactive (list (completing-read "Layout: " + (mapcar (lambda (i) + (list (symbol-name (car i)))) + bbdb-display-layout-alist)))) + (when (stringp layout) + (setq layout (intern layout))) + (when (null records) + (setq records bbdb-records)) + (bbdb-change-records-state-and-redisplay layout records)) + +;;;###autoload +(defun bbdb-omit-record (n) + "Remove the current record from the display without deleting it from the +database. With a prefix argument, omit the next N records. If negative, +omit backwards." + (interactive "p") + (while (not (= n 0)) + (if (< n 0) (bbdb-prev-record 1)) + (let* ((record (or (bbdb-current-record) (error "no records"))) + (rest bbdb-records) + cons next prev-tail) + (while rest + (if (eq (car (car rest)) record) + (setq cons (car rest) + next (car (cdr rest)) + rest nil) + (setq prev-tail rest + rest (cdr rest)))) + (or record (error "can't find current record")) + (let ((buffer-read-only nil)) + (delete-region (nth 2 cons) (if next (nth 2 next) (point-max)))) + (if prev-tail + (setcdr prev-tail (cdr (cdr prev-tail))) + (setq bbdb-records (cdr bbdb-records))) + (setq n (if (> n 0) (1- n) (1+ n))))) + (bbdb-frob-mode-line (length bbdb-records))) + +;;; Fixing up bogus entries + +(defcustom bbdb-refile-notes-generate-alist '((creation-date . bbdb-refile-notes-string-least) (timestamp . bbdb-refile-notes-string-most)) + "*An alist defining specific merging function, based on notes field." + :group 'bbdb-noticing-records + :type '(repeat (cons + (symbol :tag "Notes filed") + (hook :tag "Generating function")))) + +(defcustom bbdb-refile-notes-default-merge-function 'bbdb-refile-notes-default-merge-function + "*Default function to use for merging BBDB notes records. + +If the note field has an entry in `bbdb-refile-notes-generate-alist', +that function will be used instead." + :group 'bbdb-noticing-records + :type 'function) + + +(defun bbdb-refile-notes-default-merge-function (string1 string2) + "Returns the concatenation of STRING1 and STRING2" + (concat string1 "\n" string2)) + +(defun bbdb-refile-notes-remove-duplicates (string1 string2) + "Concatenate STRING1 and STRING2, but remove duplicate lines." + (let ((note1 (split-string string1 "\n")) + (note2 (split-string string2 "\n"))) + (while note2 + (if (not (member (car note2) note1)) + (setq note1 (cons (car note2) note1))) + (setq note2 (cdr note2))) + (mapconcat 'identity note1 "\n"))) + +(defun bbdb-refile-notes-string-least (string1 string2) + "Returns the string that is lessp." + (if (string-lessp string1 string2) + string1 + string2)) + +(defun bbdb-refile-notes-string-most (string1 string2) + "Returns the string that is not lessp." + (if (string-lessp string1 string2) + string2 + string1)) + +(defun bbdb-merge-lists! (l1 l2 cmp &optional mod) + "Merge two lists l1 l2 (modifies l1) only adds elements from l2 +if cmp returns false for all elements of l1. If optional mod +is provided it is applied to each element of l1 and l2 prior to cmp" + (if (null l1) + l2 + (let ((end (last l1)) + (src2 l2) + (chk (if mod (mapcar mod l1) (append l1 '())))) + (while src2 + (let ((fail '()) + (src1 chk) + (val (if mod (apply mod (car src2) '()) (car src2)))) + (while src1 + (if (apply cmp (car src1) val '()) + (setq src1 '() + fail 't) + (setq src1 (cdr src1)))) + (if fail '() + (setcdr end (cons (car src2) '())) + (setq end (cdr end))) + (setq src2 (cdr src2)))) + l1))) + +(defun bbdb-merge-records (old-record new-record) + "Merge the contents of old-record into new-record, old-record +remains unchanged. For name and company it queries about which to use +if they differ. All other fields are concatenated. Idealy this would +be better about checking for duplicate entries in other fields, as +well as possibly querying about differing values. + +This function does nothing to ensure the integrity of the rest of the +database, that is somebody elses problem (something like +`bbdb-refile-record')." + (if (or (null new-record) (eq old-record new-record)) + (error "those are the same")) + (let ((new-name (bbdb-record-name new-record)) + (new-co (bbdb-record-company new-record)) + (old-name (bbdb-record-name old-record)) + (old-co (bbdb-record-company old-record)) + (old-nets (bbdb-record-net old-record)) + (old-aka (bbdb-record-aka old-record)) + extra-name) + (let ((name + (cond ((= 0 (length old-name)) + (cons (bbdb-record-firstname new-record) + (bbdb-record-lastname new-record))) + ((= 0 (length new-name)) + (cons (bbdb-record-firstname old-record) + (bbdb-record-lastname old-record))) + ((string-equal (downcase old-name) (downcase new-name)) + (cons (bbdb-record-firstname new-record) + (bbdb-record-lastname new-record))) + (t (prog1 + (if (bbdb-y-or-n-p + (format "Use name \"%s\" instead of \"%s\"? " + old-name new-name)) + (progn + (setq extra-name new-record) + (cons (bbdb-record-firstname old-record) + (bbdb-record-lastname old-record))) + (setq extra-name old-record) + (cons (bbdb-record-firstname new-record) + (bbdb-record-lastname new-record))) + (or (and bbdb-use-alternate-names + (bbdb-y-or-n-p + (format "Keep \"%s\" as an alternate name? " + (bbdb-record-name extra-name)))) + (setq extra-name nil)))))) + (comp (cond ((= 0 (length old-co)) new-co) + ((= 0 (length new-co)) old-co) + ((string-equal old-co new-co) new-co) + (t (if (bbdb-y-or-n-p + (format "Use company \"%s\" instead of \"%s\"? " + old-co new-co)) + old-co new-co))))) + + (if extra-name + (setq old-aka (cons (bbdb-record-name extra-name) old-aka))) + + (bbdb-record-set-phones new-record + (bbdb-merge-lists! + (bbdb-record-phones new-record) + (bbdb-record-phones old-record) + 'equal)) + (bbdb-record-set-addresses new-record + (bbdb-merge-lists! + (bbdb-record-addresses new-record) + (bbdb-record-addresses old-record) + 'equal)) + (bbdb-record-set-company new-record comp) + + (let ((n1 (bbdb-record-raw-notes new-record)) + (n2 (bbdb-record-raw-notes old-record)) + tmp) + (or (equal n1 n2) + (progn + (or (listp n1) (setq n1 (list (cons 'notes n1)))) + (or (listp n2) (setq n2 (list (cons 'notes n2)))) + (while n2 + (if (setq tmp (assq (car (car n2)) n1)) + (setcdr tmp + (funcall + (or (cdr (assq (car (car n2)) + bbdb-refile-notes-generate-alist)) + bbdb-refile-notes-default-merge-function) + (cdr tmp) (cdr (car n2)))) + (setq n1 (nconc n1 (list (car n2))))) + (setq n2 (cdr n2))) + (bbdb-record-set-raw-notes new-record n1)))) + + (bbdb-record-set-firstname new-record (car name)) + (bbdb-record-set-lastname new-record (cdr name)) + (bbdb-record-set-namecache new-record nil) + + (bbdb-record-set-net new-record + (bbdb-merge-lists! + (bbdb-record-net new-record) old-nets + 'string= 'downcase)) + (bbdb-record-set-aka new-record + (bbdb-merge-lists! + (bbdb-record-aka new-record) old-aka + 'string= 'downcase)) + new-record))) + +;;;###autoload +(defun bbdb-refile-record (old-record new-record) + "Merge the current record into some other record; that is, delete the +record under point after copying all of the data within it into some other +record. this is useful if you realize that somehow a redundant record has +gotten into the database, and you want to merge it with another. + +If both records have names and/or companies, you are asked which to use. +Phone numbers, addresses, and network addresses are simply concatenated. +The first record is the record under the point; the second is prompted for. +Completion behaviour is as dictated by the variable `bbdb-completion-type'." + (interactive + (let ((r (bbdb-current-record)) + name) + (setq name (bbdb-record-name r)) + (list r + (if current-prefix-arg + (car (delq r (bbdb-search (bbdb-records) name nil))) + (bbdb-completing-read-one-record + (format "merge record \"%s\" into: " + (or (bbdb-record-name r) (car (bbdb-record-net r)) + "???")) (list r)))))) + + (if (or (null new-record) (eq old-record new-record)) + (error "those are the same")) + (setq new-record (bbdb-merge-records old-record new-record)) + + (bbdb-delete-current-record old-record 'noprompt) + (bbdb-change-record new-record t) ; don't always need-to-sort... + (let ((bbdb-display-layout nil)) + (if (assq new-record bbdb-records) + (bbdb-redisplay-one-record new-record)) + (bbdb-with-db-buffer + (if (not (memq new-record bbdb-changed-records)) + (setq bbdb-changed-records + (cons new-record bbdb-changed-records)))) + (if (null bbdb-records) ; nothing displayed, display something. + (bbdb-display-records (list new-record)))) + (message "records merged.")) + +;; sort the notes +(defcustom bbdb-notes-sort-order + '((notes . 0) (www . 1) (ftp . 2) (gopher . 3) (telnet . 4) (mail-alias . 5) + (mail-folder . 6) (lpr . 7) (creation-date . 1000) (timestamp . 1001)) + "*The order for sorting the notes. +If a note is not in the alist, it is assigned weight 100, so all notes +with weights less then 100 will be in the beginning, and all notes with +weights more than 100 will be in the end." + :group 'bbdb-noticing-records + :type 'list) + +;;;###autoload +(defun bbdb-sort-notes (rec) + "Sort the notes in the record according to `bbdb-notes-sort-order'. +Can be used in `bbdb-change-hook'." + (flet ((kk (nt) (or (cdr (assq (car nt) bbdb-notes-sort-order)) 100))) + (bbdb-record-set-raw-notes + rec (sort (bbdb-record-raw-notes rec) + (lambda (aa bb) (< (kk aa) (kk bb))))))) + +;;;###autoload +(defun bbdb-sort-phones (rec) + "Sort the phones in the record according to the location. +Can be used in `bbdb-change-hook'." + (bbdb-record-set-phones + rec (sort (bbdb-record-phones rec) + (lambda (xx yy) (string< (aref xx 0) (aref yy 0)))))) + +;;;###autoload +(defun bbdb-sort-addresses (rec) + "Sort the addresses in the record according to the location. +Can be used in `bbdb-change-hook'." + (bbdb-record-set-addresses + rec (sort (bbdb-record-addresses rec) + (lambda (xx yy) (string< (aref xx 0) (aref yy 0)))))) + + +;;; Send-Mail interface + +(defcustom bbdb-dwim-net-address-allow-redundancy nil + "*Non-nil means always use full name when sending mail, even if same as net." + :group 'bbdb + :type '(choice (const :tag "Disallow redundancy" nil) + (const :tag "Return only the net" 'netonly) + (const :tag "Allow redundancy" t))) + +(defcustom bbdb-dwim-net-address-title-field 'title + "*Non-nil should by a field to get the title from for prepending it." + :group 'bbdb + :type '(choice (const :tag "Do not append title." nil) + (const :tag "Append content of field 'title" 'title) + (symbol :tag "Field name"))) + +;;;###autoload +(defun bbdb-dwim-net-address (record &optional net) + "Return a string to use as the email address of the given record. +It is formatted like \"Firstname Lastname <addr>\" unless both the first name +and last name are constituents of the address, as in John.Doe@SomeHost, or the +address is already in the form \"Name <foo>\" or \"foo (Name)\", in which case +the address is used as-is. + +If the record has the field 'mail-name it is used instead of the record's name. + +If `bbdb-dwim-net-address-allow-redundancy' is non-nil, the name is always +included. If `bbdb-dwim-net-address-allow-redundancy' is 'netonly the name is +never included! + +A title is prepended from the field `bbdb-dwim-net-address-title-field' if it +exists." + (or net (setq net (car (bbdb-record-net record)))) + (or net (error "record unhas network addresses")) + (let* ((override (bbdb-record-getprop record 'mail-name)) + (name (or override (bbdb-record-name record))) + title + fn ln (i 0)) + (if override + (let ((both (bbdb-divide-name override))) + (setq fn (car both) + ln (car (cdr both))) + (if (equal fn "") (setq fn nil)) + (if (equal ln "") (setq ln nil))) + (setq fn (bbdb-record-firstname record) + ln (bbdb-record-lastname record)) + (if (setq title bbdb-dwim-net-address-title-field + title (if title (bbdb-record-getprop record title))) + (setq name (concat title " " name)))) + ;; if the name contains backslashes or double-quotes, backslash them. + (if name + (while (setq i (string-match "[\\\"]" name i)) + (setq name (concat (substring name 0 i) "\\" (substring name i)) + i (+ i 2)))) + (cond ((eq 'netonly bbdb-dwim-net-address-allow-redundancy) + net) + ((or (null name) + (if (not (or title bbdb-dwim-net-address-allow-redundancy)) + (cond ((and fn ln) + (or (string-match + (concat "\\`[^!@%]*\\b" (regexp-quote fn) + "\\b[^!%@]+\\b" (regexp-quote ln) "\\b") + net) + (string-match + (concat "\\`[^!@%]*\\b" (regexp-quote ln) + "\\b[^!%@]+\\b" (regexp-quote fn) "\\b") + net))) + ((or fn ln) + (string-match + (concat "\\`[^!@%]*\\b" (regexp-quote (or fn ln)) "\\b") + net)))) + ;; already in "foo <bar>" or "bar <foo>" format. + (string-match "\\`[ \t]*[^<]+[ \t]*<" net) + (string-match "\\`[ \t]*[^(]+[ \t]*(" net)) + net) + ;; if the name contains control chars or RFC822 specials, it needs + ;; to be enclosed in quotes. Double-quotes and backslashes have + ;; already been escaped. This quotes a few extra characters as + ;; well (!,%, and $) just for common sense. + ((string-match "[][\000-\037\177()<>@,;:.!$%]" name) + (format "\"%s\" <%s>" name net)) + (t + (format "%s <%s>" name net))))) + + +(defun bbdb-send-mail-internal (&optional to subj records) + (let ((type (or bbdb-send-mail-style + ;; In Emacs, `compose-mail' gets whatever you've + ;; customized as your preferred `mail-user-agent'. + (cond ((fboundp 'compose-mail) 'compose-mail) + ((featurep 'mh-e) 'mh) + ((featurep 'vm) 'vm) + ((featurep 'message) 'message) + ((featurep 'mew) 'mew) + ((featurep 'gnus) 'gnus) + (t 'mail))))) + (cond + ((eq type 'mh) + (or (fboundp 'mh-send) (autoload 'mh-send "mh-e")) + (mh-send to "" (or subj ""))) + ((eq type 'vm) + (cond ((not (fboundp 'vm-mail-internal)) + (load-library "vm") ; 5.32 or later + (or (fboundp 'vm-mail-internal) + (load-library "vm-reply")))) ; 5.31 or earlier + (vm-session-initialization) + (if (not subj) + (vm-mail to) + (vm-mail-internal nil to subj) + (run-hooks 'vm-mail-hook) + (run-hooks 'vm-mail-mode-hook))) + ((eq type 'message) + (or (fboundp 'message-mail) (autoload 'message-mail "message")) + (message-mail to subj)) + ((or (eq type 'mail) (eq type 'rmail)) + (mail nil to subj)) + ((eq type 'mew) + (or (fboundp 'mew-send) (load-library "mew")) + (mew-send to nil subj)) + ((eq type 'compose-mail) + (compose-mail to subj)) + ((eq type 'gnus) + (gnus-msg-mail to subj)) + (t + (error "bbdb-send-mail-style must be vm, mh, message, compose-mail, or rmail"))))) + +;;;###autoload +(defun bbdb-send-mail (bbdb-record &optional subject) + "Compose a mail message to the person indicated by the current bbdb record. +The first (most-recently-added) address is used if there are more than one. +\\<bbdb-mode-map> +If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-send-mail]\" is \ +used instead of simply \"\\[bbdb-send-mail]\", then mail will be sent to \ +all of the +folks listed in the *BBDB* buffer instead of just the person at point." + (interactive (list (if (bbdb-do-all-records-p) + (mapcar 'car bbdb-records) + (bbdb-current-record)))) + (if (consp bbdb-record) + (bbdb-send-mail-many bbdb-record subject) + (bbdb-send-mail-1 bbdb-record subject))) + + +(defun bbdb-send-mail-1 (bbdb-record &optional subject) + (if bbdb-inside-electric-display + (bbdb-electric-throw-to-execute + (list 'bbdb-send-mail bbdb-record subject))) + ;; else... + + (cond ((null bbdb-record) (error "record unexists")) + ((null (bbdb-record-net bbdb-record)) + (error "Current record unhas a network addresses.")) + (t (bbdb-send-mail-internal (bbdb-dwim-net-address bbdb-record) + subject (list bbdb-record)) + (if (re-search-backward "^Subject: $" nil t) (end-of-line))))) + + +(defun bbdb-send-mail-many (records &optional subject) + (if bbdb-inside-electric-display + (bbdb-electric-throw-to-execute + (list 'bbdb-send-mail (list 'quote records) subject))) + ;; else... + + (let ((good '()) (bad '()) + (orec records)) + (while records + (if (bbdb-record-net (car records)) + (setq good (cons (car records) good)) + (setq bad (cons (car records) bad))) + (setq records (cdr records))) + (bbdb-send-mail-internal + (mapconcat (lambda (x) (bbdb-dwim-net-address x)) + (nreverse good) ",\n ") + subject orec) + (if (not bad) nil + (goto-char (point-max)) + (let ((p (point)) + (fill-prefix " ") + (fill-column 70)) + (insert "*** Warning: No net addresses for " + (mapconcat (lambda (x) (bbdb-record-name x)) + (nreverse bad) ", ") ".") + (fill-region-as-paragraph p (point)) + (goto-char p)))) + (if (re-search-backward "^Subject: $" nil t) (end-of-line))) + + +(defun bbdb-yank-addresses () + "CC the people displayed in the *BBDB* buffer on this message. +The primary net-address of each of the records currently listed in the +*BBDB* buffer (whether it is visible or not) will be appended to the +CC: field of the current buffer (assuming the current buffer is a mail +composition buffer.)" + (interactive) + (let ((addrs (save-excursion + (set-buffer bbdb-buffer-name) + (delq nil + (mapcar (lambda (x) + (if (bbdb-record-net (car x)) + (bbdb-dwim-net-address (car x)) + nil)) + bbdb-records))))) + (goto-char (point-min)) + ;; If there's a CC field, move to the end of it, inserting a comma if + ;; there are already addresses present. + ;; Otherwise, if there's an empty To: field, move to the end of it. + ;; Otherwise, insert an empty CC: field. + (if (re-search-forward "^CC:[ \t]*" nil t) + (if (eolp) + nil + (end-of-line) + (while (looking-at "\n[ \t]") + (forward-char) (end-of-line)) + (insert ",\n") + (indent-relative)) + (re-search-forward "^To:[ \t]*") + (if (eolp) + nil + (end-of-line) + (while (looking-at "\n[ \t]") + (forward-char) (end-of-line)) + (insert ",\n") + (indent-relative)) + (if (eolp) + nil + (end-of-line) + (while (looking-at "\n[ \t]") + (forward-char) (end-of-line)) + (insert "\nCC:") + (indent-relative))) + ;; Now insert each of the addresses on its own line. + (while addrs + (insert (car addrs)) + (if (cdr addrs) (progn (insert ",\n") (indent-relative))) + (setq addrs (cdr addrs))))) + +;;;###autoload +(defun bbdb-show-all-recipients () + "*Display BBDB records for all recipients of the message in this buffer." + (interactive) + (let ((marker (bbdb-header-start)) + (fields '("from" "sender" "to" "cc" "bcc" + "resent-from" "resent-to" "resent-cc" "resent-bcc")) + addrs) + (message "Searching...") + (save-excursion + (set-buffer (marker-buffer marker)) + (while fields + (goto-char marker) + (setq addrs (append (bbdb-split (or (bbdb-extract-field-value + (car fields)) + "") + ",") + addrs) + fields (cdr fields)))) + (let ((rest addrs) + (records '()) + record) + (while rest + (setq record (bbdb-annotate-message-sender (car rest) t t t)) + (if record (setq records (cons record records))) + (setq rest (cdr rest))) + (message "Sorting...") + (setq records (sort records (lambda (x y) (bbdb-record-lessp x y)))) + (bbdb-display-records records)))) + + +;;; completion + +;;;###autoload +(defun bbdb-completion-check-record (sym rec) + (let ((name (or (bbdb-record-name rec) + (bbdb-record-company rec) + "")) + (nets (bbdb-record-net rec)) + ok) + + (if (null bbdb-completion-type) + (setq ok 't) + + (if (memq bbdb-completion-type + '(name primary-or-name name-or-primary)) + (setq ok (string= sym (downcase name)))) + + ;; #### handle AKA, mail-name or mail-alias here? + (if ok '() + (when (eq bbdb-completion-type 'net) + (while (and nets (not ok)) + (setq ok (string= sym (downcase (car nets))) + nets (cdr nets)))) + (when (and nets (memq bbdb-completion-type + '(primary primary-or-name name-or-primary))) + (setq ok (string= sym (downcase (car nets))))))) + ok)) + + +;;;###autoload +(defun bbdb-completion-predicate (symbol) + "For use as the third argument to `completing-read'. +Obey the semantics of `bbdb-completion-type'." + (cond ((null bbdb-completion-type) + t) + ((not (boundp symbol)) + nil) + (t + (let ((sym (symbol-name symbol)) + (recs (symbol-value symbol)) + ok) + (while (and recs (not ok)) + (setq ok (bbdb-completion-check-record sym (car recs)) + recs (cdr recs))) + ok)))) + +(defun bbdb-completing-read-record (prompt &optional omit-records) + "Prompt for and return a record from the bbdb. +Completion is done according to `bbdb-completion-type'. If the user +just hits return, nil is returned. Otherwise, a valid response is forced." + (let* ((ht (bbdb-hashtable)) + (completion-ignore-case 't) + (string (completing-read prompt ht 'bbdb-completion-predicate t)) + (symbol (and (not (= 0 (length string))) + (intern-soft string ht)))) + (if symbol + (if (and (boundp symbol) (symbol-value symbol)) + (let ((recs (symbol-value symbol)) ret) + (while recs + (if (and (not (memq (car recs) omit-records)) + (bbdb-completion-check-record (symbol-name symbol) + (car recs))) + (setq ret (cons (car recs) ret))) + (setq recs (cdr recs))) + ret) + (error "selecting deleted (unhashed) record \"%s\"!" symbol)) + nil))) + +(defun bbdb-completing-read-one-record (prompt &optional omit-records) + "Prompt for and return a single record from the bbdb; +completion is done according to `bbdb-completion-type'. If the user +just hits return, nil is returned. Otherwise, a valid response is forced. +if omit-records is non-nil it should be a list of records to dis-allow +completion with." + (let ((records (bbdb-remove-memq-duplicates + (bbdb-completing-read-record prompt omit-records)))) + (cond + ((eq (length records) 1) + (car records)) + ((> (length records) 1) + (let ((count (length records)) + prompts result) + (bbdb-display-records records) + (while (> count 0) + (setq prompts (cons (list (number-to-string count) count) prompts) + count (1- count))) + (setq result + (completing-read (format "Which duplicate record (1-%s): " + (length records)) + prompts nil t "1")) + (nth (1- (string-to-number result)) records))) + (t + nil)))) + +(defvar bbdb-read-addresses-with-completion-map + (let ((map (copy-keymap minibuffer-local-completion-map))) + (define-key map " " 'self-insert-command) + (define-key map "\t" 'bbdb-complete-name) + (define-key map "\M-\t" 'bbdb-complete-name) + map)) + +;;;###autoload +(defun bbdb-read-addresses-with-completion (prompt &optional default) + "Like `read-string', but allows `bbdb-complete-name' style completion." + (read-from-minibuffer prompt default + bbdb-read-addresses-with-completion-map)) + + +;; Internal use. Store the window configuration before we pop up the +;; completion buffer. +(defvar bbdb-complete-name-saved-window-config nil) + +;; Restore the saved window configuration +(defun bbdb-complete-name-cleanup () + (if bbdb-complete-name-saved-window-config + (progn + (if (get-buffer-window "*Completions*") + (progn + (set-window-configuration + bbdb-complete-name-saved-window-config) + (bury-buffer "*Completions*")) + ) + (setq bbdb-complete-name-saved-window-config nil)))) + +(defvar bbdb-complete-name-callback-data nil + "Stores the buffer and region start and end of the completed string. +This is set in the *Completions* buffer. +It is set in `bbdb-display-completion-list' and used in the advice +`choose-completion-string'.") + +(make-variable-buffer-local 'bbdb-complete-name-callback-data) + +(defun bbdb-display-completion-list (list &optional callback data) + "Wrapper for `display-completion-list'. +GNU Emacs requires DATA to be in a specific format, viz. (nth 1 data) should +be a marker for the start of the region being completed." + ;; disgusting hack to make GNU Emacs nuke the bit you've typed + ;; when it inserts the completion. + (setq bbdb-complete-name-callback-data data) + (if (featurep 'xemacs) + (display-completion-list list :activate-callback callback + :user-data data) + (display-completion-list list))) + +(defadvice choose-completion-string (before bbdb-complete-fix activate) + "Deletes the completed string before replacing. +We need to do this as we are abusing completion and it was not meant to work +in buffer other than the mini buffer." + (when bbdb-complete-name-callback-data + (save-excursion + (set-buffer (car bbdb-complete-name-callback-data)) + (apply 'delete-region (cdr bbdb-complete-name-callback-data))))) + +(defcustom bbdb-complete-name-allow-cycling t + "Whether to allow cycling of email addresses when calling +`bbdb-complete-name' on a completed address in a composition buffer." + :group 'bbdb-mua-specific + :type 'boolean) + +(defun bbdb-complete-clicked-name (event extent user-data) + "Find the record for a name clicked in a completion buffer. +Currently only used by XEmacs." + (let ((buffer (nth 0 user-data)) + (bbdb-complete-name-allow-cycling nil) + (beg (nth 1 user-data)) + (end (nth 2 user-data))) + (bbdb-complete-name-cleanup) + (set-buffer buffer) + (goto-char beg) + (delete-region beg end) + (insert (bbdb-extent-string extent)) + (bbdb-complete-name beg))) + + +(defun bbdb-list-overlap (l1 l2) + (let (ok) + (while (and (not ok) l1) + (if (memq (car l1) l2) (setq ok t l1 '()) + (setq l1 (cdr l1)))) + ok)) + +(defun bbdb-remove-assoc-duplicates (l) + (if (null l) '() + (if (assoc (car (car l)) (cdr l)) + (bbdb-remove-assoc-duplicates (cdr l)) + (cons (car l) (bbdb-remove-assoc-duplicates (cdr l)))))) + +(defcustom bbdb-complete-name-hooks nil + "List of functions called after a sucessful completion." + :group 'bbdb-mua-specific + :type 'boolean) + +(eval-when-compile (defvar auto-fill-hook)) + +;;;###autoload +(defun bbdb-complete-name (&optional start-pos) + "Complete the user full-name or net-address before point (up to the +preceeding newline, colon, or comma, or the value of START-POS). If +what has been typed is unique, insert an entry of the form \"User Name +<net-addr>\" (although see documentation for +bbdb-dwim-net-address-allow-redundancy). If it is a valid completion +but not unique, a list of completions is displayed. + +If the completion is done and `bbdb-complete-name-allow-cycling' is +true then cycle through the nets for the matching record. + +When called with a prefix arg then display a list of all nets. + +Completion behaviour can be controlled with `bbdb-completion-type'." + (interactive) + + (let* ((end (point)) + (beg (or start-pos + (save-excursion + (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") + (goto-char (match-end 0)) + (point)))) + (orig (buffer-substring beg end)) + (typed (downcase orig)) + (pattern (bbdb-string-trim typed)) + (ht (bbdb-hashtable)) + ;; make a list of possible completion strings + ;; (all-the-completions), and a flag to indicate if there's a + ;; single matching record or not (only-one-p) + (only-one-p t) + (all-the-completions nil) + (pred + (lambda (sym) + (when (bbdb-completion-predicate sym) + (if (and only-one-p + all-the-completions + (or + ;; not sure about this. more than one record + ;; attached to the symbol? does that happen? + (> (length (symbol-value sym)) 1) + ;; this is the doozy, though. multiple syms + ;; which all match the same record + (delete t (mapcar (lambda(x) + (equal (symbol-value x) + (symbol-value sym))) + all-the-completions)))) + (setq only-one-p nil)) + (if (not (memq sym all-the-completions)) + (setq all-the-completions (cons sym all-the-completions)))))) + (completion (progn (all-completions pattern ht pred) (try-completion pattern ht))) + (exact-match (eq completion t))) + + (cond + ;; No matches found OR you're trying completion on an + ;; already-completed record. In the latter case, we might have to + ;; cycle through the nets for that record. + ((or (null completion) + (and bbdb-complete-name-allow-cycling + exact-match ;; which is a net of the record + (member orig + (bbdb-record-net + (car (symbol-value (intern-soft pattern ht))))))) + ;; Clean up the completion buffer, if it exists + (bbdb-complete-name-cleanup) + ;; Check for cycling + (or (catch 'bbdb-cycling-exit + ;; jump straight out if we're not cycling + (or bbdb-complete-name-allow-cycling + (throw 'bbdb-cycling-exit nil)) + + ;; find the record we're working on. + (let* ((addr (funcall bbdb-extract-address-components-func orig)) + (rec + (if (listp addr) + ;; for now, we're ignoring the case where this + ;; returns more than one record. Ideally, the + ;; last expansion would be stored in a + ;; buffer-local variable, perhaps. + (car (bbdb-search-intertwingle (caar addr) + (cadar addr))) + nil))) + (or rec + (throw 'bbdb-cycling-exit nil)) + + (if current-prefix-arg + ;; use completion buffer + (let ((standard-output (get-buffer-create "*Completions*"))) + ;; a previously existing buffer has to be cleaned first + (save-excursion (set-buffer standard-output) + (setq buffer-read-only nil) + (erase-buffer)) + (display-completion-list + (mapcar (lambda (n) (bbdb-dwim-net-address rec n)) + (bbdb-record-net rec))) + (delete-region beg end) + (switch-to-buffer standard-output)) + ;; use next address + (let* ((addrs (bbdb-record-net rec)) + (this-addr (or (cadr (member (car (cdar addr)) addrs)) + (nth 0 addrs)))) + (if (= (length addrs) 1) + ;; no alternatives. don't signal an error. + (throw 'bbdb-cycling-exit t) + ;; replace with new mail address + (delete-region beg end) + (insert (bbdb-dwim-net-address rec this-addr)) + (run-hooks 'bbdb-complete-name-hooks) + (throw 'bbdb-cycling-exit t)))))) + + ;; FALL THROUGH + ;; Check mail aliases + (if (and bbdb-expand-mail-aliases (expand-abbrev)) + () + (when bbdb-complete-name-hooks + (message "completion for \"%s\" unfound." pattern) + (ding)))));; no matches, sorry! + + ;; Match for a single record. If cycling is enabled then we don't + ;; care too much about the exact-match part. + ((and only-one-p (or exact-match bbdb-complete-name-allow-cycling)) + (let* ((sym (if exact-match (intern-soft pattern ht) (car all-the-completions))) + (recs (symbol-value sym)) + the-net match-recs lst primary matched) + + (while recs + (when (bbdb-record-net (car recs)) + + ;; Did we match on name? + (let ((b-r-name (or (bbdb-record-name (car recs)) ""))) + (if (string= pattern + (substring (downcase b-r-name) 0 + (min (length b-r-name) + (length pattern)))) + (setq match-recs (cons (car recs) match-recs) + matched t))) + + ;; Did we match on lastname? + (let ((b-r-name (or (bbdb-record-lfname (car recs)) ""))) + (if (string= pattern + (substring (downcase b-r-name) 0 + (min (length b-r-name) + (length pattern)))) + (setq match-recs (cons (car recs) match-recs) + matched t))) + + ;; Did we match on aka? + (when (not matched) + (setq lst (bbdb-record-aka (car recs))) + (while lst + (if (string= pattern (substring (downcase (car lst)) 0 + (min (length (downcase + (car + lst))) + (length pattern)))) + (setq match-recs (append match-recs (list (car recs))) + matched t + lst '()) + (setq lst (cdr lst))))) + + ;; Name didn't match name so check net matching + (when (not matched) + (setq lst (bbdb-record-net (car recs))) + (setq primary t) ;; primary wins over secondary... + (while lst + (if (string= pattern (substring (downcase (car lst)) + 0 (min (length + (downcase (car + lst))) + (length pattern)))) + (setq the-net (car lst) + lst nil + match-recs + (if primary (cons (car recs) match-recs) + (append match-recs (list (car recs)))))) + (setq lst (cdr lst) + primary nil)))) + + ;; loop to next rec + (setq recs (cdr recs) + matched nil)) + + (unless match-recs + (error "only exact matching record unhas net field")) + + ;; now replace the text with the expansion + (delete-region beg end) + (insert (bbdb-dwim-net-address (car match-recs) the-net)) + + ;; if we're past fill-column, wrap at the previous comma. + (if (and + (bbdb-auto-fill-function) + (>= (current-column) fill-column)) + (let ((p (point)) + bol) + (save-excursion + (beginning-of-line) + (setq bol (point)) + (goto-char p) + (if (search-backward "," bol t) + (progn + (forward-char 1) + (insert "\n ")))))) + + ;; Update the *BBDB* buffer if desired. + (if bbdb-completion-display-record + (let ((bbdb-gag-messages t)) + (bbdb-display-records-1 match-recs t))) + (bbdb-complete-name-cleanup) + + ;; call the exact-completion hook + (run-hooks 'bbdb-complete-name-hooks))) + + ;; Partial match + ;; note, we can't use the trimmed version of the pattern here or + ;; we'll recurse infinitely on e.g. common first names + ((and (stringp completion) (not (string= typed completion))) + (delete-region beg end) + (insert completion) + (setq end (point)) + (let ((last "") + (bbdb-complete-name-allow-cycling nil)) + (while (and (stringp completion) + (not (string= completion last)) + (setq last completion + pattern (downcase orig) + completion (progn (all-completions pattern ht pred) (try-completion pattern ht)))) + (if (stringp completion) + (progn (delete-region beg end) + (insert completion)))) + (bbdb-complete-name beg))) + + ;; Exact match, but more than one record + (t + (or (eq (selected-window) (minibuffer-window)) + (message "Making completion list...")) + + (let (dwim-completions + uniq nets net name lfname akas) + ;; Now collect all the dwim-addresses for each completion, but only + ;; once for each record! Add it if the net is part of the completions + (bbdb-mapc + (lambda (sym) + (bbdb-mapc + (lambda (rec) + (when (not (member rec uniq)) + (setq uniq (cons rec uniq) + nets (bbdb-record-net rec) + name (downcase (or (bbdb-record-name rec) "")) + lfname (downcase (or (bbdb-record-lfname rec) "")) + akas (mapcar 'downcase (bbdb-record-aka rec))) + (while nets + (setq net (car nets)) + (when (cond + ;; primary + ((and (member bbdb-completion-type + '(primary primary-or-name)) + (member (intern-soft (downcase net) ht) + all-the-completions)) + (setq nets nil) + t) + ;; name + ((and name (member bbdb-completion-type + '(nil name primary-or-name)) + (let ((cname (symbol-name sym))) + (or (string= cname name) + (string= cname lfname) + (member cname akas)))) + (setq name nil) + t) + ;; net + ((and (member bbdb-completion-type + '(nil net)) + (member (intern-soft (downcase net) ht) + all-the-completions))) + ;; (name-or-)primary + ((and (member bbdb-completion-type + '(name-or-primary)) + (let ((cname (symbol-name sym))) + (or (string= cname name) + (string= cname lfname) + (member cname akas)))) + (setq nets nil) + t) + ) + (setq dwim-completions + (cons (bbdb-dwim-net-address rec net) + dwim-completions)) + (if exact-match (setq nets nil))) + (setq nets (cdr nets))))) + (symbol-value sym))) + all-the-completions) + + ;; if, after all that, we've only got one matching record... + (if (and dwim-completions (null (cdr dwim-completions))) + (progn + (delete-region beg end) + (insert (car dwim-completions)) + (message "")) + ;; otherwise, pop up a completions window + (if (not (get-buffer-window "*Completions*")) + (setq bbdb-complete-name-saved-window-config + (current-window-configuration))) + (let ((arg (list (current-buffer) + (set-marker (make-marker) beg) + (set-marker (make-marker) end)))) + (with-output-to-temp-buffer "*Completions*" + (bbdb-display-completion-list + dwim-completions + 'bbdb-complete-clicked-name + arg))) + (or (eq (selected-window) (minibuffer-window)) + (message "Making completion list...done")))))))) + +;;;###autoload +(defun bbdb-yank () + "Insert the current contents of the *BBDB* buffer at point." + (interactive) + (insert (let ((b (current-buffer))) + (set-buffer bbdb-buffer-name) + (prog1 (buffer-string) (set-buffer b))))) + + +;;; interface to mail-abbrevs.el. + +(defcustom bbdb-define-all-aliases-field 'mail-alias + "*The field which `bbdb-define-all-aliases' searches for." + :group 'bbdb + :type 'symbol) + +(defun bbdb-magic-net-* (include &optional exclude primary-only) + "Return list of expanded email addresses matching regexp INCLUDE. +Exclude those matching the regexp EXCLUDE. When PRIMARY-ONLY is t +only work on the primary net of records." + (let ((records (bbdb-records)) + expanded + r n nets) + (while records + (setq r (car records) + nets (bbdb-record-net r)) + (while nets + (setq n (car nets)) + (if (and (not (= (aref n 0) ?\()) + (not (= (aref n 1) ?/)) + (string-match include n) + (or (not exclude) (not (string-match exclude n)))) + (setq expanded (cons (bbdb-dwim-net-address r n) expanded))) + (setq nets (if primary-only nil (cdr nets)))) + (setq records (cdr records))) + expanded)) + +(defun bbdb-magic-net-1 (include &optional exclude) + "Return list of expanded primary nets matching regexp INCLUDE. +Exclude those matching the regexp EXCLUDE." + (bbdb-magic-net-* include exclude t)) + +;(and (pp (bbdb-collect-all-aliases) (get-buffer "*scratch*")) nil) +(defun bbdb-collect-all-aliases () + "Return an alist of (alias (rec1 emails) [(rec2 emails) ...]) elements. +Does the magic alias handling described in `bbdb-define-all-aliases'." + (let* ((aliases-field bbdb-define-all-aliases-field) + (target (cons bbdb-define-all-aliases-field ".")) + (records (bbdb-search (bbdb-records) nil nil nil target)) + nets aliases result) + (dolist (r records) + (setq nets (bbdb-record-net r)) + (if (null nets) + (if (not bbdb-silent-running) + (bbdb-warn + "record %S has no network address, but the aliases: %s" + (bbdb-record-name r) + (bbdb-record-getprop r aliases-field))) + (setq aliases (bbdb-split (bbdb-record-getprop r aliases-field) ",")) + (while aliases + (let* ((alias (car aliases)) + match item) + ;; extract the nets based on the alias + (cond ((string-match "^\\(.+\\)\\*$" alias) + ;; all nets of the record + (setq alias (match-string 1 alias) + item nets)) + ((string-match "^\\(.+\\)\\[\\([0-9]+\\)\\]$" alias) + ;; the NTH net of the record + (setq item (string-to-number (match-string 2 alias)) + item (list (or (nth item nets) + (error + "net[%d] for alias %S does not exist!" + item alias))) + alias (match-string 1 alias))) + ((string-match "^\\(.+\\)/\\(.+\\)$" alias) + ;; all nets of the record matching a regexp + (let ((r (match-string 2 alias))) + (setq alias (match-string 1 alias)) + (setq item (mapcar (lambda (n) + (if (string-match r n) + n)) + nets) + item (delete nil item)))) + (t + (setq item (list (car nets))))) + (when item + (setq item (list r item)) + (if (setq match (assoc alias result)) + (nconc match (cons item nil)) + (setq result (cons (list alias item) result)))) + (setq aliases (cdr aliases)))))) + result)) + +(defun bbdb-expand-alias (alias-items aliases &optional seen-aliases) + "Return the list (alias record-list expanded-nets-list). + +ALIAS-ITEMS are elements of the list returned by `bbdb-collect-all-aliases'. +Does the actual formatting and handling of magic nets as described in +`bbdb-define-all-aliases'. + +Nets which do not contain an \"@\" and exist as alias in ALIASES are expanded +recursively. SEEN-ALIASES will be filled with the aliases already seen and +checked to detect cycles. + +Other nets are formatted by `bbdb-dwim-net-address'." + (let ((alias (car alias-items)) + (items (cdr alias-items)) + rec nets n r + records result) + (if (member alias seen-aliases) + (error "Alias cycle during recursive expansion. Alias %S already seen in %S" + alias seen-aliases)) + (setq seen-aliases (cons alias seen-aliases)) + (while items + (setq rec (car items) + nets (car (cdr rec)) + rec (car rec) + records (cons rec records)) + (while nets + (setq n (car nets)) + (cond ((string-match "^\\([^/]+\\)/\\(.*\\)$" n) + (setq n (funcall (intern (format "bbdb-magic-net-%s" + (match-string 1 n))) + (match-string 2 n)))) + ((= ?\( (aref n 0)) + (setq r (read n)) + (setq n (apply (intern (format "bbdb-magic-net-%s" + (car r))) + (cdr r)))) + ((and (not (string-match "@" n)) (setq r (assoc n aliases))) + (setq n (bbdb-expand-alias r aliases seen-aliases) + records (append (nth 1 n) records) + n (nth 2 n))) + (t + (setq n (list (bbdb-dwim-net-address rec n))))) + (setq result (append n result)) + (setq nets (cdr nets))) + (setq items (cdr items))) + (list alias records result))) + +;(and (pp (bbdb-expand-all-aliases) (get-buffer "*scratch*")) nil) +(defun bbdb-all-aliases-expanded () + "Return an alist (alias record-list net-list) elements." + (let ((aliases (reverse (bbdb-collect-all-aliases))) + as result) + (setq as aliases) + (while as + (setq result (cons (bbdb-expand-alias (car as) aliases) result)) + (setq as (cdr as))) + result)) + +;;;###autoload +(defun bbdb-define-all-aliases () + "Define mail aliases for some of the records in the database. +Every record which has a `mail-alias' field \(but see +`bbdb-define-all-aliases-field') will have a mail alias defined for it +which is the contents of that field. If there are multiple +comma-separated words in this field, then all of those words will be +defined as aliases for that record. + +If multiple entries in the database have the same mail alias, then +that alias expands to a comma-separated list of the primary network +addresses of all of those people. + +An alias ending in \"*\" will expand to all the nets of the record. +An alias ending in \"[NTH]\" will expand the the NTH net of the +record. + +Special nets exist and expand to other nets using one of +`bbdb-magic-net-*', `bbdb-magic-net-1' or `bbdb-magic-net-SOMETHING'. +Magic nets may not contain any comma character. If you need one, please +put it into a custom magic net function or use the octal escape +sequence \"\\054\". + +Nets matching \"FUNCTION/ARG\" (i.e. containing at least one \"/\") +will be passed to the function `bbdb-magic-net-FUNCTION' with the +string argument ARG. + +Nets starting with a \"(\" will be considered as a lisp list where the +first element is prefixed by `bbdb-magic-net-' and then called as a +function with the rest of the list as arguments. + +Nets which do not contain an \"@\" character and also exist as aliases +are expanded recursively. This can be used to define hierarchical +aliases. + +Other nets are formatted by `bbdb-dwim-net-address'." + (interactive "") + (let* ((use-abbrev-p (fboundp 'define-mail-abbrev)) + (abbrev-handler (if use-abbrev-p + 'define-mail-abbrev + 'define-mail-alias)) + (abbrev-table (if use-abbrev-p + 'mail-abbrevs + 'mail-aliases)) + (mail-alias-separator-string (if (boundp 'mail-alias-separator-string) + mail-alias-separator-string + ", ")) + (aliases (bbdb-all-aliases-expanded)) + records alias nets expansion) + + (if use-abbrev-p + nil + ;; clear abbrev-table + (setq mail-aliases nil) + ;; arrange rebuilt if necessary, this should be done by + ;; mail-pre-abbrev-expand-hook, but there is none! + (defadvice sendmail-pre-abbrev-expand-hook + (before bbdb-rebuilt-all-aliases activate) + (bbdb-rebuilt-all-aliases))) + + ;; iterate over the results and create the aliases + (while aliases + (setq alias (car aliases) + records (nth 1 alias) + nets (nth 2 alias) + alias (car alias) + expansion (mapconcat 'identity nets mail-alias-separator-string)) + (funcall abbrev-handler alias expansion) + (setq alias (or (intern-soft (downcase alias) + (symbol-value abbrev-table)) + (error "couldn't find the alias we just defined!"))) + (or (eq (symbol-function alias) 'mail-abbrev-expand-hook) + (error "mail-aliases contains unexpected hook %s" + (symbol-function alias))) + (fset alias (list 'lambda '() + (list 'bbdb-mail-abbrev-expand-hook + alias (list 'quote + (mapcar (lambda (e) + (car (bbdb-record-net e))) + records))))) + (setq aliases (cdr aliases))))) + +;; We should be cleverer here and instead of rebuilding all aliases we should +;; just do what's necessary, i.e. remove deleted records and add new records +(defun bbdb-rebuilt-all-aliases () + (let ((needs-rebuilt bbdb-define-all-aliases-needs-rebuilt)) + (when needs-rebuilt + (if (not bbdb-silent-running) + (message "Rebuilding aliases due to %s aliases." needs-rebuilt)) + (setq bbdb-define-all-aliases-needs-rebuilt nil) + (bbdb-define-all-aliases)))) + +(defcustom bbdb-mail-abbrev-expand-hook nil + "*Hook or hooks invoked each time an alias is expanded. +The hook is called with two arguments the alias and the list of nets." + :group 'bbdb-hooks + :type 'hook) + +(defun bbdb-mail-abbrev-expand-hook (alias nets) + "The abbrev-hook is called with a list of network addresses NETS. +ALIAS and NETS is passed to the other hooks in `bbdb-mail-abbrev-expand-hook'. +Thus we do not keep pointers to bbdb records, which would lose if +the database was reverted. It uses `bbdb-search-simple' to convert +these to records, which is plenty fast." + (when bbdb-completion-display-record + (let ((bbdb-gag-messages t)) + (bbdb-display-records-1 + (mapcar (lambda (n) (bbdb-search-simple nil n)) nets) + t))) + (run-hook-with-args 'bbdb-mail-abbrev-expand-hook alias nets) + (mail-abbrev-expand-hook)) + +(defun bbdb-get-mail-aliases () + "Return a list of mail aliases used in the BBDB. +The format is suitable for `completing-read'." + (let* ((target (cons bbdb-define-all-aliases-field ".")) + (records (bbdb-search (bbdb-records) nil nil nil target)) + result aliases) + (while records + (setq aliases (bbdb-split + (bbdb-record-getprop (car records) + bbdb-define-all-aliases-field) + ",")) + (while aliases + (add-to-list 'result (list (car aliases))) + (setq aliases (cdr aliases))) + (setq records (cdr records))) + result)) + +;;;###autoload +(defun bbdb-add-or-remove-mail-alias (&optional records newalias delete) + "Add NEWALIAS in all RECORDS or remove it if DELETE it t. +When called with prefix argument it will remove the alias. +We honor `bbdb-apply-next-command-to-all-records'! +The new alias will only be added if it isn't there yet." + (interactive (list (if (bbdb-do-all-records-p) 'all 'one) + (completing-read + (format "%s mail alias: " (if current-prefix-arg "Remove" "Add")) + (bbdb-get-mail-aliases)) + current-prefix-arg)) + (setq newalias (bbdb-string-trim newalias)) + (setq newalias (if (string= "" newalias) nil newalias)) + (let* ((propsym bbdb-define-all-aliases-field) + (do-all-p (if (equal records 'one) nil t)) + (records (cond ((equal records 'all) (mapcar 'car bbdb-records)) + ((equal records 'one) (list (bbdb-current-record t))) + (t records)))) + (while records + (let* ((record (car records)) + (oldaliases (bbdb-record-getprop record propsym))) + (if oldaliases (setq oldaliases (bbdb-split oldaliases ","))) + (if delete (setq oldaliases (delete newalias oldaliases)) + (add-to-list 'oldaliases newalias)) + (setq oldaliases (bbdb-join oldaliases ", ")) + (bbdb-record-putprop record propsym oldaliases)) + (setq records (cdr records))) + (if do-all-p + (bbdb-redisplay-records) + (bbdb-redisplay-one-record (bbdb-current-record)))) + (setq bbdb-define-all-aliases-needs-rebuilt + (if delete + 'deleted + (if (bbdb-record-net (bbdb-current-record)) + 'new + nil)))) + +;;; Dialing numbers from BBDB +(defcustom bbdb-dial-local-prefix-alist + '(((if (integerp bbdb-default-area-code) + (format "(%03d)" bbdb-default-area-code) + (or bbdb-default-area-code "")) + "")) + "Mapping to remove local prefixes from numbers. +If this is non-nil, it should be an alist of +(PREFIX REPLACEMENT) elements. The first part of a phone number +matching the regexp returned by evaluating PREFIX will be replaced by +the corresponding REPLACEMENT when dialing." + :group 'bbdb-phone-dialing + :type 'sexp) + +(defcustom bbdb-dial-local-prefix nil + "Local prefix digits. +If this is non-nil, it should be a string of digits which your phone +system requires before making local calls (for example, if your phone system +requires you to dial 9 before making outside calls.) In BBDB's +opinion, you're dialing a local number if it starts with a 0 after +processing bbdb-dial-local-prefix-alist." + :group 'bbdb-phone-dialing + :type '(choice (const :tag "No digits required" nil) + (string :tag "Dial this first" "9"))) + +(defcustom bbdb-dial-long-distance-prefix nil + "Long distance prefix digits. +If this is non-nil, it should be a string of digits which your phone +system requires before making a long distance call (one not in your local +area code). For example, in some areas you must dial 1 before an area +code. Note that this is used to replace the + sign in phone numbers +when dialling (international dialing prefix.)" + :group 'bbdb-phone-dialing + :type '(choice (const :tag "No digits required" nil) + (string :tag "Dial this first" "1"))) + +(defcustom bbdb-sound-player nil + "The program to be used to play the sounds for the touch-tone digits." + :group 'bbdb-phone-dialing + :type '(choice (const :tag "No External Player" nil) + (file :tag "Sound Player" "/usr/local/bin/play"))) + +(defcustom bbdb-sound-files + '["/usr/demo/SOUND/sounds/touchtone.0.au" + "/usr/demo/SOUND/sounds/touchtone.1.au" + "/usr/demo/SOUND/sounds/touchtone.2.au" + "/usr/demo/SOUND/sounds/touchtone.3.au" + "/usr/demo/SOUND/sounds/touchtone.4.au" + "/usr/demo/SOUND/sounds/touchtone.5.au" + "/usr/demo/SOUND/sounds/touchtone.6.au" + "/usr/demo/SOUND/sounds/touchtone.7.au" + "/usr/demo/SOUND/sounds/touchtone.8.au" + "/usr/demo/SOUND/sounds/touchtone.9.au" + "/usr/demo/SOUND/sounds/touchtone.pound.au" + "/usr/demo/SOUND/sounds/touchtone.star.au"] + "A vector of ten sound files to be used for dialing. They +correspond to the 0, 1, 2, ... 9 digits, pound and star, respectively." + :group 'bbdb-phone-dialing + :type 'vector) + +(defcustom bbdb-modem-dial nil + "Type of dialing to use. +If this value is nil, the audio device is used for dialing. Otherwise, +this string is fed to the modem before the phone number digits." + :group 'bbdb-phone-dialing + :type '(choice (const :tag "audio" nil) + (string :tag "tone dialing" "ATDT ") + (string :tag "pulse dialing" "ATDP "))) + +(defcustom bbdb-modem-device "/dev/modem" + "The name of the modem device. +This is only used if bbdb-modem-dial is set to something other than nil." + :group 'bbdb-phone-dialing + :type 'string) + +(defcustom bbdb-sound-volume 50 + "The volume to play back dial tones at. The range is 0 to 100. +This is only used if bbdb-modem-dial is set to nil." + :group 'bbdb-phone-dialing + :type 'integer) + +(defun bbdb-play-sound (num &optional volume) + "Play the specified touchtone number NUM at VOLUME. +Uses external program `bbdb-sound-player' if set, otherwise +try to use internal sound if available." + (if (and (not bbdb-sound-player) (featurep 'native-sound)) + ;; This requires the sound files to be loaded via bbdb-xemacs. + (apply 'play-sound (list (intern (format "touchtone%d" num)) + bbdb-sound-volume)) + (if (and (not (featurep 'xemacs)) + ;; We can't tell a priori if Emacs 21 facility will + ;; actually work. + (condition-case nil + (play-sound (list 'sound + :file (aref bbdb-sound-files + (string-to-number num)) + :volume (or volume bbdb-sound-volume))) + (error nil))) + (if (and bbdb-sound-player + (file-exists-p bbdb-sound-player)) + (call-process bbdb-sound-player nil nil nil + (aref bbdb-sound-files num)) + (error "BBDB has no means of playing sound."))))) + +(eval-and-compile + (if (fboundp 'next-event) + (fset 'bbdb-next-event 'next-event) + (fset 'bbdb-next-event 'read-event))) + +(defun bbdb-dial-number (phone-string) + "Dial the number specified by PHONE-STRING. +The number is dialed either by playing touchtones through the audio +device using bbdb-sound-player, or by sending a dial sequence to +bbdb-modem-device. # and * are dialed as-is, and a space is treated as +a pause in the dial sequence." + (interactive "sDial number: ") + (let ((dialed "")) + (mapc + (lambda(d) + (if bbdb-modem-dial + (setq dialed + (concat dialed + (cond ((eq ? d) ",") + ((memq d '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?* ?#)) + (format "%c" d)) + (t "")))) + (cond + ((eq ?# d) + (bbdb-play-sound 10)) + ((eq ?* d) + (bbdb-play-sound 11)) + ((eq ? d) + ;; if we use sit-for, the user can interrupt! + (sleep-for 1)) ;; configurable? + ((memq d '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + (bbdb-play-sound (- d ?0))) + (t)))) phone-string) + + ;; tell the user that we're dialed, if we're using the modem + (if bbdb-modem-dial + (with-temp-buffer + (insert bbdb-modem-dial dialed ";\r\n") + (write-region (point-min) (point-max) bbdb-modem-device t) + (message "%s dialed. Pick up the phone now and hit any key ..." + phone-string) + (bbdb-next-event) + (erase-buffer) + (insert "ATH\r\n") + (write-region (point-min) (point-max) bbdb-modem-device t))))) + +;;;###autoload +(defun bbdb-dial (phone force-area-code) + "Dial the number at point. +If the point is at the beginning of a record, dial the first +phone number. Does not dial the extension. Does not apply the +transformations from bbdb-dial-local-prefix-alist if a prefix arg +is given." + (interactive (list (bbdb-current-field) + current-prefix-arg)) + (if (eq (car-safe phone) 'name) + (setq phone (car (bbdb-record-phones (bbdb-current-record))))) + (if (eq (car-safe phone) 'phone) + (setq phone (car (cdr phone)))) + (or (vectorp phone) (error "not on a phone field")) + + (let* ((number (bbdb-phone-string phone)) shortnumber) + (when (not force-area-code) + (let ((alist bbdb-dial-local-prefix-alist)) + (while alist + (if (string-match (concat "^" (eval (caar alist))) number) + (setq shortnumber (concat (car (cdar alist)) + (substring number (match-end 0))) + alist nil)) + (setq alist (cdr alist))))) + + ;; cut off the extension + (if (string-match "x[0-9]+$" number) + (setq number (substring number 0 (match-beginning 0)))) + + ;; This is terrifically Americanized... + ;; Leading 0 => local number (?) + (if (and (not shortnumber) bbdb-dial-local-prefix + (string-match "^0" number)) + (setq number (concat bbdb-dial-local-prefix number))) + + ;; Leading + => long distance/international number + (if (and (not shortnumber) bbdb-dial-long-distance-prefix + (string-match "^\+" number)) + (setq number (concat bbdb-dial-long-distance-prefix " " + (substring number 1)))) + + ;; use the short number if it's available + (setq number (or shortnumber number)) + (if (not bbdb-silent-running) + (message "Dialing %s" number)) + (bbdb-dial-number number))) + + +;; not sure what this is doing here... +(defun bbdb-get-record (prompt) + "Get the current record or ask the user. +To be used in `interactive' like this: +(interactive (list (bbdb-get-record \"look up ...\")))" + (if (and (boundp 'bbdb-buffer-name) +(string= bbdb-buffer-name (buffer-name))) +(bbdb-current-record) +(let (re (pr "")) + (while (not re) + (setq re (bbdb-completing-read-record (concat pr prompt))) + (unless re (ding)) (setq pr "Invalid response! ")) re))) + +;;; Finger, based on code by Sam Cramer <cramer@sun.com>. +;;; Note that process-death bugs in 18.57 may make this eat up all the cpu... + +(defcustom bbdb-finger-buffer-name "*finger*" + "The buffer into which finger output should be directed." + :group 'bbdb-utilities-finger + :type 'string) + +(defun bbdb-finger-internal (address) + (message "Fingering %s..." address) + (condition-case condition + (let* ((@ (string-match "@" address)) + (stream (open-network-stream + "finger" bbdb-finger-buffer-name + (if @ (substring address (1+ @)) "localhost") + "finger"))) + (set-process-sentinel stream 'bbdb-finger-process-sentinel) + (princ (concat "finger " address "\n")) + (process-send-string + stream (concat;;"/W " ; cs.stanford.edu doesn't like this... + (if @ (substring address 0 @) address) "\n")) + (process-send-eof stream)) + (error + (princ (format "error fingering %s: %s\n" address + (if (stringp condition) condition + (concat "\n" (nth 1 condition) + (if (cdr (cdr condition)) ": ") + (mapconcat '(lambda (x) + (if (stringp x) x + (bbdb-prin1-to-string x))) + (cdr (cdr condition)) ", "))))) + (bbdb-finger-process-sentinel nil nil)))) ; hackaroonie + +(defvar bbdb-remaining-addrs-to-finger) +(defun bbdb-finger-process-sentinel (process s) + (save-excursion + (set-buffer bbdb-finger-buffer-name) + (goto-char (point-min)) + (while (search-forward "\r" nil t) + (delete-char -1)) + (if (and (boundp 'bbdb-remaining-addrs-to-finger) + bbdb-remaining-addrs-to-finger) + (let ((addr (car bbdb-remaining-addrs-to-finger))) + (setq bbdb-remaining-addrs-to-finger + (cdr bbdb-remaining-addrs-to-finger)) + (goto-char (point-max)) + (let ((standard-output (current-buffer))) + (princ "\n\n\^L\n") + (bbdb-finger-internal addr))) + (goto-char (point-max)) + (message "Finger done.")))) + +(defcustom bbdb-finger-host-field 'finger-host + "*The field for special net addresses used by \"\\[bbdb-finger]\"." + :group 'bbdb-utilities-finger + :type 'symbol) + +(defun bbdb-record-finger-host (record) + (let ((finger-host (and bbdb-finger-host-field + (bbdb-record-getprop record bbdb-finger-host-field)))) + (if finger-host + (bbdb-split finger-host ",") + (bbdb-record-net record)))) + +;;;###autoload +(defun bbdb-finger (record &optional which-address) + "Finger the network address of a BBDB record. +If this command is executed from the *BBDB* buffer, finger the network +address of the record at point; otherwise, it prompts for a user. +With a numeric prefix argument, finger the Nth network address of the +current record\; with a prefix argument of ^U, finger all of them. +The *finger* buffer is filled asynchronously, meaning that you don't +have to wait around for it to finish\; but fingering another user before +the first finger has finished could have unpredictable results. +\\<bbdb-mode-map> +If this command is executed from the *BBDB* buffer, it may be prefixed +with \"\\[bbdb-apply-next-command-to-all-records]\" \(as in \ +\"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-finger]\" instead of \ +simply \"\\[bbdb-finger]\"\), meaning to finger all of +the users currently listed in the *BBDB* buffer instead of just the one +at point. The numeric prefix argument has the same interpretation. + +You can define a special network address to \"finger\" by defining a +field `finger-host' (default value of `bbdb-finger-host-field')." + (interactive (list (bbdb-get-record "BBDB Finger: ") + current-prefix-arg)) + (if (not (consp record)) (setq record (list record))) + (let ((addrs nil)) + (while record + (cond ((null which-address) + (setq addrs + (nconc addrs + (list (car (bbdb-record-finger-host (car record))))))) + ((stringp which-address) + (setq addrs (nconc addrs (list which-address)))) + ((numberp which-address) + (setq addrs + (nconc addrs + (list (nth which-address + (bbdb-record-finger-host (car record))))))) + (t + (setq addrs + (nconc addrs + (copy-sequence (bbdb-record-finger-host + (car record))))))) + (setq record (cdr record))) + (if (car addrs) + (save-excursion + (with-output-to-temp-buffer bbdb-finger-buffer-name + (set-buffer bbdb-finger-buffer-name) + (make-local-variable 'bbdb-remaining-addrs-to-finger) + (setq bbdb-remaining-addrs-to-finger (cdr addrs)) + (bbdb-finger-internal (car addrs)))) + (error "Nothing to finger!")))) + + +(defun bbdb-remove-duplicate-nets (records) + "*Remove duplicate nets from a record." + (interactive (if (bbdb-do-all-records-p) + (mapcar 'car bbdb-records) + (bbdb-current-record))) + (let (nets cnets) + (while records + (setq nets (bbdb-record-net (car records)) + cnets nil) + (while nets + (add-to-list 'cnets (car nets)) + (setq nets (cdr nets))) + (bbdb-record-set-net (car records) cnets) + (setq records (cdr records))))) + +(defun bbdb-find-duplicates (&optional fields) + "Find all records that have duplicate entries for given FIELDS. +FIELDS should be a list of the symbols `name', `net', and/or `aka'. +Note that overlap between these fields is noted if either is selected, +most common case `aka' and `name'. If FIELDS is not given it +defaults to all of them. + +The results of the search is returned as a list of records." + (setq fields (or fields '(name net aka))) + (let ((records (bbdb-records)) + rec hash ret) + (while records + (setq rec (car records)) + + (when (and (memq 'name fields) + (bbdb-record-name rec) + (setq hash (bbdb-gethash (downcase (bbdb-record-name rec)))) + (> (length hash) 1)) + (setq ret (append hash ret)) + (message "BBDB record `%s' causes duplicates, maybe it is equal to a company name." + (bbdb-record-name rec)) + (sit-for 0)) + + (if (memq 'net fields) + (let ((nets (bbdb-record-net rec))) + (while nets + (setq hash (bbdb-gethash (downcase (car nets)))) + (when (> (length hash) 1) + (setq ret (append hash ret)) + (message "BBDB record `%s' has duplicate net `%s'." + (bbdb-record-name rec) (car nets)) + (sit-for 0)) + (setq nets (cdr nets))))) + + (if (memq 'aka fields) + (let ((aka (bbdb-record-aka rec))) + (while aka + (setq hash (bbdb-gethash (downcase (car aka)))) + (when (> (length hash) 1) + (setq ret (append hash ret)) + (message "BBDB record `%s' has duplicate aka `%s'" + (bbdb-record-name rec) (car aka)) + (sit-for 0)) + (setq aka (cdr aka))))) + + (setq records (cdr records))) + (reverse (bbdb-remove-memq-duplicates ret)))) + +(defun bbdb-show-duplicates (&optional fields) + "*Find all records that have duplicate entries for given FIELDS. +FIELDS should be a list of the symbols `name', `net', and/or `aka'. +Note that overlap between these fields is noted if either is selected +(most common case `aka' and `name'). If FIELDS is not given it +defaults to all of them. + +The results are displayed in the bbdb buffer." + (interactive) + (setq fields (or fields '(name net aka))) + (bbdb-display-records (bbdb-find-duplicates fields))) + +;;; Time-based functions +(defun bbdb-kill-older (date &optional compare function) + "*Apply FUNCTION to all records with timestamps older than DATE. +The comparison is done with COMPARE. If FUNCTION is not specified, the +selected records are deleted. If COMPARE is not specified, +`string-lessp' is used. + +Example: + (bbdb-kill-older \"1997-01-01\") +will delete all records with timestamps older than Jan 1 1997. + +Notes: 1. Records without timestamp fields will be ignored +2. DATE must be in yyyy-mm-dd format." + (interactive "sKill records with timestamp older than (yyyy-mm-dd): \n") + (let ((records (bbdb-records)) timestamp + (fun (or function 'bbdb-delete-record-internal)) + (cmp (or compare 'string-lessp))) + (while records + (if (and (setq timestamp (bbdb-record-getprop (car records) 'timestamp)) + (funcall cmp timestamp date)) + (funcall fun (car records))) + (setq records (cdr records))))) + +(defmacro bbdb-compare-records (cmpval field compare) + "Builds a lambda comparison function that takes one argument, REC. +REC is returned if +(COMPARE VALUE CMPVAL) +is true, where VALUE is the value of the FIELD field of REC." + `(lambda (rec) +(let ((val (bbdb-record-getprop rec ,field))) + (if (and val (,compare val ,cmpval)) + rec nil)))) + +;;;###autoload +(defun bbdb-timestamp-older (date) + "*Display records with timestamp older than DATE. +DATE must be in yyyy-mm-dd format." + (interactive "sOlder than date (yyyy-mm-dd): ") + (bbdb-display-some (bbdb-compare-records date 'timestamp string<))) + +;;;###autoload +(defun bbdb-timestamp-newer (date) + "*Display records with timestamp newer than DATE. +DATE must be in yyyy-mm-dd format." + (interactive "sNewer than date (yyyy-mm-dd): ") + (bbdb-display-some (bbdb-compare-records date 'timestamp string>))) + +;;;###autoload +(defun bbdb-creation-older (date) + "*Display records with creation-date older than DATE. +DATE must be in yyyy-mm-dd format." + (interactive "sOlder than date (yyyy-mm-dd): ") + (bbdb-display-some (bbdb-compare-records date 'creation-date string<))) + +;;;###autoload +(defun bbdb-creation-newer (date) + "*Display records with creation-date newer than DATE. +DATE must be in yyyy-mm-dd format." + (interactive "sNewer than date (yyyy-mm-dd): ") + (bbdb-display-some (bbdb-compare-records date 'creation-date string>))) + +;;;###autoload +(defun bbdb-creation-no-change () + "*Display records that have the same timestamp and creation-date." + (interactive) + (bbdb-display-some + (bbdb-compare-records (bbdb-record-getprop rec 'timestamp) + 'creation-date string=))) + +;;; Help and documentation + +(defcustom bbdb-info-file nil + "*Set this to the location of the bbdb info file, if it's not in the +standard place." + :group 'bbdb + :type '(choice (const :tag "Standard location" nil) + (file :tag "New location"))) + +;;;###autoload +(defun bbdb-info () + (interactive) + (require 'info) + (if bbdb-inside-electric-display + (bbdb-electric-throw-to-execute '(bbdb-info)) + (let ((file (or bbdb-info-file "bbdb"))) + (Info-goto-node (format "(%s)Top" file))))) + +;;;###autoload +(defun bbdb-help () + (interactive) + (message (substitute-command-keys "\\<bbdb-mode-map>\ +new field: \\[bbdb-insert-new-field]; \ +edit field: \\[bbdb-edit-current-field]; \ +delete field: \\[bbdb-delete-current-field-or-record]; \ +mode help: \\[describe-mode]; \ +info: \\[bbdb-info]"))) + + +(or (fboundp 'member);; v18 lossage + (defun member (item list) + (while (and list (not (equal item (car list)))) (setq list (cdr list))) + list)) + + +;;; If Sebastian Kremer's minibuffer history package is around, use it. +(if (and (fboundp 'gmhist-make-magic) + (string-lessp emacs-version "19")) ; v19 has history built in + (mapc 'gmhist-make-magic + '(bbdb bbdb-name bbdb-company bbdb-net bbdb-changed))) + +;;;###autoload +(defcustom bbdb-update-records-mode 'annotating + "Controls how `bbdb-update-records' processes email addresses. +Set this to an expression which evaluates either to 'searching or +'annotating. When set to 'annotating email addresses will be fed to +`bbdb-annotate-message-sender' in order to update existing records or create +new ones. A value of 'searching will search just for existing records having +the right net. + +There is a version of this variable for each MUA, which overrides this variable +when set! + +This variable is also used for inter-function communication between the +functions `bbdb-update-records' and `bbdb-prompt-for-create'." + :group 'bbdb-mua-specific + :group 'bbdb-noticing-records + :type '(choice (const :tag "annotating all messages" + annotating) + (const :tag "annotating no messages" + searching) + (sexp :tag "user defined"))) + +(defvar bbdb-offer-to-create nil + "Used for inter-function communication between the functions +`bbdb-update-records' and `bbdb-prompt-for-create'.") +(defvar bbdb-address nil + "Used for inter-function communication between the functions +`bbdb-update-records' and `bbdb-prompt-for-create'.") + +(defvar bbdb-update-address-class nil + "Class of currently processed address as in `bbdb-get-addresses-headers'. +The `bbdb-notice-hook' and `bbdb-create-hook' functions may utilize this to +treat updates in the right way.") + +(defvar bbdb-update-address-header nil + "Header the currently processed address was extracted from. +The `bbdb-notice-hook' and `bbdb-create-hook' functions may utilize this to +treat updates in the right way.") + +;;;###autoload +(defun bbdb-update-records (addrs auto-create-p offer-to-create) + "Returns the records corresponding to the list of addresses ADDRS, +creating or modifying them as necessary. A record will be created if +AUTO-CREATE-P is non-nil or if OFFER-TO-CREATE is true and the user +confirms the creation. + +`bbdb-update-records-mode' controls if records are updated or not. +A MUA specific variable, e.g. `bbdb/vm-update-records-mode', can +overwrite this. + +See also `bbdb-get-only-first-address-p' to limit the update to the +sender of the message. + +When hitting C-g once you will not be asked any more for new people listed +in this message, but it will search only for existing records. When hitting +C-g again it will stop scanning." + (setq auto-create-p (bbdb-invoke-hook-for-value auto-create-p)) + + (let ((bbdb-records (bbdb-records)) + (processed-addresses 0) + (bbdb-offer-to-create (or offer-to-create (eq 'prompt auto-create-p))) + (bbdb-update-records-mode + (if offer-to-create 'annotating + (if (listp bbdb-update-records-mode) + (eval bbdb-update-records-mode) + bbdb-update-records-mode))) + (addrslen (length addrs)) + (bbdb-update-address-class nil) + (bbdb-update-address-header nil) + records hits) + + (while addrs + + (setq bbdb-address (car addrs) + bbdb-update-address-class (car bbdb-address) + bbdb-update-address-header (cadr bbdb-address) + bbdb-address (caddr bbdb-address)) + + (condition-case nil + (progn + (setq hits + (cond ((null (cadr bbdb-address)) + ;; ignore emtpy addrs, e.g. (??? nil) + nil) + ((eq bbdb-update-records-mode 'annotating) + (list;; search might return a list + (bbdb-annotate-message-sender + bbdb-address t + (or auto-create-p offer-to-create) + (if (eq auto-create-p t) + nil + (if bbdb-offer-to-create + 'bbdb-prompt-for-create))))) + ((eq bbdb-update-records-mode 'searching) + ;; search for records having this net + (let ((net (concat "^" + (regexp-quote + (cadr bbdb-address)) + "$")) + ;; there is no case for nets + (bbdb-case-fold-search t)) + (bbdb-search bbdb-records nil nil net)))) + processed-addresses (+ processed-addresses 1)) + + (when (and (not bbdb-silent-running) + (not bbdb-gag-messages) + (not (eq bbdb-offer-to-create 'q)) + (= 0 (% processed-addresses 5))) + (let ((mess (format "Hit C-g to stop BBDB from %s. %d of %d addresses processed." + bbdb-update-records-mode processed-addresses addrslen))) + (if (featurep 'xemacs) + (bbdb-display-message 'progress mess) + (message mess))) + (sit-for 0))) + + ;; o.k. there was a quit signal so how should we proceed now? + (quit (cond ((eq bbdb-update-records-mode 'annotating) + (setq bbdb-update-records-mode 'searching)) + ((eq bbdb-update-records-mode 'searching) + nil) + ((eq bbdb-update-records-mode 'next) + (setq bbdb-update-records-mode 'annotating)) + (t + (setq bbdb-update-records-mode 'quit))) + nil)) + + (while hits + ;; people should be listed only once so we use add-to-list + (if (car hits) (add-to-list 'records (car hits))) + (setq hits (cdr hits))) + + (setq addrs (cdr addrs))) + + ;; add-to-list adds at the front so we have to reverse the list in order + ;; to reflect the order of the records as they appear in the headers. + (setq records (nreverse records)) + + records)) + +(defun bbdb-get-help-window (message) + "Display MESSAGE in a new window which is the last one in the current frame." + (bbdb-pop-up-bbdb-buffer) + (let ((b (get-buffer-create " *BBDB Help*")) + (w (get-buffer-window bbdb-buffer-name)) + (selected (selected-window)) + (lines (let ((l 2) (s 0)) + (while (setq s (string-match "\n" message s)) + (setq s (1+ s) l (1+ l))) + l))) + (unless w + (setq w (display-buffer b))) + (select-window w) + (switch-to-buffer b) + (setq buffer-read-only t) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert message)) + (goto-char (point-min)) + (let ((window-min-height 1)) + (enlarge-window (- lines (window-height w)))) + w)) + +;; This is a hack. The function is called by bbdb-annotate-message-sender and +;; uses the above variable in order to manipulate bbdb-update-records. +;; Some cases are handled with signals in order to keep the changes in +;; bbdb-annotate-message-sender as minimal as possible. + +(defun bbdb-prompt-for-create () + "This function is used by `bbdb-update-records' to ask the user how to +proceed the processing of records. + +It is called from `bbdb-annotate-message-sender' (PROMPT-FOR-CREATE arg) and +returns `t' if the record should be created or `nil' otherwise. It honors a +previous answer, e.g. \"!\" add all ..." + (let ((old-offer-to-create bbdb-offer-to-create) + event prompt) + (when bbdb-offer-to-create + (when (not (integerp bbdb-offer-to-create)) + (setq prompt (format "%s is not in the db; add? (y,!,n,s,q,?) " + (or (car bbdb-address) (cadr bbdb-address)))) + (while (not event) + (setq event (read-key-sequence prompt)) + (if (featurep 'xemacs) + (setq event (bbdb-event-to-character (aref event 0))) + (setq event (if (stringp event) (aref event 0))))) + + (setq bbdb-offer-to-create event)) + (message "");; clear the message buffer + + (cond ((eq bbdb-offer-to-create ?y) + (setq bbdb-offer-to-create old-offer-to-create) + t) + ((eq bbdb-offer-to-create ?!) + t) + ((or (eq bbdb-offer-to-create ?n) + (eq bbdb-offer-to-create ? )) + (setq bbdb-update-records-mode 'next + bbdb-offer-to-create old-offer-to-create) + (signal 'quit 'next)) + ((eq bbdb-offer-to-create ?q) + (setq bbdb-update-records-mode 'quit) + (signal 'quit 'quit)) + ((eq bbdb-offer-to-create ?s) + (setq bbdb-update-records-mode 'searching) + (signal 'quit 'searching)) + (t + (save-window-excursion + (bbdb-get-help-window + "Your answer controls how BBDB updates/searches for records. + +Type ? for this help. +Type y to add the current record. +Type ! to add all remaining records. +Type n to skip the current record. (You might also type space) +Type s to switch from annotate to search mode. +Type q to quit updating records. No more search or annotation is done.") + (bbdb-prompt-for-create))))))) + +;;;###autoload +(defcustom bbdb-get-addresses-headers + '((authors . ("From" "Resent-From" "Reply-To")) + (recipients . ("Resent-To" "Resent-CC" "To" "CC" "BCC"))) + "*List of headers to search for senders and recipients email addresses. +The headers are grouped into two classes, the authors and the senders headers." + :group 'bbdb-mua-specific + :group 'bbdb-noticing-records + :type 'list) + +;;;###autoload +(defcustom bbdb-get-only-first-address-p nil + "*If t `bbdb-update-records' will return only the first one. +Changing this variable will show its effect only after clearing the +`bbdb-message-cache' of a folder or closing and visiting it again." + :group 'bbdb-mua-specific + :group 'bbdb-noticing-records + :type 'boolean) + +(defun bbdb-get-addresses (only-first-address + uninteresting-senders + get-header-content-function + &rest get-header-content-function-args) + "Return a list of all addresses found in the headers of a message. +With ONLY-FIRST-ADDRESS being t, it will only return the first found address. +Addresses matching UNINTERESTING-SENDERS will be ignored. + +The client has to provide a GET-HEADER-CONTENT-FUNCTION and optional arguments +\(GET-HEADER-CONTENT-FUNCTION-ARGS) to extract the header content. The first +argument to this function if the header name sans." + (let ((headers bbdb-get-addresses-headers) + (ignore-senders (or bbdb-user-mail-names uninteresting-senders)) + addrlist adlist fn ad + header-type header-fields header-content) + (while headers + (setq header-type (caar headers) + header-fields (cdar headers)) + (while header-fields + (setq header-content (apply get-header-content-function + (car header-fields) + get-header-content-function-args)) + (when header-content + (setq adlist (funcall bbdb-extract-address-components-func + header-content)) + (while adlist + (setq fn (caar adlist) + ad (car (cdar adlist))) + + ;; ignore uninteresting addresses, this is kinda gross! + (if (or (not (stringp ignore-senders)) + (not (or (and fn (string-match ignore-senders fn)) + (and ad (string-match ignore-senders ad))))) + (add-to-list 'addrlist + (list header-type + (car header-fields) + (car adlist)))) + + (if (and only-first-address addrlist) + (setq adlist nil headers nil) + (setq adlist (cdr adlist))))) + (setq header-fields (cdr header-fields))) + (setq headers (cdr headers))) + (nreverse addrlist))) + +(provide 'bbdb-com) diff --git a/lisp/bbdb-ftp.el b/lisp/bbdb-ftp.el new file mode 100644 index 0000000..1ac48d6 --- /dev/null +++ b/lisp/bbdb-ftp.el @@ -0,0 +1,201 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is an addition to the Insidious Big Brother Database +;;; (aka BBDB), copyright (c) 1991, 1992 Jamie Zawinski +;;; <jwz@netscape.com>. +;;; +;;; The Insidious Big Brother Database 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 1, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;; This file was written by Ivan Vazquez <ivan@haldane.bu.edu> + +;;; This file adds the ability to define ftp-sites in a BBDB, much the same +;;; way one adds a regular person's name to the BBDB. It also defines the +;;; bbdb-ftp command which allows you to ftp a site that is in a bbdb-record. +;;; You must have either EFS or ange-ftp in order to use this code. Ange-ftp +;;; is available at archive.cis.ohio-state.edu in the +;;; /pub/gnu/emacs/elisp-archive/packages directory. EFS ships with XEmacs. + +;;; Note that Ftp Site BBDB entries differ from regular entries by the +;;; fact that the Name Field must have the ftp site preceeded by the +;;; bbdb-ftp-site-name-designator-prefix. This defaults to "Ftp Site:" +;;; BBDB Ftp Site entries also have two new fields added, the +;;; ftp-dir slot, and the ftp-user slot. These are added to the notes +;;; alist part of the bbdb-records, the original bbdb-record structure +;;; remains untouched. + +;;; The following user-level commands are defined for use: +;;; + +;;; bbdb-ftp - Use ange-ftp to open an ftp-connection to a BBDB +;;; record's name. If this command is executed from the +;;; *BBDB* buffer, ftp the site of the record at point; +;;; otherwise, it prompts for an ftp-site. + +;;; bbdb-create-ftp-site - +;;; Add a new ftp-site entry to the bbdb database; prompts +;;; for all relevant info using the echo area, inserts the +;;; new record in the db, sorted alphabetically. + +;;; The package can be installed by compiling and adding the following +;;; two lines to your .emacs. + +;;; (autoload 'bbdb-ftp "bbdb-ftp" "Ftp BBDB Package" t) +;;; (autoload 'bbdb-create-ftp-site "bbdb-ftp" "Ftp BBDB Package" t) + +(require 'bbdb) +(require 'bbdb-com) + +;; There must be a better way +(if (featurep 'efs-cu) + (require 'efs) + (require 'ange-ftp)) + +(defcustom bbdb-default-ftp-user "anonymous" + "*The default login to use when ftp-ing." + :group 'bbdb-utilities-ftp + :type 'string) + +(defcustom bbdb-default-ftp-dir "/" + "*The default directory to open when ftp-ing." + :group 'bbdb-utilities-ftp + :type 'string) + +(defcustom bbdb-ftp-site-name-designator-prefix "Ftp Site: " + "*The prefix that all ftp sites in the bbdb will have in their name field." + :group 'bbdb-utilities-ftp + :type 'string) + +(defmacro defun-bbdb-raw-notes-accessor (slot) + "Expands into an accessor function for slots in the notes alist." + (let ((fn-name (intern (concat "bbdb-record-" (symbol-name slot))))) + (list 'defun fn-name (list 'record) + (list 'cdr + (list 'assoc (list 'quote slot) + (list 'bbdb-record-raw-notes 'record)))))) + +(defun-bbdb-raw-notes-accessor ftp-dir) +(defun-bbdb-raw-notes-accessor ftp-user) + +(defun bbdb-record-ftp-site (record) + "Accessor Function. Returns the ftp-site field of the BBDB record or nil." + (let* ((name (bbdb-record-name record)) + (ftp-pfx-regexp (concat bbdb-ftp-site-name-designator-prefix " *")) + (ftp-site + (and (string-match ftp-pfx-regexp name) + (substring name (match-end 0))))) + ftp-site)) + +(defun remove-leading-whitespace (string) + "Remove any spaces or tabs from only the start of the string." + (let ((space-char-code (string-to-char " ")) + (tab-char-code ?\t) + (index 0)) + (if string + (progn + (while (or (char-equal (elt string index) space-char-code) + (char-equal (elt string index) tab-char-code)) + (setq index (+ index 1))) + (substring string index)) + nil))) + +;;;###autoload +(defun bbdb-ftp (bbdb-record &optional which) + "Use ange-ftp to open an ftp-connection to a BBDB record's name. +If this command is executed from the *BBDB* buffer, ftp the site of +the record at point; otherwise, it prompts for an ftp-site." + (interactive (list (bbdb-get-record "Visit (FTP): ") + (or current-prefix-arg 0))) + (if (bbdb-record-ftp-site bbdb-record) + (bbdb-ftp-internal bbdb-record) + (find-file-other-window + (read-string "fetch: " (bbdb-get-field bbdb-record 'ftp which))))) + +(defun bbdb-ftp-internal (bbdb-record) + (let* ((site (bbdb-record-ftp-site bbdb-record)) + (dir (or (bbdb-record-ftp-dir bbdb-record) bbdb-default-ftp-dir)) + (user (or (bbdb-record-ftp-user bbdb-record) bbdb-default-ftp-user)) + (file-string (concat "/" user "@" site ":" dir ))) + (if bbdb-inside-electric-display + (bbdb-electric-throw-to-execute (list 'bbdb-ftp-internal bbdb-record))) + (if site + (find-file-other-window file-string) + (error "Not an ftp site. Check bbdb-ftp-site-name-designator-prefix")))) + +(defun bbdb-read-new-ftp-site-record () + "Prompt for and return a completely new BBDB record that is +specifically an ftp site entry. Doesn't insert it in to the database +or update the hashtables, but does insure that there will not be name +collisions." + (bbdb-records) ; make sure database is loaded + (if bbdb-readonly-p (error "The Insidious Big Brother Database is read-only.")) + (let (site dir user) + (bbdb-error-retry + (progn + (setq site (bbdb-read-string "Ftp Site: ")) + ;; try and parse it out, in case the user typed in things like + ;; "ftp://user@site/directory/ or /user@site/directory + (if (string-match + "^\\([Ff][Tt][Pp]://\\|/\\)?\\([^@/]@\\)?\\([^/]+\\)\\(/[^/].*\\)?" + site) + (setq user (if (match-beginning 2) + (substring site (match-beginning 2) + (match-end 2))) + dir (if (match-beginning 4) + (substring site (match-beginning 4) + (match-end 4))) + site (substring site (match-beginning 3) + (match-end 3))) + (if (string-match "/" site) + (error "%s doesn't look like a valid site name." site))) + (setq site (concat bbdb-ftp-site-name-designator-prefix site)) + (if (and bbdb-no-duplicates-p + (bbdb-gethash (downcase site))) + (error "%s is already in the database" site)))) + (let* ((dir (or dir (bbdb-read-string "Ftp Directory: " + bbdb-default-ftp-dir))) + (user (or user (bbdb-read-string "Ftp Username: " + bbdb-default-ftp-user))) + (company (bbdb-read-string "Company: ")) + (notes (bbdb-read-string "Additional Comments: ")) + (names (bbdb-divide-name site)) + (firstname (car names)) + (lastname (nth 1 names))) + (if (string= user bbdb-default-ftp-user) (setq user nil)) + (if (string= company "") (setq company nil)) + (if (or (string= dir bbdb-default-ftp-dir) (string= dir "")) + (setq dir nil)) + (if (string= notes "") (setq notes nil)) + + (let ((record + (vector firstname lastname nil company nil nil nil + (append + (if notes (list (cons 'notes notes)) nil) + (if dir (list (cons 'ftp-dir dir)) nil) + (if user (list (cons 'ftp-user user)) nil)) + (make-vector bbdb-cache-length nil)))) + record)))) + +;;;###autoload +(defun bbdb-create-ftp-site (record) + "Add a new ftp-site entry to the bbdb database. +Prompts for all relevant info using the echo area, +inserts the new record in the db, sorted alphabetically." + (interactive (list (bbdb-read-new-ftp-site-record))) + (bbdb-invoke-hook 'bbdb-create-hook record) + (bbdb-change-record record t) + (bbdb-display-records (list record))) + +(provide 'bbdb-ftp) diff --git a/lisp/bbdb-gnus.el b/lisp/bbdb-gnus.el new file mode 100644 index 0000000..0ea33db --- /dev/null +++ b/lisp/bbdb-gnus.el @@ -0,0 +1,835 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski <jwz@netscape.com>. +;;; Interface to Gnus. See bbdb.texinfo. + +;;; The Insidious Big Brother Database 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 1, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(require 'bbdb) +(require 'bbdb-snarf) +(require 'gnus) + +(eval-and-compile + (require 'bbdb-com) + (require 'rfc822)) + +;; Cater for older emacs (19.34) with default Gnus installation. +(eval-and-compile + (condition-case nil + (progn + (require 'gnus-win) + (require 'gnus-sum) + (require 'gnus-art)) + (error nil))) + +;;; Compiler hushing +(eval-when-compile + (defvar gnus-optional-headers) + (defvar gnus-summary-to-prefix)) + +(defsubst bbdb/gnus-ignored-from-addresses () + "Return the value of `gnus-ignored-from-addresses' handling both +recent Gnus (>= 04/2007) and older ones." + (cond ((fboundp 'gnus-ignored-from-addresses) + (gnus-ignored-from-addresses)) + ((boundp 'gnus-ignored-from-addresses) + gnus-ignored-from-addresses) + (t nil))) + +(defun bbdb/gnus-get-message-id () + "Return the message-id of the current message." + (save-excursion + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (re-search-forward "^Message-ID:\\s-*\\(<.+>\\)" (point-max) t) + (match-string 1))))) + +(defcustom bbdb/gnus-update-records-mode 'annotating +; '(if (gnus-new-flag msg) 'annotating 'searching) + "Controls how `bbdb/gnus-update-records' processes email addresses. +Set this to an expression which evaluates either to 'searching or +'annotating. When set to 'annotating email addresses will be fed to +`bbdb-annotate-message-sender' in order to update existing records or create +new ones. A value of 'searching will search just for existing records having +the right net. + +The default is to annotate only new messages." + :group 'bbdb-mua-specific-gnus + :type '(choice (const :tag "annotating all messages" + annotating) + (const :tag "annotating no messages" + searching) + (const :tag "annotating only new messages" + (if (equal "" + (gnus-summary-article-mark + (gnus-summary-article-number))) + 'annotating 'searching)) + (sexp :tag "user defined"))) + + +;;;###autoload +(defun bbdb/gnus-update-record (&optional offer-to-create) + "Return the record corresponding to the current Gnus message, creating +or modifying it as necessary. A record will be created if +bbdb/news-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and +the user confirms the creation." + (let* ((bbdb-get-only-first-address-p t) + (records (bbdb/gnus-update-records offer-to-create))) + (if records (car records) nil))) + +;;;###autoload +(defun bbdb/gnus-update-records (&optional offer-to-create) + "Return the records corresponding to the current Gnus message, creating +or modifying it as necessary. A record will be created if +`bbdb/news-auto-create-p' is non-nil or if OFFER-TO-CREATE is true +and the user confirms the creation. + +The variable `bbdb/gnus-update-records-mode' controls what actions +are performed and it might override `bbdb-update-records-mode'. + +When hitting C-g once you will not be asked anymore for new people listed +in this message, but it will search only for existing records. When hitting +C-g again it will stop scanning." + (let ((bbdb-update-records-mode (or bbdb/gnus-update-records-mode + bbdb-update-records-mode)) + (bbdb/gnus-offer-to-create offer-to-create) + ;; here we may distiguish between different type of messages + ;; for those that have no message id we have to find something + ;; else as message key. + (msg-id (bbdb/gnus-get-message-id)) + records cache) + (save-excursion + (set-buffer gnus-article-buffer) + + (if (and msg-id (not bbdb/gnus-offer-to-create)) + (setq cache (bbdb-message-cache-lookup msg-id))) + + (if cache + (setq records (if bbdb-get-only-first-address-p + (list (car cache)) + cache)) + + (let ((bbdb-update-records-mode (or bbdb/gnus-update-records-mode + bbdb-update-records-mode))) + (setq records (bbdb-update-records + (bbdb-get-addresses + bbdb-get-only-first-address-p + (or (bbdb/gnus-ignored-from-addresses) + bbdb-user-mail-names) + 'gnus-fetch-field) + bbdb/news-auto-create-p + offer-to-create))) + (if (and bbdb-message-caching-enabled msg-id) + (bbdb-encache-message msg-id records)))) + records)) + +;;;###autoload +(defun bbdb/gnus-annotate-sender (string &optional replace) + "Add a line to the end of the Notes field of the BBDB record +corresponding to the sender of this message. If REPLACE is non-nil, +replace the existing notes entry (if any)." + (interactive (list (if bbdb-readonly-p + (error "The Insidious Big Brother Database is read-only.") + (read-string "Comments: ")))) + (gnus-summary-select-article) + (bbdb-annotate-notes (bbdb/gnus-update-record t) string 'notes replace)) + +(defun bbdb/gnus-edit-notes (&optional arg) + "Edit the notes field or (with a prefix arg) a user-defined field +of the BBDB record corresponding to the sender of this message." + (interactive "P") + (gnus-summary-select-article) + (let ((record (or (bbdb/gnus-update-record t) (error "unperson")))) + (bbdb-display-records (list record)) + (if arg + (bbdb-record-edit-property record nil t) + (bbdb-record-edit-notes record t)))) + +;;;###autoload +(defun bbdb/gnus-show-records (&optional address-class) + "Display the contents of the BBDB for all addresses of this message. +This buffer will be in `bbdb-mode', with associated keybindings." + (interactive) + (gnus-summary-select-article) + (let ((bbdb-get-addresses-headers + (if address-class + (list (assoc address-class bbdb-get-addresses-headers)) + bbdb-get-addresses-headers)) + (bbdb/gnus-update-records-mode 'annotating) + (bbdb-message-cache nil) + (bbdb-user-mail-names nil) + (gnus-ignored-from-addresses nil) + records) + (setq records (bbdb/gnus-update-records t)) + (if records + (bbdb-display-records records) + (bbdb-undisplay-records)) + records)) + +;;;###autoload +(defun bbdb/gnus-show-all-recipients () + "Show all recipients of this message. Counterpart to `bbdb/vm-show-sender'." + (interactive) + (let ((bbdb-get-only-first-address-p nil)) + (bbdb/gnus-show-records 'recipients))) + +(defun bbdb/gnus-show-sender (&optional show-recipients) + "Display the contents of the BBDB for the senders of this message. +With a prefix argument show the recipients instead, +with two prefix arguments show all records. +This buffer will be in `bbdb-mode', with associated keybindings." + (interactive "p") + (cond ((= 4 show-recipients) + (bbdb/gnus-show-all-recipients)) + ((= 16 show-recipients) + (let ((bbdb-get-only-first-address-p nil)) + (bbdb/gnus-show-records))) + (t + (if (null (bbdb/gnus-show-records 'authors)) + (bbdb/gnus-show-all-recipients))))) + +(defun bbdb/gnus-pop-up-bbdb-buffer (&optional offer-to-create) + "Make the *BBDB* buffer be displayed along with the Gnus windows, +displaying the record corresponding to the sender of the current message." + (let ((bbdb-gag-messages t) + (records (bbdb/gnus-update-records offer-to-create)) + (bbdb-electric-p nil)) + + (when bbdb-use-pop-up + (let ((b (current-buffer))) + ;; display the bbdb buffer iff there is a record for this article. + (if records + (bbdb-pop-up-bbdb-buffer + (lambda (w) + (let ((b (current-buffer))) + (set-buffer (window-buffer w)) + (prog1 (eq major-mode 'gnus-article-mode) + (set-buffer b))))) + (or bbdb-inside-electric-display + (not (get-buffer-window bbdb-buffer-name)) + (let (w) + (delete-other-windows) + (gnus-configure-windows 'article) + (if (setq w (get-buffer-window gnus-summary-buffer)) + (select-window w))))) + (set-buffer b)) + (if records (bbdb-display-records records bbdb-pop-up-display-layout))) + records)) + +;; +;; Announcing BBDB entries in the summary buffer +;; + +(defcustom bbdb/gnus-lines-and-from-length 18 + "*The number of characters used to display From: info in Gnus, if you have +set gnus-optional-headers to 'bbdb/gnus-lines-and-from." + :group 'bbdb-mua-specific-gnus + :type 'integer) + +(defcustom bbdb/gnus-summary-mark-known-posters t + "*If t, mark messages created by people with records in the BBDB. +In Gnus, this marking will take place in the subject list (assuming +`gnus-optional-headers' contains `bbdb/gnus-lines-and-from'). In Gnus, the +marking will take place in the Summary buffer if the format code defined by +`bbdb/gnus-summary-user-format-letter' is used in `gnus-summary-line-format'. +This variable has no effect on the marking controlled by +`bbdb/gnus-summary-in-bbdb-format-letter'." + :group 'bbdb-mua-specific-gnus + :type '(choice (const :tag "Mark known posters" t) + (const :tag "Do not mark known posters" nil))) +(defvaralias 'bbdb/gnus-mark-known-posters + 'bbdb/gnus-summary-mark-known-posters) + +(defcustom bbdb/gnus-summary-known-poster-mark "+" + "This is the default character to prefix author names with if +bbdb/gnus-summary-mark-known-posters is t. If the poster's record has +an entry in the field named by bbdb-message-marker-field, then that will +be used instead." + :group 'bbdb-mua-specific-gnus + :type 'character) + +(defcustom bbdb/gnus-summary-show-bbdb-names t + "*If both this variable and `bbdb/gnus-summary-prefer-real-names' are true, +then for messages from authors who are in your database, the name +displayed will be the primary name in the database, rather than the +one in the From line of the message. This doesn't affect the names of +people who aren't in the database, of course. (`gnus-optional-headers' +must be `bbdb/gnus-lines-and-from' for Gnus users.)" + :group 'bbdb-mua-specific-gnus + :type 'boolean) +(defvaralias 'bbdb/gnus-header-show-bbdb-names + 'bbdb/gnus-summary-show-bbdb-names) + +(defcustom bbdb/gnus-summary-prefer-bbdb-data t + "If t, then for posters who are in our BBDB, replace the information +provided in the From header with data from the BBDB." + :group 'bbdb-mua-specific-gnus + :type 'boolean) + +(defcustom bbdb/gnus-summary-prefer-real-names t + "If t, then display the poster's name from the BBDB if we have one, +otherwise display his/her primary net address if we have one. If it +is set to the symbol bbdb, then real names will be used from the BBDB +if present, otherwise the net address in the post will be used. If +bbdb/gnus-summary-prefer-bbdb-data is nil, then this has no effect. +See `bbdb/gnus-lines-and-from' for Gnus users, or +`bbdb/gnus-summary-user-format-letter' for Gnus users." + :group 'bbdb-mua-specific-gnus + :type '(choice (const :tag "Prefer real names" t) + (const :tag "Prefer network addresses" nil))) +(defvaralias 'bbdb/gnus-header-prefer-real-names + 'bbdb/gnus-summary-prefer-real-names) + +(defcustom bbdb/gnus-summary-user-format-letter "B" + "This is the gnus-user-format-function- that will be used to insert +the information from the BBDB in the summary buffer (using +`bbdb/gnus-summary-get-author'). This format code is meant to replace +codes that insert sender names or addresses (like %A or %n). Unless +you've already got other code using user format B, you might as well +stick with the default. Additionally, if the value of this variable +is nil, no format function will be installed for +`bbdb/gnus-summary-get-author'. See also +`bbdb/gnus-summary-in-bbdb-format-letter', which installs a format +code for `bbdb/gnus-summary-author-in-bbdb'" + :group 'bbdb-mua-specific-gnus + :type 'character) + +(defcustom bbdb/gnus-summary-in-bbdb-format-letter "b" + "This is the gnus-user-format-function- that will be used to insert +`bbdb/gnus-summary-known-poster-mark' (using +`bbdb/gnus-summary-author-in-bbdb') if the poster is in the BBDB, and +\" \" if not. If the value of this variable is nil, no format code +will be installed for `bbdb/gnus-summary-author-in-bbdb'. See also +`bbdb/gnus-summary-user-format-letter', which installs a format code +for `bbdb/gnus-summary-get-author'." + :group 'bbdb-mua-specific-gnus + :type 'character) + +(defcustom bbdb-message-marker-field 'mark-char + "*The field whose value will be used to mark messages by this user in Gnus." + :group 'bbdb-mua-specific-gnus + :type 'symbol) + +(defun bbdb/gnus-summary-get-author (header) + "Given a Gnus message header, returns the appropriate piece of +information to identify the author in a Gnus summary line, depending on +the settings of the various configuration variables. See the +documentation for the following variables for more details: + `bbdb/gnus-summary-mark-known-posters' + `bbdb/gnus-summary-known-poster-mark' + `bbdb/gnus-summary-prefer-bbdb-data' + `bbdb/gnus-summary-prefer-real-names' +This function is meant to be used with the user function defined in + `bbdb/gnus-summary-user-format-letter'" + (let* ((from (mail-header-from header)) + (to (let ((gifa (bbdb/gnus-ignored-from-addresses))) + (when (and gifa (string-match gifa from)) + (let* ((extras (mail-header-extra header)) + (to (or (cdr (assoc 'To extras)) + (cdr (assoc 'CC extras)) + (cdr (assoc 'Newgroups extras))))) + (if (and to (listp to)) + (cdr (car to)) + to))))) + (data (and bbdb/gnus-summary-show-bbdb-names + (condition-case nil + (mail-extract-address-components (or to from)) + (error nil)))) + (name (car data)) + (net (car (cdr data))) + (record (and data + (bbdb-search-simple + name + (if (and net bbdb-canonicalize-net-hook) + (bbdb-canonicalize-address net) + net))))) + + (if (and record name (member (downcase name) (bbdb-record-net record))) + ;; bogon! + (setq record nil)) + (setq name + (or (and bbdb/gnus-summary-prefer-bbdb-data + (or (and bbdb/gnus-summary-prefer-real-names + (and record (bbdb-record-name record))) + (and record (bbdb-record-net record) + (nth 0 (bbdb-record-net record))))) + (and bbdb/gnus-summary-prefer-real-names + (or (and (equal bbdb/gnus-summary-prefer-real-names 'bbdb) + net) + name)) + net from "**UNKNOWN**")) + (format "%s%s%s" + (if to + (if (and (boundp 'gnus-summary-to-prefix) + (stringp gnus-summary-to-prefix)) + gnus-summary-to-prefix + "To: ") + "") + (or (and record bbdb/gnus-summary-mark-known-posters + (or (bbdb-record-getprop + record bbdb-message-marker-field) + bbdb/gnus-summary-known-poster-mark)) + " ") + name))) + +;; DEBUG: (bbdb/gnus-summary-author-in-bbdb "From: simmonmt@acm.org") +(defun bbdb/gnus-summary-author-in-bbdb (header) + "Given a Gnus message header, returns a mark if the poster is in the BBDB, \" \" otherwise. The mark itself is the value of the field indicated by `bbdb-message-marker-field' (`mark-char' by default) if the indicated field is in the poster's record, and `bbdb/gnus-summary-known-poster-mark' otherwise." + (let* ((from (mail-header-from header)) + (data (condition-case () + (mail-extract-address-components from) + (error nil))) + (name (car data)) + (net (cadr data)) + record) + (if (and data + (setq record + (bbdb-search-simple + name (if (and net bbdb-canonicalize-net-hook) + (bbdb-canonicalize-address net) + net)))) + (or (bbdb-record-getprop + record bbdb-message-marker-field) + bbdb/gnus-summary-known-poster-mark) " "))) + +;; +;; Gnus-specific snarfing (see also bbdb-snarf.el) +;; + +;;;###autoload +(defun bbdb/gnus-snarf-signature () + "Snarf signature from the corresponding *Article* buffer." + (interactive) + (save-excursion + ;; this is a little bogus, since it will remain set after you've + ;; quit Gnus + (or gnus-article-buffer (error "Not in Gnus!")) + ;; This is wrong for non-ASCII text. Why not use + ;; gnus-article-hide-signature? + (set-buffer gnus-original-article-buffer) + (save-restriction + (or (gnus-article-narrow-to-signature) (error "No signature!")) + (bbdb-snarf-region (point-min) (point-max))))) + +;; +;; Scoring +;; + +(defcustom bbdb/gnus-score-field 'gnus-score + "This variable contains the name of the BBDB field which should be +checked for a score to add to the net addresses in the same record." + :group 'bbdb-mua-specific-gnus-scoring + :type 'symbol) + +(defcustom bbdb/gnus-score-default nil + "If this is set, then every net address in the BBDB that does not have +an associated score field will be assigned this score. A value of nil +implies a default score of zero." + :group 'bbdb-mua-specific-gnus-scoring + :type '(choice (const :tag "Do not assign default score") + (integer :tag "Assign this default score" 0))) + +(defvar bbdb/gnus-score-default-internal nil + "Internal variable for detecting changes to +`bbdb/gnus-score-default'. You should not set this variable directly - +set `bbdb/gnus-score-default' instead.") + +(defvar bbdb/gnus-score-alist nil + "The text version of the scoring structure returned by +bbdb/gnus-score. This is built automatically from the BBDB.") + +(defvar bbdb/gnus-score-rebuild-alist t + "Set to t to rebuild bbdb/gnus-score-alist on the next call to +bbdb/gnus-score. This will be set automatically if you change a BBDB +record which contains a gnus-score field.") + +(defun bbdb/gnus-score-invalidate-alist (rec) + "This function is called through `bbdb-after-change-hook', +and sets `bbdb/gnus-score-rebuild-alist' to t if the changed +record contains a gnus-score field." + (if (bbdb-record-getprop rec bbdb/gnus-score-field) + (setq bbdb/gnus-score-rebuild-alist t))) + +;;;###autoload +(defun bbdb/gnus-score (group) + "This returns a score alist for Gnus. A score pair will be made for +every member of the net field in records which also have a gnus-score +field. This allows the BBDB to serve as a supplemental global score +file, with the advantage that it can keep up with multiple and changing +addresses better than the traditionally static global scorefile." + (list (list + (condition-case nil + (read (bbdb/gnus-score-as-text group)) + (error (setq bbdb/gnus-score-rebuild-alist t) + (message "Problem building BBDB score table.") + (ding) (sit-for 2) + nil))))) + +(defun bbdb/gnus-score-as-text (group) + "Returns a SCORE file format string built from the BBDB." + (cond ((or (cond ((/= (or bbdb/gnus-score-default 0) + (or bbdb/gnus-score-default-internal 0)) + (setq bbdb/gnus-score-default-internal + bbdb/gnus-score-default) + t)) + (not bbdb/gnus-score-alist) + bbdb/gnus-score-rebuild-alist) + (setq bbdb/gnus-score-rebuild-alist nil) + (setq bbdb/gnus-score-alist + (concat "((touched nil) (\"from\"\n" + (mapconcat + (lambda (rec) + (let ((score (or (bbdb-record-getprop rec + bbdb/gnus-score-field) + bbdb/gnus-score-default)) + (net (bbdb-record-net rec))) + (if (not (and score net)) nil + (mapconcat + (lambda (addr) + (format "(\"%s\" %s)\n" addr score)) + net "")))) + (bbdb-records) "") + "))")))) + bbdb/gnus-score-alist) + +;;;###autoload +(defun bbdb/gnus-summary-show-all-recipients (not-elided) + "Display BBDB records for all recipients of the message." + (interactive "P") + (let ((bbdb-display-layout (or (not not-elided) + bbdb-pop-up-display-layout + bbdb-display-layout)) + (bbdb-get-only-first-address-p nil)) + (gnus-summary-select-article) + (bbdb/gnus-show-records 'recipients))) + +;;; from Brian Edmonds' gnus-bbdb.el +;;; +;;; Filing with gnus-folder REQUIRES (ding) 0.50 OR HIGHER +;;; +;;; To use this feature, you need to put this file somewhere in your +;;; load-path and add the following lines of code to your .gnus file: +;;; +;;; (setq nnmail-split-methods 'bbdb/gnus-split-method) +;;; +;;; You should also examine the variables defvar'd below and customize +;;; them to your taste. They're listed roughly in descending likelihood +;;; of your wanting to change them. Once that is done, you need to add +;;; filing information to your BBDB. There are two fields of interest: +;;; +;;; 1. gnus-private. This field contains the name of the group in which +;;; mail to you from any of the addresses associated with this record +;;; will be filed. Also, any self-copies of mail you send any of the +;;; same addresses will be filed here. +;;; 2. gnus-public. This field is used to keep mail from mailing lists +;;; out of the private mailboxes. It should be added to a record for +;;; the list submission address, and is formatted as follows: +;;; "group regexp" +;;; where group is where mail from the list should be filed, and +;;; regexp is a regular expression which is checked against the +;;; envelope sender (from the From_ header) to verify that this is +;;; the copy which came from the list. For example, the entry for +;;; the ding mailing list might be: +;;; "mail.emacs.ding ding-request@ifi.uio.no" +;;; Yes, the second part *is* a regexp, so those dots may match +;;; something other than dots. Sue me. +;;; +;;; Note that you can also specify a gnus-private field for mailing list +;;; addresses, in which case self-copies of mail you send to the list +;;; will be filed there. Also, the field names can be changed below if +;;; the defaults aren't hip enough for you. Lastly, if you specify a +;;; gnus-private field for your *own* BBDB record, then all self-copies +;;; of mail you send will be filed to that group. +;;; +;;; This documentation should probably be expanded and moved to a +;;; separate file, but it's late, and *I* know what I'm trying to +;;; say. :) + +;;; custom bits +(defcustom bbdb/gnus-split-default-group "mail.misc" + "*If the BBDB doesn't indicate any group to spool a message to, it will +be spooled to this group. If bbdb/gnus-split-crosspost-default is not +nil, and if the BBDB did not indicate a specific group for one or more +addresses, messages will be crossposted to this group in addition to any +group(s) which the BBDB indicated." + :group 'bbdb-mua-specific-gnus-splitting + :type 'string) + +(defcustom bbdb/gnus-split-nomatch-function nil + "*This function will be called after searching the BBDB if no place to +file the message could be found. It should return a group name (or list +of group names) -- nnmail-split-fancy as provided with Gnus is an +excellent choice." + :group 'bbdb-mua-specific-gnus-splitting + :type 'function) + +(defcustom bbdb/gnus-split-myaddr-regexp + (concat "^" (user-login-name) "$\\|^" + (user-login-name) "@\\([-a-z0-9]+\\.\\)*" + (or gnus-local-domain (message-make-domain) + (system-name) "") "$") + "*This regular expression should match your address as found in the +From header of your mail. You should make sure gnus-local-domain or +gnus-use-generic-from are set before loading this module, if they differ +from (system-name). If you send mail/news from multiple addresses, then +you'll likely have to set this yourself anyways." + :group 'bbdb-mua-specific-gnus-splitting + :type 'string) + +(defcustom bbdb/gnus-split-crosspost-default nil + "*If this variable is not nil, then if the BBDB could not identify a +group for every mail address, messages will be filed in +bbdb/gnus-split-default-group in addition to any group(s) which the BBDB +identified." + :group 'bbdb-mua-specific-gnus-splitting + :type 'boolean) + +(defcustom bbdb/gnus-split-private-field 'gnus-private + "*This variable is used to determine the field to reference to find the +associated group when saving private mail for a network address known to +the BBDB. The value of the field should be the name of a mail group." + :group 'bbdb-mua-specific-gnus-splitting + :type 'string) + +(defcustom bbdb/gnus-split-public-field 'gnus-public + "*This variable is used to determine the field to reference to find the +associated group when saving non-private mail (received from a mailing +list) for a network address known to the BBDB. The value of the field +should be the name of a mail group, followed by a space, and a regular +expression to match on the envelope sender to verify that this mail came +from the list in question." + :group 'bbdb-mua-specific-gnus-splitting + :type 'string) + +;; The split function works by assigning one of four spooling priorities +;; to each group that is associated with an address in the message. The +;; priorities are assigned as follows: +;; +;; 0. This priority is assigned when crosspost-default is nil to To/Cc +;; addresses which have no private group defined in the BBDB. If the +;; user's own address has no private group defined, then it will +;; always be given this priority. +;; 1. This priority is assigned to To/Cc addresses which have a private +;; group defined in the BBDB. If crosspost-default is not nil, then +;; To/Cc addresses which have no private group will also be assigned +;; this priority. This is also assigned to the user's own address in +;; the From position if a private group is defined for it. +;; 2. This priority is assigned to From addresses which have a private +;; group defined in the BBDB, except for the user's own address as +;; described under priorities 0 and 1. +;; 3. This priority is assigned to To/Cc addresses which have a public +;; group defined in the BBDB, and whose associated regular expression +;; matches the envelope sender (found in the header From_). +;; +;; The split function evaluates the spool priority for each address in +;; the headers of the message, and returns as a list all the groups +;; associated with the addresses which share the highest calculated +;; priority. + +;;;#autoload +(defun bbdb/gnus-split-method nil + "This function expects to be called in a buffer which contains a mail +message to be spooled, and the buffer should be narrowed to the message +headers. It returns a list of groups to which the message should be +spooled, using the addresses in the headers and information from the +BBDB." + (let ((prq (list (cons 0 nil) (cons 1 nil) (cons 2 nil) (cons 3 nil)))) + ;; the From: header is special + (let* ((hdr (or (mail-fetch-field "resent-from") + (mail-fetch-field "from") + (user-login-name))) + (rv (bbdb/gnus-split-to-group hdr t))) + (setcdr (nth (cdr rv) prq) (cons (car rv) nil))) + ;; do the rest of the headers + (let ((hdr (or (concat (or (mail-fetch-field "resent-to" nil t) + (mail-fetch-field "to" nil t)) + ", " + (mail-fetch-field "cc" nil t) + ", " + (mail-fetch-field "apparently-to" nil t)) + ""))) + (setq hdr (rfc822-addresses hdr)) + (while hdr + (let* ((rv (bbdb/gnus-split-to-group (car hdr))) + (pr (nth (cdr rv) prq))) + (or (member (car rv) pr) (setcdr pr (cons (car rv) (cdr pr))))) + (setq hdr (cdr hdr)))) + ;; find the highest non-empty queue + (setq prq (reverse prq)) + (while (and prq (not (cdr (car prq)))) (setq prq (cdr prq))) + ;; and return... + (if (not (or (not (cdr (car prq))) + (and (equal (cdr (car prq)) (list bbdb/gnus-split-default-group)) + (symbolp bbdb/gnus-split-nomatch-function) + (fboundp bbdb/gnus-split-nomatch-function)))) + (cdr (car prq)) + (goto-char (point-min)) + (funcall bbdb/gnus-split-nomatch-function)))) + +(defun bbdb/gnus-split-to-group (addr &optional source) + "This function is called from bbdb/gnus-split-method in order to +determine the group and spooling priority for a single address." + (condition-case tmp + (progn + (setq tmp (mail-extract-address-components addr)) + (let* ((nam (car tmp)) + (net (if (not bbdb-canonicalize-net-hook) (car (cdr tmp)) + (bbdb-canonicalize-address (car (cdr tmp))))) + (rec (bbdb-search-simple nam net)) + pub prv rgx) + (if (not rec) nil + (setq prv (bbdb-record-getprop rec bbdb/gnus-split-private-field) + pub (bbdb-record-getprop rec bbdb/gnus-split-public-field)) + (if (and pub (not source) (string-match "^\\([^ ]+\\) \\(.*\\)$" pub)) + (setq rgx (substring pub (match-beginning 2) (match-end 2)) + pub (substring pub (match-beginning 1) (match-end 1))) + (setq pub nil))) + (cond + ((and rgx pub + (goto-char (point-min)) + (re-search-forward "^From: \\([^ \n]+\\)[ \n]" nil t) + (string-match rgx (buffer-substring (match-beginning 1) + (match-end 1)))) + (cons pub 3)) + (prv + (cons prv + (- 1 (if source -1 0) + (if (string-match bbdb/gnus-split-myaddr-regexp net) 1 0)))) + (t + (cons bbdb/gnus-split-default-group + (if (string-match bbdb/gnus-split-myaddr-regexp net) 0 + (if source 2 (if bbdb/gnus-split-crosspost-default 1 0)))))))) + (error (cons bbdb/gnus-split-default-group 0)))) + +;; +;; Insinuation +;; + +;;;###autoload +(defun bbdb-insinuate-gnus () + "Call this function to hook BBDB into Gnus." + (setq gnus-optional-headers 'bbdb/gnus-lines-and-from) + (add-hook 'gnus-article-prepare-hook 'bbdb/gnus-pop-up-bbdb-buffer) + (add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save) + (define-key gnus-summary-mode-map ":" 'bbdb/gnus-show-sender) + (define-key gnus-summary-mode-map ";" 'bbdb/gnus-edit-notes) + + ;; Set up user field for use in gnus-summary-line-format + (let ((get-author-user-fun (intern + (concat "gnus-user-format-function-" + bbdb/gnus-summary-user-format-letter))) + (in-bbdb-user-fun (intern + (concat "gnus-user-format-function-" + bbdb/gnus-summary-in-bbdb-format-letter)))) + ; The big one - whole name + (cond (bbdb/gnus-summary-user-format-letter + (if (and (fboundp get-author-user-fun) + (not (eq (symbol-function get-author-user-fun) + 'bbdb/gnus-summary-get-author))) + (bbdb-warn + (format "`gnus-user-format-function-%s' already seems to be in use. +Please redefine `bbdb/gnus-summary-user-format-letter' to a different letter." + bbdb/gnus-summary-user-format-letter)) + (fset get-author-user-fun 'bbdb/gnus-summary-get-author)))) + + ; One tick. One tick only, please + (cond (bbdb/gnus-summary-in-bbdb-format-letter + (if (and (fboundp in-bbdb-user-fun) + (not (eq (symbol-function in-bbdb-user-fun) + 'bbdb/gnus-summary-author-in-bbdb))) + (bbdb-warn + (format "`gnus-user-format-function-%s' already seems to be in use. +Redefine `bbdb/gnus-summary-in-bbdb-format-letter' to a different letter." + bbdb/gnus-summary-in-bbdb-format-letter)) + (fset in-bbdb-user-fun 'bbdb/gnus-summary-author-in-bbdb))))) + + ;; Scoring + (add-hook 'bbdb-after-change-hook 'bbdb/gnus-score-invalidate-alist) +; (setq gnus-score-find-score-files-function +; (if (boundp 'gnus-score-find-score-files-function) +; (cond ((functionp gnus-score-find-score-files-function) +; (list gnus-score-find-score-files-function +; 'bbdb/gnus-score)) +; ((listp gnus-score-find-score-files-function) +; (append gnus-score-find-score-files-function +; 'bbdb/gnus-score)) +; (t 'bbdb/gnus-score)) +; 'bbdb/gnus-score)) + ) + +;; Uwe Brauer +(defun bbdb/gnus-nnimap-folder-list-from-bbdb () + "Return a list of \( \"From\" email-regexp imap-folder-name\) tuples +based on the contents of the bbdb. + +The folder-name is the value of the 'imap attribute on the bbdb +record; the email-regexp consists of all the email addresses for the +bbdb record concatenated with with OR. bbdb records without a 'imap +attribute are ignored. +Here is an example of a relevant BBDB entry: + +Uwe Brauer + net: oub@mat.ucm.es + imap: testimap + + +This function uses regexp-opt to generate the email-regexp which +automatically regexp-quotes its arguments. Please note: in oder that +this will work with the nnimap-split-fancy method you have to use +macros, that is your setting will look like: + +\(setq + nnimap-split-rule 'nnimap-split-fancy + nnimap-split-inbox \"INBOX\" + nnimap-split-fancy + `\(| + ,@\(bbdb/gnus-nnimap-folder-list-from-bbdb\) + ... +\)\) +Note that `\( is the backquote NOT the quote '\(. " + + ;(interactive) + (let ( ;; the raw-notes attribute of a bbdb record + notes-attr + ;; the value of the 'imap attribute of a bbdb record + folder-attr + ;; strings to put before and after the folder-attr + (folder-prefix "") + (folder-postfix "") + ;; a regexp matching all the email addresses from a bbdb record + email-regexp + ;; the list of (folder email) tuples to return + new-elmnt-list + ) + ;; loop over the bbdb-records; if a imap attribute exists on + ;; the record, generate a regexp matching all the email addresses + ;; and add a tuple (folder email-regexp) to the new-elmnt-list + (dolist (record (bbdb-records)) + (setq notes-attr (bbdb-record-raw-notes record)) + (when (and (listp notes-attr) + (setq folder-attr (cdr (assq 'imap notes-attr)))) + (setq email-regexp (regexp-opt (mapcar 'downcase + (bbdb-record-net record)))) + (unless (zerop (length email-regexp)) + (setq new-elmnt-list + (cons (list "From" email-regexp (concat folder-prefix + folder-attr folder-postfix)) + new-elmnt-list))))) + new-elmnt-list)) + + +(provide 'bbdb-gnus) diff --git a/lisp/bbdb-gui.el b/lisp/bbdb-gui.el new file mode 100644 index 0000000..867bef5 --- /dev/null +++ b/lisp/bbdb-gui.el @@ -0,0 +1,530 @@ +;;; -*- Mode:Emacs-Lisp -*- +;;; This file contains font and menu hacks for BBDB. + +;;; This file is the part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1992, 1993, 1994 Jamie Zawinski <jwz@netscape.com>. + +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; This code is kind of kludgey, mostly because it needs to parse the contents +;;; of the *BBDB* buffer, since BBDB doesn't save the buffer-positions of the +;;; various fields when it fills in that buffer (doing that would be slow and +;;; cons a lot, so it doesn't seem to be worth it.) + +(require 'bbdb) +(require 'bbdb-com) + +(eval-and-compile + (if (featurep 'xemacs) + (require 'overlay))) + +;; compiler whinage. Some of this is legacy stuff that would probably +;; be better deleted. +(defvar scrollbar-height nil) + +;; MIGRATE XXX +(eval-and-compile + (if (fboundp 'set-specifier) + (defalias 'bbdb-set-specifier 'set-specifier) + (defalias 'bbdb-set-specifier 'ignore)) + (if (fboundp 'make-glyph) + (defalias 'bbdb-make-glyph 'make-glyph) + (defalias 'bbdb-make-glyph 'ignore)) + (if (fboundp 'set-glyph-face) + (defalias 'bbdb-set-glyph-face 'set-glyph-face) + (defalias 'bbdb-set-glyph-face 'ignore)) + (if (fboundp 'highlight-headers-x-face) + (defalias 'bbdb-highlight-headers-x-face 'highlight-headers-x-face) + (defalias 'bbdb-highlight-headers-x-face 'ignore)) + (if (fboundp 'highlight-headers-x-face-to-pixmap) + (defalias 'bbdb-highlight-headers-x-face-to-pixmap + 'highlight-headers-x-face-to-pixmap) + (defalias 'bbdb-highlight-headers-x-face-to-pixmap 'ignore))) + + +(if (featurep 'xemacs) + (progn + (define-key bbdb-mode-map 'button3 'bbdb-menu) + (define-key bbdb-mode-map 'button2 + (lambda (e) + (interactive "e") + (mouse-set-point e) + (bbdb-toggle-records-display-layout nil)))) + (define-key bbdb-mode-map [mouse-3] 'bbdb-menu) + (define-key bbdb-mode-map [mouse-2] + (lambda (e) + (interactive "e") + (mouse-set-point e) + (bbdb-toggle-records-display-layout nil)))) + +(eval-and-compile + (if (fboundp 'find-face) + (defalias 'bbdb-find-face 'find-face) + (if (fboundp 'internal-find-face) ;; GRR. + ;; This should be facep in Emacs 21 + (defalias 'bbdb-find-face 'internal-find-face) + (defalias 'bbdb-find-face 'ignore)))) ; noop - you probably don't HAVE faces. + +(or (bbdb-find-face 'bbdb-name) + (face-differs-from-default-p (make-face 'bbdb-name)) + (set-face-underline-p 'bbdb-name t)) + +(condition-case nil + (or (bbdb-find-face 'bbdb-company) + (face-differs-from-default-p (make-face 'bbdb-company)) + (make-face-italic 'bbdb-company)) ;; this can fail on emacs + (error nil)) + +(or (bbdb-find-face 'bbdb-field-value) + (make-face 'bbdb-field-value)) + +(or (bbdb-find-face 'bbdb-field-name) + (face-differs-from-default-p (make-face 'bbdb-field-name)) + (copy-face 'bold 'bbdb-field-name)) + +;;; Extents vs. Overlays unhappiness +;;; FIXME: see if VM is around, and call its extents code instead; +;;; change bbdb-foo-extents below to vm-foo-extents, etc. +(eval-and-compile + (if (fboundp 'make-extent) + (defalias 'bbdb-make-extent 'make-extent) + (defalias 'bbdb-make-extent 'make-overlay)) + + (if (fboundp 'delete-extent) + (defalias 'bbdb-delete-extent 'delete-extent) + (defalias 'bbdb-delete-extent 'delete-overlay)) + + (if (fboundp 'mapcar-extents) + (defmacro bbdb-list-extents() `(mapcar-extents 'identity)) + (defun bbdb-list-extents() + (let ((o (overlay-lists))) (nconc (car o) (cdr o))))) + + (if (fboundp 'mapcar-extents) + (defmacro bbdb-extents-in (s e) + (list 'mapcar-extents ''identity nil nil s e)) + (defmacro bbdb-extents-in (s e) + (list 'overlays-in s e))) + + (if (fboundp 'set-extent-property) + (defalias 'bbdb-set-extent-property 'set-extent-property) + (defun bbdb-set-extent-property( e p v ) + (if (eq 'highlight p) + (if v + (overlay-put e 'mouse-face 'highlight) + (overlay-put e 'mouse-face nil))) + (overlay-put e p v))) + + (if (fboundp 'extent-property) + (defalias 'bbdb-extent-property 'extent-property) + (defalias 'bbdb-extent-property 'overlay-get)) + + (if (fboundp 'extent-at) + (defalias 'bbdb-extent-at 'extent-at) + (defun bbdb-extent-at (pos buf tag) "NOT FULL XEMACS IMPLEMENTATION" + (let ((o (overlays-at pos)) + minpri retval) + (while (car o) + (let ((x (car o))) + (and (overlayp x) + (overlay-get x tag) + (if (or (null minpri) (> minpri (overlay-get x 'priority))) + (setq retval x + minpri (overlay-get x 'priority)))) + (setq o (cdr o)))) + retval))) + + (if (fboundp 'highlight-extent) + (defalias 'bbdb-highlight-extent 'highlight-extent) + (defalias 'bbdb-highlight-extent 'ignore)) ; XXX noop + + (if (fboundp 'extent-start-position) + (defalias 'bbdb-extent-start-position 'extent-start-position) + (defalias 'bbdb-extent-start-position 'overlay-start)) + + (if (fboundp 'extent-end-position) + (defalias 'bbdb-extent-end-position 'extent-end-position) + (defalias 'bbdb-extent-end-position 'overlay-end)) + + (if (fboundp 'extent-face) + (defalias 'bbdb-extent-face 'extent-face) + (defun bbdb-extent-face (extent) + (overlay-get extent 'face))) + + (if (fboundp 'set-extent-face) + (defalias 'bbdb-set-extent-face 'set-extent-face) + (defun bbdb-set-extent-face (extent face) "set the face for an overlay" + (overlay-put extent 'face face))) + + (if (fboundp 'set-extent-begin-glyph) + (defalias 'bbdb-set-extent-begin-glyph 'set-extent-begin-glyph) + (defalias 'bbdb-set-extent-begin-glyph 'ignore)) ; XXX noop + + (if (fboundp 'set-extent-end-glyph) + (defalias 'bbdb-set-extent-end-glyph 'set-extent-end-glyph) + (defalias 'bbdb-set-extent-end-glyph 'ignore))) ; XXX noop + + +(eval-when-compile (defvar scrollbar-height)) +;;;###autoload +(defun bbdb-fontify-buffer (&optional records) + (interactive) + (save-excursion + (set-buffer bbdb-buffer-name) + (if (featurep 'scrollbar) + (bbdb-set-specifier scrollbar-height (cons (current-buffer) 0))) + + (let ((rest (or records bbdb-records)) + record face + start end s e + multi-line-p + property + extent) + + (while rest + (setq record (car (car rest)) + multi-line-p (string-match "multi-line" + (symbol-name (nth 1 (car rest)))) + face (and multi-line-p (bbdb-record-getprop record 'face)) + start (marker-position (nth 2 (car rest))) + end (1- (or (nth 2 (car (cdr rest))) (point-max)))) + + (if (< start (point-min)) (setq start (point-min))) + (if (> end (point-max)) (setq end (point-max))) + + (mapc (function (lambda(o) + (if (and o + (eq (bbdb-extent-property o 'data) + 'bbdb)) + (bbdb-delete-extent o)))) + (bbdb-extents-in start end)) + + (setq extent (bbdb-make-extent start end)) + (bbdb-set-extent-property extent 'highlight t) + (bbdb-set-extent-property extent 'data 'bbdb) + ;; note that on GNU Emacs, once you hit the main overlay, you + ;; have to move off the record and back on again before it'll + ;; notice that you're on a more specific overlay. This is + ;; bogus, like most GNU Emacs GUI stuff. + (bbdb-set-extent-property extent 'priority 3) + (if face (bbdb-hack-x-face face extent)) + (goto-char start) + (setq s start) + (setq property (cadr (member 'bbdb-field (text-properties-at s)))) + (while (and s (< s end)) + (setq e (or (next-single-property-change (1+ s) 'bbdb-field) + (point-max))) + (cond ((equal property '(name)) + (setq extent (bbdb-make-extent s e)) + (bbdb-set-extent-property extent 'priority 2) + (bbdb-set-extent-property extent 'data 'bbdb) + (bbdb-set-extent-face extent 'bbdb-name)) + ((equal property '(company)) + (setq extent (bbdb-make-extent s e)) + (bbdb-set-extent-property extent 'priority 2) + (bbdb-set-extent-property extent 'data 'bbdb) + (bbdb-set-extent-face extent 'bbdb-company)) + ((member 'field-name property) + (goto-char s) + (setq extent (bbdb-make-extent s e)) + (bbdb-set-extent-property extent 'priority 2) + (bbdb-set-extent-property extent 'data 'bbdb) + (bbdb-set-extent-face extent 'bbdb-field-name)) + (t + (setq extent (bbdb-make-extent start e)) + (bbdb-set-extent-property extent 'priority 2) + (bbdb-set-extent-property extent 'data 'bbdb) + (bbdb-set-extent-face extent 'bbdb-field-value))) + (setq s e) + (while (and s (null (setq property + (cadr (member 'bbdb-field + (text-properties-at s)))))) + (setq s (next-single-property-change s 'bbdb-field)))) + + (setq rest (cdr rest)) + (if (null (caar rest)) + (setq rest nil)))))) + +;;; share the xface cache data with VM if it's around +(defvar vm-xface-cache (make-vector 29 0)) +(eval-when-compile (defvar highlight-headers-hack-x-face-p)) + +;; In Emacs 21, this could use the x-face support from Gnus. +(defun bbdb-hack-x-face (face extent) + "Process a face property of a record and honour it. +Not done for GNU Emacs just yet, since it doesn't have image support +as of GNU Emacs 20.7" + (if (not (or (and (fboundp 'highlight-headers-hack-x-face-p) + (symbol-value (intern ;; compiler + "highlight-headers-hack-x-face-p"))) ;; ick. + (and (featurep 'xemacs) + (string-match "^21\\." emacs-version)))) ;; XXX + () ;; nothing doing + (setq face (bbdb-split face "\n")) + (while face + (cond + + ;; ripped pretty much verbatim from VM; X Faces for recent XEmacsen. + ((string-match "^21\\." emacs-version) ;; XXX how far back can I go? + (condition-case nil + (let* ((h (concat "X-Face: " (car face))) ;; from vm-display-xface + (g (intern h vm-xface-cache))) + (if (bbdb-find-face 'vm-xface) ;; use the same face as VM + nil + (make-face 'vm-xface) + (set-face-background 'vm-xface "white") + (set-face-foreground 'vm-xface "black")) + (if (boundp g) + (setq g (symbol-value g)) + (set g (bbdb-make-glyph + (list + (vector 'xface ':data h)))) ;; XXX use API + (setq g (symbol-value g)) + (bbdb-set-glyph-face g 'vm-xface)) + (bbdb-set-extent-property extent 'vm-xface t) + (bbdb-set-extent-begin-glyph extent g)) + (error nil))) ;; looks like you don't have xface support, d00d + + ;; requires lemacs 19.10 version of highlight-headers.el + ((fboundp 'highlight-headers-x-face) ; the 19.10 way + (bbdb-highlight-headers-x-face (car face) extent) + (let ((b (bbdb-extent-property extent 'begin-glyph))) + (cond (b ; I'd like this to be an end-glyph instead + (bbdb-set-extent-property extent 'begin-glyph nil) + (bbdb-set-extent-property extent 'end-glyph b))))) + + ((fboundp 'highlight-headers-x-face-to-pixmap) ; the 19.13 way + (save-excursion + (set-buffer (get-buffer-create " *tmp*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert (car face)) + (bbdb-set-extent-begin-glyph extent nil) + (bbdb-set-extent-end-glyph extent + (bbdb-highlight-headers-x-face-to-pixmap + (point-min) (point-max))) + (erase-buffer)))) + + ;; more faces? + (setq face (cdr face)) + (cond (face ; there are more, so clone the extent + (setq extent (bbdb-make-extent + (bbdb-extent-start-position extent) + (bbdb-extent-end-position extent))) + (bbdb-set-extent-property extent 'data 'bbdb)))))) + + +(defcustom bbdb-user-menu-commands nil + "User defined menu entries which should be appended to the BBDB menu. +This should be a list of menu entries. +When set to a fucntion the function gets called with two arguments the +RECORD and the FIELD and it should either return nil or a list of menu +entries." + :group 'bbdb-database + :type 'sexp) + +(defun build-bbdb-finger-menu (record) + (let ((addrs (bbdb-record-finger-host record))) + (if (cdr addrs) + (cons "Finger..." + (nconc + (mapcar (lambda (addr) + (vector addr (list 'bbdb-finger record addr) + t)) + addrs) + (list "----" + (vector "Finger all addresses" + (list 'bbdb-finger record ''(4)) t)))) + (vector (concat "Finger " (car addrs)) + (list 'bbdb-finger record (car addrs)) t)))) + +(defun build-bbdb-sendmail-menu (record) + (let ((addrs (bbdb-record-net record))) + (if (cdr addrs) + (cons "Send Mail..." + (mapcar (lambda (addr) + (vector addr (list 'bbdb-send-mail-internal + (bbdb-dwim-net-address record addr)) + t)) + addrs)) + (vector (concat "Send mail to " (car addrs)) + (list 'bbdb-send-mail-internal + (bbdb-dwim-net-address record (car addrs))) + t)))) + + +(defun build-bbdb-field-menu (record field) + (let ((type (car field))) + (nconc + (list + (concat "Commands for " + (cond ((eq type 'property) + (concat "\"" + (symbol-name (if (consp (car (cdr field))) + (car (car (cdr field))) + (car (cdr field)))) + "\" field:")) + ((eq type 'name) "Name field:") + ((eq type 'company) "Company field:") + ((eq type 'net) "Network Addresses field:") + ((eq type 'aka) "Alternate Names field:") + (t + (concat "\"" (aref (nth 1 field) 0) "\" " + (capitalize (symbol-name type)) " field:")))) + "-----" + ["Edit Field" bbdb-edit-current-field t] + ) + (if (memq type '(name company)) + nil + (list ["Delete Field" bbdb-delete-current-field-or-record t])) + (cond ((eq type 'phone) + (list (vector (concat "Dial " (bbdb-phone-string (car (cdr field)))) + (list 'bbdb-dial (list 'quote field) nil) t))) + ) + ))) + + +(defun build-bbdb-insert-field-menu (record) + (cons "Insert New Field..." + (mapcar + (lambda (field) + (let ((type (if (string= (car field) "AKA") + 'aka + (intern (car field))))) + (vector (car field) + (list 'bbdb-insert-new-field + record + (list 'quote type) + (list 'bbdb-prompt-for-new-field-value + (list 'quote type))) + (not + (or (and (eq type 'net) (bbdb-record-net record)) + (and (eq type 'aka) (bbdb-record-aka record)) + (and (eq type 'notes) (bbdb-record-notes record)) + (and (consp (bbdb-record-raw-notes record)) + (assq type (bbdb-record-raw-notes record)))))))) + (append '(("phone") ("address") ("net") ("AKA") ("notes")) + (bbdb-propnames))))) + + +(defun build-bbdb-menu (record field) + (delete + nil + (append + '("bbdb-menu" "Global BBDB Commands" "-----") + (list + ["Save BBDB" bbdb-save-db t] + ["Toggle All Records Display Layout" + bbdb-toggle-all-records-display-layout t] + ["Finger All Records" (bbdb-finger (mapcar 'car bbdb-records)) t] + ["BBDB Manual" bbdb-info t] + ["BBDB Quit" bbdb-bury-buffer t]) + (if record + (list + "-----" + (concat "Commands for record \"" + (bbdb-record-name record) "\":") + "-----" + (vector "Delete Record" + (list 'bbdb-delete-current-record record) t) + ["Toggle Records Display Layout" bbdb-toggle-records-display-layout t] + (if (and (not (eq 'full-multi-line + (nth 1 (assq record bbdb-records)))) + (bbdb-display-layout-get-option 'multi-line 'omit)) + ["Fully Display Record" bbdb-display-record-completely t]) + ["Omit Record" bbdb-omit-record t] + ["Refile (Merge) Record" bbdb-refile-record t] + )) + (if record + (list (build-bbdb-finger-menu record))) + (if (bbdb-record-net record) + (list (build-bbdb-sendmail-menu record))) + (if record + (list (build-bbdb-insert-field-menu record))) + (if field + (cons "-----" (build-bbdb-field-menu record field))) + (if bbdb-user-menu-commands + (let ((menu (if (functionp bbdb-user-menu-commands) + (funcall bbdb-user-menu-commands record field) + bbdb-user-menu-commands))) + (if menu + (append ["-----"] + ["User Defined Commands"] + ["-----"] + menu))))))) + +(eval-and-compile + (if (fboundp 'popup-menu) + (progn + (fset 'bbdb-popup 'popup-menu) + (fset 'bbdb-desc-to-menu 'identity)) + ;; This is really, REALLY ugly, but it saves me some coding and uses + ;; the correct keymap API instead of carnal knowledge of keymap + ;; structure. + (defun bbdb-desc-to-menu(desc) + (let ((map (make-sparse-keymap (car desc))) + (desc (reverse (cdr desc))) ;; throw away header, reorient list + (txtcount 0) elt elt-name) + (while (setq elt (car desc)) + ;; fake a key binding name + (setq elt-name (intern (format "fake%d" txtcount)) + txtcount (+ 1 txtcount)) + (cond + ;; non-active entries in the menu + ((stringp elt) + (define-key map (vector elt-name) (list elt))) + + ;; active entries in the menu + ((vectorp elt) + (define-key map (vector elt-name) (cons (aref elt 0) (aref elt 1)))) + + ;; submenus + ((listp elt) + (define-key map (vector elt-name) + (cons (car elt) (bbdb-desc-to-menu elt)))) + ) + (setq desc (cdr desc))) + map)) + ;; this does the actual popping up & parsing nonsense + (defun bbdb-popup( desc &optional event ) + (let ((map (bbdb-desc-to-menu desc)) result) + (setq result (x-popup-menu t map)) + (if result + (let ((command (lookup-key map (vconcat result)))) + ;; Clear out echoing, which perhaps shows a prefix arg. + (message "") + (if command + (if (commandp command) + (command-execute command) + (funcall 'eval command))))))))) + +;;;###autoload +(defun bbdb-menu (event) + (interactive "e") + (mouse-set-point event) + (bbdb-popup + (save-window-excursion + (save-excursion + (let ((extent (or (bbdb-extent-at (point) (current-buffer) 'highlight) + (error ""))) + record field) + (or (eq (bbdb-extent-property extent 'data) 'bbdb) + (error "not a bbdb extent")) + (bbdb-highlight-extent extent t) + (setq record (bbdb-current-record) + field (get-text-property (point) 'bbdb-field)) + (build-bbdb-menu record field)))))) + +;; tell everyone else we're here. +(provide 'bbdb-gui) diff --git a/lisp/bbdb-hooks.el b/lisp/bbdb-hooks.el new file mode 100644 index 0000000..09b1e89 --- /dev/null +++ b/lisp/bbdb-hooks.el @@ -0,0 +1,713 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski <jwz@netscape.com>. +;;; Various additional functionality for the BBDB. See bbdb.texinfo. + +;;; The Insidious Big Brother Database 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 or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; This file lets you do stuff like +;;; +;;; o automatically update a "timestamp" field each time a record is +;;; modified +;;; o automatically add some string to the notes field(s) based on the +;;; contents of header fields of the current message +;;; o only automatically create entries when certain header fields +;;; are matched +;;; o don't automatically create entries when certain header fields +;;; are matched +;;; +;;; Read the docstrings; read the texinfo file. + +(require 'bbdb) +(require 'bbdb-com) +(require 'bbdb-autoloads) +(require 'mail-parse) + +(eval-when-compile + (condition-case() + (progn + (require 'gnus) + (require 'bbdb-gnus)) + (error nil)) + (condition-case() + (progn + (require 'vm) + (require 'vm-version) + (require 'bbdb-vm)) + (error nil)) + (autoload 'mh-show "mh-e") + (condition-case() + (require 'bbdb-rmail) + (error (message "Warning: Could not load RMAIL"))) + (condition-case() + (require 'bbdb-mhe) + (error (message "Warning: Could not load MHE")))) + +(defvar rmail-buffer) +(defvar mh-show-buffer) + + +(defvar bbdb-time-internal-format "%Y-%m-%d" + "The internal date format.") + +;;;###autoload +(defun bbdb-timestamp-hook (record) + "For use as a `bbdb-change-hook'; maintains a notes-field called `timestamp' +for the given record which contains the time when it was last modified. If +there is such a field there already, it is changed, otherwise it is added." + (bbdb-record-putprop record 'timestamp (format-time-string + bbdb-time-internal-format + (current-time)))) + +;;;###autoload +(defun bbdb-creation-date-hook (record) + "For use as a `bbdb-create-hook'; adds a notes-field called `creation-date' +which is the current time string." + ;; hey buddy, we've known about your antics since the eighties... + (bbdb-record-putprop record 'creation-date (format-time-string + bbdb-time-internal-format + (current-time)))) + + +;;; Determining whether to create a record based on the content of the +;;; current message. + +(eval-when-compile + (defvar vm-mail-buffer) + (defvar vm-message-pointer) + (autoload 'vm-start-of "vm") + (autoload 'bbdb/vm-pop-up-bbdb-buffer "bbdb-vm")) + +;;;###autoload +(defun bbdb-header-start () + "Returns a marker at the beginning of the header block of the current +message. This will not necessarily be in the current buffer." + (cond ((memq major-mode + '(gnus-group-mode gnus-summary-mode gnus-article-mode)) + (set-buffer (or gnus-original-article-buffer + gnus-article-buffer)) + (point-min-marker)) + ((memq major-mode '(vm-presentation-mode vm-mode vm-summary-mode)) + (if vm-mail-buffer (set-buffer vm-mail-buffer)) + (vm-start-of (car vm-message-pointer))) + ((memq major-mode '(rmail-mode rmail-summary-mode)) + (if (and (boundp 'rmail-buffer) rmail-buffer) + (set-buffer rmail-buffer)) + (point-min-marker)) + ;; MH-E clause added by knabe. + ((eq major-mode 'mh-folder-mode) + (mh-show) + (set-buffer mh-show-buffer) + (point-min-marker)) + (t (point-min-marker)) + )) + + +;;;###autoload +(defun bbdb-extract-field-value (field-name) + "Given the name of a field (like \"Subject\") this returns the value of +that field in the current message, or nil. This works whether you're in +Gnus, Rmail, or VM. This works on multi-line fields, but if more than +one field of the same name is present, only the last is returned. It is +expected that the current buffer has a message in it, and (point) is at the +beginning of the message headers." + ;; we can't special-case VM here to use its cache, because the cache has + ;; divided real-names from addresses; the actual From: and Subject: fields + ;; exist only in the message. + (save-excursion + (if (memq major-mode + '(gnus-summary-mode gnus-article-mode gnus-tree-mode)) + (progn + (set-buffer (get-buffer gnus-original-article-buffer)) + (goto-char (point-min)))) + (setq field-name (concat (regexp-quote field-name) "[ \t]*:[ \t]*")) + (let ((case-fold-search t) + done) + (while (not (or done + (looking-at "\n") ; we're at BOL + (eobp))) + (if (looking-at field-name) + (progn + (goto-char (match-end 0)) + (setq done (buffer-substring (point) + (progn (end-of-line) (point)))) + (while (looking-at "\n[ \t]") + (setq done (concat done " " + (buffer-substring (match-end 0) + (progn (end-of-line 2) (point)))))))) + (forward-line 1)) + (and done + (mail-decode-encoded-word-string done))))) + +(defcustom bbdb-ignore-most-messages-alist '() + "*An alist describing which messages to automatically create BBDB +records for. This only works if bbdb/news-auto-create-p or +bbdb/mail-auto-create-p (or both) is 'bbdb-ignore-most-messages-hook. +The format of this alist is + (( HEADER-NAME . REGEXP ) ... ) +for example, + ((\"From\" . \"@.*\\.maximegalon\\.edu\") + (\"Subject\" . \"time travel\")) +will cause BBDB entries to be made only for messages sent by people at +Maximegalon U., or (that's *or*) people posting about time travel. + +See also bbdb-ignore-some-messages-alist, which has the opposite effect." + :group 'bbdb-noticing-records + :type '(repeat (cons + (string :tag "Header name") + (regexp :tag "Regex to match on header value")))) + + +(defcustom bbdb-ignore-some-messages-alist '() + "*An alist describing which messages *not* to automatically create +BBDB records for. This only works if bbdb/news-auto-create-p or +bbdb/mail-auto-create-p (or both) is 'bbdb-ignore-some-messages-hook. +The format of this alist is + (( HEADER-NAME . REGEXP ) ... ) +for example, + ((\"From\" . \"mailer-daemon\") + (\"To\" . \"mailing-list-1\\\\|mailing-list-2\") + (\"CC\" . \"mailing-list-1\\\\|mailing-list-2\")) +will cause BBDB entries to not be made for messages from any mailer daemon, +or messages sent to or CCed to either of two mailing lists. + +See also bbdb-ignore-most-messages-alist, which has the opposite effect." + :group 'bbdb-noticing-records + :type '(repeat (cons + (string :tag "Header name") + (regexp :tag "Regex to match on header value")))) + + +;;;###autoload +(defun bbdb-ignore-most-messages-hook (&optional invert-sense) + "For use as the value of bbdb/news-auto-create-p or bbdb/mail-auto-create-p. +This will automatically create BBDB entries for messages which match +the bbdb-ignore-most-messages-alist (which see) and *no* others." + ;; don't need to optimize this to check the cache, because if + ;; bbdb/*-update-record uses the cache, this won't be called. + (let ((rest (if invert-sense + bbdb-ignore-some-messages-alist + bbdb-ignore-most-messages-alist)) + (case-fold-search t) + (done nil) + (b (current-buffer)) + (marker (bbdb-header-start)) + field regexp fieldval) + (set-buffer (marker-buffer marker)) + (save-restriction + (widen) + (while (and rest (not done)) + (goto-char marker) + (setq field (car (car rest)) + regexp (cdr (car rest)) + fieldval (bbdb-extract-field-value field)) + (if (and fieldval (string-match regexp fieldval)) + (setq done t)) + (setq rest (cdr rest)))) + (set-buffer b) + (if invert-sense + (not done) + done))) + +;;; Provided by Bill Carpenter. +(defvar bbdb-ignore-selected-messages-confirmation nil + "*If bbdb-ignore-selected-messages-hook is used as an auto-create-hook, this +variable governs whether you are prompted for creation of BBDB entries.") + +;;;###autoload +(defun bbdb-ignore-selected-messages-hook () + "For use as a bbdb/news-auto-create-hook or bbdb/mail-auto-create-hook. +This will automatically create BBDB entries for messages based on a +combination of bbdb-ignore-some-messages-alist and +bbdb-ignore-most-messages-alist. It first looks at the SOME list. If +that doesn't disqualify a message, then it looks at the MOST list. If +that qualifies the message, the record is auto-created, but a +confirmation is conditionally sought, based on the value of +`bbdb-ignore-selected-messages-confirmation'." + (if (bbdb-ignore-some-messages-hook) + ;; wasn't ruled out + (if (bbdb-ignore-most-messages-hook) + ;; was ruled in + (if bbdb-ignore-selected-messages-confirmation + (let ((case-fold-search t) + (marker (bbdb-header-start)) + record-exists from) + (save-excursion + (set-buffer (marker-buffer marker)) + (save-restriction + (widen) + (goto-char marker) + (setq from (bbdb-extract-field-value "FROM")))) + (setq record-exists (bbdb-annotate-message-sender from)) + (or record-exists + (y-or-n-p (concat "Create BBDB record from " from "? ")))) + ;; no confirmation desired so let it be + t) + nil) + nil)) + +;;;###autoload +(defun bbdb-ignore-some-messages-hook () + "For use as a `bbdb/news-auto-create-hook' or `bbdb/mail-auto-create-hook'. +This will automatically create BBDB entries for messages which do *not* +match the `bbdb-ignore-some-messages-alist' (which see)." + (bbdb-ignore-most-messages-hook t)) + + +;;; Automatically add to the notes field based on the current message. + +(defcustom bbdb-auto-notes-alist nil + "*An alist which lets you have certain pieces of text automatically added +to the BBDB record representing the sender of the current message based on +the subject or other header fields. This only works if `bbdb-notice-hook' +contains `bbdb-auto-notes-hook'. The format of this alist is + + ((HEADER-NAME [ADDRESS-CLASS-LIST] + (REGEXP . STRING) ... ) + ... ) +for example, + ((\"To\" (\"-vm@\" . \"VM mailing list\")) + (\"Subject\" (\"sprocket\" . \"mail about sprockets\") + (\"you bonehead\" . \"called me a bonehead\"))) + +will cause the text \"VM mailing list\" to be added to the notes field of +the record corresponding to anyone you get mail from via one of the VM +mailing lists. If, that is, `bbdb/mail-auto-create-p' is set such that the +record would have been created, or the record already existed. + +A ADDRESS-CLASS-LIST is optional and by default actions will be performed only +for records of authors of a message. However, by giving an list of classes +specified in `bbdb-get-addresses-headers'. Actions will then only be +performed if the currently processed email is of a class listed in +ADDRESS-CLASS-LIST. ADDRESS-CLASS-LIST might also be an alist with elements +of the form (CLASS . HEADER) which allows actions only when the current +address matches one of the elemets. + +The format of elements of this list may also be + (REGEXP FIELD-NAME STRING) +or + (REGEXP FIELD-NAME STRING REPLACE-P) +instead of + (REGEXP . STRING) + +meaning add the given string to the named field. The field-name may not +be name, address, phone, or net (builtin fields) but must be either ``notes,'' +``company,'' or the name of a user-defined note-field. + (\"pattern\" . \"string to add\") +is equivalent to + (\"pattern\" notes \"string to add\") + +STRING can contain \\& or \\N escapes like in function +`replace-match'. For example, to automatically add the contents of the +\"organization\" field of a message to the \"company\" field of a BBDB +record, you can use this: + + (\"Organization\" (\".*\" company \"\\\\&\")) + +\(Note you need two \\ to get a single \\ into a lisp string literal.\) + +If STRING is an integer N, the N'th matching subexpression is used, so +the above example could be written more efficiently as + + (\"Organization\" (\".*\" company 0)) + +If STRING is neither a string or an integer, it should be a function, which +will be called with the contents of the field. The result of that function +call is used as the field value (the returned value must be a string.) + +If REPLACE-P is t, the string replaces the old contents instead of +being appended to it. + +If multiple clauses match the message, all of the corresponding strings +will be added. + +This works for news as well. You might want to arrange for this to have +a different value when in mail as when in news. + +See also variables `bbdb-auto-notes-ignore' and `bbdb-auto-notes-ignore-all'." + :group 'bbdb-noticing-records + :type '(repeat + (bbdb-alist-with-header + (string :tag "Header name") + (repeat (choice + (cons :tag "Address Class" + (repeat (choice + (const authors) + (const recipients)))) + (cons :tag "Value Pair" + (regexp :tag "Regexp to match on header value") + (string :tag "String for notes if regexp matches")) + (list :tag "Replacement list" + (regexp :tag "Regexp to match on header value") + (choice :tag "Record field" + (const notes :tag "Notes") + (const company :tag "Company") + (symbol :tag "Other")) + (choice :tag "Regexp match" + (string :tag "Replacement string") + (integer :tag "Subexpression match") + (function :tag "Callback Function")) + (choice :tag "Replace previous contents" + (const :tag "No" nil) + (const :tag "Yes" t)))))))) + +(defcustom bbdb-auto-notes-ignore nil + "Alist of headers and regexps to ignore in `bbdb-auto-notes-hook'. +Each element looks like + + (HEADER . REGEXP) + +For example, + + (\"Organization\" . \"^Gatewayed from\\\\\|^Source only\") + +would exclude the phony `Organization:' headers in GNU mailing-lists +gatewayed to gnu.* newsgroups. Note that this exclusion applies only +to a single field, not to the entire message. For that, use the variable +`bbdb-auto-notes-ignore-all'." + :group 'bbdb-noticing-records + :type '(repeat (cons + (string :tag "Header name") + (regexp :tag "Regexp to match on header value")))) + +(defcustom bbdb-auto-notes-ignore-all nil + "Alist of headers and regexps which cause the entire message to be ignored +in `bbdb-auto-notes-hook'. Each element looks like + + (HEADER . REGEXP) + +For example, + + (\"From\" . \"BLAT\\\\.COM\") + +would exclude any notes recording for message coming from BLAT.COM. +Note that this is different from `bbdb-auto-notes-ignore', which applies +only to a particular header field, rather than the entire message." + :group 'bbdb-noticing-records + :type '(repeat (cons + (string :tag "Header name") + (regexp :tag "Regexp to match on header value")))) + + +;;;###autoload +(defun bbdb-auto-notes-hook (record) + "For use as a `bbdb-notice-hook'. This might automatically add some text +to the notes field of the BBDB record corresponding to the current record +based on the header of the current message. See the documentation for +the variables `bbdb-auto-notes-alist' and `bbdb-auto-notes-ignore'." + ;; This could stand to be faster... + ;; could optimize this to check the cache, and noop if this record is + ;; cached for any other message, but that's probably not the right thing. + (unless bbdb-readonly-p + (let ((rest bbdb-auto-notes-alist) + (ignore-all bbdb-auto-notes-ignore-all) + (case-fold-search t) + (b (current-buffer)) + (marker (bbdb-header-start)) + ignore + field pairs fieldval ; do all bindings here for speed + regexp string notes-field-name notes + replace-p) + (set-buffer (marker-buffer marker)) + (save-restriction + (widen) + (goto-char marker) + (if (and (setq fieldval (bbdb-extract-field-value "From")) + (string-match (bbdb-user-mail-names) fieldval)) + ;; Don't do anything if this message is from us. Note that we have + ;; to look at the message instead of the record, because the record + ;; will be of the recipient of the message if it is from us. + nil + ;; check the ignore-all pattern + (while (and ignore-all (not ignore)) + (goto-char marker) + (setq field (car (car ignore-all)) + regexp (cdr (car ignore-all)) + fieldval (bbdb-extract-field-value field)) + (if (and fieldval + (string-match regexp fieldval)) + (setq ignore t) + (setq ignore-all (cdr ignore-all)))) + + (unless ignore ; ignore-all matched + (while rest ; while there are still clauses in the auto-notes alist + (goto-char marker) + (setq field (car (car rest)) ; name of header, e.g., "Subject" + pairs (cdr (car rest)) ; (REGEXP . STRING) or + ; (REGEXP FIELD-NAME STRING) or + ; (REGEXP FIELD-NAME STRING REPLACE-P) + fieldval (bbdb-extract-field-value field)) ; e.g., Subject line + (when fieldval + ;; we perform the auto notes stuff only for authors of a message + ;; or if explicitly requested + (if (or (symbolp (caar pairs)) (listp (caar pairs))) + (if (or (memq bbdb-update-address-class (car pairs)) + (and (assoc bbdb-update-address-class (car pairs)) + (string= bbdb-update-address-header + (cdr (assoc bbdb-update-address-class + (car pairs)))))) + (setq pairs (cdr pairs)) + (setq pairs nil)) + (if (not (and (eq 'authors bbdb-update-address-class) + (string-match "From" bbdb-update-address-header))) + (setq pairs nil))) + + ;; now handle the remaining pairs + (while pairs + (setq regexp (car (car pairs)) + string (cdr (car pairs))) + (if (consp string) ; not just the (REGEXP . STRING) format + (setq notes-field-name (car string) + replace-p (nth 2 string) ; perhaps nil + string (nth 1 string)) + ;; else it's simple (REGEXP . STRING) + (setq notes-field-name 'notes + replace-p nil)) + (setq notes (bbdb-record-getprop record notes-field-name)) + (let ((did-match + (and (string-match regexp fieldval) + ;; make sure it is not to be ignored + (let ((re (cdr (assoc field + bbdb-auto-notes-ignore)))) + (if re + (not (string-match re fieldval)) + t))))) + ;; An integer as STRING is an index into match-data: + ;; A function as STRING calls the function on fieldval: + (if did-match + (setq string + (cond ((integerp string) ; backward compat + (substring fieldval + (match-beginning string) + (match-end string))) + ((stringp string) + (bbdb-auto-expand-newtext fieldval string)) + (t + (goto-char marker) + (let ((s (funcall string fieldval))) + (or (stringp s) + (null s) + (error "%s returned %s: not a string" + string s)) + s))))) + ;; need expanded version of STRING here: + (if (and did-match + string ; A function as STRING may return nil + (not (and notes + ;; check that STRING is not already + ;; present in the NOTES field + (string-match + (regexp-quote string) + notes)))) + (if replace-p + ;; replace old contents of field with STRING + (progn + (when (not bbdb-silent-running) + (if (eq notes-field-name 'notes) + (message "Replacing with note \"%s\"" string) + (message "Replacing field \"%s\" with \"%s\"" + notes-field-name string))) + (bbdb-record-putprop record notes-field-name string) + (bbdb-maybe-update-display record)) + ;; add STRING to old contents, don't replace + (when (not bbdb-silent-running) + (if (eq notes-field-name 'notes) + (message "Adding note \"%s\"" string) + (message "Adding \"%s\" to field \"%s\"" + string notes-field-name))) + (bbdb-annotate-notes record string notes-field-name)))) + (setq pairs (cdr pairs)))) + (setq rest (cdr rest)))))) + (set-buffer b)))) + +(defun bbdb-auto-expand-newtext (string newtext) + ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT. + ;; Note that in Emacs 18 match data are clipped to current buffer + ;; size...so the buffer had better not be smaller than STRING (arrrrggggh!!) + (let ((pos 0) + (len (length newtext)) + (expanded-newtext "")) + (while (< pos len) + (setq expanded-newtext + (concat expanded-newtext + (let ((c (aref newtext pos))) + (if (= ?\\ c) + (cond ((= ?\& (setq c (aref newtext + (setq pos (1+ pos))))) + (substring string + (match-beginning 0) + (match-end 0))) + ((and (>= c ?1) + (<= c ?9)) + ;; return empty string if N'th + ;; sub-regexp did not match: + (let ((n (- c ?0))) + (if (match-beginning n) + (substring string + (match-beginning n) + (match-end n)) + ""))) + (t (char-to-string c))) + (char-to-string c))))) + (setq pos (1+ pos))) + expanded-newtext)) + + +;;; I use this as the value of bbdb-canonicalize-net-hook; it is provided +;;; as an example for you to customize. + +(defcustom bbdb-canonical-hosts + (mapconcat 'regexp-quote + '("cs.cmu.edu" "ri.cmu.edu" "edrc.cmu.edu" "andrew.cmu.edu" + "mcom.com" "netscape.com" "cenatls.cena.dgac.fr" + "cenaath.cena.dgac.fr" "irit.fr" "enseeiht.fr" "inria.fr" + "cs.uiuc.edu" "xemacs.org") + "\\|") + "Certain sites have a single mail-host; for example, all mail originating +at hosts whose names end in \".cs.cmu.edu\" can (and probably should) be +addressed to \"user@cs.cmu.edu\" instead. This variable lists other hosts +which behave the same way." + :group 'bbdb + :type '(regexp :tag "Regexp matching sites")) + +(defmacro bbdb-match-substring (string match) + (list 'substring string + (list 'match-beginning match) (list 'match-end match))) + +;;;###autoload +(defun sample-bbdb-canonicalize-net-hook (addr) + (cond + ;; + ;; rewrite mail-drop hosts. + ;; + ((string-match + (concat "\\`\\([^@%!]+@\\).*\\.\\(" bbdb-canonical-hosts "\\)\\'") + addr) + (concat (bbdb-match-substring addr 1) (bbdb-match-substring addr 2))) + ;; + ;; Here at Lucid, our workstation names sometimes get into our email + ;; addresses in the form "jwz%thalidomide@lucid.com" (instead of simply + ;; "jwz@lucid.com"). This removes the workstation name. + ;; + ((string-match "\\`\\([^@%!]+\\)%[^@%!.]+@\\(lucid\\.com\\)\\'" addr) + (concat (bbdb-match-substring addr 1) "@" (bbdb-match-substring addr 2))) + ;; + ;; Another way that our local mailer is misconfigured: sometimes addresses + ;; which should look like "user@some.outside.host" end up looking like + ;; "user%some.outside.host" or even "user%some.outside.host@lucid.com" + ;; instead. This rule rewrites it into the original form. + ;; + ((string-match "\\`\\([^@%]+\\)%\\([^@%!]+\\)\\(@lucid\\.com\\)?\\'" addr) + (concat (bbdb-match-substring addr 1) "@" (bbdb-match-substring addr 2))) + ;; + ;; Sometimes I see addresses like "foobar.com!user@foobar.com". + ;; That's totally redundant, so this rewrites it as "user@foobar.com". + ;; + ((string-match "\\`\\([^@%!]+\\)!\\([^@%!]+[@%]\\1\\)\\'" addr) + (bbdb-match-substring addr 2)) + ;; + ;; Sometimes I see addresses like "foobar.com!user". Turn it around. + ;; + ((string-match "\\`\\([^@%!.]+\\.[^@%!]+\\)!\\([^@%]+\\)\\'" addr) + (concat (bbdb-match-substring addr 2) "@" (bbdb-match-substring addr 1))) + ;; + ;; The mailer at hplb.hpl.hp.com tends to puke all over addresses which + ;; pass through mailing lists which are maintained there: it turns normal + ;; addresses like "user@foo.com" into "user%foo.com@hplb.hpl.hp.com". + ;; This reverses it. (I actually could have combined this rule with + ;; the similar lucid.com rule above, but then the regexp would have been + ;; more than 80 characters long...) + ;; + ((string-match "\\`\\([^@!]+\\)%\\([^@%!]+\\)@hplb\\.hpl\\.hp\\.com\\'" + addr) + (concat (bbdb-match-substring addr 1) "@" (bbdb-match-substring addr 2))) + ;; + ;; Another local mail-configuration botch: sometimes mail shows up + ;; with addresses like "user@workstation", where "workstation" is a + ;; local machine name. That should really be "user" or "user@netscape.com". + ;; (I'm told this one is due to a bug in SunOS 4.1.1 sendmail.) + ;; + ((string-match "\\`\\([^@%!]+\\)[@%][^@%!.]+\\'" addr) + (bbdb-match-substring addr 1)) + ;; + ;; Sometimes I see addrs like "foo%somewhere%uunet.uu.net@somewhere.else". + ;; This is silly, because I know that I can send mail to uunet directly. + ;; + ((string-match ".%uunet\\.uu\\.net@[^@%!]+\\'" addr) + (concat (substring addr 0 (+ (match-beginning 0) 1)) "@UUNET.UU.NET")) + ;; + ;; Otherwise, leave it as it is. Returning a string EQ to the one passed + ;; in tells BBDB that we're done. + ;; + (t addr))) + + +;;; Here's another approach; sometimes one gets mail from foo@bar.baz.com, +;;; and then later gets mail from foo@baz.com. At this point, one would +;;; like to delete the bar.baz.com address, since the baz.com address is +;;; obviously superior. See also var `bbdb-canonicalize-redundant-nets-p'. +;;; +;;; Turn this on with +;;; (add-hook 'bbdb-change-hook 'bbdb-delete-redundant-nets) + +(defun bbdb-delete-redundant-nets (record) + "Deletes redundant network addresses. +For use as a value of `bbdb-change-hook'. See `bbdb-net-redundant-p'." + (let* ((nets (bbdb-record-net record)) + (rest nets) + net new redundant) + (while rest + (setq net (car rest)) + (if (bbdb-net-redundant-p net nets) + (setq redundant (cons net redundant)) + (setq new (cons net new))) + (setq rest (cdr rest))) + (cond (redundant + (message "Deleting redundant nets %s..." + (mapconcat 'identity (nreverse redundant) ", ")) + (setq new (nreverse new)) + (bbdb-record-set-net record new) + t)))) + + + +;;;###autoload +(defun bbdb-force-record-create () + "Force automatic creation of a BBDB records for the current message. +You might add this to the reply hook of your MUA in order to automatically +get records added for those people you reply to." + (interactive) + (let ((bbdb/mail-auto-create-p t) + (bbdb/news-auto-create-p t) + (bbdb-message-caching-enabled nil) + (bbdb/gnus-update-records-mode 'annotating) + (bbdb/rmail-update-records-mode 'annotating) + (bbdb/mhe-update-records-mode 'annotating) + (bbdb/vm-update-records-mode 'annotating)) + (save-excursion + (cond ((member major-mode '(vm-mode vm-virtual-mode vm-summary-mode + vm-presentation-mode)) + (bbdb/vm-pop-up-bbdb-buffer)) + ((member major-mode '(gnus-summary-mode gnus-article-mode + gnus-tree-mode)) + (bbdb/gnus-pop-up-bbdb-buffer)) + ((member major-mode '(rmail-mode rmail-summary-mode)) + (bbdb/rmail-pop-up-bbdb-buffer)) + ((member major-mode '(mhe-mode mhe-summary-mode mh-folder-mode)) + (bbdb/mh-pop-up-bbdb-buffer)) + )))) + +(provide 'bbdb-hooks) diff --git a/lisp/bbdb-merge.el b/lisp/bbdb-merge.el new file mode 100644 index 0000000..ac90ae5 --- /dev/null +++ b/lisp/bbdb-merge.el @@ -0,0 +1,264 @@ +;;; BBDB merge/sync framework +;;; GNU Public License to go here. This file is under GPL, thanks guys. +;;; Copyright (c) 2000 Waider + +(require 'bbdb) +(require 'bbdb-com) + +;;; to do: +;;; smarter phone, notes and address merging. + +;;;###autoload +(defun bbdb-merge-record (new-record &optional merge-record override) + "Generic merge function. + +Merges new-record into your bbdb, using DATE to check who's more +up-to-date and OVERRIDE to decide who gets precedence if two dates +match. DATE can be extracted from a notes if it's an alist with an +element marked timestamp. Set OVERRIDE to 'new to allow the new record +to stomp on existing data, 'old to preserve existing data or nil to +merge both together. If it can't find a record to merge with, it will +create a new record. If MERGE-RECORD is set, it's a record discovered +by other means that should be merged with. + +Returns the Grand Unified Record." + + (let* ((firstname (bbdb-record-firstname new-record)) + (lastname (bbdb-record-lastname new-record)) + (aka (bbdb-record-aka new-record)) + (nets (bbdb-record-net new-record)) + (addrs (bbdb-record-addresses new-record)) + (phones (bbdb-record-phones new-record)) + (company (bbdb-record-company new-record)) + (notes (bbdb-record-raw-notes new-record)) + (name (bbdb-string-trim (concat firstname " " lastname))) + (date (if (listp notes) (cdr (assq 'timestamp notes)) nil)) + olddate) + + ;; for convenience + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + + ;; See if we have a record that looks right, using an intertwingle + ;; search. Could probably parameterize that. + ;; bbdb-merge-search-function or some such. + (if (null merge-record) + (setq merge-record (bbdb-search-simple name nets))) + + (if merge-record + (progn + ;; if date is unset, set it to the existing record's date. + (setq olddate (bbdb-record-getprop merge-record 'timestamp) + date (or date olddate)) + ;; FIXME if date & olddate are STILL unset, set to today's date. + + ;; if the old record is actually newer, invert the sense of override + (if (string-lessp olddate date) + (setq override (cond ((eq 'old override) 'new) + ((eq 'new override) 'old) + (t nil)))) + + (bbdb-record-set-firstname merge-record + (if (null override) + (bbdb-merge-strings (bbdb-record-firstname merge-record) + firstname " ") + (if (eq 'new override) firstname + (bbdb-record-firstname merge-record)))) + + (bbdb-record-set-lastname merge-record + (if (null override) + (bbdb-merge-strings (bbdb-record-lastname merge-record) + lastname " ") + (if (eq 'new override) lastname + (bbdb-record-lastname merge-record)))) + + (bbdb-record-set-company merge-record + (if (null override) + (bbdb-merge-strings (bbdb-record-company merge-record) + company " ") + (if (eq 'new override) company + (bbdb-record-company merge-record)))) + + (bbdb-record-set-aka + merge-record + (if (null override) + (bbdb-merge-lists! + (bbdb-record-aka merge-record) + (if (listp aka) aka (list aka)) 'string= 'downcase) + (if (eq 'new override) aka + (bbdb-record-aka merge-record)))) + + (bbdb-record-set-net + merge-record + (if (null override) + (bbdb-merge-lists! + (bbdb-record-net merge-record) nets 'string= 'downcase) + (if (eq 'new override) nets + (bbdb-record-net merge-record)))) + + (bbdb-record-set-phones + merge-record + (if (null override) + (bbdb-merge-lists! + (bbdb-record-phones merge-record) phones 'equal) + (if (eq 'new override) phones + (bbdb-record-phones merge-record)))) + + (bbdb-record-set-addresses + merge-record + (if (null override) + (bbdb-merge-lists! + (bbdb-record-addresses merge-record) addrs 'equal) + (if (eq 'new override) addrs + (bbdb-record-addresses merge-record)))) + + ;; lifted from bbdb-com.el + (let ((n1 (bbdb-record-raw-notes merge-record)) + (n2 notes) + tmp + (bbdb-refile-notes-default-merge-function ;; XXX + 'bbdb-merge-strings)) + (or (equal n1 n2) + (progn + (or (listp n1) (setq n1 (list (cons 'notes n1)))) + (or (listp n2) (setq n2 (list (cons 'notes n2)))) + (while n2 + (if (setq tmp (assq (car (car n2)) n1)) + (setcdr tmp + (funcall (or (cdr (assq (car (car n2)) + bbdb-refile-notes-generate-alist)) + bbdb-refile-notes-default-merge-function) + (cdr tmp) (cdr (car n2)))) + (setq n1 (nconc n1 (list (car n2))))) + (setq n2 (cdr n2))) + (bbdb-record-set-raw-notes merge-record n1))))) + + ;; we couldn't find a record, so create one + (setq merge-record + (bbdb-create-internal name company nets addrs phones notes)) + ;; bite me, bbdb-create-internal + (bbdb-record-set-firstname merge-record firstname) + (bbdb-record-set-lastname merge-record lastname)) + + ;; more general bitingness + (if (equal (bbdb-record-firstname merge-record) "") + (bbdb-record-set-firstname merge-record nil)) + (if (equal (bbdb-record-lastname merge-record) "") + (bbdb-record-set-lastname merge-record nil)) + + ;; fix up the in-memory copy. + (bbdb-change-record merge-record t) + (let ((name (bbdb-record-name merge-record)) + (lfname (bbdb-record-lastname merge-record)) + (company (bbdb-record-company merge-record))) + (if (> (length name) 0) + (bbdb-remhash (downcase name) merge-record)) + (if (> (length lfname) 0) + (bbdb-remhash (downcase lfname) merge-record)) + (if (> (length company) 0) + (bbdb-remhash (downcase company) merge-record))) + (bbdb-record-set-namecache merge-record nil) + (if (or (bbdb-record-lastname merge-record) + (bbdb-record-firstname merge-record)) + (bbdb-puthash (downcase (bbdb-record-name merge-record)) merge-record)) + (if (bbdb-record-company merge-record) + (bbdb-puthash (downcase (bbdb-record-company merge-record)) + merge-record)) + (bbdb-with-db-buffer + (if (not (memq merge-record bbdb-changed-records)) + (setq bbdb-changed-records + (cons merge-record bbdb-changed-records)))) + + ;; your record, sir. + merge-record)) + +;; fixme these could be a macros, I guess. +(defun bbdb-instring( s1 s2 ) +;; (and case-fold-search +;; (setq s1 (downcase s1) +;; s2 (downcase s2))) + (catch 'done + (while (>= (length s1) (length s2)) + (if (string= s2 (substring s1 0 (length s2))) + (throw 'done t) + (setq s1 (substring s1 1)))) + (throw 'done nil))) + +(defun bbdb-merge-strings (s1 s2 &optional sep) + "Merge two strings together uniquely. +If s1 doesn't contain s2, return s1+sep+s2." + (cond ((or (null s1) (string-equal s1 "")) s2) + ((or (null s2) (string-equal s2 "")) s1) + (t (if (bbdb-instring s2 s1) s1 + (concat s1 (or sep "") s2))))) + +;;;###autoload +(defun bbdb-merge-file (&optional bbdb-new override match-fun) + "Merge a bbdb file into the in-core bbdb." + (interactive "fMerge bbdb file: ") + (or bbdb-gag-messages + bbdb-silent-running + (message "Merging %s" bbdb-new)) + ;; argh urgle private environment + (let* ((bbdb-live-file bbdb-file) + (bbdb-file bbdb-new) + (bbdb-live-buffer-name bbdb-buffer-name) + (bbdb-buffer-name "*BBDB-merge*") + (bbdb-buffer nil) ;; hack hack + (new-records (bbdb-records)) + (bbdb-buffer nil) ;; hack hack + (bbdb-file bbdb-live-file) + (bbdb-buffer-name bbdb-live-buffer-name) + (bbdb-refile-notes-default-merge-function 'bbdb-merge-strings)) + + ;; merge everything + (mapc (lambda(rec) + (bbdb-merge-record rec + (and match-fun + (funcall match-fun rec)) + override)) + new-records)) + ;; hack + (setq bbdb-buffer (or (get-file-buffer bbdb-file) nil))) + +(defun bbdb-add-or-update-phone ( record location phone-string ) + "Add or update a phone number in the current record. + +Insert into RECORD phone number for LOCATION consisting of +PHONE-STRING. Will automatically overwrite an existing phone entry for +the same location." + (let* ((phone (make-vector (if bbdb-north-american-phone-numbers-p + bbdb-phone-length + 2) + nil))) + (if (= 2 (length phone)) + (aset phone 1 phone-string) + (let ((newp (bbdb-parse-phone-number phone-string))) + (bbdb-phone-set-area phone (nth 0 newp)) + (bbdb-phone-set-exchange phone (nth 1 newp)) + (bbdb-phone-set-suffix phone (nth 2 newp)) + (bbdb-phone-set-extension phone (or (nth 3 newp) 0)))) + (bbdb-phone-set-location phone location) + + ;; "phone" now contains a suitable record + ;; we need to check if this is already in the phones list + (let ((phones (bbdb-record-phones record)) + phones-list) + (setq phones-list phones) + (while (car phones-list) + (if (string= (bbdb-phone-location (car phones-list)) + location) + (setq phones (delete (car phones-list) phones))) + (setq phones-list (cdr phones-list))) + + + (bbdb-record-set-phones record + (nconc phones (list phone)))) + (bbdb-change-record record nil) + + ;; update display if record is visible + (and (get-buffer-window bbdb-buffer-name) + (bbdb-display-records (list record))) + nil)) + +(provide 'bbdb-merge) diff --git a/lisp/bbdb-mhe.el b/lisp/bbdb-mhe.el new file mode 100644 index 0000000..717ae95 --- /dev/null +++ b/lisp/bbdb-mhe.el @@ -0,0 +1,225 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991 Todd Kaufmann <toad@cs.cmu.edu> +;;; Interface to mh-e version 3.7 or later (modeled after bbdb-rmail). +;;; Created 5-Mar-91; +;;; Modified: 28-Jul-94 by Fritz Knabe <knabe@ecrc.de> +;;; Jack Repenning <jackr@dblues.wpd.sgi.com> + +;;; The Insidious Big Brother Database 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 1, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(eval-and-compile + (require 'bbdb) + (require 'bbdb-com) + (require 'mail-utils) + ;; We advise several mh-e functions + (require 'mh-e) + (if (fboundp 'mh-version) + (require 'mh-comp)) ; For mh-e 4.x + (require 'advice)) + +(defmacro bbdb/mh-cache-key (message) + "Return a (numeric) key for MESSAGE" + (`(let* ((attrs (file-attributes (, message))) + (status-time (nth 6 attrs)) + (status-time-2 (cdr status-time)) + (inode (nth 10 attrs))) + (logxor (if (integerp inode) ;; if inode is larger than an emacs int, + inode ;; it's returned as a dotted pair + (car inode)) + (car status-time) + ;; We need the following test because XEmacs returns the + ;; status time as a dotted pair, whereas FSF and Epoch + ;; return it as list. + (if (integerp status-time-2) + status-time-2 + (car status-time-2)))))) + +;;;###autoload +(defun bbdb/mh-update-record (&optional offer-to-create) + "Returns the record corresponding to the current MH message, creating or +modifying it as necessary. A record will be created if +bbdb/mail-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and +the user confirms the creation." + (save-excursion + (and mh-show-buffer (set-buffer mh-show-buffer)) + (if bbdb-use-pop-up + (bbdb/mh-pop-up-bbdb-buffer offer-to-create) + (let ((msg (bbdb/mh-cache-key buffer-file-name)) + records record) + (if (eq msg 0) (setq msg nil)) ; 0 could mean trouble; be safe. + (setq records (bbdb-message-cache-lookup msg)) + (if records + (car records) + (let ((from (bbdb/mh-get-field "^From[ \t]*:"))) + (if (or (string= "" from) + (string-match (bbdb-user-mail-names) + (mail-strip-quoted-names from))) + ;; if logged-in user sent this, use recipients. + (progn + (setq from (bbdb/mh-get-field "^To[ \t]*:")) + (if (or (string= "" from) + (string-match (bbdb-user-mail-names) + (mail-strip-quoted-names from))) + (setq from nil)))) + (if from + (setq record + (bbdb-annotate-message-sender + from t + (or (bbdb-invoke-hook-for-value bbdb/mail-auto-create-p) + offer-to-create) + ;; ugh. what the hell? + (or offer-to-create + (bbdb-invoke-hook-for-value bbdb/mail-auto-create-p))))) + (if (and msg record) (bbdb-encache-message msg (list record))) + ;; return one record + record)))))) + +;;;###autoload +(defun bbdb/mh-annotate-sender (string &optional replace) + "Add a line to the end of the Notes field of the BBDB record +corresponding to the sender of this message. If REPLACE is non-nil, +replace the existing notes entry (if any)." + (interactive (list (if bbdb-readonly-p + (error "The Insidious Big Brother Database is read-only.") + (read-string "Comments: ")))) + (mh-show) + (let ((b (current-buffer)) + (p (point))) + (set-buffer mh-show-buffer) + (bbdb-annotate-notes (bbdb/mh-update-record t) string 'notes replace) + (set-buffer b) + (goto-char p))) + + +(defun bbdb/mh-edit-notes (&optional arg) + "Edit the notes field or (with a prefix arg) a user-defined field +of the BBDB record corresponding to the sender of this message." + (interactive "P") + (mh-show) + (let ((b (current-buffer)) + (p (point))) + (set-buffer mh-show-buffer) + (let (bbdb-electric-p (record (or (bbdb/mh-update-record t) (error "")))) + (bbdb-display-records (list record)) + (if arg + (bbdb-record-edit-property record nil t) + (bbdb-record-edit-notes record t))) + (set-buffer b) + (goto-char p))) + + +;;;###autoload +(defun bbdb/mh-show-sender () + "Display the contents of the BBDB for the sender of this message. +This buffer will be in bbdb-mode, with associated keybindings." + (interactive) + (mh-show) + (let ((b (current-buffer)) + (p (point))) + (set-buffer mh-show-buffer) + (let ((record (bbdb/mh-update-record t))) + (if record + (bbdb-display-records (list record)) + (error "unperson"))) + (set-buffer b) + (goto-char p))) + + +(defun bbdb/mh-pop-up-bbdb-buffer (&optional offer-to-create) + "Make the *BBDB* buffer be displayed along with the MH window, +displaying the record corresponding to the sender of the current message." + (bbdb-pop-up-bbdb-buffer + (function (lambda (w) + (let ((b (current-buffer))) + (set-buffer (window-buffer w)) + (prog1 (eq major-mode 'mh-show-mode) + (set-buffer b)))))) + (let ((bbdb-gag-messages t) + (bbdb-use-pop-up nil) + (bbdb-electric-p nil)) + (let ((record (bbdb/mh-update-record offer-to-create))) + (bbdb-display-records (if record (list record) nil) + bbdb-pop-up-display-layout) + record))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; this is a more strict version of mh-get-field which takes an regexp + +(defun bbdb/mh-get-field (field) + ;; Find and return the value of field FIELD (regexp) in the current buffer. + ;; Returns the empty string if the field is not in the message. + (let ((case-fold-search nil)) + (goto-char (point-min)) + (cond ((not (re-search-forward field nil t)) "") + ((looking-at "[\t ]*$") "") + (t (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) + (let ((field (buffer-substring (match-beginning 1) (match-end 1))) + (end-of-match (point))) + (forward-line) + (while (looking-at "[ \t]") (forward-line 1)) + (backward-char 1) + (if (<= (point) end-of-match) + field + (format "%s%s" field + (buffer-substring end-of-match (point))))))))) + +(defadvice mh-process-commands (after mh-bbdb-process act) + (bbdb-offer-save)) + +(defadvice mh-send (before mh-bbdb-send act) + (interactive (list + (bbdb-read-addresses-with-completion "To: ") + (bbdb-read-addresses-with-completion "Cc: ") + (read-string "Subject: ")))) + +(defadvice mh-send-other-window (before mh-bbdb-send-other act) + (interactive (list + (bbdb-read-addresses-with-completion "To: ") + (bbdb-read-addresses-with-completion "Cc: ") + (read-string "Subject: ")))) + +(defadvice mh-forward (before mh-bbdb-forward act) + (interactive (list (bbdb-read-addresses-with-completion "To: ") + (bbdb-read-addresses-with-completion "Cc: ") + (if current-prefix-arg + (mh-read-seq-default "Forward" t) + (mh-get-msg-num t))))) + +(defadvice mh-redistribute (before mh-bbdb-redist act) + (interactive (list + (bbdb-read-addresses-with-completion "Redist-To: ") + (bbdb-read-addresses-with-completion "Redist-Cc: ") + (mh-get-msg-num t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; mail from bbdb-mode using mh + +;; these redefine the bbdb-send-mail functions to use mh-send. + +;;; Install bbdb into mh-e's show-message function + +;;;###autoload +(defun bbdb-insinuate-mh () + "Call this function to hook BBDB into MH-E." + (define-key mh-folder-mode-map ":" 'bbdb/mh-show-sender) + (define-key mh-folder-mode-map ";" 'bbdb/mh-edit-notes) + (define-key mh-letter-mode-map "\M-;" 'bbdb-complete-name) + (add-hook 'mh-show-hook 'bbdb/mh-update-record) + (define-key mh-letter-mode-map "\e\t" 'bbdb-complete-name)) + +(provide 'bbdb-mhe) diff --git a/lisp/bbdb-migrate.el b/lisp/bbdb-migrate.el new file mode 100644 index 0000000..92c2504 --- /dev/null +++ b/lisp/bbdb-migrate.el @@ -0,0 +1,413 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file contains the migration functions for the Insidious Big +;;; Brother Database (aka BBDB), copyright (c) 1991, 1992, 1993, 1994 +;;; Jamie Zawinski <jwz@netscape.com>. See the file bbdb.texinfo for +;;; documentation. +;;; +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; + +(require 'bbdb) + +;;; Migrating the BBDB + +;; Features that have changed in the various database revs. Format: +;; ((VERSION . DIFFERENCES) ... ) +(defconst bbdb-migration-features + '((3 . "* Date format for `creation-date' and `timestamp' has changed, + from \"dd mmm yy\" (ex: 25 Sep 97) to \"yyyy-mm-dd\" (ex: 1997-09-25).") + (4 . "* Country field added.") + (5 . "* More flexible street address.") + (6 . "* Zip codes are stored as plain strings."))) + +;;;###autoload +(defun bbdb-migration-query (ondisk) + "Ask if the database is to be migrated. +ONDISK is the version number of the database as currently stored on +disk. Returns the version for the saved database." + (save-excursion + (let ((wc (current-window-configuration)) + (buf (get-buffer-create "*BBDB Migration Info*")) + (newfeatures bbdb-migration-features) + (first t) + win update) + (set-buffer buf) + (erase-buffer) + (goto-char (point-min)) + (insert (format "BBDB new data version notice: +============================= + +Your BBDB data is stored in an older format (version %d). At this point, +you have the option of either upgrading or continuing to save your data +in your current format. Please note that if you elect the latter option, +any changes made to your data using features intended for the newer +versions will be lost. For your convenience, a list of file format +changes introduced after version %d is shown below:\n\n" ondisk ondisk)) + (while newfeatures + (if (> (caar newfeatures) ondisk) + (insert (concat (if first (setq first nil) "\n\n") + "New features in database version " + (format "%d" (caar newfeatures)) + ":\n\n" (cdar newfeatures)))) + (setq newfeatures (cdr newfeatures))) + (setq win (display-buffer buf)) + (shrink-window-if-larger-than-buffer win) + (setq update + (y-or-n-p (concat "Upgrade BBDB to version " + (format "%d" bbdb-file-format) + "? "))) + (condition-case nil + (delete-window win) + ;; The window might be the only one on its frame. Hopefully, it's + ;; a dedicated window and the kill-buffer below will DTRT. + (error nil)) + (kill-buffer buf) + (set-window-configuration wc) + (if update bbdb-file-format ondisk)))) + +;;;###autoload +(defun bbdb-migrate (records) + "Migrate the BBDB from the version on disk (the car of +`bbdb-file-format-migration') to the current version (in +`bbdb-file-format')." + (bbdb-mapc (bbdb-migrate-versions-lambda (car bbdb-file-format-migration)) + records) + records) + +;;;###autoload +(defun bbdb-unmigrate-record (record) + "Reverse-migrate a single record from the current version (in +`bbdb-file-format') to the version to be saved (the cdr of +`bbdb-file-format-migration')." + (funcall (bbdb-migrate-versions-lambda bbdb-file-format + (car bbdb-file-format-migration)) + record) + record) + +(defconst bbdb-migration-spec + '((2 (bbdb-record-raw-notes bbdb-record-set-raw-notes + bbdb-migrate-change-dates)) + (3 (bbdb-record-addresses bbdb-record-set-addresses + bbdb-migrate-add-country-field)) + (4 (bbdb-record-addresses bbdb-record-set-addresses + bbdb-migrate-streets-to-list)) + (5 (bbdb-record-addresses bbdb-record-set-addresses + bbdb-migrate-zip-codes-to-strings))) + "The alist of (version . migration-spec-list). +See `bbdb-migrate-record-lambda' for details.") + +(defconst bbdb-unmigration-spec + '((2 (bbdb-record-raw-notes bbdb-record-set-raw-notes + bbdb-unmigrate-change-dates)) + (3 (bbdb-record-addresses bbdb-record-set-addresses + bbdb-unmigrate-add-country-field)) + (4 (bbdb-record-addresses bbdb-record-set-addresses + bbdb-unmigrate-streets-to-list)) + (5 (bbdb-record-addresses bbdb-record-set-addresses + bbdb-unmigrate-zip-codes-to-strings))) + "The alist of (version . migration-spec-list). +See `bbdb-migrate-record-lambda' for details.") + +(defun bbdb-migrate-record-lambda (changes) + "Return a function which will migrate a single record. +CHANGES is a `migration-spec-list' containing entries of the form + + (GET SET FUNCTION) + +where GET is the function to be used to retrieve the field to be +modified, and SET is the function to be used to set the field to be +modified. FUNCTION will be applied to the result of GET, and its +results will be saved with SET." + (byte-compile `(lambda (rec) + ,@(mapcar (lambda (ch) + `(,(cadr ch) rec + (,(car (cddr ch)) + (,(car ch) rec)))) + changes) + rec))) + +(defun bbdb-migrate-versions-lambda (v0 &optional v1) + "Return the function to migrate from V0 to V1. +V1 defaults to `bbdb-file-format'." + (setq v1 (or v1 bbdb-file-format)) + (let ((vv v0) spec) + (while (/= vv v1) + (setq spec (append spec (cdr (assoc vv bbdb-migration-spec))) + vv (if (< v0 v1) (1+ vv) (1- vv)))) + (bbdb-migrate-record-lambda spec))) + +(defun bbdb-migrate-zip-codes-to-strings (addrs) + "Make all zip codes plain strings. +This uses the code that used to be in bbdb-address-zip-string." + ;; apply the function to all addresses in the list and return a + ;; modified list of addresses + (mapcar (lambda (addr) + (let ((zip (if (stringp (bbdb-address-zip addr)) + (bbdb-address-zip addr) + ;; if not a string, make it a string... + (if (consp (bbdb-address-zip addr)) + ;; if a cons cell with two strings + (if (and (stringp (car (bbdb-address-zip addr))) + (stringp (car (cdr (bbdb-address-zip addr))))) + ;; if the second string starts with 4 digits + (if (string-match "^[0-9][0-9][0-9][0-9]" + (car (cdr (bbdb-address-zip addr)))) + (concat (car (bbdb-address-zip addr)) + "-" + (car (cdr (bbdb-address-zip addr)))) + ;; if ("abc" "efg") + (concat (car (bbdb-address-zip addr)) + " " + (car (cdr (bbdb-address-zip addr))))) + ;; if ("SE" (123 45)) + (if (and (stringp (nth 0 (bbdb-address-zip addr))) + (consp (nth 1 (bbdb-address-zip addr))) + (integerp (nth 0 (nth 1 (bbdb-address-zip addr)))) + (integerp (nth 1 (nth 1 (bbdb-address-zip addr))))) + (format "%s-%d %d" + (nth 0 (bbdb-address-zip addr)) + (nth 0 (nth 1 (bbdb-address-zip addr))) + (nth 1 (nth 1 (bbdb-address-zip addr)))) + ;; if a cons cell with two numbers + (if (and (integerp (car (bbdb-address-zip addr))) + (integerp (car (cdr (bbdb-address-zip addr))))) + (format "%05d-%04d" (car (bbdb-address-zip addr)) + (car (cdr (bbdb-address-zip addr)))) + ;; else a cons cell with a string an a number (possible error + ;; if a cons cell with a number and a string -- note the + ;; order!) + (format "%s-%d" (car (bbdb-address-zip addr)) + (car (cdr (bbdb-address-zip addr))))))) + ;; if nil or zero + (if (or (eq 0 (bbdb-address-zip addr)) + (null (bbdb-address-zip addr))) + "" + ;; else a number, could be 3 to 5 digits (possible error: assuming + ;; no leading zeroes in zip codes) + (format "%d" (bbdb-address-zip addr))))))) + (bbdb-address-set-zip addr zip)) + addr) + addrs)) + +(defun bbdb-unmigrate-zip-codes-to-strings (addrs) + "Make zip code string into zip code datastructures. +This uses the code that used to be in bbdb-parse-zip-string." + ;; apply the function to all addresses in the list and return a + ;; modified list of addresses + (mapcar (lambda (addr) + (let* ((string (bbdb-address-zip addr)) + (zip (cond ((string-match "^[ \t\n]*$" string) 0) + ;; Matches 1 to 6 digits. + ((string-match "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$" string) + (string-to-number string)) + ;; Matches 5 digits and 3 or 4 digits. + ((string-match "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[ \t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$" string) + (list (bbdb-subint string 1) (bbdb-subint string 2))) + ;; Match zip codes for Canada, UK, etc. (result is ("LL47" "U4B")). + ((string-match + "^[ \t\n]*\\([A-Za-z0-9]+\\)[ \t\n]+\\([A-Za-z0-9]+\\)[ \t\n]*$" + string) + (list (substring string (match-beginning 1) (match-end 1)) + (substring string (match-beginning 2) (match-end 2)))) + ;; Match zip codes for continental Europe. Examples "CH-8057" + ;; or "F - 83320" (result is ("CH" "8057") or ("F" "83320")). + ;; Support for "NL-2300RA" added at request from Carsten Dominik + ;; <dominik@astro.uva.nl> + ((string-match + "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+ ?[A-Z]*\\)[ \t\n]*$" string) + (list (substring string (match-beginning 1) (match-end 1)) + (substring string (match-beginning 2) (match-end 2)))) + ;; Match zip codes from Sweden where the five digits are grouped 3+2 + ;; at the request from Mats Lofdahl <MLofdahl@solar.stanford.edu>. + ;; (result is ("SE" (133 36))) + ((string-match + "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+\\)[ \t\n]+\\([0-9]+\\)[ \t\n]*$" string) + (list (substring string (match-beginning 1) (match-end 1)) + (list (bbdb-subint string 2) + (bbdb-subint string 3))))))) + (bbdb-address-set-zip addr zip) + addr)) + addrs)) + +(defun bbdb-migrate-change-dates (rec) + "Change date formats. +Formats are changed in timestamp and creation-date fields from +\"dd mmm yy\" to \"yyyy-mm-dd\". Assumes the notes are passed in as an +argument." + (unless (stringp rec) + (bbdb-mapc (lambda (rr) + (when (memq (car rr) '(creation-date timestamp)) + (bbdb-migrate-change-dates-change-field rr))) + rec) + rec)) + +(defun bbdb-migrate-change-dates-change-field (field) + "Migrate the date field (the cdr of FIELD) from \"dd mmm yy\" to +\"yyyy-mm-dd\"." + (let ((date (cdr field)) + parsed) + ;; Verify and extract - this is fairly hideous + (and (equal (setq parsed (timezone-parse-date (concat date " 00:00:00"))) + ["0" "0" "0" "0" nil]) + (equal (setq parsed (timezone-parse-date date)) + ["0" "0" "0" "0" nil]) + (cond ((string-match + "^\\([0-9]\\{4\\}\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)" date) + (setq parsed (vector (string-to-number (match-string 1 date)) + (string-to-number (match-string 2 date)) + (string-to-number (match-string 3 date)))) + ;; This should be fairly loud for GNU Emacs users + (bbdb-warn "BBDB is treating %s field value %s as %s %d %d" + (car field) (cdr field) + (upcase-initials + (downcase (car (rassoc (aref parsed 1) + timezone-months-assoc)))) + (aref parsed 2) (aref parsed 0))) + ((string-match + "^\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([0-9]\\{4\\}\\)" date) + (setq parsed (vector (string-to-number (match-string 3 date)) + (string-to-number (match-string 1 date)) + (string-to-number (match-string 2 date)))) + ;; This should be fairly loud for GNU Emacs users + (bbdb-warn "BBDB is treating %s field value %s as %s %d %d" + (car field) (cdr field) + (upcase-initials + (downcase (car (rassoc (aref parsed 1) + timezone-months-assoc)))) + (aref parsed 2) (aref parsed 0))) + (t ["0" "0" "0" "0" nil]))) + + ;; I like numbers + (and (stringp (aref parsed 0)) + (aset parsed 0 (string-to-number (aref parsed 0)))) + (and (stringp (aref parsed 1)) + (aset parsed 1 (string-to-number (aref parsed 1)))) + (and (stringp (aref parsed 2)) + (aset parsed 2 (string-to-number (aref parsed 2)))) + + ;; Sanity check + (cond ((and (< 0 (aref parsed 0)) + (< 0 (aref parsed 1)) (>= 12 (aref parsed 1)) + (< 0 (aref parsed 2)) + (>= (timezone-last-day-of-month (aref parsed 1) + (aref parsed 0)) + (aref parsed 2))) + (setcdr field (format "%04d-%02d-%02d" (aref parsed 0) + (aref parsed 1) (aref parsed 2))) + field) + (t + (error "BBDB cannot parse %s header value %S for upgrade" + field date))))) + +(defun bbdb-unmigrate-change-dates (rec) + "Change date formats. +Formats are changed in timestamp and creation-date fields from +\"yyyy-mm-dd\" to \"dd mmm yy\". Assumes the notes list is passed in +as an argument." + (unless (stringp rec) + (bbdb-mapc (lambda (rr) + (when (memq (car rr) '(creation-date timestamp)) + (bbdb-unmigrate-change-dates-change-field rr))) + rec) + rec)) + +(defun bbdb-unmigrate-change-dates-change-field (field) + "Unmigrate the date field (the cdr of FIELD) from \"yyyy-mm-dd\" to +\"yyyy-mm-dd\"." + (cons (car field) (bbdb-time-convert (cdr field) "%e %b %y"))) + +(defun bbdb-migrate-add-country-field (addrl) + "Add a country field to each address in the address list." + (mapcar (lambda (addr) (vconcat addr [""])) addrl)) + +(defun bbdb-unmigrate-add-country-field (addrl) + "Remove the country field from each address in the address list." + ;; Some version 4 zip codes will be illegal version 3 (as used in + ;; 2.00.06) zip codes. This problem has not been solved. + (mapcar (lambda (addr) + (let* ((len (1- (length addr))) + (new-addr (make-vector len nil)) + (ii 0)) + (while (< ii len) + (aset new-addr ii (aref addr ii)) + (setq ii (1+ ii))))) + addrl)) + +(defun bbdb-migrate-streets-to-list (addrl) + "Convert the streets to a list." + (mapcar (lambda (addr) + (vector (aref addr 0) ; tag + (delete nil (delete "" ; nuke empties + (list (aref addr 1) ; street1 + (aref addr 2) ; street2 + (aref addr 3))));street3 + (aref addr 4) ; city + (aref addr 5) ; state + (aref addr 6) ; zip + (aref addr 7))) ; country + addrl)) + +(defun bbdb-unmigrate-streets-to-list (addrl) + "Convert the street list to the street[1-3] format." + ;; Take all the old addresses, ie. the 5th field, and for each + ;; address, render the third element (a list of streets) as three + ;; vector elements (v4-style address). If there's more than 3 + ;; lines, everything remaining gets crammed into the third, using + ;; commas to separate the bits. If there's less, fill out with nil. + (mapcar (lambda (addr) + (let ((streets (aref addr 1))) + (vector (aref addr 0) ; tag + (or (nth 0 streets) "") + (or (nth 1 streets) "") + (mapconcat 'identity (cddr streets) ", ") + (aref addr 2) ; city + (aref addr 3) ; state + (aref addr 4) ; zip + (aref addr 5)))) ; country + addrl)) + +;;;###autoload +(defun bbdb-migrate-rewrite-all (message-p &optional records) + "Rewrite each and every record in the bbdb file; this is necessary if we +are updating an old file format. MESSAGE-P says whether to sound off +for each record converted. If RECORDS is non-nil, its value will be +used as the list of records to update." + ;; RECORDS is used by the migration mechanism. Since the migration + ;; mechanism is called from within bbdb-records, if we called + ;; bbdb-change-record, we'd recurse and die. We're therefore left + ;; with the slightly more palatable (but still not pretty) calling + ;; of bbdb-overwrite-record-internal. + (or records (setq records (bbdb-records))) + (let ((i 0)) + (while records + (bbdb-overwrite-record-internal (car records) nil) + (if message-p (message "Updating %d: %s %s" (setq i (1+ i)) + (bbdb-record-firstname (car records)) + (bbdb-record-lastname (car records)))) + (setq records (cdr records))))) +(defalias 'bbdb-dry-heaves 'bbdb-migrate-rewrite-all) + +;;;###autoload +(defun bbdb-migrate-update-file-version (old new) + "Change the `file-version' string from the OLD version to the NEW +version." + (goto-char (point-min)) + (if (re-search-forward (format "^;;; file-version: %d$" old) nil t) + (replace-match (format ";;; file-version: %d" new)) + (error (format "Can't find file-version string in %s buffer for v%d migration" + bbdb-file new)))) + +(provide 'bbdb-migrate) diff --git a/lisp/bbdb-print.el b/lisp/bbdb-print.el new file mode 100644 index 0000000..cda31ed --- /dev/null +++ b/lisp/bbdb-print.el @@ -0,0 +1,672 @@ +;;; bbdb-print.el -- for printing BBDB databases using TeX. + +;;; Authors: Boris Goldowsky <boris@cs.rochester.edu> +;;; Dirk Grunwald <grunwald@cs.colorado.edu> +;;; Luigi Semenzato <luigi@paris.cs.berkeley.edu> +;;; Copyright (C) 1993 Boris Goldowsky +;;; Version: 3.92; 4Jan95 + +;;; This file is part of the bbdb-print extensions to the Insidious +;;; Big Brother Database, which is for use with GNU Emacs. +;;; +;;; The Insidious Big Brother Database 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 1, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;;; +;;; In the *BBDB* buffer, type P to convert the listing to TeX +;;; format. It will prompt you for a filename. Then run TeX on that +;;; file and print it out. +;;; +;;; Bbdb-print understands one new bbdb field: tex-name. If it +;;; exists, this will be used for the printed listing instead of the +;;; name field of that record. This is designed for entering names +;;; with lots of accents that would mess up mailers, or when for any +;;; reason you want the printed version of the name to be different +;;; from the version that appears on outgoing mail and in the *BBDB* +;;; buffer. You may want to add tex-name to a omit list of the variable +;;; bbdb-display-layout-alist so you only see it in the printout. +;;; tex-name is exempted from the usual special-character quoting done by +;;; bbdb-print; it is used verbatim. +;;; +;;; Not all fields or records need be printed. To not print a certain +;;; field, add it to `bbdb-print-omit-fields' (which see). If after eliding +;;; fields a record contains no interesting information, it will not +;;; be printed at all; the variable `bbdb-print-require' determines +;;; what is meant by "interesting" information. You can also restrict +;;; printing to just the records currently in the *BBDB* buffer by +;;; using *P instead of P. +;;; +;;; There are various options for the way the formatting is done; most +;;; are controlled by the variable bbdb-print-alist. See its +;;; documentation for the allowed options. + +;;; Installation: +;;; +;;; Put this file somewhere on your load-path. Put bbdb-print.tex and +;;; bbdb-cols.tex somewhere on your TEXINPUTS path, or put absolute +;;; pathnames into the variable bbdb-print-format-files (which see). Put +;;; (add-hook 'bbdb-load-hook (function (lambda () (require 'bbdb-print)))) +;;; into your .emacs, or autoload it. +;;; +;;; This program was adapted for BBDB by Boris Goldowsky +;;; <boris@cs.rochester.edu> and Dirk Grunwald +;;; <grunwald@cs.colorado.edu> using a TeX format designed by Luigi +;;; Semenzato <luigi@paris.cs.berkeley.edu>. +;;; We are also grateful to numerous people on the bbdb-info +;;; mailing list for suggestions and bug reports. + +;;; Code: + +(require 'bbdb) +(require 'bbdb-com) + +;;; Variables: + +(defcustom bbdb-print-file-name "~/bbdb.tex" + "*Default file name for printouts of BBDB database." + :group 'bbdb-utilities-print + :type 'file) + +(defcustom bbdb-print-omit-fields '(omit tex-name aka mail-alias) + "*List of fields NOT to print in address list. +See also bbdb-print-require." + :group 'bbdb-utilities-print + :type '(repeat (symbol :tag "Field to exclude"))) + +(defcustom bbdb-print-require '(or address phone) + "*What fields are required for printing a record. +This is evaluated for each record, and the record will be printed only +if it returns non-nil. The symbols name, company, net, phone, +address, and notes will be set to appropriate values when this is +evaluated; they will be nil if the field does not exist or is elided. + +The value of this variable can be any lisp expression, but typically +it will be used for a boolean combination of the field variables, as +in the following simple examples: + + Print only people whose phone numbers are known: + (setq bbdb-print-require 'phone) + Print people whose names AND companies are known: + (setq bbdb-print-require '(and name company)) + Print people whose names, and either addresses OR phone numbers are known: + (setq bbdb-print-require '(and name (or address phone)))." + :group 'bbdb-utilities-print + :type '(choice (const :tag "Print all records" t) + (symbol :tag "Print all records with this field" phone) + (sexp :tag "Print only when this evaluates to non-nil" + '(or phone address phone)))) + +(defun bbdb-print-field-shown-p (field) + (not (memq field bbdb-print-omit-fields))) + +(define-widget 'bbdb-print-alist-widget 'repeat + "For use in Customize" + :args `((choice + (cons :tag "Column specification" :value (column . 1) + (const :tag "Column mode" column) + (radio-button-choice (const :tag "One column" 1) + (const :tag "Two columns" 2) + (const :tag "Three columns" 3) + (const :tag "Four columns" 4) + (const :tag "Quad" quad) + (const :tag "Grid" grid))) + (cons :tag "Separator specification" :value (separator . 0) + (const :tag "Separator" separator) + (radio-button-choice (const :tag "None" 0) + (const :tag "Line" 1) + (const :tag "Boxed letters" 2) + (const :tag "Large boxed letters" 3) + (const :tag "Large letters" 4) + (const :tag "Letters with lines" 5) + (const :tag "Letters with suits" 6) + (const :tag "Boxed letters with suits" 7))) + (cons :tag "Omit certain area codes" + :value (omit-area-code . ,(concat "^(" + (if (integerp bbdb-default-area-code) + (int-to-string bbdb-default-area-code) + "000") ") ")) + (const :tag "Omit certain area codes" omit-area-code) + (regexp :tag "Pattern to omit")) + (cons :tag "Phone number location" :value (phone-on-first-line . t) + (const :tag "Phone number location" phone-on-first-line) + (choice (const :tag "First home number on same line as name" t) + (const :tag "Don't put the phone number on the name line" nil) + (regexp :tag "Use phone number whose location matches" "^work$"))) + (cons :tag "Limit included phone numbers" :value (n-phones . 3) + (const :tag "Limit included phone numbers" n-phones) + (integer :tag "Maximum number to include" 3)) + (cons :tag "Limit included addresses" :value (n-addresses . 3) + (const :tag "Limit included addresses" n-addresses) + (integer :tag "Maximum number to include" 3)) + (cons :tag "Include additional TeX input files" :value (include-files . nil) + (const :tag "Additional TeX input files to include" include-files) + (repeat (file :tag "TeX file to include"))) + (cons :tag "Font type selection" :value (ps-fonts . nil) + (const :tag "Select font type" ps-fonts) + (choice (const :tag "Use standard TeX fonts" nil) + (const :tag "Use Postscript fonts" t))) + (cons :tag "Font size selection" :value (font-size . 10) + (const :tag "Select font size" font-size) + (integer :tag "Font size in points" 10)) + (cons :tag "Page height selection" :value (v-size . nil) + (const :tag "Select page height" v-size) + (choice (const :tag "Use TeX default" nil) + (string :tag "Height (must be valid TeX dimension)" "9in"))) + (cons :tag "Page width selection" :value (h-size . nil) + (const :tag "Select page width" h-size) + (choice (const :tag "Use TeX default" nil) + (string :tag "Width (must be valid TeX dimension)" "6in"))) + (cons :tag "Vertical offset (top margin)" :value (voffset . nil) + (const :tag "Select vertical offset (top margin)" voffset) + (choice (const :tag "Use TeX default" nil) + (string :tag "Vertical offset (must be valid TeX dimension)" "1in"))) + (cons :tag "Horizontal offset (left margin)" :value (hoffset . nil) + (const :tag "Select horizontal offset (left margin)" hoffset) + (choice (const :tag "Use TeX default" nil) + (string :tag "Horizontal offset (must be valid TeX dimension)" "1in"))) + (cons :tag "Quad format height" :value (quad-vsize . "") + (const :tag "Select height for quad format pages" quad-vsize) + (string :tag "Height (must be valid TeX dimension)")) + (cons :tag "Quad format width" :value (quad-hsize . "") + (const :tag "Select width for quad format pages" quad-hsize) + (string :tag "Width (must be valid TeX dimension)"))))) + +(defcustom bbdb-print-alist + `((omit-area-code . ,(concat "^(" (if (integerp bbdb-default-area-code) + (int-to-string bbdb-default-area-code) + "000") ") ")) + (phone-on-first-line . "^[ \t]*$") + (ps-fonts . nil) + (font-size . 6) + (quad-hsize . "3.15in") + (quad-vsize . "4.5in")) + "*Formatting options for `bbdb-print', all formats. +This is an alist of the form ((option1 . value1) (option2 . value2) ...) + +You can have separate settings for brief and non-brief printouts; +see the variables `bbdb-print-brief-alist' and `bbdb-print-full-alist'. +Settings there will override the common settings in this variable. + +The possible options and legal values are: + - columns: 1, 2, 3, 4 or 'quad (4 little 2-column pages per sheet) + or 'grid (12 credit-card-sized pages per sheet). + - separator: 0-7, the style of heading for each letter. + 0=none, 1=line, 2=boxed letters, 3=large boxed letters, 4=large letters, + 5=letters with lines, 6=letters with suits, 7=boxed letters with suits. + - omit-area-code: a regular expression matching area codes to omit. + - phone-on-first-line: t means to put first phone number on the same + line with the name, nil means just the name. A string means to + use the first phone number whose \"location\" matches that string, + which should be a valid regular expression. + - n-phones: maximum number of phone numbers to include. + - n-addresses: maximum number of addresses to include. + - include-files: list of TeX files to \\input. If these filenames are not + absolute, the files must be located somewhere that TeX will find them. + - ps-fonts: nonnil means to use them, nil to use standard TeX fonts. + - font-size: in points, any integer (assuming fonts in that size exist!). + - hsize, vsize: horizontal dimension of pages. String value can be any valid + TeX dimension, or nil to use TeX's default. + - hoffset, voffset: shift TeX's output rightward (downward) by this distance + (any TeX dimension). Nil or 0 uses TeX's default positioning. + - quad-hsize, quad-vsize: for the quad format, horizontal and + vertical size of the little pages. These must be strings which + are valid TeX dimensions, eg \"10cm\"." + :group 'bbdb-utilities-print + :type 'bbdb-print-alist-widget) + +(defcustom bbdb-print-full-alist + '((columns . 3) + (separator . 2) + (include-files "bbdb-print" "bbdb-cols")) + "*Extra options for `bbdb-print' non-brief format. +These supplement or override entries in `bbdb-print-alist'; see description +of possible contents there." + :group 'bbdb-utilities-print + :type 'bbdb-print-alist-widget) + +(defcustom bbdb-print-brief-alist + '((columns . 1) + (separator . 1) + (n-phones . 2) + (n-addresses . 1) + (include-files "bbdb-print-brief" "bbdb-cols")) + "*Extra Options for `bbdb-print', brief format. +These supplement or override entries in `bbdb-print-alist'; see description +of possible contents there." + :group 'bbdb-utilities-print + :type 'bbdb-print-alist-widget) + +(defconst bbdb-print-filofax-alist + (append '((font-size . 12) + (columns . 2) + (voffset . "-2cm") + (hoffset . "-2cm") + (vsize . "27cm")) + bbdb-print-full-alist) + "Example setup for making pages for a Filofax binder.") + + +(defcustom bbdb-print-prolog + (concat "%%%% ====== Phone/Address list in -*-TeX-*- Format =====\n" + "%%%% produced by bbdb-print, version 3.0\n\n") + "*TeX statements to include at the beginning of the `bbdb-print' file." + :group 'bbdb-utilities-print + :type '(text :format "%t:\n%v")) + +(defcustom bbdb-print-epilog "\\endaddresses\n\\bye\n" + "*TeX statements to include at the end of the `bbdb-print' file." + :group 'bbdb-utilities-print + :type '(text :format "%t:\n%v")) + +(defcustom bbdb-print-net 'primary + "*Indicates whether only the primary or all email addresses are printed. +Symbol `primary' means print the primary email address only. +Symbol `all' means print all email addresses." + :group 'bbdb-utilities-print + :type '(choice (const primary) + (const all))) + +;;; Functions: + +(defsubst bbdb-print-if-not-blank (string &rest more) + "If STRING is not null, then return it concatenated +with rest of arguments. If it is null, then all arguments are +ignored and the null string is returned." + (if (or (null string) (equal "" string)) + "" + (apply 'concat string more))) + +;;;###autoload +(defun bbdb-print (visible-records to-file brief) + "Make a TeX file for printing out the bbdb database.\\<bbdb-mode-map> +If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-print]\" is \ +used instead of simply \"\\[bbdb-print]\", then includes only the +people currently in the *BBDB* buffer. With a prefix argument, makes +a brief \(one-line-per-entry) printout. + +There are various variables for customizing the content & format of +the printout, notably the variables `bbdb-print-alist' and +`bbdb-print-require'. See the file bbdb-print.el for more information." + (interactive (list (bbdb-do-all-records-p) + (read-file-name "Print To File: " + (file-name-directory bbdb-print-file-name) + bbdb-print-file-name + nil + (file-name-nondirectory bbdb-print-file-name)) + current-prefix-arg)) + (setq bbdb-print-file-name (expand-file-name to-file)) + (let* ((alist (append (if brief bbdb-print-brief-alist bbdb-print-full-alist) + bbdb-print-alist)) + (records (if (not visible-records) + (bbdb-records) + (set-buffer bbdb-buffer-name) + (mapcar 'car bbdb-records))) + (psstring (if (cdr (assoc 'ps-fonts alist)) + "ps" "")) + (columns (cdr (assoc 'columns alist))) + (current-letter t) + (pofl (cdr (assoc 'phone-on-first-line alist))) + (n-phones (cdr (assoc 'n-phones alist))) + (n-addresses (cdr (assoc 'n-addresses alist)))) + (find-file bbdb-print-file-name) + (widen) (erase-buffer) + (insert bbdb-print-prolog) + (let ((dimens '(hsize vsize hoffset voffset)) + val) + (while dimens + (setq val (cdr (assoc (car dimens) alist))) + (if val + (insert (format "\\%s=%s\n" (car dimens) val))) + (setq dimens (cdr dimens)))) + (let ((infiles (cdr (assoc 'include-files alist)))) + (while infiles + (insert (format "\\input %s\n" (car infiles))) + (setq infiles (cdr infiles)))) + (insert (format "\n\\set%ssize{%d}\n" + psstring (cdr (assoc 'font-size alist))) + (format "\\setseparator{%d}\n" + (cdr (assoc 'separator alist))) + (cond ((eq 'quad columns) + (format "\\quadformat{%s}{%s}" + (cdr (assoc 'quad-hsize alist)) + (cdr (assoc 'quad-vsize alist)))) + ((eq 'grid columns) "\\grid") + ((= 4 columns) "\\fourcol") + ((= 3 columns) "\\threecol") + ((= 2 columns) "\\twocol") + ((= 1 columns) "\\onecol")) + ;; catcodes are font-encoding specific ! + ;; Add more if you know them + (if (equal psstring "ps") + (concat "\n\n" + ;; Adobe Times and Courier + ) + (concat "\n\n" + ;; ec fonts + "\\catcode`ß=\\active\\chardefß=\"FF")) + "\n\n\\beginaddresses\n") + (while records + (setq current-letter + (bbdb-print-format-record (car records) current-letter + brief pofl n-phones n-addresses)) + (setq records (cdr records))) + (insert bbdb-print-epilog) + (goto-char (point-min)))) + +(defvar bbdb-address-print-formatting-alist + '((bbdb-address-is-continental . bbdb-print-format-address-continental) + (nil . bbdb-print-format-address-default)) + "Alist of address identifying and address formatting functions for printing. +The key is an identifying function which accepts an address. The +associated value is a formatting function which inserts the formatted +address in the current buffer. If the identifying function returns +non-nil, the formatting function is called. The nil key is a default +value will allways calls the associated formatting function. Therefore +you should always have (nil . bbdb-print-format-address-default) as the +last element in the alist. + +The functions must take one argument, the address. + +See also `bbdb-address-formatting-alist'.") + +(defun bbdb-print-format-address-continental (addr) + "Insert formated continental address ADDR in current buffer for printing. +This format is used in western Europe, for example. + +This function is a possible formatting function for +`bbdb-address-print-formatting-alist'. + +The result looks like this: + street + street + ... + zip city, state + country" + (insert + (format + "\\address{%s}\n" + (bbdb-print-tex-quote + (if addr + (concat + (mapconcat (function (lambda(str) + (if (= 0 (length (bbdb-string-trim str))) + () + (concat str"\\\\\n")))) + (bbdb-address-streets addr) + "") + (let ((c (bbdb-address-city addr)) + (s (bbdb-address-state addr)) + (z (bbdb-address-zip addr))) + (if (or (> (length c) 0) + (> (length z) 0) + (> (length s) 0)) + (concat z (if (and (> (length z) 0) + (> (length c) 0)) " " "") + c (if (and (or (> (length z) 0) + (> (length c) 0)) + (> (length s) 0)) ", " "") + s "\\\\\n") "")) + (bbdb-print-if-not-blank (bbdb-address-country addr) "\\\\\n")) + ""))))) + +(defun bbdb-print-format-address-default (addr) + "Insert formated address ADDR in current buffer for printing. +This is the default format; it is used in the US, for example. + +This function is a possible formatting function for +`bbdb-address-print-formatting-alist'. + +The result looks like this: + street + street + ... + city, state zip + country" + (insert + (format + "\\address{%s}\n" + (bbdb-print-tex-quote + (if addr + (concat + (mapconcat (function (lambda(str) + (if (= 0 (length (bbdb-string-trim str))) + () + (concat str "\\\\\n")))) + (bbdb-address-streets addr) + "") + (let ((c (bbdb-address-city addr)) + (s (bbdb-address-state addr)) + (z (bbdb-address-zip addr))) + (if (or (> (length c) 0) + (> (length z) 0) + (> (length s) 0)) + (concat c (if (and (> (length c) 0) + (> (length s) 0)) ", " "") + s (if (and (or (> (length c) 0) + (> (length s) 0)) + (> (length z) 0)) " " "") + z "\\\\\n") "")) + (bbdb-print-if-not-blank (bbdb-address-country addr) "\\\\\n")) + ""))))) + +(defun bbdb-print-format-record (record current-letter + brief pofl n-phones n-addresses) + "Insert the bbdb RECORD in TeX format. +Second arg CURRENT-LETTER is the first letter of the sortkey of the previous +record. If this is non-nil and RECORD begins differently, a section heading is +output. If CURRENT-LETTER is t always produces a heading. +3rd argument BRIEF is for 1-line-per-record printouts. +Args 3-5 PHONE-ON-FIRST-LINE, N-PHONES, and N-ADDRESSES are the respective +values from `bbdb-print-alist'. + +The return value is the new CURRENT-LETTER." + + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "plus ungood: tex formatting deleted record"))) + + (let* ((first-letter + (substring (concat (bbdb-record-sortkey record) "?") 0 1)) + (name (and (bbdb-print-field-shown-p 'name) + (or (bbdb-record-getprop record 'tex-name) + (bbdb-print-tex-quote + (bbdb-record-name record))))) + (company (and (bbdb-print-field-shown-p 'company) + (bbdb-record-company record))) + (net (and (bbdb-print-field-shown-p 'net) + (bbdb-record-net record))) + (phone (and (bbdb-print-field-shown-p 'phone) + (bbdb-record-phones record))) + (address (and (bbdb-print-field-shown-p 'address) + (bbdb-record-addresses record))) + (notes (bbdb-record-raw-notes record))) + + (if (not (eval bbdb-print-require)) + nil ; lacks required fields + + ;; Section header, if neccessary. + + (if (and current-letter + (not (string-equal first-letter current-letter))) + (insert (format "\\goodbreak\n\\separator{%s}\n%%\n" + (bbdb-print-tex-quote (upcase first-letter))))) + + (insert "\\beginrecord\n") + + ;; if there is no name, use company instead + (if (and (not name) company) + (setq name (bbdb-print-tex-quote company) + company nil)) + + (let ((rightside "")) + (cond ((null phone)) + ((eq t pofl) + (setq rightside (bbdb-print-phone-string (car phone)) + phone (cdr phone))) + ((stringp pofl) + (let ((p (bbdb-print-front-if + (function (lambda (ph) + (string-match pofl (aref ph 0)))) + phone))) + (if p + (setq rightside (bbdb-print-phone-string (car p)) + phone (cdr p)))))) + (insert (format "\\firstline{%s}{%s}\n" + name + (bbdb-print-tex-quote rightside)))) + + (if company + (insert (format "\\comp{%s}\n" (bbdb-print-tex-quote company)))) + + ;; Phone numbers + + (if n-phones + (setq phone (bbdb-print-firstn (- n-phones (if pofl 1 0)) + phone brief))) + (while phone + (if (car phone) + (let ((place (aref (car phone) 0)) + (number (bbdb-print-phone-string (car phone)))) + (insert (format "\\phone{%s%s}\n" + (bbdb-print-tex-quote + (bbdb-print-if-not-blank place ": ")) + (bbdb-print-tex-quote number)))) + (insert (format "\\phone{}\n"))) + (setq phone (cdr phone))) + + ;; Email address + ;; Make all dots legal line-breaks. + + (when net + (let ((net-addrs + (cond ((eq bbdb-print-net 'primary) + (list (car net))) + ((eq bbdb-print-net 'all) + net) + (t nil)))) + (insert + (format + "\\email{%s}\n" + (mapconcat + (lambda (net-addr) + (setq net-addr (bbdb-print-tex-quote net-addr)) + (let ((start 0)) + (while (string-match "\\." net-addr start) + (setq net-addr + (concat (substring net-addr 0 (match-beginning 0)) + ".\\-" + (substring net-addr (match-end 0)))) + (setq start (+ 2 (match-end 0))))) + net-addr) + net-addrs ", "))))) + + ;; Addresses. FUTURE: If none left, should use phones instead. + + (if n-addresses + (setq address + (bbdb-print-firstn n-addresses address brief))) + (while address + (bbdb-format-address (car address) 'printing) + (setq address (cdr address))) + + ;; Notes + + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + (while notes + (let ((thisnote (car notes))) + (if (bbdb-print-field-shown-p (car thisnote)) + (progn + (if (eq 'notes (car thisnote)) + (insert (format "\\notes{%s}\n" (bbdb-print-tex-quote + (cdr thisnote)))) + (insert (format "\\note{%s}{%s}\n" + (bbdb-print-tex-quote (symbol-name + (car thisnote))) + (bbdb-print-tex-quote (cdr thisnote)))))))) + (setq notes (cdr notes))) + + ;; Mark end of the record. + + (insert "\\endrecord\n%\n") + (setq current-letter first-letter))) + + current-letter) + +(defun bbdb-print-phone-string (phone) + "Format PHONE-NUMBER as a string, obeying omit-area-code setting. +Omit-area-code is one of the allowed symbols in `bbdb-print-alist', which see." + (let ((str (bbdb-phone-string phone)) + (omit (cdr (assoc 'omit-area-code bbdb-print-alist)))) + (if (and omit (string-match omit str)) + (substring str (match-end 0)) + str))) + +(defun bbdb-print-front-if (func list) + "Move first elt of LIST satisfying FUNC to front. +The car of the returned list is the first element that returned nonnil; +The cdr is the rest of the list. +But if the FUNC returns nil for every elements of the LIST, returns nil." + (cond ((null list) nil) + ((funcall func (car list)) + list) + ((let ((rest (bbdb-print-front-if func (cdr list)))) + (if rest + (cons (car rest) + (cons (car list) (cdr rest)))))))) + +(defun bbdb-print-firstn (n list force) + "The first N elements of LIST. +If 3rd arg FORCE is nonnil, will extend the list to length N if necessary, by +adding nil's. If N is nil, just returns LIST." + (cond ((null n) list) + ((null list) (if force (make-list n nil) nil)) + ((<= n 0) nil) + (t (cons (car list) (bbdb-print-firstn (1- n) (cdr list) force))))) + +(defun bbdb-print-tex-quote (string) + "Quote any unquoted TeX special characters that appear in STRING. +In other words, # alone will be replaced by \\#, but \\^ will be left for +TeX to process as an accent." + (if string + (save-excursion + (set-buffer (get-buffer-create " bbdb-print-tex-quote")) + (erase-buffer) + (insert string) + (goto-char (point-min)) + (while (not (eobp)) + (cond ((looking-at "[<>=]+") + (replace-match "$\\&$")) + ((and (looking-at "[#$%&_]") + (not (eq ?\\ (char-after (1- (point)))))) + (insert "\\") + (forward-char 1)) + ((and (looking-at "~") + (not (eq ?\\ (char-after (1- (point)))))) + (insert "\\") + (forward-char 1) + (insert "{}")) + ((and (looking-at "[{}]") + (not (eq ?\\ (char-after (1- (point)))))) + (insert "$\\") + (forward-char 1) + (insert "$")) + (t (forward-char 1)))) + (buffer-string)))) + + +(provide 'bbdb-print) + +;;; bbdb-print ends here. + diff --git a/lisp/bbdb-reportmail.el b/lisp/bbdb-reportmail.el new file mode 100644 index 0000000..baadb03 --- /dev/null +++ b/lisp/bbdb-reportmail.el @@ -0,0 +1,107 @@ +;; bbdb-reportmail.el --- Hooks the Insidious Big Brother Database +;; into the Reportmail package + +;; Copyright (C) 1997 Christopher Kline + +;; Author: Christopher Kline <ckline@media.mit.edu> +;; Maintainer: Christopher Kline <ckline@media.mit.edu> +;; Version: 1.01 +;; Created: 25 Jun 1997 +;; Date: 26 Jun 1997 + +;; Bbdb-reportmail 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, or (at your option) +;; any later version. + +;; Bbdb-reportmail 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Bbdb-reportmail advises the reportmail package function +;; display-time-get-field so that it attempts to replace the reported +;; "from" and "to" fields with the name field (or mail-name, if it +;; exists) of the corresponding BBDB record, if such a correspondence +;; can be made. + +;; To use this, simply add the following lines AFTER you load in your +;; bbdb, set bbdb variables, etc. +;; +;; (bbdb-insinuate-reportmail) +;; +;; (A require used to be necessary - it is no longer needed as long as +;; bbdb-insinuate-reportmail is called) + +;;; History: + +;; v1.01 26 June 1997 +;; Fixed the advice so that if we are the message recipient, do +;; nothing so that display-time-process-new-mail will correctly +;; trap this case. +;; +;; v1.00 26 June 1997 +;; Initial release. + +;;----------------------------------------------------------------------- + +(require 'bbdb) +(require 'reportmail) +(require 'advice) +(require 'mail-extr) + +(defun bbdb/reportmail-alternate-full-name (address) + (if address + (let ((entry (bbdb-search-simple nil address))) + (if entry + (or (bbdb-record-getprop entry 'mail-name) + (bbdb-record-name entry)))))) + +(defadvice display-time-get-field + (around bbdb/reportmail-hack-display-time-get-field disable activate) + "Advises the `display-time-get-field' function in the reportmail package. +If the field is \"from\" or \"to\", it tries to replace the value of the field +with the name field of the corresponding BBDB entry, if one can be found. + +If no corresponding record can be found, the field value is left unaltered." + (let (gf-field) + ;; Get the original argument to display-time-get-field + (setq gf-field (ad-get-arg 0)) + ;; Call the original display-time-get-field + ad-do-it + (if (or (string= gf-field "To") (string= gf-field "From")) + (setq ad-return-value + (or + ;; If this message is to me, then do nothing so + ;; reportmail can trap this case in + ;; display-time-process-new-mail + (if (display-time-member ad-return-value + display-time-my-addresses) + ad-return-value + nil) + ;; Is the sender/recipient in our BBDB? + (bbdb/reportmail-alternate-full-name + (car (cdr (mail-extract-address-components ad-return-value)))) + ;; Can't find sender/recipient in BBDB; do nothing. + ad-return-value) + )))) + +;;;###autoload +(defun bbdb-insinuate-reportmail () + "Call this function to hook BBDB into reportmail." + (ad-enable-advice 'display-time-get-field 'around + 'bbdb/reportmail-hack-display-time-get-field) + (ad-activate 'display-time-get-field) + (message "Insinuated BBDB into Reportmail.") +) + +(provide 'bbdb-reportmail) + + diff --git a/lisp/bbdb-rmail.el b/lisp/bbdb-rmail.el new file mode 100644 index 0000000..d6aab98 --- /dev/null +++ b/lisp/bbdb-rmail.el @@ -0,0 +1,202 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991, 1992 Jamie Zawinski <jwz@netscape.com>. +;;; Interface to RMAIL. See bbdb.texinfo. + +;;; The Insidious Big Brother Database 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 1, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(require 'bbdb) +(require 'bbdb-com) +(require 'rmail) +(load-library "rmailsum") +(require 'mailheader) + + +;;;###autoload +(defun bbdb/rmail-update-record (&optional offer-to-create) + (let ((bbdb-get-only-first-address-p) + (records (bbdb/rmail-update-records offer-to-create))) + (if records (car records) nil))) + +(defun bbdb/rmail-get-header-content( header-field buf ) + "Pull HEADER-FIELD out of BUF's mail header. +BUF is actually the rmail buffer from which the current message should +be extracted." + (save-excursion + (set-buffer buf) + (if (fboundp 'rmail-get-header) ; Emacs 23 + (rmail-get-header header-field) + (save-restriction + (rmail-narrow-to-non-pruned-header) + (let ((headers (mail-header-extract)) + (header (intern-soft (downcase header-field)))) + (mail-header header headers)))))) + +(defun bbdb/rmail-new-flag( buf ) + "Returns t if the current message in buffer BUF is new." + (rmail-message-labels-p rmail-current-message ", ?\\(unseen\\),")) + +(defcustom bbdb/rmail-update-records-mode + '(if (bbdb/rmail-new-flag rmail-buffer) 'annotating 'searching) + "RMAIL-specific version of `bbdb-update-records-mode', which see." + :group 'bbdb-mua-specific-rmail + :type '(choice (const :tag "annotating all messages" + annotating) + (const :tag "annotating no messages" + searching) + (const :tag "annotating only new messages" + (if (bbdb/rmail-new-flag rmail-buffer) 'annotating 'searching)) + (sexp :tag "user defined"))) + +;;;###autoload +(defun bbdb/rmail-update-records (&optional offer-to-create) + "Returns the records corresponding to the current RMAIL emssage, +creating or modifying them as necessary. A record will be created if +bbdb/mail-auto-create-p is non-nil or if OFFER-TO-CREATE is true, and +the user confirms the creation. + +The variable `bbdb/rmail-update-records-mode' controls what actions +are performed and it might override `bbdb-update-records-mode'. + +When hitting C-g once you will not be asked anymore for new people +listed n this message, but it will search only for existing records. +When hitting C-g again it will stop scanning." + (if (and (boundp 'rmail-buffer) rmail-buffer) + (set-buffer rmail-buffer) + (error "Not in an rmail buffer")) + (if rmail-current-message + (let ((bbdb/rmail-offer-to-create offer-to-create) + cache records) + + (if (not bbdb/rmail-offer-to-create) + (setq cache (bbdb-message-cache-lookup + rmail-current-message))) + + (if cache + (setq records (if bbdb-get-only-first-address-p + (list (car cache)) + cache)) + + (let ((bbdb-update-records-mode (or + bbdb/rmail-update-records-mode + bbdb-update-records-mode))) + (setq records (bbdb-update-records + (bbdb-get-addresses + bbdb-get-only-first-address-p + ;; uninteresting-senders + user-mail-address + 'bbdb/rmail-get-header-content + rmail-buffer) + bbdb/mail-auto-create-p + offer-to-create)) + + (bbdb-encache-message rmail-current-message records))) + records)) + ) + +;;;###autoload +(defun bbdb/rmail-annotate-sender (string &optional replace) + "Add a line to the end of the Notes field of the BBDB record +corresponding to the sender of this message. If REPLACE is non-nil, +replace the existing notes entry (if any)." + (interactive (list (if bbdb-readonly-p + (error "The Insidious Big Brother Database is read-only.") + (read-string "Comments: ")))) + (if (and (boundp 'rmail-buffer) rmail-buffer) + (set-buffer rmail-buffer)) + (bbdb-annotate-notes (bbdb/rmail-update-record t) string 'notes replace)) + +(defun bbdb/rmail-edit-notes (&optional arg) + "Edit the notes field or (with a prefix arg) a user-defined field +of the BBDB record corresponding to the sender of this message." + (interactive "P") + (let ((record (or (bbdb/rmail-update-record t) (error "")))) + (bbdb-display-records (list record)) + (if arg + (bbdb-record-edit-property record nil t) + (bbdb-record-edit-notes record t)))) + + +;;;###autoload +(defun bbdb/rmail-show-sender () + "Display the contents of the BBDB for the sender of this message. +This buffer will be in bbdb-mode, with associated keybindings." + (interactive) + (if (and (boundp 'rmail-buffer) rmail-buffer) + (set-buffer rmail-buffer)) + (let ((record (bbdb/rmail-update-record t))) + (if record + (bbdb-display-records (list record)) + (error "unperson")))) + +(defun bbdb/rmail-pop-up-bbdb-buffer ( &optional offer-to-create ) + "Make the *BBDB* buffer be displayed along with the RMAIL window(s). +Displays the records corresponding to the sender respectively +recipients of the current message. +See `bbdb/rmail-get-addresses-headers' and +'bbdb-get-only-first-address-p' for configuration of what is being +displayed." + (save-excursion + (let ((bbdb-gag-messages t) + (bbdb-electric-p nil) + (records (bbdb/rmail-update-records offer-to-create)) + (bbdb-buffer-name bbdb-buffer-name)) + + (when (and bbdb-use-pop-up records) + (bbdb-pop-up-bbdb-buffer + (function (lambda (w) + (let ((b (current-buffer))) + (set-buffer (window-buffer w)) + (prog1 (eq major-mode 'rmail-mode) + (set-buffer b)))))) + + ;; Always update the records; if there are no records, empty + ;; the BBDB window. This should be generic, not MUA-specific. + (bbdb-display-records records bbdb-pop-up-display-layout)) + + (when (not records) + (bbdb-undisplay-records) + (if (get-buffer-window bbdb-buffer-name) + (delete-window (get-buffer-window bbdb-buffer-name))))))) + +;;;###autoload +(defun bbdb-insinuate-rmail () + "Call this function to hook BBDB into RMAIL." + (define-key rmail-mode-map ":" 'bbdb/rmail-show-sender) + (define-key rmail-mode-map ";" 'bbdb/rmail-edit-notes) + (define-key rmail-summary-mode-map ":" 'bbdb/rmail-show-sender) + (define-key rmail-summary-mode-map ";" 'bbdb/rmail-edit-notes) + + (add-hook 'rmail-show-message-hook 'bbdb/rmail-pop-up-bbdb-buffer) + + ;; We must patch into rmail-only-expunge to clear the cache, since + ;; expunging a message invalidates the cache (which is based on + ;; message numbers). + (defadvice rmail-only-expunge (before bbdb/rmail-only-expunge) + "Invalidate BBDB cache before expunging." + (setq bbdb-message-cache nil)) + + ;; Same for undigestifying. + (or (fboundp 'undigestify-rmail-message) + (autoload 'undigestify-rmail-message "undigest" nil t)) + (if (eq (car-safe (symbol-function 'undigestify-rmail-message)) 'autoload) + (load (nth 1 (symbol-function 'undigestify-rmail-message)))) + (defadvice undigestify-rmail-message (before bbdb/undigestify-rmail-message) + "Invalidate BBDB cache before undigestifying." + (setq bbdb-message-cache nil)) + ) + +(provide 'bbdb-rmail) diff --git a/lisp/bbdb-sc.el b/lisp/bbdb-sc.el new file mode 100644 index 0000000..6fe04ae --- /dev/null +++ b/lisp/bbdb-sc.el @@ -0,0 +1,209 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is an addition to the Insidious Big Brother Database +;;; (aka BBDB), copyright (c) 1991, 1992 Jamie Zawinski +;;; <jwz@netscape.com>. +;;; +;;; The Insidious Big Brother Database 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 1, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;; This file was written by Martin Sjolin <marsj@ida.liu.se> +;;; based the original code by Tom Tromey <tromey@busco.lanl.gov>. +;;; +;;; Thanks to Richard Stanton <stanton@haas.berkeley.edu> for ideas +;;; for improvements and to Michael D. Carney <carney@ltx-tr.com> +;;; for testing and feedback. + +;;; This file adds the ability to define attributions for Supercite in +;;; a BBDB, enables you to retrieve your standard attribution from +;;; BBDB. If the from header in the mail to which you are replying +;;; only contains the e-mail address, the personal name is lookup in +;;; BBDB. You need Supercite to make this code work. The attribution +;;; os is stored under the key `attribution' (unless you've changed +;;; bbdb/sc-attribution-field). + +;;; To use enable this code you will have to the "sc-consult" to your +;;; sc-preferred-attribution-list. This file sets variable if it is not +;;; set and isues an warning message if "sc-consult" is not included. +;;; +;;; (setq sc-preferred-attribution-list +;;; '("sc-lastchoice" "x-attribution" "sc-consult" +;;; "initials" "firstname" "lastname")) +;;; +;;; +;;; We also set the sc-attrib-selection-list below if is not bound, if +;;; you have your own special sc-attrib-selection-list, please add +;;; an expression as below: +;;; +;;; (setq sc-attrib-selection-list +;;; '(("sc-from-address" ((".*" . (bbdb/sc-consult-attr +;;; (sc-mail-field "sc-from-address"))))))) +;;; +;;; And finally we set the sc-mail-glom-frame to enable the +;;; fetching of the name of person when there is only an e-mail +;;; address in the original mail: +;;; +;;; (setq sc-mail-glom-frame +;;; '((begin (setq sc-mail-headers-start (point))) +;;; ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t) +;;; ("^\\S +:.*$" (sc-mail-fetch-field) nil t) +;;; ("^$" (progn (bbdb/sc-default) +;;; (list 'abort '(step . 0)))) +;;; ("^[ \t]+" (sc-mail-append-field)) +;;; (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) +;;; (end (setq sc-mail-headers-end (point))))) +;;; +;;; + +;;; +;;; + +;;; packages +(require 'bbdb) +(require 'supercite) + +;;; User variable(s) +(defcustom bbdb/sc-replace-attr-p t + "t if you like to create a new BBDB entry when +entering a non-default attribution, 'ask if the user +should be asked before creation and NIL if we never create a new entry." + :group 'bbdb-utilities-supercite + :type '(choice (const "Create a new BBDB entry" t) + (const "Confirm new record creation" ask) + (const "Don't create a new entry" nil))) + +(defcustom bbdb/sc-attribution-field 'attribution + "The BBDB field used for Supercite attribution information." + :group 'bbdb-utilities-supercite + :type '(symbol :tag "Field name")) + +;;; Code starts +(defcustom bbdb/sc-last-attribution "" + "Default attribution return by the SuperCite citation engine, +used to compare against citation selected by the user." + :group 'bbdb-utilities-supercite + :type '(string :tag "Default citation" "")) + +(defun bbdb/sc-consult-attr (from) + "Extract citing information from BBDB using sc-consult where +FROM is user e-mail address to look for in BBDB." + ;; if logged in user sent this, use recipients. + (let ((from (if (or (null from) + (string-match (bbdb-user-mail-names) from)) + (car (cdr (mail-extract-address-components + (or (sc-mail-field "to") from)))) + from))) + (if from + (let ((record (bbdb-search-simple nil from))) + (and record + (bbdb-record-getprop record bbdb/sc-attribution-field)))))) + +(defun bbdb/sc-set-attr () + "Add attribute to BBDB." + (let ((from (sc-mail-field "from")) + (address (sc-mail-field "sc-from-address")) + (attr (sc-mail-field "sc-attribution"))) + (if (and from attr bbdb/sc-replace-attr-p + (not (string-equal attr bbdb/sc-last-attribution)) + (not (string-match (bbdb-user-mail-names) address))) + (let* ((bbdb-notice-hook nil) + ;; avoid noticing any headers in the reply message + (record (bbdb-annotate-message-sender + from t + (bbdb-invoke-hook-for-value + bbdb/mail-auto-create-p) t))) + (if record + (let ((old (bbdb-record-getprop record 'attribution))) + ;; ignore if we have an value and same value + (if (and (not (and old (string-equal old attr))) + (or (not (eq bbdb/sc-replace-attr-p 'ask)) + (y-or-n-p (concat "Change attribution " attr)))) + (progn (bbdb-record-putprop record + bbdb/sc-attribution-field attr) + (bbdb-change-record record nil))))))))) + +;;; this is marked as autoload since someone managed to trip up Gnus +;;; with it. I'm not clear this needs fixing, as you should be calling +;;; bbdb-insinuate-sc if you're using supercite/BBDB. However. +;;;###autoload +(defun bbdb/sc-default () + "If the current \"from\" field in `sc-mail-info' alist +contains only an e-mail address, lookup e-mail address in +BBDB, and prepend a new \"from\" field to `sc-mail-info'." + (let* ((from (sc-mail-field "from")) + (pair (and from (mail-extract-address-components from)))) + (if (and pair (not (car pair))) + (let* ((record (bbdb-search-simple nil (car (cdr pair)))) + (name (and record (bbdb-record-name record)))) + (if name + (setq sc-mail-info + (cons (cons "from" + (format "%s (%s)" (car (cdr pair)) name)) + sc-mail-info))))))) + +;;; setup the default setting of the variables +(defun bbdb/sc-setup-variables () + "Set up the various Supercite variables for the BBDB. +`sc-preferred-attribution-list', `sc-attrib-selection-list', and +`sc-mail-glom-frame' are set, but only if they have not previously +been defined. It is strongly suggested that you not call this +function directly, but that you use this function (specifically the +settings contained herein) as an example. In other words, set these +variables yourself, either in your Emacs configuration file or using +Custom." + + ;; check for sc-consult in sc-preferred-attribution-list + (if (boundp 'sc-preferred-attribution-list) + (or (member '"sc-consult" sc-preferred-attribution-list) + (bbdb-warn (concat "\"sc-consult\" not included in " + "sc-preferred-attribution-list. Attributions cannot" + "be gathered from the BBDB without \"sc-consult\"" + "in sc-preferred-attribution-list"))) + (defvar sc-preferred-attribution-list + '("sc-lastchoice" "x-attribution" "sc-consult" + "initials" "firstname" "lastname"))) + + ;; check sc-attrib-selection-list + (defvar sc-attrib-selection-list + '(("sc-from-address" + ((".*" . (bbdb/sc-consult-attr + (sc-mail-field "sc-from-address"))))))) + + ;; set sc-mail-glom-frame + (defvar sc-mail-glom-frame + '((begin (setq sc-mail-headers-start (point))) + ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t) + ("^\\S +:.*$" (sc-mail-fetch-field) nil t) + ("^$" (progn (bbdb/sc-default) + (list 'abort '(step . 0)))) + ("^[ \t]+" (sc-mail-append-field)) + (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) + (end (setq sc-mail-headers-end (point)))))) + +;; insert our hooks - call me from your Emacs initialization file +(defvar attribution) ;; dammit, supercite! +;;;###autoload +(defun bbdb-insinuate-sc () + "Call this function to hook BBDB into Supercite." + + (add-hook 'sc-post-hook 'bbdb/sc-set-attr) + (add-hook 'sc-attribs-postselect-hook + (function (lambda() + (setq bbdb/sc-last-attribution + (if sc-downcase-p + (downcase attribution) attribution)))))) + +(provide 'bbdb-sc) +;;; end of bbdb-sc.el diff --git a/lisp/bbdb-snarf.el b/lisp/bbdb-snarf.el new file mode 100644 index 0000000..bf9d969 --- /dev/null +++ b/lisp/bbdb-snarf.el @@ -0,0 +1,599 @@ +;;; bbdb-snarf.el -- convert free-form text to BBDB records + +;;; +;;; Copyright (C) 1997 by John Heidemann <johnh@isi.edu>. +;;; +;;; This file 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 version 1. +;;; +;;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; + +;;; +;;; bbdb-snarf is code to pick addresses, phones, and such out of a +;;; free-form paragraphs. Things are recognized by context (web pages +;;; start with http:// or www., for example). I wrote it because I +;;; despise fill-in-the-blank forms (a la bbdb-create). (if I wanted +;;; modes, I'd use vi :-). +;;; +;;; Eventually I'd like to be able to replace bbdb-mode with a free-form +;;; text mode where bbdb-snarf merges in any changes you make. +;;; I'm not there yet---merging is not good enough currently. +;;; Currently bbdb-snarf is good for pulling postal addresses +;;; from e-mail messages and converting other databases. +;;; + +(require 'bbdb) +(require 'bbdb-com) +(require 'rfc822) +(require 'mail-extr) + +(defconst bbdb-digit "[0-9]") +(defvar bbdb-snarf-phone-regexp + (concat + "\\(([2-9][0-9][0-9])[-. ]?\\|[2-9][0-9][0-9][-. ]\\)?" + "[0-9][0-9][0-9][-. ][0-9][0-9][0-9][0-9]" + "\\( *\\(x\\|ext\\.?\\) *[0-9]+\\)?" + ) + "regexp to match phones.") +(defvar bbdb-snarf-zip-regexp + (concat + "\\<" + bbdb-digit bbdb-digit bbdb-digit bbdb-digit bbdb-digit + "\\(-" bbdb-digit bbdb-digit bbdb-digit bbdb-digit "\\)?" + "\\>$") + "regexp matching zip.") + +(defcustom bbdb-snarf-web-prop 'www + "What property bbdb should use for the web, or nil to not detect web URLs." + :group 'bbdb + :type 'symbol) + +(defun bbdb-snarf-address-lines () + (let ((lines (bbdb-split (buffer-string) "\n"))) + (if (>= bbdb-file-format 5) nil + (while (< (length lines) 3) + (setq lines (append lines (list nil)))) + (if (> (length lines) 3) + (error "bbdb-snarf-address-lines: too many lines in address."))) + (delete-region (point-min) (point-max)) + lines)) + +(defun bbdb-snarf-make-address + (label address-lines city state zip country) + (if (>= bbdb-file-format 4) + (vector label address-lines city state zip country) + (if (>= bbdb-file-format 3) + (vector label address-lines city state zip) + (vector label + (nth 0 address-lines) + (nth 1 address-lines) + (nth 2 address-lines) + city state zip)))) + +(defun bbdb-snarf-prune-empty-lines () + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*\n" (point-max) t) + (replace-match ""))) + +(defun delete-and-return-region (begin end) + (prog1 + (buffer-substring begin end) + (delete-region begin end))) + +(defun bbdb-snarf-extract-label (default consume-p) + "Extract the label before the point, or return DEFAULT if no label. +If CONSUME-P is set, delete the text, if found." + (interactive "sDefault label: ") + (let ((end (point-marker))) + (skip-chars-backward " \t") + (if (not (= (point) (point-min))) + (forward-char -1)) + (if (looking-at ":") + (let* ((label-end (point)) + (label (delete-and-return-region + (progn (skip-chars-backward "^\n,;") (point)) + label-end))) + (delete-region (point) end) + label) + default))) + +(defun bbdb-snarf-parse-phone-number (phone) + "Fix the bogosity that is `bbdb-snarf-parse-phone-number'. +It doesn't always return a normalized phone number. +For (800) 555-1212 it returns a three element list." + (let ((try (bbdb-parse-phone-number phone))) + (if (= 3 (length try)) + (nconc try '(0))) + try)) + +;;;###autoload +(defun bbdb-snarf (where) + "snarf up a bbdb record WHERE the point is. +We assume things are line-broken and paragraph-bounded. +The name comes first and other fields (address, +phone, email, web pages) are recognized by context. + +Required context: + addresses end with \"City, State ZIP\" or \"City, State\" + phones match bbdb-snarf-phone-regexp + (currently US-style phones) + e-mail addresses have @'s in them + web sites are recognized by http:// or www. + +Address and phone context are currently US-specific; +patches to internationalize these assumptions are welcome. + +\\[bbdb-snarf] is similar to \\[bbdb-whois-sentinel], but less specialized." + (interactive "d") + (bbdb-snarf-region + (progn (goto-char where) (forward-paragraph -1) (point)) + (progn (forward-paragraph 1) (point)))) + +;;;###autoload +(defun bbdb-snarf-region (begin end) + "snarf up a bbdb record in the current region. See `bbdb-snarf' for +more details." + (interactive "r") + + (save-excursion + (let + ((buf (get-buffer-create " *BBDB snarf*")) + (text (buffer-substring-no-properties begin end)) + phones nets web city state zip name address-lines + address-vector notes) + (set-buffer buf) + (erase-buffer) + (insert text) + + ;; toss beginning and trailing space + (goto-char (point-min)) + (while (re-search-forward "^[ \t]+" (point-max) t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "^\\s +$" (point-max) t) + (replace-match "")) + + ;; first, pick out phone numbers + (goto-char (point-min)) + (while (re-search-forward bbdb-snarf-phone-regexp (point-max) t) + (let (phone + (begin (match-beginning 0)) + (end (match-end 0))) + (goto-char begin) + (forward-char -1) + (if (looking-at "[0-9A-Za-z]") + (goto-char end);; not really phone + (setq phone (bbdb-snarf-parse-phone-number + (delete-and-return-region begin end)) + phones (append phones + (list (vconcat + (list (bbdb-snarf-extract-label + (bbdb-label-completion-default + 'phone) t)) + phone))))))) + + ;; next, web pages + (goto-char (point-min)) + (if (and bbdb-snarf-web-prop + (re-search-forward "\\(http://\\|www\.\\)[^ \t\n]+" + (point-max) t)) + (progn + (setq web (match-string 0) + notes (append notes (list (cons bbdb-snarf-web-prop web)))) + (replace-match ""))) + + ;; next e-mail + (goto-char (point-min)) + (while (re-search-forward "[^ \t\n<]+@[^ \t\n>]+" (point-max) t) + (setq nets (append nets (list (match-string 0)))) + (replace-match "")) + + (bbdb-snarf-prune-empty-lines) + + ;; name + (goto-char (point-min)) + ;; This check is horribly english-centric (I think) + (while (and (not (eobp)) (/= (char-syntax (char-after (point))) ?w)) + (forward-line 1)) + (if (re-search-forward "\\(\\sw\\|[ -\.,]\\)*\\sw" nil t) + (progn + (setq name (match-string 0)) + (delete-region (match-beginning 0) (match-end 0)))) + + ;; address + (goto-char (point-min)) + (cond + ;; city, state zip + ((re-search-forward bbdb-snarf-zip-regexp (point-max) t) + (save-excursion + (save-restriction + (let (mk) + (narrow-to-region (point-min) (match-end 0)) + (goto-char (point-max)) + ;; zip + (re-search-backward bbdb-snarf-zip-regexp (point-min) t) + (setq zip (bbdb-parse-zip-string (match-string 0))) + ;; state + (skip-chars-backward " \t") + (setq mk (point)) + (skip-chars-backward "^ \t,") + (setq state (buffer-substring (point) mk)) + ;; city + (skip-chars-backward " \t,") + (setq mk (point)) + (beginning-of-line) + (setq city (buffer-substring (point) mk)) + ;; toss it + (forward-char -1) + (delete-region (point) (point-max)) + ;; address lines + (goto-char (point-min)) + (setq address-lines (bbdb-snarf-address-lines) + address-vector (list (bbdb-snarf-make-address + (bbdb-label-completion-default + 'address) + address-lines + city + state + zip + "";; FIXME: snarf country + ))))))) + ;; try for just city, state + ((re-search-forward "^\\(.*\\), \\([A-Z][A-Za-z]\\)$" + (point-max) t) + (save-excursion + (save-restriction + (setq city (match-string 1) + state (match-string 2)) + (narrow-to-region (point-min) (match-end 0)) + (goto-char (point-min)) + (setq address-lines (bbdb-snarf-address-lines) + address-vector (list (bbdb-snarf-make-address + "address" + address-lines + city + state + 0 + "";; FIXME: snarf country + )))))) + (t + (setq address-lines '(nil nil nil) + address-vector nil))) + + ;; anything else -> notes + (bbdb-snarf-prune-empty-lines) + (if (/= (point-min) (point-max)) + (setq notes (append notes (list (cons 'notes (buffer-string)))))) + + ;; debug + ; (goto-char (point-max)) + ; (insert "\n\n" + ; "name: " name "\n" + ; "city: " city "\n" + ; "state: " state "\n" + ; "zip: " zip "\n") + + (setq name (or name + (and nets (car (car (bbdb-rfc822-addresses (car nets))))) + "?")) + + (bbdb-merge-interactively name + nil + nets + address-vector + phones + notes)))) + + +; (setq bbdb-snarf-test-cases " +; +; another test person +; 1234 Gridley St. +; Los Angeles, CA 91342 +; 555-1212 +; test@person.net +; http://www.foo.bar/ +; other stuff about this person +; +; test person +; 1234 Gridley St. +; St. Los Angeles, CA 91342-1234 +; 555-1212 +; test@person.net +; +; x test person +; 1234 Gridley St. +; Los Angeles, California 91342-1234 +; 555-1212 +; test@person.net +; +; y test person +; 1234 Gridley St. +; Los Angeles, CA +; 555-1212 +; test@person.net +; " +; "some test cases") + + + +(defun bbdb-merge-interactively (name company nets addrs phones notes) + "Interactively add a new record; arguments same as \\[bbdb-create-internal]." + (let* + ((f-l-name (bbdb-divide-name name)) + (firstname (car f-l-name)) + (lastname (nth 1 f-l-name)) + (aka nil) + (new-record + (vector firstname lastname aka company phones addrs + (if (listp nets) nets (list nets)) notes + (make-vector bbdb-cache-length nil))) + (old-record (bbdb-search-simple name nets))) + (if old-record + (progn + (setq new-record (bbdb-merge-internally old-record new-record)) + (bbdb-delete-record-internal old-record))) + ;; create new record + (bbdb-invoke-hook 'bbdb-create-hook new-record) + (bbdb-change-record new-record t) + (bbdb-hash-record new-record) + (bbdb-display-records (list new-record)))) + +(defun bbdb-merge-internally (old-record new-record) + "Merge two records. NEW-RECORDS wins over OLD in cases of ties." + (if (and (null (bbdb-record-firstname new-record)) + (bbdb-record-firstname old-record)) + (bbdb-record-set-firstname new-record (bbdb-record-firstname old-record))) + (if (and (null (bbdb-record-lastname new-record)) + (bbdb-record-lastname old-record)) + (bbdb-record-set-lastname new-record (bbdb-record-lastname old-record))) + (if (and (null (bbdb-record-company new-record)) + (bbdb-record-company old-record)) + (bbdb-record-set-company new-record (bbdb-record-company old-record))) + ;; nets + (let ((old-nets (bbdb-record-net old-record)) + (new-nets (bbdb-record-net new-record))) + (while old-nets + (if (not (member (car old-nets) new-nets)) + (setq new-nets (append new-nets (list (car old-nets))))) + (setq old-nets (cdr old-nets))) + (bbdb-record-set-net new-record new-nets)) + ;; addrs + (let ((old-addresses (bbdb-record-addresses old-record)) + (new-addresses (bbdb-record-addresses new-record))) + (while old-addresses + (if (not (member (car old-addresses) new-addresses)) + (setq new-addresses (append new-addresses (list (car old-addresses))))) + (setq old-addresses (cdr old-addresses))) + (bbdb-record-set-addresses new-record new-addresses)) + ;; phones + (let ((old-phones (bbdb-record-phones old-record)) + (new-phones (bbdb-record-phones new-record))) + (while old-phones + (if (not (member (car old-phones) new-phones)) + (setq new-phones (append new-phones (list (car old-phones))))) + (setq old-phones (cdr old-phones))) + (bbdb-record-set-phones new-record new-phones)) + ;; notes + (let ((old-notes (bbdb-record-raw-notes old-record)) + (new-notes (bbdb-record-raw-notes new-record))) + (while old-notes + (if (not (member (car old-notes) new-notes)) + (setq new-notes (append new-notes (list (car old-notes))))) + (setq old-notes (cdr old-notes))) + (bbdb-record-set-raw-notes new-record new-notes)) + ;; return + new-record) + +;;---------------------------------------------------------------------------- +(defcustom bbdb-extract-address-component-regexps + '( + ;; "surname, firstname" <address> from Outlookers + ("\"\\([^\"]*\\)\"\\s-*<\\([^>]+\\)>" + (bbdb-clean-username (match-string 1 adstring)) 2) + + ;; name <address> + ("\\([^<>,\t][^<>,]+[^<>, \t]\\)\\s-*<\\([^>]+\\)>" + 1 2) + ;; <address> + ("<\\([^>,]+\\)>" nil 1) + ;; address (name) + ("\\(\\b[^<\",()]+\\b\\)\\s-*(\\([^)]+\\))" + (car (mail-extract-address-components + (concat "\"" (match-string 2 adstring) "\""))) + 1) + ;; firstname.lastname@host + ("\\b\\(\\([^@ \t\n.]+\\.[^@ \t\n.]+\\)@[^@ \t\n]+\\)\\b" + (car (mail-extract-address-components + (concat "\"" (match-string 2 adstring) "\""))) + 1) + ;; user@host + ("\\b\\(\\([^@ \t\n]+\\)@[^@ \t\n]+\\)\\b" + nil 1) + ;; localaddress + ("\\b\\([^@ \t\n]+\\)\\b" + nil 1) + ) + "*List of regexps matching headers. +Each list element should have the form (REGEXP FULLNAME ADDRESS), where +REGEXP matches the address while the actual address components should +be a parenthesized expression. + +FULLNAME is a default string for addresses without full name or a +number denoting parenthesized expression. +ADDRESS is a number denoting the parenthesized expression matching the +address. + +If FULLNAME or ADDRESS is a list it will be evaluated to return a +string or nil. If its a function it will be called with the remaining +address-string as argument." + :group 'bbdb-noticing-records + :type 'list) + +(defcustom bbdb-extract-address-component-ignore-regexp + "\\(\\(undisclosed\\|unlisted\\)[^,]*recipients\\)\\|no To-header on input" + "*A regexp matching addresses which should be ignored." + :group 'bbdb-noticing-records + :type 'string) + +(defcustom bbdb-extract-address-component-handler 'message + "*Specifies how `bbdb-extract-address-components' reports errors. + +A value of nil means ignore unparsable stuff and 'warn will report +a warning, 'message will report a message in the minibuffer and all +other value will fire a error. + +When set to a function it will be called with the remaining string in +order to extract the address components and return the rest and the +components as list or to do what ever it wants, e.g. send a complain +to the author ... + +To skip known unparseable stuff you rather should set the variable +`bbdb-extract-address-component-ignore-regexp' instead of disabling +this handler." + :group 'bbdb-noticing-records + :type '(choice (const :tag "Ignore problems." + nil) + (const :tag "Warn about parsing problems." + 'warn) + (const :tag "Show a message about parsing problems." + 'message) + (function :tag "A user defined handler"))) + +;;;###autoload +(defun bbdb-extract-address-components (adstring &optional ignore-errors) + "Return a list of address components found in ADSTRING. +If extracting fails one probably has to adjust the variable +`bbdb-extract-address-component-regexps'." + (let ((case-fold-search t) + (fnadlist nil) + adcom-regexp + nomatch) + + ;; Do some string cleanup and trimming + (setq adstring (bbdb-replace-in-string adstring "[\n\t]" " ")) + (setq adstring (bbdb-replace-in-string adstring " " " ")) + (setq adstring (bbdb-replace-in-string adstring "^ +" "")) + + ;; scan the string + (while (not (string= "" adstring)) + (setq adcom-regexp bbdb-extract-address-component-regexps + nomatch t) + (while adcom-regexp + (let ((regexp (caar adcom-regexp)) + (fn (car (cdar adcom-regexp))) + (ad (cadr (cdar adcom-regexp)))) + (cond ((string-match + (concat "^[^,]*\\(" + bbdb-extract-address-component-ignore-regexp + "\\)[^,]*\\(,\\|$\\)") + adstring) + (setq adstring (substring adstring (match-end 0)) + adcom-regexp nil + nomatch nil)) + ((string-match (concat "^\\s-*" regexp "\\s-*\\(,\\|$\\)") + adstring) + (add-to-list 'fnadlist + (list (let ((n + (cond ((numberp fn) + (match-string fn adstring)) + ((listp fn) + (save-match-data (eval fn))) + ((functionp fn) + (save-match-data + (funcall fn adstring))) + (t fn)))) + (if (string= n "") + nil + n)) + (let ((a + (cond ((numberp ad) + (match-string ad adstring)) + ((listp ad) + (save-match-data (eval ad))) + ((functionp ad) + (save-match-data + (funcall ad adstring))) + (t ad)))) + (if (string= a "") + nil + a)))) +; (save-match-data +; (message "%S Match on %S to\n\t%S" +; regexp adstring fnadlist)) + (setq adstring (substring adstring (match-end 0)) + adcom-regexp nil + nomatch nil))) + (setq adcom-regexp (cdr adcom-regexp)))) + + ;; Now handle problems + (if (and nomatch (not ignore-errors)) + (cond ((equal bbdb-extract-address-component-handler nil)) + ((equal bbdb-extract-address-component-handler 'warn) + (bbdb-warn "Cannot extract an address component at \"%s\". +See `bbdb-extract-address-component-handler' for more information." + adstring)) + ((equal bbdb-extract-address-component-handler 'message) + (message "Cannot extract an address component at \"%s\"." + adstring)) + ((functionp bbdb-extract-address-component-handler) + (let ((result + (funcall bbdb-extract-address-component-handler + adstring))) + (if (and (listp result) (= 3 (length result))) + (progn (add-to-list 'fnadlist (cdr result)) + (setq adstring (car result) + nomatch nil))))) + (t + (error "Cannot extract an address component at \"%30s\"" + adstring)))) + + ;; ignore the bad junk + (if nomatch + (if (string-match "^[^,]*," adstring) + (setq adstring (substring adstring (match-end 0))) + (setq adstring "")))) + + (delete '(nil nil) (nreverse fnadlist)))) + +;;; alternative name parser +;;;###autoload +(defun bbdb-rfc822-addresses ( addrline &optional ignore-errors) + "Split ADDRLINE into a list of parsed addresses. + +You can't do this with rfc822.el in any sort of useful way because it discards +the comments. You can't do this with mail-extr.el because the multiple address +parsing in GNU Emacs appears to be broken beyond belief, and the XEmacs +version doesn't support multiple addresses." + (let (addrs (start 0)) + (setq addrline (concat addrline ",")) ;; kludge, to make parsing easier + ;; Addresses are separated by commas. This is probably the worst + ;; possible way to do this, but it does cut down on the amount of + ;; coding effort I have to duplicate. Basically, we split on + ;; commas, and then try and parse what we've found. Pathologically + ;; bad address lines will break this. + (while (string-match "\\([^,]+\\)," addrline start) + (let* ((thisaddr (substring addrline 0 (match-end 1))) + (comma (match-end 0)) ;; rfc822-addresses trashes match-data + (parsed (rfc822-addresses thisaddr))) + (if (string-match "(" (or (car parsed) "")) ;; rfc822 didn't like it. + (setq start comma) + (setq addrs + (append addrs (list + (mail-extract-address-components + thisaddr))) + ;; throw away what we just parsed + addrline (substring addrline comma) + start 0)))) + addrs)) + +(provide 'bbdb-snarf) diff --git a/lisp/bbdb-srv.el b/lisp/bbdb-srv.el new file mode 100644 index 0000000..d28235b --- /dev/null +++ b/lisp/bbdb-srv.el @@ -0,0 +1,285 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is the part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1995 Jamie Zawinski <jwz@netscape.com>. +;;; Invoking BBDB from another process, via `gnudoit'. +;;; See the file bbdb.texinfo for documentation. +;;; +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; This requires the `gnuserv' and `itimer' packages. +;;; +;;; To use: +;;; +;;; First, do `(gnuserv-start)' to initialize the emacs server process. +;;; If you don't know what this does, see the doc for gnuserv.el. +;;; +;;; Then, an external process may invoke `gnudoit' in the following way: +;;; +;;; gnudoit '(bbdb-server "...all message headers..")' +;;; +;;; The bbdb-srv.perl program is a good choice for this; it takes a header +;;; block on stdin, and converts them to a lisp string, taking care to +;;; "sanitize" them so that hostile data can't take over the executing shell. +;;; +;;; The string should be a validly-formatted-and-quoted lisp string, and +;;; should contain multiple lines, which are the headers of the message for +;;; which a record should be displayed. It should contain at least a "From:" +;;; header, or nothing will be displayed, but it should contain as many headers +;;; as your various BBDB hooks might want access to. +;;; +;;; Records will not be displayed until no record has been requested for +;;; `bbdb/srv-display-delay' seconds (default 2.) This is to prevent rapid +;;; display of records from queueing up and swamping the emacs server process. +;;; +;;; Note that in order for this to build, itimer.el and gnuserv.el must be in +;;; the build-path. The easiest way to achieve this is to set OTHERDIR to point +;;; to the directory/ies they're in. + +;;; A trivial application of this is the shell command: +;;; +;;; echo 'From: Jamie Zawinski <jwz@netscape.com>' | bbdb-srv.perl +;;; +;;; which will cause the corresponding record to be displayed. +;;; A more interesting application of this is: +;;; +;;; setenv NS_MSG_DISPLAY_HOOK bbdb-srv.perl +;;; +;;; which will hook BBDB up to Mozilla (Unix Netscape Mail and Netscape News +;;; versions 3.0b2 and later only.) + +(require 'bbdb) +(require 'bbdb-com) +(require 'bbdb-hooks) + + +(eval-when-compile + (require 'mail-utils) ;; for mail-strip-quoted-names + (require 'bbdb-gui) ;; for extents macros + (if (featurep 'xemacs) + () + (fset 'set-keymap-name 'ignore) + (fset 'frame-lowest-window 'ignore))) + +;; newer version of gnuserv requires gnuserv-compat when using FSF emacs +;; but you might be using an older version, and we can't tell until you +;; crash it... +(or (fboundp 'define-obsolete-variable-alias) + (if (locate-library "gnuserv-compat") + (require 'gnuserv-compat))) +(require 'gnuserv) +(require 'itimer) + +(defcustom bbdb/srv-auto-create-p nil + "*Like `bbdb/news-auto-create-p' and `bbdb/mail-auto-create-p', +but for the case where the record is being displayed by some external +process via the `gnudoit' mechanism. + +If this is t, then records will automatically be created; if this is a +function name or lambda, then it is called with no arguments to decide +whether an entry should be automatically created. You can use this to, +for example, create or not create messages which have a particular subject. + +`bbdb/srv-auto-create-mail-news-dispatcher' is a good value for this -- +that function will try to decide if this is a mail message or a news +message, and then run either `bbdb/news-auto-create-p' or +`bbdb/mail-auto-create-p' as appropriate." + :group 'bbdb-utilities-server + :type '(choice (const :tag "Don't automatically create records" nil) + (const :tag "Automatically create records" t) + (sexp :tag "Use function to determine record creation" + bbdb/srv-auto-create-mail-news-dispatcher))) + +(defcustom bbdb/srv-display-delay 2 + "*How long (in seconds) we must be idle before displaying a record." + :group 'bbdb-utilities-server + :type 'integer) + +(defvar bbdb/srv-pending-headers nil) +(defvar bbdb/srv-pending-map + (and (fboundp 'bbdb-set-extent-property) + (condition-case nil + (let ((m (make-sparse-keymap))) + (set-keymap-name m 'bbdb/srv-pending-map) + (define-key m 'button1 'bbdb/srv-pending-add) + m) + (error nil)))) + +(defun bbdb/srv-handle-headers (headers &optional create-p) + "Display (or create) the BBDB entry corresponding to the message headers. +HEADERS should be a string containing an RFC822 header block; at least a +\"From:\" header should be provided, but others will be made available to +the various hooks (like `bbdb-notice-hook' and `bbdb/news-auto-create-p')." + (let ((buf "*bbdb-tmp*") + (record nil) + (bbdb-force-dialog-boxes t) ; affects bbdb-y-or-n-p + from) + (save-excursion + (set-buffer (or (get-buffer buf) + (progn + (setq buf (get-buffer-create buf)) + (set-buffer buf) + (buffer-disable-undo buf) + buf))) + (erase-buffer) + (insert headers "\n\n") + (setq from (mail-fetch-field "from")) + (if (or (null from) + (string-match (bbdb-user-mail-names) + (mail-strip-quoted-names from))) + ;; if logged-in user sent this, use recipients. + (setq from (or (mail-fetch-field "to") from))) + (if from + (setq record + (bbdb-annotate-message-sender from t + (or create-p + (bbdb-invoke-hook-for-value + bbdb/srv-auto-create-p)) + nil)))) + (let ((w (get-buffer-window bbdb-buffer-name))) + (if w + nil + (setq w (selected-window)) + (unwind-protect + (progn + (if (fboundp 'frame-lowest-window) + (select-window (frame-lowest-window))) + (bbdb-pop-up-bbdb-buffer)) + (select-window w)) + (setq w (get-buffer-window bbdb-buffer-name)) + (if (fboundp 'set-window-dedicated-p) + (set-window-dedicated-p w bbdb-buffer-name)))) + (cond (record + (let ((bbdb-gag-messages t) + (bbdb-use-pop-up nil) + (bbdb-electric-p nil) + (b (current-buffer))) + (save-window-excursion ;; needed to get around XEmacs 19.15 bug? + (bbdb-display-records (list record)) bbdb-pop-up-display-layout) + (set-buffer b))) + ((and from (not create-p) bbdb/srv-pending-map) + (setq bbdb/srv-pending-headers headers) + (save-excursion + (set-buffer bbdb-buffer-name) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert "\t\t\t") + (let ((p (point)) + e) + (insert from) + (setq e (bbdb-make-extent p (point))) + (bbdb-set-extent-face e 'bold) + (bbdb-set-extent-property e 'highlight t) + (bbdb-set-extent-property e 'keymap bbdb/srv-pending-map) + ) + (insert "\n\n\t\t\tClick to add to BBDB.") + )))))) + +(defun bbdb/srv-pending-add () + (interactive "@") + (or bbdb/srv-pending-headers (error "lost headers?")) + (bbdb/srv-handle-headers bbdb/srv-pending-headers t)) + + +(defvar bbdb/srv-itimer-arg nil) +(defun bbdb/srv-itimer () + "Used as a timer function by bbdb/srv-handle-headers-with-delay. +This invokes bbdb/srv-handle-headers with bbdb/srv-itimer-arg. +We do it this way instead of by using a lambda to start-itimer so that +we cons less." + (defvar current-itimer) + (if current-itimer (delete-itimer current-itimer)) + (if bbdb/srv-itimer-arg + (bbdb/srv-handle-headers + (prog1 bbdb/srv-itimer-arg + (setq bbdb/srv-itimer-arg nil))))) + +;;;###autoload +(defun bbdb/srv-handle-headers-with-delay (headers) + "Just like bbdb/srv-handle-headers, but only updates every few seconds. +This is so that trying to display many records in succession won't queue them +up, but will end up only displaying a record when no displays have been +requested for a couple of seconds." + (let* ((name "bbdb-srv") + (itimer (get-itimer name))) + (setq bbdb/srv-itimer-arg headers) + (if itimer + ;; It hasn't gone off yet; just change what it's argument will be. + nil + ;; else, start the timer going again. + (start-itimer name 'bbdb/srv-itimer bbdb/srv-display-delay nil)) + nil)) + +;;;###autoload +(defalias 'bbdb-srv 'bbdb/srv-handle-headers-with-delay) + +(autoload 'bbdb-header-start "bbdb-hooks") + +;;;###autoload +(defun bbdb/srv-auto-create-mail-news-dispatcher () + "For use as the value of bbdb/srv-auto-create-p. +This will try to decide if this is a mail message or a news message, and then +run either bbdb/news-auto-create-p or bbdb/mail-auto-create-p as appropriate. +\(The heuristic is that news messages never have a Status or X-Mozilla-Status +header; and that mail messages never have Path headers.)" + (let (mail-p) + (save-excursion + (let ((start (bbdb-header-start))) + (set-buffer (marker-buffer start)) + (setq mail-p + (cond ((progn (goto-char start) + (bbdb-extract-field-value "Status")) + t) + ((progn (goto-char start) + (bbdb-extract-field-value "X-Mozilla-Status")) + t) + ((progn (goto-char start) + (bbdb-extract-field-value "Path")) + nil) + (t t))))) ; can't tell -- guess mail. + (bbdb-invoke-hook-for-value + (if mail-p bbdb/mail-auto-create-p bbdb/news-auto-create-p)))) + + +;; For caller-id stuff +;;;###autoload +(defun bbdb-srv-add-phone (phone-string &optional description record) + (let ((phone (make-vector (if bbdb-north-american-phone-numbers-p + bbdb-phone-length + 2) + nil))) + (setq record (if (stringp record) + (or (bbdb-search-simple record "") + (bbdb-create-internal record nil nil nil nil nil)) + (bbdb-completing-read-record + (format "Add %s to: " phone-string)))) + (if (= 2 (length phone)) + (aset phone 1 phone-string) + (let ((newp (bbdb-parse-phone-number phone-string))) + (bbdb-phone-set-area phone (nth 0 newp)) + (bbdb-phone-set-exchange phone (nth 1 newp)) + (bbdb-phone-set-suffix phone (nth 2 newp)) + (bbdb-phone-set-extension phone (or (nth 3 newp) 0)))) + (bbdb-phone-set-location phone + (or description + (read-string "Phone number description: " + "cid"))) + (bbdb-record-set-phones record + (nconc (bbdb-record-phones record) (list phone))) + (bbdb-change-record record nil) + (bbdb-display-records (list record)) + record)) + +(provide 'bbdb-srv) diff --git a/lisp/bbdb-vm.el b/lisp/bbdb-vm.el new file mode 100644 index 0000000..9ef279a --- /dev/null +++ b/lisp/bbdb-vm.el @@ -0,0 +1,426 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is the part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski <jwz@netscape.com>. +;;; Interface to VM (View Mail) 5.31 or greater. See bbdb.texinfo. + +;;; The Insidious Big Brother Database 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 1, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(eval-and-compile + (require 'cl) + (require 'bbdb) + (require 'bbdb-com) + (require 'bbdb-snarf) + (require 'vm-version) + (require 'vm-macro) + (require 'vm-message) + (require 'vm-misc) + (require 'vm-undo) + (require 'vm-motion) + (require 'vm-summary) + (require 'vm-vars) + (require 'vm-folder) + (require 'vm-mime)) + +(defun bbdb/vm-get-header-content (header-field msg) + (let ((content (vm-get-header-contents msg (concat header-field ":")))) + (if content + (vm-decode-mime-encoded-words-in-string content)))) + +(defcustom bbdb/vm-update-records-mode +; '(if (vm-new-flag msg) 'annotating 'searching) + 'annotating + "Controls how `bbdb/vm-update-records' processes email addresses. +Set this to an expression which evaluates either to 'searching or +'annotating. When set to 'annotating email addresses will be fed to +`bbdb-annotate-message-sender' in order to update existing records or create +new ones. A value of 'searching will search just for existing records having +the right net. + +The default is to annotate only new messages." + :group 'bbdb-mua-specific-vm + :type '(choice (const :tag "annotating all messages" + annotating) + (const :tag "annotating no messages" + searching) + (const :tag "annotating only new messages" + (if (vm-new-flag msg) 'annotating 'searching)) + (sexp :tag "user defined"))) + +;;;###autoload +(defun bbdb/vm-update-record (&optional offer-to-create) + (let* ((bbdb-get-only-first-address-p t) + (records (bbdb/vm-update-records offer-to-create))) + (if records (car records) nil))) + +;;;###autoload +(defun bbdb/vm-update-records (&optional offer-to-create) + "Returns the records corresponding to the current VM message, +creating or modifying them as necessary. A record will be created if +`bbdb/mail-auto-create-p' is non-nil or if OFFER-TO-CREATE is true, and +the user confirms the creation. + +The variable `bbdb/vm-update-records-mode' controls what actions +are performed and it might override `bbdb-update-records-mode'. + +When hitting C-g once you will not be asked anymore for new people listed +in this message, but it will search only for existing records. When hitting +C-g again it will stop scanning." + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (let ((msg (car vm-message-pointer)) + (enable-local-variables t) ; ...or vm bind this to nil. + (inhibit-quit nil) ; vm better not bind this to t! + (bbdb/vm-offer-to-create offer-to-create) + cache records) + + ;; ignore cache if we may be creating a record, since the cache + ;; may otherwise tell us that the user didn't want a record for + ;; this person. + (if (not bbdb/vm-offer-to-create) + (setq cache (and msg (bbdb-message-cache-lookup msg)))) + + (if cache + (setq records (if bbdb-get-only-first-address-p + (list (car cache)) + cache)) + + (let ((bbdb-update-records-mode (or bbdb/vm-update-records-mode + bbdb-update-records-mode))) + (setq records (bbdb-update-records + (bbdb-get-addresses bbdb-get-only-first-address-p + vm-summary-uninteresting-senders + 'bbdb/vm-get-header-content + (vm-real-message-of msg)) + bbdb/mail-auto-create-p + offer-to-create)) + + (bbdb-encache-message msg records))) + records)) + +;;;###autoload +(defun bbdb/vm-annotate-sender (string &optional replace) + "Add a line to the end of the Notes field of the BBDB record +corresponding to the sender of this message. If REPLACE is non-nil, +replace the existing notes entry (if any)." + (interactive + (list (if bbdb-readonly-p + (error "The Insidious Big Brother Database is read-only.") + (read-string "Comments: ")))) + (vm-follow-summary-cursor) + (let ((record (or (bbdb/vm-update-record t) (error "unperson")))) + (bbdb-annotate-notes record string 'notes replace))) + +(defun bbdb/vm-edit-notes (&optional arg) + "Edit the notes field or (with a prefix arg) a user-defined field +of the BBDB record corresponding to the sender of this message." + (interactive "P") + (vm-follow-summary-cursor) + (let ((record (or (bbdb/vm-update-record t) (error "unperson")))) + (bbdb-display-records (list record)) + (if arg + (bbdb-record-edit-property record nil t) + (bbdb-record-edit-notes record t)))) + +;;;###autoload +(defun bbdb/vm-show-records (&optional address-class) + "Display the contents of the BBDB for the sender of this message. +This buffer will be in bbdb-mode, with associated keybindings." + (interactive) + (vm-follow-summary-cursor) + (let ((bbdb-get-addresses-headers + (if address-class + (list (assoc address-class bbdb-get-addresses-headers)) + bbdb-get-addresses-headers)) + (bbdb/vm-update-records-mode 'annotating) + (bbdb-message-cache nil) + ;; should we move this to bbdb/vm-show-sender? + (bbdb-user-mail-names nil) + (vm-summary-uninteresting-senders nil) + records) + (setq records (bbdb/vm-update-records t)) + (if records + (bbdb-display-records records) + (bbdb-undisplay-records)) + records)) + +;;;###autoload +(defun bbdb/vm-show-all-recipients () + "Show all recipients of this message. Counterpart to `bbdb/vm-show-sender'." + (interactive) + (let ((bbdb-get-only-first-address-p nil)) + (bbdb/vm-show-records 'recipients))) + +;;;###autoload +(defun bbdb/vm-show-sender (&optional show-recipients) + "Display the contents of the BBDB for the senders of this message. +With a prefix argument show the recipients instead, +with two prefix arguments show all records. +This buffer will be in `bbdb-mode', with associated keybindings." + (interactive "p") + (cond ((= 4 show-recipients) + (bbdb/vm-show-all-recipients)) + ((= 16 show-recipients) + (let ((bbdb-get-only-first-address-p nil)) + (bbdb/vm-show-records))) + (t + (if (null (bbdb/vm-show-records 'authors)) + (bbdb/vm-show-all-recipients))))) + +(defun bbdb/vm-pop-up-bbdb-buffer (&optional offer-to-create) + "Make the *BBDB* buffer be displayed along with the VM window(s). +Displays the records corresponding to the sender respectively +recipients of the current message. +See `bbdb-get-addresses-headers' and 'bbdb-get-only-first-address-p' for +configuration of what is being displayed." + (save-excursion + (let ((bbdb-gag-messages t) + (bbdb-electric-p nil) + (records (bbdb/vm-update-records offer-to-create)) + (bbdb-buffer-name bbdb-buffer-name)) + + (when (and bbdb-use-pop-up records) + (bbdb-pop-up-bbdb-buffer + (function (lambda (w) + (let ((b (current-buffer))) + (set-buffer (window-buffer w)) + (prog1 (member major-mode '(vm-mode vm-presentation-mode)) + (set-buffer b)))))) + + ;; Always update the records; if there are no records, empty the + ;; BBDB window. This should be generic, not VM-specific. + (bbdb-display-records records bbdb-pop-up-display-layout)) + + (when (not records) + (bbdb-undisplay-records) + (if (get-buffer-window bbdb-buffer-name) + (delete-window (get-buffer-window bbdb-buffer-name))))))) + + +;; By Alastair Burt <burt@dfki.uni-kl.de> +;; vm 5.40 and newer support a new summary format, %U<letter>, to call +;; a user-provided function. Use "%-17.17UB" instead of "%-17.17F" to +;; have your VM summary buffers display BBDB's idea of the sender's full +;; name instead of the name (or lack thereof) in the message itself. + +(defun vm-summary-function-B (m &optional to-p) + "Given a VM message returns the BBDB name of the sender. +Respects vm-summary-uninteresting-senders." + (if (and vm-summary-uninteresting-senders (not to-p)) + (let ((case-fold-search nil)) + (if (string-match vm-summary-uninteresting-senders (vm-su-from m)) + (concat vm-summary-uninteresting-senders-arrow + (vm-summary-function-B m t)) + (or (bbdb/vm-alternate-full-name (vm-su-from m)) + (vm-su-full-name m)))) + (or (bbdb/vm-alternate-full-name (if to-p (vm-su-to m) (vm-su-from m))) + (vm-decode-mime-encoded-words-in-string + (if to-p (vm-su-to-names m) (vm-su-full-name m)))))) + +(defun bbdb/vm-alternate-full-name (address) + (if address + (let ((entry (bbdb-search-simple + nil + (if (and address bbdb-canonicalize-net-hook) + (bbdb-canonicalize-address address) + address)))) + (if entry + (or (bbdb-record-getprop entry 'mail-name) + (bbdb-record-name entry)))))) + + +;; From: Mark Thomas <mthomas@jprc.com> +;; Subject: auto-folder-alist from bbdb + +;;;###autoload +(defcustom bbdb/vm-set-auto-folder-alist-field 'vm-folder + "*The field which `bbdb/vm-set-auto-folder-alist' searches for." + :group 'bbdb-mua-specific-vm + :type 'symbol) + +;;;###autoload +(defcustom bbdb/vm-set-auto-folder-alist-headers '("From:" "To:" "CC:") + "*The headers used by `bbdb/vm-set-auto-folder-alist'. +The order in this list is the order how matching will be performed!" + :group 'bbdb-mua-specific-vm + :type '(repeat (string :tag "header name"))) + +;;;###autoload +(defun bbdb/vm-set-auto-folder-alist () + "Create a `vm-auto-folder-alist' according to the records in the bbdb. +For each record that has a 'vm-folder' attribute, add an +element (email-regexp . folder) to the `vm-auto-folder-alist'. + +The element gets added to the 'element-name' sublist of the +`vm-auto-folder-alist'. + +The car of the element consists of all the email addresses for the +bbdb record concatenated with OR; the cdr is the value of the +vm-folder attribute. + +If the first character of vm-folders value is a quote ' it will be +parsed as lisp expression and is evaluated to return a folder name, +e.g. define you own function `my-folder-name' and set it to + '(my-folder-name)" + (interactive) + (let* (;; we add the email-address/vm-folder-name pair to this + ;; sublist of the vm-auto-folder-alist variable + (headers (reverse bbdb/vm-set-auto-folder-alist-headers)) + header + ;; grab the folder list from the vm-auto-folder-alist + folder-list + ;; the raw-notes and vm-folder attributes of the current bbdb + ;; record + notes-field folder + ;; a regexp matching all the email addresses from the bbdb + ;; record + email-regexp + ;; + records) + + (setq records + (delete + nil + (mapcar (lambda (r) + (if (bbdb-record-getprop r bbdb/vm-set-auto-folder-alist-field) + r)) + (bbdb-records)))) + + (while headers + (setq header (car headers) headers (cdr headers)) + ;; create the folder-list in vm-auto-folder-alist if it doesn't exist + (setq folder-list (assoc header vm-auto-folder-alist)) + (unless folder-list + (setq vm-auto-folder-alist (cons (list header) + vm-auto-folder-alist) + folder-list (assoc header vm-auto-folder-alist))) + (mapcar + (lambda (r) + (setq notes-field (bbdb-record-raw-notes r)) + (when (and (listp notes-field) + (setq folder (cdr (assq bbdb/vm-set-auto-folder-alist-field + notes-field)))) + ;; quote all the email addresses for the record and join them + ;; with OR + (setq email-regexp (regexp-opt (bbdb-record-net r))) + (unless (or (zerop (length email-regexp)) + (assoc email-regexp folder-list)) + ;; be careful: nconc modifies the list in place + (if (equal (elt folder 0) ?\') + (setq folder (read (substring folder 1)))) + (nconc folder-list (list (cons email-regexp folder)))))) + records)))) + + +;;; bbdb/vm-auto-add-label +;;; Howard Melman, contributed Jun 16 2000 +(defcustom bbdb/vm-auto-add-label-list nil + "*List used by `bbdb/vm-auto-add-label' to automatically label messages. +Each element in the list is either a string or a list of two strings. +If a single string then it is used as both the field value to check for +and the label to apply to the message. If a list of two strings, the first +is the field value to search for and the second is the label to apply." + :group 'bbdb-mua-specific-vm + :type 'list) + +(defcustom bbdb/vm-auto-add-label-field bbdb-define-all-aliases-field + "*Fields used by `bbdb/vm-auto-add-label' to automatically label messages. +Value is either a single symbol or a list of symbols of bbdb fields that +`bbdb/vm-auto-add-label' uses to check for labels to apply to messages. +Defaults to `bbdb-define-all-aliases-field' which is typically `mail-alias'." + :group 'bbdb-mua-specific-vm + :type '(choice symbol list)) + +(defun bbdb/vm-auto-add-label (record) + "Automatically add labels to messages based on the mail-alias field. +Add this to `bbdb-notice-hook' and if using VM each message that bbdb +notices will be checked. If the sender has a value in the +bbdb/vm-auto-add-label-field in their BBDB record that +matches a value in `bbdb/vm-auto-add-label-list' then a VM +label will be added to the message. + +This works great when `bbdb-user-mail-names' is set. As a result +mail that you send to people (and copy yourself on) is labeled as well. + +This is how you hook it in. +;; (add-hook 'bbdb-notice-hook 'bbdb/vm-auto-add-label) +" + (let (field aliases sep) + (and (eq major-mode 'vm-mode) + (mapcar #'(lambda(x) + (and + (setq field (bbdb-record-getprop record x)) + (setq sep (or (get x 'field-separator) ",")) + (setq aliases (append aliases (bbdb-split field sep))))) + (cond ((listp bbdb/vm-auto-add-label-field) + bbdb/vm-auto-add-label-field) + ((symbolp bbdb/vm-auto-add-label-field) + (list bbdb/vm-auto-add-label-field)) + (t (error "Bad value for bbdb/vm-auto-add-label-field")) + )) + (vm-add-message-labels + (mapconcat #'(lambda (l) + (cond ((stringp l) + (if (member l aliases) + l)) + ((and (consp l) + (stringp (car l)) + (stringp (cdr l))) + (if (member (car l) aliases) + (cdr l))) + (t + (error "Malformed bbdb/vm-auto-add-label-list") + ))) + bbdb/vm-auto-add-label-list + " ") + 1)))) + + +;;; Automatically add a record for replies. +;;; Contributed by Robert Fenk, 27 Oct 2000. It only took me 8 months to put +;;; it in the source... +;;; +;;; (add-hook 'vm-reply-hook 'bbdb/vm-force-create) to enable it. You could +;;; presumably hook it elsewhere as well. +(defun bbdb/vm-force-create () + "Force automatic adding of a bbdb entry for current message." + (interactive) + (let ((bbdb/mail-auto-create-p t) + (bbdb-message-caching-enabled nil)) + (save-excursion + (vm-select-folder-buffer) + (bbdb/vm-pop-up-bbdb-buffer)))) + + +;;;###autoload +(defun bbdb-insinuate-vm () + "Call this function to hook BBDB into VM." + (cond ((boundp 'vm-select-message-hook) ; VM 5.36+ + (add-hook 'vm-select-message-hook 'bbdb/vm-pop-up-bbdb-buffer)) + ((boundp 'vm-show-message-hook) ; VM 5.32.L+ + (add-hook 'vm-show-message-hook 'bbdb/vm-pop-up-bbdb-buffer)) + (t + (error "vm versions older than 5.36 no longer supported"))) + (define-key vm-mode-map ":" 'bbdb/vm-show-sender) + ;; (define-key vm-mode-map "'" 'bbdb/vm-show-all-recipients) ;; not yet + (define-key vm-mode-map ";" 'bbdb/vm-edit-notes) + (define-key vm-mode-map "/" 'bbdb) + ;; VM used to inherit from mail-mode-map, so bbdb-insinuate-sendmail + ;; did this. Kyle, you loser. + (if (boundp 'vm-mail-mode-map) + (define-key vm-mail-mode-map "\M-\t" 'bbdb-complete-name))) + +(provide 'bbdb-vm) diff --git a/lisp/bbdb-w3.el b/lisp/bbdb-w3.el new file mode 100644 index 0000000..4c9c8d4 --- /dev/null +++ b/lisp/bbdb-w3.el @@ -0,0 +1,61 @@ +;;; This file is part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski <jwz@netscape.com>. +;;; WWW-related functions for the BBDB. See bbdb.texinfo. + +;;; The Insidious Big Brother Database 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 or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(require 'bbdb-com) +(require 'browse-url) + +(defvar w3-mode-map) +(eval-when-compile + (condition-case() (require 'url) (error (fset 'url-view-url 'ignore)))) + +;;;###autoload +(defun bbdb-www (rec &optional which) + "Visit URLs stored in the `www' field of the current record. +\\[bbdb-apply-next-command-to-all-records]\\[bbdb-www] \ +means to try all records currently visible. +Non-interactively, do all records if arg is nonnil." + (interactive (list (bbdb-get-record "Visit (WWW): ") + (or current-prefix-arg 0))) + (browse-url (read-string "fetch: " + (or (bbdb-get-field rec 'www which) + (bbdb-get-field rec 'ftp which))))) + +;;;###autoload +(defun bbdb-www-grab-homepage (record) + "Grab the current URL and store it in the bbdb database" + (interactive (list (bbdb-completing-read-one-record + "Add WWW homepage for: "))) + ;; if there is no database record for this person, create one + (unless record + (setq record (bbdb-read-new-record)) + (bbdb-invoke-hook 'bbdb-create-hook record)) + (if (bbdb-record-getprop record 'www) + (bbdb-record-putprop + record 'www + (concat (bbdb-record-getprop record 'www) "," (url-view-url t))) + (bbdb-record-putprop record 'www (url-view-url t))) + (bbdb-change-record record t) + (bbdb-display-records (list record))) + +;;;###autoload +(defun bbdb-insinuate-w3 () + "Call this function to hook BBDB into W3." + (add-hook 'w3-mode-hook + (lambda () (define-key w3-mode-map ":" 'bbdb-www-grab-homepage)))) + +(provide 'bbdb-w3) diff --git a/lisp/bbdb-whois.el b/lisp/bbdb-whois.el new file mode 100644 index 0000000..af4c34d --- /dev/null +++ b/lisp/bbdb-whois.el @@ -0,0 +1,264 @@ +;;; bbdb-whois.el -- Big Brother gets a little help from Big Brother +;;; This file is part of the Insidious Big Brother Database (aka BBDB). +;;; +;;; Copyright (C) 1992, 1993 Roland McGrath +;;; +;;; This program 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, or (at your option) +;;; any later version. +;;; +;;; This program 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. +;;; +;;; A copy of the GNU General Public License can be obtained from this +;;; program's author (send electronic mail to roland@gnu.ai.mit.edu) or +;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA +;;; 02139, USA. +;;; +;;; Send bug reports to bbdb@waider.ie + +(require 'bbdb-com) + +(defmacro bbdb-add-to-field (record field text) + (let ((get (intern (concat "bbdb-record-" (symbol-name field)))) + (set (intern (concat "bbdb-record-set-" (symbol-name field))))) + `(let ((old (,get ,record)) + (text ,text)) + (or (member text old) + (,set ,record (nconc old (list text))))))) + +(defcustom bbdb-whois-server (or (and (boundp 'whois-server) whois-server) + "whois.geektools.com") + "*Server for \\[bbdb-whois] lookups." + :group 'bbdb-utilities + :type 'string) + +(defvar bbdb-whois-name nil + "Used to store the name during a whois call.") +(make-variable-buffer-local 'bbdb-whois-name) +(defvar bbdb-whois-record nil + "Used to store the record during a whois call.") +(make-variable-buffer-local 'bbdb-whois-record) + +;;; main entry point. it'd be nice if we could bbdb-whois an arbitrary +;;; name and make a record from that directly. + +;;;###autoload +(defun bbdb-whois (the-record &optional server) + (interactive (list (bbdb-get-record "BBDB Whois: ") + (and current-prefix-arg + (read-string "Query whois server: " + bbdb-whois-server)))) + (or server (setq server bbdb-whois-server)) + (if (or (bbdb-record-lastname the-record) (bbdb-record-firstname the-record)) + ;; XXX we seem to get called with a vector of nils. + (save-excursion + (set-buffer (generate-new-buffer " *bbdb-whois*")) + (set bbdb-whois-record the-record) + (set bbdb-whois-name + (if (bbdb-record-getprop the-record 'nic) + (concat "!" (bbdb-record-getprop the-record 'nic)) + (concat (bbdb-record-lastname the-record) ", " + (bbdb-record-firstname the-record)))) + (let ((proc (open-network-stream "whois" (current-buffer) server 43))) + (set-process-sentinel proc 'bbdb-whois-sentinel) + (process-send-string proc (concat bbdb-whois-name "\r\n")))))) + +;;; This function parses the results from the server. +(defun bbdb-whois-sentinel (proc status) + (save-excursion + (let (rec) + (set-buffer (process-buffer proc)) + (setq rec bbdb-whois-record) + (goto-char 1) + + ;; check for multiple replies + ;; should maybe present a menu/completion buffer of multiples and do a + ;; refetch. + (if (not (re-search-forward "Record last updated" (point-max) t)) + (if (re-search-forward "No match" (point-max) t) + (message "Can not find a whois record for `%s'" bbdb-whois-name) + (if (re-search-forward "Access Limit Exceeded" (point-max) t) + (message "Per-day access limit to %s exceeded." + bbdb-whois-server) ;; bah! + (message "%s is ambiguous to whois; try a different name" + bbdb-whois-name))) + + ;; clean up & parse buffer, otherwise. + (while (re-search-forward "\r\n" (point-max) t) + (replace-match "\n")) + (goto-char 1) + (if (re-search-forward + (concat (if (string-match "^!" bbdb-whois-name) + (concat "(\\(" + (regexp-quote (substring bbdb-whois-name 1)) + "\\))") + (concat (regexp-quote bbdb-whois-name) + ".*(\\([A-Z0-9]+\\))")) + "\\s *\\(\\S +@\\S +\\)?$") + nil t) + (let ((net (if (match-beginning 2) + (downcase (buffer-substring (match-beginning 2) + (match-end 2))))) + (nic (buffer-substring (match-beginning 1) (match-end 1))) + (lines nil)) + (if net + (bbdb-add-to-field rec net net)) + (bbdb-record-putprop rec 'nic nic) + + ;; Snarf company. + ;; not all nic records have companies, though. + (forward-line 1) + (back-to-indentation) + (let ((company (buffer-substring (point) (progn (end-of-line) + (point)))) + (old (bbdb-record-company rec))) + (cond ((not old) + (bbdb-record-set-company rec company)) + ((string= old company) + nil) + (t + (bbdb-record-putprop rec 'nic-organization company)))) + + ;; Read the address info into LINES. + (while (progn (forward-line 1) + (not (looking-at "^$"))) + (back-to-indentation) + (setq lines (cons (buffer-substring (point) + (progn (end-of-line) + (point))) + lines))) + + ;; Snarf phone number. + ;; phone, fax are presented, it seems, as + ;; +country area prefix number +country area prefix number + ;; we can look for the " +" and split there, I guess. + (if (car lines) + (let ((phones (car lines)) + (n 1) + phone-numbers) + (while (string-match "^\\(.+\\) \\+" phones) + (setq phone-numbers + (append phone-numbers + (list (substring phones 0 (match-end 1)))) + phones (substring phones (+ 1 (match-end 1))))) + (setq phone-numbers (append phone-numbers + (list phones))) + + ;; now add each member of the list to the bbdb record + ;; it'd be nice if we could be smarter about this. + (mapc (function + (lambda(p) + (if (not (bbdb-find-phone + p (bbdb-record-phones rec))) + (let ((p-n + (vector (format "nic-phone-%d" n) p))) + (bbdb-add-to-field rec phones p-n) + (setq n (+ 1 n)))))) + phone-numbers) + + ;; throw away phones line from what we've snarfed + (setq lines (cdr lines)))) + + ;; Snarf address. + (if (car lines) + (let ((addr (make-vector bbdb-address-length nil)) + (city "") + (state "") + (zip "") + (country "")) + + ;; extract country + (if (string-match "^[A-Z][A-Z]$" (car lines)) + (setq country (car lines) ;; could convert from ISO... + lines (cdr lines))) + + ;; extract city, state, zip + ;; it would be nice if this could all use bbdb-snarf. + ;; or if NICs would hand out something machine + ;; readable, like <shudder> XML. + ;; + ;; note the zipcode check at the end of the regexp + ;; isn't really a zipcode check, because we don't do + ;; zipcode checks any more. + (if (string-match + "\\([^,]+\\),\\s *\\(\\S +\\)\\s *\\(.+\\)" + (car lines)) + (setq city (substring (car lines) + (match-beginning 1) + (match-end 1)) + state (substring (car lines) + (match-beginning 2) + (match-end 2)) + zip (substring (car lines) + (match-beginning 3) + (match-end 3)) + lines (cdr lines)) + ;; otherwise we just stuff everything into the + ;; streets list and let the user clean it up. This + ;; would be nice to do heuristically, if I knew + ;; enough about variable address formats. + ;; (bbdb-snarf-grok-address (ADDR)) would be neat. + ) + + (bbdb-address-set-location addr "nic-address") + (bbdb-address-set-city addr (or city "")) + (bbdb-address-set-state addr (or state "")) + (bbdb-address-set-zip addr (or zip "")) + (bbdb-address-set-country addr (or country "")) + (setq lines (nreverse lines)) + (bbdb-address-set-streets addr lines) + + ;; should probably overwrite existing nic-address field. + (bbdb-add-to-field rec addresses addr))) + + ;; Snarf any random notes. + (setq lines nil) + (while (progn + (forward-line 1) + (back-to-indentation) + (not (looking-at + "$\\|Record last updated on"))) + (if (looking-at "Alternate mailbox: \\(\\S +\\)$") + (bbdb-add-to-field rec net + (buffer-substring (match-beginning 1) + (match-end 1))) + (setq lines (cons (buffer-substring (point) + (progn (end-of-line) + (point))) + lines)))) + (if lines + (bbdb-record-putprop rec 'nic-notes + (mapconcat 'identity + (nreverse lines) + "\n"))) + + ;; Snarf the last-update date. + (if (re-search-forward "Record last updated on \\(\\S *\\)\\." + nil t) + (bbdb-record-putprop rec 'nic-updated + (buffer-substring (match-beginning 1) + (match-end 1)))) + + (save-excursion + (set-buffer bbdb-buffer-name) + (bbdb-redisplay-one-record rec))) + (message "No whois information for %s" bbdb-whois-name))) + (delete-process proc) + (kill-buffer (current-buffer))))) + +(defun bbdb-find-phone (string record) + "Return the vector entry if STRING is a phone number listed in RECORD." + (let ((phone nil) + (done nil)) + (while (and record (not done)) + (setq phone (car record)) + (if (string= string (bbdb-phone-string phone)) + (setq done phone)) + (setq record (cdr record))) + done)) + +(provide 'bbdb-whois) diff --git a/lisp/bbdb-xemacs.el b/lisp/bbdb-xemacs.el new file mode 100644 index 0000000..d828201 --- /dev/null +++ b/lisp/bbdb-xemacs.el @@ -0,0 +1,114 @@ +;;; -*- Mode:Emacs-Lisp -*- +;;; This file contains some XEmacs-specific stuff for BBDB. + +;;; This file is the part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1992, 1993, 1994 Jamie Zawinski <jwz@netscape.com>. + +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; This code is kind of kludgey, mostly because it needs to parse the contents +;;; of the *BBDB* buffer, since BBDB doesn't save the buffer-positions of the +;;; various fields when it fills in that buffer (doing that would be slow and +;;; cons a lot, so it doesn't seem to be worth it.) + +(eval-and-compile + (if (not (featurep 'xemacs)) + (error "This file only works in XEmacs."))) + +;; this makes no sense, long-term, but. +(eval-when-compile + (or (featurep 'xemacs) + (fset 'load-sound-file 'ignore))) + +(require 'bbdb) +(require 'bbdb-com) +(require 'bbdb-gui) ;; load in the menu/font stuff + +;; Utility functions that mask others to provide XEmacs-specific functionality +;;;###autoload +(defun bbdb-xemacs-display-completion-list (list &optional callback data) + "Wrapper for `display-completion-list'. +Allows callbacks on XEmacs `display-completion-list' is called with +`:activate-callback CALLBACK' if CALLBACK is non-nil. +`:user-data DATA' is also used if DATA is non-nil. +Neither are used if CALLBACK is nil." + (cond ((and callback data) + (display-completion-list list + :activate-callback callback + :user-data data)) + (callback + (display-completion-list list + :activate-callback callback)) + (t + (display-completion-list list)))) + + +;; For native Xemacs sound support we can use these ... +;;;###autoload +(defcustom bbdb-sounds-directory (expand-file-name "~/.xemacs/etc/sounds") + "The directory to load the touchtone sound files from, or nil if none." + :group 'bbdb-phone-dialing + :type 'directory) + +;;;###autoload +(defcustom bbdb-sound-volume 50 + "Volume for playing sounds." + :group 'bbdb-phone-dialing + :type 'integer) + +;;;###autoload +(defun bbdb-load-touchtones () + "Load the touchtone sounds into `sound-alist'. +The directory specified in `bbdb-sounds-directory' is searched for the files +touchtone.*\\.\\(wav\\|au\\) as named in `bbdb-sound-files'. +They are stored in `sound-alist' as touchtone0 to touchtone11." + (interactive) + (let (files + (nr 0)) + (condition-case nil + (setq files + (directory-files bbdb-sounds-directory t + (if (and system-type + (string-match + "windows" + (format "%s" system-type))) + "touchtone.*\\.wav" + "touchtone.*\\.au"))) + (error + ;; It is not a fatal error if we can't find the touchtones; it + ;; just prevents a particular, possibly little-used feature + ;; from working. + (bbdb-warn "Cannot find any touchtone sounds") + (setq files nil))) + + (if (not files) + (progn + (message "No touchtone files found in `bbdb-sound-directory'!") + (sit-for 2)) + ;; otherwise, load 'em up. + (while files + (load-sound-file (car files) + (intern (concat "touchtone" (format "%d" nr))) + bbdb-sound-volume) + (setq files (cdr files) + nr (1+ nr)))))) + +(if (and bbdb-sounds-directory + (file-directory-p bbdb-sounds-directory) + (boundp 'xemacsp) + (featurep 'native-sound)) + (bbdb-load-touchtones)) + +(provide 'bbdb-xemacs) diff --git a/lisp/bbdb.el b/lisp/bbdb.el new file mode 100644 index 0000000..4b91509 --- /dev/null +++ b/lisp/bbdb.el @@ -0,0 +1,3873 @@ +;;; -*- Mode:Emacs-Lisp -*- +;;; This file is the core of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991, 1992, 1993, 1994 Jamie Zawinski <jwz@netscape.com>. +;;; See the file bbdb.texinfo for documentation. +;;; +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; +;;; ------------------------------------------------------------------------ +;;; | There is a mailing list for discussion of BBDB: | +;;; | bbdb-info@lists.sourceforge.net | +;;; | To join, send mail to bbdb-info-request@lists.sourceforge.net | +;;; | (don't forget the "-request" part or you'll look silly in front of | +;;; | lots of people who have the ability to remember it indefinitely...) | +;;; | | +;;; | There is also a second mailing list, to which only bug fixes and | +;;; | new version announcements are sent; to be added to it, send mail to | +;;; | bbdb-announce-request@lists.sourceforge.net. This is a very low | +;;; | volume list, and if you're using BBDB, you really should be on it. | +;;; | | +;;; | When joining these lists or reporting bugs, please mention which | +;;; | version you have. The preferred method of reporting bugs is to use | +;;; | bbdb-submit-bug-report, which will include all useful version | +;;; | information plus state information about how you have BBDB set up. | +;;; ------------------------------------------------------------------------ + +(require 'timezone) +(eval-when-compile (require 'cl)) + +(eval-when-compile ; pacify the compiler. + (autoload 'widget-group-match "wid-edit") + (autoload 'Electric-pop-up-window "electric") + (autoload 'Electric-command-loop "electric") + (autoload 'bbdb-migration-query "bbdb-migrate") + (autoload 'bbdb-migrate "bbdb-migrate") + (autoload 'bbdb-migrate-rewrite-all "bbdb-migrate") + (autoload 'bbdb-migrate-update-file-version "bbdb-migrate") + (autoload 'bbdb-unmigrate-record "bbdb-migrate") + (autoload 'bbdb-create-internal "bbdb-com") + (autoload 'bbdb-append-records-p "bbdb-com") + (autoload 'bbdb-redisplay-records "bbdb-com") + (autoload 'y-or-n-p-with-timeout "timer") + (autoload 'mail-position-on-field "sendmail") + (autoload 'bbdb-fontify-buffer "bbdb-gui") + (autoload 'vm-select-folder-buffer "vm-folder") + + ;; can't use autoload for variables... + (defvar bbdb-define-all-aliases-needs-rebuilt) ;; bbdb-com + (defvar message-mode-map) ;; message.el + (defvar mail-mode-map) ;; sendmail.el + (defvar gnus-article-buffer) ;; gnus-art.el + (defvar temp-buffer-setup-hook nil) + (defvar buffer-file-coding-system nil) + (defvar coding-system-for-write nil) + ) + +(defconst bbdb-version "2.36") + + +(defmacro bbdb-eval-when (c &rest body) + "Emit BODY only if C is true." + (if (eval c) + (backquote (progn (\,@ body))))) + +(put 'bbdb-eval-when 'lisp-indent-hook 'defun) + +(defcustom bbdb-gui (if (fboundp 'display-color-p) ; Emacs 21 + (display-color-p) + (not (null window-system))) ; wrong for XEmacs? + "*Non-nil means fontify the *BBDB* buffer." + :group 'bbdb + :type 'boolean) + +;; File format +(defconst bbdb-file-format 6) +(defvar bbdb-file-format-migration nil + "A cons of two elements: the version read, and the version to write. +nil if the database was read in and is to be written in the current +version.") + +(defvar bbdb-no-duplicates-p nil + "Should BBDB allow entries with duplicate names. +This may lead to confusion when doing completion. If non-nil, it will +prompt the users on how to merge records when duplicates are detected.") + +;; Definitions for things that aren't in all Emacsen and that I really +;; would prefer not to live without. +(eval-and-compile + (if (fboundp 'unless) nil + (defmacro unless (bool &rest forms) `(if ,bool nil ,@forms)) + (defmacro when (bool &rest forms) `(if ,bool (progn ,@forms)))) + (unless (fboundp 'save-current-buffer) + (defalias 'save-current-buffer 'save-excursion)) + (if (fboundp 'mapc) + (defalias 'bbdb-mapc 'mapc) + (defalias 'bbdb-mapc 'mapcar)) + ) + +(unless (fboundp 'with-current-buffer) + (defmacro with-current-buffer (buf &rest body) + `(save-current-buffer (set-buffer ,buf) ,@body))) + +(unless (fboundp 'defvaralias) + (defun defvaralias (&rest args))) + +(defmacro string> (a b) (list 'not (list 'or (list 'string= a b) + (list 'string< a b)))) + +(eval-and-compile + (or (fboundp 'set-keymap-prompt) + (fset 'set-keymap-prompt 'ignore))) + +(eval-and-compile + (if (fboundp 'replace-in-string) + (defalias 'bbdb-replace-in-string 'replace-in-string) + (if (fboundp 'replace-regexp-in-string) ; defined in e21 + (defalias 'bbdb-replace-regexp-in-string 'replace-regexp-in-string) + ;; actually this is `dired-replace-in-string' slightly modified + ;; We're not defining the whole thing, just enough for our purposes. + (defun bbdb-replace-regexp-in-string (regexp newtext string &optional + fixedcase literal) + ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result. + ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. + (let ((result "") (start 0) mb me) + (while (string-match regexp string start) + (setq mb (match-beginning 0) + me (match-end 0) + result (concat result (substring string start mb) newtext) + start me)) + (concat result (substring string start))))) + (defun bbdb-replace-in-string (string regexp newtext &optional literal) + (bbdb-replace-regexp-in-string regexp newtext string nil literal)))) + +(defun bbdb-prin1-to-string (object &optional noescape) + (let ((print-length nil) + (print-level nil)) + (prin1-to-string object noescape))) + +(defun bbdb-prin1 (object &optional stream) + (let ((print-length nil) + (print-level nil)) + (prin1 object stream))) + +;; this should really be in bbdb-com +;;;###autoload +(defun bbdb-submit-bug-report () + "Submit a bug report, with pertinent information to the BBDB info list." + (interactive) + (require 'reporter) + (delete-other-windows) + (reporter-submit-bug-report + "bbdb-info@lists.sourceforge.net" + (concat "BBDB " bbdb-version) + (append + ;; non user variables + '(emacs-version + bbdb-file-format + bbdb-no-duplicates-p) + ;; user variables + (sort (apropos-internal "^bbdb" + 'user-variable-p) + (lambda (v1 v2) (string-lessp (format "%s" v1) (format "%s" v2)))) + ;; see what the user had loaded + (list 'features) + ) + nil + nil + "Please change the Subject header to a concise bug description.\nIn this report, remember to cover the basics, that is, what you expected to\nhappen and what in fact did happen. Please remove these\ninstructions from your message.") + + ;; insert the backtrace buffer content if present + (let ((backtrace (get-buffer-create "*Backtrace*"))) + (when backtrace + (goto-char (point-max)) + (insert "\n\n") + (insert-buffer-substring backtrace))) + + (goto-char (point-min)) + (mail-position-on-field "Subject")) + +;; Make custom stuff work even without customize +;; Courtesy of Hrvoje Niksic <hniksic@srce.hr> +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (unless (and (featurep 'custom) (fboundp 'custom-declare-variable)) + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + `(defvar ,var ,value ,doc)) + (defmacro defface (var value doc &rest args) + `(make-face ,var)) + (defmacro define-widget (&rest args) + nil))) + +(defconst bbdb-have-re-char-classes (string-match "[[:alpha:]]" "x") + "Non-nil if this Emacs supports regexp character classes. +E.g. `[[:alnum:]]'.") + +;; Custom groups + +(defgroup bbdb nil + "The Insidious Big Brother Database." + :group 'news + :group 'mail) + +(put 'bbdb 'custom-loads '("bbdb-hooks" "bbdb-com")) + +(defgroup bbdb-hooks nil + "Hooks run at various times by the BBDB" + :group 'bbdb) + +(defgroup bbdb-record-display nil + "Variables that affect the display of BBDB records" + :group 'bbdb) + +(defgroup bbdb-record-creation nil + "Variables that affect the creation of BBDB records" + :group 'bbdb) + +(defgroup bbdb-noticing-records nil + "Variables that affect the noticing of new authors" + :group 'bbdb-record-creation) +(put 'bbdb-noticing-records 'custom-loads '("bbdb-hooks")) + +(defgroup bbdb-record-use nil + "Variables that affect the use of BBDB records" + :group 'bbdb) + +(defgroup bbdb-database nil + "Variables that affect the database as a whole" + :group 'bbdb) + +(defgroup bbdb-saving nil + "Variables that affect saving of the BBDB" + :group 'bbdb-database) + +(defgroup bbdb-mua-specific nil + "MUA-specific customizations" + :group 'bbdb) + +(defgroup bbdb-mua-specific-gnus nil + "Gnus-specific BBDB customizations" + :group 'bbdb-mua-specific) + +(put 'bbdb-mua-specific-gnus 'custom-loads '("bbdb-gnus")) + +(defgroup bbdb-mua-specific-gnus-scoring nil + "Gnus-specific scoring BBDB customizations" + :group 'bbdb-mua-specific-gnus) + +(put 'bbdb-mua-specific-gnus-scoring 'custom-loads '("bbdb-gnus")) + +(defgroup bbdb-mua-specific-gnus-splitting nil + "Gnus-specific splitting BBDB customizations" + :group 'bbdb-mua-specific-gnus) + +(put 'bbdb-mua-specific-gnus-splitting 'custom-loads '("bbdb-gnus")) + +(defgroup bbdb-mua-specific-vm nil + "VM-specific BBDB customizations" + :group 'bbdb-mua-specific) + +(put 'bbdb-mua-specific-vm 'custom-loads '("bbdb-vm")) + +(defgroup bbdb-phone-dialing nil + "Customizations for phone number dialing" + :group 'bbdb) +(put 'bbdb-phone-dialing 'custom-loads '("bbdb-com")) + +(defgroup bbdb-utilities nil + "Customize BBDB Utilities" + :group 'bbdb) + +(defgroup bbdb-utilities-finger nil + "Customizations for fingering from within the BBDB" + :group 'bbdb-utilities + :prefix "bbdb-finger") +(put 'bbdb-utilities-finger 'custom-loads '("bbdb-com")) + +(defgroup bbdb-utilities-ftp nil + "Customizations for using FTP sites stored in BBDB records." + :group 'bbdb-utilities) +(put 'bbdb-utilities-ftp 'custom-loads '("bbdb-ftp")) + +(defgroup bbdb-utilities-print nil + "Customizations for printing the BBDB." + :group 'bbdb-utilities + :prefix "bbdb-print") +(put 'bbdb-utilities-print 'custom-loads '("bbdb-print")) + +(defgroup bbdb-utilities-supercite nil + "Customizations for using Supercite with the BBDB." + :group 'bbdb-utilities + :prefix "bbdb/sc") +(if (or (featurep 'supercite) + (locate-library "supercite")) + (put 'bbdb-utilities-supercite 'custom-loads '("bbdb-sc"))) + +(defgroup bbdb-utilities-server nil + "Customizations for interfacing with the BBDB from external programs." + :group 'bbdb-utilities + :prefix "bbdb/srv") +(if (and (or (featurep 'gnuserv) (locate-library "gnuserv")) + (or (featurep 'itimer) (locate-library "itimer"))) + (put 'bbdb-utilities-server 'custom-loads '("bbdb-srv"))) + +;; BBDB custom widgets + +(define-widget 'bbdb-alist-with-header 'group + "My group" + :match 'bbdb-alist-with-header-match + :value-to-internal (lambda (widget value) + (if value (list (car value) (cdr value)))) + :value-to-external (lambda (widget value) + (if value (append (list (car value)) (cadr value))))) + +(defun bbdb-alist-with-header-match (widget value) + (widget-group-match widget + (widget-apply widget :value-to-internal value))) + +;; Customizable variables + +(defcustom bbdb-file "~/.bbdb" + "*The name of the Insidious Big Brother Database file." + :group 'bbdb-database + :type 'file) + +;; this should be removed, and the following put in place: +;; a hierarchical structure of bbdb files, some perhaps read-only, +;; perhaps caching in the local bbdb. This way you could have, e.g. a +;; company address book, with each person having access to it, and +;; then a local address book with personal stuff in it. +(defcustom bbdb-file-remote nil + "*The remote file to save the database to. +When this is non-nil, it should be a file name. +When BBDB reads `bbdb-file', it checks this file, + and if it is newer, downloads it. +When BBDB writes `bbdb-file', it also writes this file. + +This feature allows one to keep the database in one place while using +different computers, thus reducing the need for merging different files." + :group 'bbdb-database + :type '(choice (const :tag "none" nil) + (file :tag "remote file name"))) + +(defcustom bbdb-file-remote-save-always t + "*Should the `bbdb-file-remote' file be saved whenever the database is saved? +When nil, you will be asked." + :group 'bbdb-database + :type 'boolean) + +(defun bbdb-primep (num) + "Return t if NUM is a prime number." + (if (fboundp 'primep) + (primep num) + (and (numberp num) (> num 1) (= num (floor num)) + (let ((lim (sqrt num)) (nu 2) (prime t)) + (while (and prime (<= nu lim)) + (setq prime (/= 0 (mod num nu)) + nu (1+ nu))) + prime)))) + +(defcustom bbdb-hashtable-size 1021 + "*The size of the bbdb hashtable. +BBDB hashtable is an obarray, so this must be a prime integer. +Set this to a prime number (much) larger than the size of your database +before loading it. +If you change this variable outside `customize', +you should reload `bbdb-file'." + :group 'bbdb-database + :type 'integer + :set (lambda (symb val) + (unless (bbdb-primep val) + (error "`%s' must be prime, not %s" symb val)) + (set symb val) + (when (fboundp 'bbdb-records) + (bbdb-records)) + val)) + +(defcustom bbdb-default-area-code nil + "*The default area code to use when prompting for a new phone number. +This variable also affects dialing." + :group 'bbdb-record-creation + :type '(choice (const :tag "none" nil) + (integer :tag "Default Area Code")) + :set (lambda( symb val ) + (if (or (and (stringp val) + (string-match "^[0-9]+$" val)) + (integerp val) + (null val)) + (set symb val) + (error "%s must contain digits only." symb)))) + +(defcustom bbdb-lastname-prefixes + '("von" "Von" "de" "De") + "*List of lastname prefixes recognized in name fields. Used to +enhance dividing name strings into firstname and lastname parts." + :group 'bbdb-record-creation + :type '(repeat string)) + +(defcustom bbdb-default-domain nil + "*The default domain to append when prompting for a new net address. +If the address entered does not contain `[@%!]', `@bbdb-default-domain' +will be appended to it. + +The address will not be altered if bbdb-default-domain remains at its +default value of nil, or if one provides a prefix argument to the +bbdb-insert-new-field command." + :group 'bbdb-record-creation + :type '(choice (const :tag "none" nil) + (string :tag "Domain" :value nil))) + +(defcustom bbdb-north-american-phone-numbers-p t + "*Set this to nil if you want to enter phone numbers that aren't the same +syntax as those in North America (that is, [[1] nnn] nnn nnnn ['x' n*]). +If this is true, then some error checking is done so that you can't enter +incorrect phone numbers, and all phone numbers are pretty-printed the same +way. European phone numbers don't have as strict a syntax, however, so +this is a harder problem for them (on which I am punting). + +You can have both styles of phone number in your database by providing a +prefix argument to the bbdb-insert-new-field command." + :group 'bbdb-record-creation + :type 'boolean) + +(defcustom bbdb-electric-p nil + "*Whether bbdb mode should be `electric' like `electric-buffer-list'." + :group 'bbdb-record-display + :type 'boolean) + +(defcustom bbdb-case-fold-search (default-value 'case-fold-search) + "*This is the value of `case-fold-search' used by `bbdb' and friends. +This variable lets the case-sensitivity of ^S and of the bbdb +commands be different." + :group 'bbdb + :type 'boolean) + +(defcustom bbdb/mail-auto-create-p t + "*If this is t, then MH, RMAIL, and VM will automatically +create new bbdb records for people you receive mail from. If this +is a function name or lambda, then it is called with no arguments +to decide whether an entry should be automatically created. You +can use this to, for example, not create records for messages +which have reached you through a particular mailing list, or to +only create records automatically if the mail has a particular +subject." + :group 'bbdb-noticing-records + :type '(choice (const :tag "Automatically create" t) + (const :tag "Prompt before creating" prompt) + (const :tag "Do not automatically create" nil) + (function :tag "Create with function" bbdb-))) + +(defcustom bbdb/news-auto-create-p nil + "*If this is t, then Gnus will automatically create new bbdb +records for people you receive mail from. If this is a function name +or lambda, then it is called with no arguments to decide whether an +entry should be automatically created. You can use this to, for +example, create or not create messages which have a particular +subject. If you want to autocreate messages based on the current +newsgroup, it's probably a better idea to set this variable to t or +nil from your `gnus-select-group-hook' instead." + :group 'bbdb-noticing-records + :type '(choice (const :tag "Automatically create" t) + (const :tag "Prompt before creating" prompt) + (const :tag "Do not automatically create" nil) + (function :tag "Create with function" bbdb-))) + +(defcustom bbdb-quiet-about-name-mismatches nil + "*If this is true, then BBDB will not prompt you when it notices a +name change, that is, when the \"real name\" in a message doesn't correspond +to a record already in the database with the same network address. As in, +\"John Smith <jqs@frob.com>\" versus \"John Q. Smith <jqs@frob.com>\". +Normally you will be asked if you want to change it. +If set to a number it is the number of seconds to sit for while +displaying the mismatch message. + +If set to a function it will be called with two arguments, the record and the +new name and should return nil, t or a number. + +If none of the others it must be a sexp evaluating to nil, t or a number. + +Any other return value of the function or sexp will be considered as true." + :group 'bbdb-noticing-records + :type '(choice (const :tag "Prompt for name changes" nil) + (const :tag "Do not prompt for name changes" t) + (integer :tag + "Instead of prompting, warn for this many seconds") + (function :tag "User defined function") + (sexp :tag "User defined sexp") + (const :tag "Ignore records which has a 'readonly' field" + (assq 'readonly (bbdb-record-raw-notes record))))) + +(defcustom bbdb-use-alternate-names t + "*If this is true, then when bbdb notices a name change, it will ask you +if you want both names to map to the same record." + :group 'bbdb-noticing-records + :type '(choice (const :tag "Ask to use alternate names field" t) + (const :tag "Use alternate names field without asking" nil))) + +(defcustom bbdb-readonly-p nil + "*If this is true, then nothing will attempt to change the bbdb database +implicitly, and you will be prevented from doing it explicitly. If you have +more than one emacs running at the same time, you might want to arrange for +this to be set to t in all but one of them." + :group 'bbdb-database + :type '(choice (const :tag "Database is read-only" t) + (const :tag "Database is writable" nil))) + +(defcustom bbdb-continental-zip-regexp "^\\s *[A-Z][A-Z]?\\s *-\\s *[0-9][0-9][0-9]" + "Regexp matching continental zip codes. +Addresses with zip codes matching the regexp will be formated using +`bbdb-format-address-continental'. The regexp should match zip codes +of the form CH-8052, NL-2300RA, and SE-132 54." + :group 'bbdb-record-display + :type 'regexp) + +(defcustom bbdb-auto-revert-p nil + "*If this variable is true and the BBDB file is noticed to have changed on +disk, it will be automatically reverted without prompting you first. Otherwise +you will be asked. (But if the file has changed and you hae made changes in +memory as well, you will always be asked.)" + :group 'bbdb-saving + :type '(choice (const :tag "Revert unchanged database without prompting" t) + (const :tag "Ask before reverting database"))) + +(defcustom bbdb-notice-auto-save-file nil + "*If this is true, then the BBDB will notice when its auto-save file is +newer than the file is was read from, and will offer to revert." + :group 'bbdb-saving + :type '(choice (const :tag "Check auto-save file" t) + (const :tag "Do not check auto-save file" nil))) + +(defcustom bbdb-use-pop-up 'horizontal + "*If not nil, display a continuously-updating bbdb window while in VM, MH, +RMAIL, Gnus or a composition buffer. + +If 'horizontal, stack the window horizontally and give it the number of lines +specified by `bbdb-pop-up-target-lines'. +If 'vertical, stack the window vertically and give it the number of rows +specified by `bbdb-pop-up-target-columns'." + :group 'bbdb-record-display + :type '(choice (const :tag "Automatic BBDB window, stacked vertically" 'vertical) + (const :tag "Automatic BBDB window, stacked horizontally" 'horizontal) + (const :tag "No Automatic BBDB window" nil))) + +(defcustom bbdb-pop-up-target-lines 5 + "*Desired number of lines in a horizontal BBDB buffer pop-up window. +See `bbdb-use-pop-up' on how to select horizontal splitting." + :group 'bbdb-record-display + :type 'integer) + +(defcustom bbdb-pop-up-target-columns 20 + "*Desired number of lines in a vertical BBDB buffer pop-up window. +See `bbdb-use-pop-up' on how to select vertical splitting." + :group 'bbdb-record-display + :type 'integer) + +(defcustom bbdb-completion-type nil + "*Controls the behaviour of `bbdb-complete-name'. If nil, completion is +done across the set of all full-names and user-ids in the bbdb-database; +if the symbol 'name, completion is done on names only; if the symbol 'net, +completion is done on network addresses only; if it is 'primary, then +completion is done only across the set of primary network addresses (the +first address in the list of addresses for a given user). If it is +'primary-or-name, completion is done across primaries and real names." + :group 'bbdb-record-use + :type '(choice (const :tag "Complete across names and net addresses" nil) + (const :tag "Complete across names" name) + (const :tag "Complete across net addresses" net) + (const :tag "Complete across primary net addresses" primary) + (const :tag "Complete across names and primary net addresses" + primary-or-name))) + +(defcustom bbdb-completion-display-record t + "*Whether `bbdb-complete-name' (\\<mail-mode-map>\\[bbdb-complete-name] +in mail-mode) will update the *BBDB* buffer to display the record whose email +address has just been inserted." + :group 'bbdb-record-use + :type '(choice (const :tag "Update the BBDB buffer" t) + (const :tag "Don't update the BBDB buffer" nil))) + +(defcustom bbdb-user-mail-names nil + "*A regular expression identifying the addresses that belong to you. +If a message from an address matching this is seen, the BBDB record for +the To: line will be shown instead of the one for the From: line. If +this is nil, it will default to the value of (user-login-name)." + :group 'bbdb-noticing-records + :type (list 'choice '(const :tag "Use value of (user-login-name)" nil) + (list 'regexp :tag "Pattern matching your addresses" + (or (user-login-name) "address")))) + +(defcustom bbdb-always-add-addresses 'ask + "*If this is true, then when the Insidious Big Brother Database notices +a new email address for a person, it will automatically add it to the list of +addresses. If it is 'ask, you will be asked whether to add it. If it is nil +then new network addresses will never be automatically added nor the user will +be asked. + +When set to a function name the function should return one of these values. + +See also the variable `bbdb-new-nets-always-primary' for control of whether +the addresses go at the front of the list or the back." + :group 'bbdb-noticing-records + :type '(choice (const :tag "Automatically add new addresses" t) + (const :tag "Ask before adding new addresses" ask) + (const :tag "Never add new addresses" nil) + (const bbdb-ignore-some-messages-hook) + (const bbdb-ignore-most-messages-hook))) + +(defcustom bbdb-new-nets-always-primary nil + "*If this is true, then when the Insidious Big Brother Database adds a new +address to a record, it will always add it to the front of the list of +addresses, making it the primary address. If this is nil, you will be asked. +If it is the symbol 'never (really, if it is any non-t, non-nil value) then +new network addresses will always be added at the end of the list." + :group 'bbdb-noticing-records + :type '(choice (const :tag "New address automatically made primary" t) + (const :tag "Ask before making new address primary" nil) + (const :tag "Never make new address primary" never))) + +(defcustom bbdb-send-mail-style nil + "*Specifies which package should be used to send mail. +Should be 'vm, 'mh, 'mail, 'message, or 'gnus (or nil, meaning guess.)" + :group 'bbdb-record-use + :type '(choice (const :tag "Use VM to send mail" vm) + (const :tag "Use MH-E to send mail" mh) + (const :tag "Use send-mail mode to send mail" mail) + (const :tag "Use Message to send mail" message) + (const :tag "Use Mew to send mail" mew) + (const :tag "Use compose-mail to send mail" compose-mail) + (const :tag "Use gnus to send mail" gnus) + (const :tag "Guess which package to use" nil))) + +(defcustom bbdb-offer-save t + "*If t, then certain actions will cause the BBDB to ask you whether +you wish to save the database. If nil, then the offer to save will never +be made. If not t and not nil, then any time it would ask you, it will +just save it without asking." + :group 'bbdb-saving + :type '(choice (const :tag "Offer to save the database" t) + (const :tag "Never offer to save the database" nil) + (const :tag "Save database without asking" savenoprompt))) + +(defcustom bbdb-message-caching-enabled t + "*Whether caching of the message->bbdb-record association should be used +for the interfaces which support it (VM, MH, and RMAIL). This can speed +things up a lot. One implication of this variable being true is that the +`bbdb-notice-hook' will not be called each time a message is selected, but +only the first time. Likewise, if selecting a message would generate a +question (whether to add an address, change the name, etc) you will only +be asked that question the very first time the message is selected." + :group 'bbdb + :type '(choice (const :tag "Enable caching" t) + (const :tag "Disable caching" nil))) + +(defcustom bbdb-silent-running nil + "*If this is true, bbdb will suppress all its informational messages and +queries. Be very very certain you want to set this, because it will suppress +prompting to alter record names, assign names to addresses, etc." + :group 'bbdb + :type '(choice (const :tag "Run silently" t) + (const :tag "Disable silent running" nil))) + +(defcustom bbdb-mode-hook nil + "*Hook or hooks invoked when the *BBDB* buffer is created." + :group 'bbdb-hooks + :type 'hook) + +(defcustom bbdb-list-hook nil + "*Hook or hooks invoked after the `bbdb-list-buffer' is filled in. +Invoked with no arguments." + :group 'bbdb-hooks + :type 'hook) + +(defcustom bbdb-create-hook 'bbdb-creation-date-hook + "*Hook or hooks invoked each time a new BBDB record is created. Invoked +with one argument, the new record. This is called *before* the record is +added to the database. Note that `bbdb-change-hook' will be called as well. + +Hook functions can use the variable `bbdb-update-address-class' to determine +the class of an email address according to `bbdb-get-addresses-headers' and +the variable `bbdb-update-address-header' is set to the header the email +address was extracted from." + :group 'bbdb-hooks + :type 'hook) + +(defcustom bbdb-change-hook 'bbdb-timestamp-hook + "*Hook or hooks invoked each time a BBDB record is altered. Invoked with +one argument, the record. This is called *before* the bbdb-database buffer +is modified. Note that if a new bbdb record is created, both this hook and +`bbdb-create-hook' will be called." + :group 'bbdb-hooks + :type 'hook) + +(defcustom bbdb-after-change-hook nil + "*Hook or hooks invoked each time a BBDB record is altered. Invoked with +one argument, the record. This is called *after* the bbdb-database buffer +is modified, so if you want to modify the record each time it is changed, +you should use the `bbdb-change-hook' instead. Note that if a new bbdb +record is created, both this hook and `bbdb-create-hook' will be called." + :group 'bbdb-hooks + :type 'hook) + +(defcustom bbdb-canonicalize-net-hook nil + "*If this is non-nil, it should be a function of one arg: a network address +string. Whenever the Insidious Big Brother Database \"notices\" a message, +the corresponding network address will be passed to this function first, as +a kind of \"filter\" to do whatever transformations upon it you like before +it is compared against or added to the database. For example: it is the case +that CS.CMU.EDU is a valid return address for all mail originating at a +machine in the .CS.CMU.EDU domain. So, if you wanted all such addresses to +be canonically hashed as user@CS.CMU.EDU, instead of as user@host.CS.CMU.EDU, +you might set this variable to a function like this: + + (setq bbdb-canonicalize-net-hook + '(lambda (addr) + (cond ((string-match \"\\\\`\\\\([^@]+@\\\\).*\\\\.\\\\(CS\\\\.CMU\\\\.EDU\\\\)\\\\'\" + addr) + (concat (substring addr (match-beginning 1) (match-end 1)) + (substring addr (match-beginning 2) (match-end 2)))) + (t addr)))) + +You could also use this function to rewrite UUCP-style addresses into domain- +style addresses, or any number of things. + +This function will be called repeatedly until it returns a value EQ to the +value passed in. So multiple rewrite rules might apply to a single address." + :group 'bbdb-hooks + :type 'function) + +(defcustom bbdb-canonicalize-redundant-nets-p t + "*If this is non-nil, redundant network addresses will be ignored. +If a record has an address of the form foo@baz.com, setting this to t +will cause subsequently-noticed addresses like foo@bar.baz.com to be +ignored (since we already have a more general form of that address.) +This is similar in function to one of the possible uses of the variable +`bbdb-canonicalize-net-hook' but is somewhat more automatic. (This +can't quite be implemented in terms of the canonicalize-net-hook because +it needs access to the database to determine whether an address is +redundant, and the canonicalize-net-hook is purely a textual manipulation +which is performed before any database access.)" + :group 'bbdb-noticing-records + :type '(choice (const :tag "Ignore redundant addresses" t) + (const :tag "Don't ignore redundant addresses" nil))) + +(defcustom bbdb-notice-hook nil + "*Hook or hooks invoked each time a BBDB record is \"noticed\", that is, +each time it is displayed by the news or mail interfaces. Invoked with +one argument, the new record. The record need not have been modified for +this to be called - use `bbdb-change-hook' for that. You can use this to, +for example, add something to the notes field based on the subject of the +current message. It is up to your hook to determine whether it is running +in Gnus, VM, MH, or RMAIL, and to act appropriately. + +Also note that `bbdb-change-hook' will NOT be called as a result of any +modifications you may make to the record inside this hook. + +Hook functions can use the variable `bbdb-update-address-class' to determine +the class of an email address according to `bbdb-get-addresses-headers' and +the variable `bbdb-update-address-header' is set to the header the email +address was extracted from. + +Beware that if the variable `bbdb-message-caching-enabled' is true (a good +idea) then when you are using VM, MH, or RMAIL, this hook will be called only +the first time that message is selected. (The Gnus interface does not use +caching.) When debugging the value of this hook, it is a good idea to set +caching-enabled to nil." + :group 'bbdb-hooks + :type 'hook) + +(defcustom bbdb-after-read-db-hook nil + "*Hook or hooks invoked (with no arguments) just after the Insidious Big +Brother Database is read in. Note that this can be called more than once if +the BBDB is reverted." + :group 'bbdb-hooks + :type 'hook) + +(defcustom bbdb-load-hook nil + "*Hook or hooks invoked when the BBDB code is first loaded. + +WARNING: This hook will be run the first time you traverse the Custom menus + for the BBDB. As a result, nothing slow should be added to + this hook." + :group 'bbdb-hooks + :type 'hook) + +(defcustom bbdb-initialize-hook nil + "*Hook or hooks invoked (with no arguments) when the Insidious Big Brother +Database initialization function `bbdb-initialize' is run." + :group 'bbdb-hooks + :type 'hook) + +;;;###autoload +(defcustom bbdb-multiple-buffers nil + "When non-nil we create a new buffer of every buffer causing pop-ups. +You can also set this to a function returning a buffer name." + :group 'bbdb-record-display + :type '(choice (const :tag "Disabled" nil) + (function :tag "Enabled" bbdb-multiple-buffers-default) + (function :tag "User defined function"))) + +(defvar bbdb-mode-map nil + "Keymap for Insidious Big Brother Database listings.") +(defvar bbdb-mode-search-map nil + "Keymap for Insidious Big Brother Database searching") + +;; iso-2022-7bit should be OK (but not optimal for Emacs, at least -- +;; emacs-mule would be better) with both Emacs 21 and XEmacs. +(defcustom bbdb-file-coding-system + (bbdb-eval-when (fboundp 'coding-system-p) + (cond ((apply 'coding-system-p '(utf-8-emacs)) + 'utf-8-emacs) + (t 'iso-8859-1))) + "Coding system used for reading and writing `bbdb-file'. +This should not be changed by users. +This should not be changed in between BBDB sessions, i.e. before loading the +BBDB which was stored in a different coding system. Make a backup of your +BBDB before changing this variable!" + :group 'bbdb + :type '(choice (const iso-8859-1) + (const utf-8-emacs) + (const iso-2022-7bit))) + +(defvar bbdb-suppress-changed-records-recording nil + "Whether to record changed records in variable `bbdb-changed-records'. + +If this is false, the BBDB will cease to remember which records are changed +as the change happens. It will still remember that records have been changed, +so the file will still be saved, but the changed records list, and the `!!' +in the *BBDB* buffer modeline that it depends on, will no longer be updated. + +You should bind this variable, not set it; the `!!' is a useful user- +interface feature, and should only be suppressed when changes need to be +automatically made to BBDB records which the user will not care directly +about.") + + +;;; These are the buffer-local variables we use. +;;; They are mentioned here so that the compiler doesn't warn about them +;;; when byte-compile-warn-about-free-variables is on. + +(defvar bbdb-records nil) +(defvar bbdb-changed-records nil) +(defvar bbdb-end-marker nil) +(defvar bbdb-hashtable nil) +(defvar bbdb-propnames nil) +(defvar bbdb-message-cache nil) +(defvar bbdb-showing-changed-ones nil) +(defvar bbdb-modified-p nil) +(defvar bbdb-address-print-formatting-alist) ; "bbdb-print" + +(defvar bbdb-debug t) +(defmacro bbdb-debug (&rest body) + ;; ## comment out the next line to turn off debugging. + ;; ## You really shouldn't do this! But it will speed things up. + (list 'and 'bbdb-debug (list 'let '((debug-on-error t)) (cons 'progn body))) + ) + + +;;; internal kludge to force queries to always happen with the mouse rather +;;; than basing the decision on the last-input-event; bind this, don't set it. +(defvar bbdb-force-dialog-boxes nil) + +(defun bbdb-y-or-n-p (prompt) + (prog1 + (funcall + (cond ((and bbdb-force-dialog-boxes + (fboundp 'yes-or-no-p-dialog-box)) + (when (and (fboundp 'raise-frame) + (not (frame-visible-p (selected-frame)))) + (raise-frame (selected-frame))) + 'yes-or-no-p-dialog-box) + (t 'y-or-n-p)) + prompt) + (message " "))) + +(defun bbdb-yes-or-no-p (prompt) + (prog1 + (funcall (if (and bbdb-force-dialog-boxes + (fboundp 'yes-or-no-p-dialog-box)) + 'yes-or-no-p-dialog-box + 'yes-or-no-p) + prompt) + (message " "))) + +(defun bbdb-invoke-hook (hook arg) + "Like `invoke-hooks', but invokes the given hook with one argument." + (if (and (boundp hook) (setq hook (symbol-value hook))) + (if (and (consp hook) (not (eq (car hook) 'lambda))) + (while hook + (funcall (car hook) arg) + (setq hook (cdr hook))) + (funcall hook arg)))) + +(defun bbdb-invoke-hook-for-value (hook &rest args) + "If HOOK is a function, invoke it with ARGS. Otherwise return it as-is." + (cond ((eq hook nil) nil) + ((eq hook t) t) + ((functionp hook) (apply hook args)) + (t hook))) + +(defmacro bbdb-defstruct (conc-name &rest slots) + "Make two functions, one for each slot. The functions are: + CONC-NAME + SLOT and CONC-NAME + `set-' + SLOT +The first one is to be used to read the element named in SLOT, and the +second is used to set it. Also make a constant + CONC-NAME + `length' +that holds the number of slots." + (setq conc-name (symbol-name conc-name)) + (let ((body '()) + (i 0) + (L (length slots))) + (while slots + (setq body + (nconc body + (let ((readname (intern (concat conc-name (symbol-name (car slots))))) + (setname (intern (concat conc-name "set-" (symbol-name (car slots)))))) + (list + (list 'defmacro readname '(vector) + (list 'list ''aref 'vector i)) + (list 'defmacro setname '(vector value) + (if (string= setname "bbdb-record-set-net") + (list 'setq + 'bbdb-define-all-aliases-needs-rebuilt t)) + (list 'list ''aset 'vector i 'value)) + ;(list 'put (list 'quote readname) ''edebug-form-hook ''(form)) + ;(list 'put (list 'quote setname) ''edebug-form-hook ''(form form)) + )))) + (setq slots (cdr slots) i (1+ i))) + (setq body (nconc body (list (list 'defconst + (intern (concat conc-name "length")) + L)))) + (cons 'progn body))) + +;;; When reading this code, beware that "cache" refers to two things. +;;; It refers to the cache slot of bbdb-record structures, which is +;;; used for computed properties of the records; and it also refers +;;; to a message-id --> bbdb-record association list which speeds up +;;; the RMAIL, VM, and MH interfaces. + +;; Build reading and setting functions for firstname, lastname, aka, +;; company, phones, addresses, net, raw-notes, and cache. These are +;; for accessing the high-level forms for the record. +(bbdb-defstruct bbdb-record- + firstname lastname aka company + phones addresses net raw-notes + cache + ) + +;; HACKHACK +;;(defmacro bbdb-record-set-net (vector value) +;; "We redefine the set-binding for 'net to detect changes" +;; (list 'progn +;; (list 'aset vector 6 value) +;; (list 'setq 'bbdb-define-all-aliases-needs-rebuilt t))) + +(put 'company 'field-separator "; ") +(put 'notes 'field-separator "\n") + +;; Build reading and setting functions for location, area, exchange, +;; suffix, and extension. These are for accessing the elements of the +;; individual phone number forms. +(bbdb-defstruct bbdb-phone- + location area exchange suffix extension + ) + +;; Build reading and setting functions for location, street, city, +;; state, zip and country. These are for accessing the elements of +;; the individual address forms. +(bbdb-defstruct bbdb-address- + location streets city state zip country + ) + +;; Build reading and setting functions for namecache (the full name of +;; the person referred to by the record), sortkey (the concatenation +;; of the elements used for sorting the record), marker, and +;; deleted-p. These are for accessing the elements of the cache form, +;; and are generally concatenations of data existing in separate parts +;; of the record, stored here prebuilt for speed. +(bbdb-defstruct bbdb-cache- + namecache sortkey marker deleted-p + ) + +;; Build the namecache for a record +(defsubst bbdb-record-name-1 (record) + (bbdb-cache-set-namecache (bbdb-record-cache record) + (let ((fname (bbdb-record-firstname record)) + (lname (bbdb-record-lastname record))) + (if (> (length fname) 0) + (if (> (length lname) 0) + (concat fname " " lname) + fname) + lname)))) + +;; Return the full name from a record. If the name is not available +;; in the namecache, the namecache value is generated (and stored). +(defun bbdb-record-name (record) + (or (bbdb-cache-namecache (bbdb-record-cache record)) + (bbdb-record-name-1 record))) + +(defun bbdb-record-lfname (record) + (let ((fname (bbdb-record-firstname record)) + (lname (bbdb-record-lastname record))) + (if (and (> (length fname) 0) (> (length lname) 0)) + (concat lname " " fname) + nil))) + +;; Return the sortkey for a record, building (and storing) it if +;; necessary. +(defun bbdb-record-sortkey (record) + (or (bbdb-cache-sortkey (bbdb-record-cache record)) + (bbdb-cache-set-sortkey (bbdb-record-cache record) + (downcase + (concat (bbdb-record-lastname record) + (bbdb-record-firstname record) + (bbdb-record-company record)))))) + +(defmacro bbdb-record-marker (record) + (list 'bbdb-cache-marker (list 'bbdb-record-cache record))) + +(defmacro bbdb-record-deleted-p (record) + (list 'bbdb-cache-deleted-p (list 'bbdb-record-cache record))) + +(defmacro bbdb-record-set-deleted-p (record val) + (list 'bbdb-cache-set-deleted-p (list 'bbdb-record-cache record) val)) + +(defmacro bbdb-record-set-namecache (record newval) + (list 'bbdb-cache-set-namecache (list 'bbdb-record-cache record) newval)) + +(defmacro bbdb-record-set-sortkey (record newval) + (list 'bbdb-cache-set-sortkey (list 'bbdb-record-cache record) newval)) + +(defmacro bbdb-record-set-marker (record newval) + (list 'bbdb-cache-set-marker (list 'bbdb-record-cache record) newval)) + + +;; The "notes" and "properties" accessors don't need to be fast. + +(defun bbdb-record-notes (record) + (if (consp (bbdb-record-raw-notes record)) + (cdr (assq 'notes (bbdb-record-raw-notes record))) + (bbdb-record-raw-notes record))) + +;; this works on the 'company field as well. +(defun bbdb-record-getprop (record property) + (if (memq property '(name address addresses phone phones net aka AKA)) + (error "bbdb: cannot access the %s field this way" property)) + (if (eq property 'company) + (bbdb-record-company record) + (if (consp (bbdb-record-raw-notes record)) + (cdr (assq property (bbdb-record-raw-notes record))) + (if (and (eq property 'notes) + (stringp (bbdb-record-raw-notes record))) + (bbdb-record-raw-notes record) + nil)))) + +(defun bbdb-get-field (rec field &optional nn) + "Get the N-th element (or all if nil) of the notes FIELD of the REC. +If the note is absent, returns a zero length string." + (let ((note (or (bbdb-record-getprop rec field) ""))) + (if nn + (nth nn (split-string note " ,;\t\n\f\r\v")) + note))) + +;; this works on the 'company field as well. +(defun bbdb-record-putprop (record property newval) + (if (memq property '(name address addresses phone phones net aka AKA)) + (error "bbdb: cannot annotate the %s field this way" property)) + (if (eq property 'company) + (bbdb-record-set-company record + (bbdb-record-set-company record newval)) + (if (and (eq property 'notes) + (not (consp (bbdb-record-raw-notes record)))) + (bbdb-record-set-raw-notes record newval) + (or (listp (bbdb-record-raw-notes record)) + (bbdb-record-set-raw-notes record + (list (cons 'notes (bbdb-record-raw-notes record))))) + (let ((old (assq property (bbdb-record-raw-notes record)))) + (if old + (if newval + (setcdr old newval) + (bbdb-record-set-raw-notes record + (delq old (bbdb-record-raw-notes record)))) + (and newval + (bbdb-record-set-raw-notes record + (append (bbdb-record-raw-notes record) + (list (cons property newval)))))))) + ;; save some file space: if we ever end up with ((notes . "...")), + ;; replace it with the string. + (if (and (consp (bbdb-record-raw-notes record)) + (null (cdr (bbdb-record-raw-notes record))) + (eq 'notes (car (car (bbdb-record-raw-notes record))))) + (bbdb-record-set-raw-notes record + (cdr (car (bbdb-record-raw-notes record))))) + ) + ;; If we're changing the company, then we need to sort, since the company + ;; is the sortkey for nameless records. This should almost never matter... + (bbdb-change-record record (eq property 'company)) + newval) + +(defun bbdb-record-set-notes (record newval) + (if (consp (bbdb-record-raw-notes record)) + (bbdb-record-putprop record 'notes newval) + (bbdb-record-set-raw-notes record newval) + (bbdb-change-record record nil))) + +(defun bbdb-phone-string (phone) + (if (= 2 (length phone)) ; euronumbers.... + (aref phone 1) + ;; numbers should come in two forms: + ;; ["where" 415 555 1212 99] or ["where" "the number"] + (if (stringp (aref phone 1)) + (error "doubleplus ungood: euronumbers unwork")) + (concat (if (/= 0 (bbdb-phone-area phone)) + (format "(%03d) " (bbdb-phone-area phone)) + "") + (if (/= 0 (bbdb-phone-exchange phone)) + (format "%03d-%04d" + (bbdb-phone-exchange phone) (bbdb-phone-suffix phone)) + "") + (if (and (bbdb-phone-extension phone) + (/= 0 (bbdb-phone-extension phone))) + (format " x%d" (bbdb-phone-extension phone)) + "")))) + +;; Legacy function. Used to convert a zip datastructure string into a +;; formated string. As zip codes are plain strings now, use +;; `bbdb-address-zip' instead. +(defalias 'bbdb-address-zip-string 'bbdb-address-zip) + +(defmacro bbdb-record-lessp (record1 record2) + (list 'string< (list 'bbdb-record-sortkey record1) + (list 'bbdb-record-sortkey record2))) + +(defmacro bbdb-subint (string match-number) + (list 'string-to-number + (list 'substring string + (list 'match-beginning match-number) + (list 'match-end match-number)))) + +(eval-and-compile + (if (fboundp 'display-error) + (fset 'bbdb-display-error 'display-error) + (defun bbdb-display-error(msg stream) + (message "Error: %s" (nth 1 msg))))) + +(defmacro bbdb-error-retry (form) + (list 'catch ''--bbdb-error-retry-- + (list 'while ''t + (list 'condition-case '--c-- + (list 'throw ''--bbdb-error-retry-- form) + '(error + (ding) + (let ((cursor-in-echo-area t)) + (bbdb-display-error --c-- nil) + (sit-for 2))))))) + +;;; Completion on labels and field data + +;;; Realistically speaking, it doesn't make sense to offer minibuffer +;;; completion for some fields - like ones that don't have labels! +;;; +;;; Also, I could probably do this with macros similar to the +;;; def-struct stuff. +(defcustom bbdb-default-label-list + '("Home" "Office" "Mobile" "Other") + "*Default list of labels for Address and Phone fields." + :group 'bbdb-record-creation + :type '(repeat string)) + +(defcustom bbdb-phones-label-list + bbdb-default-label-list + "*List of labels for Phone field. +The default value is `bbdb-default-label-list'." + :group 'bbdb-record-creation + :type '(repeat string)) + +(defcustom bbdb-addresses-label-list + bbdb-default-label-list + "*List of labels for Address field. +The default value is `bbdb-default-label-list'." + :group 'bbdb-record-creation + :type '(repeat string)) + +(defun bbdb-label-completion-list (field) + "Figure out a completion list for the specified FIELD label. +This evaluates the variable bbdb-FIELD-label-list, such +as `bbdb-phones-label-list'." + (if (boundp (intern (format "bbdb-%s-label-list" field))) + (eval (intern (format "bbdb-%s-label-list" field))) + ;; special-case out the ones it doesn't make sense for here? + bbdb-default-label-list)) + +(defun bbdb-label-completion-default (field) + "Figure out a default label from the completion list for FIELD. +This evaluates the variable bbdb-default-FIELD-label, such +as `bbdb-default-phones-label', if it exists, or it takes +the first item from the list of completions for FIELD as +returned by `bbdb-label-completion-list'." + (if (boundp (intern (format "bbdb-default-%s-label" field))) + (eval (intern (format "bbdb-default-%s-label" field))) + (nth 0 (bbdb-label-completion-list field)))) + +;; These are so you can accumulate e.g. mail aliases or company names +;; and have BBDB offer completion on them. +(defun bbdb-data-completion-list (field) + "Figure out a completion list for the specified FIELD value. +This evaluates the variable bbdb-FIELD-data-list, such +as `bbdb-mail-alias-data-list', if it exists, or it uses +`bbdb-default-label-list'." + (if (boundp (intern (format "bbdb-%s-data-list" field))) + (eval (intern (format "bbdb-%s-data-list" field))) + ;; special-case out the ones it doesn't make sense for here? + bbdb-default-label-list)) + +(defun bbdb-data-completion-default (field) + "Figure out a default value from the completion list for FIELD. +This evaluates the variable bbdb-default-FIELD-data, such +as `bbdb-default-mail-alias-data', if it exists, or it takes +the first item from the list of completions for FIELD as +returned by `bbdb-data-completion-list'." + (if (boundp (intern (format "bbdb-default-%s-data" field))) + (eval (intern (format "bbdb-default-%s-data" field))) + (nth 0 (bbdb-label-completion-list field)))) + +;;; +(defvar bbdb-buffer nil) +(defun bbdb-buffer () + (if (and bbdb-buffer (buffer-live-p bbdb-buffer)) + bbdb-buffer + (when (and bbdb-file-remote + (file-newer-than-file-p bbdb-file-remote bbdb-file)) + (let ((coding-system-for-write bbdb-file-coding-system)) + (copy-file bbdb-file-remote bbdb-file t t))) + (setq bbdb-buffer (find-file-noselect bbdb-file 'nowarn)))) + +(defmacro bbdb-with-db-buffer (&rest body) + (cons 'with-current-buffer + (cons '(bbdb-buffer) + (if (and (boundp 'bbdb-debug) bbdb-debug) + ;; if we're debugging, and the .bbdb buffer is visible in + ;; a window, temporarilly switch to that window so that + ;; when we come out, that window has been scrolled to the + ;; record we've just modified. (make w-point = b-point) + (list + (list 'let '((w (and bbdb-debug + (get-buffer-window + (buffer-name + (get-buffer bbdb-file)))))) + (list 'save-excursion + (cons 'save-window-excursion + (cons '(and w (select-window w)) + body))))) + body)))) + +(defsubst bbdb-string-trim (string) + "Lose leading and trailing whitespace. Also remove all properties +from string." + (if (string-match "\\`[ \t\n]+" string) + (setq string (substring string (match-end 0)))) + (if (string-match "[ \t\n]+\\'" string) + (setq string (substring string 0 (match-beginning 0)))) + ;; This is not ideologically blasphemous. It is a bad function to + ;; use on regions of a buffer, but since this is our string, we can + ;; do whatever we want with it. --Colin + (set-text-properties 0 (length string) nil string) + string) + +(defun bbdb-read-string (prompt &optional default completions) + "Reads a string, trimming whitespace and text properties." + (bbdb-string-trim + (if completions + (completing-read prompt completions nil nil (cons default 0)) + (bbdb-string-trim (read-string prompt default))))) + +;;; Address formatting. + +(defcustom bbdb-time-display-format "%d %b %Y" + "The format for the timestamp to be used in the creation-date and +timestamp fields. See the documentation for `format-time-string'." + :group 'bbdb :type 'string) + +(defun bbdb-time-convert (date &optional format) + "Convert a date from the BBDB internal format to the format +determined by FORMAT (or `bbdb-time-display-format' if FORMAT not +present). Returns a string containing the date in the new format." + (let ((parts (bbdb-split date "-"))) + (format-time-string (or format bbdb-time-display-format) + (encode-time 0 0 0 (string-to-number (caddr parts)) + (string-to-number (cadr parts)) + (string-to-number (car parts)))))) + +(defalias 'bbdb-format-record-timestamp 'bbdb-time-convert) +(defalias 'bbdb-format-record-creation-date 'bbdb-time-convert) + +(defconst bbdb-gag-messages nil + "Bind this to t to quiet things down - do not set it!") + +(defvar bbdb-buffer-name "*BBDB*") + +(defcustom bbdb-display-layout-alist + '((one-line (order . (phones mail-alias net notes)) + (name-end . 24) + (toggle . t)) + (multi-line (omit . (creation-date timestamp)) + (toggle . t)) + (pop-up-multi-line) + (full-multi-line)) + "*An alist describing each display layout. +The format of an element is (LAYOUT-NAME OPTION-ALIST). + +By default there are four different layout types used by BBDB, which are +`one-line', `multi-line', `pop-up-multi-line' (used for pop-ups) and +`full-multi-line' (showing all fields of a record). + +OPTION-ALIST specifies the options for the layout. Valid options are: + + ------- Availability -------- + Format one-line multi-line default if unset +------------------------------------------------------------------------------ + (toggle . BOOL) + + nil + (order . FIELD-LIST) + + '(phones ...) + (omit . FIELD-LIST) + + nil + (name-end . INTEGER) + - 40 + (indentation . INTEGER) - + 14 + (primary . BOOL) - + nil + (test . SEXP) + + nil + +- toggle: controls if this layout is included when toggeling the display layout +- order: defines a user specific order for the fields, where `t' is a place + holder for all remaining fields +- omit: is a list of fields which should not be displayed or `t' to exclude all + fields except those listed in the order option +- name-end: sets the column where the name should end in one-line layout. +- indentation: sets the level of indentation for multi-line display. +- primary: controls wether only the primary net is shown or all are shown. +- test: a lisp expression controlling wether the record is to be displayed. + +When you add a new layout FOO, you can write a corresponding layout +function bbdb-format-record-layout-FOO. If you do not write your own +layout function, the multi-line layout will be used." + :group 'bbdb + :type + `(repeat + (cons :tag "Layout Definition" + (choice :tag "Layout type" + (const one-line) + (const multi-line) + (const pop-up-multi-line) + (const full-multi-line) + (symbol)) + (set :tag "Properties" + (cons :tag "Order" + (const :tag "List of fields to order by" order) + (repeat (choice (const phones) + (const addresses) + (const net) + (const AKA) + (const notes) + (symbol :tag "other") + (const :tag "Remaining fields" t)))) + (choice :tag "Omit" + :value (omit . nil) + (cons :tag "List of fields to omit" + (const :tag "Fields not to display" omit) + (repeat (choice (const phones) + (const addresses) + (const net) + (const AKA) + (const notes) + (symbol :tag "other")))) + (const :tag "Exclude all fields except those listed in the order property" t)) + (cons :tag "Indentation" + :value (indentation . 14) + (const :tag "Level of indentation for multi-line layout" + indentation) + (number :tag "Column")) + (cons :tag "End of name field" + :value (name-end . 24) + (const :tag "The column where the name should end in one-line layout" + name-end) + (number :tag "Column")) + (cons :tag "Toggle" + (const :tag "The layout is included when toggling display layout" toggle) + boolean) + (cons :tag "Primary Net Only" + (const :tag "Only the primary net address is included" primary) + boolean) + (cons :tag "Test" + (const :tag "Show only records passing this test" test) + (choice (const :tag "No test" nil) + (cons :tag "List of required fields" + (const :tag "Choose from the attributes in the following set:" and) + (set + (const name) + (const company) + (const net) + (const phones) + (const addresses) + (const notes))) + (sexp :tag "Lisp expression"))))))) + + +(defcustom bbdb-display-layout 'multi-line + "*The default display layout." + :group 'bbdb + :type '(choice (const one-line) + (const multi-line) + (const full-multi-line) + (symbol))) + +(defcustom bbdb-pop-up-display-layout 'one-line + "*The default display layout pop-up BBDB buffers, i.e. mail, news." + :group 'bbdb + :type '(choice (const one-line) + (const multi-line) + (const full-multi-line) + (symbol))) + +(defun bbdb-display-layout-get-option (layout option) + (let ((layout-spec (if (listp layout) + layout + (assoc layout bbdb-display-layout-alist))) + option-value) + (and layout-spec + (setq option-value (assoc option layout-spec)) + (cdr option-value)))) + +(defcustom bbdb-address-formatting-alist + '((bbdb-address-is-continental . bbdb-format-address-continental) + (nil . bbdb-format-address-default)) + "Alist of address identifying and address formatting functions. +The key is an identifying function which accepts an address. The +associated value is a formatting function which inserts the formatted +address in the current buffer. If the identifying function returns +non-nil, the formatting function is called. When nil is used as the +car, then the associated formatting function will always be called. +Therefore you should always have (nil . bbdb-format-address-default) as +the last element in the alist. + +All functions should take two arguments, the address and an indentation. +The indentation argument may be optional. + +This alist is used in `bbdb-format-address'. + +See also `bbdb-address-print-formatting-alist'." + :group 'bbdb-record-display + :type '(repeat (cons function function))) + +(defvar bbdb-address-print-formatting-alist) ; "bbdb-print" + +(defun bbdb-address-is-continental (addr) + "Return non-nil if the address ADDR is a continental address. +This is done by comparing the zip code to `bbdb-continental-zip-regexp'. + +This is a possible identifying function for +`bbdb-address-formatting-alist' and +`bbdb-address-print-formatting-alist'." + (string-match bbdb-continental-zip-regexp (bbdb-address-zip addr))) + +(defun bbdb-format-streets (addr indent) + "Insert street subfields of address ADDR in current buffer. +This may be used by formatting functions listed in +`bbdb-address-formatting-alist'." + (bbdb-mapc (lambda(str) + (indent-to indent) + (insert str "\n")) + (bbdb-address-streets addr))) + +(defun bbdb-format-address-continental (addr &optional indent) + "Insert formated continental address ADDR in current buffer. +This format is used in western Europe, for example. + +This function is a possible formatting function for +`bbdb-address-formatting-alist'. + +The result looks like this: + location: street + street + ... + zip city, state + country" + (setq indent (or indent 14)) + (let (;(fmt (format " %%%ds: " indent)) + (indent (+ 3 indent))) + ;(insert (format fmt (bbdb-address-location addr))) + (bbdb-format-streets addr indent) + (let ((c (bbdb-address-city addr)) + (s (bbdb-address-state addr)) + (z (bbdb-address-zip addr))) + (if (or (> (length c) 0) + (> (length z) 0) + (> (length s) 0)) + (progn + (indent-to indent) + (insert z (if (and (> (length z) 0) + (> (length c) 0)) " " "") + c (if (and (or (> (length z) 0) + (> (length c) 0)) + (> (length s) 0)) ", " "") + s "\n")))) + (let ((str (bbdb-address-country addr))) + (if (= 0 (length str)) nil + (indent-to indent) (insert str "\n"))))) + +(defun bbdb-format-address-default (addr &optional indent) + "Insert formated address ADDR in current buffer. +This is the default format; it is used in the US, for example. + +This function is a possible formatting function for +`bbdb-address-formatting-alist'. + +The result looks like this: + location: street + street + ... + city, state zip + country" + (setq indent (or indent 14)) + (let (;(fmt (format " %%%ds: " indent)) + (indent (+ 3 indent))) +; (insert (format fmt (bbdb-address-location addr))) + (bbdb-format-streets addr indent) + (let ((c (bbdb-address-city addr)) + (s (bbdb-address-state addr)) + (z (bbdb-address-zip addr))) + (if (or (> (length c) 0) + (> (length z) 0) + (> (length s) 0)) + (progn + (indent-to indent) + (insert c (if (and (> (length c) 0) + (> (length s) 0)) ", " "") + s (if (and (or (> (length c) 0) + (> (length s) 0)) + (> (length z) 0)) " " "") + z "\n")))) + (let ((str (bbdb-address-country addr))) + (if (= 0 (length str)) nil + (indent-to indent) (insert str "\n"))))) + +(defun bbdb-format-address (addr &optional printing indent) + "Call appropriate formatting function for address ADDR. + +If optional second argument PRINTING is non-nil, this uses the alist +`bbdb-address-print-formatting-alist' to determine how the address is to +formatted and inserted into the current buffer. This is used by +`bbdb-print-format-record'. + +If second argument PRINTING is nil, this uses the alist +`bbdb-address-formatting-alist' to determine how the address is to +formatted and inserted into the current buffer. This is used by +`bbdb-format-record'." + ;; alist contains functions ((ident1 . format1) (ident2 . format2) ...) + ;; the first identifying-function is (caar alist) + ;; the first formatting-function is (cdar alist) + (let ((alist (if printing bbdb-address-print-formatting-alist + bbdb-address-formatting-alist))) + ;; while there a functions left and the current function does not + ;; identify the address, try the next function. + (while (and (caar alist) + (null (funcall (caar alist) addr))) + (setq alist (cdr alist))) + ;; if we haven't reached the end of functions, we got a hit. + (when alist + (if printing + (funcall (cdar alist) addr) + (funcall (cdar alist) addr indent))))) + +(defun bbdb-format-record-name-company (record) + (let ((name (or (bbdb-record-name record) "???")) + (company (bbdb-record-company record)) + (start (point))) + + (insert name) + (put-text-property start (point) 'bbdb-field '(name)) + + (when company + (insert " - ") + (setq start (point)) + (insert company) + (put-text-property start (point) 'bbdb-field '(company))))) + +(defun bbdb-format-record-one-line-phones (layout record phone) + "Insert a formatted phone number for one-line display." + (let ((start (point))) + (insert (format "%s " (aref phone 1))) + (put-text-property start (point) 'bbdb-field + (list 'phone phone (aref phone 0))) + (setq start (point)) + (insert (format "(%s)" (aref phone 0))) + (put-text-property start (point) 'bbdb-field + (list 'phone phone 'field-name)))) + +(defun bbdb-format-record-one-line-net (layout record net) + "Insert a formatted list of nets for one-line display." + (let ((start (point))) + (insert net) + (put-text-property start (point) 'bbdb-field (list 'net net)))) + +(defun bbdb-format-record-one-line-notes (layout record notes) + "Insert formatted notes for one-line display. +Line breaks will be removed and white space trimmed." + (let ((start (point))) + (insert (bbdb-replace-in-string notes "[\r\n\t ]+" " ")) + (put-text-property start (point) 'bbdb-field (list 'notes notes)))) + +(defun bbdb-format-record-layout-one-line (layout record field-list) + "Record formatting function for the one-line layout. +See `bbdb-display-layout-alist' for more." + ;; name and company + (bbdb-format-record-name-company record) + (let ((name-end (or (bbdb-display-layout-get-option layout 'name-end) + 40)) + start end) + (save-excursion + (setq end (point)) + (beginning-of-line) + (setq start (point))) + (when (> (- end start -1) name-end) + (put-text-property (+ start name-end -4) end 'invisible t) + (insert "...")) + ;; guarantee one space after name - company + (insert " ") + (indent-to name-end)) + ;; rest of the fields + (let (start field contentfun formatfun values value) + (while field-list + (setq field (car field-list) + contentfun (intern (concat "bbdb-record-" + (symbol-name field)))) + (if (fboundp contentfun) + (setq values (eval (list contentfun record))) + (setq values (bbdb-record-getprop record field))) + (when (and (eq field 'net) + (bbdb-display-layout-get-option layout 'primary)) + (setq values (list (car values)))) + (when values + (if (not (listp values)) (setq values (list values))) + (setq formatfun (intern (format "bbdb-format-record-%s-%s" + layout field))) + (while values + (setq start (point) + value (car values)) + (if (fboundp formatfun) + (funcall formatfun layout record value) + (insert (format "%s" value)) + (cond ((eq field 'addresses) + (put-text-property start (point) 'bbdb-field + (list 'address value))) + ((eq field 'phones) + (put-text-property start (point) 'bbdb-field + (list 'phone value))) + ((memq field '(name net aka)) + (put-text-property start (point) 'bbdb-field + (list field value ))) + (t + (put-text-property start (point) 'bbdb-field + (list 'property (list field value)))))) + (setq values (cdr values)) + (if values (insert ", "))) + (insert "; ")) + (setq field-list (cdr field-list)))) + ;; delete the trailing "; " + (backward-delete-char 2) + (insert "\n")) + +(defun bbdb-format-record-layout-multi-line (layout record field-list) + "Record formatting function for the multi-line layout. +See `bbdb-display-layout-alist' for more." + (bbdb-format-record-name-company record) + (insert "\n") + (let* ((notes (bbdb-record-raw-notes record)) + (indent (or (bbdb-display-layout-get-option layout 'indentation) 14)) + (fmt (format " %%%ds: " indent)) + start field) + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + (while field-list + (setq field (car field-list) + start (point)) + (cond ((eq field 'phones) + (let ((phones (bbdb-record-phones record)) + loc phone) + (while phones + (setq phone (car phones) + start (point)) + (setq loc (format fmt (bbdb-phone-location phone))) + (insert loc) + (put-text-property start (point) 'bbdb-field + (list 'phone phone 'field-name)) + (setq start (point)) + (insert (bbdb-phone-string phone) "\n") + (put-text-property start (point) 'bbdb-field + (list 'phone phone + (bbdb-phone-location phone))) + (setq phones (cdr phones)))) + (setq start nil)) + ((eq field 'addresses) + (let ((addrs (bbdb-record-addresses record)) + loc addr) + (while addrs + (setq addr (car addrs) + start (point)) + (setq loc (format fmt (bbdb-address-location addr))) + (insert loc) + (put-text-property start (point) 'bbdb-field + (list 'address addr 'field-name)) + (setq start (point)) + (bbdb-format-address addr nil indent) + (put-text-property start (point) 'bbdb-field + (list 'address addr + (bbdb-address-location addr))) + (setq addrs (cdr addrs)))) + (setq start nil)) + ((eq field 'net) + (let ((net (bbdb-record-net record))) + (when net + (insert (format fmt "net")) + (put-text-property start (point) 'bbdb-field + '(net field-name)) + (setq start (point)) + (if (bbdb-display-layout-get-option layout 'primary) + (insert (car net) "\n") + (insert (mapconcat (function identity) net ", ") "\n")) + (put-text-property start (point) 'bbdb-field '(net))))) + ((eq field 'aka) + (let ((aka (bbdb-record-aka record))) + (when aka + (insert (format fmt "AKA")) + (put-text-property start (point) 'bbdb-field + '(aka field-name)) + (insert (mapconcat (function identity) aka ", ") "\n") + (setq start (point)) + (put-text-property start (point) 'bbdb-field '(aka))))) + (t + (let ((note (assoc field notes)) + (indent (length (format fmt ""))) + p notefun) + (when note + (insert (format fmt field)) + (put-text-property start (point) 'bbdb-field + (list 'property note 'field-name)) + (setq start (point)) + (setq p (point) + notefun (intern (format "bbdb-format-record-%s" field))) + (if (fboundp notefun) + (insert (funcall notefun (cdr note))) + (insert (cdr note))) + (save-excursion + (save-restriction + (narrow-to-region p (1- (point))) + (goto-char (1+ p)) + (while (search-forward "\n" nil t) + (insert (make-string indent ?\ ))))) + (insert "\n")) + (put-text-property start (point) 'bbdb-field + (list 'property note))))) + (setq field-list (cdr field-list))))) + +(defalias 'bbdb-format-record-layout-full-multi-line + 'bbdb-format-record-layout-multi-line) + +(defalias 'bbdb-format-record-layout-pop-up-multi-line + 'bbdb-format-record-layout-multi-line) + +(defun bbdb-format-record (record &optional layout) + "Insert a formatted version of RECORD into the current buffer. + +LAYOUT can be a symbol describing a layout in +`bbdb-display-layout-alist'. For compatibility reasons, LAYOUT can +also be nil or t, where t stands for the one-line, and nil for the +multi-line layout." + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "plus ungood: formatting deleted record"))) + (setq layout (cond ((eq nil layout) + 'multi-line) + ((eq t layout) + 'one-line) + ((symbolp layout) + layout) + (t + (error "Unknown layout `%s'" layout)))) + (let* ((layout-spec (assoc layout bbdb-display-layout-alist)) + (test (bbdb-display-layout-get-option layout-spec 'test)) + (omit-list (bbdb-display-layout-get-option layout-spec 'omit)) + (order-list (bbdb-display-layout-get-option layout-spec 'order)) + (all-fields (append '(phones addresses net aka) + (let ((raw-notes (bbdb-record-raw-notes record))) + (if (stringp raw-notes) + '(notes) + (mapcar (lambda (r) (car r)) raw-notes))))) + format-function field-list) + (when (or (not test) + ;; bind some variables for the test + (let ((name (bbdb-record-name record)) + (company (bbdb-record-company record)) + (net (bbdb-record-net record)) + (phones (bbdb-record-phones record)) + (addresses (bbdb-record-addresses record)) + (notes (bbdb-record-raw-notes record))) + ;; this must evaluate to non-nil if the record is to be shown + (eval test))) + (if (functionp omit-list) + (setq omit-list (funcall omit-list record layout))) + (if (functionp order-list) + (setq order-list (funcall order-list record layout))) + ;; first omit unwanted fields + (when (and omit-list (or (not order-list) (memq t order-list))) + (if (not (listp omit-list)) + ;; t => show nothing + (setq all-fields nil) + ;; listp => show all fields except those listed here + (while omit-list + (setq all-fields (delete (car omit-list) all-fields) + omit-list (cdr omit-list))))) + ;; then order them + (if (not order-list) + (setq field-list all-fields) + (if (not (memq t order-list)) + (setq field-list order-list) + (setq order-list (reverse order-list)) + (setq all-fields (delete nil (mapcar (lambda (f) + (if (memq f order-list) + nil + f)) + all-fields))) + (while order-list + (if (eq t (car order-list)) + (setq field-list (append all-fields field-list)) + (setq field-list (cons (car order-list) field-list))) + (setq order-list (cdr order-list))))) + ;; call the actual format function + (setq format-function + (intern (format "bbdb-format-record-layout-%s" layout))) + (if (functionp format-function) + (funcall format-function layout record field-list) + (bbdb-format-record-layout-multi-line layout record field-list))))) + +(defun bbdb-frob-mode-line (n) + (setq + ;; identification + mode-line-buffer-identification + (if (> n 0) + (list 24 (buffer-name) ": " + (list 10 (format "%d/%d" n (length (bbdb-records)))) + '(bbdb-showing-changed-ones " !!" " ")) + (list (buffer-name) ": Insidious Big Brother Database v" bbdb-version " " + mode-line-modified "-")) + ;; modified indicator + mode-line-modified + '(bbdb-readonly-p "--%%%%-" (bbdb-modified-p "--**-" "-----")))) + +(defun bbdb-display-records-1 (records &optional append layout) + (setq append (or append (bbdb-append-records-p))) + + (if (or (null records) + (consp (car records))) + nil + + ;; add layout and a marker to the local list of records + (setq layout (or layout bbdb-display-layout)) + (setq records (mapcar (lambda (x) + (list x layout (make-marker))) + records))) + + (let ((b (current-buffer)) + (temp-buffer-setup-hook nil) + (temp-buffer-show-function nil) + (first (car (car records)))) + + ;; just quiet a warning about unused vars + (and temp-buffer-setup-hook temp-buffer-show-function) + + (bbdb-pop-up-bbdb-buffer) + + (save-excursion + (set-buffer bbdb-buffer-name) + (let ((inhibit-read-only t)) (erase-buffer)) + + ;; If append is set, clear the buffer, otherwise do clean up. + (unless append (bbdb-undisplay-records)) + + ;; If we're appending these records to the ones already displayed, + ;; then first remove any duplicates, and then sort them. + (if append + (let ((rest records)) + (while rest + (if (assq (car (car rest)) bbdb-records) + (setq records (delq (car rest) records))) + (setq rest (cdr rest))) + (setq records (append bbdb-records records)) + (setq records + (sort records + (lambda (x y) (bbdb-record-lessp (car x) (car y))))))) + (make-local-variable 'mode-line-buffer-identification) + (make-local-variable 'mode-line-modified) + (set (make-local-variable 'bbdb-showing-changed-ones) nil) + (let ((done nil) + (rest records) + (changed (bbdb-changed-records))) + (while (and rest (not done)) + (setq done (memq (car (car rest)) changed) + rest (cdr rest))) + (setq bbdb-showing-changed-ones done)) + (bbdb-frob-mode-line (length records)) + (and (not bbdb-gag-messages) + (not bbdb-silent-running) + (message "Formatting...")) + (bbdb-mode) + ;; this in in the *BBDB* buffer, remember, not the .bbdb buffer. + (set (make-local-variable 'bbdb-records) nil) + (setq bbdb-records records) + (let ((buffer-read-only nil) + prs) + (bbdb-debug (setq prs (bbdb-records))) + (setq truncate-lines t) + (while records + (bbdb-debug (if (not (memq (car (car records)) prs)) + (error "record doubleplus unpresent!"))) + (set-marker (nth 2 (car records)) (point)) + (bbdb-format-record (nth 0 (car records)) + (nth 1 (car records))) + (setq records (cdr records)))) + (and (not bbdb-gag-messages) + (not bbdb-silent-running) + (message "Formatting...done."))) + (set-buffer bbdb-buffer-name) + (if (and append first) + (let ((cons (assq first bbdb-records)) + (window (get-buffer-window (current-buffer)))) + (if window (set-window-start window (nth 2 cons))))) + (bbdbq) + ;; this doesn't really belong here, but it's convenient ... and when + ;; using electric display it would not be called otherwise. + (save-excursion (run-hooks 'bbdb-list-hook)) + (if bbdb-gui (bbdb-fontify-buffer)) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (set-buffer b))) + +(defun bbdb-undisplay-records () + (let ((bbdb-display-buffer (get-buffer bbdb-buffer-name))) + (if (bufferp bbdb-display-buffer) + (save-excursion + (set-buffer bbdb-display-buffer) + (setq bbdb-showing-changed-ones nil + mode-line-modified nil + bbdb-records nil + buffer-read-only nil) + (erase-buffer) + (setq buffer-read-only t) + (set-buffer-modified-p nil))))) + +;;; Electric display stuff + +(defvar bbdb-inside-electric-display nil) +;; hack hack: a couple of specials that the electric stuff uses for state. +(defvar bbdb-electric-execute-me) +(defvar bbdb-electric-completed-normally) + +(defun electric-bbdb-display-records (records) + (require 'electric) + (let ((bbdb-electric-execute-me nil)) ; Hack alert! throw-to-execute sets this! + (let ((bbdb-inside-electric-display t) + buffer + bbdb-electric-completed-normally ; Hack alert! throw-to-execute sets this! + ) + (save-excursion + (save-window-excursion + (save-window-excursion (bbdb-display-records-1 records)) + (setq buffer (window-buffer (Electric-pop-up-window bbdb-buffer-name))) + (set-buffer buffer) + (if (not bbdb-gag-messages) + (message "<<< Press Space to bury the Insidious Big Brother Database list >>>")) + (catch 'Done + (while t + (catch 'Blow-off-the-error + (setq bbdb-electric-completed-normally nil) + (unwind-protect + (progn + (catch 'electric-bbdb-list-select + (Electric-command-loop 'electric-bbdb-list-select + "-> " t)) + (setq bbdb-electric-completed-normally t)) + ;; protected + (if bbdb-electric-completed-normally + (throw 'Done t) + (ding) + (message "BBDB-Quit") + (throw 'Blow-off-the-error t) + ))))) + (bury-buffer buffer)))) + (message " ") + (if bbdb-electric-execute-me + (eval bbdb-electric-execute-me))) + nil) + +(defun bbdb-electric-throw-to-execute (form-to-execute) + "Exit the `electric-command-loop' and evaluate the given form." + ;; Hack alert! These variables are bound only within the scope of + ;; bbdb-electric-display-records! + (if (not (boundp 'bbdb-electric-execute-me)) + (error "plusungood: electrical short")) + (setq bbdb-electric-execute-me form-to-execute + bbdb-electric-completed-normally t) + (throw 'electric-bbdb-list-select t)) + + +(defun bbdb-done-command () (interactive) + (throw 'electric-bbdb-list-select t)) + +(defun bbdb-bury-buffer () + (interactive) + (if bbdb-inside-electric-display + (bbdb-done-command) + (bury-buffer))) + +(defun bbdb-display-records (records &optional layout append) + (let ((bbdb-window (get-buffer-window bbdb-buffer-name))) + (if (and bbdb-electric-p + ;; never be electric if the buffer is already on screen. + (not bbdb-window)) + (progn + (define-key bbdb-mode-map " " 'bbdb-done-command) + (electric-bbdb-display-records records)) + (bbdb-display-records-1 records append layout) + ;; don't smash keybinding if they invoked `bbdb-display' + ;; from inside an electric loop. + (unless bbdb-inside-electric-display + (define-key bbdb-mode-map " " 'undefined)) + (if (and (not bbdb-gag-messages) + (not bbdb-window)) + (message + (substitute-command-keys + (if (one-window-p t) + (if pop-up-windows + "Type \\[delete-other-windows] to unshow the bbdb-list window." + "Type \\[switch-to-buffer] RET to unshow the bbdb-list window.") + "Type \\[switch-to-buffer-other-window] RET to restore old contents of the bbdb-list window."))))))) + +(defun bbdbq () + (if (not (zerop (logand (random) 31))) nil + (let ((v '["\104\157\156\47\164\40\163\165\163\160\145\143\164\40\171\157\ +\165\162\40\156\145\151\147\150\142\157\162\72\40\162\145\160\157\162\164\40\ +\150\151\155\41" "\146\156\157\162\144" "\103\157\156\163\165\155\145\40\55\55\ +\40\102\145\40\123\151\154\145\156\164\40\55\55\40\104\151\145" "\114\157\166\ +\145\40\102\151\147\40\102\162\157\164\150\145\162" "\114\145\145\40\110\141\ +\162\166\145\171\40\117\163\167\141\154\144\40\141\143\164\145\144\40\141\154\ +\157\156\145" "\101\114\114\40\131\117\125\122\40\102\101\123\105\40\101\122\ +\105\40\102\105\114\117\116\107\40\124\117\40\125\123" "\127\141\162\40\151\ +\163\40\120\145\141\143\145" "\106\162\145\145\144\157\155\40\151\163\40\123\ +\154\141\166\145\162\171" "\111\147\156\157\162\141\156\143\145\40\151\163\40\ +\123\164\162\145\156\147\164\150" "\120\162\157\154\145\163\40\141\156\144\40\ +\141\156\151\155\141\154\163\40\141\162\145\40\146\162\145\145"])) + (message (aref v (% (logand 255 (random)) (length v)))) + (message " ")))) + +(defmacro bbdb-hashtable () + '(bbdb-with-db-buffer (bbdb-records nil t) bbdb-hashtable)) + +(defun bbdb-changed-records () + (bbdb-with-db-buffer (bbdb-records nil t) bbdb-changed-records)) + +(defmacro bbdb-build-name (f l) + (list 'downcase + (list 'if (list '= (list 'length f) 0) l + (list 'if (list '= (list 'length l) 0) f + (list 'concat f " " l))))) + +(defun bbdb-remove! (e l) + (if (null l) l + (let ((ret l) + (n (cdr l))) + (while n + (if (eq e (car n)) + (setcdr l (cdr n)) ; skip n + (setq l n)) ; keep n + (setq n (cdr n))) + (if (eq e (car ret)) (cdr ret) + ret)))) + +(defun bbdb-remove-memq-duplicates (l) + (let (ret tail) + (setq ret (cons '() '()) + tail ret) + (while l + (if (not (memq (car l) ret)) + (setq tail (setcdr tail (cons (car l) '())))) + (setq l (cdr l))) + (cdr ret))) + +(defmacro bbdb-gethash (name &optional ht) + (list 'symbol-value + (list 'intern-soft name + (or ht '(bbdb-hashtable))))) + +(defmacro bbdb-puthash (name record &optional ht) + (list 'let (list (list 'sym (list 'intern name (or ht '(bbdb-hashtable))))) + (list 'set 'sym (list 'cons record + '(and (boundp sym) (symbol-value sym)))))) + +(defmacro bbdb-remhash (name record &optional ht) + (list 'let (list (list 's (list 'intern-soft name + (or ht '(bbdb-hashtable))))) + (list 'and 's (list 'set 's (list 'bbdb-remove! record + (list 'symbol-value 's)))))) + +(defsubst bbdb-search-intertwingle (name net) + "Find bbdb records matching NAME and NET. + +This is a more stringent version of bbdb-search-simple, which I am +not inclined to modify for fear of damaging other code that currently +relies on it. BBDB internals should be migrated to use this function +to identify which record is referred to by a name/net combination, +since search-simple has been overloaded with other functionality. + +The name comes from +http://www.mozilla.org/blue-sky/misc/199805/intertwingle.html, which +any budding BBDB hacker should be at least vaguely familiar with." + (bbdb-records t) + (if name (setq name (downcase name))) + (if net (setq net (downcase net)) + (setq net "")) + (let ((net-recs (bbdb-gethash (downcase net))) + recs) + (while net-recs + (if (or (and (not name) net) + (string= name (downcase (bbdb-record-name (car net-recs))))) + (add-to-list 'recs (car net-recs))) + (setq net-recs (cdr net-recs))) + recs)) + +(defsubst bbdb-search-simple (name net) + "name is a string; net is a string or list of strings." + (if (eq 0 (length name)) (setq name nil)) + (if (eq 0 (length net)) (setq net nil)) + (bbdb-records t) ; make sure db is parsed; don't check disk (faster) + (let ((name-recs (if name ;; filter out companies from hash + (let ((recs (bbdb-gethash (downcase name))) + answer) + (while recs + (let ((n-rec (car recs))) + (if (string= (downcase name) + (downcase + (or (bbdb-record-name + n-rec) + (bbdb-record-company + n-rec) + ""))) + (setq answer (append recs (list n-rec)))) + (setq recs (cdr recs)))) + answer))) + (net-recs (if (stringp net) (bbdb-gethash (downcase net)) + (let (answer) + (while (and net (null answer)) + (setq answer (bbdb-gethash (downcase (car net))) + net (cdr net))) + answer))) + ret) + (if (not (and name-recs net-recs)) + (or (and name-recs (car name-recs)) + (and net-recs (car net-recs))) + + (while name-recs + (let ((name-rec (car name-recs)) + (nets net-recs)) + (while nets + (if (eq (car nets) name-rec) + (setq nets '() + name-recs '() + ret name-rec) + (setq nets (cdr nets)))) + (if name-recs (setq name-recs (cdr name-recs)) + name-rec))) + ret))) + +(defun bbdb-net-convert (record) + "Given a record whose net field is a comma-separated string, convert it to +a list of strings (the new way of doing things.) Returns the new list." + (bbdb-record-set-net record (bbdb-split (bbdb-record-net record) ","))) + +(defun bbdb-split (string separators) + "Return a list by splitting STRING at SEPARATORS. +The inverse function of `bbdb-join'." + (let (result + (not-separators (concat "^" separators))) + (save-excursion + (set-buffer (get-buffer-create " *split*")) + (erase-buffer) + (insert string) + (goto-char (point-min)) + (while (progn + (skip-chars-forward separators) + (skip-chars-forward " \t\n\r") + (not (eobp))) + (let ((begin (point)) + p) + (skip-chars-forward not-separators) + (setq p (point)) + (skip-chars-backward " \t\n\r") + (setq result (cons (buffer-substring begin (point)) result)) + (goto-char p))) + (erase-buffer)) + (nreverse result))) + +(defun bbdb-join (list separator) + "Join a LIST to a string where the list elements are separated by SEPARATOR. +The inverse function of `bbdb-split'." + (when list + (mapconcat 'identity list separator))) + +(defsubst bbdb-hash-record (record) + "Insert the record in the appropriate hashtables. This must be called +while the .bbdb buffer is selected." + (let ((name (bbdb-record-name-1 record)) ; faster version + (lfname (bbdb-record-lfname record)) + (company (bbdb-record-company record)) + (aka (bbdb-record-aka record)) + (net (bbdb-record-net record))) + (if (> (length name) 0) + (bbdb-puthash (downcase name) record bbdb-hashtable)) + (if (> (length lfname) 0) + (bbdb-puthash (downcase lfname) record bbdb-hashtable)) + (if (> (length company) 0) + (bbdb-puthash (downcase company) record bbdb-hashtable)) + (while aka + (bbdb-puthash (downcase (car aka)) record bbdb-hashtable) + (setq aka (cdr aka))) + (while net + (bbdb-puthash (downcase (car net)) record bbdb-hashtable) + (setq net (cdr net))))) + + +;;; Reading the BBDB + +(defvar inside-bbdb-records nil + "Internal variable. Do not touch.") + +(defvar bbdb-write-file-hooks '(bbdb-write-file-hook-fn) + "*The list of functions added to `local-write-file-hooks' in `bbdb-file'.") + +(defun bbdb-records (&optional dont-check-disk already-in-db-buffer) + "Return a list of all bbdb records; read in and parse the db if necessary. +This also notices if the disk file has changed out from under us, unless +optional arg DONT-CHECK-DISK is non-nil (which is faster, but hazardous.)" + (if inside-bbdb-records + (let ((debug-on-error t)) + (error "catastrophic: bbdb-records recursed"))) + (let ((inside-bbdb-records t) + (buf (if already-in-db-buffer (current-buffer) (bbdb-buffer))) + shut-up) + (with-current-buffer buf + ;; make sure the BBDB in memory is not out of synch with disk. + (cond (dont-check-disk nil) + ((verify-visited-file-modtime buf) nil) + ((and bbdb-auto-revert-p (not (buffer-modified-p buf))) + (message "BBDB has changed on disk, reverting...") + (setq shut-up t) + (revert-buffer t t)) + ;; hassle the user + ((bbdb-yes-or-no-p + (if (buffer-modified-p buf) + "BBDB has changed on disk; flush your changes and revert? " + "BBDB has changed on disk; revert? ")) + (or (file-exists-p bbdb-file) + (error "bbdb: file %s no longer exists!!" bbdb-file)) + (revert-buffer t t)) + ;; this is the case where the .bbdb file has changed; the buffer + ;; has changed as well; and the user has answered "no" to the + ;; "flush your changes and revert" question. The only other + ;; alternative is to save the file right now. If they answer + ;; no to the following question, they will be asked the + ;; preceeding question again and again some large (but finite) + ;; number of times. `bbdb-records' is called a lot, you see... + ((buffer-modified-p buf) + ;; this prompts + (bbdb-save-db t t)) + ;; otherwise, the buffer and file are inconsistent, but we let + ;; them stay that way. + ) + (unless (assq 'bbdb-records (buffer-local-variables)) + (set (make-local-variable 'bbdb-records) nil) + (set (make-local-variable 'bbdb-changed-records) nil) + (set (make-local-variable 'bbdb-end-marker) nil) + (set (make-local-variable 'bbdb-hashtable) nil) + (set (make-local-variable 'bbdb-propnames) nil) + (set (make-local-variable 'revert-buffer-function) + 'bbdb-revert-buffer) + (bbdb-mapc (lambda (ff) (add-hook 'local-write-file-hooks ff)) + bbdb-write-file-hooks) + (setq bbdb-hashtable (make-vector bbdb-hashtable-size 0))) + (setq bbdb-modified-p (buffer-modified-p) + buffer-read-only bbdb-readonly-p) + (or bbdb-records + (cond ((= (point-min) (point-max)) ; special-case empty db + ;; this doesn't need to be insert-before-markers because + ;; there are no db-markers in this buffer. + (insert (format ";; -*-coding: %s;-*-\n;;; file-version: %d\n" + bbdb-file-coding-system bbdb-file-format)) + (bbdb-flush-all-caches) + (setq bbdb-end-marker (point-marker)) + ;;(run-hooks 'bbdb-after-read-db-hook) ; run this? + nil) + (t + (or shut-up bbdb-silent-running (message "Parsing BBDB...")) + (bbdb-flush-all-caches) + (cond ((and bbdb-notice-auto-save-file + (file-newer-than-file-p (make-auto-save-file-name) + buffer-file-name)) + (if (bbdb-yes-or-no-p "BBDB auto-save file is newer; recover it? ") + (progn + (recover-file buffer-file-name) + (bury-buffer (current-buffer)) ; recover-file selects it + (auto-save-mode 1) ; turn autosave back on + (delete-file (make-auto-save-file-name)) + (message "Auto-save mode is ON in BBDB buffer. Suggest you save it soon.") + (sleep-for 2)) + ;; delete auto-save anyway, so we don't keep asking. + (condition-case nil + (delete-file (make-auto-save-file-name)) + (file-error nil))) + ;; tail-recurse and try again + (let ((inside-bbdb-records nil)) + (bbdb-records))) + (t + ;; normal case + (fillarray bbdb-hashtable 0) + (parse-bbdb-internal))))))))) + +(defun bbdb-revert-buffer (arg noconfirm) + ;; The .bbdb file's revert-buffer-function. + ;; Don't even think of calling this. + (kill-all-local-variables) ; clear db and caches. + (if (get-buffer bbdb-buffer-name) ; now contains invalid records; nukem. + (bbdb-undisplay-records)) + (let ((revert-buffer-function nil)) ; don't loop. + (revert-buffer arg noconfirm))) + +(defun parse-bbdb-internal () + (bbdb-debug (message "Parsing BBDB... (reading...)")) + (widen) + (goto-char (point-min)) + ;; go to the point at which the first record begins + (cond ((eq (following-char) ?\[) nil) + ((search-forward "\n[" nil 0) (forward-char -1)) + (t nil)) ;; no records + ;; look backwards for user-defined field names (for completion purposes.) + (save-excursion + (if (re-search-backward "^;+[ \t]*user-fields:[ \t]*\(" nil t) + (progn + (goto-char (1- (match-end 0))) + (setq bbdb-propnames + (mapcar (lambda (x) (list (symbol-name x))) + (read (point-marker))))))) + ;; look backwards for file version, and convert if necessary. + ;; (at least, I'll write this code if I ever change the file format again...) + (let ((v (save-excursion + (if (re-search-backward + "^;+[ \t]*file-version:[ \t]*\\([0-9]+\\)[ \t]*$" nil t) + (car (read-from-string + (buffer-substring + (match-beginning 1) (match-end 1)))))))) + (if (null v) ; current version, but no file-version: line. Bootstrap it. + (let ((modp (buffer-modified-p))) + ;; This should never happen (not any more, anyway...) + (bbdb-debug (error "bbdb corrupted: no file-version line")) + (setq v 2) + (save-excursion + (if (re-search-backward "^;" nil t) + (forward-line 1) + (goto-char 1)) + ;; remember, this goes before the begin-marker of the first + ;; record in the database! + (insert-before-markers + (format ";; -*-coding: %s;-*-\n;;; file-version: %d\n" + bbdb-file-coding-system bbdb-file-format))) + (set-buffer-modified-p modp))) + (cond ((< v bbdb-file-format) + (if bbdb-file-format-migration + ;; Sanity checking. + (if (/= (car bbdb-file-format-migration) v) + (error + (format + "BBDB file format has changed on disk from %d to %d!" + (car bbdb-file-format-migration) v))) + (setq bbdb-file-format-migration + (cons v (bbdb-migration-query v))))) + ((> v bbdb-file-format) + (error "BBDB version %s doesn't understand file format version %s." + bbdb-version v)) + (t (setq bbdb-file-format-migration (cons bbdb-file-format + bbdb-file-format))))) + ;; A trap to catch a bug + ;;(assert (not (null (car bbdb-file-format-migration)))) + + (bbdb-debug + (or (eobp) (looking-at "[\[]") + (error "no following bracket: bbdb corrupted")) + (if (save-excursion + (save-restriction + (widen) + (save-excursion (search-backward "\n[" nil t)))) + (error "bbdb corrupted: records before point"))) + + ;; Migrate only if we need to. Change the .bbdb buffer only if it + ;; is not to be saved in the newest version. + (if (= (car bbdb-file-format-migration) bbdb-file-format) + (parse-bbdb-frobnicate (parse-bbdb-read)) + (let ((newrecs (parse-bbdb-frobnicate (bbdb-migrate (parse-bbdb-read))))) + (cond ((= (cdr bbdb-file-format-migration) bbdb-file-format) + (bbdb-migrate-rewrite-all nil newrecs) + (bbdb-migrate-update-file-version + (car bbdb-file-format-migration) + (cdr bbdb-file-format-migration)))) + newrecs))) + +(defun parse-bbdb-read () + ;; narrow the buffer to skip over the rubbish before the first record. + (narrow-to-region (point) (point-max)) + (let ((records nil)) + ;; insert parens so we can read the db in one fell swoop (down in C). + (let ((buffer-read-only nil) + (modp (buffer-modified-p)) + ;; Make sure those parens get cleaned up. + ;; This code had better stay simple! + (inhibit-quit t)) + (goto-char (point-min)) (insert "(\n") + (goto-char (point-max)) (insert "\n)") + (goto-char (point-min)) + (setq records (read (current-buffer))) + (goto-char (point-min)) (delete-char 2) + (goto-char (point-max)) (delete-char -2) + (set-buffer-modified-p modp)) + records)) + +(defun parse-bbdb-frobnicate (records) + ;; now we have to come up with a marker for each record. Rather than + ;; calling read for each record, we read them at once (already done) and + ;; assume that the markers are at each newline. If this isn't the case, + ;; things can go *very* wrong. + (goto-char (point-min)) + (while (looking-at "[ \t\n\f]*;") + (forward-line 1)) + (widen) + (bbdb-debug (message "Parsing BBDB... (frobnicating...)")) + (setq bbdb-records records) + (let* ((head (cons '() records)) + (rest head) + record) + (while (cdr rest) + (setq record (car (cdr rest))) + ;; yow, are we stack-driven yet?? Damn byte-compiler... + ;; Make a cache. Put it in the record. Put a marker in the cache. + ;; Add record to hash tables. + (bbdb-cache-set-marker + (bbdb-record-set-cache record (make-vector bbdb-cache-length nil)) + (point-marker)) + (forward-line 1) + + ;; frob the label completion lists (and data completion when I, + ;; uh, get around to it, maybe. this stuff should probably be + ;; conditional, in case you're not running a 42GHz Pentium 69 + ;; with chrome tailpipes) + (let ((ps (bbdb-record-phones record)) + (pl (bbdb-label-completion-list "phones")) + (as (bbdb-record-addresses record)) + (al (bbdb-label-completion-list "addresses"))) + (while ps + (let ((l (bbdb-phone-location (car ps)))) + (or (member l pl) + (setq bbdb-phones-label-list + (append (or bbdb-phones-label-list + bbdb-default-label-list) + (list l)) + pl bbdb-phones-label-list))) + (setq ps (cdr ps))) + ;; Yes, I cut and pasted. + (while as + (let ((l (bbdb-address-location (car as)))) + (or (member l al) + (setq bbdb-addresses-label-list + (append (or bbdb-addresses-label-list + bbdb-default-label-list) + (list l)) + al bbdb-addresses-label-list))) + (setq as (cdr as)))) + + (if bbdb-no-duplicates-p + ;; warn the user that there is a duplicate... + (let* ((name (bbdb-record-name record)) + (tmp (and name (bbdb-gethash (downcase name) + bbdb-hashtable)))) + (if tmp (message "Duplicate BBDB record encountered: %s" name)))) + + (bbdb-hash-record record) + (setq rest (cdr rest)) + + (bbdb-debug + (if (and (cdr rest) (not (looking-at "[\[]"))) + (error "bbdb corrupted: junk between records at %s" (point))))) + ;; In case we removed some of the leading entries... + (setq bbdb-records (cdr head))) + ;; all done. + (setq bbdb-end-marker (point-marker)) + (run-hooks 'bbdb-after-read-db-hook) + (bbdb-debug (message "Parsing BBDB... (frobnicating...done)")) + bbdb-records) + +(defmacro bbdb-user-mail-names () + "Returns a regexp matching the address of the logged-in user." + '(or bbdb-user-mail-names + (setq bbdb-user-mail-names + (concat "\\b" (regexp-quote (user-login-name)) "\\b")))) + +(defun bbdb-write-file-hook-fn () + "This is just for `bbdb-write-file-hooks'. Keep it there." + ;; this is premature as the file isn't actually written yet; but it's just + ;; for the benefit of the mode-line of the *BBDB* buffer, and there isn't + ;; an after-write-file-hook, so it'll do. + (save-restriction + (widen) + (goto-char (point-min)) + + ;; this always rewrites the coding cookie, which is a bit + ;; wasteful, but safer than alternatives + (if (looking-at ";; *-\\*-coding:") + (delete-region (point) (progn (forward-line) (point)))) + (insert-before-markers (format ";; -*-coding: %s;-*-\n" + bbdb-file-coding-system))) + (setq bbdb-modified-p nil + bbdb-changed-records nil + buffer-file-coding-system bbdb-file-coding-system) + (let ((buf (get-buffer bbdb-buffer-name))) + (when buf + (with-current-buffer buf + (setq bbdb-showing-changed-ones nil) + (set-buffer-modified-p nil)))) + (when (and bbdb-file-remote + (or bbdb-file-remote-save-always + (y-or-n-p (format "Save the remote BBDB file %s too? " + bbdb-file-remote)))) + ;; write the current buffer, which is `bbdb-file' (since this is called + ;; from its `local-write-file-hooks'), into the `bbdb-file-remote'. + (let ((coding-system-for-write bbdb-file-coding-system)) + (write-region (point-min) (point-max) bbdb-file-remote)))) + +(defun bbdb-delete-record-internal (record) + (if (null (bbdb-record-marker record)) (error "bbdb: marker unpresent")) + (bbdb-with-db-buffer + (if (or bbdb-suppress-changed-records-recording + (memq record bbdb-changed-records)) + nil + (setq bbdb-changed-records (cons record bbdb-changed-records))) + (let ((tail (memq record bbdb-records))) + (if (null tail) (error "bbdb: unfound %s" record)) + (setq bbdb-records (delq record bbdb-records)) + (delete-region (bbdb-record-marker record) + (if (cdr tail) + (bbdb-record-marker (car (cdr tail))) + bbdb-end-marker)) + (let ((name (bbdb-record-name record)) + (lfname (bbdb-record-lfname record)) + (company (bbdb-record-company record)) + (aka (bbdb-record-aka record)) + (nets (bbdb-record-net record))) + (if (> (length name) 0) + (bbdb-remhash (downcase name) record bbdb-hashtable)) + (if (> (length company) 0) + (bbdb-remhash (downcase company) record bbdb-hashtable)) + (if (> (length lfname) 0) + (bbdb-remhash (downcase lfname) record bbdb-hashtable)) + (while nets + (bbdb-remhash (downcase (car nets)) record bbdb-hashtable) + (setq nets (cdr nets))) + (while aka + (bbdb-remhash (downcase (car aka)) record bbdb-hashtable) + (setq aka (cdr aka))) + ) + (bbdb-record-set-sortkey record nil) + (setq bbdb-modified-p t)))) + +(defun bbdb-insert-sorted (record records) + "Inserts the RECORD into the list of RECORDS, in order. +Assumes the list is already sorted. Returns the new head." + (bbdb-debug (if (memq record records) + (error "doubleplus ununique: - %s" record))) + (let* ((rest (cons nil records)) + (top rest)) + (while (and (cdr rest) + (bbdb-record-lessp (nth 1 rest) record)) + (setq rest (cdr rest))) + (setcdr rest (cons record (cdr rest))) + (cdr top))) + +(defun bbdb-insert-record-internal (record unmigrated) + (if (null (bbdb-record-marker record)) + (bbdb-record-set-marker record (make-marker))) + (bbdb-with-db-buffer + (if (or bbdb-suppress-changed-records-recording + (memq record bbdb-changed-records)) + nil + (setq bbdb-changed-records (cons record bbdb-changed-records))) + (let ((print-escape-newlines t)) + (bbdb-record-set-sortkey record nil) ; just in case... + (setq bbdb-records + (bbdb-insert-sorted record bbdb-records)) + (let ((next (car (cdr (memq record bbdb-records))))) + (goto-char (if next + (bbdb-record-marker next) + bbdb-end-marker)) + ;; before printing the record, remove the cache \(we don't want that + ;; written to the file.\) Ater writing, put the cache back and update + ;; the cache's marker. + (let ((cache (bbdb-record-cache record)) + (point (point))) + (bbdb-debug + (if (= point (point-min)) + (error "doubleplus ungood: inserting at point-min (%s)" point)) + (if (and (/= point bbdb-end-marker) + (not (looking-at "[\[]"))) + (error "doubleplus ungood: not inserting before a record (%s)" + point))) + (bbdb-record-set-cache record nil) + (if unmigrated (bbdb-record-set-cache unmigrated nil)) + (insert-before-markers (bbdb-prin1-to-string (or unmigrated record)) "\n") + (set-marker (bbdb-cache-marker cache) point) + (bbdb-record-set-cache record cache) +;; (if (bbdb-record-name record) +;; (bbdb-puthash (downcase (bbdb-record-name record)) record bbdb-hashtable)) +;; (let ((nets (bbdb-record-net record))) +;; (while nets +;; (bbdb-puthash (downcase (car nets)) record bbdb-hashtable) +;; (setq nets (cdr nets)))) + ;; This is marginally slower because it rebuilds the namecache, + ;; but it makes jbw's life easier. :-\) + (bbdb-hash-record record)) + record)) + (setq bbdb-modified-p t))) + +(defun bbdb-overwrite-record-internal (record unmigrated) + (bbdb-with-db-buffer + (if (or bbdb-suppress-changed-records-recording + (memq record bbdb-changed-records)) + nil + (setq bbdb-changed-records (cons record bbdb-changed-records))) + (let ((print-escape-newlines t) + (tail bbdb-records)) + ;; Look for record after RECORD in the database. Use the + ;; beginning marker of this record (or the marker for the end of + ;; the database if no next record) to determine where to stop + ;; deleting old copy of record + (while (and tail (not (eq record (car tail)))) + (setq tail (cdr tail))) + (if (null tail) (error "bbdb: unfound %s" record)) + (let ((cache (bbdb-record-cache record))) + + (bbdb-debug + (if (<= (bbdb-cache-marker cache) (point-min)) + (error "doubleplus ungood: cache marker is %s" + (bbdb-cache-marker cache))) + (goto-char (bbdb-cache-marker cache)) + (if (and (/= (point) bbdb-end-marker) + (not (looking-at "[\[]"))) + (error "doubleplus ungood: not inserting before a record (%s)" + (point)))) + + (goto-char (bbdb-cache-marker cache)) + (bbdb-record-set-cache record nil) + (if unmigrated (bbdb-record-set-cache unmigrated nil)) + + (insert (bbdb-prin1-to-string (or unmigrated record)) "\n") + (delete-region (point) + (if (cdr tail) + (bbdb-record-marker (car (cdr tail))) + bbdb-end-marker)) + (bbdb-record-set-cache record cache) + + (bbdb-debug + (if (<= (if (cdr tail) + (bbdb-record-marker (car (cdr tail))) + bbdb-end-marker) + (bbdb-record-marker record)) + (error "doubleplus ungood: overwrite unworks"))) + + (setq bbdb-modified-p t) + record)))) + +(defvar inside-bbdb-change-record nil "hands off") +(defvar inside-bbdb-notice-hook nil + "Internal variable; hands off. +Set to t by the BBDB when inside the `bbdb-notice-hook'. + +Calls to the `bbdb-change-hook' are suppressed when this is non-nil.") + +(defun bbdb-change-record (record need-to-sort) + "Update the database after a change to the given record. Second arg +NEED-TO-SORT is whether the name has changed. You still need to worry +about updating the name hash-table." + (if inside-bbdb-change-record + record + (let ((inside-bbdb-change-record t) + unmigrated) + (or inside-bbdb-notice-hook + (bbdb-invoke-hook 'bbdb-change-hook record)) + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "bbdb: changing deleted record"))) + (if (/= (cdr bbdb-file-format-migration) bbdb-file-format) + (bbdb-unmigrate-record (setq unmigrated (bbdb-copy-thing record)))) + ;; Do the changing + (if (memq record (bbdb-records)) ; checks file synchronization too. + (if (not need-to-sort) ;; If we don't need to sort, overwrite it. + (progn + (bbdb-overwrite-record-internal record unmigrated) + (bbdb-debug + (if (not (memq record (bbdb-records))) + (error "Overwrite in change doesn't work")))) + ;; Since we do need to sort, delete then insert + (bbdb-delete-record-internal record) + (bbdb-debug + (if (memq record (bbdb-records)) + (error "Delete in need-sort change doesn't work"))) + (bbdb-insert-record-internal record unmigrated) + (bbdb-debug + (if (not (memq record (bbdb-records))) + (error "Insert in need-sort change doesn't work")))) + ;; Record isn't in database so add it. + (bbdb-insert-record-internal record unmigrated) + (bbdb-debug (if (not (memq record (bbdb-records))) + (error "Insert in change doesn't work")))) + (setq bbdb-modified-p t) + (bbdb-invoke-hook 'bbdb-after-change-hook record) + record))) + +(defun bbdb-copy-thing (thing) + "Copy a thing. Handles vectors, strings, markers, numbers, conses, +lists, symbols, and nil. Raises an error if it finds something it +doesn't know how to deal with." + (cond ((vectorp thing) + (let ((i 0) + (newvec (make-vector (length thing) nil))) + (while (< i (length thing)) + (aset newvec i (bbdb-copy-thing (aref thing i))) + (setq i (1+ i))) + newvec)) + ((stringp thing) + (copy-sequence thing)) + ((markerp thing) + (copy-marker thing)) + ((numberp thing) + thing) + ((consp thing) + (cons (bbdb-copy-thing (car thing)) + (bbdb-copy-thing (cdr thing)))) + ((listp thing) + (let ((i 0) newlist) + (while (< i (length thing)) + (setq newlist (append newlist (list (bbdb-copy-thing + (nth i thing)))) + i (1+ i))) + newlist)) + ((symbolp thing) + thing) + ((eq nil thing) + nil) + (t + (error "Don't know how to copy %s" (prin1-to-string thing))))) + +(defmacro bbdb-propnames () + '(bbdb-with-db-buffer bbdb-propnames)) + +(defun bbdb-set-propnames (newval) + (bbdb-with-db-buffer + (setq bbdb-propnames newval) + (widen) + (goto-char (point-min)) + (and (not (eq (following-char) ?\[)) + (search-forward "\n[" nil 0)) + (if (re-search-backward "^[ \t]*;+[ \t]*user-fields:[ \t]*\(" nil t) + (progn + (goto-char (1- (match-end 0))) + (delete-region (point) (progn (end-of-line) (point)))) + (and (re-search-backward "^[ \t]*;.*\n" nil t) + (goto-char (match-end 0))) + ;; remember, this goes before the begin-marker of the first + ;; record in the database! + (insert-before-markers ";;; user-fields: \n") + (forward-char -1)) + (bbdb-prin1 (mapcar (lambda (x) (intern (car x))) + bbdb-propnames) + (current-buffer)) + bbdb-propnames)) + + +;;; BBDB mode + +(defun bbdb-mode () + "Major mode for viewing and editing the Insidious Big Brother Database. +Letters no longer insert themselves. Numbers are prefix arguments. +You can move around using the usual cursor motion commands. +\\<bbdb-mode-map> +\\[bbdb-add-or-remove-mail-alias]\t Add new mail alias to visible records or \ +remove it. +\\[bbdb-edit-current-field]\t Edit the field on the current line. +\\[bbdb-record-edit-notes]\t Edit the `notes' field for the current record. +\\[bbdb-delete-current-field-or-record]\t Delete the field on the \ +current line. If the current line is the\n\t first line of a record, then \ +delete the entire record. +\\[bbdb-insert-new-field]\t Insert a new field into the current record. \ +Note that this\n\t will let you add new fields of your own as well. +\\[bbdb-transpose-fields]\t Swap the field on the current line with the \ +previous field. +\\[bbdb-dial]\t Dial the current phone field. +\\[bbdb-next-record], \\[bbdb-prev-record]\t Move to the next or the previous \ +displayed record, respectively. +\\[bbdb-create]\t Create a new record. +\\[bbdb-toggle-records-display-layout]\t Toggle whether the current record is displayed in a \ +one-line\n\t listing, or a full multi-line listing. +\\[bbdb-apply-next-command-to-all-records]\\[bbdb-toggle-records-display-layout]\t Do that \ +for all displayed records. +\\[bbdb-refile-record]\t Merge the contents of the current record with \ +some other, and then\n\t delete the current record. See this command's \ +documentation. +\\[bbdb-omit-record]\t Remove the current record from the display without \ +deleting it from\n\t the database. This is often a useful thing to do \ +before using one\n\t of the `*' commands. +\\[bbdb]\t Search for records in the database (on all fields). +\\[bbdb-net]\t Search for records by net address. +\\[bbdb-company]\t Search for records by company. +\\[bbdb-notes]\t Search for records by note. +\\[bbdb-name]\t Search for records by name. +\\[bbdb-changed]\t Display records that have changed since the database \ +was saved. +\\[bbdb-send-mail]\t Compose mail to the person represented by the \ +current record. +\\[bbdb-apply-next-command-to-all-records]\\[bbdb-send-mail]\t Compose mail \ +to everyone whose record is displayed. +\\[bbdb-finger]\t Finger the net address of the current record. +\\[bbdb-ftp]\t FTP to the curent records's `ftp' field. +\\[bbdb-apply-next-command-to-all-records]\\[bbdb-finger]\t Finger the \ +net address of all displayed records. +\\[bbdb-save-db]\t Save the BBDB file to disk. +\\[bbdb-print]\t Create a TeX file containing a pretty-printed version \ +of all the\n\t records in the database. +\\[bbdb-apply-next-command-to-all-records]\\[bbdb-print]\t Do that for the \ +displayed records only. +\\[other-window]\t Move to another window. +\\[bbdb-info]\t Read the Info documentation for BBDB. +\\[bbdb-help]\t Display a one line command summary in the echo area. +\\[bbdb-www]\t Visit Web sites listed in the `www' field(s) of the current \ +record. +\\[bbdb-whois]\t run whois on the current record. + +For address completion using the names and net addresses in the database: +\t in Sendmail mode, type \\<mail-mode-map>\\[bbdb-complete-name]. +\t in Message mode, type \\<message-mode-map>\\[bbdb-complete-name]. + +Variables of note: +\t bbdb-always-add-addresses +\t bbdb-auto-revert-p +\t bbdb-canonicalize-redundant-nets-p +\t bbdb-case-fold-search +\t bbdb-completion-type +\t bbdb-default-area-code +\t bbdb-default-domain +\t bbdb-electric-p +\t bbdb-display-layout +\t bbdb-file +\t bbdb-message-caching-enabled +\t bbdb-new-nets-always-primary +\t bbdb-north-american-phone-numbers-p +\t bbdb-notice-auto-save-file +\t bbdb-offer-save +\t bbdb-pop-up-display-layout +\t bbdb-pop-up-target-lines +\t bbdb-quiet-about-name-mismatches +\t bbdb-readonly-p +\t bbdb-use-alternate-names +\t bbdb-use-pop-up +\t bbdb-user-mail-names +\t bbdb/mail-auto-create-p +\t bbdb/news-auto-create-p + +There are numerous hooks. M-x apropos ^bbdb.*hook RET + +The keybindings, more precisely: +\\{bbdb-mode-map}" + (setq major-mode 'bbdb-mode) + (setq mode-name "BBDB") + (use-local-map bbdb-mode-map) + (run-hooks 'bbdb-mode-hook)) + +;;; these should be in bbdb-com.el but they're so simple, why load it all. + +(defun bbdb-next-record (p) + "Move the cursor to the first line of the next BBDB record." + (interactive "p") + (if (< p 0) + (bbdb-prev-record (- p)) + (forward-char) + (while (> p 0) + (or (re-search-forward "^[^ \t\n]" nil t) + (progn (beginning-of-line) + (error "no next record"))) + (setq p (1- p))) + (beginning-of-line))) + +(defun bbdb-prev-record (p) + "Move the cursor to the first line of the previous BBDB record." + (interactive "p") + (if (< p 0) + (bbdb-next-record (- p)) + (while (> p 0) + (or (re-search-backward "^[^ \t\n]" nil t) + (error "no previous record")) + (setq p (1- p))))) + + +(defun bbdb-maybe-update-display (bbdb-record) + (save-excursion + (save-window-excursion + (let ((w (get-buffer-window bbdb-buffer-name)) + (b (current-buffer))) + (if w + (unwind-protect + (progn (set-buffer bbdb-buffer-name) + (save-restriction + (if (assq bbdb-record bbdb-records) + (bbdb-redisplay-records)))) + (set-buffer b))))))) + +(defcustom bbdb-notes-default-separator ", " + "*The default separator inserted by `bbdb-annotate-notes'. +This is used for notes which do not have `field-separator' property set. +E.g., if you want URLs to be separated by newlines, you can put + (put 'www 'field-separator \"\\n\") +into your .emacs." + :group 'bbdb-noticing-records + :type 'string) + +(defun bbdb-annotate-notes (bbdb-record annotation &optional fieldname replace) + "Add an annotation to a record. +Adds (or replaces, when the fourth argument REPLACE is non-nil) +an ANNOTATION to the note FIELDNAME in BBDB-RECORD. +Called by `bbdb-auto-notes-hook'." + (or bbdb-record (error "unperson")) + (setq annotation (bbdb-string-trim annotation)) + (if (memq fieldname '(name address addresses phone phones net aka AKA)) + (error "bbdb: cannot annotate the %s field this way" fieldname)) + (or fieldname (setq fieldname 'notes)) + (or (memq fieldname '(notes company)) + (assoc (symbol-name fieldname) (bbdb-propnames)) + (bbdb-set-propnames (append (bbdb-propnames) + (list (list (symbol-name fieldname)))))) + (let ((notes (bbdb-string-trim + (or (bbdb-record-getprop bbdb-record fieldname) "")))) + (unless (or (string= "" annotation) + (string-match (regexp-quote annotation) notes)) + (bbdb-record-putprop bbdb-record fieldname + (if (or replace (string= notes "")) + annotation + (concat notes + (or (get fieldname 'field-separator) + bbdb-notes-default-separator) + annotation))) + (bbdb-maybe-update-display bbdb-record)))) + +(defun bbdb-offer-save () + "Offer to save the Insidious Big Brother Database if it is modified." + (if bbdb-offer-save + (bbdb-save-db (eq bbdb-offer-save t)))) + +(defcustom bbdb-save-db-timeout nil + "*If non-nil, then when `bbdb-save-db' is asking you whether to save the db, +it will time out to `yes' after this many seconds. This only works if the +function `y-or-n-p-with-timeout' is defined." + :group 'bbdb-save + :type '(choice (const :tag "Don't time out" nil) + (integer :tag "Time out after this many seconds" 5))) + +(defun bbdb-save-db (&optional prompt-first mention-if-not-saved) + "Save the DB if it is modified." + (interactive (list nil t)) + (bbdb-with-db-buffer + (if (and (buffer-modified-p) + (or (null prompt-first) + (if bbdb-readonly-p + (bbdb-y-or-n-p + "Save the BBDB, even though it's supposedly read-only? ") + (if (and bbdb-save-db-timeout + (fboundp 'y-or-n-p-with-timeout)) + (y-or-n-p-with-timeout + "Save the BBDB now? " bbdb-save-db-timeout t) + (bbdb-y-or-n-p "Save the BBDB now? "))))) + (save-buffer) + (if mention-if-not-saved (message "BBDB not saved"))))) + + +;;; mail and news interface + +(defun bbdb-clean-username (string) + "Strips garbage from the user full name string." + ;; This function is called a lot, and should be fast. But I'm loathe to + ;; remove any of the functionality in it. + (if (string-match "[@%!]" string) ; ain't no user name! It's an address! + (bbdb-string-trim string) + (let ((case-fold-search t)) + ;; Take off leading and trailing non-alpha chars \(quotes, parens, + ;; digits, etc) and things which look like phone extensions \(like + ;; "x1234" and "ext. 1234". \) + ;; This doesn't work all the time because some of our friends in + ;; northern europe have brackets in their names... + (if (string-match (if bbdb-have-re-char-classes + "\\`[^[:alpha:]]+" + "\\`[^a-z]+") + string) + (setq string (substring string (match-end 0)))) + (while (string-match + "\\(\\W+\\([Xx]\\|[Ee]xt\\.?\\)\\W*[-0-9]+\\|[^a-z]+\\)\\'" + string) + (setq string (substring string 0 (match-beginning 0)))) + ;; replace tabs, multiple spaces, dots, and underscores with a single + ;; space, but don't replace ". " with " " because that could be an + ;; initial. + (while (string-match "\\(\t\\| +\\|\\(\\.\\)[^ \t_]\\|_+\\)" string) + (setq string (concat (substring string 0 + (or (match-beginning 2) + (match-beginning 1))) + " " + (substring string (or (match-end 2) + (match-end 1)))))) + ;; If the string contains trailing parenthesized comments, nuke 'em. + (if (string-match "[^ \t]\\([ \t]*\\((\\| -\\| #\\)\\)" string) + (progn + (setq string (substring string 0 (match-beginning 1))) + ;; lose rubbish this may have exposed. + (while + (string-match + "\\(\\W+\\([Xx]\\|[Ee]xt\\.?\\)\\W*[-0-9]+\\|[^a-z]+\\)\\'" + string) + (setq string (substring string 0 (match-beginning 0)))))) + string))) + +;;; message-caching, to speed up the the mail interfaces + +(defvar bbdb-buffers-with-message-caches '() + "A list of all the buffers which have stuff on their `bbdb-message-cache' +local variable. When we re-parse the `bbdb-file', we need to flush all of +these caches.") + +(defun notice-buffer-with-cache (buffer) + (or (memq buffer bbdb-buffers-with-message-caches) + (progn + ;; First remove any deleted buffers which may have accumulated. + ;; This happens only when a buffer is added to the list, so it + ;; ought not happen that frequently (each time you read mail, say.) + (let ((rest bbdb-buffers-with-message-caches)) + (while rest + (if (null (buffer-name (car rest))) + (setq bbdb-buffers-with-message-caches + (delq (car rest) bbdb-buffers-with-message-caches))) + (setq rest (cdr rest)))) + ;; now add this buffer. + (setq bbdb-buffers-with-message-caches + (cons buffer bbdb-buffers-with-message-caches))))) + +(defvar bbdb-message-cache nil + "alist of (MESSAGE-KEY BBDB-RECORDS) cached in order to avoid updating +messages each time they are visited. This is used by all MUAs, while the +MESSAGE-KEY is specific to the MUA and the cache is local for each MUA or MUA +folder.") + +(make-variable-buffer-local 'bbdb-message-cache) + +(defun bbdb-message-cache-lookup (message-key) + "Return cached BBDB records for MESSAGE-KEY. +If not present or when the records have been modified return nil." + (bbdb-records) + (if bbdb-message-caching-enabled + (let ((records (assq message-key bbdb-message-cache)) + (invalid nil)) + (when records + (setq records (cdr records)) + (bbdb-mapc (lambda (record) + (if (bbdb-record-deleted-p record) + (setq invalid t))) + records)) + (if invalid nil records)))) + +(defun bbdb-encache-message (message-key bbdb-records) + "Cache the BBDB-RECORDS for a message identified by MESSAGE-KEY and +return them." + (and bbdb-message-caching-enabled + (car bbdb-records) + (add-to-list 'bbdb-message-cache (cons message-key bbdb-records)) + (notice-buffer-with-cache (current-buffer))) + bbdb-records) + +(defun bbdb-decache-message (message-key) + "Remove an element form the cache." + (and bbdb-message-caching-enabled + (delq (assoc message-key bbdb-message-cache) bbdb-message-cache))) + +(defun bbdb-flush-all-caches () + (bbdb-debug + (and bbdb-buffers-with-message-caches + (message "Flushing BBDB caches"))) + (save-excursion + (while bbdb-buffers-with-message-caches + (if (buffer-name (car bbdb-buffers-with-message-caches)) + (progn + (set-buffer (car bbdb-buffers-with-message-caches)) + (setq bbdb-message-cache nil))) + (setq bbdb-buffers-with-message-caches + (cdr bbdb-buffers-with-message-caches))))) + + +(defconst bbdb-name-gubbish + (concat "[-,. \t/\\]+\\(" + "[JjSs]r\\.?" + "\\|V?\\(I\\.?\\)+V?" + (concat "\\|" + (regexp-opt bbdb-lastname-prefixes)) + "\\)\\W*\\'")) + +(defun bbdb-divide-name (string) + "divide the string into a first name and a last name, cleverly." + ;; ## This shouldn't be here. + (if (string-match "\\W+\\([Xx]\\|[Ee]xt\\.?\\)\\W*[-0-9]+\\'" string) + (setq string (substring string 0 (match-beginning 0)))) + (let* ((case-fold-search nil) + (str string) + (gubbish (string-match bbdb-name-gubbish string))) + (if gubbish + (setq gubbish (substring str gubbish) + str (substring string 0 (match-beginning 0)))) + (if (string-match + (concat " +\\(" + ;; start recognize some prefixes to lastnames + (if bbdb-lastname-prefixes + (concat "\\(" + (regexp-opt bbdb-lastname-prefixes t) + "[ ]+\\)?")) + ;; end recognize some prefixes to lastnames + "\\([^ ]+ *- *\\)?[^ ]+\\)\\'") str) + (list (substring str 0 (match-beginning 0)) + (concat + (substring str (match-beginning 1)) + (or gubbish ""))) + (list string "")))) + +(defun bbdb-check-alternate-name (possible-name record) + (let (aka) + (if (setq aka (bbdb-record-aka record)) + (let ((down-name (downcase possible-name)) + match) + (while aka + (if (equal down-name (downcase (car aka))) + (setq match (car aka) + aka nil) + (setq aka (cdr aka)))) + match)))) + + +(defun bbdb-canonicalize-address (net) + ;; call the bbdb-canonicalize-net-hook repeatedly until it returns a + ;; value eq to the value passed in. This implies that it can't + ;; destructively modify the string. + + ;; Hysterical Raisins: This is a function, not a hook. In order to + ;; make this hook a hook, we'll quietly convert a single function + ;; into a hook list. We should really warn the user that we're + ;; doing this, and advise them to update their configuration + ;; accordingly. For the release, maybe. + (if (functionp bbdb-canonicalize-net-hook) + (setq bbdb-canonicalize-net-hook (list bbdb-canonicalize-net-hook))) + + ;; Now, do the hook run. Note, if you mess up, it's possible that + ;; BBDB will get stuck here oscillating between various definitions + ;; of the canonical address. + (while (not (equal net (setq net (run-hook-with-args + 'bbdb-canonicalize-net-hook net))))) + + net) + +;; Mostly written by Rod Whitby. +(defun bbdb-net-redundant-p (net old-nets) + "Returns non-nil if NET represents a sub-domain of one of the OLD-NETS. +The returned value is the address which makes this one redundant. +For example, \"foo@bar.baz.com\" is redundant w.r.t. \"foo@baz.com\", +and \"foo@quux.bar.baz.com\" is redundant w.r.t. \"foo@bar.baz.com\"." + (let ((redundant-addr nil)) + (while (and (not redundant-addr) old-nets) + ;; Calculate a host-regexp for each address in OLD-NETS + (let* ((old (car old-nets)) + (host-index (string-match "@" old)) + (name (and host-index (substring old 0 host-index))) + (host (and host-index (substring old (1+ host-index)))) + ;; host-regexp is "^<name>@.*\.<host>$" + (host-regexp (and name host + (concat "\\`" (regexp-quote name) + "@.*\\." (regexp-quote host) + "\\'")))) + ;; If NET matches host-regexp, then it is redundant + (if (and host-regexp net + (string-match host-regexp net)) + (setq redundant-addr old))) + (setq old-nets (cdr old-nets))) + redundant-addr)) + +(defun bbdb-name-normalize (name) + "Return normalized NAME. +NAME is converted to lower case and in a MULE enabled Emacs it is converted to +UTF-8 or unibyte to unify the overlapping ISO-8859-* encodings. + +You may advice this function to allow more sophisticated normalizations." + (when name + (setq name (downcase name)) + (cond ((functionp 'encode-coding-string) + (funcall 'encode-coding-string name 'utf-8)) + ((functionp 'string-make-unibyte) + (funcall 'string-make-unibyte name)) + (t + name)))) + +(defun bbdb-name= (a b) + "Return t if the two names A and B are equal. +Before comparing A and B they are normalized by calling the function +`bbdb-name-normalize'." + (string= (bbdb-name-normalize a) (bbdb-name-normalize b))) + + +(defun bbdb-annotate-message-sender (from &optional loudly create-p + prompt-to-create-p) + "Fills the record corresponding to the sender with as much info as possible. +A record may be created by this; a record or nil is returned. +If `bbdb-readonly-p' is true, then a record will never be created. +If CREATE-P is true, then a record may be created, otherwise it won't. +If PROMPT-TO-CREATE-P is true, then the user will be asked for confirmation +before the record is created, otherwise it is created without confirmation +\(assuming that CREATE-P is true\). " + (let* ((data (if (consp from) + from ; if from is a cons, it's pre-parsed (hack hack) + (mail-extract-address-components from))) + (name (car data)) + (net (car (cdr data)))) + (if (equal name net) (setq name nil)) + (bbdb-debug + (if (equal name "") (error "mail-extr returned \"\" as name")) + (if (equal net "") (error "mail-extr returned \"\" as net"))) + + (if (and net bbdb-canonicalize-net-hook) + (setq net (bbdb-canonicalize-address net))) + + (let ((change-p nil) + (record (or (bbdb-search-simple nil net) + (bbdb-search-simple name nil))) + (created-p nil) + (fname name) + (lname nil) + old-name + ignore-name-mismatch + bogon-mode) + (and record (setq old-name (bbdb-record-name record))) + + ;; This is to prevent having losers like "John <blat@foop>" match + ;; against existing records like "Someone Else <john>". + ;; + ;; The solution implemented here is to never create or show records + ;; corresponding to a person who has a real-name which is the same + ;; as the network-address of someone in the db already. This is not + ;; a good solution. + (let (old-net) + (if (and record name (not (bbdb-name= name old-name))) + (progn + (setq old-net (bbdb-record-net record)) + (while old-net + (if (bbdb-name= name (car old-net)) + (progn + (setq bogon-mode t + old-net nil) + (message + "Ignoring bogon %s's name \"%s\" to avoid name-clash with \"%s\"" + net name old-name) + (sit-for 2)) + (setq old-net (cdr old-net))))))) + + (if (or record + bbdb-readonly-p + (not create-p) + (not (or name net)) + bogon-mode) + ;; no further action required + nil + ;; otherwise, the db is writable, and we may create a record. + ;; first try to get a reasonable default name if not given + ;; often I get things like <firstname>.<surname>@ ... + (if (or (null name) (and (stringp name) (string= "" name))) + (if (string-match "^[^@]+" net) + (setq name (bbdb-clean-username (match-string 0 net))))) + (setq record (if (or (null prompt-to-create-p) + (if (functionp prompt-to-create-p) + (bbdb-invoke-hook-for-value + prompt-to-create-p) + (bbdb-y-or-n-p + (format "%s is not in the db. Add? " + (or name net))))) + (make-vector bbdb-record-length nil)) + created-p (not (null record))) + (if record + (bbdb-record-set-cache record (make-vector bbdb-cache-length nil))) + ) + (if (or bogon-mode (null record)) + nil + (bbdb-debug (if (bbdb-record-deleted-p record) + (error "nasty nasty deleted record nasty."))) + (if (and name + (not (bbdb-name= name old-name)) + (or (null bbdb-use-alternate-names) + (not (bbdb-check-alternate-name name record))) + (let ((fullname (bbdb-divide-name name)) + tmp) + (setq fname (car fullname) + lname (nth 1 fullname)) + (not (and (equal (downcase fname) + (and (setq tmp + (bbdb-record-firstname record)) + (downcase tmp))) + (equal (downcase lname) + (and (setq tmp + (bbdb-record-lastname record)) + (downcase tmp))))))) + + ;; have a message-name, not the same as old name. + (cond (bbdb-readonly-p nil);; skip if readonly + + ;; ignore name mismatches? + ;; NB 'quiet' means 'don't ask', not 'don't mention' + ((and old-name + (setq ignore-name-mismatch bbdb-quiet-about-name-mismatches + ignore-name-mismatch + (cond + ((eq nil ignore-name-mismatch) + nil) + ((eq t ignore-name-mismatch) + 2) + ((numberp ignore-name-mismatch) + ignore-name-mismatch) + ((functionp ignore-name-mismatch) + (funcall ignore-name-mismatch record name)) + (t + (eval ignore-name-mismatch))))) + (if (or bbdb-silent-running (eq t ignore-name-mismatch)) + nil + (message "name mismatch: \"%s\" changed to \"%s\"" + (bbdb-record-name record) name) + (if (numberp ignore-name-mismatch) + (sit-for ignore-name-mismatch)))) + ((or created-p + (if bbdb-silent-running t + (if (null old-name) + (bbdb-y-or-n-p + (format "Assign name \"%s\" to address \"%s\"? " + name (car (bbdb-record-net record)))) + (bbdb-y-or-n-p + (format "Change name \"%s\" to \"%s\"? " + old-name name))))) + (setq change-p 'sort) + + ;; Keep old name? + (and old-name bbdb-use-alternate-names + (not (member old-name (bbdb-record-aka record))) + ;; Silent mode: just add it. + (if bbdb-silent-running + (bbdb-record-set-aka record + (cons old-name + (bbdb-record-aka + record))) + ;; prompt user otherwise. + (if (bbdb-y-or-n-p + (format "Keep name \"%s\" as an AKA? " + old-name)) + (bbdb-record-set-aka record + (cons old-name + (bbdb-record-aka + record))) + (bbdb-remhash (downcase old-name) record)))) + + (bbdb-record-set-namecache record nil) + (bbdb-record-set-firstname record fname) + (bbdb-record-set-lastname record lname) + (bbdb-debug (or fname lname + (error "bbdb: should have a name by now"))) + (bbdb-puthash (downcase (bbdb-record-name record)) record)) + + ;; not quiet about mismatches + ((and old-name bbdb-use-alternate-names + ;; dedupe + (not (member old-name (bbdb-record-aka record))) + (if (not bbdb-silent-running) + (bbdb-y-or-n-p + (format "Make \"%s\" an alternate for \"%s\"? " + name old-name)))) + (setq change-p 'sort) + (bbdb-record-set-aka + record (cons name (bbdb-record-aka record))) + (bbdb-puthash (downcase name) record)))) + + ;; It's kind of a kludge that the "redundancy" concept is built in. + ;; Maybe I should just add a new hook here... The problem is that the + ;; canonicalize-net-hook is run before database lookup, and thus can't + ;; refer to the database to determine whether a net is redundant. + (if bbdb-canonicalize-redundant-nets-p + (setq net (or (bbdb-net-redundant-p net (bbdb-record-net record)) + net))) + + (if (and net (not bbdb-readonly-p)) + (if (null (bbdb-record-net record)) + ;; names are always a sure match, so don't bother prompting + ;; here. + (progn (bbdb-record-set-net record (list net)) + (bbdb-puthash (downcase net) record) ; important! + (or change-p (setq change-p t))) + ;; new address; ask before adding. + (if (let ((rest-net (bbdb-record-net record)) + (new (downcase net)) + (match nil)) + (while (and rest-net (null match)) + (setq match (string= new (downcase (car rest-net))) + rest-net (cdr rest-net))) + match) + nil + (if (let ((bbdb-always-add-addresses + bbdb-always-add-addresses)) + (if (functionp bbdb-always-add-addresses) + (setq bbdb-always-add-addresses + (funcall bbdb-always-add-addresses))) + (cond + ;; add it automatically + ((eq bbdb-always-add-addresses t) + t) + ;; do not add it + ((null bbdb-always-add-addresses) + nil) + ;; ask the user if it should be added + (t + (and + (not (equal net "???")) + (let ((the-first-bit + (format "Add address \"%s\" to \"" net)) + ;; this groveling is to prevent the "(y or n)" + ;; from falling off the right edge of the + ;; screen. + (the-next-bit (mapconcat 'identity + (bbdb-record-net + record) + ", ")) + (w (window-width (minibuffer-window)))) + (if (> (+ (length the-first-bit) + (length the-next-bit) 15) w) + (setq the-next-bit + (concat + (substring + the-next-bit + 0 (max 0 (- w (length the-first-bit) + 20))) + "..."))) + (bbdb-display-records (list record)) + (if (bbdb-y-or-n-p (concat the-first-bit + the-next-bit + "\"? ")) + ;; then add the new net + t + ;; else add a new record with the same name + (if (and create-p + (or (null prompt-to-create-p) + (if (functionp prompt-to-create-p) + (bbdb-invoke-hook-for-value + prompt-to-create-p) + (bbdb-y-or-n-p + (format + "Create a new record for %s? " + (bbdb-record-name record)))))) + (setq record + (bbdb-create-internal name nil net + nil nil nil))) + nil)))))) + ;; then modify an existing record + (let ((front-p (cond ((null bbdb-new-nets-always-primary) + (bbdb-y-or-n-p + (format + "Make \"%s\" the primary address? " + net))) + ((eq bbdb-new-nets-always-primary t) + t) + (t nil)))) + (bbdb-record-set-net record + (if front-p + (cons net (bbdb-record-net + record)) + (nconc (bbdb-record-net record) + (list net)))) + (bbdb-puthash (downcase net) record) ; important! + (or change-p (setq change-p t))))))) + + (bbdb-debug + (if (and change-p bbdb-readonly-p) + (error + "doubleplus ungood: how did we change anything in readonly mode?" + ))) + (if (and loudly change-p (not bbdb-silent-running)) + (if (eq change-p 'sort) + (message "noticed \"%s\"" (bbdb-record-name record)) + (if (bbdb-record-name record) + (message "noticed %s's address \"%s\"" + (bbdb-record-name record) net) + (message "noticed naked address \"%s\"" net)))) + + (if created-p + (bbdb-invoke-hook 'bbdb-create-hook record)) + + (if change-p + (bbdb-change-record record (eq change-p 'sort))) + + ;; only invoke bbdb-notice-hook if we actually noticed something + (if record + (let ((inside-bbdb-notice-hook t)) + (bbdb-invoke-hook 'bbdb-notice-hook record))) + + record)))) + + +;;; window configuration hackery +(defun bbdb-multiple-buffers-default () + "Default function for guessing a better name for new *BBDB* buffers." + (cond ((memq major-mode '(vm-mode vm-summary-mode + vm-presentation-mode + vm-virtual-mode)) + (vm-select-folder-buffer) + (buffer-name)) + ((memq major-mode '(gnus-summary-mode gnus-group-mode)) + (set-buffer gnus-article-buffer) + (buffer-name)) + ((memq major-mode '(mail-mode vm-mail-mode message-mode)) + "message composition"))) + +(defun bbdb-multiple-buffers-set-name (&optional buffer-list new-name) + (setq new-name (or new-name + (concat " *BBDB " (funcall bbdb-multiple-buffers) "*")) + buffer-list (append (list (current-buffer) + (get-buffer-create new-name)) + buffer-list)) + + (save-excursion + (while buffer-list + (set-buffer (car buffer-list)) + (make-local-variable 'bbdb-buffer-name) + (setq bbdb-buffer-name new-name) + (setq buffer-list (cdr buffer-list))))) + +(defun bbdb-pop-up-bbdb-buffer (&optional predicate) + "Find the largest window on the screen, and split it, displaying the +*BBDB* buffer in the bottom 'bbdb-pop-up-target-lines' lines (unless +the *BBDB* buffer is already visible, in which case do nothing.) + +PREDICATE can be a function to select the right window for the split. + +`bbdb-use-pop-up' controls how to split the selected window and how many lines +resp. columns it will get. If it is 'vertical a vertical split is done otherwise +a horizontal. + +If `bbdb-multiple-buffers' is set we create a new BBDB buffer when not +already within one. The new buffer-name starts with a space, i.e. it does +not clutter the buffer-list." + + (let ((current-window (selected-window)) + (current-buffer (current-buffer)) + new-bbdb-buffer-name + window) + + ;; create new BBDB buffer if multiple buffers are desired. + (when (and bbdb-multiple-buffers (not (eq major-mode 'bbdb-mode))) + (bbdb-multiple-buffers-set-name (list current-buffer))) + (setq new-bbdb-buffer-name bbdb-buffer-name) + + + ;; now get the pop-up + (if (or (not bbdb-use-pop-up) (get-buffer-window new-bbdb-buffer-name)) + ;; just create the buffer if necessary + (progn + (get-buffer-create new-bbdb-buffer-name) + (display-buffer new-bbdb-buffer-name)) + + ;; else find a window to split + (when predicate + (setq window current-window) + (while (and (not (funcall predicate window)) + (not (eq current-window + (setq window (next-window window))))))) + + ;; find the tallest window if none has been selected so far + (when (null window) + (let ((tallest-window current-window)) + (while (not (eq current-window (setq window (next-window window)))) + (if (> (window-height window) (window-height tallest-window)) + (setq tallest-window window))) + (setq window tallest-window))) + + ;; select it and split it... + (select-window window) + (cond ((eq bbdb-use-pop-up 'vertical) + (split-window-horizontally (- bbdb-pop-up-target-columns))) + (t + (let ((size (min + (- (window-height window) window-min-height 1) + (- (window-height window) + (max window-min-height + (1+ bbdb-pop-up-target-lines)))))) + (setq size (if (> size 0) size window-min-height)) + (split-window window size)))) + + ;; make gnus happy... + (if (memq major-mode + '(gnus-Group-mode gnus-Subject-mode gnus-Article-mode)) + (goto-char (point-min))) + + ;; goto the next window, the one created by the split and + ;; make it display the BBDB buffer + (select-window (next-window)) + (let ((pop-up-windows nil)) + (switch-to-buffer (get-buffer-create new-bbdb-buffer-name))) + + ;; select the original window we were in + (select-window current-window) + ;; and make sure the original buffer is selected + (set-buffer current-buffer)))) + +(defun bbdb-version (&optional arg) + "Return string describing the version of the BBDB that is running. +When called interactively with a prefix argument, insert string at point." + (interactive "P") + (let ((version-string (format "BBDB version %s" bbdb-version))) + (cond + (arg + (insert (message version-string))) + ((interactive-p) + (message version-string)) + (t version-string)))) + +;;; resorting, which really shouldn't be necesary... + +(defun bbdb-record-lessp-fn (record1 record2) ; for use as a funarg + (bbdb-record-lessp record1 record2)) + +(defun bbdb-resort-database () + "*Resort BBDB database as a last resort. +This is not be needed when using BBDB itself. It might be necessary +after having used inferior software to add entries to the BBDB, however." + (interactive) + (let* ((records (copy-sequence (bbdb-records)))) + (bbdb-with-db-buffer + (setq bbdb-records (sort bbdb-records 'bbdb-record-lessp-fn)) + (if (equal records bbdb-records) + nil + (message "DANGER! BBDB was mis-sorted; it's being fixed...") + (goto-char (point-min)) + (cond ((eq (following-char) ?\[) nil) + ((search-forward "\n[" nil 0) (forward-char -1))) + (delete-region (point) bbdb-end-marker) + (let ((print-escape-newlines t) + (standard-output (current-buffer)) + (inhibit-quit t) ; really, don't fuck with this + record cache) + (setq records bbdb-records) + (while records + (setq record (car records) + cache (bbdb-record-cache record)) + (bbdb-record-set-cache record nil) + (bbdb-prin1 (car records)) + (bbdb-record-set-cache record cache) + (insert ?\n) + (setq records (cdr records)))) + (kill-all-local-variables) + (error "the BBDB was mis-sorted: it has been repaired."))))) + +(defvar bbdb-init-forms + '((gnus ; gnus 3.15 or newer + (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)) + (mh-e ; MH-E + (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) + (rmail ; RMAIL + (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) + (sendmail ; the standard mail user agent + (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)) + (vm-old ; the alternative mail reader + (add-hook 'vm-load-hook 'bbdb-insinuate-vm)) + (vm ; newer versions don't have vm-load-hook + (progn (eval-after-load "vm" '(bbdb-insinuate-vm)))) + (message ; the gnus mail user agent + (add-hook 'message-setup-hook 'bbdb-insinuate-message)) + (reportmail ; mail notification + (add-hook 'reportmail-load-hook 'bbdb-insinuate-reportmail)) + (sc ; message citation + (add-hook 'sc-load-hook 'bbdb-insinuate-sc)) + (supercite ; same + (add-hook 'sc-load-hook 'bbdb-insinuate-sc)) + (w3 ; WWW browser + (add-hook 'w3-load-hook 'bbdb-insinuate-w3))) + "The alist which maps features to insinuation forms.") + +;;;###autoload +(defun bbdb-initialize (&rest to-insinuate) +"*Initialize the BBDB. One or more of the following symbols can be +passed as arguments to initiate the appropriate insinuations. + + Initialization of mail/news readers: + + gnus Initialize BBDB support for the gnus mail/news reader + version 3.15 or newer. If you pass the `gnus' symbol, + you should probably also pass the `message' symbol. + mh-e Initialize BBDB support for the MH-E mail reader. + rmail Initialize BBDB support for the RMAIL mail reader. + sendmail Initialize BBDB support for sendmail (M-x mail). + vm Initialize BBDB support for the VM mail reader. + NOTE: For the VM insinuation to work properly, you must + either call `bbdb-initialize' with the `vm' symbol from + within your VM initialization file (\"~/.vm\") or you + must call `bbdb-insinuate-vm' manually from within your + VM initialization file. + + Initialization of miscellaneous package: + + message Initialize BBDB support for Message mode. + reportmail Initialize BBDB support for the Reportmail mail + notification package. + sc or Initialize BBDB support for the Supercite message + supercite citation package. + w3 Initialize BBDB support for Web browsers." + + (defalias 'advertized-bbdb-delete-current-field-or-record + 'bbdb-delete-current-field-or-record) + + (require 'bbdb-autoloads) + + (while to-insinuate + (let* ((feature (car to-insinuate)) + (init (assq feature bbdb-init-forms))) + (setq to-insinuate (cdr to-insinuate)) + (if init + (if (or (featurep feature) (locate-library (symbol-name feature))) + (eval (cadr init)) + (bbdb-warn "cannot locate feature `%s'" feature)) + (bbdb-warn "don't know how to insinuate `%s'" feature)))) + + ;; RMAIL, MHE, and VM interfaces might need these. + (autoload 'mail-strip-quoted-names "mail-utils") + (autoload 'mail-fetch-field "mail-utils") + ;; All of the interfaces need this. + (autoload 'mail-extract-address-components "mail-extr") + + (run-hooks 'bbdb-initialize-hook)) + +;; Initialize keymaps +(unless bbdb-mode-search-map + (define-prefix-command 'bbdb-mode-search-map) + (if (fboundp 'set-keymap-prompt) + (set-keymap-prompt + bbdb-mode-search-map + "(Search [n]ame, [c]ompany, net [a]ddress, n[o]tes)?")) + + (define-key bbdb-mode-search-map [(n)] 'bbdb-name) + (define-key bbdb-mode-search-map [(c)] 'bbdb-company) + (define-key bbdb-mode-search-map [(a)] 'bbdb-net) + (define-key bbdb-mode-search-map [(o)] 'bbdb-notes)) + +(unless bbdb-mode-map + (setq bbdb-mode-map (make-keymap)) + (suppress-keymap bbdb-mode-map) + + (define-key bbdb-mode-map [(S)] 'bbdb-mode-search-map) + + (define-key bbdb-mode-map [(*)] 'bbdb-apply-next-command-to-all-records) + (define-key bbdb-mode-map [(+)] 'bbdb-append-records) + (define-key bbdb-mode-map [(!)] 'bbdb-search-invert-set) + (define-key bbdb-mode-map [(a)] 'bbdb-add-or-remove-mail-alias) + (define-key bbdb-mode-map [(e)] 'bbdb-edit-current-field) + (define-key bbdb-mode-map [(n)] 'bbdb-next-record) + (define-key bbdb-mode-map [(p)] 'bbdb-prev-record) + (define-key bbdb-mode-map [(d)] 'bbdb-delete-current-field-or-record) + (define-key bbdb-mode-map [(control k)] 'bbdb-delete-current-field-or-record) + (define-key bbdb-mode-map [(control o)] 'bbdb-insert-new-field) + (define-key bbdb-mode-map [(s)] 'bbdb-save-db) + (define-key bbdb-mode-map [(control x) (control s)] + 'bbdb-save-db) + (define-key bbdb-mode-map [(r)] 'bbdb-refile-record) + (define-key bbdb-mode-map [(t)] 'bbdb-toggle-records-display-layout) + (define-key bbdb-mode-map [(T)] 'bbdb-display-record-completely) + (define-key bbdb-mode-map [(o)] 'bbdb-omit-record) + (define-key bbdb-mode-map [(?\;)] 'bbdb-record-edit-notes) + (define-key bbdb-mode-map [(m)] 'bbdb-send-mail) + (define-key bbdb-mode-map "\M-d" 'bbdb-dial) + (define-key bbdb-mode-map [(f)] 'bbdb-finger) + (define-key bbdb-mode-map [(F)] 'bbdb-ftp) + (define-key bbdb-mode-map [(i)] 'bbdb-info) + (define-key bbdb-mode-map [(??)] 'bbdb-help) + (define-key bbdb-mode-map [(q)] 'bbdb-bury-buffer) + (define-key bbdb-mode-map [(control x) (control t)] + 'bbdb-transpose-fields) + (define-key bbdb-mode-map [(w)] 'bbdb-www) + (define-key bbdb-mode-map [(W)] 'bbdb-whois) + (define-key bbdb-mode-map [(P)] 'bbdb-print) + (define-key bbdb-mode-map [(h)] 'other-window) + (define-key bbdb-mode-map [(=)] 'delete-other-windows) + (define-key bbdb-mode-map [(c)] 'bbdb-create) + (define-key bbdb-mode-map [(C)] 'bbdb-changed) + (define-key bbdb-mode-map [(b)] 'bbdb) + + (define-key bbdb-mode-map [delete] 'scroll-down) + (define-key bbdb-mode-map " " 'scroll-up) + ) + + +;;; Support for the various Emacsen. This is for features that the +;;; BBDB adds to itself for different Emacsen. For definitions of +;;; functions that aren't present in various Emacsen (for example, +;;; cadr for Emacs 19.34), see below +(when (string-match "XEmacs\\|Lucid" emacs-version) + ;; Above + (fset 'bbdb-warn 'warn) + + ;; bbdb-com.el + (fset 'bbdb-display-completion-list 'bbdb-xemacs-display-completion-list)) + +(defun bbdb-insinuate-sendmail () + "Call this function to hook BBDB into sendmail (that is, M-x mail)." + (define-key mail-mode-map "\M-\t" 'bbdb-complete-name)) + +;;;###autoload +(defun bbdb-insinuate-message () + "Call this function to hook BBDB into `message-mode'." + (define-key message-mode-map "\M-\t" 'bbdb-complete-name)) + +;;; Erm. says here that (require...) can take a noerror flag; why do +;;; we have this function? +(defmacro safe-require (thing) + (list 'condition-case nil (list 'require thing) '(file-error nil))) + +;; Wrappers for things that change for different Emacsen. Note: This +;; is for things that get redefined that don't belong elsewhere. Some +;; functions that get redefined live elsewhere in the source because +;; it makes sense to put them there. + +(defun bbdb-warn (&rest args) + (beep 1) + (apply 'message args)) + + +(provide 'bbdb) ; provide before loading things which might require + +(run-hooks 'bbdb-load-hook) diff --git a/misc/bbdb-unmigrate-stuff.el b/misc/bbdb-unmigrate-stuff.el new file mode 100644 index 0000000..9400eac --- /dev/null +++ b/misc/bbdb-unmigrate-stuff.el @@ -0,0 +1,53 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is part of the Insidious Big Brother Database (aka BBDB), +;;; Copyright (c) 2000 Alex Schroeder +;;; +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(defun bbdb-unmigrate-stuff (&optional new-version) + "Create a buffer with unmigrated BBDB data. +Usefull if you fooled around with BBDB file format 4 by Alex and want to +start using the official BBDB 2.00.06 again. In order to do that, you +have to save your .bbdb in BBDB file format 3 instead of the file format 4 +introduced by Alex. This function will create a *BBDB Version 3* buffer +for you, which you can examine and save as your new .bbdb. The unmigration +will strip the country fields of all entries in your BBDB as such a field +did not exist in the BBDB file format 3 used in BBDB 2.00.06." + (interactive "nUnmigrate to version (I recommend version 3): ") + (if (null new-version) + (setq new-version 3)) + (if (>= new-version bbdb-file-format) + (error "Current BBDB file format is version %d" bbdb-file-format) + (let* ((records (bbdb-records)) + (propnames (bbdb-with-db-buffer bbdb-propnames)) + (rec) + (bbdb-file-format-migration (cons bbdb-file-format new-version)) + (buf (get-buffer-create (format "*BBDB Version %d*" (cdr bbdb-file-format-migration))))) + (message "Unconverting the BBDB database...") + (set-buffer buf) + (erase-buffer) + (insert (format (concat ";;; file-version: %d\n" + ";;; user-fields: %S\n") + new-version (mapcar (function (lambda (x) (intern (car x)))) + propnames))) + (while records + (setq rec (copy-sequence (car records))) + (bbdb-unmigrate-record rec) + (aset rec 8 nil) + (insert (format "%S\n" rec)) + (setq records (cdr records))) + (pop-to-buffer buf) + (message "Unconverting the BBDB database...done")))) diff --git a/misc/bbdb_gnus-summary-get-author.fig b/misc/bbdb_gnus-summary-get-author.fig new file mode 100644 index 0000000..fbd6764 --- /dev/null +++ b/misc/bbdb_gnus-summary-get-author.fig @@ -0,0 +1,151 @@ +#FIG 3.1 +Landscape +Center +Inches +1200 2 +6 3975 2700 5025 3750 +2 3 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 + 5025 3225 4500 2700 3975 3225 4500 3750 5025 3225 +4 1 -1 0 0 0 12 0.0000 4 180 420 4500 3060 prefer\001 +4 1 -1 0 0 0 12 0.0000 4 135 255 4500 3300 real\001 +4 1 -1 0 0 0 12 0.0000 4 90 450 4500 3540 names\001 +-6 +6 3975 4200 5025 5250 +2 3 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 + 5025 4725 4500 4200 3975 4725 4500 5250 5025 4725 +4 1 -1 0 0 0 12 0.0000 4 135 135 4500 4620 in\001 +4 1 -1 0 0 0 12 0.0000 4 135 495 4500 4860 BBDB\001 +-6 +6 6300 1725 7350 2775 +2 3 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 + 7350 2250 6825 1725 6300 2250 6825 2775 7350 2250 +4 1 -1 0 0 0 12 0.0000 4 135 360 6825 2340 bbdb\001 +4 1 -1 0 0 0 12 0.0000 4 135 285 6825 2580 data\001 +4 1 -1 0 0 0 12 0.0000 4 180 420 6825 2100 prefer\001 +-6 +6 2025 4200 3075 5250 +2 3 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 + 3075 4725 2550 4200 2025 4725 2550 5250 3075 4725 +4 1 -1 0 0 0 12 0.0000 4 135 135 2550 4620 in\001 +4 1 -1 0 0 0 12 0.0000 4 135 495 2550 4860 BBDB\001 +-6 +6 900 5625 1950 6675 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 900 5625 1950 5625 1950 6675 900 6675 900 5625 +4 1 -1 0 0 0 12 0.0000 4 135 345 1425 6180 from\001 +4 1 -1 0 0 0 12 0.0000 4 90 375 1425 5940 name\001 +4 1 -1 0 0 0 12 0.0000 4 135 450 1425 6435 record\001 +-6 +6 2025 5625 3075 6675 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 2025 5625 3075 5625 3075 6675 2025 6675 2025 5625 +4 1 -1 0 0 0 12 0.0000 4 90 375 2550 5925 name\001 +4 1 -1 0 0 0 12 0.0000 4 135 345 2550 6165 from\001 +4 1 -1 0 0 0 12 0.0000 4 135 600 2550 6405 message\001 +-6 +6 5850 4200 6900 5250 +2 3 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 + 6900 4725 6375 4200 5850 4725 6375 5250 6900 4725 +4 1 -1 0 0 0 12 0.0000 4 135 135 6375 4620 in\001 +4 1 -1 0 0 0 12 0.0000 4 135 495 6375 4860 BBDB\001 +-6 +6 5850 5625 6900 6675 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 5850 5625 6900 5625 6900 6675 5850 6675 5850 5625 +4 1 -1 0 0 0 12 0.0000 4 135 465 6375 5910 1st net\001 +4 1 -1 0 0 0 12 0.0000 4 135 345 6375 6150 from\001 +4 1 -1 0 0 0 12 0.0000 4 135 450 6375 6405 record\001 +-6 +6 6975 5625 8025 6675 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 6975 5625 8025 5625 8025 6675 6975 6675 6975 5625 +4 1 -1 0 0 0 12 0.0000 4 120 405 7500 5835 net or\001 +4 1 -1 0 0 0 12 0.0000 4 165 705 7500 6075 (if no net)\001 +4 1 -1 0 0 0 12 0.0000 4 135 765 7500 6315 name from\001 +4 1 -1 0 0 0 12 0.0000 4 135 600 7500 6555 message\001 +-6 +6 10575 5625 11625 6675 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 10575 5625 11625 5625 11625 6675 10575 6675 10575 5625 +4 1 -1 0 0 0 12 0.0000 4 120 405 11100 5835 net or\001 +4 1 -1 0 0 0 12 0.0000 4 165 705 11100 6075 (if no net)\001 +4 1 -1 0 0 0 12 0.0000 4 135 765 11100 6315 name from\001 +4 1 -1 0 0 0 12 0.0000 4 135 600 11100 6555 message\001 +-6 +6 9450 2700 10500 3750 +2 3 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 + 10500 3225 9975 2700 9450 3225 9975 3750 10500 3225 +4 1 -1 0 0 0 12 0.0000 4 180 420 9975 3060 prefer\001 +4 1 -1 0 0 0 12 0.0000 4 135 255 9975 3300 real\001 +4 1 -1 0 0 0 12 0.0000 4 90 450 9975 3540 names\001 +-6 +6 8325 5625 9375 6675 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 8325 5625 9375 5625 9375 6675 8325 6675 8325 5625 +4 1 -1 0 0 0 12 0.0000 4 90 375 8850 5925 name\001 +4 1 -1 0 0 0 12 0.0000 4 135 345 8850 6165 from\001 +4 1 -1 0 0 0 12 0.0000 4 135 600 8850 6405 message\001 +-6 +6 9450 5625 10500 6675 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 9450 5625 10500 5625 10500 6675 9450 6675 9450 5625 +4 1 -1 0 0 0 12 0.0000 4 120 210 9975 5940 net\001 +4 1 -1 0 0 0 12 0.0000 4 135 345 9975 6180 from\001 +4 1 -1 0 0 0 12 0.0000 4 135 600 9975 6420 message\001 +-6 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 4500 2700 4500 2250 6300 2250 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 3975 3225 2550 3225 2550 4200 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 4500 3750 4500 4200 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 5025 3225 6375 3225 6375 4200 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 7350 2250 9975 2250 9975 2700 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 6900 4725 7500 4725 7500 5625 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 2025 4725 1425 4725 1425 5625 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 6375 5250 6375 5625 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 3975 4725 3900 4725 3900 5625 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 5025 4725 5100 4725 5100 5625 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 2550 5250 2550 5625 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 8850 5625 8850 3225 9450 3225 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 9975 3750 9975 5625 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 + 11100 5625 11100 3225 10500 3225 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 6825 1725 6825 1050 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 3375 5625 4425 5625 4425 6675 3375 6675 3375 5625 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 4500 5625 5550 5625 5550 6675 4500 6675 4500 5625 +4 1 -1 0 0 0 12 0.0000 4 135 360 4275 4050 bbdb\001 +4 1 -1 0 0 0 12 0.0000 4 120 45 6225 5475 t\001 +4 1 -1 0 0 0 12 0.0000 4 135 180 2400 5535 nil\001 +4 1 -1 0 0 0 12 0.0000 4 135 180 5175 4635 nil\001 +4 1 -1 0 0 0 12 0.0000 4 135 360 9750 4050 bbdb\001 +4 1 -1 0 0 0 12 0.0000 4 120 45 9300 3150 t\001 +4 1 -1 0 0 0 12 0.0000 4 135 180 10650 3135 nil\001 +4 1 -1 0 0 0 12 0.0000 4 120 45 1950 4650 t\001 +4 1 -1 0 0 0 12 0.0000 4 120 45 3900 4650 t\001 +4 1 -1 0 0 0 12 0.0000 4 120 45 3900 3150 t\001 +4 1 -1 0 0 0 12 0.0000 4 135 180 5175 3135 nil\001 +4 1 -1 0 0 0 12 0.0000 4 135 555 6000 2175 non-nil\001 +4 1 -1 0 0 0 12 0.0000 4 135 180 7500 2160 nil\001 +4 1 -1 0 0 0 12 0.0000 4 135 180 7050 4635 nil\001 +4 1 -1 0 0 0 24 0.0000 4 315 4815 6825 825 bbdb/gnus-summary-get-author\001 +4 2 -1 0 0 0 12 0.0000 4 180 5490 11625 7200 bbdb/gnus-summary-get-author 1998-Feb-22 bbdb-gnus.el version 1.58\001 +4 1 -1 0 0 0 12 0.0000 4 135 345 3900 6180 from\001 +4 1 -1 0 0 0 12 0.0000 4 135 345 5025 6165 from\001 +4 1 -1 0 0 0 12 0.0000 4 135 600 5025 6405 message\001 +4 1 -1 0 0 0 12 0.0000 4 90 375 3900 5940 name\001 +4 1 -1 0 0 0 12 0.0000 4 135 450 3900 6420 record\001 +4 1 -1 0 0 0 12 0.0000 4 120 210 5025 5925 net\001 diff --git a/testing/.gitignore b/testing/.gitignore new file mode 100644 index 0000000..5fc607b --- /dev/null +++ b/testing/.gitignore @@ -0,0 +1 @@ +/Makefile diff --git a/testing/Makefile.in b/testing/Makefile.in new file mode 100644 index 0000000..85d2c22 --- /dev/null +++ b/testing/Makefile.in @@ -0,0 +1,8 @@ +all: bbdb-test-results + +bbdb-test-results: ../lisp bbdb-test.el + @EMACS_PROG@ -no-site-file -no-init-file -batch -l run-tests.el >/dev/null 2>&1 + @if @GREP@ FAILED bbdb-test-results >/dev/null 2>&1; then echo "Tests failed:"; @GREP@ @GREPCONTEXT@ -n FAILED bbdb-test-results; else echo "All tests succeeded"; fi + +clean: + @RM@ bbdb-test-results diff --git a/testing/bbdb-test b/testing/bbdb-test new file mode 100644 index 0000000..86688df --- /dev/null +++ b/testing/bbdb-test @@ -0,0 +1,7 @@ +;;; file-version: 6 +;;; user-fields: (mail-alias mailer lastmail vm-folder www dir birthday vm-virtual) +["Robert" "Fenk" nil "RML" nil nil ("fenk@users.sourceforge.net" "Robert.Fenk@gmx.de" "Robert.Fenk@forwiss.de") ((creation-date . "2002-01-16") (timestamp . "2002-01-17")) nil] +["First" "Last" nil nil nil nil ("First.Last@location1.org" "first.last@location2.org") ((creation-date . "2002-03-12") (timestamp . "2002-03-12")) nil] +["Ronan" "Waide" ("Raider") "BBDB" (["Inter" "+111-22-333-4444"] ["National" "022-333-4444"] ["Local" "333-4444"]) nil ("waider@waider.ie" "waider@dspsrv.com" "Ronan.Waide@euroconex.com") ((creation-date . "2002-01-16") (timestamp . "2002-01-17")) nil] +["Jamie" "Zawinski" nil "Xemacs" nil nil ("jwz@jwz.org") ((creation-date . "2002-01-16") (timestamp . "2002-01-16")) nil] +["First" "Second" nil nil nil nil ("First.Second@location1.org" "first.second@location2.org") ((creation-date . "2002-03-12") (timestamp . "2002-03-12")) nil] diff --git a/testing/bbdb-test.el b/testing/bbdb-test.el new file mode 100644 index 0000000..0eaf156 --- /dev/null +++ b/testing/bbdb-test.el @@ -0,0 +1,676 @@ +;; Testing +;; +;; This is a rough start on a test harness for BBDB. It attempts to +;; get around the interactive nature of BBDB in order to allow batch +;; testing. Eventually, there will be a 'make test' target, which +;; verifies that the changes you've just made haven't killed some +;; other part of BBDB. +;; +;; Use the function bbdb-test/switch-to-test-bbdb to use the BBDB with the +;; default test cases and exit-recursive-edit to come back to the original +;; BBDB. Eventually this should happen automatically, but it is nice to edit +;; the test BBDB also manually. +;; +;; Authors: Waider & Robert Fenk +;; +;; This stuff doesn't get included in the tarball. + +(require 'cl) ;; for flet +(require 'bbdb) +(require 'bbdb-snarf) ;; should be autoloaded, I'm sure. + +(defvar bbdb-test/bbdb-file + (expand-file-name + "bbdb-test" + (file-name-directory + (or (locate-library "bbdb-test") + (concat (getenv "HOME") "/src/emacs/bbdb/testing/bbdb-test"))))) + +(defun bbdb-test/initialize () + (setq bbdb-file bbdb-test/bbdb-file) + (bbdb-initialize)) + +(defvar bbdb-test/log-buffer "*BBDB Test Results*") + +(defun bbdb-test/log-buffer () + "Return log buffer. +When it does not existm, create one an setup the key bindings." + (let ((buf (get-buffer bbdb-test/log-buffer))) + (when (not buf) + (setq buf (get-buffer-create bbdb-test/log-buffer)) + (set-buffer buf) + (local-set-key "r" 'bbdb-test/run-tests) + (local-set-key "a" 'bbdb-test/run-all-tests) + (local-set-key "o" 'bbdb-test/run-one-test) + (local-set-key "s" 'bbdb-test/set-test-vars) + (local-set-key "c" 'bbdb-test/log-clear) + (local-set-key "q" 'kill-buffer)) + buf)) + +(defun bbdb-test/log-result (format &rest rest) + (save-excursion + (set-buffer (bbdb-test/log-buffer)) + (goto-char (point-max)) + (insert (apply 'format format rest)))) + +(defun bbdb-test/log-clear () + (save-excursion + (let ((buf (bbdb-test/log-buffer))) + (set-buffer buf) + (erase-buffer) + (pop-to-buffer buf) + buf))) + +(defun bbdb-test/kill-bbdb-buffers (bbdb-file) + (bbdb-save-db) + (if bbdb-buffer + (kill-buffer bbdb-buffer)) + (if (get-file-buffer bbdb-buffer-name) + (kill-buffer (get-file-buffer bbdb-buffer-name))) + (if (get-file-buffer bbdb-file) + (kill-buffer (get-file-buffer bbdb-file)))) + +(defun bbdb-test/switch-to-test-bbdb () + "Edit the test BBDB" + (interactive) + (let ((old-bbdb-file (expand-file-name bbdb-file)) + (bbdb-file (expand-file-name bbdb-test/bbdb-file))) + + ;; cleanup for normal BBDB + (bbdb-test/kill-bbdb-buffers old-bbdb-file) + + ;; now care for test BBDB + (condition-case err + (progn + (bbdb-initialize) + (message "recursive-edit of BBDB %s" + (abbreviate-file-name bbdb-file)) + (recursive-edit) + (bbdb-test/kill-bbdb-buffers bbdb-file) + (message "Returned to BBDB %s" + (abbreviate-file-name old-bbdb-file))) + (error + (bbdb-test/kill-bbdb-buffers bbdb-file) + (message "Returned to BBDB %s due to %s" + (abbreviate-file-name old-bbdb-file) + err)) + (quit + (bbdb-test/kill-bbdb-buffers bbdb-file) + (message "Returned to BBDB %s due to %s" + (abbreviate-file-name old-bbdb-file) + err))))) + +(defvar bbdb-test/test-vars nil + "User defined list of tests.") + +(defvar bbdb-test/batchmode nil + "Batchmode active?") + +(defun bbdb-test/test-vars (&optional matching) + "Return all test variables. +I.e. those matching \"^bbdb-test/.+$\" which have a documentation +starting with \"Test\"" + (or bbdb-test/test-vars + (apropos-internal + (format "^bbdb-test/%s$" (if matching (concat ".*" matching ".*") ".+")) + (lambda (s) (and (symbolp s) + (boundp s) + (documentation-property s 'variable-documentation) + (string-match "^Test" + (documentation-property + s + 'variable-documentation) + )))))) + +(defun bbdb-test/set-test-vars (matching) + (interactive "sRegexp for BBDB tests: ") + (setq matching (or matching (bbdb-string-trim matching))) + (if (string= "" matching) (setq matching nil)) + (setq bbdb-test/test-vars nil) + (bbdb-test/log-clear) + (if (not matching) + (bbdb-test/log-result "All test will be performed!\n") + (setq bbdb-test/test-vars (bbdb-test/test-vars matching)) + (bbdb-test/log-result "Test vars are:\n") + (mapcar (lambda (v) (bbdb-test/log-result "\t%s\n" (symbol-name v))) + bbdb-test/test-vars))) + +;;;###autoload +(defun bbdb-test/run-all-tests(&optional batch) + "Run all BBDB tests." + (interactive) + (let (bbdb-test/test-vars + (bbdb-test/batchmode batch)) + (bbdb-test/run-tests) + (and bbdb-test/batchmode + (set-buffer (bbdb-test/log-buffer)) + (write-file "bbdb-test-results")))) + +;;;###autoload +(defun bbdb-test/run-tests () + "Run BBDB tests." + (interactive) + (let ((test-vars (bbdb-test/test-vars))) + + (bbdb-initialize) + (bbdb-test/log-clear) + (bbdb-test/log-result "Testing started at %s\n\n" + (current-time-string)) + + (while test-vars + (bbdb-test/run-one-test (car test-vars)) + (setq test-vars (cdr test-vars))))) + +(defmacro bbdb-test/with-var-set (var value &rest body) + (append (list 'let (list (list (symbol-value var) value))) + body)) + +;;;###autoload +(defun bbdb-test/run-one-test (test-var) + (interactive + (list + (intern (completing-read "Enter a variable to test: " + (mapcar (lambda (v) (list (symbol-name v))) + (bbdb-test/test-vars)) + nil t)))) + (or (string-match "^bbdb-test/" (symbol-name test-var)) + (setq test-var (intern (concat "bbdb-test/" (symbol-name test-var))))) + (let ((bbdb-var (intern (substring (symbol-name test-var) 10))) + (vals (symbol-value test-var)) + test-func) + + ;; Peel the test function off the top of the variable, and + ;; adjust the variable upward. + (setq test-func (car vals) + vals (cdr vals)) + + (bbdb-test/log-result "Testing %s\n using\t%s:\n\n" + bbdb-var test-func) + + (while vals + (let* ((current-test-data (car vals)) + (val (car current-test-data)) + (par (cdr current-test-data))) + ;; ick. Hope you weren't using this. + (bbdb-test/with-var-set + bbdb-var val + (bbdb-test/log-result " %s:\n" (symbol-value bbdb-var)) + + (if par + (while par + (bbdb-test/log-result "\t%s\n" + (apply test-func (car par))) + (setq par (cdr par))) + (funcall test-func))) + + (bbdb-test/log-result "\n")) + + ;; next set of values + (setq vals (cdr vals))) + + (bbdb-test/log-result "Completed testing of %s.\n%s\n" + bbdb-var (make-string 79 ?-)))) + + +;; Coverage guestimation (VARIABLES ONLY; turns up a few false ones) +(defun bbdb-test/guestimate-coverage () + (interactive) + (let* ((vars (apropos-internal "^bbdb-.*$" + (lambda (s) + (and (symbolp s) + (not (fboundp s)) + (not (string-match + "^bbdb-test" + (symbol-name s))))))) + (tests (apropos-internal "^bbdb-test/.*$" + (lambda (s) (and (symbolp s) + (not (fboundp s)))))) + (cov (* 100 (/ (float (length tests)) (float (length vars)))))) + (message "coverage: %d of %d variables (%0.2f%%)" (length tests) + (length vars) cov) + cov)) + + +;;; These are test-harness functions for BBDB functionality +;;; +;;; Test BBDB's completion +(defun bbdb-test/bbdb-complete-name (input output ocompletions) + (let ((bbdb-complete-name-allow-cycling t) ;; some test cases + (bbdb-dwim-net-address-allow-redundancy nil) ;; need this + bbdb-completion-display-record + result completions) + + ;; Try completing + (with-current-buffer (get-buffer-create "*BBDB_TEST*") + (erase-buffer) + (insert input) + + ;; Try completion. Disable beeping so that we don't get noise + ;; while testing uncompletables. + (flet ((beep nil ()) + (ding nil ()) + ;; Hack to get around interactivity + (bbdb-display-completion-list + (list &optional cb data) + (setq completions list))) + (save-excursion + (bbdb-complete-name))) + + (setq result (buffer-substring (point-min) (point-max))) + + (if (get-buffer-window "*Completions*") + (kill-buffer "*Completions*")) + + ;; Check the output + (if (and (equal result output) + (equal completions ocompletions)) + (format "PASSED %S => %S" input output) + (format "FAILED %S =>\n\t got %S %S\n\t expected %S %S" input + result completions + output ocompletions))))) + +;;; Test BBDB parsing of email addresses +(defun bbdb-test/bbdb-extract-address-components (input output) + "Test suite for BBDB developers internal use." + (let (parsed) + (setq parsed (funcall bbdb-extract-address-components-func input t)) + (if (and parsed (equal output parsed)) + (format "PASSED %S => \n\t\t%S" input parsed) + (format "FAILED got `%S' expected `%S'" parsed output)))) + +;; Test username-cleaning-function +;; This function doesn't depend on any variables. +;; XXX fix the test harness to not require a variable to frob! +(defun bbdb-test/bbdb-clean-username (input output) + (let ((result (bbdb-clean-username input))) + (if (and result (equal output result)) + (format "PASSED %S => \n\t\t%S" input result) + (format "FAILED got `%S' expected `%S'" result output)))) + + +;; These are setup variables for the testing +(defvar bbdb-test/bbdb-clean-username-dummy + '(bbdb-test/bbdb-clean-username + (nil ("Ronan Waide" "Ronan Waide") + ("Forrester Research, Inc." "Forrester Research, Inc") + ("Ronan Waide ext 5781" "Ronan Waide") + ("Ronan Waide (Just This Guy)" "Ronan Waide") + )) + "Test") + +;; Dialing tests +;; This is for low-level testing directly via bbdb-dial-number +(defun bbdb-test/bbdb-dial-number(input output) + (let ((bbdb-modem-dial (or bbdb-modem-dial "")) + (bbdb-modem-device (make-temp-name "bbdb-dial")) + result) + (if (file-exists-p bbdb-modem-device) + (delete-file bbdb-modem-device)) ;; so we don't get false negatives + (flet ((bbdb-next-event nil ())) ;; don't wait + (bbdb-dial-number input)) + (save-excursion + (let ((buf (find-file bbdb-modem-device))) + (setq result (buffer-substring (point-min) (point-max))) + (kill-buffer buf))) + (if (file-exists-p bbdb-modem-device) (delete-file bbdb-modem-device)) + (if (and result (equal output result)) + (format "PASSED %S => \n\t\t%S" input result) + (format "FAILED %S => got `%S' expected `%S'" input result output)))) + +;; This is for high-level testing via the bbdb-dial UI +(defun bbdb-test/bbdb-dial(input output) + (let ((bbdb-modem-dial "") + (bbdb-modem-device (make-temp-name "bbdb-dial")) + result) + + ;; prevent these guys from interfering with other tests that use + ;; this code + (or (eq bbdb-var 'bbdb-default-area-code) + (setq bbdb-default-area-code nil)) + (or (eq bbdb-var 'bbdb-dial-local-prefix-alist) + (if (eq bbdb-var 'bbdb-default-area-code) + () ;; bbdb-default-area-code cascades into + ;; bbdb-dial-local-prefix-alist + (setq bbdb-dial-local-prefix-alist nil))) + + + (if (file-exists-p bbdb-modem-device) (delete-file bbdb-modem-device)) + (flet ((bbdb-next-event nil ())) + (save-excursion + (bbdb-display-records (bbdb-records)) + (set-buffer bbdb-buffer-name) + (goto-char (point-min)) + (re-search-forward input) + (call-interactively 'bbdb-dial))) + (save-excursion + (let ((buf (find-file bbdb-modem-device))) + (setq result (buffer-substring (point-min) (point-max))) + (kill-buffer buf))) + (if (file-exists-p bbdb-modem-device) (delete-file bbdb-modem-device)) + (if (and result (equal output result)) + (format "PASSED %S => \n\t\t%S" input result) + (format "FAILED %S => got `%S' expected `%S'" input result output)))) + +(defvar bbdb-test/bbdb-modem-dial + '(bbdb-test/bbdb-dial-number + (nil ("012345678" "012345678;\nATH\n")) + ("ATDT" ("012345678" "ATDT012345678;\nATH\n")) + ("ATDP" ("012345678" "ATDP012345678;\nATH\n"))) + "Test") + +;; XXX input number is taken from the BBDB for these tests; input +;; parameter is used to decide which phone number to use. +(defvar bbdb-test/bbdb-default-area-code + '(bbdb-test/bbdb-dial + (nil ("national" "0223334444;\nATH\n")) + ("022" ("national" "3334444;\nATH\n")) ;; 022 is our dummy area code + ) + "Test") + +(defvar bbdb-test/bbdb-dial-local-prefix-alist + '(bbdb-test/bbdb-dial + (nil ("national" "0223334444;\nATH\n")) + ((("022" "")) ("national" "3334444;\nATH\n")) + ((("022" "021")) ("national" "0213334444;\nATH\n")) + ) + "Test") + +(defvar bbdb-test/bbdb-dial-local-prefix + '(bbdb-test/bbdb-dial + (nil ("national" "0223334444;\nATH\n")) + ("9" ("national" "90223334444;\nATH\n")) + ) + "Test") + +(defvar bbdb-test/bbdb-dial-long-distance-prefix + '(bbdb-test/bbdb-dial + (nil ("inter" "111223334444;\nATH\n")) + ("00" ("inter" "00,111223334444;\nATH\n")) ;; comma is wacky, but hey. + ) + "Test") + +;; End of dialing tests +;; IGNORING: bbdb-sound-player, bbdb-sound-files, bbdb-sound-volume +;; (not dialing, strictly speaking, except for the sound-files array) + +(defvar bbdb-test/bbdb-extract-address-components-func + (let ((test-cases '(("Robert Fenk <fenk@users.sourceforge.net>" + (("Robert Fenk" "fenk@users.sourceforge.net"))) + ("\"Robert Fenk, Jr\" <fenk@users.sourceforge.net>" + (("Robert Fenk, Jr." "fenk@users.sourceforge.net"))) + ("<fenk@users.sourceforge.net>" + ((nil "fenk@users.sourceforge.net"))) + ("\"Fenk, Robert\" <fenk@users.sourceforge.net>" + (("Robert Fenk" "fenk@users.sourceforge.net"))) + ("fenk@users.sourceforge.net (Robert Fenk)" + (("Robert Fenk" "fenk@users.sourceforge.net"))) + ("fenk@users.sourceforge.net (Robert Fenk, Jr)" + (("Robert Fenk, Jr." "fenk@users.sourceforge.net"))) + ("Robert.Fenk@users.sourceforge.net" + (("Robert Fenk" "Robert.Fenk@users.sourceforge.net"))) + ("<fenk@gmx.de>, fenk@web.de" + ((nil "fenk@gmx.de") (nil "fenk@web.de"))) + ))) + (list 'bbdb-test/bbdb-extract-address-components + (cons 'bbdb-rfc822-addresses test-cases) + (cons 'bbdb-extract-address-components test-cases))) + "Test") + +;; Things to test bbdb-completion-type with +(defvar bbdb-test/bbdb-completion-type + '(bbdb-test/bbdb-complete-name ;; test function + ;; variable setting, (input output completions) + + ;; With completion-type set to nil, completion happens across all + ;; names and all email addresses. + + ;; multiple completions, but all in the same record should result + ;; in the first mail address in that record. + (nil ("waider" + "Ronan Waide <waider@waider.ie>" + nil) + ;; completing a completed record should cycle to the next + ;; email address. + ("Ronan Waide <waider@waider.ie>" + "Ronan Waide <waider@dspsrv.com>" + nil) + ;; completing on the name should return the first email + ;; address + ("ronan waide" + "Ronan Waide <waider@waider.ie>" + nil) + ;; completing on a unique email address should return that + ;; email address + ("ronan.waide" + "Ronan.Waide@euroconex.com" + nil) + ;; completing on a username vs. a name + ("Ronan." + "Ronan.Waide@euroconex.com" + nil) + ;; unique email address + ("Robert.Fenk@g" + "Robert.Fenk@gmx.de" + nil) + ;; unique email address, case insensitive. again, + ;; single-record match. + ("Robert.Fenk" + "Robert.Fenk@gmx.de" + nil) + ;; unique email address + ("jwz" + "Jamie Zawinski <jwz@jwz.org>" + nil)) + + ;; When set to 'name, completion should only occur on the NAME + ;; field + (name ("waider" + "waider" + nil) + ("ronan" + "Ronan Waide <waider@waider.ie>" + nil) + ("ronan waide" + "Ronan Waide <waider@waider.ie>" + nil)) + + ;; 'net => complete across NET field only + (net ("waider" + "Ronan Waide <waider@waider.ie>" + nil) + ("jwz" + "Jamie Zawinski <jwz@jwz.org>" + nil)) + + ;; only complete on the primary email address + (primary ("waider" + "Ronan Waide <waider@waider.ie>" + nil)) + + ;; complete on primary email address or name + (primary-or-name ("waider" + "Ronan Waide <waider@waider.ie>" + nil) + ("ronan" + "Ronan Waide <waider@waider.ie>" + nil) + ("first" + "first" + ("First.Last@location1.org" "First.Second@location1.org"))) + + ;; same as above + (name-or-primary ("waider" + "Ronan Waide <waider@waider.ie>" + nil) + ("ronan" + "Ronan Waide <waider@waider.ie>" + nil))) + "Test") + +;; This is a list of **158** symbols defined in BBDB at present. Some +;; are obviously not actually variables and can be ignored. Mark the +;; variables done as they have test cases applied to them. Coverage +;; function above should probably use this to determine what can be +;; safely ignored. Additionally, I should load all the files before +;; generating a list like this and thinking it's definitive :) +;; +;; DISREGARD bbdb-test/bbdb- +;; INTERNAL ONLY bbdb-test/bbdb-address +;; DISREGARD bbdb-test/bbdb-address- +;; bbdb-test/bbdb-address-editing-function +;; bbdb-test/bbdb-address-formatting-alist +;; INTERNAL ONLY bbdb-test/bbdb-address-length +;; bbdb-test/bbdb-address-print-formatting-alist +;; bbdb-test/bbdb-addresses-label-list +;; bbdb-test/bbdb-after-change-hook +;; bbdb-test/bbdb-after-read-db-hook +;; bbdb-test/bbdb-alist-with-header +;; bbdb-test/bbdb-always-add-addresses +;; bbdb-test/bbdb-auto-revert-p +;; bbdb-test/bbdb-autoloads +;; bbdb-test/bbdb-buffer-name +;; bbdb-test/bbdb-buffers-with-message-caches +;; DISREGARD bbdb-test/bbdb-cache- +;; bbdb-test/bbdb-cache-length +;; bbdb-test/bbdb-canonicalize-net-hook +;; bbdb-test/bbdb-canonicalize-redundant-nets-p +;; bbdb-test/bbdb-case-fold-search +;; bbdb-test/bbdb-change-hook +;; bbdb-test/bbdb-check-zip-codes-p +;; bbdb-test/bbdb-com +;; bbdb-test/bbdb-complete-name-allow-cycling +;; bbdb-test/bbdb-complete-name-full-completion +;; bbdb-test/bbdb-complete-name-hooks +;; bbdb-test/bbdb-complete-name-saved-window-config +;; bbdb-test/bbdb-completion-display-record +;; DONE bbdb-test/bbdb-completion-type +;; bbdb-test/bbdb-continental-zip-regexp +;; bbdb-test/bbdb-create-hook +;; INTERNAL bbdb-test/bbdb-cycling-exit +;; bbdb-test/bbdb-database +;; bbdb-test/bbdb-default-area-code +;; bbdb-test/bbdb-default-country +;; bbdb-test/bbdb-default-domain +;; bbdb-test/bbdb-default-label-list +;; bbdb-test/bbdb-define-all-aliases-field +;; DONE bbdb-test/bbdb-dial-local-prefix +;; DONE bbdb-test/bbdb-dial-local-prefix-alist +;; DONE bbdb-test/bbdb-dial-long-distance-prefix +;; bbdb-test/bbdb-display-buffer +;; bbdb-test/bbdb-display-layout +;; bbdb-test/bbdb-display-layout-alist +;; bbdb-test/bbdb-dwim-net-address-allow-redundancy +;; bbdb-test/bbdb-electric-completed-normally +;; bbdb-test/bbdb-electric-execute-me +;; bbdb-test/bbdb-electric-p +;; bbdb-test/bbdb-elided-display +;; bbdb-test/bbdb-end-marker +;; bbdb-test/bbdb-expand-mail-aliases +;; bbdb-test/bbdb-extract-address-component-handler +;; bbdb-test/bbdb-extract-address-component-ignore-regexp +;; bbdb-test/bbdb-extract-address-component-regexps +;; DONE bbdb-test/bbdb-extract-address-components-func +;; bbdb-test/bbdb-field +;; bbdb-test/bbdb-file +;; bbdb-test/bbdb-file-format +;; bbdb-test/bbdb-file-format-migration +;; bbdb-test/bbdb-file-remote +;; bbdb-test/bbdb-file-remote-save-always +;; bbdb-test/bbdb-finger-buffer-name +;; bbdb-test/bbdb-finger-host-field +;; bbdb-test/bbdb-force-dialog-boxes +;; bbdb-test/bbdb-gag-messages +;; bbdb-test/bbdb-get-addresses-headers +;; bbdb-test/bbdb-get-only-first-address-p +;; bbdb-test/bbdb-gui +;; bbdb-test/bbdb-hashtable-size +;; bbdb-test/bbdb-hooks +;; bbdb-test/bbdb-info-file +;; bbdb-test/bbdb-init-forms +;; bbdb-test/bbdb-initialize-hook +;; bbdb-test/bbdb-inside-electric-display +;; bbdb-test/bbdb-insinuate-sc +;; bbdb-test/bbdb-legal-zip-codes +;; bbdb-test/bbdb-list-hook +;; bbdb-test/bbdb-load-hook +;; bbdb-test/bbdb-message-cache +;; bbdb-test/bbdb-message-caching-enabled +;; bbdb-test/bbdb-mode-hook +;; bbdb-test/bbdb-mode-map +;; bbdb-test/bbdb-modem-device +;; bbdb-test/bbdb-modem-dial +;; bbdb-test/bbdb-modified-p +;; bbdb-test/bbdb-mua-specific +;; bbdb-test/bbdb-mua-specific-gnus +;; bbdb-test/bbdb-mua-specific-gnus-scoring +;; bbdb-test/bbdb-mua-specific-gnus-splitting +;; bbdb-test/bbdb-mua-specific-vm +;; bbdb-test/bbdb-name-gubbish +;; bbdb-test/bbdb-new-nets-always-primary +;; bbdb-test/bbdb-no-duplicates-p +;; bbdb-test/bbdb-north-american-phone-numbers-p +;; bbdb-test/bbdb-notes-default-separator +;; bbdb-test/bbdb-notes-field +;; bbdb-test/bbdb-notes-sort-order +;; bbdb-test/bbdb-notice-auto-save-file +;; bbdb-test/bbdb-notice-hook +;; bbdb-test/bbdb-noticing-records +;; bbdb-test/bbdb-offer-to-create +;; bbdb-test/bbdb-phone- +;; bbdb-test/bbdb-phone-area-regexp +;; bbdb-test/bbdb-phone-dialing +;; bbdb-test/bbdb-phone-ext-regexp +;; bbdb-test/bbdb-phone-length +;; bbdb-test/bbdb-phone-main-regexp +;; bbdb-test/bbdb-phone-regexp-1 +;; bbdb-test/bbdb-phone-regexp-2 +;; bbdb-test/bbdb-phone-regexp-3 +;; bbdb-test/bbdb-phone-regexp-4 +;; bbdb-test/bbdb-phone-regexp-5 +;; bbdb-test/bbdb-phones-label-list +;; bbdb-test/bbdb-pop-up-display-layout +;; bbdb-test/bbdb-pop-up-elided-display +;; bbdb-test/bbdb-pop-up-target-lines +;; bbdb-test/bbdb-quiet-about-name-mismatches +;; bbdb-test/bbdb-read-addresses-with-completion-map +;; bbdb-test/bbdb-read-only-p +;; bbdb-test/bbdb-readonly-p +;; bbdb-test/bbdb-record +;; bbdb-test/bbdb-record- +;; bbdb-test/bbdb-record-creation +;; bbdb-test/bbdb-record-display +;; bbdb-test/bbdb-record-length +;; bbdb-test/bbdb-record-use +;; bbdb-test/bbdb-refile-notes-generate-alist +;; bbdb-test/bbdb-remaining-addrs-to-finger +;; bbdb-test/bbdb-save +;; bbdb-test/bbdb-save-db-timeout +;; bbdb-test/bbdb-saving +;; bbdb-test/bbdb-send-mail-style +;; bbdb-test/bbdb-showing-changed-ones +;; bbdb-test/bbdb-silent-running +;; bbdb-test/bbdb-snarf-phone-regexp +;; bbdb-test/bbdb-snarf-web-prop +;; bbdb-test/bbdb-snarf-zip-regexp +;; bbdb-test/bbdb-sound-files +;; bbdb-test/bbdb-sound-player +;; bbdb-test/bbdb-sound-volume +;; bbdb-test/bbdb-sounds-directory +;; bbdb-test/bbdb-suppress-changed-records-recording +;; bbdb-test/bbdb-time-display-format +;; bbdb-test/bbdb-update-address-class +;; bbdb-test/bbdb-update-address-header +;; bbdb-test/bbdb-update-records-mode +;; bbdb-test/bbdb-use-alternate-names +;; bbdb-test/bbdb-use-pop-up +;; bbdb-test/bbdb-utilities +;; bbdb-test/bbdb-utilities-finger +;; bbdb-test/bbdb-utilities-ftp +;; bbdb-test/bbdb-utilities-print +;; bbdb-test/bbdb-utilities-server +;; bbdb-test/bbdb-utilities-supercite +;; bbdb-test/bbdb-version-date +;; bbdb-test/bbdb-window +;; bbdb-test/bbdb-write-file-hooks + +(provide 'bbdb-test) diff --git a/testing/run-tests.el b/testing/run-tests.el new file mode 100644 index 0000000..f832127 --- /dev/null +++ b/testing/run-tests.el @@ -0,0 +1,7 @@ +(setq load-path (append (list "../lisp" ".") load-path)) +(setq make-backup-files nil) +(if (file-exists-p "bbdb-test-results") (delete-file + "bbdb-test-results")) +(require 'bbdb-test) +(bbdb-test/initialize) +(bbdb-test/run-all-tests 'batch) diff --git a/tex/.gitignore b/tex/.gitignore new file mode 100644 index 0000000..5fc607b --- /dev/null +++ b/tex/.gitignore @@ -0,0 +1 @@ +/Makefile diff --git a/tex/Makefile.in b/tex/Makefile.in new file mode 100644 index 0000000..0024b0a --- /dev/null +++ b/tex/Makefile.in @@ -0,0 +1,40 @@ +@SET_MAKE@ + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_DATA = @INSTALL_DATA@ + +RM = @RM@ +LN_S = @LN_S@ + +PACKAGEDIR = @PACKAGEDIR@ +SYMLINKS = @SYMLINKS@ +LINKPATH = @LINKPATH@ + +install-pkg: uninstall-pkg + @if test "x$(SYMLINKS)" = "xno" ; then \ + mkdir -p -m 0755 $(PACKAGEDIR)/etc/bbdb/tex ; \ + for i in `ls *.tex` ; do \ + $(INSTALL_DATA) $$i $(PACKAGEDIR)/etc/bbdb/tex/ ; \ + done ; \ + else \ + if test "x$(LINKPATH)" = "x" ; then \ + $(LN_S) `pwd` $(PACKAGEDIR)/etc/bbdb/tex ; \ + else \ + $(LN_S) $(LINKPATH)/tex $(PACKAGEDIR)/etc/bbdb/tex ; \ + fi ; \ + fi + +uninstall-pkg: + -$(RM) -r $(PACKAGEDIR)/etc/bbdb/tex + +clean: + +distclean: clean + +# Backward compatibility: +reallyclean: distclean + +cvsclean: distclean + -$(RM) Makefile diff --git a/tex/bbdb-cols.tex b/tex/bbdb-cols.tex new file mode 100644 index 0000000..4102d0f --- /dev/null +++ b/tex/bbdb-cols.tex @@ -0,0 +1,234 @@ +%%% bbdb-cols.tex - multiple columns per page, multiple pages per sheet. + +%%% Authors: Luigi Semenzato <luigi@paris.cs.berkeley.edu> +%%% Boris Goldowsky <boris@cs.rochester.edu> +%%% Copyright (C) 1993 Boris Goldowsky +%%% Version: 3.92; 5Jan95 + +%%% Commentary: +%%% +%%% Put \input bbdb-cols.tex +%%% at the beginning of your TeX file. +%%% Then \twocol, \threecol, or \fourcol for multi-column output +%%% or \gridformat (4x3 grid of small credit-card-sized pages) +%%% or \quadformat{xsize}{ysize} for four 2-column pages per sheet. +%%% In any case you will need to put \endcol at the end of the +%%% document, before \bye. + +%%% For instructions on using this format file with BBDB, see bbdb-print.el +%%% which should have come bundled with this file. The complete bbdb-print +%%% package is also available via anonymous ftp at: +%%% /cs.rochester.edu:/pub/u/boris/bbdb-print.tar.gz + +%%% This file is part of the bbdb-print extensions to the Insidious +%%% Big Brother Database, which is for use with GNU Emacs. +%%% +%%% This program 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 1, or +%%% (at your option) any later version. +%%% +%%% This program 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 GNU Emacs; see the file COPYING. If not, write to +%%% the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +\newdimen\colshsize \colshsize=\hsize +\newdimen\columngutter \columngutter=.2in % space between columns + +\newbox\columnA \newbox\columnB \newbox\columnC + +\newdimen\FULLHSIZE +\newdimen\FULLVSIZE +\newbox\quadrantbox +\newbox\firstquadrant \newbox\secondquadrant +\newbox\thirdquadrant \newbox\fourthquadrant +\newbox\row \newbox\page + +\def\columnbox{\leftline{\pagebody}} + +\def\colsline{\hbox to \colshsize} + +\newcount\NROW \NROW=3 % for grid format. are these really variables +\newcount\NCOL \NCOL=4 % that can be changed? should they be set + % from lisp? I'm not sure. +\newcount\rowindex \newcount\colindex + +\def\onecol % for consistency---or maybe one could use it for switching back. +{ + \output={\shipout\vbox{\makeheadline\colsline{\columnbox}\makefootline} + \advancepageno \ifnum\outputpenalty>-20000 \else\dosupereject\fi} + \def\endcol{} +}% end onecol + +\def\twocol +{ + \advance\hsize by -\columngutter + \divide\hsize 2 + \let\column=A + \output={\if A\column + \global\setbox\columnA=\columnbox \global\let\column=B + \else + \shipout\vbox{\makeheadline + \colsline{\box\columnA\hfil\columnbox} + \makefootline} + \advancepageno \global\let\column=A + \fi + \ifnum\outputpenalty>-20000 \else\dosupereject\fi} + + \def\endcol + { + \vfill\supereject\if A\column \else\null\vfill\eject\fi + } + +} % end twocol + +\def\threecol +{ + \advance\hsize -\columngutter + \advance\hsize -\columngutter + \divide\hsize 3 + \let\column=A + \output={\if A\column + \global\setbox\columnA=\columnbox \global\let\column=B + \else \if B\column + \global\setbox\columnB=\columnbox \global\let\column=C + \else + \shipout\vbox{\makeheadline + \colsline{\box\columnA\hfil\box\columnB + \hfil\columnbox} + \makefootline} + \advancepageno \global\let\column=A + \fi\fi + \ifnum\outputpenalty>-20000 \else\dosupereject\fi} + + \def\endcol + { + \if A\column + \null\vfill\eject\null\vfill\eject + \else\if B\column + \null\vfill\eject + \fi\fi + \vfill\supereject + } + +} % end threecol + +\def\fourcol +{ + \advance\hsize -3\columngutter + \divide\hsize 4 + \let\column=A + \output={\if A\column + \global\setbox\columnA=\columnbox \global\let\column=B + \else \if B\column + \global\setbox\columnB=\columnbox \global\let\column=C + \else \if C\column + \global\setbox\columnC=\columnbox \global\let\column=D + \else + \shipout\vbox + { \makeheadline + \colsline{\box\columnA\hfil\box\columnB\hfil + \box\columnC\hfil\columnbox} + \makefootline} + \advancepageno\global\let\column=A + \fi\fi\fi + \ifnum\outputpenalty>-20000 \else\dosupereject\fi + } + + \def\endcol + { + \vfill\supereject + \if A\column \else\null\vfill\eject\fi + \if B\column \else\null\vfill\eject\fi + \if C\column \else\null\vfill\eject\fi + } + +} % end fourcol + +\def\quadformat#1#2 +{ + \FULLHSIZE=\hsize + \FULLVSIZE=\vsize + + \colshsize=#1 + \vsize=#2 + + \hsize=\colshsize \advance\hsize by -.15in \divide\hsize 2 + + \let\lr=L + \let\quadrant=A + \output={\if L\lr + \global\setbox\columnA=\columnbox \global\let\lr=R + \else + \global\setbox\quadrantbox=\vbox{\colsline + {\box\columnA\hfil\columnbox}} \global\let\lr=L + \quadrantformat + \fi + \ifnum\outputpenalty>-20000 \else\dosupereject\fi} + + \def\quadrantformat + {\if A\quadrant + \global\setbox\firstquadrant=\box\quadrantbox + \global\let\quadrant=B + \else \if B\quadrant + \global\setbox\secondquadrant=\box\quadrantbox + \global\let\quadrant=C + \else \if C\quadrant + \global\setbox\thirdquadrant=\box\quadrantbox + \global\let\quadrant=D + \else + {\shipout + \vbox to \FULLVSIZE + {\FULLLINE{\box\firstquadrant\hfil\box\secondquadrant} + \vfill + \FULLLINE{\box\thirdquadrant\hfil\box\quadrantbox}}} + \global\let\quadrant=A + \advancepageno + \fi\fi\fi} + + \def\FULLLINE{\hbox to \FULLHSIZE} + + \def\endcol{\supereject\if R\lr \null\vfill\eject\fi} +} % end of quadformat + +\def\grid +{ + \def\rowspace{\vbox to 0.2in{}} + \def\colspace{\hbox to 0.2in{}} + + \hsize=1.5in + \vsize=2.9in + + \rowindex=0 \colindex=0 + + \setbox\row=\null \setbox\page=\null + + \output={\global\advance\colindex by 1 + \ifnum\colindex>\NCOL + \global\colindex=1 + \global\setbox\page=\vbox{\box\page\rowspace\box\row} + \global\setbox\row=\null + \global\advance\rowindex by 1 + \ifnum\rowindex=\NROW + \global\rowindex=1 + \shipout\box\page + \global\setbox\page=\null + \advancepageno + \fi + \fi + \global\setbox\row=\hbox{\box\row\colspace\columnbox}} + + \def\columnbox{\leftline{\pagebody}} + + \def\endcol{\vfill\supereject + \ifnum\colindex=1\null\vfill\eject\fi} +} % end of grid. + +%%% bbdb-cols.tex ends here. + diff --git a/tex/bbdb-print-brief.tex b/tex/bbdb-print-brief.tex new file mode 100644 index 0000000..f116270 --- /dev/null +++ b/tex/bbdb-print-brief.tex @@ -0,0 +1,159 @@ +%%% bbdb-print-brief.tex - for formatting address lists, one line per entry. + +%%% Authors: Luigi Semenzato <luigi@paris.cs.berkeley.edu> +%%% Boris Goldowsky <boris@cs.rochester.edu> +%%% Copyright (C) 1993 Boris Goldowsky +%%% Version: 3.91; 19Dec94 + +%%% For instructions on using this format file with BBDB, see bbdb-print.el +%%% which should have come bundled with this file; or write to +%%% boris@cs.rochester.edu. + +%%% This file is part of the bbdb-print extensions to the Insidious +%%% Big Brother Database, which is for use with GNU Emacs. +%%% +%%% The Insidious Big Brother Database 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 1, or (at your +%%% option) any later version. +%%% +%%% BBDB 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 GNU Emacs; see the file COPYING. If not, write to +%%% the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +%%% The address-list file should look something like this: + +%%% \input file % this format file's filename +%%% \setsize{6} % point size of type to use +%%% % or \setpssize{6} to use PostScript fonts. (optional) +%%% \setseparator{3} % which style of separators, 0-7 +%%% +%%% \separator{A} % include a separator here +%%% +%%% \beginrecord % and start a record +%%% \name{A. Name} +%%% \phone{location: (xxx) xxx-xxxx} +%%% \address{1234 Main Street\\ +%%% Anytown, XX 00000\\} +%%% \note{note name}{note text} +%%% \notes{blah blah} +%%% \endrecord +%%% +%%% \endaddresses % done +%%% \bye + +\nopagenumbers +\raggedright +\tolerance=10000 +\hbadness=10000 +\parskip 0pt +\parindent=0pt % was 10pt + +%%% +%%% Fonts +%%% + +\def\setsize#1{ + \font\rm=ecrm#1 + \font\bf=ecbx#1 + \font\it=\ifnum #1=6 ecti7 \else ecti#1 \fi + \font\tt=ectt#1 + \font\bigbf=ecbx#1 scaled \magstep3 + \rm + \baselineskip=#1pt + \ifnum #1>9 \advance\baselineskip by 1pt \fi +} + +\def\setpssize#1{ + \font\rm=ptmr at #1pt + \font\bf=ptmb at #1pt + \font\it=ptmri at #1pt + \font\tt=pcrr at #1pt + {\dimen0=#1pt\global\font\bigbf=ptmb at 1.8\dimen0} + \rm + \baselineskip=#1pt +} + +%%% +%%% Define separator types +%%% + +\def\setseparator#1{ + \ifnum #1=1 + \def\sep##1{\line{\hrulefill}\smallskip\mark{##1}} + \else \ifnum #1=2 + \def\sep##1{\hbox{\vrule\hskip -0.4pt\vbox{\hrule\smallskip + \centerline{\bf{##1}}\smallskip\hrule}\hskip -0.4pt\vrule + \mark{##1}}} + \else \ifnum #1=3 + \def\sep##1{\hbox{\vrule\hskip -0.4pt\vbox{\hrule\smallskip + \centerline{\bigbf{##1}}\smallskip\hrule}\hskip -0.4pt\vrule} + \medskip\mark{##1}} + \else \ifnum #1=4 + \def\sep##1{\smallskip\centerline{\bigbf{##1}}\medskip\mark{##1}} + \else \ifnum #1=5 + \def\sep##1{\hrule\smallskip + \centerline{\bigbf{##1}}\smallskip\hrule\medskip\mark{##1}} + \else \ifnum #1=6 + \def\cute{$\sya\syb\syc\syd$} + \def\revcute{$\syd\syc\syb\sya$} + \let\sya=\heartsuit\let\syb=\spadesuit + \let\syc\diamondsuit\let\syd=\clubsuit + \def\cycle{\let\tmp=\sya\let\sya=\syb + \let\syb=\syc\let\syc=\syd\let\syd=\tmp} + \def\sep##1{\smallskip + \hbox to \hsize{\hfil\cute\hfil\bigbf{##1}\hfil\revcute\hfil} + \cycle\medskip\mark{##1}} + \else \ifnum #1=7 + \def\cute{$\sya\syb\syc\syd$} + \def\revcute{$\syd\syc\syb\sya$} + \let\sya=\heartsuit\let\syb=\spadesuit + \let\syc=\diamondsuit\let\syd=\clubsuit + \def\cycle{\let\tmp=\sya\let\sya=\syb\let\syb=\syc\let\syc=\syd + \let\syd=\tmp} + \def\sep##1{\hbox{\vrule\vbox{\hrule\smallskip + \hbox to \hsize{\hfil\cute\hfil\bigbf{##1}\hfil\revcute\hfil} + \smallskip\hrule}\vrule}\medskip\cycle\mark{##1}} + \else + \def\sep##1{\mark{##1}} + \fi\fi\fi\fi\fi\fi\fi + \def\separator##1{\noalign{\sep##1}} +} % end setseparator + +%%% +%%% Macros for formatting the entries. +%%% + +\def\\{} + +\def\firstline#1#2{% the name and (maybe) the first phone number. + {\bf #1}\hfil&\hfil#2&\hskip0pt} + +\def\name#1{\firstline{#1}{}} % for backwards compatibility + +\def\phone#1{\hfil#1&\hskip0pt} + +\def\address#1{#1\hfil&\hskip0pt} + +\def\comp#1{\hskip0pt} +\def\email#1{\hskip0pt} +\def\note#1#2{\hskip0pt} +\def\notes#1{\hskip0pt} + +\def\beginrecord{\relax} +\def\endrecord{\cr} + +\def\beginaddresses{\halign\bgroup&##\quad\cr} +\def\endaddresses{\egroup} + +\def\today{\number\day\space + \ifcase\month\or Jan\or Feb\or Mar\or Apr \or May\or June\or + Jul\or Aug\or Sept\or Oct\or Nov\or Dec\fi + \space\number\year} + +%%% bbdb-print-brief.tex ends here. diff --git a/tex/bbdb-print.tex b/tex/bbdb-print.tex new file mode 100644 index 0000000..9b60e4b --- /dev/null +++ b/tex/bbdb-print.tex @@ -0,0 +1,171 @@ +%%% bbdb-print.tex - for formatting address lists. + +%%% Authors: Luigi Semenzato <luigi@paris.cs.berkeley.edu> +%%% Boris Goldowsky <boris@cs.rochester.edu> +%%% Copyright (C) 1993 Boris Goldowsky +%%% Version: 3.92; 5Jan95 + +%%% For instructions on using this format file with BBDB, see bbdb-print.el +%%% which should have come bundled with this file. The complete bbdb-print +%%% package is also available via anonymous ftp at: +%%% /cs.rochester.edu:/pub/u/boris/bbdb-print.tar.gz + +%%% This file is part of the bbdb-print extensions to the Insidious +%%% Big Brother Database, which is for use with GNU Emacs. +%%% +%%% This program 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 1, or +%%% (at your option) any later version. +%%% +%%% This program 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 GNU Emacs; see the file COPYING. If not, write to +%%% the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +%%% The address-list file should look something like this: + +%%% \input file % this format file's filename +%%% \setsize{6} % point size of type to use +%%% % or \setpssize{6} to use PostScript fonts. (optional) +%%% \setseparator{3} % which style of separators, 0-7 +%%% +%%% \separator{A} % include a separator here +%%% +%%% \beginrecord % and start a record +%%% \name{A. Name} +%%% \phone{location: (xxx) xxx-xxxx} +%%% \address{1234 Main Street\\ +%%% Anytown, XX 00000\\} +%%% \note{note name}{note text} +%%% \notes{blah blah} +%%% \endrecord +%%% +%%% \endaddresses % done +%%% \bye + +\raggedright +\tolerance=10000 +\hbadness=10000 +\parskip 0pt +\parindent=0pt +\footline{\hfil} + +%%% +%%% Fonts +%%% + +\def\setsize#1{ + \font\rm=ecrm#1 + \font\bf=ecbx#1 + \font\it=\ifnum #1=6 ecti7 \else ecti#1 \fi + \font\tt=ectt#1 + \font\bigbf=ecbx#1 scaled \magstep3 + \rm + \baselineskip=#1pt + \ifnum #1>9 \advance\baselineskip by 1pt \fi +} + +\def\setpssize#1{ + \font\rm=ptmr at #1pt + \font\bf=ptmb at #1pt + \font\it=ptmri at #1pt + \font\tt=pcrr at #1pt + {\dimen0=#1pt\global\font\bigbf=ptmb at 1.8\dimen0} + \rm + \baselineskip=#1pt +} + +%%% +%%% Define separator types +%%% + +\def\setseparator#1{ + \ifnum #1=1 + \def\separator##1{\hrule\smallskip\mark{##1}} + \else \ifnum #1=2 + \def\separator##1{\hbox{\vrule\hskip -0.4pt\vbox{\hrule\smallskip + \centerline{\bf{##1}}\smallskip\hrule}\hskip -0.4pt\vrule + \mark{##1}}} + \else \ifnum #1=3 + \def\separator##1{\hbox{\vrule\hskip -0.4pt\vbox{\hrule\smallskip + \centerline{\bigbf{##1}}\smallskip\hrule}\hskip -0.4pt\vrule} + \medskip\mark{##1}} + \else \ifnum #1=4 + \def\separator##1{\smallskip\centerline{\bigbf{##1}}\medskip\mark{##1}} + \else \ifnum #1=5 + \def\separator##1{\hrule\smallskip + \centerline{\bigbf{##1}}\smallskip\hrule\medskip\mark{##1}} + \else \ifnum #1=6 + \def\cute{$\sya\syb\syc\syd$} + \def\revcute{$\syd\syc\syb\sya$} + \let\sya=\heartsuit\let\syb=\spadesuit + \let\syc\diamondsuit\let\syd=\clubsuit + \def\cycle{\let\tmp=\sya\let\sya=\syb + \let\syb=\syc\let\syc=\syd\let\syd=\tmp} + \def\separator##1{\smallskip + \hbox to \hsize{\hfil\cute\hfil\bigbf{##1}\hfil\revcute\hfil} + \cycle\medskip\mark{##1}} + \else \ifnum #1=7 + \def\cute{$\sya\syb\syc\syd$} + \def\revcute{$\syd\syc\syb\sya$} + \let\sya=\heartsuit\let\syb=\spadesuit + \let\syc=\diamondsuit\let\syd=\clubsuit + \def\cycle{\let\tmp=\sya\let\sya=\syb\let\syb=\syc\let\syc=\syd + \let\syd=\tmp} + \def\separator##1{\hbox{\vrule\vbox{\hrule\smallskip + \hbox to \hsize{\hfil\cute\hfil\bigbf{##1}\hfil\revcute\hfil} + \smallskip\hrule}\vrule}\medskip\cycle\mark{##1}} + \else + \def\separator##1{\mark{##1}} + \fi\fi\fi\fi\fi\fi\fi +} % end setseparator + +%%% +%%% Macros for formatting the entries. +%%% + +\def\beginaddresses{} + +\def\endaddresses{ + \bigskip\hrule\smallskip + \noindent {\bf Printed \today}\vfill\endcol} + +\def\beginrecord{\bigbreak} + +\def\endrecord{\bigbreak} + +\def\\{\par} + +\def\dots{\leaders\hbox to 0.6em{\hss.\hss}} + +\def\firstline#1#2{% the name and (maybe) the first phone number. + \hyphenpenalty=10000\rightskip=0pt plus 1fil + \noindent{\bf #1}\dotfill\penalty-1\hbox{}\dotfill{#2}\\ +} + +\def\name#1{\firstline{#1}{}} % for backwards compatibility + +\def\comp#1{#1\\} + +\def\phone#1{\hfill#1\\} + +\def\email#1{\smallbreak{\tt#1}\\} + +\def\address#1{\smallbreak#1\smallbreak} + +\def\note#1#2{{\smallbreak\leftskip=2em\parindent=-1em + \noindent\hskip-\leftskip{\it#1: } #2\\ }} + +\def\notes#1{\smallbreak{\it(#1)}\\ } + +\def\today{\number\day\space + \ifcase\month\or Jan\or Feb\or Mar\or Apr \or May\or June\or + Jul\or Aug\or Sept\or Oct\or Nov\or Dec\fi + \space\number\year} + +%%% bbdb-print.tex ends here. diff --git a/texinfo/.gitignore b/texinfo/.gitignore new file mode 100644 index 0000000..818cbf5 --- /dev/null +++ b/texinfo/.gitignore @@ -0,0 +1,17 @@ +/Makefile +/bbdb.aux +/bbdb.cp +/bbdb.cps +/bbdb.dvi +/bbdb.fn +/bbdb.fns +/bbdb.info +/bbdb.ky +/bbdb.log +/bbdb.pdf +/bbdb.pg +/bbdb.toc +/bbdb.tp +/bbdb.vr +/bbdb.vrs +/bbdb/*.html diff --git a/texinfo/Makefile.in b/texinfo/Makefile.in new file mode 100644 index 0000000..351c788 --- /dev/null +++ b/texinfo/Makefile.in @@ -0,0 +1,93 @@ +@SET_MAKE@ + +infodir = @infodir@ +prefix = @prefix@ +srcdir = @srcdir@ +subdir = texinfo +top_srcdir = @top_srcdir@ +datarootdir = @datarootdir@ + +VPATH=$(srcdir) +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_DATA = @INSTALL_DATA@ + +RM = @RM@ +LN_S = @LN_S@ + +MAKEINFO = @MAKEINFO@ +EMACSINFO = @EMACS_PROG@ -no-site-file -no-init-file -batch -q -l infohack.el -f batch-makeinfo + +PACKAGEDIR = @PACKAGEDIR@ +SYMLINKS = @SYMLINKS@ +LINKPATH = @LINKPATH@ + +all: info bbdb.dvi + +install-pkg: uninstall-pkg info + @if test "x$(SYMLINKS)" = "xno" ; then \ + for i in `ls bbdb.info* ` ; do \ + $(INSTALL_DATA) $$i $(PACKAGEDIR)/info/ ; \ + done ; \ + else \ + if test "x$(LINKPATH)" = "x" ; then \ + for i in `ls bbdb.info* ` ; do \ + $(LN_S) `pwd`/$$i $(PACKAGEDIR)/info/$$i ; \ + done ; \ + else \ + for i in `ls bbdb.info* ` ; do \ + $(LN_S) $(LINKPATH)/texinfo/$$i $(PACKAGEDIR)/info/$$i ; \ + done ; \ + fi ; \ + fi + +uninstall-pkg: + -$(RM) $(PACKAGEDIR)/info/bbdb.info* + +info: bbdb.info + +bbdb.info: bbdb.texinfo + @if test "x$(MAKEINFO)" = "x" ; then \ + $(EMACSINFO) bbdb.texinfo ; \ + else \ + $(MAKEINFO) bbdb.texinfo ; \ + fi + +bbdb.dvi: bbdb.texinfo + @if test "x$(TEXI2DVI)" = "x" ; then \ + echo "Sorry, no \`texi2dvi' program available." ; \ + else \ + $(TEXI2DVI) bbdb.texinfo ; \ + fi + +bbdb.pdf: bbdb.texinfo + @if test "x$(TEXI2DVI)" = "x" ; then \ + echo "Sorry, no \`texi2dvi' program available." ; \ + else \ + $(TEXI2DVI) -p bbdb.texinfo ; \ + fi + +bbdb.html: bbdb.texinfo + texi2html bbdb.texinfo && cp $@ ../html + +clean: + -$(RM) *.aux *.cp *.cps *.dvi *.pdf *.fn *.fns *.ky *.log *.pg \ + *.toc *.tp *.vr *.vrs + +# Backward compatibility +reallyclean: distclean + +distclean: clean + -$(RM) bbdb.info* + +cvsclean: distclean + -$(RM) Makefile + +Makefile: $(srcdir)/Makefile.in ../config.status + cd .. \ + && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/texinfo/bbdb.texinfo b/texinfo/bbdb.texinfo new file mode 100644 index 0000000..27cfed8 --- /dev/null +++ b/texinfo/bbdb.texinfo @@ -0,0 +1,3978 @@ +\input texinfo @c -*-texinfo-*- -*- coding: iso-latin-1 -*- +@c %**start of header +@setfilename bbdb.info +@settitle Insidious Big Brother Database User Manual +@c %**end of header + +@ifinfo +@dircategory Emacs +@direntry +* BBDB: (bbdb). The Insidious Big Brother Database. +@end direntry + +This file documents the Insidious Big Brother Database + +This is the BBDB User Manual for BBDB version 2.36. + +Copyright (c) 1991-1994 Jamie Zawinski <jwz@@netscape.com> + +Copyright (c) 1997-1999 Matt Simmons <simmonmt@@acm.org> + +Copyright (c) 2000-present The BBDB Development Team +@end ifinfo + +@titlepage +@title BBDB User Manual +@subtitle A phone number and address database program for Emacs + +@author by Jamie Zawinski, Matt Simmons and the BBDB Development Team +@page +Copyright @copyright{} 1991-1994 Jamie Zawinski <jwz@@netscape.com> + +Copyright @copyright{} 1997-1999 Matt Simmons <simmonmt@@acm.org> + +Copyright @copyright{} 2000-present The BBDB Development Team + +@sp 2 + +Permission is granted to make and distribute verbatim copies of this +manual provided the copyright notice and this permission notice are +preserved on fnord all copies. + +Permission is granted to copy and distribute modified versions of +this manual under the conditions for verbatim copying, provided that +the entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + +Permission is granted to copy and distribute translations of this +manual into another language, under the above conditions for modified +versions, except that this permission notice may be stated in a +translation approved by the author. + +@end titlepage +@page + +@node Top, Installation,,_ +@chapter BBDB + +@b{BBDB} is a rolodex-like database program for GNU Emacs. @b{BBDB} stands +for @b{@i{Insidious Big Brother Database}}, and is not, repeat, @emph{not} an +obscure reference to the Buck Rogers TV series. + +It provides the following features: + +@itemize @bullet +@item +Integration with mail and news readers, with little or no +interaction by the user: @refill + +@itemize @bullet +@item +easy (or automatic) display of the record corresponding to the sender of +the current message; @refill + +@item +automatic creation of records based on the contents of the current +message; @refill + +@item +automatic addition of data to arbitrary fields of the record +corresponding to the sender of the current message. @refill +@end itemize + +@item +Listing all records which match a regular expression; + +@item +Listing all records which match a regular expression in a particular +field (@samp{company} or @samp{notes,} for example); @refill +@end itemize + +@menu +* Installation:: Installation +* The BBDB:: Overview +* BBDB Mode:: BBDB Mode +* Interfaces:: Interfaces to various readers +* Reader-specific Features:: Features only available to specific readers +* Other Packages:: Using the BBDB with other packages +* Options:: Options +* Utilities:: Utilities +* Internals:: BBDB Internals +* Mailing Lists:: The BBDB mailing lists +* Changes:: New in this version +* The Latest Version:: Where to Get It +* The Future:: Known Bugs, the TODO list and EOL statements +* Thanks:: to the Ministry of Bugs + +* Concept Index:: Concept Index +* Variable Index:: Variable Index + +@detailmenu + --- The Detailed Node Listing --- + +Installation + +* General Prerequisites:: General @b{BBDB} requirements + +File Installation +* Normal User:: "Normal" Installations +* XEmacs Package:: Installing as an XEmacs package + +Initial Configuration +* Initial Configuration:: How to initially set up the @b{BBDB} + +Manual initialization + +* Gnus Prep:: Initializing @b{BBDB} support for Gnus +* MH-E Prep:: Initializing @b{BBDB} support for MH-E +* RMAIL Prep:: Initializing @b{BBDB} support for RMAIL +* Sendmail Prep:: Initializing @b{BBDB} support for Sendmail +* VM Prep:: Initializing @b{BBDB} support for VM + +Other packages: + +* Message Prep:: Initializing @b{BBDB} support for Message mode +* Reportmail Prep:: Initializing @b{BBDB} support for Reportmail +* Supercite Prep:: Initializing @b{BBDB} support for Supercite +* Web Browser Prep:: Initializing @b{BBDB} support for Web Browsers + +The @b{BBDB} + +* Database Fields:: Description of database fields +* Basic Searching:: Basic database searching commands +* Advanced Searching:: Advanced database searching commands +* Manual Record Addition:: Adding records by hand + +Interfaces + +* Mail Reading Interfaces:: Mail Reading Interfaces +* News Reading Interfaces:: News Reading Interfaces +* Mail Sending Interfaces:: Mail Sending Interfaces + +Reader-specific Features + +* Gnus Features:: Gnus-specific Features +* VM Features:: VM-specific Features + +Gnus-specific Features + +* Gnus Scoring:: Store score adjustments in the @b{BBDB} +* Gnus Summary Buffer:: @b{BBDB} information in the Summary buffer +* GNUS Subject List:: @b{BBDB} information in the Subject List + +VM-specific features + +* VM Message Summary:: @b{BBDB} information in message summary + +Using the @b{BBDB} with other packages + +* Using Message Mode:: Using the @b{BBDB} with Message Mode +* Using Reportmail:: Using the @b{BBDB} with Reportmail +* Using Supercite:: Using the @b{BBDB} with Supercite +* Using Web Browsers:: Using the @b{BBDB} with Web Browsers + +Options + +* Customization Parameters:: Customization Parameters +* Customization Hooks:: Customization Hooks +* Predefined Hooks:: Predefined Hooks + +Utilities + +* bbdb-ftp:: Storing FTP sites in the @b{BBDB} +* bbdb-print:: Print the @b{BBDB} +* bbdb-snarf:: Record generation from raw text +* bbdb-srv:: External control of the @b{BBDB} + +Changes in this Version + +* Major Changes:: Major changes in this version +* Other Changes:: Not-so-major changes + +The Future + +* Known Bugs:: Known Bugs, and how to submit new ones +* TODO List:: The TODO List +* EOL Statements:: EOL (End Of Life) Statements + +_ + +* Top:: + +@end detailmenu +@end menu + +@node Installation, The BBDB, Top, Top +@section Installation +@cindex Installation +@cindex Makefile + +This program consists of several groups of files, organized by +directory: + +@ifinfo +@example + lisp - the main program code for the @b{BBDB} + tex - TeX support files for @xref{bbdb-print}, the @b{BBDB} + printing utility + texinfo - the documentation files for the @b{BBDB} + utils - miscellaneous external utility programs + misc - things that don't fall into the above categories + bits - things that have been written as add-ons for @b{BBDB} + but have not yet been merged with the main codebase +@end example +@end ifinfo +@iftex +@bgroup@tableindent=1.5in +@table @b +@item lisp +the main program code for the BBDB +@item tex +@TeX@ support files for bbdb-print, the BBDB printing utility +@item texinfo +the documentation files for the BBDB +@item utils +miscellaneous external utility programs +@item bits +things that have been written as add-ons for @b{BBDB} but have not yet +been merged with the main codebase +@end table +@egroup +@end iftex + +@menu +* General Prerequisites:: General @b{BBDB} requirements + +File Installation +* Normal User:: "Normal" Installations +* XEmacs Package:: Installing as an XEmacs package + +Initial Configuration +* Initial Configuration:: How to initially set up the @b{BBDB} +@end menu + +@node General Prerequisites, Normal User, Installation, Installation +@subsection General Prerequisites + +Various parts of the @b{BBDB} require extra packages to be available +that are not part of the @b{BBDB} distribution. Please note that with +one exception no extra packages (beyond those which ship with both GNU +Emacs and XEmacs) are required for the use of @b{BBDB} core +functionality.@footnote{"Core Functionality" is defined as the parts of +the @b{BBDB} used to implement basic record creation (@samp{M-x +bbdb-create}) and searching (@samp{M-x bbdb}).} This one exception +applies to XEmacs 20.5 users - the @code{xemacs-base} package must be +installed for the correct operation of the core @b{BBDB} functionality. +The table below lists the requirements of the various portions of the +@b{BBDB}. Please note that the absence of any of the below optional +packages will not affect core @b{BBDB} functionality. + +@multitable {bbdb-reportmail } {Package needed} {GNU 19.34} {GNU 20.2} {XEmacs} {XEmacs} +@item @* BBDB file +@tab @* Package needed +@tab @* GNU 19.34 +@tab @* GNU 20.2 +@tab XEmacs@* @center >=20.4 +@tab XEmacs@* @center 20.5 + +@item @code{bbdb-ftp} +@tab EFS or @* Ange-FTP +@tab @center B +@tab @center B +@tab @center B +@tab @center P + +@item @code{bbdb-gnus} +@tab Gnus[1] +@tab @center B +@tab @center B +@tab @center B +@tab @center P + +@item @code{bbdb-mhe} +@tab MH-E +@tab @center B +@tab @center B +@tab @center B +@tab @center P + +@item @code{bbdb-reportmail} +@tab Reportmail +@tab +@tab +@tab @center B +@tab @center P[2] + +@item @code{bbdb-sc} +@tab Supercite +@tab @center B +@tab +@tab @center B +@tab @center P + +@item @code{bbdb-srv} +@tab @code{gnuserv} and @* @code{itimer} +@tab +@tab +@tab @center B +@tab @center B + +@item @code{bbdb-vm} +@tab VM[4] +@tab +@tab +@tab @center B +@tab @center P + +@item @code{bbdb-w3} +@tab @code{browse-url} +@tab @center B +@tab @center B +@tab @center B +@tab @center P[3] +@end multitable + +@* +@noindent +@b{NOTES:} +@enumerate +@item +The old GNUS mail/newsreader should still work. Please keep in mind +that you have a relatively recent Emacs (GNU 19.34 or later, XEmacs +19.15 or later), you are probably using Gnus. +@item +As of this writing, Reportmail is available as +part of the @code{edit-utils} package. +@item +As of this writing, @code{browse-url} is +available as part of the @code{mail-lib} package. +@item +The source release of VM is currently required due to the use of macros +from the VM codebase in @b{BBDB}'s VM integration. +@end enumerate + +Please also note that the XEmacs package locations are as of this +writing. As the XEmacs 20.5 package system is still in development, the +locations may change without warning. + +@node Normal User, XEmacs Package, General Prerequisites, Installation +@subsection Normal User Installation +@cindex Normal User Installation + +@subheading Configuring the compilation process + +First of all, you should run the @code{configure} script at the toplevel +of the distribution. This script will perform a number of checks on +your system and generate the @file{Makefile}'s accordingly. + +The @code{configure} script also comes with a number of options that +lets you customize the compilation process. These options are described +below where appropriate. + +@subheading Byte Compiling the Lisp files + +First, you need to byte-compile the appropriate @b{BBDB} Lisp files. +While this is in theory an optional step, it is virtually required in +practice due to speed reasons. + +In order to byte-compile the lisp files, an Emacs of some sort must be +used. By default (at @code{configure} time), @code{emacs} and +@code{xemacs} will be tried in that order. If you want to use a special +Emacs flavor (or if you want to use @code{xemacs} at the first place), +you should pass the @code{--with-emacs=PROG} option to @code{configure}. + +In order to successfully compile the @b{BBDB}, the build process also +needs to know the location of the various optional packages. If the +directories containing these optional packages are in the default Emacs +search path (the @code{load-path} variable), no other changes need be +made for the build process to complete successfully. + +If the optional packages are not in the default search path, the build +process will not find them unless explicitly told of their location(s). +To tell the build process where to find Gnus, MH-E, and/or VM, use the +@code{configure} options @code{--with-gnus-dir=DIR}, +@code{--with-mhe-dir=DIR}, and/or @code{--with-vm-dir=DIR} variables +respectively. To tell the build process where to find any other +package(s), pass the directories containing the lisp files for the +package(s) to the @code{configure} option @code{--with-other-dirs=DIRS}. +If multiple directories are to be added, they should be separated by +spaces or colons, and should @b{not} be quoted. For example, to +add the @file{/p/local/elisp/footnote} and @file{/p/local/elisp/sc} +directories, call the @code{configure} script as follows: + +@example + @code{configure --with-other-dirs=/p/local/elisp/footnote:/p/local/elisp/sc} +@end example + +After configuring, run one of the following commands: + +@ifinfo +@example + @code{make bbdb} - Build the core, mailer independent, components + @code{make gnus} - Core components plus @code{Gnus} support + @code{make mhe} - Core components plus @code{MH-E} support + @code{make rmail} - Core components plus @code{RMAIL} support + @code{make vm} - Build the core components with @code{VM} support + @code{make all} - Core components plus support for all mailers + listed above +@end example +@end ifinfo +@iftex +@bgroup@tableindent=1.5in +@table @b +@item @code{make bbdb} +Build the core, mailer independent, components +@item @code{make gnus} +Core components plus @code{Gnus} support +@item @code{make mhe} +Core components plus @code{MH-E} support +@item @code{make rmail} +Core components plus @code{RMAIL} support +@item @code{make vm} +Build the core components with @code{VM} support +@item @code{make all} +Core components plus support for all mailers listed above +@end table +@egroup +@end iftex + +You can also combine the above @code{make} commands. For example, to +build the @b{BBDB} with support for @code{Gnus} and @code{VM}, you can +do so by typing: + +@example +make gnus vm +@end example + +@subheading Moving the files to their final destination + +@subsubheading Lisp files + +As stated above, the @file{lisp} subdirectory contains the Emacs Lisp source +files for the @b{BBDB}. Therefore, these files must be in the Emacs +@code{load-path}. There are several ways of doing this, three of which are +described below: + +@itemize @bullet +@item +Add the @file{lisp} directory from the source distribution to the +@code{load-path}. This will allow you to run the @b{BBDB} in-place. This +method is recommended for normal users or @b{BBDB} developers, especially if +disk usage is an issue. It is @b{not} recommended for site-wide +installations. @refill + +@item +Link the @file{lisp} directory into your @file{site-lisp} directory. This is +for a site-wide installation, but it is subject to the following caveat. If you +link the @file{lisp} directory into @file{site-lisp}, you will make life more +difficult for yourself down the road, as you will not be able to make changes to +the source directory (new versions, patches, etc) without having an effect on +other users who now depend on it. This directory will automatically be added to +the @code{load-path} when Emacs starts. @refill + +@item +Make a directory whose sole purpose in life is containing the production copies +of the @b{BBDB} source and byte-compiled source files. Either put this +directory under @file{site-lisp} (or put it somewhere else and link it into +@file{site-lisp}). This directory will automatically be added to the +@code{load-path} when Emacs starts. This is the best of the three listed here, +as it allows for a degree of separation between the (possibly changing) source +tree and the production code. +@end itemize + +@ifinfo +@subsubheading TeX files + +The @file{tex} subdirectory contains the TeX support files for +bbdb-print, the @b{BBDB} printing utility (@xref{bbdb-print}.). The +three support files, @file{bbdb-cols.tex}, @file{bbdb-print.tex}, and +@file{bbdb-print-brief.tex}, must be placed in a directory that is +either on the default TeX search path or is listed in the +@code{TEXINPUTS} environment variable. If neither of these two options +is taken, TeX will not be able to process the file output by +@code{bbdb-print}. +@end ifinfo +@iftex +@subsubheading @TeX files + +The @file{tex} subdirectory contains the @TeX support files for +bbdb-print, the @b{BBDB} printing utility (@xref{bbdb-print}). The three +support files, @file{bbdb-cols.tex}, @file{bbdb-print.tex}, and +@file{bbdb-print-brief.tex}, must be placed in a directory that is +either on the default @TeX search path or is listed in the +@code{TEXINPUTS} environment variable. If neither of these two options +is taken, @TeX will not be able to process the file output by +@code{bbdb-print}. +@end iftex + +@subsubheading texinfo files + +The @file{bbdb.info} file in this directory contains the documentation +for the @b{BBDB}. This file should either be linked or copied to a +directory on the default path for the @code{info} program or listed in +the @code{INFOPATH} environment variable. + +@node XEmacs Package, Initial Configuration, Normal User, Installation +@subsection XEmacs Package Installation +@cindex XEmacs Package Installation + +@noindent +@b{NOTE:} XEmacs packages are currently supported only under XEmacs +versions after and including 20.5. If you are not running such a version +of XEmacs, you should install the @b{BBDB} according to the instructions +in @ref{Normal User}. + +@subheading Configuring / Byte Compiling + +The configuration and byte-compilation procedures are the same as in the +Normal User installation. See @ref{Normal User}. + +@subheading Moving the files to their final destination + +Support is provided for the automatic installation of the @b{BBDB} in an +XEmacs package directory. The following @code{configure} options are +available for you: + +@table @b +@item @code{--with-package-dir=DIR} +This option sets the root of the XEmacs package directory. By default, +@file{/usr/local/lib/xemacs/site-packages} is used. +@item @code{--with-symlinks} +If this option is used, the installation will be done by making symbolic +links to the sources instead of copying the files. +@item @code{--with-linkpath=PATH} +Without this option, the installation process uses the output of +@code{pwd} to determine the current directory. If something else should +be used, you should provide an alternate name for the BBDB toplevel +directory by using @code{--with-linkpath}. If, for example, @code{pwd} +returns @file{/p/local/elisp/bbdb}, but you prefer to use +@file{/usr/local/elisp/bbdb/...} for the links, usr this: +@code{configure --with-linkpath=/usr/local/elisp/bbdb}. This option is +ignored if @code{--with-symlinks} is not used. +@end table + +To perform the (un)installation, use the command @code{make (un)install-pkg}. +This will compile the @file{lisp/auto-autoloads.el} file and will +install the appropriate files to the appropriate places. The final +installation tree will take the following form: + +@table @code +@item $(PACKAGEDIR)/ +@table @code +@item lisp/ +@table @code +@item bbdb/ + @i{@b{BBDB} lisp source files. This directory contains a copy of all +@code{.el} and @code{.elc} files from the @file{lisp} source directory, +or is a symbolic link to it.} +@end table +@item info/ +@table @code +@item bbdb.info* + @i{@b{BBDB} documentation files. These are either copies of the info +files from the @file{texinfo} source directory, or are symbolic links to +them.} +@end table +@item etc/ +@table @code +@item bbdb/ +@table @code +@item tex/ + @i{@b{BBDB} support files for bbdb-print. This directory contains a +copy of the appropriate files from the @file{tex} source directory, or +is a symbolic link to it.} +@item utils/ + @i{@b{BBDB} miscellaneous utilities. This directory contains a copy +of the appropriate files from the @file{utils} source directory, or is a +symbolic link to it.} +@end table +@end table +@end table +@end table + +@node Initial Configuration, , XEmacs Package, Installation +@subsection Initial Configuration +@cindex Initial Configuration +@findex bbdb-initialize + +The simplest way to configure the @b{BBDB} is to include the following +forms in your Emacs configuration file: + +@example +@code{(require 'bbdb)} +@code{(bbdb-initialize)} +@end example + +@b{Note:} The forms above replace the autoloads needed for previous +versions of the @b{BBDB}. + +This will set up the @b{BBDB} for basic querying and record manipulation +(the Core Functionality referred to in the Prerequisites section). It +will not enable any of the mailreader-, newsreader- or other +package-specific @b{BBDB} features. To enable some or all of these +features, the @code{(bbdb-initialize)} form can be enable as shown +below. Alternatively, the features can be enabled manually as described +in the following sections. + +@subheading Modifying @code{(bbdb-initialize)} + +The @code{bbdb-initialize} function can be used to enable the various +package-specific @b{BBDB} functions. This feature activation is +accomplished through the passing of symbols which tell the function +which features to activate. These symbols are outlined below and in the +Emacs documentation for the @code{bbdb-initialize}@footnote{This +documentation can be accessed by typing @kbd{C-h f bbdb-initialize RET}.} + +@subsubheading Initialization symbols for mail and news readers + +@table @code +@item gnus + Initialize support for Gnus@footnote{If you are using GNUS (not Gnus), + and if your GNUS version is 3.14 or older, use the @code{Gnus} (note + the capitalization) symbol.}. If you pass the @code{gnus} symbol, you should + probably also pass the @code{message} symbol. +@item mh-e + Initialize support for the MH-E mail reader. +@item rmail + Initialize support for the RMAIL mail reader. +@item sendmail + Initialize support for sendmail (@kbd{M-x mail}) +@item vm + Initialize support for the VM mail reader.@footnote{For the VM + initialization to work properly, you must either call + @code{bbdb-initialize} with the @code{vm} symbol from within your VM + initialization file (@file{~/.vm}), or you must call + @code{bbdb-insinuate-vm} manually from within your VM initialization + file.} +@end table + +@subsubheading Initialization symbols for other packages + +@table @code +@item message + Initialize support for Message mode (the mail composition program + included with Gnus). +@item reportmail + Initialize support for the Reportmail mail notification package. +@item sc + Initialize support for the Supercite message citation package. + Additional initialization is required for Supercite to work with the + @b{BBDB}. @xref{Supercite Prep}. +@item w3 + Initialize support for Web browsers. +@end table + +@subsubheading Initialization example + +To initialize support for Gnus 5.5, Message mode, Supercite, and Web +browsers, the following forms would be used: + +@example +(require 'bbdb) +(bbdb-initialize 'gnus 'message 'sc 'w3) +@end example + +@subsubheading Manual initialization + +If your initialization needs exceed those provided by +@code{bbdb-initialize}, refer to the following sections for a +description of the procedures necessary for enabling @b{BBDB} support +for the packages listed above. The procedures described are the same as +those carried out by the @code{bbdb-initialize} function when passed the +appropriate symbols. That is, the procedure listed in the RMAIL Prep +section below is the same as than executed by @code{bbdb-initialize} +when the @code{rmail} symbol is passed. + +@menu +Mail and News readers: + +* Gnus Prep:: Initializing @b{BBDB} support for Gnus +* MH-E Prep:: Initializing @b{BBDB} support for MH-E +* RMAIL Prep:: Initializing @b{BBDB} support for RMAIL +* Sendmail Prep:: Initializing @b{BBDB} support for Sendmail +* VM Prep:: Initializing @b{BBDB} support for VM + +Other packages: + +* Message Prep:: Initializing @b{BBDB} support for Message mode +* Reportmail Prep:: Initializing @b{BBDB} support for Reportmail +* Supercite Prep:: Initializing @b{BBDB} support for Supercite +* Web Browser Prep:: Initializing @b{BBDB} support for Web Browsers +@end menu + +@node Gnus Prep, MH-E Prep, Initial Configuration, Initial Configuration +@subsubsection Initializing @b{BBDB} support for Gnus + +To take advantage of the @b{Gnus} features of the @b{BBDB}, add one of +the following forms to your Emacs configuration file: @refill + +@noindent +For Gnus 3.14 or older: + +@code{(add-hook 'gnus-Startup-hook 'bbdb-insinuate-gnus)} + +@noindent +For Gnus 3.15 or newer: + +@code{(add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)} + +@code{bbdb-insinuate-gnus} adds bindings for the default keys to +@b{Gnus} and configures @b{Gnus} to notify the @b{BBDB} when new +messages are loaded. This notification is required if the @b{BBDB} is +to be able to display @b{BBDB} entries for messages displayed in +@b{Gnus}. + +@node MH-E Prep, RMAIL Prep, Gnus Prep, Initial Configuration +@subsubsection Initializing @b{BBDB} support for MH-E + +To take advantage of the @b{MH-E} features of the @b{BBDB}, add the +following form to your Emacs configuration file: @refill + +@example +(add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh) +@end example + +@code{bbdb-insinuate-mh} adds bindings for the default keys to +@b{MH-E} and configures @b{MH-E} to notify the @b{BBDB} when new +messages are loaded. This notification is required if the @b{BBDB} is +to be able to display @b{BBDB} entries for messages displayed in +@b{MH-E}. + +@node RMAIL Prep, Sendmail Prep, MH-E Prep, Initial Configuration +@subsubsection Initializing @b{BBDB} support for RMAIL + +To take advantage of the @b{RMAIL} features of the @b{BBDB}, add the +following form to your Emacs configuration file: @refill + +@example +(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail) +@end example + +@code{bbdb-insinuate-rmail} adds bindings for the default keys to +@b{RMAIL} and configures @b{RMAIL} to notify the @b{BBDB} when new +messages are loaded. This notification is required if the @b{BBDB} is +to be able to display @b{BBDB} entries for messages displayed in +@b{RMAIL}. + +@node Sendmail Prep, VM Prep, RMAIL Prep, Initial Configuration +@subsubsection Initializing @b{BBDB} support for Sendmail + +To take advantage of send-mail-mode (the one invoked with @code{M-x +mail}) features of the @b{BBDB}, add the following form to your Emacs +configuration file: @refill + +@example +(add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) +@end example + +@code{bbdb-insinuate-sendmail} enables auto-completion in +send-mail-mode. + +@node VM Prep, Message Prep, Sendmail Prep, Initial Configuration +@subsubsection Initializing @b{BBDB} support for VM + +To take advantage of the @b{VM} features of the @b{BBDB}, either add +@code{'vm} to the parameters of the @code{(bbdb-initialize)} form, or +add the following form to your @file{~/.vm} file: + +@example +@code{(bbdb-insinuate-vm)} +@end example + +@code{bbdb-insinuate-vm} adds bindings for the default keys to @b{VM} +and configures @b{VM} to notify the @b{BBDB} when new messages are +loaded. This notification is required if the @b{BBDB} is to be able to +display @b{BBDB} entries for messages displayed in @b{VM}. + +@node Message Prep, Reportmail Prep, VM Prep, Initial Configuration +@subsubsection Initializing @b{BBDB} support for Message mode + +To allow the @b{BBDB} to be used in Message mode, add the following form +to your Emacs initialization file: + +@example +@code{(bbdb-insinuate-message)} +@end example + +@code{bbdb-insinuate-message} adds a binding for @kbd{M-TAB} to Message +mode. This will enable completion of addressees based on @b{BBDB} +records. See @ref{Using Message Mode} for more details on the operation +of Message mode @b{BBDB} record completion. + +@node Reportmail Prep, Supercite Prep, Message Prep, Initial Configuration +@subsubsection Initializing @b{BBDB} support for Reportmail + +To allow the Reportmail package to report information from @b{BBDB} +records for new mail, add the following form to your Emacs +initialization file: + +@example +@code{(bbdb-insinuate-reportmail)} +@end example + +@code{bbdb-insinuate-reportmail} adds to the +@code{display-time-get-field} function to allow access to @b{BBDB} +records during new mail information display. See @ref{Using Reportmail} +for more details on the operation of Reportmail with the @b{BBDB}. + +@node Supercite Prep, Web Browser Prep, Reportmail Prep, Initial Configuration +@subsubsection Initializing @b{BBDB} support for Supercite + +To allow the @b{BBDB} to assist in the storage of Supercite citations, +add the following form to your Emacs initialization file: + +@example +@code{(bbdb-insinuate-sc)} +@end example + +@code{bbdb-insinuate-sc} adds @b{BBDB} functions to two Supercite hooks +- @code{sc-post-hook} and @code{sc-attribs-postselect-hook}. See +@ref{Using Supercite} for more details on the operation of Supercite +citation management using the @b{BBDB}. + +Three other Supercite variables must be set/modified to allow the +@b{BBDB} to work with it. These variables are not automatically set as +it would be impossible to reliably set them without interfering with +other user customizations. The modifications are: + +@table @code +@item sc-preferred-attribution-list +@code{"sc-consult"} should be added to the list. An example +configuration is: + +@example +(setq sc-preferred-attribution-list + '("sc-lastchoice" "x-attribution" "sc-consult" + "initials" "firstname" "lastname")) +@end example + +@item sc-attrib-selection-list +The following form should be added to @code{sc-attrib-selection-list}: + +@example + '(("sc-from-address" + ((".*" . (bbdb/sc-consult-attr + (sc-mail-field "sc-from-address")))))) +@end example + +@item sc-mail-glom-frame +The following form should be added to @code{sc-mail-glom-frame}, to +allow the retrieval of the name of a person who is a) in the @b{BBDB} +and b) has only included their net address in the message in question. + +@example + ("^$" (progn (bbdb/sc-default) + (list 'abort '(step . 0)))) +@end example + +An example configuration is as follows: + +@example +@exdent @code{(setq sc-mail-glom-frame} +@exdent @code{ '((begin (setq sc-mail-headers-start (point)))} +@exdent @code{ ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t)} +@exdent @code{ ("^\\S +:.*$" (sc-mail-fetch-field) nil t)} +@exdent @code{ ("^$" (progn (bbdb/sc-default)} +@exdent @code{ (list 'abort '(step . 0))))} +@exdent @code{ ("^[ \t]+" (sc-mail-append-field))} +@exdent @code{ (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))} +@exdent @code{ (end (setq sc-mail-headers-end (point)))))} +@end example +@end table + +The above is also documented in @file{bbdb-sc.el}. The +@code{bbdb/sc-setup-variables} function has been provided as an example for +Supercite variable initialization. Please note that while +@code{bbdb/sc-setup-variables} makes every attempt to safely configure +the Supercite variables, it will not always work. Specifically, the +variables @code{sc-attrib-selection-list} and @code{sc-mail-glom-frame} +will not be overridden if they have already been defined. + +@node Web Browser Prep, , Supercite Prep, Initial Configuration +@subsubsection Initializing @b{BBDB} support for Web Browsers + +To allow URLs to be added to @b{BBDB} records, add the following form to +your Emacs initialization file: + +@example +@code{(bbdb-insinuate-w3)} +@end example + +@code{bbdb-insinuate-w3} adds the definition of @kbd{:} to the W3 +keymap. + +The other @code{bbdb-w3} functions, specifically the passing of URLs +from @b{BBDB} records to Web browsers, do not require initialization +within the @b{BBDB}. They do, however, require the configuration of the +@code{browse-url} package so it knows to which Web browser URLs are to +be passed. For more details on the operation of @code{bbdb-w3}, see +@ref{Using Web Browsers}. + +@node The BBDB, BBDB Mode, Installation, Top +@section The @b{BBDB} + +This section discusses the basics of the @b{BBDB} - an overview of the +database's layout, and a discussion of the basic @b{BBDB} manipulation +commands. + +The database itself lives in a file which is named by the variable +@code{bbdb-file}. If this variable is not set, the database is assumed +to be in @file{~/.bbdb}. + +@menu +* Database Fields:: Description of database fields +* Basic Searching:: Basic database searching commands +* Advanced Searching:: Advanced database searching commands +* Manual Record Addition:: Adding records by hand +@end menu + +@node Database Fields, Basic Searching, The BBDB, The BBDB +@subsection Database Fields + +The database is organized as a set of records, where each record +corresponds to one person or organization. Each record has several +fields, and each field is of one of several types. Below, the built-in +types are listed, followed by a description of how and why some types +can be used more than once in a single record: @refill +@cindex Builtin field types + +@multitable @columnfractions .1 .5 .4 +@item Type +@tab Description +@tab Notes + +@item @code{name} +@tab The name of this person, or none if the record corresponds to an +organization. +@tab Single value, single instance. + +@item @code{company} +@tab The name of this person's organization, or none. +@tab Single value, single instance. + +@item @code{AKA} +@tab A list of other names for this person. +@tab Multiple values through commas. + +@item @code{net} +@tab A list of this person's network addresses. +@tab Multiple values through commas. + +@item @code{address} +@tab A list of postal (physical) addresses for this person. +@tab Multiple values through multiple occurences. + +@item @code{phone} +@tab A list of telephone numbers for this person. +@tab Multiple values through multiple occurences. + +@item @code{notes} +@tab Random commentary. +@tab Multiple values through multiple occurences. + +@end multitable + +The field types listed above can be classified into four categories, as +indicated by the comments in the `Notes' column. + +Field types marked as "Single value, single occurrence" may only occur +once per record. Each occurrence can only have a single value. For +example, there will be only one field of type @code{name} in a record. +It will be named @code{name}, and will contain a single value (the +person's name). + +The types marked as "Multiple values through commas" are essentially the +same as the single value, single occurrence field types, but with one +crucial difference: they can contain multiple values in the form of a +comma-separated list. So, for example, while a @code{name} field with a +value of "foo, bar" would be treated as if it contained the single value +"foo, bar", a @code{net} field with the same data would be thought of as +having two separate values - "foo" and "bar". As in the single +occurrence, single value field types, there will be only one occurrence +of each "Multiple values through commas" field type, and the occurrence +will have the same name as the type. + +The "Multiple values through multiple occurrences" field type is the +most flexible of the four listed here. There can be multiple +occurrences of each type. This type necessarily does not have the name +restriction imposed by the previous two types. For example, there can +be multiple fields of the @code{address} type, none of which have to be +named @code{address}. One could be named @code{home}, and the other +could be named @code{work}. + +Special properties of the @code{notes} field type: All user-defined +fields that don't fit into the other predefined field types +(@code{name}, @code{company}, @code{AKA}, @code{net}, @code{address}, +and @code{phone}) will be created as a @code{notes}-type field. In +addition, several of the user-defined field names are "special". That +is, the @b{BBDB} treats the values of these "special" fields differently +than it does other user-defined fields. The "special" fields are: + +@cindex Special Field Names +@table @code +@item attribution +@vindex bbdb/sc-attribution-field +@i{(Available only when the Supercite-specific @b{BBDB} functions have been +enabled)} Used for the storage of Supercite attributions. For initialization +details, see @ref{Supercite Prep}. For usage details, see @ref{Using +Supercite}. The field used can be changed by changing the value of +@code{bbdb/sc-attribution-field}. +@item aka +Used to store non-primary names associated with a given record. +@item face +@i{(XEmacs only)} Used for the storage of image data. This data is to be +in the format output by @code{compface}, and commonly found in +@code{X-Face:} headers in messages. If face support has been compiled +into XEmacs, the image contained in the @code{face} header will be +displayed when the record is viewed. +@item finger-host +@vindex bbdb-finger-host-field +Address used in place of the listed net address for fingering the entity +indicated by the record. @xref{BBDB Mode}. The field used can be changed by +changing the value of @code{bbdb-finger-host-field}. +@item gnus-score +@vindex bbdb/gnus-score-field +@b{Gnus} scoring adjustment for this person. For initialization details, see +@ref{Gnus Prep}. For usage details, see @ref{Gnus Features}. The field used +can be changed by changing the value of @code{bbdb/gnus-score-field}. +@item mail-alias +@cindex mail-alias definition +Value used instead of @code{name} for completion. @xref{Mail Sending +Interfaces}. +@item mail-name +Used for the storage of non-default names to be used as name in email +addresses. See also @ref{Reportmail Prep} and see @ref{Using Reportmail}. +@item mark-char +The field containing the character to be used for marking a given poster +in the Gnus Summary Buffer. For usage details, see @ref{Gnus Summary Buffer}. +@item title +The field containing the title of a person. +@item tex-name +@cindex Printing records in the database +@findex bbdb-print +The value of this field is used in place of the @code{name} field when +printing the database using @code{bbdb-print}. @xref{bbdb-print}. +@item www +This field contains the URL associated with the @b{BBDB} record. Common uses +are with @code{bbdb-snarf} (@pxref{bbdb-snarf}) and the @b{BBDB}/Web Browser +functionality (for initialization details, see @ref{Web Browser Prep}. For +usage details, see @ref{Using Web Browsers}). +@end table + +@node Basic Searching, Advanced Searching, Database Fields, The BBDB +@subsection Basic searching commands + +You can list the contents of the database with the command +@w{@kbd{M-x bbdb}}. You will be prompted for a regular expression, and all +records which match that regexp in the name, company, network address, +or any notes fields will be displayed.@refill +@cindex Searching the database +@findex bbdb +@findex bbdb-name +@findex bbdb-company +@findex bbdb-net +@findex bbdb-notes + +A narrower search may be made by using the commands @kbd{bbdb-name}, +@kbd{bbdb-company,} @kbd{bbdb-net,} or @kbd{bbdb-notes}. These commands +limit their searches to the name, company, email address, and notes +fields, respectively. If these commands are given a prefix argument, +the listing displayed will be one line per entry; otherwise, the full +database entry will be shown on multiple lines. + +The functions described above are predefined to certain keys in the +@code{*BBDB*} buffer. @xref{BBDB Mode}. for more details. + +@cindex User-defined fields +The @code{bbdb-notes} command will prompt for the notes field to search +(@kbd{RET} for all). In this way you can limit your searches to the +contents of one particular user-defined notes field. (You can add +user-defined fields with the @code{bbdb-insert-new-field} command; +@xref{BBDB Mode}.)@refill + +@cindex Elided display +@cindex One-line display + +@node Advanced Searching, Manual Record Addition, Basic Searching, The BBDB +@subsection Advanced searching commands + +The following functions can be used to search for records based on +creation and/or modification dates. These functions will match records +that have @code{timestamp} and/or @code{creation-date} fields (as +appropriate. @xref{Predefined Hooks}. for more information on these +fields, which are created by default. + +@table @code +@findex bbdb-timestamp-older +@item bbdb-timestamp-older +Display all records modified before a given date. If this function is +called interactively, it will prompt for a date. If it is being called +non-interactively, the date should be provided as a string in +@samp{yyyy-mm-dd} format. + +@findex bbdb-timestamp-newer +@item bbdb-timestamp-newer +Display all records modified after a given date. If this function is +called interactively, it will prompt for a date. If it is being called +non-interactively, the date should be provided as a string in +@samp{yyyy-mm-dd} format. + +@findex bbdb-creation-older +@item bbdb-creation-older +Display all records created before a given date. If this function is +called interactively, it will prompt for a date. If it is being called +non-interactively, the date should be provided as a string in +@samp{yyyy-mm-dd} format. + +@findex bbdb-creation-newer +@item bbdb-creation-newer +Display all records created after a given date. If this function is +called interactively, it will prompt for a date. If it is being called +non-interactively, the date should be provided as a string in +@samp{yyyy-mm-dd} format. + +@findex bbdb-creation-no-change +@item bbdb-creation-no-change +Display all records that have not been changed since creation. +@end table + +@node Manual Record Addition, , Advanced Searching, The BBDB +@subsection Manual record addition + +There are several ways to add new entries to the Insidious Big Brother +Database; the most straightforward is to use @w{@kbd{M-x bbdb-create}}, +which will prompt you for all relevant information. However, the +easiest way is to allow them to be added automatically by one of the +mail or news-reading interfaces (@xref{Interfaces}.). @refill + +@cindex Creating new records +@cindex Adding new records + +There is also @w{@kbd{bbdb-snarf}} (@pxref{bbdb-snarf}.), which will +attempt to create a record from a text block. Note that this depends +on particular formatting and may not do exactly what you want. + +@node BBDB Mode, Interfaces, The BBDB, Top +@section BBDB Mode + +@subsection Functions bound to keys in @b{BBDB} Mode + +When the @samp{*BBDB*} buffer is active (either summoned by one of the +commands in the previous section [@xref{The BBDB}.] or by your mail +or news program), a variety of commands become available for database +manipulation. Some of the commands listed below take numeric arguments. +These arguments can be generated by entering the number before pressing +the key(s) corresponding to the desired command. The output (if any) of +the listed commands will be displayed in the @samp{*BBDB*} buffer, and +can be navigated through using the usual cursor motion commands. +@cindex BBDB Mode +@cindex *BBDB* buffer + +@table @kbd +@item e +@findex bbdb-edit-current-field +@cindex Editing fields +@cindex Changing fields +(@code{bbdb-edit-current-field}) Edit the field on the current line. If +the cursor is in the middle of a multi-line field, such as an address or +comments section, then the entire field is edited, not just the current +line. @refill + +@item ; +@findex bbdb-edit-notes +(@code{bbdb-edit-notes}) A shortcut for editing the @var{notes} field. @refill + +@item d, C-k +@findex bbdb-delete-current-field-or-record +@cindex Deleting fields +@cindex Removing fields +(@code{bbdb-delete-current-field-or-record}) Delete the field on the +current line. If the current line is the first line of a record, the +@b{BBDB} will, after prompting the user, delete the entire record from +the database. This may also be applied to multiple records at once by +@kbd{*}. + +@item C-o +@findex bbdb-insert-new-field +@cindex Adding new fields +@cindex Inserting new fields +@cindex User-defined fields +(@code{bbdb-insert-new-field}) Inserts a new field into the current +record. You are prompted (with completion) for the type of field to +insert (@b{phone}, @b{address}, @b{notes}, etc); if the string you type +is not a known field type, you will be asked whether to add a new field +with the entered name of type @code{notes}. + +@cindex Phone numbers +@cindex North American phone numbers +@cindex European phone numbers +If you are inserting a new phone-number field, you can control whether +it is a North American or European phone number by providing a prefix +argument. A prefix arg of @kbd{^U} means it's to be a euronumber, and +any other prefix arg means it's to be a a structured North American +number. If no prefix argument is supplied, the style used is controlled +by the variable @code{bbdb-north-american-phone-numbers-p}. @refill + +@item C-x C-t +@findex bbdb-transpose-fields +@cindex Reordering fields +@cindex Transposing fields +(@code{bbdb-transpose-fields}) This is like the @code{transpose-lines} +command, but it is for @b{BBDB} fields. If the cursor is on a field of +a @b{BBDB} record, that field and the previous field will be +transposed.@refill + +With non-zero numeric argument @var{ARG}, the previous field is moved +past @var{ARG} fields. With argument 0, the field indicated by +@i{point} is interchanged with the one indicated by @i{mark}. + +Both fields must be in the same record, and must be of the same basic type +(that is, you can use this command to change the order in which phone-number +fields are listed, but you can't use it to make an address appear before a +phone number; the order of field types is fixed.)@refill + +@item n, p +@findex bbdb-next-record +@findex bbdb-prev-record +(@code{bbdb-next-record}, @code{bbdb-prev-record}) Move to the next and +previous displayed record, respectively. @refill + +@item t +@findex bbdb-toggle-records-display-layout +(@code{bbdb-toggle-records-display-layout}) Toggles the display layout of a +record. With a numeric argument +of 0, the current record will be made displayed in one line layout; with any +other argument, the current record will be shown in multi-line layout. @refill + +If @kbd{*t} is used instead of simply @kbd{t}, then the state of all +records will be changed instead of just the one at point. In this case, +a numeric argument of 0 means that all records will unconditionally be +made one-line layout; any other numeric argument means that all of the records +will unconditionally be shown expanded; and no numeric argument means +that the records are made to be in the opposite state of the record +under point. @refill + +@item T +@findex bbdb-display-record-completely +(@code{bbdb-display-record-completely}) +Show all the fields of the current record. +The display layout `full-multi-line' is used for this. +@refill + +@item o +@findex bbdb-omit-record +(@code{bbdb-omit-record}) Removes the current record from the display, +but does not delete it from the database; it merely makes it seem as if +the most recent search had not matched this record. With a numeric +argument, omit the next N records. With a negative argument, go +backwards. @refill + +@item m +@findex bbdb-send-mail +@cindex Sending mail +@vindex bbdb-send-mail-style +(@code{bbdb-send-mail}) Begin composing mail to the person represented +by the current record. The first email address is used. Normally, the +mail-sending package which is used is determined by which mail-reading +package is loaded; that is, if @b{MH-E} is loaded, then @code{mh-send} +will be used; if @b{VM} is loaded, then @code{vm-mail} is used; if +@b{message} is loaded, then it is used; otherwise, @code{mail} is used. +You can override this by setting the variable +@code{bbdb-send-mail-style} to one of the symbols @code{vm}, @code{mh}, +@code{message}, or @code{mail}. @refill + +If @kbd{*m} is used instead of simply @kbd{m}, then mail will be sent to +all of the folks listed in the @samp{*BBDB*} buffer instead of just the +person under point. @refill + +This function does not at present use the facility provided by +@code{compose-mail} and @code{mail-user-agent}. In a future version of +the @b{BBDB}, it will. + +@item s, C-x C-s +@findex bbdb-save-db +@cindex Saving your changes +(@code{bbdb-save-db}) Saves the @b{BBDB} file to disk. + +@item r +@findex bbdb-refile-record +@cindex Fixing mistakes +@cindex Merging records +(@code{bbdb-refile-record}) Merge the current record into some other record; +that is, delete the record under point after copying all of the data +within it into some other record. this is useful if you realize that +somehow a redundant record has gotten into the database, and you want to +merge it with another. @refill + +If both records have names and/or companies, you are asked which to use. +Phone numbers, addresses, and network addresses are simply concatenated. +The first record is the record under the point; the second is prompted +for. Completion behavior is as dictated by the variable +@code{bbdb-completion-type}. @refill + +@item M-d +@findex bbdb-dial +@cindex Dialling phone numbers +(@code{bbdb-dial}) This command will attempt to dial the phone number +currently at point, or if point is at the start of a record, the first +phone number in the record. An extension, if present, is disregarded. +@refill + +The method of dialling is controlled by @code{bbdb-modem-dial}. If this +variable is nil, the @b{BBDB} will play touchtones corresponding to the +number to be dialled. Otherwise, this variable is treated as a modem +command string to be prepended to the number prior to feeding it to +@code{bbdb-modem-device}. @refill + +The @b{BBDB} plays touchtones using @code{bbdb-sound-player} to play the +sounds and the elements of @code{bbdb-sound-files} as the audio to be +played. The first ten elements of @code{bbdb-sound-files} correspond to +the touchtones for the digits @samp{0} to @samp{9}, while the eleventh +and twelfth elements correspond to @samp{#} and @samp{*} +respectively. The default configuration assumes a Solaris[tm] +installation with the demonstration sound files in +@code{/usr/demo/SOUND/sounds}. @refill + +The actual number dialled depends on the following variables: + +@table @code +@item bbdb-dial-local-prefix-alist +@vindex bbdb-dial-local-prefix-alist +This is a list of (SEXPR REPLACEMENT) pairs. SEXPR is evaluated to +produce a regular expression which is then applied to the number. If it +matches, whatever it matches is replaced by REPLACEMENT. The match and +replace is performed using each item in the list that matches, in +sequence, so that the output from one item may become input to another. +The default value for this variable is to remove +@code{(bbdb-default-area-code)} (i.e. the value of that variable, in +parenthesis) from the start of the number to be dialled.@refill + +@b{Note:} If this procedure produces a transformed number then no +further modifications (such as prefix additions, below) will be made to +the number before dialling.@refill + +Using a prefix argument to @code{bbdb-dial} disables the processing of +this variable. The other modifiers, below, are not affected by +this.@refill + +@item bbdb-dial-local-prefix +@vindex bbdb-dial-local-prefix +If the number to be dialled starts with a zero, it is deemed to be a +local number, and @code{bbdb-dial-local-prefix} is prepended to it (see +note above concerning @code{bbdb-dial-local-prefix-alist} processing, +however).@refill + +@item bbdb-dial-long-distance-prefix +@vindex bbdb-dial-long-distance-prefix +If the number to be dialled starts with a plus sign (+), it is deemed to +be a long distance number, and @code{bbdb-dial-long-distance-prefix} is +prepended to it (see note above concerning +@code{bbdb-dial-local-prefix-alist} processing, however).@refill + +@end table + +@item f +@findex bbdb-finger +@cindex Finger interface +(@code{bbdb-finger}) This command fingers the network address of a +@b{BBDB} record. If this command is executed from the @samp{*BBDB*} buffer, +it fingers the network address of the record which is at point; otherwise, +it prompts in the minibuffer (with completion) for a user to finger. With a +numeric prefix argument, it fingers the @i{N}th network address of the +current record; with a prefix argument of @kbd{^U}, it fingers all of them. +The @samp{*finger*} buffer is filled asynchronously, meaning that you don't +have to wait around for it to finish; but fingering another user before +the first finger has finished could have unpredictable results.@refill + +If this command is executed from the @samp{*BBDB*} buffer, it may be prefixed +with @kbd{*} (as in @kbd{*f} instead of simply @kbd{f}), meaning to +finger all of the users currently listed instead of just the one under +point. The numeric prefix argument has the same interpretation. @refill + +@vindex bbdb-finger-host-field +You can define a special network address to ``finger'' by defining a field +@code{finger-host}. The name of the field to be fingered can be changed +by setting @code{bbdb-finger-host-field}. + +@item q +@findex bbdb-bury-buffer +(@code{bbdb-bury-buffer}) Hides the @samp{*BBDB*} buffer. @b{Note:} +This command does @b{not} kill the @samp{*BBDB*} buffer. + +@item ? +@findex bbdb-help +(@code{bbdb-help}) This displays a one-line help message in the +minibuffer, showing some of the most common bbdb-mode commands. + +@item i +@findex bbdb-info +(@code{bbdb-info}) This documentation is displayed. Please note that +either @file{bbdb} or @file{bbdb.info} must be installed in one of the +info directories known to Emacs for this command to work. + +@table @code +@item bbdb-info-file +@vindex bbdb-info-file +If this documentation is not installed in the standard Info directory, +then you should set this variable to the name of the texinfo-formatted +version of this file; the @code{bbdb-info} command will use this file +instead.@refill +@end table + +@item W +@cindex Browsing the Web page for the current record +@findex bbdb-www +(@code{bbdb-www}) Displays the Web page listed in the @code{www} field +of the current record. @xref{Using Web Browsers}. + +@item P +@cindex Printing records in the database +@findex bbdb-print +(@code{bbdb-print}) Creates a TeX file that contains a pretty-printed version +of @b{BBDB} records. If prefixed by @kbd{*}, only the records currently +displayed will print. @xref{bbdb-print}. + +@item h +@cindex Changing windows +Moves point to another window via the @code{other-window} function. + +@item c +@cindex Creating new records +@findex bbdb-create +(@code{bbdb-create}) Create a new database record from information +supplied by the user. + +@item C +@cindex Displaying changed records +@findex bbdb-changed +(@code{bbdb-changed}) Display all records that have been changed since +the last time the database was saved. + +@item b +@cindex Searching the database +@findex bbdb +(@code{bbdb}) Begin a new database search. The results of the new +search will be displayed in place of the results of the old search. + +@item S a, S c, S o, S n +@cindex Searching the database +@findex bbdb-net +@findex bbdb-company +@findex bbdb-notes +@findex bbdb-name +(@code{bbdb-net}, @code{bbdb-company}, @code{bbdb-notes}, +@code{bbdb-name})@* +Begin a new database search. This search will be +limited to the net address, company, notes, or name fields, +respectively, of database records. @xref{Basic Searching}. for more +details. + +@item * +@findex bbdb-append-records +@code{bbdb-append-records} will make the next display/search +command to append its results to the BBDB buffer instead of replacing its +content. + +With an prefix arg (C-u) toggle between always append and no append. +With an prefix arg that is a positive number append will be enabled for that +many times. +With any other argument append will be enabled once."@refill + +@end table + +@subsection Other database manipulation functions + +@table @code +@findex bbdb-kill-older +@item bbdb-kill-older +If called interactively (or with a single argument - a date in +@samp{yyyy-mm-dd} format), it will kill all records that were last +modified before the given date as determined by the @code{timestamp} +field. @xref{Predefined Hooks}. If called non-interactively with a +date (in @samp{yyyy-mm-dd} format), a comparison function and an action +function, the comparison function is applied to the @code{timestamp} +field of all records, and the action function applied to those for whom +the comparison function returns true. If @samp{nil} is supplied as the +comparison function, @code{string-lessp} is used. + +@end table + +@node Interfaces, Reader-specific Features, BBDB Mode, Top +@section Interfaces + +The @b{BBDB} interfaces itself with several message-handling packages, but +certain parameters control its behavior depending on whether it is +being used from within a mail reader or a news reader. @refill + +In all of these packages, two new keybindings will be added: + +@table @kbd +@item : +@cindex Showing the sender of the current message +@findex bbdb/vm-show-sender +@findex bbdb/rmail-show-sender +@findex bbdb/mh-show-sender +@findex bbdb/gnus-show-sender +(@code{bbdb/@i{package}-show-sender}) Displays the @b{BBDB} entry corresponding +to the author of the current message. If there is none, you will be +asked whether to create one. The function called is +@code{bbdb/@i{package}-show-sender}, where @code{@i{package}} is either +@code{gnus}, @code{mh}, @code{rmail}, or @code{vm}, depending on the +mail or news program being used when the command is invoked. + +@item ; +@cindex Annotating the sender of the current message +@findex bbdb/vm-annotate-sender +@findex bbdb/rmail-annotate-sender +@findex bbdb/mh-annotate-sender +@findex bbdb/gnus-annotate-sender +(@code{bbdb/@i{package}-annotate-sender}) Lets you edit the @samp{notes} +field of the @b{BBDB} record corresponding to the sender of the current +message. If there is no record for the current author, you will be +asked whether to create one. The function called is +@code{bbdb/@i{package}-annotate-sender}, where @code{@i{package}} is +either @code{gnus}, @code{mh}, @code{rmail}, or @code{vm}, depending on +the mail or news program being used when the command is invoked. +@end table + +These keybindings (and several other features) will not be +available unless you call the appropriate ``insinuation'' +function; @xref{Installation}.@refill + +It is possible to configure @b{BBDB} so that it automatically creates a +record when it sees a message from a person who is not in the database. +It is also possible to have text automatically added to the notes field +of the corresponding record depending on the contents of the message +headers. @xref{Customization Hooks}.@refill + +@menu +* Mail Reading Interfaces:: Mail Reading Interfaces +* News Reading Interfaces:: News Reading Interfaces +* Mail Sending Interfaces:: Mail Sending Interfaces +@end menu + +@node Mail Reading Interfaces, News Reading Interfaces, Interfaces, Interfaces +@subsection Mail Reading Interfaces + +There are BBDB interfaces for the following mail readers: + +@itemize @bullet +@item +@b{Gnus}, a news- and email- reader written by Lars Magne Ingebrigtsen +(based on @b{GNUS} by Mansanobu Umeda). +@item +@b{MH-E}, the Emacs interface to @b{Mail Handler} (@b{MH}), from the +standard emacs library, but packaged separately from XEmacs since +version 20.4.@refill +@item +@b{RMAIL}, from the standard emacs library (packaged separately for +XEmacs users as of 20.4); +@item +@b{View Mail}, by Kyle Jones, version 5.31 or newer; +@end itemize + +@node News Reading Interfaces, Mail Sending Interfaces, Mail Reading Interfaces, Interfaces +@subsection News Reading Interfaces + +There are BBDB interfaces for the following news readers: + +@itemize @bullet +@item +@b{GNUS}, a newsreader written by Masanobu Umeda. @refill +@item +@b{Gnus}, the modern news- and email-reading incarnation of @b{GNUS}. +@b{Gnus} is written by Lars Magne Ingebrigtsen.@refill +@end itemize + +@node Mail Sending Interfaces, , News Reading Interfaces, Interfaces +@subsection Mail Sending Interfaces + +@findex bbdb-complete-name +@vindex bbdb-dwim-net-address-allow-redundancy +@vindex bbdb-dwim-net-address-title-field +@cindex Name completion +@cindex Mail address completion +@cindex Address completion +@cindex Format of completed address +When sending mail, the keystroke @kbd{M-TAB} is bound to the +function @code{bbdb-complete-name}. This will take the string that +you have typed (from point back to the preceding colon, comma, or +the beginning of the line) and will complete that against the +contents of the database. What you have typed may be an initial +subsequence of a person's full name or network address; if it +completes ambiguously, then what you have typed will be replaced +with the common portion of the matches. Typing @kbd{M-TAB} again will +show a list of possible completions. If it completes unambiguously, +then an address will be inserted. The variable +@code{bbdb-completion-type} controls whether completion is done on real +names, or network addresses, or both. The address inserted is normally +of the form @w{@code{User Name <email-address>}}; however, if +@code{User Name} has an address of the form +@code{<user.name@@somedomain>}, only the @code{<email-address>} portion +is inserted. This can be overridden by setting +@code{bbdb-dwim-net-address-allow-redundancy} to @code{t}. +If @code{User name} has the field configured by +@code{bbdb-dwim-net-address-title-field} it will be prepended. +@refill + +This binding is automatically set by the various insinuation functions +documented earlier in this manual. (@xref{Initial Configuration}.) +Briefly, the forms for these functions are: + +@table @b +@item Gnus +@code{(add-hook 'gnus-Startup-hook 'bbdb-insinuate-gnus)} @i{for Gnus 3.14 or older}@* +@code{(add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)} @i{for Gnus 3.15 or newer} +@item MH-E +@code{(add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)} +@item RMAIL +@code{(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)} +@item sendmail +@code{(add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)} +@item VM +@code{(bbdb-insinuate-vm)} @i{Add to @file{~/.vm} file} +@end table + +@noindent +The above forms should be added to your Emacs initialization file, +except where otherwise noted. + +You can control what ``real name'' is inserted with the +@code{mail-alias} field: if a record has a @code{mail-alias} +field, then that is used instead of their @code{name} field. + +@vindex bbdb-completion-display-record +If the variable @code{bbdb-completion-display-record} is true (the +default) then when you successfully complete an address with +@kbd{M-TAB}, the corresponding record will be appended to +the @samp{*BBDB*} buffer. The buffer will not be displayed if it +is not already visible, but the record will be displayed there. + +@findex bbdb-yank-addresses +@cindex Sending mail +When sending mail, you can use the command @code{bbdb-yank-addresses} +to CC the current message to the people currently displayed in +the @samp{*BBDB*} buffer. This is useful if you are in the midst of +sending or replying to a message, and you decide to add some recipients. +You can use one of the @kbd{M-x bbdb} commands to display the set of +people that you want to CC the message to, and then execute this command +to add them to the list. + +@unnumberedsubsec Mailing Lists and Mail Aliases + +@cindex Mailing lists +@cindex Mail Aliases +@cindex mail-alias usage +@findex bbdb-define-all-aliases +@findex bbdb-add-or-remove-mail-alias +@findex define-mail-alias + +If you are using Jamie Zawinski's @file{mail-abbrevs.el} package, which +uses the word-abbrev mechanism for mail aliases, then you can store your +mail aliases in the BBDB instead of duplicating the information +elsewhere.@refill + +If you want a mail alias to be defined for a person, simply add a +@code{mail-alias} field to their record. You may have multiple aliases +for the same person; simply separate them with commas.@refill + +For convenience there is the function @code{bbdb-add-or-remove-mail-alias} +bound to @kbd{a} which adds an alias to one or multiple records when prefixed +by a @kbd{*}. Called with a prefix argument @kbd{C-u} it will remove +the given alias.@refill + +If more than one person has the same mail-alias, then that alias expands +to the addresses of all of those people; in this way you can maintain +mailing lists within the BBDB.@refill + +When you want to group aliases as in @code{.mailrc} you may just +retained the group aliases in your @code{.mailrc}. + +To actually define the aliases which are stored in the BBDB, call the +function @code{bbdb-define-all-aliases} from your +@code{mail-setup-hook} (or @code{message-setup-hook} if you use +Message mode coming with Gnus). This will search the database, and +call @code{define-mail-alias} to define each of the resulting +aliases.@refill + +@node Reader-specific Features, Other Packages, Interfaces, Top +@section Reader-specific Features + +There are features of the @b{BBDB} that are available only for specific +mail- and news-readers. These features are described below. + +The headers which are parsed for email addresses and what records are +displayed can be controlled by the following variables: +@vindex bbdb-get-addresses-from-headers +@vindex bbdb-get-addresses-to-headers +@vindex bbdb-get-addresses-headers +@vindex bbdb-get-only-first-address-p +@code{bbdb-get-addresses-from-headers} controls which headers are parsed +for sender addresses when calling the show-sender function of your MUA. +@code{bbdb-get-addresses-to-headers} controls which headers are parsed +for recipients addresses when calling the show-all-recipients function +of your MUA. When using the pop up feature it will search for the +addresses in @code{bbdb-get-addresses-headers} and display them. By +default it will list only the first address, but by setting +@code{bbdb-get-only-first-address-p} to @code{nil} one will will get +records for all addresses. + +If there is no MUA specific variable for ignoring certain addresses then +those addresses matching @code{bbdb-user-mail-names} will be ignored. + +@b{BBDB} adds the bindings @kbd{:} for showing all senders and @kbd{;} +for editing the notes of the sender. + +@menu +* Gnus Features:: Gnus-specific Features +* VM Features:: VM-specific Features +@end menu + +@node Gnus Features, VM Features, Reader-specific Features, Reader-specific Features +@subsection Gnus-specific Features + +The @b{BBDB} can be used to provide score information, or to integrate +database information into the @b{Gnus} Summary buffer or the @b{GNUS} +Subject List. + +@menu +* Gnus Scoring:: Store score adjustments in the @b{BBDB} +* Gnus Summary Buffer:: @b{BBDB} information in the Summary buffer +* GNUS Subject List:: @b{BBDB} information in the Subject List +@end menu + +@node Gnus Scoring, Gnus Summary Buffer, Gnus Features, Gnus Features +@subsubsection Scoring +@vindex bbdb/gnus-score-field +@vindex bbdb/gnus-score-default +@vindex gnus-score-find-score-files-function + +The @b{BBDB} can provide scoring information to @b{Gnus} in one of two +ways. + +@enumerate +@item +Articles whose authors appear in the @b{BBDB} and who have +@code{gnus-score} fields will have their scores adjusted by the value +contained in that field. +@item +Articles whose authors appear in the @b{BBDB} but who do not have +@code{gnus-score} fields will have their scores adjusted by +@code{bbdb/gnus-score-default}. If @code{bbdb/gnus-score-default} is +@code{nil}, no score adjustment will be made. +@end enumerate + +The @b{BBDB} by default searches the field contained in +@code{bbdb/gnus-score-field} for score values. To have the @b{BBDB} use +a different field, change the value of this variable. + +To enable @b{BBDB}-assisted scoring, add the @code{bbdb/gnus-score} +function to @code{gnus-score-find-score-files-function}. Assuming that +you want to preserve the default value of this variable, use a form +similar to the following: + +@example +(setq gnus-score-find-score-files-function + '(gnus-score-find-bnews bbdb/gnus-score)) +@end example + +@b{Note:} The default value in @b{Gnus} 5.5 is @code{gnus-score-find-bnews}. +Check your configuration before using the above code, as your values may +be different. + +@node Gnus Summary Buffer, GNUS Subject List, Gnus Scoring, Gnus Features +@subsubsection Gnus Summary Buffer Enhancements + +@b{Gnus} can use the @b{BBDB} to do one of two things: + +@itemize @bullet +@item +Mark authors in the Summary Buffer who have records in the @b{BBDB} with +a user-defined mark character. See Marking Posters, below. +@item +For authors in the Summary Buffer who also have records in the @b{BBDB}, +replace their name as listed in the Summary Buffer with their name as +stored in the @b{BBDB}. See Using Names from the @b{BBDB}, below. +@end itemize + +@subsubheading Marking Posters + +Authors with records in the @b{BBDB} can be marked either with a +user-defined mark character, or with a default one. The marking is +enabled by the use of a Gnus user format code, as determined by +@code{bbdb/gnus-summary-in-bbdb-format-letter}. This variable, which +defaults to @samp{b}, is used to create a format code which is intended +for use in @code{gnus-summary-line-format}. The format code is created +by concatenating @samp{%u} with the value of +@code{bbdb/gnus-summary-in-bbdb-format-letter}. In the default case +this results in the creation of the format code @samp{%ub}. + +Posts are marked as follows: If the record for the poster has the field +indicated in @code{bbdb-message-marker-field} (the default is +@code{mark-char}), the value of that field is used as the mark +character.@footnote{While it is possible to put a multi-character mark +in @code{bbdb-message-marker-field} and/or in +@code{bbdb/gnus-summary-known-poster-mark}, the resulting summary buffer +will be misaligned as a result. This misalignment will result from fact +that at this time the character used to indicate posts whose authors are +not in the @b{BBDB} is always a single character, and cannot be +changed.} If no such field is present, the value of +@code{bbdb/gnus-summary-known-poster-mark} will be used instead. If the +author is not in the @b{BBDB}, a space will be used as the mark character. + +@subsubheading Using Names from the @b{BBDB} + +The names reported for authors of posts in the Summary buffer can be +altered to conform to the values present in their respective @b{BBDB} +records (if any). This rewriting is enabled by the use of a Gnus user +format code, as determined by +@code{bbdb/gnus-summary-user-format-letter}. This variable, which +defaults to @samp{B}, is used to create a format code which is intended +for use in @code{gnus-summary-line-format}. The format code is created +by concatenating @samp{%u} with the value of +@code{bbdb/gnus-summary-user-format-letter}. In the default case this +results in the creation of the format code @samp{%uB}. This format code +is intended to @b{replace} the format code previously used in the Summary +buffer format line to indicate the author and/or net address (usually +@samp{%a}, @samp{%n}, and/or @samp{$N}). + +The effects of this format code are in two independent parts - the +marking of known posters, and the rewriting of posters names. The +first, the marking of posters, occurs only when +@code{bbdb/gnus-summary-mark-known-posters} is @code{t} (the default) +and the posters have entries in the @b{BBDB}. When this variable is +true, the marking occurs as described in the previous section, Marking +Posters, above. + +The poster name rewriting is done for all posters - not just for those +with records in the @b{BBDB}. That said, rewriting rules for posters in +the @b{BBDB} are more flexible than for those not listed. The rewriting is +governed by two variables, as described below. + +@code{bbdb/gnus-summary-prefer-real-names} can have one of three values - +@samp{t}, @samp{bbdb}, or @code{nil}. In general, this variable governs +the preference between net addresses and names. If it is @samp{t}, the +name (if any) will be used. If @samp{nil}, the net address will be +used. The third value, @samp{bbdb}, can be used as a method for +distinguishing between authors with records in the @b{BBDB} and those +without. If the variable is set to @samp{bbdb}, the name from the +@b{BBDB} record will be used if the author has a record in the +@b{BBDB}. If the author is not in the @b{BBDB}, the net address from +the message will be printed. This variable makes little sense if +@code{bbdb/gnus-summary-prefer-bbdb-data} is @samp{nil}, as no names +will be printed in the Summary buffer in this case - only net addresses. + +@code{bbdb/gnus-summary-prefer-bbdb-data} is used to (dis)allow use of +the @b{BBDB} for author data retrieval. If it is @samp{t}, data from +the @b{BBDB} will be used if available. If it is @samp{nil}, data from +the @b{BBDB} will not be used. + +@noindent +In the following examples, assume the following: + +@enumerate +@item +Message: @code{From: Jamie <jwz@@netscape.com>}@* +@b{BBDB}: No record +@item +Message: @code{From: Matt <simmonmt@@acm.org>}@* +@b{BBDB}: Name: @samp{Matthew}, Net: @samp{simmonmt@@purdue.edu} +@end enumerate + +@multitable @columnfractions .47 .17 .18 .18 +@item @code{bbdb/gnus-summary-prefer-bbdb-data} +@tab @center @code{t} +@tab @center @code{t} +@tab @center @code{nil} +@item @code{bbdb/gnus-summary-prefer-real-names} +@tab @center @code{t} +@tab @center @code{bbdb} +@tab @center @code{t} +@item Printed in Summary buffer for +@tab +@tab +@tab +@item @center Case 1 +@tab @center Jamie +@tab @center jwz@@netscape.com +@tab @center Jamie +@item @center Case 2 +@tab @center Matthew +@tab @center Matthew +@tab @center Matt +@end multitable + +@node GNUS Subject List, , Gnus Summary Buffer, Gnus Features +@subsubsection GNUS Summary Buffer Enhancements + +@i{This section is remarkably terse, as I don't have a copy of @b{GNUS}. +If anybody can provide more descriptive information, please let me +know.} + +@example +(autoload 'bbdb/gnus-lines-and-from "bbdb-gnus") +(setq gnus-optional-headers 'bbdb/gnus-lines-and-from) +@end example + +@table @code +@item bbdb/gnus-mark-known-posters +@vindex bbdb/gnus-mark-known-posters +@cindex GNUS Subject-buffer +If @code{t} (the default), then the @b{GNUS} subject list will contain an +indication of those messages posted by people who have entries in +the Insidious Big Brother Database (they will be marked with an +asterisk.) @refill + +@cindex mark-char +You can change the character used to mark records on a record-by-record +basis by adding a @code{mark-char} property to the record, whose value +is be the string to display (preferably one character.) @refill + +@item bbdb/gnus-header-prefer-real-names +@vindex bbdb/gnus-header-prefer-real-names +Default: @code{nil}. if @code{t}, then the @b{GNUS} subject list will +display real names instead of network addresses. @refill + +@item bbdb/gnus-header-show-bbdb-names +@vindex bbdb/gnus-header-show-bbdb-names +Default: @code{t}. If both this variable and +the @code{bbdb/gnus-header-prefer-real-names} variable are true, then +for news messages from people who are in your database, the name displayed +will be the primary name from the database, rather than the one from +the @samp{From:} line of the message. This doesn't affect the names of +people who aren't in the database, of course.@refill + +@item bbdb/gnus-lines-and-from-length +@vindex bbdb/gnus-lines-and-from-length +Default: 18. The number of characters used to display @samp{From:} info in +@b{GNUS}, if you have set @code{gnus-optional-headers} to +@code{bbdb/gnus-lines-and-from}. @refill +@end table + +@node VM Features, , Gnus Features, Reader-specific Features +@subsection VM-specific features + +The @b{BBDB} can be used to integrate database information into the +message summary. + +@menu +* VM Message Summary:: @b{BBDB} information in message summary +* VM what records are displayed:: +* VM automatic setup of vm-set-auto-folder-alist:: +* VM automatic adding of labels:: +@end menu + +@node VM Message Summary, VM what records are displayed, VM Features, VM Features +@subsubsection VM Message Summary Enhancements + +@vindex vm-summary-format +@findex vm-summary-function-B +@cindex %F +@cindex %UB +VM users can cause their summary buffer to display the name of the +message sender according to @b{BBDB} data, instead of according to the +contents of the current message's headers. In VM 5.40 or later, use +the summary format control @code{%UB"} instead of @code{"%F"}, and the +current record name will be shown there if available. If no entry is +found it behaves like @code{"%F"}. See the documentation for +@code{vm-summary-format} for more details. Warning, this may +significantly slow down summary generation for large folders. + +@node VM what records are displayed, VM automatic setup of vm-set-auto-folder-alist, VM Message Summary, VM Features +@subsubsection VM configuration of what records the @b{BBDB} buffer shows + +@vindex vm-summary-uninteresting-senders + +Email addresses which match @code{vm-summary-uninteresting-senders} are +ignored. + +The records in the @b{BBDB} buffer are listed in the same order as found. + +@node VM automatic setup of vm-set-auto-folder-alist, VM automatic adding of labels, VM what records are displayed, VM Features +@subsubsection VM automatic setup of @code{vm-set-auto-folder-alist} + +@vindex bbdb/vm-set-auto-folder-alist-field +VM users can setup the @code{vm-set-auto-folder-alist} automatically by +calling @code{bbdb/vm-set-auto-folder-alist}. This adds for each @b{BBDB} +record containing a @code{bbdb/vm-set-auto-folder-alist-field} an entry +to @code{vm-set-auto-folder-alist}. + +The record field can contain a string which is used as folder name or +if it starts with a @code{'} it is treated as lisp expression returning +a folder name. + +@node VM automatic adding of labels, , VM automatic setup of vm-set-auto-folder-alist, VM Features +@subsubsection VM automatic adding of labels + +@vindex bbdb/vm-auto-add-label-list +@vindex bbdb/vm-auto-add-label-field +@findex bbdb/vm-auto-add-label + +@code{bbdb/vm-auto-add-label-list} is a +List used by @code{bbdb/vm-auto-add-label} to automatically label messages. +Each element in the list is either a string or a list of two strings. +If a single string then it is used as both the field value to check for +and the label to apply to the message. If a list of two strings, the first +is the field value to search for and the second is the label to apply. + +@code{bbdb/vm-auto-add-label-field bbdb-define-all-aliases-field} is the +field used by @code{bbdb/vm-auto-add-label} to automatically label messages. +Value is either a single symbol or a list of symbols of bbdb fields that +@code{bbdb/vm-auto-add-label} uses to check for labels to apply to messages. +Defaults to @code{bbdb-define-all-aliases-field} which is typically +@code{mail-alias}. + +@code{bbdb/vm-auto-add-label} automatically adds labels to messages +based on the @code{bbdb/vm-auto-add-label-field +bbdb-define-all-aliases-field} field. Add this to +@code{bbdb-notice-hook} and if using VM each message that bbdb notices +will be checked. If the sender has a value in the +@code{bbdb/vm-auto-add-label-field} in their BBDB record that matches a +value in @code{bbdb/vm-auto-add-label-list} then a VM label will be +added to the message. + +This works great when `bbdb-user-mail-names' is set. As a result mail +that you send to people (and copy yourself on) is labeled as well. + +@node Other Packages, Options, Reader-specific Features, Top +@section Using the @b{BBDB} with other packages + +The @b{BBDB} adds functionality to several packages. The following sections +detail these augmentations. + +@menu +* Using Message Mode:: Using the @b{BBDB} with Message Mode +* Using Reportmail:: Using the @b{BBDB} with Reportmail +* Using Supercite:: Using the @b{BBDB} with Supercite +* Using Web Browsers:: Using the @b{BBDB} with Web Browsers +@end menu + +@node Using Message Mode, Using Reportmail, Other Packages, Other Packages +@subsection Using the @b{BBDB} with Message Mode + +At this time, the only feature the @b{BBDB} adds to Message mode is the binding +to @kbd{M-TAB} which allows for @b{BBDB} record completion. + +@node Using Reportmail, Using Supercite, Using Message Mode, Other Packages +@subsection Using the @b{BBDB} with Reportmail + +The @b{BBDB} can modify the @file{reportmail.el} package to use information +from @b{BBDB} records when identifying the senders or recipients of e-mail +messages. + +In normal operation, Reportmail displays the name and net address sender and +recipient of incoming messages. The @b{BBDB} can be configured to intercept +and rewrite this information before it appears in the Emacs mode-line. It +first attempts to rewrite the sender and/or recipient information by +substituting those addresses with information from the @b{BBDB}. Replacement +information is first sought from the @code{mail-name} field in the respective +@b{BBDB} records. If no such field is found, the @code{name} field is +returned. If no @b{BBDB} record is found, no rewriting is performed. + +The @b{BBDB}-Reportmail augmentation is accomplished through the advising of +the Reportmail @code{display-time-get-field} function in order to do +a-posteriori modification of the returned value. The augmentation uses the +@code{bbdb/reportmail-alternate-full-name} function to retrieve data from the +@b{BBDB} for use in rewriting. + +@node Using Supercite, Using Web Browsers, Using Reportmail, Other Packages +@subsection Using the @b{BBDB} with Supercite + +@c <rewrite> + +The @b{BBDB} can be used with Supercite to store attributions with @b{BBDB} +records. Normally, when a non-default attribution is entered for a given +message, the entered attribution is used for that message, and is then +discarded. When the @b{BBDB}-Supercite augmentation is enabled, the +non-default attribution will be added to the record (if any) for the entity +being cited. This poor explanation sounds complicated, but it's not. If a +message from @samp{Jamie Zawinski <jwz@@netscape.com>} is being replied to, +Supercite will, by default, suggest the citation @samp{Jamie}. If the +non-default citation @samp{jwz} is entered, Supercite can save it with the +@b{BBDB} record for @samp{Jamie Zawinski} in the @code{attribution} field. + +@c </rewrite> + +The field used can be changed by changing the value of +@code{bbdb/sc-attribution-field}. + +@node Using Web Browsers, , Using Supercite, Other Packages +@subsection Using the @b{BBDB} with Web Browsers + +The @b{BBDB}/Web Browser integration is in two parts, one which is +automatically enabled, and one which must be manually enabled (@pxref{Web +Browser Prep}). The first feature added is the ability to display the URL +associated with a given record in a Web Browser. The second is the ability to +add URLs to @b{BBDB} records from within W3, the Emacs Web Browser. + +Pressing @kbd{W} in the @code{*BBDB*} buffer while the cursor is positioned +over a record with a @code{www} field will cause the first URL in the field to +be loaded in a Web Browser. This functionality uses @code{browse-url} to +display URLs - see the documentation for @code{browse-url} for information on +selecting the browser to be used. + +If W3 is used, and if the @b{BBDB}/W3 functionality has been enabled as +described in @ref{Web Browser Prep}, pressing the @kbd{:} key will add the URL +currently being displayed in W3 to a user-specified @b{BBDB} record. + +@node Options, Utilities, Other Packages, Top +@section Options + +There are many variables which control the behavior of the Insidious Big +Brother Database, and there are many hook-variables which can be used to +modify its behavior in more complex ways. Several pieces of functionality +are included which use the hooks in this way. @refill + +@menu +* Customization Parameters:: Customization Parameters +* Customization Hooks:: Customization Hooks +* Predefined Hooks:: Predefined Hooks +@end menu + +@node Customization Parameters, Customization Hooks, Options, Options +@subsection Customization Parameters + +@table @code +@item bbdb-file +@vindex bbdb-file +The name of the file which contains your personal database. Default: +@file{~/.bbdb}. + +@item bbdb-default-area-code +@vindex bbdb-default-area-code +@cindex Phone numbers +The default area code to use when prompting for a new phone number. +Default: 415. This must be a number, not a string.@refill + +@item bbdb-north-american-phone-numbers-p +@vindex bbdb-north-american-phone-numbers-p +@cindex North American phone numbers +@cindex European phone numbers +Whether syntax-checking of phone numbers should be enforced. Default: +@code{t}. This only works for Bell-system phone numbers. If this is true, +then you can't enter invalid phone numbers, and all phone numbers are +pretty-printed in the same way. European phone numbers don't have as +strict a syntax, however, so this is a harder problem for them (on which +I am punting). @refill + +You can have both styles of phone number in your database by providing a +prefix argument to the @code{bbdb-insert-new-field} command. @refill + +@item bbdb-check-zip-codes-p +@vindex bbdb-check-zip-codes-p +@vindex bbdb-legal-zip-codes +@cindex Zip code checking +@cindex Checking zip codes +@cindex Invalid zip codes +@cindex Not a valid zip code +@cindex List of valid zip codes +@cindex Valid zip codes +Whether syntax-checking of zip codes should be enforced. Default: +@code{t}. If this is true, you can't enter invalid zip codes. A zip +code is valid if it matches one of the regular expressions in the +variable @code{bbdb-legal-zip-codes}. @refill + +@item bbdb-address-formatting-alist +@vindex bbdb-address-formatting-alist +@cindex Formatting addresses +@cindex Display of addresses +@cindex Address display +Controls the display of addresses in the buffer. Each entry in this +list consists of an identifying function and a formatting function. +The identifying function must accept an address and return @code{t} if +the associated formatting function is to be used. The formatting +function must insert the formatted address in the current buffer. +Identifying functions usually base their decision on the zip code +format or on the country name. The default entries will format an +address using continental style if the zip code matches +@code{bbdb-continental-zip-regexp}. If the zip code does not match, +addresses are formatted in US style. + +@item bbdb-continental-zip-regexp +@vindex bbdb-continental-zip-regexp +@cindex Continental addresses +@cindex European addresses +Decides whether an address should be formatted using US or European +style. If the zip code of an address matches the regular expression, +the European style is used. This works only if the expression +@code{(bbdb-address-is-continental . bbdb-format-address-continental)} +is part of @code{bbdb-address-formatting-alist}. + +@item bbdb-electric-p +@vindex bbdb-electric-p +@cindex Electric display +Whether bbdb mode should be @i{``electric''} like @code{electric-buffer-list}. +Default: @code{t}. What this means is that the BBDB buffer which pops +up when you use it can be disposed of by pressing the space bar, at +which point your window configuration will be restored to what it was +before you invoked the db list. (The @code{bbdb-mode} commands still +work as well.) @refill + +There are some problems with electric modes; for example, keyboard +macros and incremental search don't work. (This is not a bug in BBDB, +but in @file{electric.el}.)@refill + +@item bbdb-case-fold-search +@vindex bbdb-case-fold-search +Default: the same as @code{case-fold-search}. @code{case-fold-search} is +bound to this by @w{@kbd{M-x bbdb}} and related commands. This variable lets +the case-sensitivity of @kbd{^S} and of the bbdb searching commands be +different. + +@item bbdb/mail-auto-create-p +@vindex bbdb/mail-auto-create-p +If this is @code{t} (the default), then @b{VM}, @b{MH}, and @b{RMAIL} +will automatically create new bbdb records for people you receive mail +from. If this variable is a function name or lambda expression, then it +is called with no arguments to decide whether an entry should be +automatically created. You can use this to, for example, not create +records for messages which have reached you through a particular mailing +list, or to only create records automatically if the mail has a +particular subject. See the variables +@code{bbdb-ignore-most-messages-alist} and +@code{bbdb-ignore-some-messages-alist} (@xref{Predefined Hooks}.) @refill + +@item bbdb/news-auto-create-p +@vindex bbdb/news-auto-create-p +@cindex Automatically creating records +If this is @code{t} (default: @code{nil}), then @b{GNUS} will +automatically create new @b{BBDB} records for people you read messages +by. If this is a function name or lambda expression, then it is called +with no arguments to decide whether an entry should be automatically +created. You can use this to, for example, create or not create +messages which have a particular subject. See the variable +@code{bbdb-auto-notes-alist} (@xref{Predefined Hooks}.). @refill + +If you want to autocreate messages based on the current newsgroup, it's +probably a better idea to set this variable to @code{t} or @code{nil} from your +@code{gnus-select-group-hook} instead. @refill + +To automatically remember users in certain groups, you can do something +like @refill +@example +@exdent (setq gnus-select-group-hook +@exdent '(lambda () +@exdent (setq bbdb/news-auto-create-p +@exdent (or (string= "some.news.group" gnus-newsgroup-name) +@exdent (string= "other.news.group" gnus-newsgroup-name))))) +@end example + +@item bbdb-quiet-about-name-mismatches +@vindex bbdb-quiet-about-name-mismatches +If this is false (the default), then @b{BBDB} will prompt you when it notices a +name change, that is, when the ``real name'' in a message doesn't correspond +to a record already in the database with the same network address. As in, +@w{@i{``John Smith <jqs@@frob.com>''}} versus +@w{@i{``John Q. Smith <jqs@@frob.com>''.}} If this is true, then you will +not be asked if you want to change it (and it will not be changed.) +If a number then it is the number of seconds to sit-for while +displaying the name mismatch. +@refill + +@item bbdb-use-alternate-names +@vindex bbdb-use-alternate-names +@cindex Alternate names +@cindex AKA +If this is false, then the @b{BBDB} will not use the @b{AKA} field. +Otherwise (the default) then the mail and news interfaces will ask you +if you want to add an alternate name when a name-change is noticed, and +will ask you whether the new name should be made the primary one. +Note that if @code{bbdb-quiet-about-name-mismatches} is true, you will +not be asked any questions about alternate names. + +@item bbdb-readonly-p +@vindex bbdb-readonly-p +If this is true (default: @code{nil}), then nothing will attempt to change the +database implicitly, and you will be prevented from doing it +explicitly. If you have more than one emacs running at the same time, +you might want to arrange for this to be set to @code{t} in all but one of +them. @refill + +@item bbdb-auto-revert-p +@vindex bbdb-auto-revert-p +If this variable is true (default: @code{nil}) and the @b{BBDB} file is noticed to +have changed on disk, it will be automatically reverted without +prompting you first. Otherwise you will be asked. (But if the file has +changed and you have made changes in memory as well, you will always be +asked.) @refill + +@item bbdb-notice-auto-save-file +@vindex bbdb-notice-auto-save-file +@cindex Auto-save files +If this is true (default: @code{nil}), then the @b{BBDB} will notice when its +auto-save file is newer than the file is was read from, and will offer +to revert. @refill + +@item bbdb-use-pop-up +@vindex bbdb-use-pop-up +@cindex Automatic display of the corresponding record +If true (the default), display a continuously-updating @b{BBDB} +window while in @b{VM}, @b{MH}, @b{RMAIL}, or @b{GNUS}. +Each time a new message is selected, the record corresponding to +that message's sender will be displayed in another window. The +buffer in this other window will be in bbdb-mode, and all +corresponding commands will be available. @refill + +This buffer will be positioned on the screen by finding the tallest +of the windows present, and splitting it such that the bottom +@code{bbdb-pop-up-target-lines} lines of the window display the +@samp{*BBDB*} buffer. With the default configurations of @b{VM}, +@b{MH}, @b{RMAIL}, and @b{GNUS}, this means that the bbdb-list +buffer will be just below the message-body buffer. @refill + +If this is the symbol @code{horiz}, then the @b{BBDB} window will be +stacked horizontally instead of vertically, if there is room to do that +tastefully. @refill + +@item bbdb-pop-up-target-lines +@vindex bbdb-pop-up-target-lines +Desired number of lines in a @b{VM/MH/RMAIL/GNUS} pop-up @b{BBDB} window, +default 5. @refill + +@item bbdb-completion-type +@vindex bbdb-completion-type +@cindex Completion +@cindex Name completion +@cindex Mail address completion +@cindex Address completion +Controls the behavior of the @code{bbdb-complete-name} command. If @code{nil} +(the default), completion is done across the set of all full-names and +user-ids in the database; if the symbol @code{name}, completion is +done on real-names only; if the symbol @code{net}, completion is done +on network addresses only; if it is @code{primary}, then completion is +done only across the set of primary network addresses (the first address +in the list of addresses for a given user). If it is +@code{primary-or-name}, completion is done across primaries and real +names. @refill + +@item bbdb-expand-mail-aliases +@vindex bbdb-expand-mail-aliases +@cindex Completion +@cindex Name completion +@cindex Mail address completion +@cindex Address completion +If non-nil, expand mail aliases in `bbdb-complete-name'. +@refill + +@item bbdb-complete-name-allow-cycling +@vindex bbdb-complete-name-allow-cycling +@cindex Completion +@cindex Name completion +@cindex Mail address completion +@cindex Address completion +Whether to allow cycling of email addresses when calling +`bbdb-complete-name' on a completed address in a composition buffer." +@refill + +@item bbdb-complete-name-full-completion +@vindex bbdb-complete-name-full-completion +@cindex Completion +@cindex Name completion +@cindex Mail address completion +@cindex Address completion +Show full expanded completion rather than partial matches. +If t then do it always, if a number then just is the number of +completions for a specific match is below that number. +@refill + +@item bbdb-user-mail-names +@vindex bbdb-user-mail-names +A regular expression identifying the addresses that belong to you. If a +message from an address matching this is seen, the @b{BBDB} record for the +@samp{To:} line will be shown instead of the one for the @samp{From:} +line. If this is @code{nil}, it will default to the value of +@code{(user-login-name)}. @refill + +@item bbdb-always-add-addresses +@vindex bbdb-always-add-addresses +If this is @code{t}, then whenever the Insidious Big Brother Database +notices a new email address corresponding to a person who is in the +database, it will add it to the database. If this is the symbol +@code{ask} (the default), then whenever a new network address is +noticed for a person in the database, you will be asked whether to add +the address. If this is @code{nil} then new network addresses will +never be automatically added. @refill + +When set to a function name, @b{BBDB} calls the function to decide +whether to add the address or not; it should return one of the above +values. You may find the functions +@code{bbdb-ignore-some-messages-hook} or +@code{bbdb-ignore-most-messages-hook} useful here. @xref{Predefined +Hooks}. +@refill + +@item bbdb-new-nets-always-primary +@vindex bbdb-new-nets-always-primary +If this is @code{t}, then when the Insidious Big Brother Database adds a new +address to a record, it will always add it to the front of the list of +addresses, making it the primary address. If this is @code{nil} (the default), +then you will be asked. If this is the symbol @code{never} (really if +it is not @code{t} and not @code{nil}) then new network addresses will +always be added to the end of the list. @refill + +@item bbdb-canonicalize-redundant-nets-p +@vindex bbdb-canonicalize-redundant-nets-p +If this is non-@code{nil}, redundant network addresses will be ignored. +If a record has an address of the form @code{foo@@baz.com}, setting this +to @code{t} will cause subsequently-noticed addresses +like @code{foo@@bar.baz.com} to be ignored (since we already have a more +general form of that address.) This is similar in function to one of +the possible uses of the variable @code{bbdb-canonicalize-net-hook} +but is somewhat more automatic. (This can't quite be implemented in +terms of the canonicalize-net-hook because it needs access to the +database to determine whether an address is redundant, and the +canonicalize-net-hook is purely a textual manipulation which is +performed before any database access.) + +@item bbdb-message-caching-enabled +@vindex bbdb-message-caching-enabled +Whether caching of the message->bbdb-record association should be +used for the interfaces which support it (@b{VM}, @b{MH}, and +@b{RMAIL}). This can speed things up a lot. One implication of +this variable being true (the default) is that the +@code{bbdb-notice-hook} will not be called each time a message is +selected, but only the first time. Likewise, if selecting a message +would generate a question (whether to add an address, change the +name, etc) you will only be asked that question the very first time +the message is selected. @refill + +@item bbdb-offer-save +@vindex bbdb-offer-save +If @code{t} (the default), then certain actions will cause the @b{BBDB} to +ask you whether you wish to save the database. If @code{nil}, then the +offer to save will never be made. If not @code{t} and not @code{nil}, then +any time it would ask you, it will just save it without asking. @refill + +@end table + +@node Customization Hooks, Predefined Hooks, Customization Parameters, Options +@subsection Customization Hooks + +All of the hooks variables described below may be set to a symbol or +lambda expression, which will be funcalled; or may be set to a list of +symbols or lambda expressions, each of which will be funcalled in turn. +Almost all hooks in Emacs work this way. But notice that some of the +hooks described below are called with arguments. + +@table @code +@item bbdb-list-hook +@vindex bbdb-list-hook +Hook or hooks invoked after the bbdb-list-buffer is filled in. Invoked +with no arguments. @refill + +@item bbdb-create-hook +@vindex bbdb-create-hook +Hook or hooks invoked each time a new bbdb-record is created. Invoked +with one argument, the new record. This is called @emph{before} the record is +added to the database. Note that @code{bbdb-change-hook} will be called as +well. @refill + +@item bbdb-change-hook +@vindex bbdb-change-hook +Hook or hooks invoked each time a bbdb-record is altered. Invoked with +one argument, the record. This is called @emph{before} the database buffer +is modified. Note that if a new bbdb record is created, both this hook and +@code{bbdb-create-hook} will be called. @refill + +@item bbdb-mode-hook +@vindex bbdb-mode-hook +Hook or hooks invoked when the @samp{*BBDB*} buffer is created. + +@item bbdb-notice-hook +@vindex bbdb-notice-hook +Hook or hooks invoked each time a bbdb-record is ``noticed,'' that +is, each time it is displayed by the news or mail interfaces. +Invoked with one argument, the new record. The record need not have +been modified for this to be called - use @code{bbdb-change-hook} for that. +You can use this to, for example, add something to the notes field +based on the subject of the current message. It is up to your hook +to determine whether it is running in @b{GNUS}, @b{VM}, +@b{MH}, or @b{RMAIL}, and to act appropriately. @refill + +Also note that @code{bbdb-change-hook} will @emph{not} be called as a +result of any modifications you may make to the record inside this +hook. @refill + +Beware that if the variable @code{bbdb-message-caching-enabled} is +true (a good idea) then when you are using @b{VM}, @b{MH}, or +@b{RMAIL}, this hook will be called only the first time that +message is selected. (The @b{GNUS} interface does not use caching.) +When debugging the value of this hook, it is a good idea to set +caching-enabled to @code{nil}. @refill + +@item bbdb-after-read-db-hook +@vindex bbdb-after-read-db-hook +Hook or hooks invoked (with no arguments) just after the Insidious Big +Brother Database is read in. Note that this can be called more than once if +the @b{BBDB} is reverted. One possible use for this is to rename the +@file{.bbdb} buffer; for example @refill + +@code{(setq bbdb-after-read-db-hook '(lambda () (rename-buffer " bbdb")))} + +@noindent +will cause the buffer visiting the @code{bbdb-file} to be +called @w{@code{" bbdb"}}. The leading space in its name will prevent +it from showing up in the buffer list. + +@item bbdb-load-hook +@vindex bbdb-load-hook +Hook or hooks invoked (with no arguments) when the Insidious Big Brother +Database code is first loaded. WARNING: Slow functions should not be +put on this hook, as the @b{BBDB} code will, if not loaded before, be +loaded during the first use of @b{BBDB}-related Customization +functions. Slow functions should be put on @code{bbdb-initialize-hook}. + +@item bbdb-initialize-hook +@vindex bbdb-initialize-hook +@findex bbdb-initialize +Hook or hooks invoked (with no arguments) when the +@code{bbdb-initialize} function is called. + +@item bbdb-canonicalize-net-hook +@vindex bbdb-canonicalize-net-hook +If this is non-@code{nil}, it should be a function of one argument: a +network address string. (Note that, unlike the other hook-variables +described above, this may not be a list of functions.) Whenever the +Insidious Big Brother Database ``notices'' a message, the corresponding +network address will be passed to this function first, as a kind of +``filter'' to do whatever transformations upon it you like before it is +compared against or added to the database. For example: it is the case +that @code{CS.CMU.EDU} is a valid return address for all mail +originating at a machine in the @code{.CS.CMU.EDU} domain. So, if you +wanted all such addresses to be canonically hashed as +@code{user@@CS.CMU.EDU}, instead of as @code{user@@somehost.CS.CMU.EDU}, +you might set this variable to a function like this: @refill + +@example +(setq bbdb-canonicalize-net-hook + '(lambda (addr) + (cond ((string-match + "\\`\\([^@@]+@@\\).*\\.\\(CS\\.CMU\\.EDU\\)\\'" + addr) + (concat (substring addr + (match-beginning 1) (match-end 1)) + (substring addr + (match-beginning 2) (match-end 2)))) + (t addr)))) +@end example + +You could also use this function to rewrite UUCP-style addresses into +domain-style addresses, or any number of other things.@refill + +This function will be called repeatedly until it returns a value EQ to the +value passed in. So multiple rewrite rules might apply to a single +address.@refill + +There is an example of the use of this variable in the +file @file{bbdb-hooks.el}: the function +@code{sample-bbdb-canonicalize-net-hook}.@refill +@end table + +@vindex bbdb-change-hook +@findex bbdb-delete-redundant-nets +The @code{bbdb-canonicalize-net-hook} is powerful in that it allows +arbitrary rewriting of addresses, however, in many cases that is +overkill. The function @code{bbdb-delete-redundant-nets} can be +used as a value of @code{bbdb-change-hook} to cause network addresses +which appear to be ``redundant'' to be deleted each time a modification +is made to a record. @refill + +This works as follows: suppose one gets mail from @code{user@@foo.bar.com}, +and then later gets mail from @code{user@@bar.com}. At this point, one +can generally delete the @code{user@@foo.bar.com} address, since the +@code{user@@bar.com} address is more general. (See also the +variable `bbdb-canonicalize-redundant-nets-p', which has the effect of +ignoring subsequent addresses from @code{user@@quux.bar.com} if the +address @code{user@@bar.com} is already known.)@refill + +@node Predefined Hooks, , Customization Hooks, Options +@subsection Predefined Hooks + +@findex bbdb-timestamp-hook +@cindex Timestamping records +If the variable @code{bbdb-change-hook} is set to the symbol +@code{bbdb-timestamp-hook} (the default), then every record in the +database will have a field named @samp{timestamp}, which will always +contain the date and time at which this record was created or last +modified. + +@findex bbdb-creation-date-hook +If the variable @code{bbdb-create-hook} is set to the symbol +@code{bbdb-creation-date-hook} (the default), then every record in the +database will have a field named @samp{creation-date}, which will +contain the date and time at which this record was added to the +database. + +@findex bbdb-ignore-most-messages-hook +@vindex bbdb-ignore-most-messages-alist +@cindex Automatically creating records +If the variable @code{bbdb/mail-auto-create-p} is set to the symbol +@code{bbdb-ignore-most-messages-hook}, then the variable +@code{bbdb-ignore-most-messages-alist} will determine which messages +should have records automatically created for them. The format of this +alist is @refill +@example +(( @var{HEADER-NAME} . @var{REGEXP} ) @dots{} ) +@end example +@noindent +for example, +@example +(("From" . "@@.*\\.maximegalon\\.edu") + ("Subject" . "time travel")) +@end example + +@noindent +will cause @b{BBDB} entries to be made only for messages sent by +people at Maximegalon U., or (that's @emph{or}) people posting +about time travel. @refill + +There may be only one entry per header in this alist: that is, @refill + +@example +(("From" . "addr1\\|addr2") @dots{} ) +@end example + +@noindent +is legal, but + +@example +(("From" . "addr1") ("From" . "addr2") @dots{} ) +@end example + +@noindent +is not. + +@vindex bbdb/mail-auto-create-p +@vindex bbdb/news-auto-create-p +@findex bbdb-ignore-some-messages-hook +@vindex bbdb-ignore-some-messages-alist +If the variable @code{bbdb/mail-auto-create-p} is set to the symbol +@code{bbdb-ignore-some-messages-hook}, then the variable +@code{bbdb-ignore-some-messages-alist} will determine which messages +should have records automatically created for them. This is the exact +inverse of the semantics of the @code{bbdb-ignore-most-messages-alist}: +the alist specifies which messages should @emph{not} have records +automatically created for them, instead of which should. For +example, @refill + +@example +(("From" . "mailer.daemon") + ("To" . "mailing-list-1\\|mailing-list-2") + ("CC" . "mailing-list-1\\|mailing-list-2")) +@end example + +@noindent +will cause @b{BBDB} entries to not be made for messages from any mailer daemon, +or messages sent to or @b{CC}ed to either of two mailing lists. @refill + +The variable @code{bbdb/news-auto-create-p} may be set to either of the +above-mentioned functions as well, to get this behavior for netnews +messages instead of mail messages.@refill + +@vindex bbdb-notice-hook +@vindex bbdb-auto-notes-alist +@cindex Automatically adding text to records +If the variable @code{bbdb-notice-hook} is set to the symbol +@code{bbdb-auto-notes-hook}, then the variable @code{bbdb-auto-notes-alist} +may be used to automatically add text to the notes fields of the records +corresponding to certain messages. The format of this alist is @refill + +@example +(( @var{HEADER-NAME} + (@var{REGEXP} . @var{STRING}) @dots{} ) + @dots{} ) +@end example + +@noindent +for example, + +@example +(("To" ("-vm@@" . "VM mailing list")) + ("Subject" ("sprocket" . "mail about sprockets") + ("you bonehead" . "called me a bonehead"))) +@end example + +@noindent +will cause the text @code{"VM mailing list"} to be added to the notes field of +the record corresponding to anyone you get mail from via one of the @b{VM} +mailing lists. If, that is, @code{bbdb/mail-auto-create-p} is set such +that the record would have been created, or if the record already +existed.@refill + +The format of elements of this list may also be + +@example +(@var{REGEXP} @var{FIELD-NAME} @var{STRING}) +@end example +@noindent +or +@example +(@var{REGEXP} @var{FIELD-NAME} @var{STRING} @var{REPLACE-P}) +@end example + +@noindent +meaning add the given string to the named field. The field-name may not +be @samp{name}, @samp{aka}, @samp{address}, @samp{phone}, or @samp{net} +(builtin fields) but must be either @samp{notes}, @samp{company}, or the +name of a user-defined note-field. @refill + +@example +("pattern" . "string to add") +@end example + +@noindent +is equivalent to + +@example +("pattern" notes "string to add") +@end example + +@noindent +@var{STRING} can contain @code{\&} or @code{\N} escapes like in the function +@code{replace-match}. For example, to automatically add the contents of the +@b{organization} field of a message to the @code{company} field of a @b{BBDB} +record, you can use this: @refill + +@example +("Organization" (".*" company "\\&")) +@end example + +@noindent +(Note you need two \ to get a single \ into a lisp string literal.) + +If STRING is an integer @i{N}, the @i{N}th matching subexpression is +used, so the above example could be written more efficiently as @refill + +@example +("Organization" (".*" company 0)) +@end example + +If STRING is neither a string or an integer, it should be a function +which is called with the contents of the field, and the result of the +function call is used. + +If the @var{REPLACE-P} flag is true, then the string replaces the old +contents instead of being appended to it. + +If multiple clauses match the message, all of the corresponding strings +will be added. @refill + +If the string is being appended (@var{REPLACE-P} is false or not +provided) then the new string is appended to the end of the existing +field value, with an intervening newline. So each piece of text +automatically added to this field will go on its own line. @refill + +You can control what the separator is by putting a @code{field-separator} +property on the symbol naming the field. For example, to make text +automatically added to a field named @code{newsgroups} be separated by +commas, you could do @refill + +@example +(put 'newsgroups 'field-separator "; ") +@end example + +This variable works for news as well. You might want to arrange for +this to have a different value when in mail as when in news. @refill + +There may be only one entry per header in this alist: that is,@refill + +@example + (("Subject" ("\\bfoo\\b" . "Foo!!") + ("bar" . "Bar!"))) +@end example + +@noindent +will work, but + +@example + (("Subject" ("\\bfoo\\b" . "Foo!!")) + ("Subject" ("bar" . "Bar!"))) +@end example + +@noindent +will not. + +Here's a more complicated example: some people include bitmaps of +themselves in their mail messages in an @b{X-Face:} header field. +You can capture this field into the @samp{*BBDB*} with the +following: + +@example +(setq bbdb-auto-notes-alist + (append bbdb-auto-notes-alist + (list "x-face" + (list (concat "[ \t\n]*\\([^ \t\n]*\\)" + "\\([ \t\n]+\\([^ \t\n]+\\)\\)?" + "\\([ \t\n]+\\([^ \t\n]+\\)\\)?" + "\\([ \t\n]+\\([^ \t\n]+\\)\\)?" + ) + 'face + "\\1\\3\\5\\7")))) +@end example + +@noindent +(The calls to @code{list} and @code{concat} are just for readability, it +could easily be a constant.) The tricky bit here is that it strips out +the newlines and whitespace used for header continuation, which are not +actually a part of the face data. So though the mail message may have +the face data on multiple lines, the entry in the @samp{*BBDB*} will +be just one line. + +@vindex bbdb-auto-notes-ignore +@code{bbdb-auto-notes-ignore} is an alist of headers and regexps to +ignore in @code{bbdb-auto-notes-hook}. Each element looks like @refill + +@example +(@var{HEADER} . @var{REGEXP}) +@end example + +@noindent +for example, + +@example +("Organization" . "^Gatewayed from\\|^Source only") +@end example + +@noindent +would exclude the phony @code{Organization:} headers in GNU mailing-lists +gatewayed to the @code{gnu.*} newsgroups. Note that this exclusion +applies only to a single field, not to the entire message. For that, +use the variable @code{bbdb-auto-notes-ignore-all}. + +@vindex bbdb-auto-notes-ignore-all +@code{bbdb-auto-notes-ignore-all} is an alist of headers and regexps +which cause the entire message to be ignored in @code{bbdb-auto-notes-hook}. +Each element looks like @refill + +@example +(@var{HEADER} . @var{REGEXP}) +@end example + +@noindent +for example, + +@example +("From" . "BLAT\\.COM") +@end example + +@noindent +would exclude any notes recording for message coming from @code{BLAT.COM}. +Note that this is different from @code{bbdb-auto-notes-ignore}, which +applies only to a particular header field, rather than the entire message. + +@node Utilities, Internals, Options, Top +@section Utilities + +This section describes @b{BBDB} functionality that does not fit neatly into +other sections. + +@menu +* bbdb-ftp:: Storing FTP sites in the @b{BBDB} +* bbdb-print:: Print the @b{BBDB} +* bbdb-snarf:: Record generation from raw text +* bbdb-srv:: External control of the @b{BBDB} +@end menu + +@node bbdb-ftp +@subsection @code{bbdb-ftp} +@cindex Storing FTP sites in the BBDB +@findex bbdb-ftp + +The @code{bbdb-ftp} utility enables the storage of FTP sites as @b{BBDB} +records. The @code{bbdb-create-ftp-site} function is used to create a +@b{BBDB} record for an FTP site. The command will prompt for information +needed to create the record. The FTP site for a given record can be accessed +with the @code{bbdb-ftp} command. + +@node bbdb-print, bbdb-snarf, bbdb-ftp, Utilities +@subsection @code{bbdb-print} +@cindex Printing records in the database +@findex bbdb-print + +@code{bbdb-print} is a utility for pretty-printing entries from the @b{BBDB} +using TeX. It is invoked by pressing @kbd{P} in the @code{*BBDB*} buffer - +this will cause all records in the @b{BBDB} to be printed as governed by the +variables described below. If @kbd{P} is prefixed by a @kbd{*}, only the +currently-displayed records will be printed. Once invoked, @code{bbdb-print} +will generate the TeX output in a buffer named @file{~/bbdb.tex} (controlled +by @code{bbdb-print-file-name}). The generated output will be shown, and must +be @b{manually} saved. + +For each record printed, @code{bbdb-print} will look for the presence of the +@code{tex-name} field. If this field is found, its value will be printed +instead of the @code{name} field for the record in question. This field is +intended to allow the storage of names with accents or other characters that +would be illegal in the address portion of a message. While other fields have +special characters quoted by @code{bbdb-print} as described below, the +contents of the @code{tex-name} field (if present) are used verbatim. + +The following variables govern the printing of records (and of the printing of +the fields therein): + +@table @code +@item bbdb-print-omit-fields +@vindex bbdb-print-omit-fields +This variable should be set to a list of the fields that are not to be printed +by @code{bbdb-print}. It defaults to:@* +@center @code{(omit tex-name aka mail-alias)} + +@item bbdb-print-file-name +@vindex bbdb-print-file-name +The name of the file where generated TeX output is to be stored. The default +is @file{~/bbdb.tex}. + +@item bbdb-print-require +@vindex bbdb-print-require +The fields required for printing a record. This allows, for example, only +records with phone numbers to be printed. The value of the value of the +variable will be evaluated once for each record, and the record will be +printed only if the evaluation returns a non-nil value. The symbols +@code{name}, @code{company}, @code{net}, @code{phone}, @code{address}, and +@code{notes} will be set to the appropriate values during evaluation; they +will be nil if the field does not exist or is elided. + +The value of this variable can be any lisp expression, but typically +it will be used for a boolean combination of the field variables, as +in the following simple examples: + +@itemize @bullet +@item Print only people whose phone numbers are known:@* +@center @code{(setq bbdb-print-require 'phone)} +@item Print people whose names AND companies are known:@* +@center @code{(setq bbdb-print-require '(and name company))} +@item Print people whose names, and either addresses OR phone numbers are +known:@* +@center @code{(setq bbdb-print-require '(and name (or address phone))).} + +The default value is:@* +@center @code{(or address phone)} +@end itemize + +@item bbdb-print-alist +@vindex bbdb-print-alist +Formatting options for all formats of @code{bbdb-print}. The value is an +alist of the form@* +@center @code{((@var{OPTION} . @var{VALUE}) (@var{OPTION} . @var{VALUE}) ...)} + +Separate settings can be configured using @code{bbdb-print-brief-alist} and +@code{bbdb-print-full-alist}. Settings in these variables will override the +ones in @code{bbdb-print-alist}. + +The possible options and legal settings are: +@table @code +@item columns +@code{1}, @code{2}, @code{3}, @code{4}, @code{quad} (4 little +2-column pages per sheet) or @code{grid} (12 credit-card-sized pages per +sheet). + +@item separator +@code{0}-@code{7}, the style of heading for each letter. @code{0}=none, +@code{1}=line, @code{2}=boxed letters, @code{3}=large boxed letters, +@code{4}=large letters, @code{5}=letters with lines, @code{6}=letters with +suits, @code{7}=boxed letters with suits. + +@item omit-area-code +A regular expression matching area codes to omit. + +@item phone-on-first-line +If @code{t}, the first phone number will be put on the same line as the name. +If @code{nil}, the name will be the only text on the line. If set to a +string, the field of type @code{phone} whose name matches the string will be +used. The string should be a valid regular expression. + +@item n-phones +Maximum number of phone numbers to include. + +@item n-addresses +Maximum number of addresses to include. + +@item include-files +List of TeX files to @code{\input}. If the filenames are not absolute, the +files must be located somewhere in the TeX input path. + +@item ps-fonts +Postscript fonts (TimesNewRoman and Courier) will be used if the value +is non-@code{nil}. Standard TeX fonts (ec-fonts) will be used +otherwise. + +@item font-size +The integer point size of the font to be used. + +@item hsize +The horizontal dimension of the pages. The value must be a string, and must +be a valid TeX dimension. Alternatively, the TeX default will be used if the +value is @code{nil}. + +@item vsize +The vertical dimension of the pages. The value must be a string, and must +be a valid TeX dimension. Alternatively, the TeX default will be used if the +value is @code{nil}. + +@item hoffset +The TeX output will be offset to the right by the value of this option. The +value must be either a string containing a valid TeX dimension or @code{nil} +or @code{0} to use the default TeX horizontal offset. + +@item voffset +The TeX output will be offset downward by the value of this option. The +value must be either a string containing a valid TeX dimension or @code{nil} +or @code{0} to use the default TeX vertical offset. + +@item quad-hsize +Horizontal size to be used for the individual pages in the quad format. The +value must be a string containing a valid TeX dimension. + +@item quad-vsize +Vertical size to be used for the individual pages in the quad format. The +value must be a string containing a valid TeX dimension. +@end table + +The default value is +@example +((omit-area-code . "(@var{AREA-CODE})") + (phone-on-first-line . "^[ \t]*$") + (ps-fonts . nil) + (font-size . 6) + (quad-hsize . "3.15in") + (quad-vsize . "4.5in")) +@end example + +Where @var{AREA-CODE} is the value of @code{bbdb-default-area-code} or +@samp{000} if there is no default area code. + +@item bbdb-print-brief-alist +@vindex bbdb-print-brief-alist +Extra options for the @code{bbdb-print} brief format. The value(s) of +this variable can either supplement or override the values in +@code{bbdb-print-alist}. The format and possible values of this variable are +as in @code{bbdb-print-alist}, described above. + +The default value is +@example +((columns . 1) + (separator . 1) + (n-phones . 2) + (n-addresses . 1) + (include-files "bbdb-print-brief" "bbdb-cols")) +@end example + +@item bbdb-print-full-alist +@vindex bbdb-print-full-alist +Extra options for the @code{bbdb-print} non-brief format. The value(s) of +this variable can either supplement or override the values in +@code{bbdb-print-alist}. The format and possible values of this variable are +as in @code{bbdb-print-alist}, described above. + +The default value is +@example +((columns . 3) + (separator . 2) + (include-files "bbdb-print" "bbdb-cols")) +@end example + +@item bbdb-print-prolog +@vindex bbdb-print-prolog +TeX statements to include at the beginning of the @code{bbdb-print} output +file. + +@item bbdb-print-epilog +@vindex bbdb-print-epilog +TeX statements to include at the end of the @code{bbdb-print} output file. + +@end table + +@node bbdb-snarf, bbdb-srv, bbdb-print, Utilities +@subsection @code{bbdb-snarf} + +@code{bbdb-snarf} provides the ability to generate @b{BBDB} records from raw +text. If invoked as @code{bbdb-snarf}, it attempts to generate the record +from the information around point (the cursor). If invoked as +@code{bbdb-snarf-region}@footnote{@code{bbdb-snarf} is actually a wrapper for +@code{bbdb-snarf-region} that determines the relevant region and passes it +on.}, the active region is used to generate the record. + +@noindent +@b{Restrictions:} + +@enumerate +@item +@code{bbdb-snarf} currently recognizes only US-style phone numbers. +@item +@code{bbdb-snarf} works best with things that look like mailing addresses. +@end enumerate + +@noindent +Example of an address that @code{bbdb-snarf} will recognize: + +@example +another test person +1234 Gridley St. +Los Angeles, CA 91342 +555-1212 +test@@person.net +http://www.foo.bar/ +other stuff about this person +@end example + +@node bbdb-srv, , bbdb-snarf, Utilities +@subsection @code{bbdb-srv} + +@code{bbdb-srv} provides the ability to initiate the display of @b{BBDB} +records from outside of Emacs. This allows external programs to cause +the @b{BBDB} record for a given person to appear in the running Emacs +when, for example, mail is recieved from that person. One specific +application, described below, is the integration of Netscape and the +@b{BBDB}, allowing the display of @b{BBDB} records corresponding to Mail +and/or News messages displayed in Netscape. + +@code{bbdb-srv} is composed of two parts - an external Perl script +(@file{utils/bbdb-srv.pl}), and an Emacs Lisp file +(@file{lisp/bbdb-srv.el}). The external portion is used to send +commands to the internal portion. + +@b{NOTE:} @code{bbdb-srv} requires @code{gnuserv} and @code{itimer}, +both included with XEmacs. @code{gnuserv} must be started with the +@code{gnuserv-start} command before @code{bbdb-srv} can be used. + +In it's most basic form, mail or news headers are passed to the Perl +script. The Perl script then causes the @b{BBDB} record (if any) +corresponding to the passed headers to be displayed in the running +Emacs. While @code{bbdb-srv} will operate with just a @samp{From:} +field, it works better when passed both @samp{From:} and @samp{To:} +headers. When @code{bbdb-srv} notices that the logged-in user is named +in the @samp{From:} header, it will attempt to display the record (if +any) for the person named in the @samp{To:} header. If no @samp{To:} +header is passed, it falls back on the record (if any) for the logged-in +user (the person named in the @samp{From:} header). + +An example manual invocation of @code{bbdb-srv} is as follows: + +@example +% cat |bbdb-srv.pl +From: Jamie Zawinski <jwz@@netscape.com> +To: Matt Simmons <simmonmt@@acm.org> +@key{CTRL-D} +@end example + +If the invoking user is Jamie Zawinski, the record for Matt Simmons (if +any) will be displayed. If the invoking user is not Jamie Zawinski, the +record for Jamie Zawinski (if any) will be displayed. + +As mentioned above @code{bbdb-srv} can be used with Netscape Mail and +Netscape News. Please note that it can only be used with the UNIX +versions 3.0b2 and greater of these applications. To allow Netscape to +use @code{bbdb-srv}, set the @samp{NS_MSG_DISPLAY_HOOK} variable to +@code{bbdb-srv.pl}@footnote{Use the full path to @code{bbdb-srv.pl} if +it is not in the default path.} as follows: + +@noindent +Bourne Shell (@file{/bin/sh}) and variants: +@example +# NS_MSG_DISPLAY_HOOK bbdb-srv.pl +# export NS_MSG_DISPLAY_HOOK +@end example + +@noindent +C-Shell (@file{/bin/csh}) and variants: +@example +% setenv NS_MSG_DISPLAY_HOOK bbdb-srv.pl +@end example + +The following variables can be used to customize the behavior of +@code{bbdb-srv}: + +@table @code +@vindex bbdb/srv-auto-create-p +@item bbdb/srv-auto-create-p +This variable is similar to @code{bbdb/news-auto-create-p} and +@code{bbdb/mail-auto-create-p}. That is, when headers are passed in to +@code{bbdb-srv}, a new @b{BBDB} record can be created if none exists, +depending on the value of this variable. Possible values are: +@table @asis +@item @code{t} +Automatically create new @b{BBDB} records if the headers passed in do +not correspond to an already-existing record. +@item @code{nil} +Do not automatically create new @b{BBDB} records. +@item @var{FUNCTION} +@var{FUNCTION} is called. If it returns @code{t}, a record will be +created for the person named in the @samp{From:} header. If it returns +@code{nil}, no record will be created. + +A suggested function for use is +@code{bbdb/srv-auto-create-mail-news-dispatcher}. This function will +attempt to determine the source of the passed headers - whether they +were part of a mail message or of a news article. The action (if any) +dictated by the value of either @code{bbdb/mail-auto-create-p} or +@code{bbdb/news-auto-create-p}, based on the determined source of the +passed headers. + +@end table + +@vindex bbdb/srv-display-delay +@item bbdb/srv/display-delay +@code{bbdb-srv} pauses between displaying the records corresponding to +each passed set of headers. This variable controls the length of time +(in seconds) of the delay between the display of different records. +Note when setting this variable that only one set of headers can be +queued at a time. If three sets of headers are passed to +@code{bbdb-srv} in less than the delay time, only the first and last +will be displayed. +@end table + +@node Internals, Mailing Lists, Utilities, Top +@section Internals + +@b{This section is currently a dumping ground for things that should +eventually go here, but were found elsewhere in the file.} + +@b{INFORMATION IN THIS SECTION IS FOR INFORMATIONAL PURPOSES ONLY. IT +SHOULD NOT BE TAKEN AS DOCUMENTATION OF AN EXTERNAL API. EVERYTHING +LISTED BELOW IS SUBJECT TO CHANGE WITHOUT NOTICE} + +The first time you use +one of the @b{BBDB} commands, this file is read into an emacs buffer, and +remains there. As you make changes to the database, this buffer is +changed as well, ensuring that if it is auto-saved, it will be saved in +its most current state. @refill + +@subsection BBDB data file format + +The data file is arranged in a hierarchical fashion. At the top level +are vectors, with one vector per database record. It is @b{very} +important that each vector be on its own line, as the BBDB builds and +stores markers based on this layout. The markers are then used to +increase the speed of database modifications (more on this later). The +record vectors contain the individual fields of the record. These +fields can be of any type, but are currently integers, strings, lists of +strings, alists, vectors, or lists of vectors. In the case of fields +that contain one or more vectors, they can be further broken down in +terms of the fields of their component vectors. + +In an effort to provide a more concrete example to illustrate the above, +and to provide a reference for database accessor and modifier functions, +we describe the database format below. This description starts with the +fields of the individual record vectors, and drills down through the +vectors used by some of the fields. + +@subsubsection Record Vectors + +@multitable @columnfractions .13 .19 .36 .32 +@item @b{Name} +@tab @b{Type} +@tab @b{Accessor and Modifier} +@tab @b{Description} + +@item First name +@tab String +@tab @code{bbdb-record-firstname}@* + @code{bbdb-record-set-firstname} +@tab Entity's first name + +@item Last name +@tab String +@tab @code{bbdb-record-lastname}@* + @code{bbdb-record-set-lastname} +@tab Entity's last name + +@item AKAs +@tab List of Strings +@tab @code{bbdb-record-aka}@* + @code{bbdb-record-set-aka} +@tab Alternate names for entity + +@item Company +@tab String +@tab @code{bbdb-record-company}@* + @code{bbdb-record-set-company} +@tab Company with which entity is associated + +@item Phones +@tab List of Vectors +@tab @code{bbdb-record-phones}@* + @code{bbdb-record-set-phones} +@tab List of phone number vectors + +@item Addresses +@tab List of Vectors +@tab @code{bbdb-record-addresses}@* + @code{bbdb-record-set-addresses} +@tab List of address vectors + +@item Net address +@tab List of Strings +@tab @code{bbdb-record-net}@* + @code{bbdb-record-set-net} +@tab List of network addresses + +@item Notes +@tab String or Alist +@tab @code{bbdb-record-raw-notes}@* + @code{bbdb-record-set-raw-notes} +@tab String or Association list of note fields (strings) + +@item Cache +@tab Vector +@tab @code{bbdb-record-cache}@* + @code{bbdb-record-set-cache} +@tab Record cache.@* + @i{Internal version only.} + +@end multitable + +The phone, address and cache vector fields are described below. Please +note that, as indicated in the table above, the cache is present only in +the internal version of the database - it is not written out as part of +the @file{.bbdb} file. + +In addition, the accessor and modifier functions for the notes alist +are described. + +@subsubsection Phone Vectors + +To access the fields in the below table, you must first get the list of +phone vectors using the @code{bbdb-record-phones} function. Note that +if you alter the phones field with the @code{bbdb-record-set-phones} +function, you are altering the entire phones list for the given record. +Use the modifier functions below for modifications to individual phone +vectors. + +@multitable @columnfractions .13 .19 .36 .32 +@item @b{Name} +@tab @b{Type} +@tab @b{Accessor and Modifier} +@tab @b{Description} + +@item Location +@tab String +@tab @code{bbdb-phone-location}@* + @code{bbdb-phone-set-location} +@tab Phone number identifier + +@item Area +@tab Integer +@tab @code{bbdb-phone-area}@* + @code{bbdb-phone-set-area} +@tab Area code for phone number + +@item Exchange +@tab Integer +@tab @code{bbdb-phone-exchange}@* + @code{bbdb-phone-set-exchange} +@tab Exchange (aka prefix) for phone number + +@item Suffix +@tab Integer +@tab @code{bbdb-phone-suffix}@* + @code{bbdb-phone-set-suffix} +@tab Suffix for phone number + +@item Extension +@tab Integer +@tab @code{bbdb-phone-extension}@* + @code{bbdb-phone-set-extension} +@tab Phone number extension (@samp{0} if none) + +@end multitable + +@subsubsection Address Vectors + +To access the fields in the below table, you must first get the list of +address vectors using the @code{bbdb-record-addresses} function. Note +that if you alter the addresses field with the +@code{bbdb-record-set-addresses} function, you are altering the entire +addresses list for the given record. Use the modifier functions below +for modifications to individual address vectors. + +@multitable @columnfractions .13 .19 .36 .32 +@item @b{Name} +@tab @b{Type} +@tab @b{Accessor and Modifier} +@tab @b{Description} + +@item Location +@tab String +@tab @code{bbdb-address-location}@* + @code{bbdb-address-set-location} +@tab Address identifier + +@item Streets +@tab List +@tab @code{bbdb-address-streets}@* + @code{bbdb-address-set-streets} +@tab List of street address lines. @code{nil} if none. + +@item Street3 +@tab String +@tab @code{bbdb-address-street3}@* + @code{bbdb-address-set-street3} +@tab Third line of street address. ``'' if none. + +@item City +@tab String +@tab @code{bbdb-address-city}@* + @code{bbdb-address-set-city} +@tab City name + +@item State +@tab String +@tab @code{bbdb-address-state}@* + @code{bbdb-address-set-state} +@tab State abbreviation + +@item Zip +@tab Integer (american) + List (non-american) +@tab @code{bbdb-address-zip}@* + @code{bbdb-address-set-zip} +@tab Zip code + +@item Country +@tab String +@tab @code{bbdb-address-country}@* + @code{bbdb-address-set-country} +@tab Country + +@end multitable + +@subsubsection Cache Vector + +This vector is present only in the internal database representation. It +is not written out to the database file because it contains information +aggregated from the rest of the record that is reconstructed when the +database is read. To write the cache information to the database file +would increase the risk of database inconsistency, and would violate the +principles of normalization. + +To access the cache fields using the functions listed below that begin +with @code{bbdb-cache-}, you must first get the cache vector using the +@code{bbdb-record-cache} function. The functions that begin with +@code{bbdb-record-} get the cache vector internally. Note that if you +alter the cache field in the high-level record with the +@code{bbdb-record-set-cache} function, you are altering the entire cache +vector for the given record. Use the modifier functions below for +modifications to individual cache fields. + +@multitable @columnfractions .15 .17 .36 .32 +@item @b{Name} +@tab @b{Type} +@tab @b{Accessor and Modifier} +@tab @b{Description} + +@item Name Cache +@tab String +@tab @code{bbdb-cache-namecache}@* + @code{bbdb-cache-set-namecache} +@tab Preconcatenated name of entity + +@item Sort Key +@tab String +@tab @code{bbdb-cache-sortkey}@* + @code{bbdb-cache-set-sortkey} +@tab Preconcatenated sort key for record + +@item Marker +@tab Marker +@tab @code{bbdb-cache-marker}@* + @code{bbdb-record-marker}@* + @code{bbdb-cache-set-marker}@* + @code{bbdb-record-set-marker}@* +@tab Marker in @file{.bbdb} for start of record + +@item Deleted +@tab Boolean +@tab @code{bbdb-cache-deleted-p}@* + @code{bbdb-record-deleted-p}@* + @code{bbdb-cache-set-deleted-p}@* + @code{bbdb-record-set-deleted-p} +@tab Set to @code{t} if record has been deleted, @code{nil} if not + +@end multitable + +The functions listed above will return @code{nil} if their respective +cache fields are not set. The functions listed below will return the +value of their cache fields if set, but will also build (and set) the +correct field values if the fields are unset: + +@table @code +@item bbdb-record-name +Return the name in the Name Cache field of the cache (if set). If +the name has not been built yet (if the field is @code{nil}), the name is +built, stored in the Name Cache field, and returned. + +@item bbdb-record-sortkey +Return the name it the Sort Key field of the cache (if set). If the +Sort Key field has not yet been set (if the field is @code{nil}), the +Sort Key is built, stored in the Sort Key field, and returned. + +@end table + +@subsubsection Notes String or Alist + +If there is only a single note for a given record, the notes field for +that record will be a string. If there is more than one note, the notes +field will be an association list (alist) with elements of the form + +@center ( @var{NAME} . @var{VALUE} ) + +@noindent +where @var{NAME} is the symbol for the name of the note, and +@var{VALUE} is the value of the note. + +@subsubsection Example BBDB record + +@node Mailing Lists, Changes, Internals, Top +@section Mailing Lists + +(If you are looking for a way to create mailing lists with @b{BBDB}, you +should be looking at the section on @xref{Mail Sending Interfaces}.) + +There are three mailing lists for the @b{BBDB}. +@code{bbdb-info@@lists.sourceforge.net} gets moderate traffic, and is +intended for the discussion and distribution of development versions of +the @b{BBDB}. Users of development versions of the @b{BBDB} should be +subscribed to this list. It is also to this list that bugs should be +reported. @xref{Known Bugs}. for instructions on submitting bug reports. + +The second mailing list @code{bbdb-announce@@lists.sourceforge.net} has +very low volume. Any user of the @b{BBDB} should consider subscribing to +this list, as new releases and security issues will be posted here. + +A third mailing list, @code{bbdb-cvs@@lists.sourceforge.net}, is +intended for developers to follow the changes made to the @b{BBDB} +development version. Developers of the @b{BBDB} should consider to +subscribe to this list. + +@node Changes, The Latest Version, Mailing Lists, Top +@section Changes in this Version + +@menu +* Major Changes:: Major changes in this version +* Other Changes:: Not-so-major changes +@end menu + +@node Major Changes, Other Changes, Changes, Changes +@subsection Major Changes + +@subsubheading Database File Version Change + +(the following version-migration text will move in a future version. It is in +this section currently because new users will likely not experience it) + +There has been a version change in the @b{BBDB} database file. The new +version supports non-US zip codes, and an additional ``Country'' field +in addresses. + +An automatic version-migration mechanism has been implemented that allows +older version @file{.bbdb} files to either be migrated to the new version, or +used as-is without migrating. When the @b{BBDB} detects a database file with +an old version, it will display the features that have been introduced @b{in +the database file} from the time of the older version's implementation. It +will offer the choice of migration or use of the @b{BBDB} with the +older-version file. + +If migration is chosen, the database file will be automatically changed to the +new format. If migration is declined, the file will kept in the older format +in the @code{.bbdb} buffer, but will be stored internally in the new format. +When changes need to be made to the @code{.bbdb} buffer, changed records will +be reverse-migrated from their internal version to that of the disk file. + +@node Other Changes, , Major Changes, Changes +@subsection Other Changes + +@subsubheading TeX Output + +By default, ec fonts are used for TeX output instead of cm fonts. With +the @code{ps-fonts} option set in @code{bbdb-print-alist}, TimesNewRoman +and Courier fonts are used. + +@itemize @bullet +@end itemize + +@node The Latest Version, The Future, Changes, Top +@section The Latest Version + +@noindent +Released versions of the @b{BBDB} can be found at the +following site: + +@itemize @bullet +@item +WWW: @code{http://bbdb.sourceforge.net} +@item +FTP: @code{ftp://ftp.sourceforge.net/pub/bbdb} +@end itemize + +@noindent +Development versions of the @b{BBDB} can be obtained in the +following ways: + +@itemize @bullet +@item +WWW: @code{http://bbdb.sourceforge.net} +@item +Anonymous CVS: See @code{http://bbdb.sourceforge.net} for instructions. +@end itemize + +Users of development versions of the @b{BBDB} should subscribe to the +@code{bbdb-info} mailing list. @xref{Mailing Lists}. + +@node The Future, , The Latest Version, Top +@section The Future + +The future consists of Bugs and Features. + +@menu +* Known Bugs:: Known Bugs, and how to submit new ones +* TODO List:: The TODO List +* EOL Statements:: EOL (End Of Life) Statements +@end menu + +@node Known Bugs, TODO List, The Future, The Future +@subsection Known Bugs + +@enumerate +@item +@b{@kbd{M-TAB} conflicts with ispell.} Workaround: The binding +installed by the @b{BBDB} for address completion/expansion conflicts with +that used by ispell. The suggested workarounds are to rebind the ispell +key (the @b{BBDB} binding is not configurable at this time), to manually +invoke ispell via @kbd{M-x}, or to not use ispell completion functionality +in @b{BBDB}-enabled message composition buffers. The following is an +example of such a rebinding, supplied by Kai Großjohan: + +@lisp +(defun my-message-mode-keys () + (define-key message-mode-map (kbd "M-TAB") 'bbdb-complete-name)) + (add-hook 'message-mode-hook 'my-message-mode-keys) +@end lisp + +@item +@b{@b{BBDB} and abbrev expansion is inconsistent.} Workaround: +Currently, @kbd{M-TAB} must be used to expand/complete against @b{BBDB} +names and net addresses, and @kbd{TAB} must be used to expand abbrevs (the +values in the @code{mail-alias} field). Unification is planned for a +future version. + +@item +@b{The @code{*BBDB*} buffer does not always come up when the first +article in a Gnus Summary Buffer is selected.} Workaround: Pressing +@kbd{g} to reload the article. This will cause the @code{*BBDB*} buffer +to be displayed. + +@item +@b{Expansion will fail when the name to be expanded is a subset of +the name for another record.} For example, if you have entries for +@samp{John} and @samp{Johnathan}, you will not be able to expand the +name for @samp{John}. Workaround: Use the net address for the subset +name (@samp{John} in this example). + +@end enumerate + +@cindex Bug Reports +It is commonly known that there are no bugs in the @b{BBDB}. Bugs +found in defiance of this rule should be submitted using @kbd{M-x +bbdb-submit-bug-report}. These bug reports will bbe sent to the +@code{bbdb-info} mailing list (@pxref{Mailing Lists}) and are +available from public archives. Other big brothers may be reading +your bug reports. + +@node TODO List, EOL Statements, Known Bugs, The Future +@subsection TODO List + +@subsubheading The Near Future + +@itemize @bullet +@item +Add bbdb/@i{MUA}-delete-sender-record + +@item +Configurable completion. Should allow user to specify "complete on +names first, then nets", etc. + +@item +More variables for upgrading. Specifically a variable that lets users +specify extra fields for upgrading (an alist @samp{(a . b)} that says +field @samp{a} should be upgraded the same way as field @samp{b}. + +@item +Change all functions that switch on MUAs to use compose-mail (ex: +@code{bbdb-send-mail-internal}). + +@item +Soren Dayton's method for generically extending the @b{BBDB} with +special-purpose fields + +@item +Sorting records on alternate keys. @code{bbdb-sort-by} from Boris +Goldowsky. +@c nnml:bbdb-maint + +@item +Sorting individual types of fields - Sam Steingold's method. + +@item +Button 3 menus (Mark Moll and Soren Dayton) + +@c @item +@c @b{BBDB}-controlled mail splitting in Gnus. Add hook for Soren to make +@c splitting better. Routine from Brian Edmonds. +@c Anyone have contact info for Soren Dayton? + +@item +Conditionalized erasure of properties when text is pasted into the @b{BBDB}. + +@item +Should notice when there are @samp{Reply-To:} addresses.@refill + +@item +Should have a command for merging together two divergent copies of +a @file{.bbdb} file (in case you read mail on one machine and news on +another, for instance.)@refill + +@item +The @samp{*BBDB*} buffer should be resized to exactly fit what it's +displaying, even when not in ``electric'' mode.@refill + +@item +It should be possible to do completion on last names as well as first +names.@refill + +@item +The BBDB buffer is left at the top of the stack when GNUS is exited +because GNUS runs its exit-hooks too early. This should be fixed.@refill + +@item +String area codes (German area codes can begin with zeroes) patch from +@code{Michael Sperber <sperber@@informatik.uni-tuebingen.de>} + +@c @item +@c Internationalization of addresses. Country code to control formats for +@c printing, etc. Country->Format mapping. + +@item +Default country variable, similar to @code{bbdb-default-area-code}. + +@item +Make format self-describing in comment + +@item +ISO-8859-x characters in records for printing. + +@item +Prefix for @kbd{W} (@code{bbdb-www}) command to allow selection of +different addresses. + +@item +Generalized buttons (via extents) for fields. Example: @samp{(a . b)} +means create button that calls @samp{b} for each entry in the @samp{a} +field. + +@item +Remove support for GNUS. Start with lisp Makefile (remove nntp and gnus +loads). + +@item +More flexible auto-addition. Conditionalizing of addition (conditions +or supplied function). Prompt if multiple records that meet criteria exist. + +@item +Different output formats. See Toby Speight's @code{<s8iurdodvm.fsf@@plato.ansa.co.uk>} +and Bin Mu's @code{<199801221605.KAA23663@@DerivaTech.Com>}. + +@item +Generalized area-code-split program that could split, for example, based +on input copied (or straight fetch of page) from the Bellcore NANP page. + +@item +Print multivalue (comma-separated) fields with one value per line + +@item +Easier BBDB extension. See @code{<xcdyb30f3hb.fsf@@ra.cs.uchicago.edu>} +from Soren Dayton. + +@item +Take birthdays from the @b{BBDB}, add them to calendar. From Boris +Goldowsky. +@c In nnml:bbdb-maint + +@item +Make mail aliases file for other mailers. From Boris Goldowsky. +@c In nnml:bbdb-maint + +@item +Various patches from Boris Goldowsky in @file{bbdb-ext}. + +@item +Various other patches: +@itemize @minus +@item +@code{bbdb-filters-0.2} +@item +@code{bbdb-frame.el} +@item +@code{bbdb-letter-1.0} +@item +@code{bbdb-plz} +@item +@code{bbdb-query} +@item +@code{country} +@item +@code{country-info} +@end itemize +@noindent +Note that these files have not been investigated. They may or +may not be incorporated. + +@item +Ability to remove all properties from copied strings. + +@end itemize + + +@subsubheading Not-So-Near Future + +@itemize @bullet +@item +Fix Gnus scoring so it rebuilds when gnus-score disappears + +@item +Multiline note fields + +@item +Change key to be some kind of unique number + +@item +There should be better support for non-American addresses and phone +numbers. This might be Near Future if somebody volunteers to send me patches. + +@item +Should reimplement ``electric'' mode to not be so broken.@refill + +@item +The @kbd{*C-o} keystroke should add a field to all displayed records. +Perhaps @kbd{*;} should append some text to an arbitrary field of all +displayed records. @refill + +@item +Multiple @file{.bbdb} files with precedence relationships. See Wes +Hardaker's @*@code{<sdu3awz75a.fsf@@oakdale.ucdavis.edu>} + +@item +Automatically grab information about a person from their sig. See +Graham Clark's @code{info-bbdb} post +@code{<6282.199706161624@@havra.dcs.ed.ac.uk>} and Adrian Aichner's +@code{info-bbdb} post +@code{<rxsiuzebpgp.fsf@@midnight.ecf.teradyne.com>}. Would like to have +@code{bbdb-snarf} attack the sig then compare the snarfed data with the +header data. + +@end itemize + +@subsubheading Thoughts + +@itemize @bullet +@item +Are there enough hooks? + +@item +The interfaces should share more code. @refill + +@item +The @code{bbdb-create-internal} function should be more forgiving.@refill + +@item +More @kbd{*} commands in general, including @kbd{*d}. +@end itemize + +@node EOL Statements, , TODO List, The Future +@subsection End of Life (EOL) Statements + +The items in the following list describe items for which support will be +removed in coming versions of the @b{BBDB}. The items listed are +guaranteed to be supported and present only until the EOL date. They +may be removed without warning at any time thereafter. + +@enumerate +@item +@code{advertized-bbdb-delete-current-field-or-record}@* +Support for this function will be removed for version 2.2. It is +recommended that all code depending on this variable be switched to use +@code{bbdb-delete-current-field-or-record}. The two functions have the +same calling conventions and effects. This EOL statement was added for +version 2.1. + +@item +Support for the GNUS (not Gnus) newsreader@* +The GNUS-specific parts of the @b{BBDB} will be actively removed for the +2.2 release. No further maintenance and/or bugfixes are planned for +GNUS code at this time. This EOL statement was added for version 2.1. +@end enumerate + +@node Thanks, , , Top +@section Thanks + +Thanks to everyone on the info-bbdb mailing list for many useful +suggestions. This hack would be far less insidious without their input! + +@subheading Thanks list for versions after 2.00.06. +@c I'm trying to include as many code contributors as possible here. It +@c doesn't happen without your help! + +Thanks to Alex Schroeder, Ronan Waide, Thomas DeWeese, Robert Fenk, +Didier Verna, Bill Carpenter. + +@subheading Thanks list for versions after 1.51 prior to and including 2.00.06. + +Thanks to Adrian Aichner, Kees de Bruin, David Carlton, Soren Dayton, +Brian Edmonds, Boris Goldowsky, Seth Golub, John Heidemann, Christopher +Kline, Carsten Leonhardt, Hrvoje Niksic, Jens-Ulrik Hoger Petersen, +Colin Rafferty, Matt Simmons, Sam Steingold, Marco Walther, Christoph +Wedler. + +@subheading Thanks list for versions prior to and including 1.51. + +And special thanks to Sebastian Kremer, Joe Wells, Todd Kaufmann, Andy +Norman, Ivan Vazquez, Stewart Clamen, Roland McGrath, Dave Brennan, +Kimball Collins, Dirk Grunwald, Philippe Queinnec, Boris Putanec, Dave +Disser, Francois Felix Ingrand, Sean Owens, Guido Bosch, Lance Brown, +Tom Emerson, George Hartzell, Luis Miguel Silveira, Kimmo Suominen, +Derek Upham, David Zuhn, Rod Whitby, Richard Mlynarik. + +Last, but not least, thanks to Jamie Zawinski for writing @b{BBDB} in the +first place. + +@node _,,,(dir) +@unnumbered _ +@example +in.sid.i.ous aj \in-'sid-e-*s\ + [L insidiosus, fr. insidiae ambush, fr. insidere to sit in, sit on, + fr. in- + sedere to sit -- more at SIT] + 1 a : awaiting a chance to entrap TREACHEROUS + b : harmful but enticing SEDUCTIVE + 2 a : having a gradual and cumulative effect SUBTLE + b of a disease + : developing so gradually as to be well established before + becoming apparent + in.sid.i.ous.ly av + in.sid.i.ous.ness n +@end example + + + +@menu +* Top:: +* _:: +@end menu + +@node Concept Index, Variable Index,, Top +@unnumbered Concept Index +@printindex cp + +@node Variable Index, , Concept Index, Top +@unnumbered Variable Index +@printindex vr + +@contents +@bye diff --git a/texinfo/infohack.el b/texinfo/infohack.el new file mode 100644 index 0000000..0fa6af0 --- /dev/null +++ b/texinfo/infohack.el @@ -0,0 +1,55 @@ +;;; infohack.el --- a hack to format info file. +;; Copyright (C) 2001 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> +;; Keywords: info + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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, or (at your option) +;; any later version. + +;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(require 'texinfmt) + +(defun infohack-remove-unsupported () + (goto-char (point-min)) + (while (re-search-forward "@\\(end \\)?ifnottex" nil t) + (replace-match ""))) + +(defun infohack (file) + (let ((dest-directory default-directory) + (max-lisp-eval-depth (max max-lisp-eval-depth 600))) + (find-file file) + (infohack-remove-unsupported) + (texinfo-every-node-update) + (texinfo-format-buffer t) ;; Don't save any file. + (setq default-directory dest-directory) + (setq buffer-file-name + (expand-file-name (file-name-nondirectory buffer-file-name) + default-directory)) + (if (> (buffer-size) 100000) + (Info-split)) + (save-buffer))) + +(defun batch-makeinfo () + "Emacs makeinfo in batch mode." + (infohack (car command-line-args-left)) + (setq command-line-args-left nil)) + +;;; infohack.el ends here diff --git a/utils/.gitignore b/utils/.gitignore new file mode 100644 index 0000000..85a41a5 --- /dev/null +++ b/utils/.gitignore @@ -0,0 +1,2 @@ +/Makefile +/*.debian diff --git a/utils/Makefile.in b/utils/Makefile.in new file mode 100644 index 0000000..d248dc1 --- /dev/null +++ b/utils/Makefile.in @@ -0,0 +1,40 @@ +@SET_MAKE@ + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_DATA = @INSTALL_DATA@ + +RM = @RM@ +LN_S = @LN_S@ + +PACKAGEDIR = @PACKAGEDIR@ +SYMLINKS = @SYMLINKS@ +LINKPATH = @LINKPATH@ + +install-pkg: uninstall-pkg + @if test "x$(SYMLINKS)" = "xno" ; then \ + mkdir -p -m 0755 $(PACKAGEDIR)/etc/bbdb/utils ; \ + for i in `ls -d * | egrep -v '(Makefile|CVS)'` ; do \ + $(INSTALL_DATA) $$i $(PACKAGEDIR)/etc/bbdb/utils/ ; \ + done ; \ + else \ + if test "x$(LINKPATH)" = "x" ; then \ + $(LN_S) `pwd` $(PACKAGEDIR)/etc/bbdb/utils ; \ + else \ + $(LN_S) $(LINKPATH)/utils $(PACKAGEDIR)/etc/bbdb/utils ; \ + fi ; \ + fi + +uninstall-pkg: + -$(RM) -r $(PACKAGEDIR)/etc/bbdb/utils + +clean: + +distclean: + +# Backward compatibility: +reallyclean: distclean + +cvsclean: distclean + -$(RM) Makefile diff --git a/utils/bbdb-213-310.el b/utils/bbdb-213-310.el new file mode 100644 index 0000000..5a791a5 --- /dev/null +++ b/utils/bbdb-213-310.el @@ -0,0 +1,57 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; The 213 area code (in LA) has been split into 213 and 310. This code +;;; will map over your Insidious Big Brother Database and convert the area +;;; codes when approriate. It then displays the records which it has changed. +;;; +;;; This is derived from a list posted by Paul Eggert <eggert@twinsun.com> +;;; on 3 Mar 92 18:24:04 GMT. + +(require 'bbdb) + +(defconst bbdb-310-exchanges + '(201 202 203 204 205 206 207 208 209 210 212 214 215 216 217 218 219 220 + 246 247 270 271 273 274 275 276 277 278 279 280 281 282 284 285 286 287 + 288 289 297 301 302 305 306 312 313 314 315 316 317 318 319 320 322 323 + 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 348 350 352 + 354 355 363 364 370 371 372 373 374 375 376 377 378 379 390 391 392 393 + 394 395 396 397 398 399 401 402 403 404 406 407 408 409 410 412 414 416 + 417 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 + 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 + 454 455 456 457 458 459 470 471 472 473 474 475 476 477 478 479 490 491 + 492 493 494 495 496 497 498 499 501 502 510 512 513 514 515 516 517 518 + 519 521 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 + 540 541 542 543 544 545 546 547 548 549 550 551 552 553 556 557 558 559 + 568 570 571 572 573 574 575 576 577 578 590 591 592 593 594 595 596 597 + 598 599 601 602 603 604 605 606 607 608 609 615 616 618 630 631 632 633 + 634 635 637 638 639 640 641 642 643 644 645 646 647 648 649 652 657 659 + 670 671 672 673 674 675 676 677 679 690 691 692 693 694 695 696 697 698 + 699 708 715 719 761 762 763 764 767 768 769 781 782 783 784 785 787 788 + 791 792 793 794 795 796 797 798 799 800 801 802 803 804 806 807 809 812 + 813 814 815 816 819 820 821 822 823 824 825 826 827 828 829 830 831 832 + 833 834 835 836 837 838 839 840 841 842 843 854 855 858 859 860 861 862 + 863 864 865 866 867 868 869 885 886 898 899 902 903 904 905 906 907 908 + 914 915 916 917 918 920 921 922 923 924 925 926 927 928 929 940 941 942 + 943 944 945 946 947 948 949 967 970 973 978 980 981 982 983 984 985 986 + 987 988 989) + "Those exchanges which have moved from the 213 area code to the new 310.") + +(defun bbdb-convert-213-to-310 () + "Convert phone numbers in the BBDB which are in the 213 area code to the +newly-created 310 area code if appropriate." + (let ((records (bbdb-records)) + phones frobbed change-p) + (while records + (setq phones (bbdb-record-phones (car records)) + change-p nil) + (while phones + (if (and (= (bbdb-phone-area (car phones)) 213) + (memq (bbdb-phone-exchange (car phones)) bbdb-310-exchanges)) + (setq change-p (bbdb-phone-set-area (car phones) 310))) + (setq phones (cdr phones))) + (if change-p + (progn + (setq frobbed (cons (car records) frobbed)) + (bbdb-change-record (car records) nil))) + (setq records (cdr records))) + (bbdb-display-records frobbed))) diff --git a/utils/bbdb-415-510.el b/utils/bbdb-415-510.el new file mode 100644 index 0000000..2870151 --- /dev/null +++ b/utils/bbdb-415-510.el @@ -0,0 +1,87 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; The San Francisco Bay Area, which was formerly area code 415, has been +;;; split into two area codes: 415 for the west side of the bay, and 510 +;;; for the east side. This code will map over your Insidious Big Brother +;;; Database and convert the area codes when approriate. It then displays +;;; the records which it has changed. + +(require 'bbdb) + +(defconst bbdb-415-exchanges + '(206 219 221 227 239 241 243 244 252 255 257 258 259 266 267 282 285 289 + 291 292 296 306 307 312 321 322 323 324 325 326 327 328 329 330 331 332 + 333 334 335 336 337 338 340 341 342 343 344 345 346 347 348 349 354 355 + 358 359 361 362 363 364 365 366 367 368 369 371 375 377 378 381 382 383 + 386 387 388 389 391 392 393 394 395 396 397 398 399 403 404 406 421 424 + 431 432 433 434 435 441 442 445 449 453 454 456 457 459 461 464 465 466 + 467 468 469 472 473 474 476 477 478 479 485 488 491 492 493 494 495 496 + 497 499 502 506 507 508 512 513 541 542 543 544 545 546 550 552 553 554 + 556 557 558 561 563 564 565 566 567 570 571 572 573 574 576 578 579 583 + 584 585 586 587 588 589 591 592 593 594 595 597 599 604 610 616 617 621 + 622 626 627 637 641 647 648 661 662 663 664 665 666 668 669 673 677 681 + 688 691 692 694 695 696 697 701 703 705 715 721 723 725 726 728 731 737 + 738 739 742 744 747 749 750 751 752 753 755 756 759 761 764 765 768 771 + 772 773 774 775 776 777 780 781 788 789 804 806 807 813 821 822 824 826 + 851 852 853 854 855 856 857 858 859 861 863 864 868 871 872 873 875 876 + 877 878 879 882 883 885 892 894 896 897 898 903 904 905 912 917 921 922 + 923 924 925 926 927 928 929 931 940 941 948 949 951 952 953 954 955 956 + 957 960 961 962 964 965 966 967 968 969 972 973 974 978 979 981 982 983 + 984 985 986 989 991 992 993 994 995 997 998) + "Those exchanges which are still in the 415 area code.") + +(defconst bbdb-510-exchanges + '(204 208 210 215 222 223 224 226 228 229 231 232 233 234 235 236 237 238 + 245 246 248 251 253 254 256 261 262 263 268 271 272 273 275 276 277 278 + 283 284 287 293 294 295 297 302 308 313 317 339 351 352 356 357 370 372 + 373 374 376 420 422 423 425 426 427 428 429 430 436 437 438 439 443 444 + 446 447 448 451 452 455 458 460 462 463 471 475 481 482 483 484 486 487 + 489 490 498 515 516 521 522 523 524 525 526 527 528 529 530 531 532 533 + 534 535 536 537 538 539 540 547 548 549 551 559 562 568 569 577 581 582 + 596 598 601 602 603 606 609 613 614 618 620 623 624 625 631 632 633 634 + 635 636 638 639 642 643 644 645 646 649 651 652 653 654 655 656 657 658 + 659 667 670 671 672 674 675 676 678 680 682 683 684 685 686 687 689 704 + 706 708 709 713 716 717 718 724 727 729 732 733 734 735 736 741 743 745 + 746 748 754 757 758 762 763 769 778 779 782 783 784 785 786 787 790 791 + 792 793 794 795 796 797 798 799 801 803 810 814 815 819 820 823 825 827 + 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 845 846 + 847 848 849 862 865 866 867 869 874 881 884 886 887 888 889 891 893 895 + 901 910 930 932 933 934 935 937 938 939 942 943 944 945 946 947 975 977 + 987) + "Those exchanges which have moved from the 415 area code to the new 510.") + + +(defsubst bbdb-convert-415-to-510-internal (phone) + (cond ((memq (bbdb-phone-exchange phone) bbdb-510-exchanges) + (if (= (bbdb-phone-area phone) 510) + nil + (bbdb-phone-set-area phone 510))) + ((memq (bbdb-phone-exchange phone) bbdb-415-exchanges) + (if (= (bbdb-phone-area phone) 415) + nil + (bbdb-phone-set-area phone 415))) + (t (error "Exchange %03d is not in the 415 or 510 area codes: %s" + (bbdb-phone-exchange phone) + (bbdb-phone-string phone))))) + + +(defun bbdb-convert-415-to-510 () + "Convert phone numbers in the BBDB which are in the 415 area code to the +newly-created 510 area code if appropriate." + (let ((records (bbdb-records)) + phones frobbed change-p) + (while records + (setq phones (bbdb-record-phones (car records)) + change-p nil) + (while phones + (if (memq (bbdb-phone-area (car phones)) '(415 510)) + (setq change-p + (or (bbdb-convert-415-to-510-internal (car phones)) + change-p))) + (setq phones (cdr phones))) + (if change-p + (progn + (setq frobbed (cons (car records) frobbed)) + (bbdb-change-record (car records) nil))) + (setq records (cdr records))) + (bbdb-display-records frobbed))) diff --git a/utils/bbdb-areacode-split.pl b/utils/bbdb-areacode-split.pl new file mode 100755 index 0000000..b77e65f --- /dev/null +++ b/utils/bbdb-areacode-split.pl @@ -0,0 +1,62 @@ +#!/usr/bin/perl +# +# Looks for phone numbers in your .bbdb with a particular area code +# and one of a set of exchanges and changes the area code. The old +# and new area codes are specified on the command line, as is the +# location of a file that contains the exchanges that are being +# changed. (The format of that file is very loose. Every three digit +# sequence will be used.) +# +# Seth Golub <seth@cs.wustl.edu> +# 15 Aug 1997 + +sub Usage +{ + $0 =~ s@.*/@@; + die "Usage: \n $0 <old-code> <new-code> <exchanges-file> [bbdb]\n"; +} + +$old_area_code = shift || Usage(); +$new_area_code = shift || Usage(); +$exchange_list_file = shift || Usage(); + +$bbdb_file = $ENV{'BBDB'} || shift || $ENV{'HOME'} . '/.bbdb'; +$bbdb_dir = `dirname $bbdb_file`; chomp $bbdb_dir; +$tmp_file = "$bbdb_dir/bbdb.new-$$"; + +open( LIST, "<$exchange_list_file" ) + || die "Failed to open $exchange_list_file\n"; + +while (<LIST>) +{ + while ( /(\d\d\d)/g ) + { + push( @exchanges, $1 ); + } +} + +close( LIST ); + +$exchanges = join( '|', @exchanges ); + +open( BBDB_IN, "<$bbdb_file" ) || die "Failed to open $bbdb_file\n"; +open( BBDB_OUT, ">$tmp_file" ) || die "Failed to open $tmp_file\n"; + +while (<BBDB_IN>) +{ + next unless /^\[/; + s/(\[\".*?\") $old_area_code (($exchanges) \d+ \d+\])/$1 $new_area_code $2/og; +} continue { + print BBDB_OUT; +} + +close( BBDB_IN ); +close( BBDB_OUT ); + +unlink( "$bbdb_file.bak" ); +rename( $bbdb_file, "$bbdb_file.bak" ); +rename( $tmp_file, $bbdb_file ); + +print STDERR "Old bbdb moved to $bbdb_file.bak\n"; + +__END__ diff --git a/utils/bbdb-cid.pl b/utils/bbdb-cid.pl new file mode 100755 index 0000000..a422b67 --- /dev/null +++ b/utils/bbdb-cid.pl @@ -0,0 +1,516 @@ +#!/usr/bin/perl -w +# +# Caller-ID-logger, by jwz (19-Jan-97) +# Modified: 24-Apr-97 +# +# Opens the modem and waits for it to print caller-ID data. When it does, +# it logs it to a file, parses it, and pops up a window using "xmessage". +# If the number is present in your .bbdb file, it shows the name (or company) +# associated with it. +# +# Todo: +# My caller ID service (in San Francisco) only ever sends numbers, not names, +# so I've never seen a "name" line come in; I assume that it would send both +# a name and a number, so it would be nice to present both (with error +# checking against BBDB) but the code as currently structured only handles +# one-line-per-call. It should realize that consecutive lines with the same +# timestamp are the same call. +# +# Modems other than ZyXELs have different caller-ID formats, and this doesn't +# deal with those. + +############################################################################## +# +# Some variables you might want to set... + + +# Set this to the device that your modem is attached to. +# +$modem_device = "/dev/ttyd1"; + +# This is your .bbdb file. (Set it to null if you don't want to do BBDB +# lookups at all, but why would you want to go and do a thing like that?) +# +$bbdb_file = "$ENV{HOME}/.bbdb"; + +# A shell command to use to cause emacs to pop up the BBDB buffer +# (bbdb-srv.pl is a good choice, so it defaults to the value of the +# shell environment variable $NS_MSG_DISPLAY_HOOK.) +# +$bbdb_cmd = $ENV{NS_MSG_DISPLAY_HOOK}; + +# If you want the $bbdb_cmd to be run on a different host, set it here. +# +$bbdb_host = "gimp"; + +# If you want each call to be logged to a file as well, name it here. +# +$logfile = "/usr/spool/fax/log/cid-log"; + +# For verbosity... +$debug = 0; + +# How to pop up a dialog box. +# +$xmessage_cmd = "xmessage"; +@xmessage_args = ("-display", ":0", + "-name", "Caller ID", + # roughly centered on my screen; YMMV. + "-geometry", "+400+400", + "-xrm", "*Font: -*-new cent*-bold-r-normal-*-240-*", + "-xrm", "*Foreground: black", + "-xrm", "*Background: lightgreen", + # no buttons on the window: dismiss it by clicking in it. + "-button", "", + "-xrm", "*form.Translations: #override <BtnDown>: exit(0)", + "-xrm", "*Command.Font: -*-new cent*-bold-r-normal-*-120-*", + "-xrm", "*Command.horizDistance: 130" + ); + +# Uh, let's turn off the screensaver before popping up the window. +# +$pre_dialog_cmd = "xscreensaver-command -deactivate"; + + +# commands (and their expected responses) used to initialize the modem. +# +@modem_init = ( "AT", "OK", # ping + "ATZ", "OK", # reset + "ATE0", "OK", # don't echo commands + "ATM0", "OK", # turn off speaker + "ATN0", "OK", # turn off ringer + "ATS40.2=1", "OK", # turn on caller ID + ); + + +# for diagnostics: if the modem ever asynchronously prints something that +# doesn't match this, we issue a warning. +# +$expected_responses = "^CALLER NUMBER" . "|" . + "^REASON FOR NO CALLER " . "|" . + "^RING" . "|" . + "^TIME: [-0-9: ]+\$"; + + +############################################################################## +# +# Talking to the serial port... +# +# + +if ( $ debug ) { + use diagnostics; +} + + +sub open_modem { + use IPC::Open2; + + # Close the terminal streams before forking `cu', because otherwise + # it fucks around with the stty settings. + # + open(SAVEIN, "<&STDIN") || die("can't dup stdin"); + open(SAVEOUT, ">&STDOUT") || die("can't dup stdout"); + open(SAVEERR, ">&STDERR") || die("can't dup stderr"); + close(STDIN); + close(STDOUT); + close(STDERR); + + my $cu_pid = open2( \*MODEM_IN, \*MODEM_OUT, + "cu -l$modem_device -s2400 2>&1"); + + # Now that cu has been launched, we can restore them. + # + open(STDIN, "<&SAVEIN") || die("can't restore stdin"); + open(STDOUT, ">&SAVEOUT") || die("can't restore stdout"); + open(STDERR, ">&SAVEERR") || die("can't restore stderr"); + close(SAVEIN); + close(SAVEOUT); + close(SAVEERR); + + # The following doesn't seem to work and I don't know why... + # + # Set up a signal handler to try and kill off the cu process + # when we exit, instead of waiting ~30 seconds for it to notice + # that the pipe is gone... + # +# $SIG{INT} = sub { my $signame = shift; +# if ( $debug) { +# print STDERR "sending $signame to $cu_pid\n"; +# } +# print MODEM_OUT "\r\n~.\r\n"; +# close MODEM_OUT; +# close MODEM_IN; +# kill ($signame, $cu_pid); +# exit (1); +# }; + + $_ = <MODEM_IN>; + chop; + if ( !m/^Connected/ ) { + print STDERR "$0: cu printed `$_' instead of `Connected'\n"; + } +} + +sub read_line { + $_ = <MODEM_IN>; + $_ || die("got eof on modem"); + s/[\r\n]+$//; + if ( $_ eq "" ) { + $_ = <MODEM_IN>; + $_ || die("got eof on modem"); + s/[\r\n]+$//; + } + return $_; +} + +sub command { + my ( $command, $expected_response) = @_; + + if ( $debug ) { + print STDERR "sending: $command\n"; + } + + print MODEM_OUT "$command\r\n"; + my $line = read_line(); + + if ( $line eq $command ) { + if ( $debug ) { + print STDERR " got echo: reading next line too...\n"; + } + $line = read_line(); + } + + if ( $line ne $expected_response ) { + print STDERR " got: $line ; expected: $expected_response\n"; + } elsif ( $debug ) { + print STDERR " got: $line\n"; + } +} + +sub init_modem { + open_modem; + + my $len = $#modem_init + 1; + my $i; + for ($i = 0; $i < $len; $i += 2) { + command($modem_init[$i], $modem_init[$i+1]); + } +} + +sub handle_async_line { + local ( $_ ) = @_; + + if (!m/$expected_responses/) { + print STDERR "modem turd: $_\n"; + + } elsif (m/CALLER/) { + if ( $debug ) { + print STDERR "caller: $_\n"; + } + handle_cid_line($_); + + } elsif ( $debug ) { + if ( $_ eq '' ) { + print STDERR "ignored: blank line\n"; + } else { + print STDERR "ignored: $_\n"; + } + } +} + + +############################################################################## +# +# Parsing BBDB and CID data... +# + +sub find_bbdb_record { + my ( $area, $exchange, $suffix ) = @_; + + if ( ! $bbdb_file ) { + return undef; + } + + # strip off leading 0's, to match the way it's stored in .bbdb. + $area =~ s/^0+(.)/$1/; + $exchange =~ s/^0+(.)/$1/; + $suffix =~ s/^0+(.)/$1/; + + my $bbdb_rec = undef; + my $pat = "\\[\"[^\"]+\" $area $exchange $suffix (nil|[0-9]+)\\]"; + + open(BBDB, "<$bbdb_file") || die("error opening $bbdb_file: $!\n"); + + while (<BBDB>) { + if ( m/$pat/ ) { + $bbdb_rec = $_; + last; + } + } + close(BBDB); + return $bbdb_rec; +} + + +# note: global (kludge!) +$pretty_number = 0; + +sub make_message_string { + my ( $number, $date, $fn, $ln, $co, $error ) = @_; + my $msg; + + my $line_prefix = " "; + my $line_suffix = " "; + + # First print the date (reformatted.) + # + $_ = $date; + my ( $dotw, $mon, $day, $hr, $min, $sec, $year ) = + m/^([^ ]+) +([^ ]+) +([^ ]+) +([^:]+):([^:]+):([^:]+) +([^ ]+) *$/; + $year =~ s/^..(..)/$1/; + $day =~ s/^0//; + $hr =~ s/^0//; + if ($hr < 12) { + $ampm = "am"; + } else { + $ampm = "pm"; + if ($hr > 12) { $hr -= 12 }; + } + $date = "$hr:$min$ampm, $day-$mon-$year ($dotw)"; + $msg = $line_prefix . $date . $line_suffix; + + # Next print the caller name, company, or error message. + # + if ( $error ) { + $msg .= "\n" . $line_prefix . $error . $line_suffix; + } elsif ( $co && !$fn && !$ln ) { + $msg .= "\n" . $line_prefix . $co . $line_suffix; + } elsif ( $fn || $ln ) { + $msg .= "\n" . $line_prefix . "$fn $ln" . $line_suffix; + } + + # Next print the phone number (formatted nicely.) + # + if ( $number ) { + my $area = 0; + my $exchange = 0; + my $suffix = 0; + $_ = $number; + ( $area, $exchange, $suffix ) = + m/^([0-9][0-9][0-9])([0-9][0-9][0-9])([0-9][0-9][0-9][0-9]+)/; + + # note: global (kludge!) + $pretty_number = "($area) $exchange-$suffix"; + $msg .= "\n" . $line_prefix . $pretty_number . $line_suffix; + } + + return $msg; +} + +use POSIX; +sub reaper { + $SIG{CHLD} = \&reaper; # loathe sysV + my $signame = shift; + if ( $debug >= 2 ) { + printf STDERR " (got SIG$signame...)\n"; + } + my $child; + while ( ( $child = waitpid(-1,WNOHANG) ), + $child > 0 ) { + if ( $debug >= 2 ) { + printf STDERR " (pid $child exited with $?)\n"; + } + } +} + +sub fork_and_exec { + my @cmd_list = @_; + + $SIG{CHLD} = \&reaper; + + if ( $debug >= 2 ) { + $_ = $cmd_list[0]; + s/ .*//; + print STDERR "forking for " . $_ . " at " . (localtime) . ".\n"; + } + + my $pid; + if ($pid = fork()) { + # parent + } elsif (!defined $pid) { + print STDERR "$0: fork failed: $!\n"; + } else { + # child + + if ( $debug ) { + $_ = $cmd_list[0]; + s/ .*//; + print STDERR "exec'ing " . $_ . " at " . (localtime) . + " in pid $$.\n"; + } + close(STDIN); + close(STDOUT); + close(STDERR); + exec @cmd_list; + } +} + + +sub fork_and_exec_for_bbdb { + my @cmd_list = @_; + my $number = shift @cmd_list; + + $SIG{CHLD} = \&reaper; + + if ( $debug >= 2 ) { + $_ = $cmd_list[0]; + s/ .*//; + print STDERR "forking for " . $_ . " at " . (localtime) . ".\n"; + } + + my $pid; + if ($pid = fork()) { + # parent + } elsif (!defined $pid) { + print STDERR "$0: fork failed: $!\n"; + exit (1); + } else { + # child + + if ( $debug ) { + $_ = $cmd_list[0]; + s/ .*//; + print STDERR "exec'ing " . $_ . " at " . (localtime) . + " in pid $$.\n"; + } + if ( system @cmd_list ) { + my $cmd = "gnudoit -q '(bbdb-srv-add-phone \"$pretty_number\")'"; + if ( $bbdb_host ) { + $cmd =~ s/([()\"])/\\$1/g; + $cmd = "rsh $bbdb_host $cmd"; + } + exec $cmd; + } + exit (0); + } +} + + +sub pop_up_dialog { + my ( $msg, $buttonp, $number ) = @_; + + fork_and_exec $pre_dialog_cmd; + + if ( ! $buttonp ) { + fork_and_exec $xmessage_cmd, @xmessage_args, "\n$msg\n\n"; + } else { + my @args = ( @xmessage_args, "-button", "Add To BBDB" ); + fork_and_exec_for_bbdb $number, $xmessage_cmd, @args, "\n$msg\n\n"; + } +} + +sub pop_up_bbdb_buffer { + my ( $caller ) = @_; + if ( $bbdb_cmd ) { + my $cmd = $bbdb_cmd; + if ( $bbdb_host ) { + $cmd = "rsh $bbdb_host $cmd"; + } + $caller =~ s/\\/\\\\/g; + $caller =~ s/\"/\\\\\"/g; + `echo "Path:\nFrom: \\\"$caller\\\" <>" | $cmd >&- 2>&- &`; + } +} + + +sub handle_cid_line { + my($line) = @_; + + my $date = localtime; + + # Log the call... + # + if ( $logfile ) { + if (open(LOG, ">>$logfile")) { + print LOG "$date\t$line\r\n"; + close LOG; + } else { + print STDERR "error opening $logfile: $!\n"; + } + } + + # Pull the phone number out of the message... + # + my $number = ""; + my $error = ""; + + $_ = $line; + if ( m/^CALLER NUMBER/ ) { + ( $number ) = m/^[^:]+: *(.*) *$/; + } else { + $error = $line; + } + + my $caller = undef; + + my $fn = undef; + my $ln = undef; + my $co = undef; + my $buttonp = 0; + + if ( !$number || $number eq "" ) { + $error =~ tr#A-Z#a-z#; + $error =~ s/^REASON FOR NO CALLER (NUMBER|NAME)/Caller unknown/i; + + } else { + $_ = $number; + + my $area = 0; + my $exchange = 0; + my $suffix = 0; + ( $area, $exchange, $suffix ) = + m/^([0-9][0-9][0-9])([0-9][0-9][0-9])([0-9][0-9][0-9][0-9]+)/; + + my $bbdb_rec = find_bbdb_record($area, $exchange, $suffix); + + if ( $bbdb_rec ) { + my $junk = 0; + $_ = $bbdb_rec; + # This will lose if names or aliases have double-quotes in them. + # No doubt there's some hairier regexp magic that handles that... + ( $fn, $ln ) = m/^[\[]\"([^\"]*)\" *\"([^\"]*)\"/; + ( $junk, $junk, $junk, $co ) = + m/^[[](nil|\"[^\"]*\") *(nil|\"[^\"]*\") (nil|[(][^)]*[)]) \"([^\"]*)\"/; + + if ( $fn || $ln ) { + $caller = "$fn $ln"; + } + } else { + $buttonp = 1; + } + } + + my $msg = make_message_string($number, $date, $fn, $ln, $co, $error); + pop_up_dialog($msg, $buttonp, $pretty_number); + + if ( $caller ) { + pop_up_bbdb_buffer($caller); + } +} + + +############################################################################## +# +# hey ho. let's go. +# +sub main { + init_modem(); + while (1) { + handle_async_line(read_line()); + } + exit (1); +} + +main(); + diff --git a/utils/bbdb-srv.pl b/utils/bbdb-srv.pl new file mode 100755 index 0000000..ac26dfb --- /dev/null +++ b/utils/bbdb-srv.pl @@ -0,0 +1,45 @@ +#!/usr/bin/perl + +# This script reads a block of message headers on stdin, and converts them +# to an emacs-lisp string (quoting all dangerous characters) and then +# uses the `gnudoit' program to cause a running Emacs process to invoke +# the `bbdb-srv' function with that string. +# +# This has the effect of causing the running Emacs to display the BBDB +# record corresponding to these headers. +# +# See the Emacs side of things in bbdb-srv.el for more info. +# +# A trivial application of this is the shell command: +# +# echo 'From: Jamie Zawinski <jwz@netscape.com>' | bbdb-srv.perl +# +# which will cause the corresponding record to be displayed. +# A more interesting application of this is: +# +# setenv NS_MSG_DISPLAY_HOOK bbdb-srv.perl +# +# which will hook BBDB up to Mozilla (Unix Netscape Mail and Netscape News +# versions 3.0b2 and later only.) +# +# -- Jamie Zawinski <jwz@netscape.com>, 25-apr-96 + +# spawn in the background and return to the caller immediately. +if (fork == 0) { exit 0; } + +$str="(bbdb-srv \""; +while(<>) +{ + # quote most shell metacharacters with backslash. + s/([\\"`$#^!])/\\\1/g; + # but quote ' as \047 + s/'/\\047/g; + # and just for kicks, turn newlines into \n +# s/\n/\\n/g; + + $str = $str.$_; +} +$str=$str."\")"; + +exec "gnudoit", "-q", $str; +exit 0; diff --git a/utils/bbdb-to-netscape.el b/utils/bbdb-to-netscape.el new file mode 100644 index 0000000..cf7d5a4 --- /dev/null +++ b/utils/bbdb-to-netscape.el @@ -0,0 +1,213 @@ +;;; -*- Mode:Emacs-Lisp -*- + +;;; This file is the part of the Insidious Big Brother Database (aka BBDB), +;;; copyright (c) 1991, 1992, 1993, 1995 Jamie Zawinski <jwz@lucid.com>. +;;; Converting a BBDB database to a Netscape Address Book. +;;; last change21-feb-97. + +;;; The Insidious Big Brother Database 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, or (at your +;;; option) any later version. +;;; +;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; This file attempts to convert a BBDB database to a Netscape Address Book +;;; file. It doesn't work very well. If you fix it, let me know. -- jwz + +(require 'bbdb) + +(defun bbdb-mozilla-insert-url (string) + (let ((p (point)) + c) + (insert string) + (goto-char (prog1 p (setq p (point)))) + (while (progn + (skip-chars-forward "-a-zA-Z0-9.@/_\r\n" p) + (< (point) p)) + (setq c (following-char)) + (delete-char 1) + (insert (format "%%%02X" c)) + (setq p (+ 2 p))) + (goto-char p))) + +(defun bbdb-mozilla-insert-html (string) + (let ((p (point)) + c) + (insert string) + (goto-char (prog1 p (setq p (point)))) + (while (progn + (skip-chars-forward "^&<>" p) + (< (point) p)) + (setq c (following-char)) + (delete-char 1) + (cond ((= c ?&) (insert "&") (setq p (+ p 4))) + ((= c ?<) (insert "<") (setq p (+ p 3))) + (t (insert ">") (setq p (+ p 3))))) + (goto-char p))) + +(defun bbdb-mozilla-emit-record (record aliases) + (let (addr) + (cond ((setq addr (car (bbdb-record-net record))) + (insert " <DT><A HREF=\"mailto:") + (bbdb-mozilla-insert-url addr) + (insert "\"") + (let ((nick nil)) + (cond (nick + (insert " NICKNAME=\"") + (bbdb-mozilla-insert-html nick) + (insert "\""))) + (insert ">")) + (let ((name (or (bbdb-record-name record) + (bbdb-record-company record) + ""))) + (bbdb-mozilla-insert-html name)) + (insert "</A>\n") + (let ((notes nil)) + (cond (notes + ))) + t) + (t nil)))) + +(defun bbdb-to-netscape () + (let* ((target (cons bbdb-define-all-aliases-field + "^[a-z, ]+$")) + (records1 (bbdb-search (bbdb-records) + nil ; name + nil ; company + nil ;"netscape\\.com" ; net + target ; notes + )) + (records records1) + result record aliases match + (lists nil) + (single-aliases nil) + (count 0) + ) + (message "%d" (length records1)) + (while records + (setq record (car records)) + (setq aliases (bbdb-record-getprop record bbdb-define-all-aliases-field)) + (setq aliases (and aliases (bbdb-split aliases ","))) + (while aliases + (if (setq match (assoc (car aliases) result)) + (nconc match (cons record nil)) + (setq result (cons (list (car aliases) record) result))) + (setq aliases (cdr aliases))) + (setq records (cdr records))) + (while result + (let ((alias (downcase (car (car result)))) + (expansion (cdr (car result)))) + (cond + ((cdr expansion) + (setq lists (cons (cons alias expansion) lists))) + (expansion + (setq single-aliases (cons (cons (car expansion) alias) + single-aliases)))) + (setq result (cdr result)))) + +; (setq records (bbdb-records)) + (setq records records1) + (set-buffer (get-buffer-create "*netscape-address-book*")) + (erase-buffer) + (insert "<!DOCTYPE NETSCAPE-Addressbook-file-1>\n" + "<!-- This is an automatically generated file.\n" + "It will be read and overwritten.\n" + "Do Not Edit! -->\n" + "<TITLE>" (user-full-name) "'s Address book</TITLE>\n" + "<H1>" (user-full-name) "'s Address book</H1>\n" + "\n" + "<DL><p>\n") + (while records + (setq record (car records)) + (insert " <DT><A HREF=\"mailto:") + (let ((net (car (bbdb-record-net record)))) + (if net (insert net)) + (insert "\" ALIASID=\"") + (prin1 count (current-buffer)) + (insert "\"") + (message "%d..." count) + (setq count (1+ count)) + (cond ((setq match (cdr (assq record single-aliases))) + (insert " NICKNAME=\"") + (princ match (current-buffer)) + (insert "\""))) + (insert ">") + (insert (or (bbdb-record-name record) + net + (bbdb-record-company record) + ""))) + + (insert "</A>\n") + (let ((phones (bbdb-record-phones record)) + (addrs (bbdb-record-addresses record)) + (aka (bbdb-record-aka record)) + phone + ) + + (insert "<DD>") + (setq match nil) + (while phones + (setq phone (car phones)) + (setq match t) + (insert (format " %14s: " (bbdb-phone-location phone))) + (insert (bbdb-phone-string phone) "\n<BR>") + (setq phones (cdr phones))) + (let (addr c s) + (while addrs + (setq addr (car addrs)) + (setq match t) + (insert (format " %14s: " (bbdb-address-location addr))) + (if (= 0 (length (setq s (bbdb-address-street1 addr)))) nil + (indent-to 17) (insert s "\n<BR>")) + (if (= 0 (length (setq s (bbdb-address-street2 addr)))) nil + (indent-to 17) (insert s "\n<BR>")) + (if (= 0 (length (setq s (bbdb-address-street3 addr)))) nil + (indent-to 17) (insert s "\n<BR>")) + (indent-to 17) + (insert (setq c (bbdb-address-city addr))) + (setq s (bbdb-address-state addr)) + (if (and (> (length c) 0) (> (length s) 0)) (insert ", ")) + (insert s " ") + (insert (bbdb-address-zip-string addr) "\n<BR>") + (setq addrs (cdr addrs)))) + (cond (aka + (setq match t) + (insert (format " %14s: %s\n<BR>" "AKA" + (mapconcat (function identity) aka ", "))))) + (let ((notes (bbdb-record-raw-notes record))) + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + (while notes + (if (memq (car (car notes)) + '(mail-alias password bbdb mail-name face mark-char aka)) + nil + (setq match t) + (insert (format " %14s: " (car (car notes)))) + (let ((p (point))) + (insert (cdr (car notes))) + (save-excursion + (save-restriction + (narrow-to-region p (1- (point))) + (goto-char (1+ p)) + (while (search-forward "\n" nil t) + (forward-char -1) + (insert "<BR>") + (forward-char 1) + (insert (make-string 17 ?\ ))))) + (insert "\n"))) + (setq notes (cdr notes))))) + + (or match (delete-char -4)) + + (setq records (cdr records)) + ) + (insert "</DL><p>\n") + )) diff --git a/utils/bbdb-unlazy-lock.pl b/utils/bbdb-unlazy-lock.pl new file mode 100755 index 0000000..b9a02c6 --- /dev/null +++ b/utils/bbdb-unlazy-lock.pl @@ -0,0 +1,19 @@ +#!/usr/bin/perl +# +# Author: Christopher Kline <ckline@media.mit.edu> +# +# $Id: bbdb-unlazy-lock.pl,v 1.1 1997/10/06 00:56:14 simmonmt Exp $ +# +# $Log: bbdb-unlazy-lock.pl,v $ +# Revision 1.1 1997/10/06 00:56:14 simmonmt +# Initial revision +# +# +# Lazy-lock-mode has (had) a nasty habit of munging .bbdb files if you visited them +# with it on. This script removes the lazy-lock mung +# + +while( <STDIN> ) { + s/#\(("[^"]*")( \d+ \d+ (nil)*(\(lazy-lock t\))*)*\)/$1/gi; + print; +} |