diff options
Diffstat (limited to 'bits/bbdb-vcard-export.el')
| -rw-r--r-- | bits/bbdb-vcard-export.el | 238 |
1 files changed, 0 insertions, 238 deletions
diff --git a/bits/bbdb-vcard-export.el b/bits/bbdb-vcard-export.el deleted file mode 100644 index afb7191..0000000 --- a/bits/bbdb-vcard-export.el +++ /dev/null @@ -1,238 +0,0 @@ -;;; 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 |