From 4427996318fc27eb6fd03e85d122a4a0d3180ef6 Mon Sep 17 00:00:00 2001 From: David Bremner Date: Sat, 7 Sep 2019 15:44:20 -0300 Subject: remove source files --- .gitmodules | 3 - ChangeLog | 3479 ------------------ INSTALL | 166 - Makefile.in | 125 - README | 5 - aclocal.m4 | 173 - bits/README | 4 - bits/bbdb-adapt-ispell.el | 120 - bits/bbdb-anniv.el | 206 -- bits/bbdb-canonicalize-lt.el | 41 - bits/bbdb-edit.el | 139 - bits/bbdb-filters/COPYING.LIB | 481 --- bits/bbdb-filters/README | 64 - bits/bbdb-filters/bbdb-ccmail.el | 118 - bits/bbdb-filters/bbdb-eudora.el | 284 -- bits/bbdb-filters/bbdb-export.el | 140 - bits/bbdb-filters/bbdb-hp200lx.el | 348 -- bits/bbdb-filters/bbdb-passwd.el | 192 - bits/bbdb-filters/bbdb-ph.el | 253 -- bits/bbdb-filters/doc/formatted/bbdb-filters.info | 1101 ------ bits/bbdb-filters/doc/lgpl.tex | 552 --- bits/bbdb-filters/doc/main.texinfo | 492 --- bits/bbdb-filters/doc/makefile | 159 - bits/bbdb-filters/makefile | 67 - bits/bbdb-funcs.txt | 383 -- bits/bbdb-gnokii.el | 863 ----- bits/bbdb-ldif.el | 820 ----- bits/bbdb-mail-folders.el | 121 - bits/bbdb-mew.el | 247 -- bits/bbdb-obsolete.el | 66 - bits/bbdb-pgp.el | 211 -- bits/bbdb-signature.el | 187 - bits/bbdb-sort-mailrc.el | 321 -- bits/bbdb-to-outlook.el | 261 -- bits/bbdb-vcard-export.el | 238 -- bits/bbdb-vcard-import.el | 198 - bits/bbdbpalm.el | 500 --- bits/make.bat | 106 - bits/vcard.el | 702 ---- configure.ac | 190 - extern/bbdb-vcard | 1 - html/bbdb.css | 3 - html/faq.html | 336 -- html/images/bbi.gif | Bin 1324 -> 0 bytes html/images/headleft.gif | Bin 197 -> 0 bytes html/images/headright.gif | Bin 199 -> 0 bytes html/index.html | 275 -- html/patches/bbdb-print.patch | 27 - html/patches/multi-record.patch | 1493 -------- install-sh | 251 -- lisp/.gitignore | 2 - lisp/Makefile.in | 194 - lisp/bbdb-com.el | 3746 ------------------- lisp/bbdb-ftp.el | 201 -- lisp/bbdb-gnus.el | 833 ----- lisp/bbdb-gui.el | 530 --- lisp/bbdb-hooks.el | 713 ---- lisp/bbdb-merge.el | 264 -- lisp/bbdb-mhe.el | 225 -- lisp/bbdb-migrate.el | 413 --- lisp/bbdb-print.el | 672 ---- lisp/bbdb-reportmail.el | 107 - lisp/bbdb-rmail.el | 202 -- lisp/bbdb-sc.el | 209 -- lisp/bbdb-snarf.el | 599 --- lisp/bbdb-srv.el | 285 -- lisp/bbdb-vm.el | 426 --- lisp/bbdb-w3.el | 61 - lisp/bbdb-whois.el | 264 -- lisp/bbdb-xemacs.el | 114 - lisp/bbdb.el | 3873 -------------------- misc/bbdb-unmigrate-stuff.el | 53 - misc/bbdb_gnus-summary-get-author.fig | 151 - testing/.gitignore | 1 - testing/Makefile.in | 8 - testing/bbdb-test | 7 - testing/bbdb-test.el | 676 ---- testing/run-tests.el | 7 - tex/.gitignore | 1 - tex/Makefile.in | 40 - tex/bbdb-cols.tex | 234 -- tex/bbdb-print-brief.tex | 159 - tex/bbdb-print.tex | 171 - texinfo/.gitignore | 17 - texinfo/Makefile.in | 93 - texinfo/bbdb.texinfo | 3996 --------------------- texinfo/infohack.el | 55 - utils/.gitignore | 2 - utils/Makefile.in | 40 - utils/bbdb-213-310.el | 57 - utils/bbdb-415-510.el | 87 - utils/bbdb-areacode-split.pl | 62 - utils/bbdb-cid.pl | 516 --- utils/bbdb-srv.pl | 45 - utils/bbdb-to-netscape.el | 213 -- utils/bbdb-unlazy-lock.pl | 16 - 96 files changed, 37152 deletions(-) delete mode 100644 ChangeLog delete mode 100644 INSTALL delete mode 100644 Makefile.in delete mode 100644 README delete mode 100644 aclocal.m4 delete mode 100644 bits/README delete mode 100644 bits/bbdb-adapt-ispell.el delete mode 100644 bits/bbdb-anniv.el delete mode 100644 bits/bbdb-canonicalize-lt.el delete mode 100644 bits/bbdb-edit.el delete mode 100644 bits/bbdb-filters/COPYING.LIB delete mode 100644 bits/bbdb-filters/README delete mode 100644 bits/bbdb-filters/bbdb-ccmail.el delete mode 100644 bits/bbdb-filters/bbdb-eudora.el delete mode 100644 bits/bbdb-filters/bbdb-export.el delete mode 100644 bits/bbdb-filters/bbdb-hp200lx.el delete mode 100644 bits/bbdb-filters/bbdb-passwd.el delete mode 100644 bits/bbdb-filters/bbdb-ph.el delete mode 100644 bits/bbdb-filters/doc/formatted/bbdb-filters.info delete mode 100644 bits/bbdb-filters/doc/lgpl.tex delete mode 100644 bits/bbdb-filters/doc/main.texinfo delete mode 100644 bits/bbdb-filters/doc/makefile delete mode 100644 bits/bbdb-filters/makefile delete mode 100644 bits/bbdb-funcs.txt delete mode 100644 bits/bbdb-gnokii.el delete mode 100644 bits/bbdb-ldif.el delete mode 100644 bits/bbdb-mail-folders.el delete mode 100644 bits/bbdb-mew.el delete mode 100644 bits/bbdb-obsolete.el delete mode 100644 bits/bbdb-pgp.el delete mode 100644 bits/bbdb-signature.el delete mode 100644 bits/bbdb-sort-mailrc.el delete mode 100644 bits/bbdb-to-outlook.el delete mode 100644 bits/bbdb-vcard-export.el delete mode 100644 bits/bbdb-vcard-import.el delete mode 100644 bits/bbdbpalm.el delete mode 100644 bits/make.bat delete mode 100644 bits/vcard.el delete mode 100644 configure.ac delete mode 160000 extern/bbdb-vcard delete mode 100644 html/bbdb.css delete mode 100644 html/faq.html delete mode 100644 html/images/bbi.gif delete mode 100644 html/images/headleft.gif delete mode 100644 html/images/headright.gif delete mode 100644 html/index.html delete mode 100644 html/patches/bbdb-print.patch delete mode 100644 html/patches/multi-record.patch delete mode 100755 install-sh delete mode 100644 lisp/.gitignore delete mode 100644 lisp/Makefile.in delete mode 100644 lisp/bbdb-com.el delete mode 100644 lisp/bbdb-ftp.el delete mode 100644 lisp/bbdb-gnus.el delete mode 100644 lisp/bbdb-gui.el delete mode 100644 lisp/bbdb-hooks.el delete mode 100644 lisp/bbdb-merge.el delete mode 100644 lisp/bbdb-mhe.el delete mode 100644 lisp/bbdb-migrate.el delete mode 100644 lisp/bbdb-print.el delete mode 100644 lisp/bbdb-reportmail.el delete mode 100644 lisp/bbdb-rmail.el delete mode 100644 lisp/bbdb-sc.el delete mode 100644 lisp/bbdb-snarf.el delete mode 100644 lisp/bbdb-srv.el delete mode 100644 lisp/bbdb-vm.el delete mode 100644 lisp/bbdb-w3.el delete mode 100644 lisp/bbdb-whois.el delete mode 100644 lisp/bbdb-xemacs.el delete mode 100644 lisp/bbdb.el delete mode 100644 misc/bbdb-unmigrate-stuff.el delete mode 100644 misc/bbdb_gnus-summary-get-author.fig delete mode 100644 testing/.gitignore delete mode 100644 testing/Makefile.in delete mode 100644 testing/bbdb-test delete mode 100644 testing/bbdb-test.el delete mode 100644 testing/run-tests.el delete mode 100644 tex/.gitignore delete mode 100644 tex/Makefile.in delete mode 100644 tex/bbdb-cols.tex delete mode 100644 tex/bbdb-print-brief.tex delete mode 100644 tex/bbdb-print.tex delete mode 100644 texinfo/.gitignore delete mode 100644 texinfo/Makefile.in delete mode 100644 texinfo/bbdb.texinfo delete mode 100644 texinfo/infohack.el delete mode 100644 utils/.gitignore delete mode 100644 utils/Makefile.in delete mode 100644 utils/bbdb-213-310.el delete mode 100644 utils/bbdb-415-510.el delete mode 100755 utils/bbdb-areacode-split.pl delete mode 100755 utils/bbdb-cid.pl delete mode 100755 utils/bbdb-srv.pl delete mode 100644 utils/bbdb-to-netscape.el delete mode 100755 utils/bbdb-unlazy-lock.pl diff --git a/.gitmodules b/.gitmodules index 16fe08e..e69de29 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +0,0 @@ -[submodule "extern/bbdb-vcard"] - path = extern/bbdb-vcard - url = git://github.com/trebb/bbdb-vcard.git diff --git a/ChangeLog b/ChangeLog deleted file mode 100644 index 740f47c..0000000 --- a/ChangeLog +++ /dev/null @@ -1,3479 +0,0 @@ -2010-06-03 Barak A. Pearlmutter - - * texinfo/bbdb.texinfo: include pointers to github repo. - -2010-09-29 Julien Danjou - - * lisp/bbdb-gnus.el (bbdb/gnus-split-myaddr-regexp): Remove usage - of deprecated gnus-local-domain. - -2010-04-20 Barak A. Pearlmutter - - * 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 - - * texinfo/bbdb.texinfo: remove @ifinfo guard to eliminate - texi2html error. - -2009-11-18 Barak A. Pearlmutter - - * 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 - - * lisp/bbdb-gnus.el (bbdb/gnus-summary-get-author): Use the proper - nnheader interface for retrieving header values. - -2008-01-29 Didier Verna - - 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 - - * lisp/bbdb-com.el (bbdb-define-all-aliases): Rewrite docstring - and format it properly for describe-function. - -2008-01-29 Didier Verna - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * lisp/Makefile.in (bbdb-hooks.elc): Put lisp on a single line. - -2007-01-01 Waider - - * lisp/bbdb.el: - fixed version of primep (Patrick Campbell-Preston) - -2006-12-15 Robert Widhopf-Fenk - - * 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 - - * 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 - - * texinfo/bbdb.texinfo, lisp/bbdb-print.el, lisp/bbdb-migrate.el: - trivial cleanups - -2005-08-02 Waider - - * 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 - - * 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 - - * 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 - - * html/index.html: update links for PilotManager - -2005-03-19 Waider - - * lisp/bbdb.el: * coding system guessing for emacs 22 (Frederik Fouvry) - -2005-02-28 Waider - - * lisp/bbdb-gnus.el (bbdb/gnus-nnimap-folder-list-from-bbdb): - new function from Uwe Brauer - -2005-02-22 Waider - - * 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 - - * 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 - - * lisp/bbdb-com.el: * bury completion buffer when completion is done - -2004-10-13 Waider - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-rmail.el: Just define rmail-buffer if not defined and - require other packages only during compilation. - -2004-03-22 Waider - - * 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 - - * lisp/bbdb-snarf.el (bbdb-merge-interactively): - If the specified value of 'nets' isn't a list, make it so. - -2004-01-23 Waider - - * lisp/bbdb.el: - Handle surnames with prefixes (Adrian Lanz ) - -2003-10-10 Robert Widhopf - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * lisp/bbdb.el (bbdb-file-coding-system): Make it defconst, test - for utf-8-Emacs and doc fix. - -2003-04-01 Robert Fenk - - * 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 - - * 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 - - * lisp/bbdb-com.el: Call bbdb-complete-name-hooks after name completion - -2003-03-27 Robert Fenk - - * lisp/bbdb-com.el (bbdb-mail-abbrev-expand-hook): save-excursion - to avoid getting into the *BBDB* buffer accidently. - -2003-03-15 Robert Fenk - - * 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 - - * 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 - - * 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 - - * 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: * buffer and set it up correctly. - -2003-03-07 Robert Fenk - - * 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 - - * lisp/bbdb-com.el (bbdb-delete-current-record): fixed docs and - bbdb-apply-next-command-to-all-records handling. - -2003-01-31 Alex Schroeder - - * lisp/bbdb.el (bbdb-resort-database): Make interactive. - -2003-01-30 Robert Fenk - - * 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 - - * bbdb-com.el, bbdb.el: - Clean up stray uses of mapc (replace with bbdb-mapc) - -2003-01-02 Waider - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * lisp/bbdb.el (bbdb-quiet-about-name-mismatches): Fix typo. - -2002-07-03 Waider - - * 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 - - * 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 - - * configure.ac: - Don't configure the testing directory if it doesn't exist. - -2002-06-28 Robert Fenk - - * lisp/bbdb-com.el (bbdb-rebuilt-all-aliases): applied a fix from - Andre Srinivasan - -2002-04-30 Robert Fenk - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-com.el (bbdb-redisplay-one-record): remove bbdb-field - text-properties before redisplaying. - -2002-01-30 Robert Fenk - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 & 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 - - * 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 - - * lisp/bbdb-hooks.el: - Conditionalise the rmail load - - * lisp/bbdb-gui.el: - Make X/Emacs compatibility less intrusive - -2002-01-13 Waider - - * lisp/bbdb-hooks.el: - Don't force VM on people, even if it is a great mailer... - -2002-01-10 Waider - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-com.el (bbdb-complete-name): - Two fixes based on further testing with completion-type. - -2001-12-27 Waider - - * 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 - - * lisp/bbdb-com.el (bbdb-phone-area-regexp): - Allow / and . as separators when parsing a phone number. - -2001-12-26 Waider - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * texinfo/bbdb.texinfo (Mail Sending Interfaces): - Mention message-setup-hook in the mail aliases section - (Raymond Scholz) - -2001-10-14 Waider - - * 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 - - * 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 - - * lisp/bbdb-snarf.el (bbdb-rfc822-addresses): - Cope with rfc822-addresses returning nil as the car. - -2001-09-11 Robert Fenk - - * 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 - - * 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-. 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 - - * 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 - - * 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 - -2001-08-31 Robert Fenk - - * 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 - - * lisp/bbdb.el (bbdb-initialize): Autoload it. - -2001-08-13 Jeff Mincy - - * fix bbdb-hack-x-face call to make-glyph - -2001-08-01 Robert Fenk - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-gui.el: - Whoops. eval-and-compile, not eval-when-compile. - -2001-06-28 Waider - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - * Makefile.in: Fixed tarball build to work with new autoconf stuff - -2001-06-05 Didier Verna - - * 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" - - * 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 - - * 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 - - * aclocal.m4 (BBDB_PROG_EMACS): fix Emacs detection problem when - configuring from an Emacs shell buffer. - -2001-05-21 Robert Fenk - - * 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 - - * lisp/bbdb.el (bbdb-invoke-hook-for-value): Fix: Return symbols - BUT CALL FUNCTIONS! - -2001-05-17 Robert Fenk - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-gnus.el: - Fix list-vs-not bug in bbdb/gnus-edit-notes - -2001-03-29 Robert Fenk - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-rmail.el: - Fix some bugs related to new message caching functions. - -2001-03-23 Waider - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-com.el (bbdb-prompt-for-create): fix a bug with GNU - Emacs. - -2001-03-19 Robert Fenk - - * lisp/bbdb-com.el (bbdb-update-records): honors now - bbdb-gag-messages; fixed the overall number in the progress - message. - -2001-03-18 Waider - - * 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 - - * 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 - - * 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 - - * lisp/bbdb.el: - bbdb-search-simple: check that the name actually matches (not company) - -2001-03-01 Robert Fenk - - * 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 - - * html/bbdb-2.20.tar.gz: - Shouldn't have been in here in the first place. Sorry 'bout that. - - -2001-02-25 ShengHuo ZHU - - * 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 - * 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 - *lisp/bbdb.el - New user option for GUI features - -2001-02-19 ShengHuo ZHU - - * lisp/Makefile.in (bbdb-autoloads.el): - Insert (provide 'bbdb-autoloads) when generated by FSF Emacs. - -2001-02-19 Waider - - * 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 - - * lisp/bbdb-vm.el (bbdb/vm-update-records): Fixed bug of calling - message with wrong argument. - -2001-02-14 Waider - - * 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 - - * 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 - - * lisp/bbdb-snarf.el (replace-in-string): Fix the argument order - of replace-regexp-in-string. - -2001-02-10 Waider - - * 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 - - * lisp/bbdb.el: doc fix - - * lisp/bbdb-com.el: doc fixes - -2001-02-08 Robert Fenk - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - * 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 - - * 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 - - * lisp/bbdb.el: - Check that an AKA is not already in the list before adding it - -2001-01-18 Waider - - * 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 - - * lisp/bbdb-hooks.el: - Added Bill Carpenter-provided function - 'bbdb-ignore-selected-messages-confirmation' - -2001-01-03 Didier Verna - - * 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 - * 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 - - * lisp/bbdb.el (bbdb-undisplay-records): - Don't mess with *BBDB* if it doesn't exist! - Some compile noise hushed. - -2000-12-18 Waider - - * 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 - - * 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 - - * lisp/bbdb-vm.el: Respect value of bbdb-use-pop-up. - * html/index.html: Corrected mirror link. - -2000-11-02 Waider - - * lisp/bbdb.el: - Define characterp if it's not already bound. Used in bbdb-vm. - -2000-11-02 Sam Steingold - - * lisp/bbdb.el (bbdb-hashtable-size): call `bbdb-records' only - when it is defined (reported by John Wiegley ). - -2000-11-01 Sam Steingold - - * 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 - - * 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 - - * lisp/bbdb-com.el (bbdb-send-mail-internal): - Added in compose-mail bits. Whoops. - -2000-09-20 Waider - - * 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 - - * 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 - - * lisp/bbdb.el (bbdbq-mk): - new function to create `subliminal' messages. Also, two new - messages. - -2000-09-08 Waider - - * lisp/bbdb.el: - Daniel Pittman's patch does indeed override Alex's! - -2000-09-07 Waider - - * 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 - - * lisp/bbdb-com.el: - Default completed name to an empty string to avoid error - -2000-08-29 Waider - - * lisp/bbdb-vm.el: - Check if vm-summary-uninteresting-senders is a string before using it - -2000-08-28 Waider - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - which sets `vm-auto-folder-alist' according to - the field `bbdb/vm-set-auto-folder-alist-field'. - -2000-08-10 Sam Steingold - - * lisp/bbdb.el (bbdb-annotate-notes): `regexp-quote' the - annotation before matching it on existing notes - -2000-08-03 Sam Steingold - - * 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 - - * 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 - - * 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 - - * lisp/bbdb.el (bbdb-init-forms): hook adding only - (bbdb-initialize): ditto - (bbdb-add-hook): dropped - -2000-07-25 Sam Steingold - - * 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 - - * lisp/bbdb.el: More bbdb-silent-running edits. - -2000-07-20 Sam Steingold - - * 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 - - * lisp/bbdb-com.el (bbdb-define-all-aliases): distinguish between - `mail-abbrevs' and `mail-aliases' in a uniform way - -2000-07-13 Sam Steingold - - * lisp/bbdb.el (bbdb-write-file-hooks): new variable - (bbdb-records): use it - -2000-07-11 16:19:29 ShengHuo ZHU - - * 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 - - * 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 - - * lisp/bbdb.el (parse-bbdb-internal): bind, not setq the version. - -2000-07-03 Jochen Küpper - - * 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 - - * 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 - - * lisp/Makefile: Add everything to build bbdb-merge.elc. - -2000-06-14 Waider - - * 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 - - * lisp/bbdb-com.el (bbdb-parse-zip-string): Match brazilian zip - codes as well. - -2000-05-25 Alex Schroeder - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-migrate.el: - omitted bracket on unmigrate for v5->v4 - -2000-04-16 kuepper - - * tex/bbdb-print-brief.tex, texinfo/bbdb.texinfo, tex/bbdb-print.tex - bbdb-print documentation - Fix \bigbf - -2000-04-16 Jochen Küpper - - * tex/bbdb-print.tex, tex/bbdb-print-brief.tex: Define \bigbf - relative to the given base-size. - -2000-04-15 Jochen Küpper - - * 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 - - * 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 - - * 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 - - * lisp/bbdb-gnus.el: - Colin's show-all-recipients - -2000-04-02 Waider - - * 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 - - * 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 . - - * 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 - - * 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 - - * 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 - - * 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 - - * lisp/bbdb.el: BBDB 2.00.06 released - -1999-01-24 Colin Rafferty - - * 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 - - * lisp/bbdb-com.el (bbdb-info): Made it work with Info-directory-list - -1999-01-21 Sam Steingold - - * 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 - - * lisp/bbdb-comp.el (bbdb-redisplay-records): Don't bug out - with mark. - -1999-01-08 Colin Rafferty - - * 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 . - -1999-01-08 Sam Steingold - - * lisp/bbdb.el (bbdb-save-db-timeout): Correct comment. - -1998-12-31 Matt Simmons - - * lisp/bbdb-snarf.el (bbdb-snarf-region): Autoload - -1998-12-31 Colin Rafferty - - * lisp/bbdb-gnus.el (bbdb/gnus-snarf-signature): Created - -1998-12-31 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00.05 released - -1998-12-31 Matt Simmons - - * INSTALL: Added documentation for those without make - * lisp/bbdb-snarf.el: Merge in 1.8.1.x subtree - -1998-12-30 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00.04 released - -1998-12-29 Colin Rafferty - - * lisp/bbdb-com.el (bbdb-current-field): Made it handle the - blank user. - -1998-12-24 Colin Rafferty - - * lisp/bbdb.el (bbdb-version): Made it take an option to output in - current buffer. - -1998-12-10 Colin Rafferty - - * 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 - - * 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 - - * lisp/bbdb.el: BBDB 2.00.03 released - -1998-12-03 Adam C. Finnefrock - - * lisp/bbdb-gnus.el (bbdb/gnus-update-record): Honor - bbdb-user-mail-names. - -1998-11-17 Colin Rafferty - - * 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 - - * 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 - - * 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 - - * 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 - - * bbdb-snarf.el (bbdb-snarf-web-prop): Made it a symbol. - -1998-10-13 Colin Rafferty - - * 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 - - * lisp/bbdb-com.el (bbdb-info-file): Made it a choice, since nil didn't - match the type: file. - -1998-10-08 Colin Rafferty - - * lisp/bbdb.el (bbdb-version): BBDB 2.00.02 released - -1998-07-19 SL Baur - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * Makefile: Fix for compatibility with other makes - -Sun Mar 15 23:46:00 1998 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00 released - -Fri Mar 13 01:52:00 1998 Matt Simmons - - * lisp/bbdb.el: BBDB 1.91unoff released - -Wed Mar 12 15:37:86 1998 Colin Rafferty - - * lisp/bbdb.el (parse-bbdb-internal): Fixed the error message on - mismatched bbdb-file-format. - -Fri Feb 06 00:00:00 1998 Colin Rafferty - - * 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 - - * 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 - - * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): don't access - scrollbars on XEmacsen without scrollbars - -Mon Mar 02 00:00:00 1998 Colin Rafferty - - * 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 - - * 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 - - * lisp/Makefile (extras): fixed typo in bbdb-migrate.elc - -Sun Feb 22 20:58:00 1998 Matt Simmons - - * 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 - - * texinfo/bbdb.texinfo: Documentation for BBDB-Reportmail - -Thu Feb 19 13:41:17 1998 Sam Steingold - - * lisp/bbdb.el (bbdb-version): Return a string if non-interactive - -Mon Jan 5 20:40:03 1998 Matt Simmons - - * 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 - - * 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 - - * lisp/bbdb.el: BBDB 1.57unoff released - -Sun Nov 30 22:47:04 1997 Sam Steingold - - * 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 - - * 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 - - * lisp/bbdb.el: Custom blob to make defcustom and defgroup - transparent in non-customized Emacsen - -Sun Nov 30 12:03:41 1997 Soren Dayton - - * lisp/bbdb-print.el (bbdb-print-tex-quote): Escape tildes properly - -Tue Nov 10 20:10:53 1997 Jens-Ulrik Holger Petersen - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 -Sat Oct 25 23:47:40 1997 Matt Simmons - - * 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 -Sat Oct 25 17:54:26 1997 Matt Simmons - - * 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 - - * Makefile (install-pkg): Made it install the el before the .elc. - -Mon Oct 20 12:15:15 1997 Christoph Wedler - - * 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 - - * Makefile (install-pkg): Fix info linking - use texinfo, not info - -Mon Oct 13 16:41:27 1997 Soren Dayton - - * 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 - - * 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 - - * 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 - - * 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 - - * 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 - * lisp/Makefile: Check for itimer before building bbdb-srv. - Complain nicely when check fails. - -Sun Oct 5 20:16:00 1997 Matt Simmons - * bbdb.el: BBDB 1.53unoff released - -Sun Oct 5 19:53:12 1997 Boris Goldowsky - * 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 - * 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 - * utils/bbdb-areacode-split.pl: New utility - -Sun Oct 5 19:51:19 1997 Matt Simmons - - * 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 - - * 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 - - * 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 - - * auto-autoloads.el, Makefile: Use BBDB as an XEmacs package - -Sun Sep 28 00:03:31 1997 Jens-Ulrik Hoger Petersen - - * 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 - - * bbdb-reportmail.el: Created - -Sat Sep 27 23:47:01 1997 Soren Dayton - - * 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 - - * bbdb.el (bbdb-annotate-message-sender): Use address for name if no name - -Sat Sep 27 23:39:09 1997 Christoph Wedler - - * 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 - - * bbdb-com.el (bbdb-phone-area-regexp): Fix US area code pattern diff --git a/INSTALL b/INSTALL deleted file mode 100644 index 9cba073..0000000 --- a/INSTALL +++ /dev/null @@ -1,166 +0,0 @@ -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 deleted file mode 100644 index 920aa4c..0000000 --- a/Makefile.in +++ /dev/null @@ -1,125 +0,0 @@ -# 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 diff --git a/README b/README deleted file mode 100644 index 293205e..0000000 --- a/README +++ /dev/null @@ -1,5 +0,0 @@ -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 deleted file mode 100644 index c403f9d..0000000 --- a/aclocal.m4 +++ /dev/null @@ -1,173 +0,0 @@ -dnl aclocal.m4 --- More autoconf macros for BBDB - -dnl Author: Didier Verna -dnl Maintainer: Didier Verna -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 deleted file mode 100644 index cc941db..0000000 --- a/bits/README +++ /dev/null @@ -1,4 +0,0 @@ -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-adapt-ispell.el b/bits/bbdb-adapt-ispell.el deleted file mode 100644 index e374537..0000000 --- a/bits/bbdb-adapt-ispell.el +++ /dev/null @@ -1,120 +0,0 @@ -;;; bbdbadapt-ispell.el --- Use the BBDB to insert a gcc field - -;; Copyright (C) 2009 Uwe Brauer - -;; Author: Uwe Brauer oub@mat.ucm.es -;; Maintainer: Uwe Brauer oub@mat.ucm.es -;; Created: 17 Mar 2009 -;; Version: 1.0 -;; Keywords: - - -;; 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. - -;; A copy of the GNU General Public License can be obtained from this -;; program's author (send electronic mail to oub@mat.ucm.es) or from -;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -;; 02139, USA. - -;; LCD Archive Entry: -;; bbdbadpt-gcc|Uwe Brauer|oub@mat.ucm.es -;; |Use the BBDB to insert a gcc field -;; |Date|Revision|~/packages/bbdbadpt-gcc.el - -;;; Commentary: -;; I wanted to have the ispell dict selected -;; based on a relevant bbdb entry which I call ispell-dict. -;; This is what the code does. - -;; The starting point was some code provided to me by Robert -;; Fenk. However the problem with that code was that it took the gcc -;; field from some entry of the BBDB buffer and if there was more than -;; on entry often the wrong string was inserted. So I had to use code -;; which extracted the correct BBDB entry from the TO field . I -;; succeeded by using to a large extend code from sigadapt.el written -;; by by C.Queinnec (University of Paris 6 & INRIA) -;; - -;;; Change log: -;; Revision 1.1 2009/03/17 17:27:31 oub -;; Initial revision -;; -;; Revision 1.2 2009/03/17 16:50:20 oub -;; modify the central function -;; -;; Revision 1.1 2009/03/17 16:32:26 oub -;; Initial revision -;; - -;;; Code: - - - - -(defun bbdbispelladpt-search-record (to) - "Search a BBDB record associated to TO or return NIL." - (let* ((data (mail-extract-address-components to)) - (name (car data)) - (net (car (cdr data)))) - (if (equal name net) (setq name nil)) - (if (and net bbdb-canonicalize-net-hook) - (setq net (bbdb-canonicalize-address net))) - (bbdb-search-simple name net))) - -(defun bbdbispelladpt-try-bbdbispell-new () - "Try to adapt non-interactively the current bbdbispell. -This function looks silently in the current message to find how to -choose the bbdbispell. It does nothinng if not enough information is -present. This function is useful in a hook." - (save-excursion - (condition-case nil - (progn - (goto-char (point-min)) - (let ((record (bbdbispelladpt-search-record - (bbdb-extract-field-value "To")))) - (if record - (let ((signame (bbdbispelladpt-retrieve-bbdbispell record))) - (when (and (stringp signame) (string= signame "castellano8")) - (ispell-change-dictionary "castellano8" nil)) - (when (and (stringp signame) (string= signame "english")) - (ispell-change-dictionary "american" nil )) - (when (and (stringp signame) (string= signame "deutsch")) - (ispell-change-dictionary "deutsch8" nil)) - (when (and (stringp signame) (string= signame "french")) - (ispell-change-dictionary "francais" nil))))))))) - - - - -(defun bbdbispelladpt-retrieve-bbdbispell (&optional record) - "Retrieve the bbdbispell (a symbol) associated to a mailee. -The search is done through a BBDB record. " - (if (not record) - (save-excursion - (goto-char (point-min)) - (let* ((to (bbdb-extract-field-value "To")) - (rec (bbdbispelladpt-search-record to)) ) - (if rec (bbdbispelladpt-do-retrieve-bbdbispell rec) - (progn (message "No bound record") - nil)))) - (bbdbispelladpt-do-retrieve-bbdbispell record) ) ) - -(defun bbdbispelladpt-do-retrieve-bbdbispell (record) - (let ((signame - (bbdb-record-getprop record 'ispell-dict))) - (if (stringp signame) - (setq signame signame)) - signame)) - - -(provide 'bbdbadapt-ispell) - -;;; BBDBADPT-ISPELL.EL ends here diff --git a/bits/bbdb-anniv.el b/bits/bbdb-anniv.el deleted file mode 100644 index 9e6205d..0000000 --- a/bits/bbdb-anniv.el +++ /dev/null @@ -1,206 +0,0 @@ -;;; bbdb-anniv.el --- Get anniversaries from BBDB - -;; Copyright (C) 1998 Ivar Rummelhoff - -;; Author: Ivar Rummelhoff -;; Maintainer: Ivar Rummelhoff -;; 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 deleted file mode 100644 index bb3d9c0..0000000 --- a/bits/bbdb-canonicalize-lt.el +++ /dev/null @@ -1,41 +0,0 @@ -;;; As per email to bbdb-info list from Len Trigg -;;; 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 - ((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 deleted file mode 100644 index b22f308..0000000 --- a/bits/bbdb-edit.el +++ /dev/null @@ -1,139 +0,0 @@ -;;; bbdb-edit.el --- BBDB field edit -;; Copyright (C) 1999, 2000, 2001 Shenghuo ZHU - -;; Author: Shenghuo ZHU -;; 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 deleted file mode 100644 index eb685a5..0000000 --- a/bits/bbdb-filters/COPYING.LIB +++ /dev/null @@ -1,481 +0,0 @@ - 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. - - - Copyright (C) - - 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. - - , 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 deleted file mode 100644 index a88c2fc..0000000 --- a/bits/bbdb-filters/README +++ /dev/null @@ -1,64 +0,0 @@ - -BBDB is a rolodex-like database program for GNU Emacs. -BBDB stands for Insidious Big Brother Database. BBDB is written by: -Jamie Zawinski . 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 . - -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 -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 deleted file mode 100644 index d8ce4d9..0000000 --- a/bits/bbdb-filters/bbdb-ccmail.el +++ /dev/null @@ -1,118 +0,0 @@ -;;; 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: "" - (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 deleted file mode 100644 index 2c2f848..0000000 --- a/bits/bbdb-filters/bbdb-eudora.el +++ /dev/null @@ -1,284 +0,0 @@ -;;; 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: "" - (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 deleted file mode 100644 index 279238a..0000000 --- a/bits/bbdb-filters/bbdb-export.el +++ /dev/null @@ -1,140 +0,0 @@ -;;; 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 deleted file mode 100644 index fe3f00a..0000000 --- a/bits/bbdb-filters/bbdb-hp200lx.el +++ /dev/null @@ -1,348 +0,0 @@ -;;; 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 deleted file mode 100644 index 74dc8fd..0000000 --- a/bits/bbdb-filters/bbdb-passwd.el +++ /dev/null @@ -1,192 +0,0 @@ -;;; 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 deleted file mode 100644 index fc21502..0000000 --- a/bits/bbdb-filters/bbdb-ph.el +++ /dev/null @@ -1,253 +0,0 @@ -;;; 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 deleted file mode 100644 index c66edef..0000000 --- a/bits/bbdb-filters/doc/formatted/bbdb-filters.info +++ /dev/null @@ -1,1101 +0,0 @@ -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--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--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 `'. - - * 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 `' wrote most of this package. Mohsen -Banan `' 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 -`'. - - - -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 deleted file mode 100644 index 7427570..0000000 --- a/bits/bbdb-filters/doc/lgpl.tex +++ /dev/null @@ -1,552 +0,0 @@ -\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 deleted file mode 100644 index 7edb948..0000000 --- a/bits/bbdb-filters/doc/main.texinfo +++ /dev/null @@ -1,492 +0,0 @@ -% 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--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--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{}. - -\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{} wrote most of this package. Mohsen -Banan \code{} 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{}. - -\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 deleted file mode 100644 index 3feac99..0000000 --- a/bits/bbdb-filters/doc/makefile +++ /dev/null @@ -1,159 +0,0 @@ -# -# 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 deleted file mode 100644 index 9959f0e..0000000 --- a/bits/bbdb-filters/makefile +++ /dev/null @@ -1,67 +0,0 @@ -# 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 deleted file mode 100644 index 14a8180..0000000 --- a/bits/bbdb-funcs.txt +++ /dev/null @@ -1,383 +0,0 @@ -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 " - -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 -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 - / updated: 2000-03-10 / significant changes: -2000-02-11 ----------------------------------------------------------------------------- diff --git a/bits/bbdb-gnokii.el b/bits/bbdb-gnokii.el deleted file mode 100644 index 46f6911..0000000 --- a/bits/bbdb-gnokii.el +++ /dev/null @@ -1,863 +0,0 @@ -;; 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 , -;; Reiner Steib , -;; Len Trigg -;; Maintainer: Martin Schwenke -;; Created: 23 August 2000 -;; 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: - -;; 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 . -;; -;; 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 . -;; -;; 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 . -;; -;; 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 . - -;; Revision 1.8 2004/02/06 03:07:33 martins -;; Merged changes from Reiner Steib : 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 "\\") - (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 deleted file mode 100644 index fd54ac7..0000000 --- a/bits/bbdb-ldif.el +++ /dev/null @@ -1,820 +0,0 @@ -;;; Copyright (C) 1998,2000 by Niels Elgaard Larsen - -;;; 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, -;; 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.\\ -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 deleted file mode 100644 index 4173ca7..0000000 --- a/bits/bbdb-mail-folders.el +++ /dev/null @@ -1,121 +0,0 @@ -;;; From: Geoffroy Ville -;;; 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 - -; 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 deleted file mode 100644 index 190e72e..0000000 --- a/bits/bbdb-mew.el +++ /dev/null @@ -1,247 +0,0 @@ -;;; 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 -;; Shuhei KOBAYASHI -;; Daisuke Kanda -;; Mitsuo Nishizawa -;; Maintenance: Chris Beggy -;; Created: 1996/11/04 - -;; 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 deleted file mode 100644 index 1dac1c3..0000000 --- a/bits/bbdb-obsolete.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; bbdb-obsolete-net.el -- Handle obsolete-net addresses. - -;; Copyright (C) 2001 Colin Rafferty - -;; Author: Colin Rafferty -;; Keywords: bbdb, net, obsolete - -;; 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 deleted file mode 100644 index 3599138..0000000 --- a/bits/bbdb-pgp.el +++ /dev/null @@ -1,211 +0,0 @@ -;;; 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 -;; 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|Revision|~/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)) - -;;;###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 deleted file mode 100644 index e44e8e6..0000000 --- a/bits/bbdb-signature.el +++ /dev/null @@ -1,187 +0,0 @@ -;;; 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 ) -;;; or from the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, USA. - -;;; LCD Archive Entry: -;;; mail-signature|Kevin Davidson| -;;; |Add context sensitive signature -;;; |Date|Revision|~/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: -;; 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: - - -(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 deleted file mode 100644 index 1a1710d..0000000 --- a/bits/bbdb-sort-mailrc.el +++ /dev/null @@ -1,321 +0,0 @@ -;;; >>>>> 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, -;;; -;;; 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 deleted file mode 100644 index a8dd6bf..0000000 --- a/bits/bbdb-to-outlook.el +++ /dev/null @@ -1,261 +0,0 @@ -;;; This is bbdb-to-outlook.el, version 0.11 -;;; -;;; Author: Bin Mu -;;; -;;; Created: 30 Oct 1997 -;;; Version: 0.11 -;;; -;;; Updated: 26 May 2004 -;;; Frank J. Christophersen -;;; -;;; -;;; 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 deleted file mode 100644 index afb7191..0000000 --- a/bits/bbdb-vcard-export.el +++ /dev/null @@ -1,238 +0,0 @@ -;;; 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 -;; Created: 2002-08-08 -;; 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 -;; Value types documented in RFC 2425 - -;; 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 deleted file mode 100644 index adbdd5a..0000000 --- a/bits/bbdb-vcard-import.el +++ /dev/null @@ -1,198 +0,0 @@ -;;; 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 -;; Created: 2008-01-03 -;; 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 -;; - Do not enforce (type . "internet") for email addresses. -;; -;; 2008-01-03 Marcus Crestani -;; - 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 deleted file mode 100644 index 3852b0d..0000000 --- a/bits/bbdbpalm.el +++ /dev/null @@ -1,500 +0,0 @@ -;;; 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 -;; Version: 0.3 -;; X-URL: http://www.neilvandyke.org/bbdbpalm/ - -;; 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 -;; 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 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 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 -;; , 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 , -;; 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. SEMI SEMI - ;; "Unfiled";"Fax";"ALastName", - (list bbdbpalm-category show-field (bbdb-record-lastname record)) - ;; 2. - ;; "AFirstName", - (bbdb-record-firstname record) - ;; 3. - ;; "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 deleted file mode 100644 index 0e5248d..0000000 --- a/bits/make.bat +++ /dev/null @@ -1,106 +0,0 @@ -@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 deleted file mode 100644 index c7bfad3..0000000 --- a/bits/vcard.el +++ /dev/null @@ -1,702 +0,0 @@ -;;; 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 - -;; 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.ac b/configure.ac deleted file mode 100644 index 795fd0f..0000000 --- a/configure.ac +++ /dev/null @@ -1,190 +0,0 @@ -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.67]) - -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/extern/bbdb-vcard b/extern/bbdb-vcard deleted file mode 160000 index 9e11faf..0000000 --- a/extern/bbdb-vcard +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 9e11fafef1a94bc6395bd1eeacd00f94848ac560 diff --git a/html/bbdb.css b/html/bbdb.css deleted file mode 100644 index 98b81d3..0000000 --- a/html/bbdb.css +++ /dev/null @@ -1,3 +0,0 @@ -body { - background-color: #faebd7; -} diff --git a/html/faq.html b/html/faq.html deleted file mode 100644 index 32c1261..0000000 --- a/html/faq.html +++ /dev/null @@ -1,336 +0,0 @@ -<html> - <head> - <title>BBDB FAQ - - - - -

