-;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
+;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend -*- coding: utf-8 -*-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel Janík <Pavel@Janik.cz>
;; Keywords: comm
;; Package: eudc
;;; Code:
(require 'eudc)
-(if (not (featurep 'bbdb))
- (load-library "bbdb"))
-(if (not (featurep 'bbdb-com))
- (load-library "bbdb-com"))
+
+;; Make it loadable on systems without bbdb.
+(require 'bbdb nil t)
+(require 'bbdb-com nil t)
;;{{{ Internal cooking
(defun eudc-bbdb-filter-non-matching-record (record)
"Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
+ (require 'bbdb)
(catch 'unmatch
(progn
- (mapc
- (function
- (lambda (condition)
- (let ((attr (car condition))
- (val (cdr condition))
- (case-fold-search t)
- bbdb-val)
- (or (and (memq attr '(firstname lastname aka company phones addresses net))
- (progn
- (setq bbdb-val
- (eval (list (intern (concat "bbdb-record-"
- (symbol-name attr)))
- 'record)))
- (if (listp bbdb-val)
- (if eudc-bbdb-enable-substring-matches
- (eval `(or ,@(mapcar '(lambda (subval)
- (string-match val
- subval))
- bbdb-val)))
- (member (downcase val)
- (mapcar 'downcase bbdb-val)))
- (if eudc-bbdb-enable-substring-matches
- (string-match val bbdb-val)
- (string-equal (downcase val) (downcase bbdb-val))))))
- (throw 'unmatch nil)))))
- eudc-bbdb-current-query)
+ (dolist (condition eudc-bbdb-current-query)
+ (let ((attr (car condition))
+ (val (cdr condition))
+ (case-fold-search t)
+ bbdb-val)
+ (or (and (memq attr '(firstname lastname aka company phones
+ addresses net))
+ (progn
+ (setq bbdb-val
+ (eval (list (intern (concat "bbdb-record-"
+ (symbol-name attr)))
+ 'record)))
+ (if (listp bbdb-val)
+ (if eudc-bbdb-enable-substring-matches
+ (eval `(or ,@(mapcar (lambda (subval)
+ (string-match val subval))
+ bbdb-val)))
+ (member (downcase val)
+ (mapcar 'downcase bbdb-val)))
+ (if eudc-bbdb-enable-substring-matches
+ (string-match val bbdb-val)
+ (string-equal (downcase val) (downcase bbdb-val))))))
+ (throw 'unmatch nil))))
record)))
;; External.
(&optional dont-check-disk already-in-db-buffer))
(defun eudc-bbdb-extract-phones (record)
+ (require 'bbdb)
(mapcar (function
(lambda (phone)
(if eudc-bbdb-use-locations-as-attribute-names
(bbdb-record-phones record)))
(defun eudc-bbdb-extract-addresses (record)
+ (require 'bbdb)
(let (s c val)
(mapcar (lambda (address)
(setq c (bbdb-address-streets address))
(defun eudc-bbdb-format-record-as-result (record)
"Format the BBDB RECORD as a EUDC query result record.
The record is filtered according to `eudc-bbdb-current-return-attributes'"
+ (require 'bbdb)
(let ((attrs (or eudc-bbdb-current-return-attributes
'(firstname lastname aka company phones addresses net notes)))
attr
(symbol-name attr)))
'record))))
(t
- (setq val "Unknown BBDB attribute")))
- (if val
- (cond
- ((memq attr '(phones addresses))
- (setq eudc-rec (append val eudc-rec)))
- ((and (listp val)
- (= 1 (length val)))
- (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
- ((> (length val) 0)
- (setq eudc-rec (cons (cons attr val) eudc-rec)))
- (t
- (error "Unexpected attribute value")))))
+ (error "Unknown BBDB attribute")))
+ (cond
+ ((or (not val) (equal val ""))) ; do nothing
+ ((memq attr '(phones addresses))
+ (setq eudc-rec (append val eudc-rec)))
+ ((and (listp val)
+ (= 1 (length val)))
+ (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
+ ((> (length val) 0)
+ (setq eudc-rec (cons (cons attr val) eudc-rec)))
+ (t
+ (error "Unexpected attribute value"))))
(nreverse eudc-rec)))
BBDB attribute names.
RETURN-ATTRS is a list of attributes to return, defaulting to
`eudc-default-return-attributes'."
-
+ (require 'bbdb)
(let ((eudc-bbdb-current-query query)
(eudc-bbdb-current-return-attributes return-attrs)
(query-attrs (eudc-bbdb-format-query query))
(provide 'eudcb-bbdb)
-;; arch-tag: 38276208-75de-4dbc-ba6f-8db684c32e0a
;;; eudcb-bbdb.el ends here