My vCard Backend for Org

Posted on December 13, 2023

Some time ago, I started using Org to manage my contacts and wrote a backend to export my contacts file to vCard, and I'm finally writing a post about it. Before I begin in earnest, I'd like to acknowledge that there's a vCard backend in Org-Contrib, but I decided against using it for a couple of reasons. And no, I don't consider Not-Invented-Here syndrome to be one of these reasons, although I have been guilty of that in the past.

Now that that's out of the way: Originally, this was just a package with a few functions to import and export contacts from vCard files which worked well. But I recently started using Org-iCalendar to export vacations and appointments from Org files and thought it would be nice if I managed my contacts using the same machinery. This is the second time I've dabbled in Org backends, and I'm always really happy when the results turn out alright. The full code is in my dotfiles1.

I decided to use Org-iCalendar as a reference, which turned out to make thing significantly easier. Org-iCalendar inherits from the ASCII backend, and I decided to do the same. As it happened, the ASCII backend provided a lot of what I needed, at least as far as I can tell:

(org-export-define-derived-backend 'vcard 'ascii
  :translate-alist '((clock . nil)
                     (footnote-definition . nil)
                     (footnote-reference . nil)
                     (headline . org-vcard-headline)
                     (inner-template . org-vcard-template)
                     (inlinetask . nil)
                     (link . org-vcard-link)
                     (paragraph . org-vcard-note)
                     (planning . nil)
                     (section . org-vcard-note)
                     (template . org-vcard-template))
  :options-alist
  '((:exclude-tags "VCARD_EXCLUDE_TAGS" nil org-vcard-exclude-tags split)
    (:vcard-date-time-format nil nil org-vcard-date-time-format)
    (:vcard-include-body nil nil org-vcard-include-body)
    (:vcard-store-UID nil nil org-vcard-store-UID))
  :filters-alist
  '((:filter-final-output . (org-vcard-clear-blank-lines
                             org-vcard-fold-string)))
  :menu-entry
  '(?v "Export to vCard"
       ((?f "Current file" org-vcard-export-to-vcard))))

Since almost everything that gets exported is headline properties, the most involved function is org-vcard-headline:

(defun org-vcard-headline (headline contents info)
  "Transcode HEADLINE element into vCard format.

HEADLINE is a headline. CONTENTS is ignored. INFO is a plist used as a
communication channel."
  (unless (org-element-property :footnote-section-p headline)
    (let ((name (split-string (org-element-property :raw-value headline) " "))
          (level (org-export-get-relative-level headline info)))
      (if (= 1 level)
          (concat "BEGIN:VCARD\n"
                  "VERSION:" org-vcard-version "\n"
                  "N:" (string-join (cdr name) " ") ";" (car name) ";;;\n"
                  "FN:" (org-element-property :raw-value headline) "\n"
                  (when-let ((id (org-element-property :ID headline)))
                    (org-vcard--thing-to-vcard "UID" id))
                  (when-let ((language (org-element-property :LANGUAGE headline)))
                    (org-vcard--thing-to-vcard "LANG" language))
                  (when-let ((adr (org-element-property :ADDRESS headline)))
                    (org-vcard--address-to-vcard adr org-vcard-default-address-type))
                  (when-let ((adr (org-element-property :HOME_ADDRESS headline)))
                    (org-vcard--address-to-vcard adr "HOME"))
                  (when-let ((adr (org-element-property :OTHER_ADDRESS headline)))
                    (org-vcard--address-to-vcard adr "OTHER"))
                  (when-let ((adr (org-element-property :WORK_ADDRESS headline)))
                    (org-vcard--address-to-vcard adr "WORK"))
                  (when-let ((email (org-element-property :EMAIL headline)))
                    (org-vcard--thing-to-vcard "EMAIL" email org-vcard-default-email-type))
                  (when-let ((email (org-element-property :OTHER_EMAIL headline)))
                    (org-vcard--thing-to-vcard "EMAIL" email "OTHER"))
                  (when-let ((email (org-element-property :PERSONAL_EMAIL headline)))
                    (org-vcard--thing-to-vcard "EMAIL" email "PERSONAL"))
                  (when-let ((email (org-element-property :WORK_EMAIL headline)))
                    (org-vcard--thing-to-vcard "EMAIL" email "WORK"))
                  (when-let ((phone (org-element-property :CELL_PHONE headline)))
                    (org-vcard--thing-to-vcard "TEL" phone "CELL"))
                  (when-let ((phone (org-element-property :HOME_PHONE headline)))
                    (org-vcard--thing-to-vcard "TEL" phone "HOME"))
                  (when-let ((phone (org-element-property :OTHER_PHONE headline)))
                    (org-vcard--thing-to-vcard "TEL" phone "OTHER"))
                  (when-let ((phone (org-element-property :PHONE headline)))
                    (org-vcard--thing-to-vcard "TEL" phone org-vcard-default-phone-type))
                  (when-let ((phone (org-element-property :WORK_PHONE headline)))
                    (org-vcard--thing-to-vcard "TEL" phone "WORK"))
                  (when-let ((geolocation (org-element-property :GEOLOCATION headline)))
                    (org-vcard--geolocation-to-vcard geolocation))
                  (when-let ((org (org-element-property :ORG headline)))
                    (org-vcard--thing-to-vcard "ORG" org))
                  (when-let ((role (org-element-property :ROLE headline)))
                    (org-vcard--thing-to-vcard "ROLE" role))
                  (when-let ((title (org-element-property :TITLE headline)))
                    (org-vcard--thing-to-vcard "TITLE" title))
                  (when-let ((url (org-element-property :WEBSITE headline)))
                    (org-vcard--thing-to-vcard "URL" url))
                  (when-let ((birthday (org-element-property :BIRTHDAY headline)))
                    (org-vcard--thing-to-vcard "BDAY" (org-format-time-string "%Y-%m-%d"
                                                                              (org-time-string-to-time birthday))))
                  (when-let ((body-length org-vcard-include-body)
                             (note-start (org-element-property :robust-begin headline))
                             (note-end (org-element-property :end headline)))
                    (when (and (numberp body-length)
                               (> (- note-end note-start) body-length))
                      (setq note-end (+ 1 note-start body-length)))
                    (org-vcard--thing-to-vcard "NOTE"
                                               contents))
                  "END:VCARD\n")
        (concat (make-string (1- level) ?-) " " (string-join name " ") " " (make-string (1- level) ?-) "\n"
                contents)))))