The BBDB FAQ

- - 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. - -

This is the BBDB FAQ.

- -
-
About BBDB and this document
-
-
-
What is the BBDB?
-
Updated: 21 July 2000
-
- 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.
-
- The full name of BBDB is "The Insidious Big Brother - Database".

- [1] In this FAQ, "Emacs" refers to both GNU Emacs and - XEmacs.

- -
What is the most current version of the BBDB?
-
Updated: 20 April 2010
-
- The current version is 2.36. Generally speaking, the - development version is the preferred version.

- -
Where can I get the most current version of the BBDB?
-
Updated: 21 July 2000
-
- BBDB is hosted, developed and maintained at http://bbdb.sourceforge.net/. - The current stable and development releases are posted - there.

-
Updated: 20 April 2010
-
- But you might want to check out - http://github.com/barak/BBDB - or git clone git://github.com/barak/BBDB.git -.

- -
About the FAQ
-
Updated: 25 February 2001
-
- 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 bbdb-faq@waider.ie.
-
- The FAQ answers assume you have some familiarity with - Emacs. Where configuration variables are mentioned, - there's usually a customize interface that allows - you to do point-and-click option setting.

-
-
- -
Installing the BBDB
-
-
-
How do I install BBDB?
-
Updated: 25 February 2001
-
- Read the file INSTALL in the distribution

