[O] Creating a new contacts style for org-vcard [was: Re: ANN: org-vcard. ...]

[Alexis]

Feng Shu wrote:

> Is this "tree" style possible?

> #+begin-comment
> * People
> ** Joan Smith
> :PROPERTIES:
> :KIND: individual
> :FIELDTYPE: name
> :END:
> *** Cell
> :PROPERTIES:
> :FIELDTYPE: cells-folder
> :END:
> **** 0000 999 991
> **** 0000 999 992
> **** 0000 999 993
> **** 0000 999 994
> **** 0000 999 995
> *** Email 
> :PROPERTIES:
> :FIELDTYPE: emails-folder
> :END:
> **** address@hidden
> **** address@hidden
> **** address@hidden
> **** address@hidden
> **** address@hidden

> #+end-comment

Here's what i've come up with. :-)

(a) Please make sure you have the latest version of org-vcard
installed!

(b) For clarity, i've made use of the `s-repeat` function from the
`s` library; if you don't already have it installed, you can install it
from MELPA or Marmalade.

(c) Assuming you've installed org-vcard from MELPA, copy the 'tree'
folder from the elpa/org-vcard-[date]/styles/ folder to the
~/.emacs.d/org-vcard-styles/ folder; the latter should already have been
created for you automatically. Then rename:

~/.emacs.d/org-vcard-styles/tree

to

~/.emacs.d/org-vcard-styles/fengshu

(d) Open the file:

~/.emacs.d/org-vcard-styles/fengshu/functions.el

Delete its entire contents, and replace it with the text between the
BEGIN and END markers:

--- BEGIN ---
(defun org-vcard-export-from-fengshu (source destination)
  "Export fengshu-style SOURCE to vCard format, sending output
to DESTINATION.

SOURCE must be \"buffer\", \"region\" or \"subtree\".
DESTINATION must be either \"buffer\" or \"file\"."
  (let* ((in-contact-entry nil)
         (fengshu-style-properties
          (or (cadr (assoc org-vcard-active-version
                           (cadr (assoc org-vcard-active-language
                                        (cadr (assoc "fengshu" 
org-vcard-styles-languages-mappings))))))
              (error "No mapping available for specified vCard version")))
         (encoding (cond
                    ((string= "4.0" org-vcard-active-version) 'utf-8)
                    ((string= "3.0" org-vcard-active-version) 'utf-8)
                    ((string= "2.1" org-vcard-active-version) 'us-ascii)))
         (output (encode-coding-string "" encoding)))
    (if (not (member source '("buffer" "region" "subtree")))
        (error "Invalid source type"))
    (save-excursion
      (let ((search-result nil))
        (cond
         ((string= "region" source)
          (narrow-to-region (region-beginning) (region-end)))
         ((string= "subtree" source)
          (org-narrow-to-subtree)))
        (goto-char (point-min))
        (setq case-fold-search t)
        (while (re-search-forward "\\s *:FIELDTYPE:\\s *name" nil t)
          (let ((content (concat (org-vcard-export-line "BEGIN:VCARD" "" t)
                                 (org-vcard-export-line "VERSION" 
org-vcard-active-version)))
                (end-vcard nil))
            (setq content (concat content
                                  (org-vcard-export-line "FN" (org-get-heading 
t t))))
            (if (or (string= "3.0" org-vcard-active-version)
                   (string= "2.1" org-vcard-active-version))
                (setq content (concat content
                                      (org-vcard-export-line "N" ""))))
            (while (and (setq search-result (re-search-forward "\\s 
*:FIELDTYPE:\\s *\\(\\(?:\\w\\|-\\)+\\)" nil t))
                      (not end-vcard))
              (let ((fieldtype (match-string 1)))
                (if (not (string= "name" (downcase fieldtype)))
                    ;; BEGIN main changes
                    (if (or (string= "cell" (downcase fieldtype))
                           (string= "email" (downcase fieldtype)))
                        (let ((done nil)
                              (heading-levels (let ((l nil)
                                                    (n (1+ 
(org-current-level))))
                                                (while (> n 0)
                                                  (setq l (append l 
`(,(s-repeat n "\\*"))))
                                                  (setq n (1- n)))
                                                l)))
                          (while (and (not done)
                                  (re-search-forward (concat (nth 0 
heading-levels) " +\\([^\n]+\\)\n") nil t))
                            (setq content (concat content
                                                  (org-vcard-export-line
                                                   (cdr (assoc (downcase 
fieldtype) fengshu-style-properties))
                                                   (match-string 1))))
                            (dolist (level (cdr heading-levels))
                              (if (or (looking-at (concat level " +"))
                                     (looking-at "^ +$")
                                     (looking-at "^$"))
                                  (setq done t)))))
                      ;; END main changes
                      (setq content (concat content
                                            (org-vcard-export-line
                                             (cdr (assoc (downcase fieldtype) 
fengshu-style-properties))
                                             (org-get-heading t t)))))
                  (setq end-vcard t))))
            (setq content (concat content
                                  (org-vcard-export-line "END:VCARD" "" t)))
            (setq output (concat output content)))
          (if search-result
              (re-search-backward "\\s *:FIELDTYPE:\\s *name")))
        (org-vcard-write-to-destination output destination)
        (cond
         ((string= "buffer" destination)
          (message "Exported contacts data to *org-vcard-export* buffer."))
         ((string= "file" destination)
          (message "Exported contacts data to file.")))))))


(defun org-vcard-import-to-fengshu (source destination)
  ;; 
)
--- END ---

Save the file.

The org-vcard-import-to-fengshu function is deliberately left as a stub;
i'm just wanting to give an overall idea of how one can create new
org-vcard style functionality. Most of the definition of
org-vcard-export-from-fengshu comes from org-vcard-export-from-tree -
i've marked the section where the former differs substantially from the
latter.

(e) Run the command `org-vcard-reload-styles`.

(f) Open your example content in a buffer. You'll need to change the
FIELDTYPEs from "cells-folder" and "emails-folder" to "cell" and
"email", respectively, due to how org-vcard's property-mapping system
works. You'll also need to make sure that there's a newline after the
fifth instance of "address@hidden"; my code doesn't address the case
where there's no such final newline.

(g) Either run the `org-vcard-export` command with source "buffer",
destination "buffer", style "fengshu", language "en" and version "4.0";
or enable org-vcard-mode and select the corresponding items from the
Org-vCard menu.

(h) Hopefully, the result should now be available in the
"*org-vcard-export*" buffer. :-)

Please let me know if you have any questions!


Alexis.