[Emacs-diffs] scratch/eudc-bbdb-3 05257b9 10/15: EUDC: Port BBDB backend to BBDB >= 3

[Thomas Fitzsimmons]

branch: scratch/eudc-bbdb-3
commit 05257b92edee3dfbaf8bd7d7d408884efd083a90
Author: Thomas Fitzsimmons <address@hidden>
Commit: Thomas Fitzsimmons <address@hidden>

    EUDC: Port BBDB backend to BBDB >= 3
    
    * lisp/net/eudcb-bbdb.el (eudc-bbdb-field): Convert BBDB < 3
    field names to BBDB >= 3 field names.
    (eudc-bbdb-format-query): Support old
    and new BBDB field names.
    (eudc-bbdb-filter-non-matching-record): Add support for both
    BBDB < 3 field names and BBDB >= 3 field names.
    (eudc-bbdb-extract-phones): Likewise.
    (eudc-bbdb-extract-addresses): Likewise.
    (eudc-bbdb-format-record-as-result): Likewise.
    * doc/misc/eudc.texi (Creating BBDB Records): Document EUDC
    BBDB field name support.
---
 doc/misc/eudc.texi     | 31 +++++++++++-------
 lisp/net/eudcb-bbdb.el | 89 ++++++++++++++++++++++++++++----------------------
 2 files changed, 69 insertions(+), 51 deletions(-)

diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index b7b263d..ab7c896 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -890,19 +890,26 @@ external directory format to the BBDB format is a highly 
customizable
 process.
 
 @defvar eudc-bbdb-conversion-alist
-The value of this variable should be a symbol naming an alist defining a
-mapping between BBDB field names onto directory attribute names records.
+The value of this variable should be a symbol naming an alist defining
+a mapping from BBDB field names to directory attribute names.
+
 This is a protocol-local variable and is initialized upon protocol
-switch (@pxref{Server/Protocol Locals}).  The alist is made of cells of the
-form @code{(@var{bbdb-field} . @var{spec-or-list})}.
address@hidden is the name of a field
-that must be defined in your BBDB environment (standard field names are
address@hidden, @code{company}, @code{net}, @code{phone}, @code{address}
-and @code{notes}).
address@hidden is either a single mapping specification or a list of
-mapping specifications.  Lists of mapping specifications are valid for
-the @code{phone} and @code{address} BBDB fields only. @var{spec}s are
-actually s-expressions which are evaluated as follows:
+switch (@pxref{Server/Protocol Locals}).  The alist is made of cells
+of the form @code{(@var{bbdb-field} . @var{spec-or-list})}.
+
address@hidden is the name of a field that must be defined in your
+BBDB environment.  Standard field names are @code{name},
address@hidden, @code{mail}, @code{phone}, @code{address} and
address@hidden  Historical field names for @code{organization},
address@hidden, @code{phone}, and @code{address} are still supported;
+they are, respectively @code{company}, @code{net}, @code{phones}, and
address@hidden
+
address@hidden is either a single mapping
+specification or a list of mapping specifications.  Lists of mapping
+specifications are valid for the @code{phone} and @code{address} BBDB
+fields only. @var{spec}s are actually s-expressions which are
+evaluated as follows:
 
 @table @asis
 @item a string
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index deda897..6541a2e 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -42,18 +42,24 @@
 
 (defun eudc-bbdb-field (field-symbol)
   "Convert FIELD-SYMBOL so that it is recognized by the current BBDB version.
-BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
-  ;; This just-in-time translation permits upgrading from BBDB 2 to
-  ;; BBDB 3 without restarting Emacs.
-  (if (and (eq field-symbol 'net)
-          (eudc--using-bbdb-3-or-newer-p))
-      'mail
-    field-symbol))
+BBDB < 3 used `company', `phones', `addresses' and `net' where
+BBDB >= 3 uses `organization', `phone', `address' and `mail'
+respectively.
+
+EUDC users may be referring to old BBDB fields in their
+configuration, so for convenience this function enables support
+for continued use of those old names."
+  (cond
+   ((eq field-symbol 'company) 'organization)
+   ((eq field-symbol 'phones) 'phone)
+   ((eq field-symbol 'addresses) 'address)
+   ((eq field-symbol 'net) 'mail)
+   (t field-symbol)))
 
 (defvar eudc-bbdb-attributes-translation-alist
   '((name . lastname)
-    (email . net)
-    (phone . phones))
+    (email . mail)
+    (phone . phone))
   "Alist mapping EUDC attribute names to BBDB names.")
 
 (eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
@@ -71,11 +77,13 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
                        (concat firstname " " lastname))
                   firstname
                   lastname))