- - - -
-
- -
Configuring the BBDB
-
-
-
BBDB sometimes displays the user's full name along with - some names, and not with others.
-
Updated: 25 February 2001
-
- Set bbdb-dwim-net-address-allow-redundancy to - t. This tells BBDB it's okay to add full names to - addresses of the form - <Firstname.Lastname@wherever>

- -
Is there a way to insert literal strings in the phone - number field?
-
Updated: July 28 2001
-
- Set bbdb-north-american-phone-numbers-p to - nil. This tells BBDB to not try parsing numbers, but to - simply accept whatever the user types in.

- -
How to I get BBDB to not keep changing the name field - for a record?
-
Updated: August 20 2005
- Probably the easiest way to do this is to use - bbdb-ignore-some-messages-alist; see the - documentation on this for more details. You'll also need - to set bbdb/{mail,news}-auto-create-p to - bbdb-ignore-some-messages-hook, or invoke the - latter from whatever your auto-create-p - variables currently point at.
- - -
How do I make BBDB do something not covered in the FAQ??
-
Updated: 20 August 2005
-
- Read The Fine Manual, and then if you're still unsure ask - on the bbdb-info list.

-
-
- -
Using BBDB
-
-
-
How do I get BBDB to fill out an email address for - me?
-
Updated: 28 June 2001
-
- Type as much of the address as you feel necessary, then - hit M-TAB to get BBDB to attempt to complete what - you've typed. If it finds several matches, you can loop - through them by repeatedly pressing M-TAB; you can - also select from a completion-buffer of - choices.