If the heading level is 1, then the backend runs through the rigmarole of grabbing all the property information. If the heading level is greater than 1, then it and its contents get added to the NOTE field. There's not really a standard for headings in a vCard note, so I just decided to surround the heading with a number of hyphens equal to the heading's level minus one. There may be a more succinct way to parse the properties that I haven't thought of, but I was able to make the function a little easier to parse with org-vcard--thing-to-vcard. It's pretty much a formatter:

(defun org-vcard--thing-to-vcard (thing value &optional types)
  "Create a generic vcard line where appropriate. TYPES should be a list of
strings which will comprise the 'TYPE=' component of the vCard line."
  (if types
      (when (stringp types)
        (setq types `(,types)))
    (setq types '()))
  (cond ((string= "3.0" org-vcard-version)
         (concat thing
                 (when (not (seq-empty-p types))
                   (concat ";TYPE=" (mapconcat 'identity
                                               types
                                               ",")))
                 ":"
                 value
                 "\n"))))

This function is what's actually responsible for getting the heading data into proper vCard format. As a disclaimer, I don't know much about vCard, so I looked up the specification for version 3 and designed to that since it's what my phone uses. My intention is to eventually support version 4, but I'll get to that when I need it. One thing I wasn't sure about was exactly how types for addresses, phone numbers, and emails worked, so I used what the spec listed for addresses and phone numbers. When I got to email addresses, though, something seemed off. I don't know about you, but aol and mcimail just don't seem relevant anymore. This gave me pause, and after looking at the type options on my phone's contact app and seeing that they were a bit more modern, I ran some tests and learned that my phone would let me use pretty much anything as a type for these objects, so I built a convoluted function that would accommodate that. Here's what it looked like:

(defun org-vcard--loose-properties-to-vcard (props)
  "Search through plist of Org header PROPS for properties that aren't
  rigorously defined (e.g. FOO_EMAIL) and convert to vCard string."
  (let ((props-iter props)
        output-string)
    (while props-iter
      (when-let* ((prop-name (symbol-name (car props-iter)))
                  (_ (and (symbolp (car props-iter))
                          (string-match "\\([A-Z]+\\)?_?\\(EMAIL\\|PHONE\\|ADDRESS\\)" prop-name))))
        (setq output-string (concat output-string
                                    (cond ((string= "EMAIL" (match-string 2 prop-name))
                                           (org-vcard--thing-to-vcard	"EMAIL"
                                                                      (cadr props-iter)
                                                                      `(,(or (match-string 1 prop-name)
                                                                             org-vcard-default-email-type))))
                                          ((string= "ADDRESS" (match-string 2 prop-name))
                                           (org-vcard--address-to-vcard (cadr props-iter)
                                                                        `(,(or (match-string 1 prop-name)
                                                                               org-vcard-default-address-type))))
                                          ((string= "PHONE" (match-string 2 prop-name))
                                           (org-vcard--thing-to-vcard "TEL"
                                                                      (cadr props-iter)
                                                                      `(,(or (match-string 1 prop-name)
                                                                             org-vcard-default-phone-type))))))))
      (setq props-iter (cddr props-iter)))
    output-string))

