annotate lisp/net/eudcb-bbdb.el @ 47576:b31c8ab7336a

Sync with version 2.0.20. Lengthy ChangeLog follows: 2002-09-22 Kai Gro?ohann <grossjoh@ls6.informatik.uni-dortmund.de> Version 2.0.20 released. 2002-09-20 Kai Gro?ohann <grossjoh@ls6.informatik.uni-dortmund.de> * net/tramp.el (tramp-completion-function-alist): Escape open paren in docstring. (tramp-user-regexp, tramp-host-regexp): Allow empty strings. (tramp-handle-insert-file-contents): Call tramp-message-for-buffer instead of tramp-message. (tramp-open-connection-rsh): Handle empty string as user name. (tramp-open-connection-su): Handle empty string as host name. Handle nil user name. (tramp-handle-file-local-copy, tramp-handle-write-region) (tramp-completion-handle-file-name-all-completions) (tramp-open-connection-telnet, tramp-open-connection-rsh) (tramp-open-connection-su, tramp-post-connection) (tramp-maybe-open-connection, tramp-method-out-of-band-p) (tramp-get-connection-function, tramp-get-remote-sh) (tramp-get-rsh-program, tramp-get-rsh-args) (tramp-get-rcp-program, tramp-get-rcp-args) (tramp-get-rcp-keep-date-arg, tramp-get-su-program) (tramp-get-su-args, tramp-get-telnet-program) (tramp-get-telnet-args): Use `tramp-find-method', perhaps require additional args USER, HOST. (tramp-action-password, tramp-open-connection-telnet) (tramp-open-connection-su, tramp-open-connection-multi) (tramp-method-out-of-band-p): `tramp-method-out-of-band-p' now takes USER and HOST arguments, to be able to use `tramp-find-method'. Update callers. (tramp-find-method): New function. 2002-09-20 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-handle-insert-directory): Handle "--dired" in SWITCHES (by removing it). 2002-09-18 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-file-name-handler): Add `file-remote-p' property. 2002-09-17 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (top-level): Maybe autoload uudecode-decode-region. 2002-09-16 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-bug): Add tramp-methods. 2002-09-16 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-methods): Update docstring: tramp-encoding-command, tramp-decoding-command, tramp-encoding-function and tramp-decoding-function are not parameters anymore. (tramp-uuencode-region): Autoload it. 2002-09-13 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> Version 2.0.19 released. * net/tramp-uu.el: New file, implements uuencode in Lisp. * net/tramp.el (tramp-coding-commands): Use `tramp-uuencode-region' as local encoder for the uuencode based entries. 2002-09-13 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-handle-write-region): Wrong parens. 2002-09-13 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> Version 2.0.18 released. * net/tramp.el (tramp-perl-decode): Perl changes to accomodate older versions of Perl. Now tested with 5.004. Suggestion from Michael Albinus. 2002-09-12 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-find-inline-encoding): Call tramp-call-local-coding-command with nil for INPUT and OUTPUT. (tramp-call-local-coding-command): OUTPUT equals nil means to discard the output. INPUT equals nil means /dev/null. 2002-09-12 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-encoding-shell): Default to environment variable COMSPEC on Windows. (tramp-handle-write-region): More debugging output. (tramp-find-inline-encoding): Ditto. 2002-09-11 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-handle-file-name-all-completions): Define `result1'. (tramp-parse-hosts-group): Discard IPv6 entries. 2002-09-11 Kai Gro?ohann <grossjoh@ls6.informatik.uni-dortmund.de> * net/tramp.el (tramp-post-connection): Only send Perl mime-encode/decode implementations when using inline method. (tramp-handle-file-local-copy) (tramp-handle-write-region, tramp-post-connection) (tramp-coding-commands, tramp-find-inline-encoding): For the inline encodings, distinguish between local and remote commands, instead of between commands and functions. (The local commands can be functions, too.) If the local host is a Windows machine, we can't expect the same commands to work there as on the remote host. (tramp-call-local-coding-command): New function for calling local encoding and decoding commands. (tramp-set-remote-encoding, tramp-get-remote-encoding) (tramp-set-remote-decoding, tramp-get-remote-decoding) (tramp-set-local-encoding, tramp-get-local-encoding) (tramp-set-local-decoding, tramp-get-local-decoding): New functions. (tramp-get-encoding-command, tramp-set-encoding-command) (tramp-get-decoding-command, tramp-set-decoding-command) (tramp-get-encoding-function, tramp-set-encoding-function) (tramp-get-decoding-function, tramp-set-decoding-function): Old functions, removed. 2002-09-10 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-open-connection-setup-interactive-shell): Change command to invoke /bin/sh slightly to make it compatible with the `rc' shell. Suggested by Daniel Pittman. 2002-09-10 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-handle-write-region): Added missing `)'. Hope it's the right place. 2002-09-09 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-open-connection-setup-interactive-shell): Do "exec env PS1='$ ' /bin/sh" instead of just "exec /bin/sh" in order to get a sane shell prompt. If people have ${CWD}, say, in their shell prompt, then the default login shell might display something harmless, but the /bin/sh will display a dollar sign which confused the subsequent prompt recognition. (tramp-multi-action-password): More debugging output. (tramp-encoding-shell): Renamed from tramp-sh-program. More documentation. Default to cmd.exe on Windows NT. (tramp-encoding-command-switch): New variable. Use instead of hard-wired "-c" which is only good for /bin/sh. (tramp-encoding-reads-stdin): New variable. If t, commands are called like "/bin/sh -c COMMAND <INPUT", if nil, they are called like "/bin/sh -c COMMAND INPUT", ie the input file is the last argument. (tramp-multi-sh-program): Always default to tramp-encoding-shell. (tramp-handle-file-local-copy, tramp-handle-write-region): Respect tramp-encoding-shell and friends. (tramp-find-inline-encoding): Use new-style calls for checking if the local commands work. 2002-09-07 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-methods): Remove `tramp-completion-function' entries. They are handled now by `tramp-completion-function-alist'. (tramp-completion-function): Defvar removed. I've never used it. Hmm. (tramp-get-completion-function) (tramp-get-completion-rsh, tramp-get-completion-ssh) (tramp-get-completion-telnet, tramp-get-completion-su): Functions removed as well. Not necessary any longer due to extended customization means. (tramp-completion-function-alist): New defcustom. Holds all FUNCTION FILE pairs used for user and host name completion relevant for METHOD. (tramp-completion-function-alist-rsh) (tramp-completion-function-alist-ssh) (tramp-completion-function-alist-telnet) (tramp-completion-function-alist-su): Defconst for initializing `tramp-completion-function-alist'. Unfortunately, mainly UNIX-like values are known for me until now. Needs to be completed for at least VMS++ like operating systems. (tramp-set-completion-function) (tramp-get-completion-function): New functions for configuration of `tramp-completion-function-alist'. The old definition of `tramp-get-completion-function' has been discarded. (tramp-completion-handle-file-name-all-completions): Change function call for user/host completion according to definition in `tramp-completion-function-alist'. (tramp-parse-passwd): Added exception handling for "root", because `tramp-get-completion-su' (the previous place for this stuff) doesn't exist any longer. 2002-09-07 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-enter-password): Use `tramp-password-end-of-line' to terminate the line. (tramp-bug): Include new variable `tramp-password-end-of-line'. (tramp-password-end-of-line): New variable. People who use plink under Windows might have to issue "\r\n" after the password, but they need to send just "\n" after the other commands. So this variable was introduced to complement `tramp-rsh-end-of-line'. (tramp-wait-for-output, tramp-post-connection): Allow "\r" at end of line of the output delimiter. 2002-09-06 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-handle-file-local-copy, tramp-find-shell) (tramp-open-connection-setup-interactive-shell): Add some comments about Douglas Grey Stephen's suggestions to make Tramp work better with plink under Windows. I'm not sure what to think of them, but now I have a guinea pig to try it out on. Said guinea pig is having other problems, though... Also remove some commented-out code. 2002-09-06 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-get-completion-methods): Algorithm slightly tuned. (tramp-get-completion-user-host): Accept user names as they are if typed until "@". (tramp-completion-mode): Replace `last-input-char' by modern `last-input-event'. Check for `event-modifiers'. 2002-09-06 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (file-expand-wildcards): Corrected check to see if advising is necessary. 2002-09-05 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-postfix-single-method-format) (tramp-postfix-multi-method-format) (tramp-postfix-multi-hop-format) (tramp-postfix-user-format): New format strings. (tramp-postfix-single-method-regexp) (tramp-postfix-multi-method-regexp) (tramp-postfix-multi-hop-regexp) (tramp-postfix-user-regexp) (tramp-make-multi-tramp-file-format) (tramp-make-tramp-file-name): Apply them. (tramp-completion-handle-file-name-all-completions): Fix for invoking ange-ftp in case of "/ftp:xxx" file names. 2002-09-04 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-prefix-format) (tramp-postfix-host-format): New format strings. (tramp-prefix-regexp, tramp-method-regexp) (tramp-postfix-single-method-regexp) (tramp-postfix-multi-method-regexp) (tramp-postfix-multi-hop-regexp) (tramp-user-regexp, tramp-postfix-user-regexp) (tramp-host-regexp, tramp-postfix-host-regexp) (tramp-path-regexp): New atomar regular expressions. If corresponding format strings exist, derived from them. (tramp-file-name-structure) (tramp-multi-file-name-structure) (tramp-multi-file-name-hop-structure) (tramp-make-multi-tramp-file-format) (tramp-completion-mode) (tramp-completion-dissect-file-name) (tramp-parse-rhosts-group) (tramp-parse-shosts-group) (tramp-parse-hosts-group) (tramp-parse-passwd-group): Apply these expressions. (tramp-file-name-structure-unified) (tramp-file-name-structure-separate) (tramp-make-tramp-file-format-unified) (tramp-make-tramp-file-format-separate) (tramp-make-tramp-file-format) (tramp-make-tramp-file-user-nil-format-unified) (tramp-make-tramp-file-user-nil-format-separate) (tramp-make-tramp-file-user-nil-format) (tramp-multi-file-name-structure-unified) (tramp-multi-file-name-structure-separate) (tramp-multi-file-name-hop-structure-unified) (tramp-multi-file-name-hop-structure-separate) (tramp-make-multi-tramp-file-format-unified) (tramp-make-multi-tramp-file-format-separate): Removed. (tramp-make-tramp-file-name): Allow partial tramp file names. Generate tramp file format on-the-fly depending on parameters. Apply atomar format strings resp expressions. (tramp-get-completion-methods) (tramp-get-completion-user-host): Apply `tramp-make-tramp-file-name'. (tramp-parse-hosts-group): Take all host names and IP addresses into account. (tramp-bug): Remove `tramp-make-tramp-file-format'. 2002-09-01 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-methods): Add `tramp-completion-function' for "su" and "sudo". (tramp-get-completion-telnet): Implement it. (tramp-parse-hosts) (tramp-parse-hosts-group) (tramp-get-completion-su) (tramp-parse-passwd) (tramp-parse-passwd-group): New functions. 2002-08-31 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-mode): Check for `last-input-char'. (tramp-completion-file-name-handler-alist): Add handler for `file-exists-p. (tramp-completion-handle-file-exists-p): New function. (tramp-completion-handle-file-name-completion): Simplified. (tramp-completion-dissect-file-name): Regexp's reorganised. (tramp-completion-handle-file-name-all-completions): Call completion-function only if `user' or `host' is given. (tramp-get-completion-user-host): New function. (tramp-get-completion-rsh) (tramp-get-completion-ssh): Apply it. 2002-08-29 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-file-name-handler-alist): Add handler for `expand-file-name'. (tramp-completion-handle-expand-file-name): New function. 2002-08-26 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-mode): New function. (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-all-completions): Apply it. (tramp-methods): Remove double definition of `ssh1-old' and `ssh2-old'. (tramp-point-at-eol): New defalias. (tramp-parse-rhosts-group) (tramp-parse-shosts-group):: Apply it. 2002-08-25 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-get-completion-methods) (tramp-get-completion-rsh) (tramp-get-completion-ssh): Add "[" for Xemacs. (tramp-completion-file-name-regexp-separate): Expression adapted. (tramp-completion-file-name-handler-alist): Add handler for `file-name-directory' and `file-name-nondirectory'. (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-nondirectory) (tramp-completion-run-real-handler): New functions. (tramp-completion-file-name-handler) (tramp-completion-handle-file-name-all-completions): Apply `tramp-completion-run-real-handler'. (tramp-parse-rhosts) (tramp-parse-shosts): Use `with-temp-buffer'. `result? renamed to `res' (otherwise side effects in XEmacs). 2002-08-24 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-file-name-regexp) (tramp-completion-file-name-handler-alist) (tramp-flatten-list) (tramp-completion-dissect-file-name) (tramp-get-completion-rsh) (tramp-parse-rhosts) (tramp-parse-rhosts-group) (tramp-get-completion-ssh): Doc string tuned. (tramp-methods): Doc string and custom type extended for `tramp-completion-function'. (tramp-completion-function): Variable added. Is it really used? Other variables like `tramp-completion-function' aren't used. (tramp-completion-file-name-handler-alist): Add handler for `file-name-completion'. (tramp-completion-handle-file-name-completion): New function. 2002-08-18 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-parse-rhosts) (tramp-parse-rhosts-group) (tramp-parse-shosts) (tramp-parse-shosts-group): New functions. 2002-08-17 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-dissect-file-name) (tramp-completion-dissect-file-name1): New functions. 2002-08-16 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-get-completion-function) (tramp-get-completion-rsh) (tramp-get-completion-ssh) (tramp-get-completion-telnet): New functions. (tramp-methods): Add `tramp-completion-function' for all methods. 2002-08-15 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-get-completion-methods): New function. (tramp-find-default-method): Allow host to be nil (like user). 2002-08-14 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-completion-file-name-regexp-unified) (tramp-completion-file-name-regexp-separate) (tramp-completion-file-name-regexp) (tramp-completion-file-name-handler-alist): New defcustoms. (tramp-completion-file-name-handler): New function. Add `tramp-completion-file-name-handler' to `file-name-handler-alist'. (tramp-run-real-handler): Add `tramp-completion-file-name-handler' to `inhibit-file-name-handlers'. (tramp-completion-handle-file-name-all-completions) (tramp-completion-handle-file-name-completion): New functions. 2002-08-12 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-invoke-ange-ftp): `tramp-disable-ange-ftp' must be called again after activating `ange-ftp'. (tramp-ange-ftp-file-name-p): Check for Xemacs. 2002-08-08 Michael Albinus <Michael.Albinus@alcatel.de> * net/tramp.el (tramp-do-copy-or-rename-file): Don't pass KEEP-DATE to tramp-invoke-ange-ftp 'rename. (tramp-handle-write-region): Don't pass LOCKNAME and CONFIRM to tramp-invoke-ange-ftp 'write-region. (tramp-handle-set-file-modes): Change order of FILENAME and MODE passing to tramp-invoke-ange-ftp 'set-file-modes. (tramp-flatten-list): New function. Maybe this functionality does exist already elsewhere in the libraries. (tramp-invoke-ange-ftp): Apply `tramp-flatten-list' to parameter list in order to avoid nested lists, f.e. when invoked from `tramp-handle-dired-call-process'. 2002-09-05 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-chunksize): New kluge variable. (tramp-send-region): If tramp-chunksize is non-nil, send region in parts and sleep 0.1 seconds between chunks. 2002-09-03 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-handle-insert-directory): Use `insert-buffer-substring' instead of `insert-buffer', which is not supposed to be used from Lisp. Remember old point in a variable instead of using `mark'. Suggestion from Stefan Monnier. (tramp-unified-filenames): New variable. Use it in default value of other filename variables. (file-expand-wildcards): Don't advise unless "[" and "]" are used in the filename format. 2002-09-01 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * net/tramp.el (tramp-methods): Remove duplicate definition of ssh1-old and ssh2-old.
author Kai Großjohann <kgrossjo@eu.uu.net>
date Sun, 22 Sep 2002 13:23:36 +0000
parents 6d743d659035
children 0d8b17d428b5
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1 ;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2
42778
6d743d659035 New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents: 42574
diff changeset
3 ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4
42778
6d743d659035 New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents: 42574
diff changeset
5 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
6d743d659035 New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents: 42574
diff changeset
6 ;; Maintainer: Pavel Janík <Pavel@Janik.cz>
42574
fcac9cd201ad Fix Keywords: header.
Pavel Janík <Pavel@Janik.cz>
parents: 42570
diff changeset
7 ;; Keywords: comm
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
8
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14 ;; any later version.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24 ;; Boston, MA 02111-1307, USA.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26 ;;; Commentary:
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
27 ;; This library provides an interface to use BBDB as a backend of
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28 ;; the Emacs Unified Directory Client.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30 ;;; Code:
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
31
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
32 (require 'eudc)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
33 (if (not (featurep 'bbdb))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
34 (load-library "bbdb"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
35 (if (not (featurep 'bbdb-com))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
36 (load-library "bbdb-com"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
37
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
38 ;;{{{ Internal cooking
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
39
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40 ;; I don't like this but mapcar does not accept a parameter to the function and
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
41 ;; I don't want to use mapcar*
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42 (defvar eudc-bbdb-current-query nil)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
43 (defvar eudc-bbdb-current-return-attributes nil)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
44
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
45 (defvar eudc-bbdb-attributes-translation-alist
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
46 '((name . lastname)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
47 (email . net)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
48 (phone . phones))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
49 "Alist mapping EUDC attribute names to BBDB names.")
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
50
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
51 (eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
52 (eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
53 (eudc-protocol-set 'eudc-protocol-attributes-translation-alist
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
54 'eudc-bbdb-attributes-translation-alist 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
55 (eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
56 (eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
57
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 (defun eudc-bbdb-format-query (query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
59 "Format a EUDC query alist into a list suitable to `bbdb-search'."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
60 (let* ((firstname (cdr (assq 'firstname query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
61 (lastname (cdr (assq 'lastname query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
62 (name (or (and firstname lastname
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
63 (concat firstname " " lastname))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
64 firstname
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
65 lastname))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
66 (company (cdr (assq 'company query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67 (net (cdr (assq 'net query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68 (notes (cdr (assq 'notes query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 (phone (cdr (assq 'phone query))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
70 (list name company net notes phone)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
71
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
72
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
73 (defun eudc-bbdb-filter-non-matching-record (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
74 "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
75 (catch 'unmatch
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
76 (progn
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
77 (mapcar
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
78 (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
79 (lambda (condition)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
80 (let ((attr (car condition))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81 (val (cdr condition))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 (case-fold-search t)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
83 bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
84 (or (and (memq attr '(firstname lastname aka company phones addresses net))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
85 (progn
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
86 (setq bbdb-val
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
87 (eval (list (intern (concat "bbdb-record-"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
88 (symbol-name attr)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
89 'record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 (if (listp bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91 (if eudc-bbdb-enable-substring-matches
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 (eval `(or ,@(mapcar '(lambda (subval)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 (string-match val
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 subval))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95 bbdb-val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 (member (downcase val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 (mapcar 'downcase bbdb-val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98 (if eudc-bbdb-enable-substring-matches
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
99 (string-match val bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100 (string-equal (downcase val) (downcase bbdb-val))))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 (throw 'unmatch nil)))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102 eudc-bbdb-current-query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103 record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
104
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
105 (defun eudc-bbdb-extract-phones (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
106 (mapcar (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
107 (lambda (phone)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
108 (if eudc-bbdb-use-locations-as-attribute-names
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
109 (cons (intern (bbdb-phone-location phone))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
110 (bbdb-phone-string phone))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
111 (cons 'phones (format "%s: %s"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
112 (bbdb-phone-location phone)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
113 (bbdb-phone-string phone))))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
114 (bbdb-record-phones record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
115
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
116 (defun eudc-bbdb-extract-addresses (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
117 (let (s c val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
118 (mapcar (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
119 (lambda (address)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
120 (setq val (concat (unless (= 0 (length (setq s (bbdb-address-street1 address))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
121 (concat s "\n"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
122 (unless (= 0 (length (setq s (bbdb-address-street2 address))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
123 (concat s "\n"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
124 (unless (= 0 (length (setq s (bbdb-address-street3 address))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
125 (concat s "\n"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
126 (progn
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
127 (setq c (bbdb-address-city address))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
128 (setq s (bbdb-address-state address))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
129 (if (and (> (length c) 0) (> (length s) 0))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
130 (concat c ", " s " ")
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
131 (concat c " ")))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
132 (bbdb-address-zip-string address)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
133 (if eudc-bbdb-use-locations-as-attribute-names
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
134 (cons (intern (bbdb-address-location address)) val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
135 (cons 'addresses (concat (bbdb-address-location address) "\n" val)))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
136 (bbdb-record-addresses record))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
137
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
138 (defun eudc-bbdb-format-record-as-result (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
139 "Format the BBDB RECORD as a EUDC query result record.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
140 The record is filtered according to `eudc-bbdb-current-return-attributes'"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
141 (let ((attrs (or eudc-bbdb-current-return-attributes
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
142 '(firstname lastname aka company phones addresses net notes)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
143 attr
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
144 eudc-rec
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
145 val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
146 (while (prog1
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
147 (setq attr (car attrs))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
148 (setq attrs (cdr attrs)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
149 (cond
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
150 ((eq attr 'phones)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 (setq val (eudc-bbdb-extract-phones record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 ((eq attr 'addresses)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 (setq val (eudc-bbdb-extract-addresses record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 ((memq attr '(firstname lastname aka company net notes))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 (setq val (eval
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 (list (intern
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
157 (concat "bbdb-record-"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 (symbol-name attr)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
159 'record))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 (t
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 (setq val "Unknown BBDB attribute")))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 (if val
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 (cond
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 ((memq attr '(phones addresses))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 (setq eudc-rec (append val eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
166 ((and (listp val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
167 (= 1 (length val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
168 (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 ((> (length val) 0)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
170 (setq eudc-rec (cons (cons attr val) eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
171 (t
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
172 (error "Unexpected attribute value")))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 (nreverse eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
174
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
175
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
176
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
177 (defun eudc-bbdb-query-internal (query &optional return-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178 "Query BBDB with QUERY.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180 BBDB attribute names.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 RETURN-ATTRS is a list of attributes to return, defaulting to
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 `eudc-default-return-attributes'."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184 (let ((eudc-bbdb-current-query query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
185 (eudc-bbdb-current-return-attributes return-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
186 (query-attrs (eudc-bbdb-format-query query))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187 bbdb-attrs
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 (records (bbdb-records))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189 result
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
190 filtered)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
191 ;; BBDB ORs its query attributes while EUDC ANDs them, hence we need to
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
192 ;; call bbdb-search iteratively on the returned records for each of the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193 ;; requested attributes
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194 (while (and records (> (length query-attrs) 0))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 (setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196 (if (car query-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198 (setq query-attrs (cdr query-attrs)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
199 (mapcar (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 (lambda (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201 (setq filtered (eudc-filter-duplicate-attributes record))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
202 ;; If there were duplicate attributes reverse the order of the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203 ;; record so the unique attributes appear first
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 (if (> (length filtered) 1)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
205 (setq filtered (mapcar (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
206 (lambda (rec)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207 (reverse rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 filtered)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
209 (setq result (append result filtered))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
210 (delq nil
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
211 (mapcar 'eudc-bbdb-format-record-as-result
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
212 (delq nil
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
213 (mapcar 'eudc-bbdb-filter-non-matching-record
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
214 records)))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
215 result))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
216
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
217 ;;}}}
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
218
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
219 ;;{{{ High-level interfaces (interactive functions)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
220
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
221 (defun eudc-bbdb-set-server (dummy)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
222 "Set the EUDC server to BBDB."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
223 (interactive)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
224 (eudc-set-server dummy 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
225 (message "BBDB server selected"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
226
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
227 ;;}}}
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
228
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
229
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
230 (eudc-register-protocol 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
231
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
232 (provide 'eudcb-bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
234 ;;; eudcb-bbdb.el ends here