- -
I have 42 records for Douglas Adams. How do I delete the - duplicates?
-
Updated: 20 August 2005
-
- M-x bbdb-show-duplicates, and delete or merge the - ones you don't want.

- -
Every time I modifiy bbdb mail-alias fields, I need to - quit and restart before Gnus sees the changes!
-
Updated: 28 June 2001
-
- (Thanks to John Hunter)
- (add-hook 'message-setup-hook 'bbdb-define-all-aliases) -

-
-
- -
Troubleshooting
-
-
-
How do I submit a bug report?
-
Updated: 20 August 2005
- Use bbdb-submit-bug-report. 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:
    -
  • Check the mailing list archives to see if your bug - has previously been discussed.
    • -
  • Make sure you've tried out the latest CVS version, - in case your bug has already been solved.
    • -
  • Be as precise as you can. Do not 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.
    • -
  • If you can, try and provide a minimal .bbdb - 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 - .bbdb file that demonstrates the problem, I've - been unable to reproduce it.
    • -
-
- - -
XEmacs is giving me an error about BBDB being already - loaded.
-
Updated: 25 February 2001 (David S. Goldman)
-
- Add the following before you call (bbdb-initialize): - 
-  (unload-feature 'bbdb-autoloads t)
-
- This is fixed in the developer release, and should be - available in the next stable release.

- -
I downloaded the developer release from CVS and I can't - build it.
-
Updated: 25 February 2001
-
- The developer version from CVS does not include the - configure script; this should be generated using - autoconf. The configure script is included - in the nightly tarball, so you can get it there if you - wish. Alternatively, it may be downloaded from the BBDB Web Site.
-
- 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 - make.bat file. The latter will probably migrate to - the BBDB bits section of CVS once the author has nailed it - down to his satisfaction.

- -
-
- -
Talking to the world outside Emacs
-
-
-
BBDB with Gnus is asking me if I want to update - <non-ASCII-name> to <non-ASCII-name<
-
Updated: 20 August 2005
-
- This should be (mostly) solved in CVS. If you encounter - this, please submit a bug report. -

- - -
How do I get BBDB and supercite to play together?
-
Updated: 28 June 2001
-
- (Thanks to Kevin Davidson, quoted here) - 
- 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"))
-             )))
-