-        (company (cdr (assq 'company query)))
-        (net (cdr (assq 'net query)))
+        (organization (or (cdr (assq 'organization query))
+                          (cdr (assq 'company query))))
+        (mail (or (cdr (assq 'mail query))
+                  (cdr (assq 'net query))))
         (notes (cdr (assq 'notes query)))
         (phone (cdr (assq 'phone query))))
-    (list name company net notes phone)))
+    (list name organization mail notes phone)))
 
 
 (defun eudc-bbdb-filter-non-matching-record (record)
@@ -88,15 +96,13 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
              (val (cdr condition))
              (case-fold-search t)
              bbdb-val)
-         (or (and (memq attr '(firstname lastname aka company phones
-                                         addresses net))
+         (or (and (memq attr '(firstname lastname aka
+                                         organization phone address mail
+                                         ;; BBDB < 3 fields.
+                                         company phones addresses net))
                   (progn
-                    (setq bbdb-val
-                          (eval (list (intern (concat "bbdb-record-"
-                                                      (symbol-name
-                                                       (eudc-bbdb-field
-                                                        attr))))
-                                      'record)))
+                    (setq bbdb-val (bbdb-record-field record
+                                                      (eudc-bbdb-field attr)))
                     (if (listp bbdb-val)
                         (if eudc-bbdb-enable-substring-matches
                             (eval `(or ,@(mapcar (lambda (subval)
@@ -118,12 +124,12 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
    (mapcar (function
            (lambda (phone)
              (if eudc-bbdb-use-locations-as-attribute-names
-                 (cons (intern (bbdb-phone-location phone))
+                 (cons (intern (bbdb-phone-label phone))
                        (bbdb-phone-string phone))
                (cons 'phones (format "%s: %s"
-                                     (bbdb-phone-location phone)
+                                     (bbdb-phone-label phone)
                                      (bbdb-phone-string phone))))))
-          (bbdb-record-phones record))))
+          (bbdb-record-phone record))))
 
 (defun eudc-bbdb-extract-addresses (record)
   "Extract addresses from BBDB RECORD."
@@ -143,20 +149,20 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
                                     (concat c ", " s)
                                   c)
                                 " "
-                                (bbdb-address-zip address)))
+                                (bbdb-address-postcode address)))
               (if eudc-bbdb-use-locations-as-attribute-names
-                  (cons (intern (bbdb-address-location address)) val)
-                (cons 'addresses (concat (bbdb-address-location address)
-                                         "\n" val))))
-            (bbdb-record-addresses record)))))
+                  (cons (intern (bbdb-address-label address)) val)
+                (cons 'address (concat (bbdb-address-label address)
+                                       "\n" val))))
+            (bbdb-record-address record)))))
 
 (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)))
+                  '(firstname lastname aka organization phone address mail
+                              notes)))
        attr
        eudc-rec
        val)
@@ -164,21 +170,26 @@ The record is filtered according to 
`eudc-bbdb-current-return-attributes'"
               (setq attr (car attrs))
             (setq attrs (cdr attrs)))
       (cond
-       ((eq attr 'phones)
+       ((or (eq attr 'phone)
+           ;; BBDB < 3 field.
+           (eq attr 'phones))
        (setq val (eudc-bbdb-extract-phones record)))
-       ((eq attr 'addresses)
+       ((or (eq attr 'address)
+           ;; BBDB < 3 field.
+           (eq attr 'addresses))
        (setq val (eudc-bbdb-extract-addresses record)))
-       ((memq attr '(firstname lastname aka company net notes))
-       (setq val (eval
-                  (list (intern
-                         (concat "bbdb-record-"
-                                 (symbol-name (eudc-bbdb-field attr))))
-                        'record))))
+       ((memq attr '(firstname lastname aka
+                              organization mail notes
+                              ;; BBDB < 3 fields.
+                              company net))
+       (setq val (bbdb-record-field record (eudc-bbdb-field attr))))
        (t
        (error "Unknown BBDB attribute")))
       (cond
        ((or (not val) (equal val ""))) ; do nothing
-       ((memq attr '(phones addresses))
+       ((memq attr '(phone address
+                          ;; BBDB < 3 fields.
+                          phones addresses))
        (setq eudc-rec (append val eudc-rec)))
        ((and (listp val)
             (= 1 (length val)))