(require 'eudc)
(if (not (featurep 'bbdb))
(load-library "bbdb"))
(if (not (featurep 'bbdb-com))
(load-library "bbdb-com"))
(defun eudc-create-bbdb-record (record &optional silent)
"Create a BBDB record using the RECORD alist.
RECORD is an alist of (KEY . VALUE) where KEY is a directory attribute name
symbol and VALUE is the corresponding value for the record.
If SILENT is non-nil then the created BBDB record is not displayed."
(eval
`(let* (,@(mapcar '(lambda (c)
(list (car c) (if (listp (cdr c))
(list 'quote (cdr c))
(cdr c))))
record)
bbdb-name
bbdb-company
bbdb-net
bbdb-address
bbdb-phones
bbdb-notes
spec
bbdb-record
value
(conversion-alist (symbol-value eudc-bbdb-conversion-alist)))
(setq bbdb-name (eudc-parse-spec (cdr (assq 'name conversion-alist)) record nil)
bbdb-company (eudc-parse-spec (cdr (assq 'company conversion-alist)) record nil)
bbdb-net (eudc-parse-spec (cdr (assq 'net conversion-alist)) record nil)
bbdb-notes (eudc-parse-spec (cdr (assq 'notes conversion-alist)) record nil))
(setq spec (cdr (assq 'address conversion-alist)))
(setq bbdb-address (delq nil (eudc-parse-spec (if (listp (car spec))
spec
(list spec))
record t)))
(setq spec (cdr (assq 'phone conversion-alist)))
(setq bbdb-phones (delq nil (eudc-parse-spec (if (listp (car spec))
spec
(list spec))
record t)))
(setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
(mapcar (function
(lambda (mapping)
(if (and (not (memq (car mapping)
'(name company net address phone notes)))
(setq value (eudc-parse-spec (cdr mapping) record nil)))
(cons (car mapping) value))))
conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes))
(setq bbdb-record (bbdb-create-internal bbdb-name
bbdb-company
bbdb-net
bbdb-address
bbdb-phones
bbdb-notes))
(or silent
(bbdb-display-records (list bbdb-record))))))
(defun eudc-parse-spec (spec record recurse)
"Parse the conversion SPEC using RECORD.
If RECURSE is non-nil then SPEC may be a list of atomic specs."
(cond
((or (stringp spec)
(symbolp spec)
(and (listp spec)
(symbolp (car spec))
(fboundp (car spec))))
(condition-case nil
(eval spec)
(void-variable nil)))
((and recurse
(listp spec))
(mapcar '(lambda (spec-elem)
(eudc-parse-spec spec-elem record nil))
spec))
(t
(error "Invalid specification for `%s' in `eudc-bbdb-conversion-alist'" spec))))
(defun eudc-bbdbify-address (addr location)
"Parse ADDR into a vector compatible with BBDB.
ADDR should be an address string of no more than four lines or a
list of lines.
The last two lines are searched for the zip code, city and state name.
LOCATION is used as the address location for bbdb."
(let* ((addr-components (if (listp addr)
(reverse addr)
(reverse (split-string addr "\n"))))
(last1 (pop addr-components))
(last2 (pop addr-components))
zip city state)
(setq addr-components (nreverse addr-components))
(if (not (string-match "[0-9][0-9][0-9]" last1))
(progn
(setq state last1)
(if (string-match "\\([0-9]+\\)[ \t]+\\(.*\\)" last2)
(setq city (match-string 2 last2)
zip (string-to-number (match-string 1 last2)))
(error "Cannot parse the address")))
(cond
((string-match "\\(\\w+\\)\\W*\\([A-Z][A-Z]\\)\\W*\\([0-9]+\\)" last1)
(setq city (match-string 1 last1)
state (match-string 2 last1)
zip (string-to-number (match-string 3 last1))))
((string-match "\\([0-9]+\\)[ \t]+\\(.*\\)" last1)
(setq city (match-string 2 last1)
zip (string-to-number (match-string 1 last1))))
(t
(error "Cannot parse the address"))))
(vector location
(or (nth 0 addr-components) "")
(or (nth 1 addr-components) "")
(or (nth 2 addr-components) "")
(or city "")
(or state "")
zip)))
(defun eudc-bbdbify-phone (phone location)
"Parse PHONE into a vector compatible with BBDB.
PHONE is either a string supposedly containing a phone number or
a list of such strings which are concatenated.
LOCATION is used as the phone location for BBDB."
(cond
((stringp phone)
(let (phone-list)
(condition-case err
(setq phone-list (bbdb-parse-phone-number phone))
(error
(if (string= "phone number unparsable." (eudc-cadr err))
(if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone)))
(error "Phone number unparsable")
(setq phone-list (list (bbdb-string-trim phone))))
(signal (car err) (cdr err)))))
(if (= 3 (length phone-list))
(setq phone-list (append phone-list '(nil))))
(apply 'vector location phone-list)))
((listp phone)
(vector location (mapconcat 'identity phone ", ")))
(t
(error "Invalid phone specification"))))
(defun eudc-batch-export-records-to-bbdb ()
"Insert all the records returned by a directory query into BBDB."
(interactive)
(goto-char (point-min))
(let ((nbrec 0)
record)
(while (eudc-move-to-next-record)
(and (overlays-at (point))
(setq record (overlay-get (car (overlays-at (point))) 'eudc-record))
(1+ nbrec)
(eudc-create-bbdb-record record t)))
(message "%d records imported into BBDB" nbrec)))
(defun eudc-insert-record-at-point-into-bbdb ()
"Insert record at point into the BBDB database.
This function can only be called from a directory query result buffer."
(interactive)
(let ((record (and (overlays-at (point))
(overlay-get (car (overlays-at (point))) 'eudc-record))))
(if (null record)
(error "Point is not over a record")
(eudc-create-bbdb-record record))))
(defun eudc-try-bbdb-insert ()
"Call `eudc-insert-record-at-point-into-bbdb' if on a record."
(interactive)
(and (or (featurep 'bbdb)
(prog1 (locate-library "bbdb") (message "")))
(overlays-at (point))
(overlay-get (car (overlays-at (point))) 'eudc-record)
(eudc-insert-record-at-point-into-bbdb)))