- You might also need the following, from Sergei Pokrovsky: -
- '(sc-citation-nonnested-root-regexp "\\([-._]\\|\\w\\)+")
- '(sc-citation-root-regexp "\\([-._]\\|\\w\\)*")
-
-

- -
How do I get my Pilot/Addressbook/Phone/Widget to sync - with BBDB?
-
Updated: 28 June 2001
-
- Run screaming, waving hands in air.

- Still here? Okay. This is a problem complicated by some - basic differences in the respective tools' approach to - addressbooks, neatly - summarised in a message from Jamie - Zawinski. The solutions to date are at least three - different bbdb-pilot.el files, SyncBBDB - and SyncAB + - BBDB. The latter two are quite good, although - personally I don't use anything to keep my bits in sync at - present.
-
-
- -
Miscellany
-
-
-
Credits
-
Updated: 25 February 2001
-
- The BBDB was originally created by Jamie Zawinski. The - cast of characters involved since then is listed in the - BBDB documentation. The current maintainer is Waider, assisted by - whoever's got write access on the SourceForge - tree and a supporting cast on the bbdb-info mailing - list.

-
-
-
- - - -
-
bbdb-faq@waider.ie
- - diff --git a/html/images/bbi.gif b/html/images/bbi.gif deleted file mode 100644 index afc503e..0000000 Binary files a/html/images/bbi.gif and /dev/null differ diff --git a/html/images/headleft.gif b/html/images/headleft.gif deleted file mode 100644 index bd44bf4..0000000 Binary files a/html/images/headleft.gif and /dev/null differ diff --git a/html/images/headright.gif b/html/images/headright.gif deleted file mode 100644 index ee42108..0000000 Binary files a/html/images/headright.gif and /dev/null differ diff --git a/html/index.html b/html/index.html deleted file mode 100644 index 2ba4498..0000000 --- a/html/index.html +++ /dev/null @@ -1,275 +0,0 @@ - - - -The Insidious Big Brother DataBase @ SourceForge - - - - - -