Just to reiterate, this is not a function I use anymore, I just wanted to show this wacky code. In short, I couldn't think of a better way to work with Elisp keywords. This seemed like a good, flexible solution at the time, but realistically the only person who is going to use this package is me; everyone else is going to use Org-Contrib's package. Furthermore, I will only ever use four values for any object where a type applies: HOME, PERSONAL, WORK, or OTHER. The only exception is CELL for phones (and omitting a type altogether, but that's not important here). Since those are the only scenarios I ever use, those are the ones I ended up designing for, which is what's in org-vcard-headline.

There is one other function used in org-vcard-headline, which parses addresses to vCard:

(defun org-vcard--address-to-vcard (adr &optional types)
  "Export an address to vCard according to 'org-vcard-version'. TYPES should be
a list of strings which will comprise the 'TYPE=' component of the vCard line."
  (when (string-match (concat "\\("
                              "\\(PO Box [0-9]+\\)"
                              "\\|"
                              "\\([0-9]+\s[A-Za-z0-9\.\s]+?\\)\s?"
                              "\\(\\(Apt\.?\s\\|# ?\\|Rm ?#?\\)[A-Z0-9]+\\)?"
                              "\\),\s"
                              "\\([A-Za-z\.\s]+\\),\s"
                              "\\([A-Z]+\\)\s?"
                              "\\([0-9]+\\)?\s?"
                              "\\([A-Z]+\\)?")
                      adr)
    (let ((po-box (match-string 2 adr))
          (street (match-string 3 adr))
          (ext (match-string 4 adr))
          (locality (match-string 6 adr))
          (region (match-string 7 adr))
          (postal (match-string 8 adr))
          (country (match-string 9 adr)))
      (when (and country
                 (not (string= org-vcard-domestic-country
                               country)))
        (if types
            (push "intl" types)
          (setq types '("intl"))))
      (cond ((string= "3.0" org-vcard-version)
             (org-vcard--thing-to-vcard "ADR"
                                        (concat po-box
                                                ";"
                                                street
                                                ";"
                                                ext
                                                ";"
                                                locality
                                                ";"
                                                region
                                                ";"
                                                postal
                                                ";"
                                                country)
                                        types))))))

This is essentially a wrapper around org-vcard--thing-to-vcard that uses a regular expression to parse the address, check if it's international, and spit out a vCard string. I don't have any international addresses currently, but I travel enough that I figure eventually I'm going to add a contact with one.

Going back to the backend definition, the only other translation is org-vcard-link, which simply replaces a link with its display text (or the URL if the link has no display text) wrapped in square brackets:

(defun org-vcard-link (link contents _info)
  "Return a link"
  (if contents
      (concat "[" contents "]")
    (when-let ((raw (org-element-property :raw-link link)))
      (concat "[" raw "]"))))

There are two other functions used in the translation process: org-vcard-note and org-vcard-template. These functions just pass the contents of the object down the pipeline. It took some trial and error to figure out which functions in the ASCII backend needed to be overridden, but I got there eventually. The only reason I have two functions for this is because Org's export machinery passes two arguments to functions translating templates and three arguments to just about everything else.

Aside from translations, the only things I added are a some options and a couple filters. The options are for date format, ignoring headline body if no notes are desired, and a UID storing mechanism that is only relevant for vCard version 4. As far as filters go, the first is self-explanatory, it simply removes any blank lines in the output:

(defun org-vcard-clear-blank-lines (text _backend _info)
  "Remove blank lines in TEXT.
HEADLINE is a string representing a transcoded headline.
BACKEND and INFO are ignored."
  (replace-regexp-in-string "^\\(?:[ \t]*\n\\)+" "" text))

I think this filter could be removed if I went through the ASCII backend and overrode the functions responsible for them; I might look into that later. The second filter is used to keep lines the proper length:

(defun org-vcard-fold-string (text _backend _info)
  "Fold string S according to vCard specification."
  (mapconcat
   (lambda (line)
     ;; Limit each line to a maximum of 75 characters.  If it is
     ;; longer, fold it by using "\r\n " as a continuation marker.
     (let ((len (length line)))
       (if (<= len 75)
           line
         (let ((folded-line (substring line 0 74))
               (chunk-start 74)
               chunk-end)
           ;; Since continuation marker takes up one character on the
           ;; line and the space takes up another, real contents must
           ;; be split at 73 chars.
           (while (< (setq chunk-end (+ chunk-start 73)) len)
             (setq folded-line
                   (concat folded-line "\r\n "
                           (substring line chunk-start chunk-end))
                   chunk-start chunk-end))
           (concat folded-line "\r\n " (substring line chunk-start))))))
   (org-split-string text "\n") "\n"))

According to vCard spec, lines can't be longer than 75 characters, and continuations are demarcated by a carriage return and line feed where a line is truncated as well as a space indenting any continuation lines.

That pretty much wraps up the exporter. In the end, it's just over 350 lines of formatted code, but practically it's significantly less than that which isn't bad for an export backend!

With the exporter out of the way, it was time to get to the fun part2: figuring out ways to use my new contacts file! Admittedly, I only had two real use cases I was initially considering. The first was a helper to pull in a contact's name and email from my contact list, so I could put it in the recipient line in an email. This was my first stab:

(defun org-contacts-select-email ()
  "Select a contact name and email to be added to address line of message."
  (interactive)
  (let ((contacts))
    (with-temp-buffer
      (insert-file-contents org-contacts-file)
      (org-mode)
      (org-element-map (org-element-parse-buffer 'headline)
          'headline
        (lambda (headline)
          (when-let (email (org-element-property :EMAIL headline))
            (push (format "%s <%s>" (org-element-property :raw-value headline) email) contacts))
          (when-let (email (org-element-property :WORK_EMAIL headline))
            (push (format "%s <%s>" (org-element-property :raw-value headline) email) contacts)))))
    (insert (completing-read "Select contact: " contacts))))

Yes, there is also a package that takes care of this, and probably provides a more elegant solution than just inserting a formatted string at point, but I don't necessarily need a sophisticated solution for something I don't do very frequently, and this function is like fifteen lines of code. I'm not one to pull in a package for that. But also, conjuring my own workflows is fun, engaging, and rewarding.

The second use case is adding links to contacts into other Org documents. Specifically, I was thinking about adding contacts to projects involving contractors I need to communicate with regularly, but it would also be nice to keep track of who gives me a recipe, who's going on a trip with me, who's involved in a to-do I'm trying to take care of, etc. This function is slightly more convoluted, because I wanted the completion list to be names, not org links:

(defun org-contacts-get-org-link-to-contact ()
  "Insert a link to an org contact at point."
  (interactive)
  (let (contact-dict)
    (with-temp-buffer
      (insert-file-contents org-contacts-file)
      (org-mode)
      (org-element-map (org-element-parse-buffer 'headline)
          'headline
        (lambda (headline)
          (let ((name (org-element-property :raw-value headline)))
            (push (cons name (concat "[[file:"
                                     org-contacts-file
                                     "::*"
                                     name
                                     "]["
                                     name
                                     "]]"))
                  contact-dict)))))
    (insert (cdr (assoc (completing-read "Select contact: "
                                         (mapcar 'car contact-dict))
                        contact-dict)))))

I say slightly more convoluted, but without formatting this function is maybe ten lines of code. I use this function surprisingly often, so it's been a great return on investment. Although, the return is less great when you factor in creating an export backend for the contact file, but I'm ignoring that because I could have just relied on Org-Contrib.

You can call it a huge yak-shave, but it's stuff like this that really keeps me motivated to continue building things out, which in turn helps me form real-life personal improvement habits around the code I'm writing; habits that I am unable to form otherwise, no matter how hard I try. I cannot exercise consistently to save my life (which isn't even an exaggeration), I can't keep my house clean, and I still can't shop for groceries consistently in spite of my cool Org package I wrote for it3. Emacs can't fix my inability to adopt structure, but there's a dopamine hit that I get from these projects which keeps me wanting to try. There's a positivity machine at work here, and I've found those are hard to come by! Learning a little more about Elisp and the intricacies and arcana of Org's export system, Feeling empowered to build a tool that's useful to me, appreciating the tools I make by using them frequently, and contemplating how to use these tools in new contexts down the road all work together to bestow a feeling that's almost as good as flow4. Sure, it's a yak-shave, but sometimes shaving yaks is good for the soul!

Footnotes

1Andrew Burch, "Dotfiles", Gitlab, accessed December 09, 2023. https://gitlab.com/AblatedSprocket/dotfiles/-/blob/main/emacs/lisp/ox-vcard.el.
2But honestly, building Org exporter backends is kind of a blast. They're empowering to code, and it's gratifying when I use them every day.
3Andrew Burch, "Org and Groceries", Nothing is Simple, accessed December 10, 2023. https://nothingissimple.ablatedsprocket.com/posts/org-and-groceries.html.
4"Flow (psychology)", Wikipedia, accessed December 09, 2023. https://en.wikipedia.org/wiki/Flow_(psychology).