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
235
236
237
238
|
;;; 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
;; 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)
(bbdb-join 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-zip address)))
(concat
"adr;type=" (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")
;; 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-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;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:"
(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"
(let ((buffer (get-buffer-create "*bbdb-vcard-export*")))
(save-excursion
(set-buffer buffer)
(kill-region (point-min) (point-max))
(bbdb-vcard-export-record-insert-vcard record)
(write-region (point-min) (point-max) vcard-name))
(kill-buffer buffer)))
(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
|