head -The Insidious Big Brother Database -head

- -

Quicklinks: - get the bbdb -| mailing lists -| links -| manual -| FAQ -| project home -| freshmeat entry -

- -

What is The Insidious Big Brother Database?

- -

The Insidious Big Brother Database (BBDB) is a contact management -utility created by Jamie Zawinski for -use with Emacs. For many years it was -maintained by Waider. Since February 2007 -BBDB is maintained by Robert Widhopf-Fenk.

- -

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.

- -

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.

- -

Requirements:

- -

Supported versions of Emacs

- -Starting with 2.35 there is no active support for Emacsens < 21.4! -
-
Gnu - Emacs -
versions 21.4 and above
-
XEmacs -
versions 21.4 and above
-
- -

Supported Mail and News readers

- -

The BBDB can be used without a mail- or news-reader. It has, -however, been optimized for use with one.

- - -

Getting the BBDB

- -

BBDB 2.35 is the current -stable released version, released on January 30, 2007.

- -

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. -

- -

Compilation notes:

- -
    -
  1. 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 prebuilt configure script. Please note that - the Makefiles in the tarball are built using the defaults, - i.e. Emacs to compile with and no extra directories - specified.
    2. - -
  2. Texinfo 3.11 (or later) is required to compile the texinfo - documentation. It is available at the GNU FTP - site. Precompiled info files are included in the - tarball. Some work has been done by ShengHuo ZHU to make this - unnecessary.
    3. - -
  3. Building on platforms without make or running BBDB - uncompiled can be assisted by downloading a prebuilt bbdb-autoloads.el. A - make.bat for Windows platforms is in the works; see the - mailing list archives for more details. -
- -

CVS tree

- -

The development and release versions are available via Anon-CVS -to the CVS tree at bbdb.cvs.sourceforge.net. To access the -tree, log in with the following command: - -

-cvs -d :pserver:anonymous@bbdb.cvs.sourceforge.net:/cvsroot/bbdb login
-
- -The password is blank; just hit return at the prompt.

- -To check out a version of the BBDB, use one of the following commands: - -
-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
-
- -

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.

- -

The second command allows control of the version retrieved, through -the -r rev argument. The rev portion of the -argument should be replaced with a word of the form:

- -
BBDB_x_yy
- -

x and yy are components of the version to be -retrieved, as in x.yy. -Note: unoff should be appended to the -above word for all versions prior to 2.00.

- -To retrieve version 1.90, use the following argument:
- -
--r BBDB_1_90unoff
-
- -To retrieve version 2.34, use the following argument:
- -
--r BBDB_2_34
-
- -

Manual

- -

You may browse HTML version of the texinfo -manual that accompanies BBDB, which is generated by texi2html.

- -

Mailing Lists

- -

There are two mailing lists for the BBDB:

- -
-
bbdb-info
-
General discussion about the BBDB, both for users and developers. - The archive for mails up to end of April 2000 can be found at - http://www.mail-archive.com/bbdb-info%40xemacs.org/. Since April 2000 mails are archived at - http://www.mail-archive.com/bbdb-info%40lists.sourceforge.net/. - -

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 project home on - SourceForge.

- -
bbdb-announce
-
Announcements of new BBDB versions. This list is moderated, and - has very low volume.
-
- -To subscribe to either mailing list, send mail to -listname-request@lists.sourceforge.net with -subscribe 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 project page. - -

Links

- -

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!

