[Emacs-diffs] Changes to emacs/lisp/net/eudc-export.el [lexbind]

[Miles Bader]

Index: emacs/lisp/net/eudc-export.el
diff -c /dev/null emacs/lisp/net/eudc-export.el:1.5.4.1
*** /dev/null   Tue Oct 14 19:39:49 2003
--- emacs/lisp/net/eudc-export.el       Tue Oct 14 19:39:26 2003
***************
*** 0 ****
--- 1,219 ----
+ ;;; eudc-export.el --- functions to export EUDC query results
+ 
+ ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
+ 
+ ;; Author: Oscar Figueiredo <address@hidden>
+ ;; Maintainer: Pavel Janík <address@hidden>
+ ;; Keywords: comm
+ 
+ ;; 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:
+ 
+ ;;; Usage:
+ ;;    See the corresponding info file
+ 
+ ;;; Code:
+ 
+ (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."
+   ;; This function runs in a special context where lisp symbols corresponding
+   ;; to field names in record are bound to the corresponding values
+   (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)))
+ 
+       ;; BBDB standard fields
+       (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)))
+       ;; BBDB custom fields
+       (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 containing the zip code the last line is supposed to contain a
+     ;; country name and the addres is supposed to be in european style
+     (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
+        ;; American style
+        ((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))))
+        ;; European style
+        ((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)))
+ 
+ ;;;###autoload
+ (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))))
+ 
+ ;;;###autoload
+ (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)))
+ 
+ ;;; arch-tag: 8cbda7dc-3163-47e6-921c-6ec5083df2d7
+ ;;; eudc-export.el ends here