-
Notifications
You must be signed in to change notification settings - Fork 3
/
bbdb-vcard.el
161 lines (142 loc) · 6.16 KB
/
bbdb-vcard.el
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
;;; 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")))