bbdb-vcard.el

;;; bbdb-vcard.el -- snarf vcard data into bbdb
;;; $Id: bbdb-vcard.el,v 1.10 2001/12/29 16:12:20 chrisb Exp $
;;; Time-stamp: <Last modified: Sat Dec 29 11:10:15 EST 2001>

;; Copyright (C) 2001 Chris Beggy

;; Author: Chris Beggy <chrisb@kippona.com>
;; Maintainer: Chris Beggy <chrisb@kippona.com>
;; Adapted by:
;; Created: 20 Nov 2001
;; Version: 0.1
;; Keywords: vcard, bbdb
;;

;; This program is not part of EMACS or BBDB

;; This program 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 of
;; the License, or (at your option) any later version.

;; This program 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 this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA

;;; Commentary: Take vcard input and convert to a bbdb entry, tested with
;;;             a few cases of version 2.1 vcard.
;;  2001-12-21 using latest vcard.el from Noah's site
;;;
;;{{{ Code: 

(require 'vcard) ;; thanks Noah!
(require 'bbdb)

(defun bbdb-vcard-phonevec (vlist)
  "create a bbdb type phone vector VPHONEDO from a LIST generated by 
vcard's `vcard-values'. This function is called by 
bbdb-vcard-snarf and bbdb-vcard-format-entry.
This function suffers from shortcomings in vcard-values \"tel\"
test case with two entries where only one has a subkey fails
     tel:
     tel\;home:"
(let* (phonedo)
  (dolist (item vlist phonedo)
     (setq phonedo (cons (vector  "phone" (car item)) phonedo))))
)

;;(bbdb-vcard-phonevec (vcard-values (vcard-parse-string vstring) (list "tel")))  

(defun bbdb-vcard-addrvec (vlist)
"create a bbdb type address vector VADDRVEC from a 
LIST generated by vcard's `vcard-values'. This function is called by 
bbdb-vcard-snarf and bbdb-vcard-format-entry"
  (let* (vaddrdo)
;;     (setq vvlist (if (listp (car vlist)) ; handle the case of a single number
;;                    vlist 
;;                    (list (cons "address" vlist))))
     (dolist (item vlist vaddrdo)
	 (let* ((loca (car item))
          (workingaddy (nreverse item))
	 (country (car workingaddy))
	 (zip (car (cdr workingaddy)))
	 (state (car (nthcdr 2 workingaddy)))
	 (city (car (nthcdr 3 workingaddy)))
	 (lines (nreverse (nthcdr 4 workingaddy)))
	 (vaddr (make-vector bbdb-address-length nil))
          )
         (bbdb-address-set-location vaddr loca) 
         (bbdb-address-set-city vaddr (or city ""))
         (bbdb-address-set-state vaddr (or state ""))
         (bbdb-address-set-zip vaddr (or zip ""))
         (bbdb-address-set-country vaddr (or country ""))
         (bbdb-address-set-streets vaddr lines)
         (setq vaddrdo (cons vaddr vaddrdo)))))
)

(defun bbdb-vcard-format-entry (vstring)
  "Takes vcard style argument and returns a list suitable for input to 
bbdb-create-internal, which needs arguments of the form:
bbdb-create-internal NAME COMPANY NET ADDRS PHONES NOTES" 
  (let* ((vname (vcard-values (vcard-parse-string vstring) "fn"))
	 (vorg (concat (car (vcard-values (vcard-parse-string vstring) "org"))
		       (car (cdr (vcard-values (vcard-parse-string vstring) "org")))))
	 (vemail (car (cdr (vcard-values (vcard-parse-string vstring) "email"))))
	 (phoneref (vcard-values (vcard-parse-string vstring) "tel" )) 
         (vphone (bbdb-vcard-phonevec phoneref))
         (vaddr (vcard-values (vcard-parse-string vstring) "adr" ))
         (vaddr2 (bbdb-vcard-addrvec vaddr))
      )
      (list vname vorg vemail vaddr2 vphone "")
    )
  )

(defun bbdb-vcard-snarf (vstring)
  "snarf vcard with operation similar to bbdb-vcard-format-entry
and insert the record into the bbdb with bbdb-create-internal"
  (let* ((vname (car (car (vcard-values (vcard-parse-string vstring) (list "fn") ))))
          (vorg (concat (car (car (vcard-values (vcard-parse-string vstring) (list "org"))))
                  " "
                (car (cdr (car (vcard-values (vcard-parse-string vstring) (list "org")))))))
         (vemail (car (car (vcard-values (vcard-parse-string vstring) (list "email")))))
 	 (phoneref (vcard-values (vcard-parse-string vstring) (list "tel")))
          (vphone (bbdb-vcard-phonevec phoneref))
;;          (vphone (bbdb-vcard-phonevec (vcard-values (vcard-parse-string vstring) (list "tel"))))
;;          (vaddr (car (vcard-values (vcard-parse-string vstring) (list "adr"))))
;;          (vaddr2 (bbdb-vcard-addrvec vaddr))
      )
;;      (bbdb-create-internal  vname vorg vemail vaddr2 vphone nil)
      (bbdb-create-internal  vname vorg vemail nil vphone nil)
      )
  )

(defun bbdb-vcard-snarf-region (begin end)
  "convert vcard information in a region to a bbdb entry tested and seems to work"
  (interactive "r")
  (setq  text (buffer-substring begin end))
  (bbdb-vcard-snarf text)
  )

(defun bbdb-vcard-snarf-buf (buf )
  "convert first vcard in a buffer to a bbdb entry. Doesn't seem to work yet."
  (interactive "b")
  (mark-whole-buffer)
  (bbdb-vcard-snarf-region (point-min point-max))
  )

;;}}}
;; for testing
;; (setq vstring (concat "begin:vcard 
;; n:Maldonado;Rene 
;; tel;work:717-555-1212
;; x-mozilla-html:FALSE
;; org:Telefonos del Noroeste;Sistemas
;; adr:1 Oak Lane;;Tijuana;Baja California;22000;Mexico
;; adr;home:2 Oak Lane;;Tijuana;Baja California;22000;Mexico
;; version:2.1
;; email;internet:remal@telnor.com
;; title:Ing. Computacion
;; fn:Rene Maldonado
;; end:vcard"))

;; tel;home:717-555-1213


;; bbdb-vcard.el ends here
;; (bbdb-vcard-snarf vstring)
;; (vcard-parse-string vstring)
;; (car (car (vcard-values (vcard-parse-string vstring) (list "fn"))))
;; (car( car (vcard-values (vcard-parse-string vstring) (list "tel"))))
;; (vcard-values (vcard-parse-string vstring) (list "adr"))
;; (concat (car (car (vcard-values (vcard-parse-string vstring) (list "org"))))
;;         " "
;;         (car (cdr (car (vcard-values (vcard-parse-string vstring) (list "org")))))
;;  )
;; (bbdb-vcard-phonevec (vcard-values (vcard-parse-string vstring) (list "tel")))