Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 235 lines (234 sloc) 19.62 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
;;; bbdb-vcard-export.el -- export BBDB as vCard files
;;
;; Copyright (c) 2002 Jim Hourihan
;; Copyright (c) 2005 Alex Schroeder
;;
;; bbdb-vcard-export.el 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.
;;
;; This software 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, 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;; Author: Jim Hourihan <jimh@panix.com>
;; Created: 2002-08-08
;; Version: $Id: bbdb-vcard-export.el,v 1.3 2006/03/14 00:00:00 malcolmp Exp $
;; Keywords: vcard ipod

;;; Commentary

;; I use this code to sync my ipod with bbdb under OS X. To do so:
;;
;; M-x bbdb-vcard-export-update-all
;;
;; and enter `/Volumes/IPOD_NAME/Contacts/' at the prompt
;;
;; vCard documentated in RFC 2426 <http://www.faqs.org/rfcs/rfc2426.html>
;; Value types documented in RFC 2425 <http://www.faqs.org/rfcs/rfc2425.html>

;; The coding system used for writing the files is UTF-16 by default.
;; To use anything else, use a prefix argument: C-u M-x
;; bbdb-vcard-export-update-all. You will be prompted for another
;; coding system to use. Latin-1 is probably a good choice.
;; bbdb-file-coding-system's default value is iso-2022-7bit, which is
;; probably useless for vCard exports.

;;; Code:

(require 'bbdb)

; XEmacs prior to 21.5 is not dumped with replace-regexp-in-string. In those
; cases it can be found in the xemacs-base package.
(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)))

;; 2.3 Predefined VALUE Type Usage

;; The predefined data type values specified in [MIME-DIR] MUST NOT be
;; repeated in COMMA separated value lists except within the N,
;; NICKNAME, ADR and CATEGORIES value types.

;; The text value type defined in [MIME-DIR] is further restricted such
;; that any SEMI-COLON character (ASCII decimal 59) in the value MUST be
;; escaped with the BACKSLASH character (ASCII decimal 92).

(defun bbdb-vcard-export-escape (str)
  "Return a copy of STR with ; , and newlines escaped."
  (setq str (bbdb-translate str)
        str (or str ""); get rid of nil values
        str (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str)
        str (replace-regexp-in-string "\n" "\\\\n" str)))

;; (insert (bbdb-vcard-export-escape "this is, not \\ or \n true"))

(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)
    (mapconcat 'identity result ",")))

;; The component values MUST be specified in
;; their corresponding position. The structured type value corresponds,
;; in sequence, to the post office box; the extended address; the street
;; address; the locality (e.g., city); the region (e.g., state or
;; province); the postal code; the country name. When a component value
;; is missing, the associated component separator MUST still be
;; specified.

;; The text components are separated by the SEMI-COLON character (ASCII
;; decimal 59). Where it makes semantic sense, individual text
;; components can include multiple text values (e.g., a "street"
;; component with multiple lines) separated by the COMMA character
;; (ASCII decimal 44).
(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-postcode address)))
    (concat
     "adr;type=" (bbdb-vcard-export-escape (bbdb-address-label 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 (car (bbdb-record-organization record)))
        (notes (bbdb-record-note record 'note))
        (phones (bbdb-record-phone record))
        (addresses (bbdb-record-address record))
        (net (bbdb-record-mail record))
        (categories (bbdb-record-note record 'category)))
    (insert "begin:vcard\n"
            "version:3.0\n")
    ;; Specify the formatted text corresponding to the name of the
    ;; object the vCard represents. The property MUST be present in
    ;; the vCard object.
    (insert "fn:" (bbdb-vcard-export-escape name) "\n")
    ;; Family Name, Given Name, Additional Names, Honorific
    ;; Prefixes, and Honorific Suffixes
    (when (or last-name first-name)
      (insert "n:"
              (bbdb-vcard-export-escape last-name) ";"
              (bbdb-vcard-export-escape first-name) ";;;\n"))
    ;; Nickname of the object the vCard represents. One or more text
    ;; values separated by a COMMA character (ASCII decimal 44).
    (when aka
      (insert "nickname:" (bbdb-vcard-export-several aka) "\n"))
    ;; FIXME: use face attribute for this one.
    ;; PHOTO;ENCODING=b;TYPE=JPEG:MIICajCCAdOgAwIBAgICBEUwDQYJKoZIhvcN
    ;; AQEEBQAwdzELMAkGA1UEBhMCVVMxLDAqBgNVBAoTI05ldHNjYXBlIENvbW11bm
    ;; ljYXRpb25zIENvcnBvcmF0aW9uMRwwGgYDVQQLExNJbmZvcm1hdGlvbiBTeXN0

    ;; FIXME: use birthday attribute if there is one.
    ;; BDAY:1996-04-15
    ;; BDAY:1953-10-15T23:10:00Z
    ;; BDAY:1987-09-27T08:30:00-06:00

    ;; A single structured text value consisting of components
    ;; separated the SEMI-COLON character (ASCII decimal 59). But
    ;; BBDB doesn't use this. So there's just one level:
    (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;type=" (bbdb-vcard-export-escape (bbdb-phone-label 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;type=internet:" (bbdb-vcard-export-escape mail) "\n"))
    ;; Use CATEGORIES based on mail-alias. One or more text values
    ;; separated by a COMMA character (ASCII decimal 44).
    (when categories
      (insert "categories:"
              (mapconcat 'identity
                         (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)

;;; bbdb-vcard-export.el ends here
Something went wrong with that request. Please try again.