Download
(require 'bbdb)
(eval-and-compile
(if (and (not (fboundp 'replace-regexp-in-string)) (featurep 'xemacs))
(require 'easy-mmode)))
(defvar bbdb-translation-table
'(("Mobile" . "Cell"))
"Translations of text items, typically for labels.")
(defun bbdb-translate (str)
"Translate STR into some other string based on `bbdb-translation-table'."
(let ((translation (assoc str bbdb-translation-table)))
(if translation
(cdr translation)
str)))
(defun bbdb-vcard-export-escape (str)
"Return a copy of STR with
(setq str (bbdb-translate str)
str (or str "")
str (replace-regexp-in-string "\\( "\\\\\\1" str)
str (replace-regexp-in-string "\n" "\\\\n" str)))
(defun bbdb-vcard-export-several (list)
"Return a comma-separated list of escaped unique elements in LIST."
(let ((hash (make-hash-table :test 'equal))
result)
(dolist (item list)
(puthash (bbdb-vcard-export-escape item) t hash))
(maphash (lambda (key val)
(setq result (cons key result)))
hash)
(bbdb-join result ",")))
(defun bbdb-vcard-export-address-string (address)
"Return the address string"
(let ((streets (bbdb-address-streets address))
(city (bbdb-address-city address))
(state (bbdb-address-state address))
(country (bbdb-address-country address))
(zip (bbdb-address-zip address)))
(concat
"adr (bbdb-vcard-export-escape (bbdb-address-location address)) ":"
" ;; no post office box, no extended address
(bbdb-vcard-export-several streets) "
(bbdb-vcard-export-escape city) "
(bbdb-vcard-export-escape state) "
(bbdb-vcard-export-escape zip) "
(bbdb-vcard-export-escape country))))
(defun bbdb-vcard-export-record-insert-vcard (record)
"Insert a vcard formatted version of RECORD into the current buffer"
(let ((name (bbdb-record-name record))
(first-name (bbdb-record-firstname record))
(last-name (bbdb-record-lastname record))
(aka (bbdb-record-aka record))
(company (bbdb-record-company record))
(notes (bbdb-record-notes record))
(phones (bbdb-record-phones record))
(addresses (bbdb-record-addresses record))
(net (bbdb-record-net record))
(categories (bbdb-record-getprop
record
bbdb-define-all-aliases-field)))
(insert "begin:vcard\n"
"version:3.0\n")
(insert "fn:" (bbdb-vcard-export-escape name) "\n")
(when (or last-name first-name)
(insert "n:"
(bbdb-vcard-export-escape last-name) "
(bbdb-vcard-export-escape first-name) "))
(when aka
(insert "nickname:" (bbdb-vcard-export-several aka) "\n"))
(when company
(insert "org:" (bbdb-vcard-export-escape company) "\n"))
(when notes
(insert "note:" (bbdb-vcard-export-escape notes) "\n"))
(dolist (phone phones)
(insert "tel (bbdb-vcard-export-escape (bbdb-phone-location phone)) ":"
(bbdb-vcard-export-escape (bbdb-phone-string phone)) "\n"))
(dolist (address addresses)
(insert (bbdb-vcard-export-address-string address) "\n"))
(dolist (mail net)
(insert "email (bbdb-vcard-export-escape mail) "\n"))
(when categories
(insert "categories:"
(bbdb-join (mapcar 'bbdb-vcard-export-escape
(bbdb-split categories ",")) ",") "\n"))
(insert "end:vcard\n")))
(defun bbdb-vcard-export-vcard-name-from-record (record)
"Come up with a vcard name given a record"
(let ((name (bbdb-record-name record))
(first-name (elt record 0))
(last-name (elt record 1)))
(concat first-name "_" last-name ".vcf")))
(defun bbdb-vcard-export-make-vcard (record vcard-name)
"Make a record buffer and write it"
(with-temp-buffer
(bbdb-vcard-export-record-insert-vcard record)
(write-region (point-min) (point-max) vcard-name)))
(defun bbdb-vcard-do-record (record output-dir coding-system)
"Update the vcard of one bbdb record"
(setq coding-system (or coding-system 'utf-16))
(let ((coding-system-for-write coding-system))
(message "Updating %s" (bbdb-record-name record))
(bbdb-vcard-export-make-vcard
record
(concat output-dir
(bbdb-vcard-export-vcard-name-from-record record)))))
(defun bbdb-vcard-export-update-all (output-dir coding-system)
"Update the vcard Contacts directory from the bbdb database"
(interactive "DDirectory to update: \nZCoding system: ")
(bbdb ".*" nil)
(dolist (record (bbdb-records))
(bbdb-vcard-do-record record output-dir coding-system)))
(defun bbdb-vcard-export (regexp output-dir coding-system)
"Update the vcard Contacts directory from records matching REGEXP"
(interactive "sExport records matching: \nDDirectory to update: \nZCoding system: ")
(bbdb regexp nil)
(let ((notes (cons '* regexp)))
(dolist (record (bbdb-search (bbdb-records) regexp regexp regexp notes nil))
(message "Updating %s" (bbdb-record-name record))
(bbdb-vcard-do-record record output-dir coding-system))))
(defun bbdb-vcard-export-current (output-dir coding-system)
"Update the vcard of the current record"
(interactive "DDirectory to update: \nZCoding system: ")
(let ((record (bbdb-current-record nil)))
(bbdb-vcard-do-record record output-dir coding-system)))
(define-key bbdb-mode-map [(v)] 'bbdb-vcard-export-current)
(provide 'bbdb-vcard-export)