- -
    -
  • Alex Schroeder - has done some work on address - formats and pine/mailrc integration. He's also responsible for - making BBDB handle non-US addresses a lot better.
    • - -
  • Jochen - Küpper has done some work on - bbdb-print, which is now in CVS.
    • - -
  • Thomas DeWeese wrote a PilotManager plugin - called SyncBBDB, and also implemented the - multiple-same-name-records support. SyncBBDB is now - maintained by Aaron Kaplan.
    • - -
  • Noah Friedman is - currently maintaining jwz's bbdb-pilot.el.
    • - -
  • Martin - Schwenke has written some code to export BBDB records to a Nokia - phone via gnokii. You can find - it at Martin's web - site.
    • - -
  • Broken: Aldo Valente has - done some work on making SyncAB (from PilotManager) work with - BBDB.
    • - -
  • Broken:Chris - Beggy 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.
    • - -
  • Broken:Nix has some - expiry code for BBDB which allows you to automatically discard old - BBDB records.
    • - -
  • lbdb2bdb - is some code by Steffen Liebergeld to migrate lbdb data to bbdb.
    • - -
  • bbdb2tbird - is some code by Neil Van Dyke to migrate BBDB data to the Thunderbird - address book.
    • - -
  • The bits 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.
    • - -
- -
-
Robert Widhopf-Fenk (based on -Waiders and Matt Simmons' BBDB page)
- - -

Hosted by
sourceforge.net

- - diff --git a/html/patches/bbdb-print.patch b/html/patches/bbdb-print.patch deleted file mode 100644 index 8bcf89f..0000000 --- a/html/patches/bbdb-print.patch +++ /dev/null @@ -1,27 +0,0 @@ ---- 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 deleted file mode 100644 index e664ea2..0000000 --- a/html/patches/multi-record.patch +++ /dev/null @@ -1,1493 +0,0 @@ -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 deleted file mode 100755 index e9de238..0000000 --- a/install-sh +++ /dev/null @@ -1,251 +0,0 @@ -#!/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 deleted file mode 100644 index 2aee78a..0000000 --- a/lisp/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -/Makefile -/bbdb-autoloads.el diff --git a/lisp/Makefile.in b/lisp/Makefile.in deleted file mode 100644 index 80d620b..0000000 --- a/lisp/Makefile.in +++ /dev/null @@ -1,194 +0,0 @@ -@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 deleted file mode 100644 index 1939bd7..0000000 --- a/lisp/bbdb-com.el +++ /dev/null @@ -1,3746 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; 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-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-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 - ;; - "^[ \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 . - ;; (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-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-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-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-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-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. -\\ -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 \" 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 \" 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 " or "bar " 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. -\\ -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 -\" (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 . -;;; 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. -\\ -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 "\\\ -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 deleted file mode 100644 index 1ac48d6..0000000 --- a/lisp/bbdb-ftp.el +++ /dev/null @@ -1,201 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is an addition to the Insidious Big Brother Database -;;; (aka BBDB), copyright (c) 1991, 1992 Jamie Zawinski -;;; . -;;; -;;; 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 - -;;; 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 deleted file mode 100644 index e903c6a..0000000 --- a/lisp/bbdb-gnus.el +++ /dev/null @@ -1,833 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; 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 (message-make-domain) - (system-name) "") "$") - "This regular expression should match your address as found in -the From header of your mail. If you send mail/news from multiple -addresses, then you'll likely have to set this yourself anyway." - :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 deleted file mode 100644 index 867bef5..0000000 --- a/lisp/bbdb-gui.el +++ /dev/null @@ -1,530 +0,0 @@ -;;; -*- 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 . - -;;; 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 deleted file mode 100644 index 09b1e89..0000000 --- a/lisp/bbdb-hooks.el +++ /dev/null @@ -1,713 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; 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 deleted file mode 100644 index ac90ae5..0000000 --- a/lisp/bbdb-merge.el +++ /dev/null @@ -1,264 +0,0 @@ -;;; 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 deleted file mode 100644 index ee7187d..0000000 --- a/lisp/bbdb-mhe.el +++ /dev/null @@ -1,225 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991 Todd Kaufmann -;;; Interface to mh-e version 3.7 or later (modeled after bbdb-rmail). -;;; Created 5-Mar-91; -;;; Modified: 28-Jul-94 by Fritz Knabe -;;; Jack Repenning - -;;; 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 deleted file mode 100644 index 92c2504..0000000 --- a/lisp/bbdb-migrate.el +++ /dev/null @@ -1,413 +0,0 @@ -;;; -*- 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 . 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 - ;; - ((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 . - ;; (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 deleted file mode 100644 index cda31ed..0000000 --- a/lisp/bbdb-print.el +++ /dev/null @@ -1,672 +0,0 @@ -;;; bbdb-print.el -- for printing BBDB databases using TeX. - -;;; Authors: Boris Goldowsky -;;; Dirk Grunwald -;;; Luigi Semenzato -;;; 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 -;;; and Dirk Grunwald -;;; using a TeX format designed by Luigi -;;; Semenzato . -;;; 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.\\ -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 deleted file mode 100644 index baadb03..0000000 --- a/lisp/bbdb-reportmail.el +++ /dev/null @@ -1,107 +0,0 @@ -;; bbdb-reportmail.el --- Hooks the Insidious Big Brother Database -;; into the Reportmail package - -;; Copyright (C) 1997 Christopher Kline - -;; Author: Christopher Kline -;; Maintainer: Christopher Kline -;; 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 deleted file mode 100644 index d6aab98..0000000 --- a/lisp/bbdb-rmail.el +++ /dev/null @@ -1,202 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992 Jamie Zawinski . -;;; 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 deleted file mode 100644 index 6fe04ae..0000000 --- a/lisp/bbdb-sc.el +++ /dev/null @@ -1,209 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is an addition to the Insidious Big Brother Database -;;; (aka BBDB), copyright (c) 1991, 1992 Jamie Zawinski -;;; . -;;; -;;; 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 -;;; based the original code by Tom Tromey . -;;; -;;; Thanks to Richard Stanton for ideas -;;; for improvements and to Michael D. Carney -;;; 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 deleted file mode 100644 index bf9d969..0000000 --- a/lisp/bbdb-snarf.el +++ /dev/null @@ -1,599 +0,0 @@ -;;; bbdb-snarf.el -- convert free-form text to BBDB records - -;;; -;;; Copyright (C) 1997 by John Heidemann . -;;; -;;; 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"
from Outlookers - ("\"\\([^\"]*\\)\"\\s-*<\\([^>]+\\)>" - (bbdb-clean-username (match-string 1 adstring)) 2) - - ;; name
- ("\\([^<>,\t][^<>,]+[^<>, \t]\\)\\s-*<\\([^>]+\\)>" - 1 2) - ;;
- ("<\\([^>,]+\\)>" 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 deleted file mode 100644 index d28235b..0000000 --- a/lisp/bbdb-srv.el +++ /dev/null @@ -1,285 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is the part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1995 Jamie Zawinski . -;;; 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 ' | 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 deleted file mode 100644 index 9ef279a..0000000 --- a/lisp/bbdb-vm.el +++ /dev/null @@ -1,426 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is the part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; 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 -;; vm 5.40 and newer support a new summary format, %U, 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 -;; 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 deleted file mode 100644 index 4c9c8d4..0000000 --- a/lisp/bbdb-w3.el +++ /dev/null @@ -1,61 +0,0 @@ -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; 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 deleted file mode 100644 index af4c34d..0000000 --- a/lisp/bbdb-whois.el +++ /dev/null @@ -1,264 +0,0 @@ -;;; 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 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 deleted file mode 100644 index d828201..0000000 --- a/lisp/bbdb-xemacs.el +++ /dev/null @@ -1,114 +0,0 @@ -;;; -*- 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 . - -;;; 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 deleted file mode 100644 index 4b91509..0000000 --- a/lisp/bbdb.el +++ /dev/null @@ -1,3873 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- -;;; This file is the core of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993, 1994 Jamie Zawinski . -;;; 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 -(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 \" versus \"John Q. Smith \". -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' (\\\\[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-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 \\\\[bbdb-complete-name]. -\t in Message mode, type \\\\[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 "^@.*\.$" - (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 " match - ;; against existing records like "Someone Else ". - ;; - ;; 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 .@ ... - (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 deleted file mode 100644 index 9400eac..0000000 --- a/misc/bbdb-unmigrate-stuff.el +++ /dev/null @@ -1,53 +0,0 @@ -;;; -*- 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 deleted file mode 100644 index fbd6764..0000000 --- a/misc/bbdb_gnus-summary-get-author.fig +++ /dev/null @@ -1,151 +0,0 @@ -#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 deleted file mode 100644 index 5fc607b..0000000 --- a/testing/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/Makefile diff --git a/testing/Makefile.in b/testing/Makefile.in deleted file mode 100644 index 85d2c22..0000000 --- a/testing/Makefile.in +++ /dev/null @@ -1,8 +0,0 @@ -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 deleted file mode 100644 index 86688df..0000000 --- a/testing/bbdb-test +++ /dev/null @@ -1,7 +0,0 @@ -;;; 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 deleted file mode 100644 index 0eaf156..0000000 --- a/testing/bbdb-test.el +++ /dev/null @@ -1,676 +0,0 @@ -;; 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 " - (("Robert Fenk" "fenk@users.sourceforge.net"))) - ("\"Robert Fenk, Jr\" " - (("Robert Fenk, Jr." "fenk@users.sourceforge.net"))) - ("" - ((nil "fenk@users.sourceforge.net"))) - ("\"Fenk, Robert\" " - (("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@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 " - nil) - ;; completing a completed record should cycle to the next - ;; email address. - ("Ronan Waide " - "Ronan Waide " - nil) - ;; completing on the name should return the first email - ;; address - ("ronan waide" - "Ronan Waide " - 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 " - nil)) - - ;; When set to 'name, completion should only occur on the NAME - ;; field - (name ("waider" - "waider" - nil) - ("ronan" - "Ronan Waide " - nil) - ("ronan waide" - "Ronan Waide " - nil)) - - ;; 'net => complete across NET field only - (net ("waider" - "Ronan Waide " - nil) - ("jwz" - "Jamie Zawinski " - nil)) - - ;; only complete on the primary email address - (primary ("waider" - "Ronan Waide " - nil)) - - ;; complete on primary email address or name - (primary-or-name ("waider" - "Ronan Waide " - nil) - ("ronan" - "Ronan Waide " - nil) - ("first" - "first" - ("First.Last@location1.org" "First.Second@location1.org"))) - - ;; same as above - (name-or-primary ("waider" - "Ronan Waide " - nil) - ("ronan" - "Ronan Waide " - 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 deleted file mode 100644 index f832127..0000000 --- a/testing/run-tests.el +++ /dev/null @@ -1,7 +0,0 @@ -(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 deleted file mode 100644 index 5fc607b..0000000 --- a/tex/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/Makefile diff --git a/tex/Makefile.in b/tex/Makefile.in deleted file mode 100644 index 0024b0a..0000000 --- a/tex/Makefile.in +++ /dev/null @@ -1,40 +0,0 @@ -@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 deleted file mode 100644 index 4102d0f..0000000 --- a/tex/bbdb-cols.tex +++ /dev/null @@ -1,234 +0,0 @@ -%%% bbdb-cols.tex - multiple columns per page, multiple pages per sheet. - -%%% Authors: Luigi Semenzato -%%% Boris Goldowsky -%%% 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 deleted file mode 100644 index f116270..0000000 --- a/tex/bbdb-print-brief.tex +++ /dev/null @@ -1,159 +0,0 @@ -%%% bbdb-print-brief.tex - for formatting address lists, one line per entry. - -%%% Authors: Luigi Semenzato -%%% Boris Goldowsky -%%% 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 deleted file mode 100644 index 9b60e4b..0000000 --- a/tex/bbdb-print.tex +++ /dev/null @@ -1,171 +0,0 @@ -%%% bbdb-print.tex - for formatting address lists. - -%%% Authors: Luigi Semenzato -%%% Boris Goldowsky -%%% 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 deleted file mode 100644 index 818cbf5..0000000 --- a/texinfo/.gitignore +++ /dev/null @@ -1,17 +0,0 @@ -/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 deleted file mode 100644 index 351c788..0000000 --- a/texinfo/Makefile.in +++ /dev/null @@ -1,93 +0,0 @@ -@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 deleted file mode 100644 index 43c9eb8..0000000 --- a/texinfo/bbdb.texinfo +++ /dev/null @@ -1,3996 +0,0 @@ -\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 - -Copyright (c) 1997-1999 Matt Simmons - -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 - -Copyright @copyright{} 1997-1999 Matt Simmons - -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 }}; however, if -@code{User Name} has an address of the form -@code{}, only the @code{} 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 }@* -@b{BBDB}: No record -@item -Message: @code{From: Matt }@* -@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 - -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 } 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 - -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 ''}} versus -@w{@i{``John Q. Smith ''.}} 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 -To: Matt Simmons -@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}.) - -The locus of BBDB development is moving to savannah, -@code{https://savannah.nongnu.org/projects/bbdb/}, -making the below of mainly historic interest. - -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. - -There is also an issue tracker associated with the @b{BBDB} -repository at @code{http://github.com/barak/BBDB}. - -@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 - -The locus of BBDB development is moving to savannah, -@code{https://savannah.nongnu.org/projects/bbdb/}, -making the below of mainly historic interest. -Development of the new v3 version, as well and maintenance releases of -v2.x, will be available in the associated git repository, -@code{git://git.savannah.nongnu.org/bbdb.git}. - -@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} -@item -Git Fork: @code{http://github.com/barak/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. -@item -Git Fork: @code{http://github.com/barak/BBDB} -@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 } - -@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{} -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{} -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{} - -@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{}. 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 deleted file mode 100644 index 0fa6af0..0000000 --- a/texinfo/infohack.el +++ /dev/null @@ -1,55 +0,0 @@ -;;; infohack.el --- a hack to format info file. -;; Copyright (C) 2001 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu -;; 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 deleted file mode 100644 index 85a41a5..0000000 --- a/utils/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -/Makefile -/*.debian diff --git a/utils/Makefile.in b/utils/Makefile.in deleted file mode 100644 index d248dc1..0000000 --- a/utils/Makefile.in +++ /dev/null @@ -1,40 +0,0 @@ -@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 deleted file mode 100644 index 5a791a5..0000000 --- a/utils/bbdb-213-310.el +++ /dev/null @@ -1,57 +0,0 @@ -;;; -*- 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 -;;; 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 deleted file mode 100644 index 2870151..0000000 --- a/utils/bbdb-415-510.el +++ /dev/null @@ -1,87 +0,0 @@ -;;; -*- 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 deleted file mode 100755 index b77e65f..0000000 --- a/utils/bbdb-areacode-split.pl +++ /dev/null @@ -1,62 +0,0 @@ -#!/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 -# 15 Aug 1997 - -sub Usage -{ - $0 =~ s@.*/@@; - die "Usage: \n $0 [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 () -{ - 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 () -{ - 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 deleted file mode 100755 index a422b67..0000000 --- a/utils/bbdb-cid.pl +++ /dev/null @@ -1,516 +0,0 @@ -#!/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 : 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); -# }; - - $_ = ; - chop; - if ( !m/^Connected/ ) { - print STDERR "$0: cu printed `$_' instead of `Connected'\n"; - } -} - -sub read_line { - $_ = ; - $_ || die("got eof on modem"); - s/[\r\n]+$//; - if ( $_ eq "" ) { - $_ = ; - $_ || 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 () { - 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 deleted file mode 100755 index ac26dfb..0000000 --- a/utils/bbdb-srv.pl +++ /dev/null @@ -1,45 +0,0 @@ -#!/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 ' | 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 , 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 deleted file mode 100644 index cf7d5a4..0000000 --- a/utils/bbdb-to-netscape.el +++ /dev/null @@ -1,213 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is the part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993, 1995 Jamie Zawinski . -;;; 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 "
")) - (let ((name (or (bbdb-record-name record) - (bbdb-record-company record) - ""))) - (bbdb-mozilla-insert-html name)) - (insert "\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 "\n" - "\n" - "" (user-full-name) "'s Address book\n" - "

" (user-full-name) "'s Address book

\n" - "\n" - "

\n") - (while records - (setq record (car records)) - (insert "

") - (insert (or (bbdb-record-name record) - net - (bbdb-record-company record) - ""))) - - (insert "\n") - (let ((phones (bbdb-record-phones record)) - (addrs (bbdb-record-addresses record)) - (aka (bbdb-record-aka record)) - phone - ) - - (insert "
") - (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
") - (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
")) - (if (= 0 (length (setq s (bbdb-address-street2 addr)))) nil - (indent-to 17) (insert s "\n
")) - (if (= 0 (length (setq s (bbdb-address-street3 addr)))) nil - (indent-to 17) (insert s "\n
")) - (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
") - (setq addrs (cdr addrs)))) - (cond (aka - (setq match t) - (insert (format " %14s: %s\n
" "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 "
") - (forward-char 1) - (insert (make-string 17 ?\ ))))) - (insert "\n"))) - (setq notes (cdr notes))))) - - (or match (delete-char -4)) - - (setq records (cdr records)) - ) - (insert "

\n") - )) diff --git a/utils/bbdb-unlazy-lock.pl b/utils/bbdb-unlazy-lock.pl deleted file mode 100755 index 30dec96..0000000 --- a/utils/bbdb-unlazy-lock.pl +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/perl -# -# Author: Christopher Kline -# -# 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( ) { - s/#\(("[^"]*")( \d+ \d+ (nil)*(\(lazy-lock t\))*)*\)/$1/gi; - print; -} -- cgit v1.2.3