contrib/lisp/org-mac-iCal.el

   1 ;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
   2
   3 ;; Copyright (C) 2009-2014 Christopher Suckling
   4
   5 ;; Author: Christopher Suckling <suckling at gmail dot com>
   6 ;; Version: 0.1057.104
   7 ;; Keywords: outlines, calendar
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; This program is Free Software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  18 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  19 ;; for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; This file provides the import of events from Mac OS X 10.5 iCal.app
  27 ;; into the Emacs diary (it is not compatible with OS X < 10.5). The
  28 ;; function org-mac-iCal will import events in all checked iCal.app
  29 ;; calendars for the date range org-mac-iCal-range months, centered
  30 ;; around the current date.
  31 ;;
  32 ;; CAVEAT: This function is destructive; it will overwrite the current
  33 ;; contents of the Emacs diary.
  34 ;;
  35 ;; Installation: add (require 'org-mac-iCal) to your .emacs.
  36 ;;
  37 ;; If you view Emacs diary entries in org-agenda, the following hook
  38 ;; will ensure that all-day events are not orphaned below TODO items
  39 ;; and that any supplementary fields to events (e.g. Location) are
  40 ;; grouped with their parent event
  41 ;;
  42 ;; (add-hook 'org-agenda-cleanup-fancy-diary-hook
  43 ;;        (lambda ()
  44 ;;          (goto-char (point-min))
  45 ;;          (save-excursion
  46 ;;            (while (re-search-forward "^[a-z]" nil t)
  47 ;;              (goto-char (match-beginning 0))
  48 ;;              (insert "0:00-24:00 ")))
  49 ;;          (while (re-search-forward "^ [a-z]" nil t)
  50 ;;            (goto-char (match-beginning 0))
  51 ;;            (save-excursion
  52 ;;              (re-search-backward "^[0-9]+:[0-9]+-[0-9]+:[0-9]+ " nil t))
  53 ;;            (insert (match-string 0)))))
  54
  55 ;;; Code:
  56
  57 (defcustom org-mac-iCal-range 2
  58   "The range in months to import iCal.app entries into the Emacs
  59 diary. The import is centered around today's date; thus a value
  60 of 2 imports entries for one month before and one month after
  61 today's date"
  62   :group 'org-time
  63   :type 'integer)
  64
  65 (defun org-mac-iCal ()
  66   "Selects checked calendars in iCal.app and imports them into
  67 the the Emacs diary"
  68   (interactive)
  69
  70   ;; kill diary buffers then empty diary files to avoid duplicates
  71   (setq currentBuffer (buffer-name))
  72   (setq openBuffers (mapcar (function buffer-name) (buffer-list)))
  73   (omi-kill-diary-buffer openBuffers)
  74   (with-temp-buffer
  75     (insert-file-contents diary-file)
  76     (delete-region (point-min) (point-max))
  77     (write-region (point-min) (point-max) diary-file))
  78
  79   ;; determine available calendars
  80   (setq caldav-folders (directory-files "~/Library/Calendars" 1 ".*caldav$"))
  81   (setq caldav-calendars nil)
  82   (mapc
  83      (lambda (x)
  84        (setq caldav-calendars (nconc caldav-calendars (directory-files x 1 ".*calendar$"))))
  85      caldav-folders)
  86
  87   (setq local-calendars nil)
  88   (setq local-calendars (directory-files "~/Library/Calendars" 1 ".*calendar$"))
  89
  90   (setq all-calendars (append caldav-calendars local-calendars))
  91
  92   ;; parse each calendar's Info.plist to see if calendar is checked in iCal
  93   (setq all-calendars (delq 'nil (mapcar
  94                                     (lambda (x)
  95                                       (omi-checked x))
  96                                     all-calendars)))
  97
  98   ;; for each calendar, concatenate individual events into a single ics file
  99   (with-temp-buffer
 100     (shell-command "sw_vers" (current-buffer))
 101     (when (re-search-backward "10\\.[5678]" nil t)
 102       (omi-concat-leopard-ics all-calendars)))
 103
 104   ;; move all caldav ics files to the same place as local ics files
 105   (mapc
 106    (lambda (x)
 107      (mapc
 108       (lambda (y)
 109         (rename-file (concat x "/" y);
 110                      (concat "~/Library/Calendars/" y)))
 111       (directory-files x nil ".*ics$")))
 112    caldav-folders)
 113
 114   ;; check calendar has contents and import
 115   (setq import-calendars (directory-files "~/Library/Calendars" 1 ".*ics$"))
 116   (mapc
 117    (lambda (x)
 118      (when (/= (nth 7 (file-attributes x 'string)) 0)
 119        (omi-import-ics x)))
 120    import-calendars)
 121
 122   ;; tidy up intermediate files and buffers
 123   (setq usedCalendarsBuffers (mapcar (function buffer-name) (buffer-list)))
 124   (omi-kill-ics-buffer usedCalendarsBuffers)
 125   (setq usedCalendarsFiles (directory-files "~/Library/Calendars" 1 ".*ics$"))
 126   (omi-delete-ics-file usedCalendarsFiles)
 127
 128   (org-pop-to-buffer-same-window currentBuffer))
 129
 130 (defun omi-concat-leopard-ics (list)
 131   "Leopard stores each iCal.app event in a separate ics file.
 132 Whilst useful for Spotlight indexing, this is less helpful for
 133 icalendar-import-file. omi-concat-leopard-ics concatenates these
 134 individual event files into a single ics file"
 135   (mapc
 136    (lambda (x)
 137      (setq omi-leopard-events (directory-files (concat x "/Events") 1 ".*ics$"))
 138      (with-temp-buffer
 139        (mapc
 140         (lambda (y)
 141           (insert-file-contents (expand-file-name y)))
 142         omi-leopard-events)
 143        (write-region (point-min) (point-max) (concat (expand-file-name x) ".ics"))))
 144    list))
 145
 146 (defun omi-import-ics (string)
 147   "Imports an ics file into the Emacs diary. First tidies up the
 148 ics file so that it is suitable for import and selects a sensible
 149 date range so that Emacs calendar view doesn't grind to a halt"
 150   (with-temp-buffer
 151     (insert-file-contents string)
 152     (goto-char (point-min))
 153     (while
 154         (re-search-forward "^BEGIN:VCALENDAR$" nil t)
 155       (setq startEntry (match-beginning 0))
 156       (re-search-forward "^END:VCALENDAR$" nil t)
 157       (setq endEntry (match-end 0))
 158       (save-restriction
 159         (narrow-to-region startEntry endEntry)
 160         (goto-char (point-min))
 161         (re-search-forward "\\(^DTSTART;.*:\\)\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)" nil t)
 162         (if (or (eq (match-string 2) nil) (eq (match-string 3) nil))
 163             (progn
 164               (setq yearEntry 1)
 165               (setq monthEntry 1))
 166           (setq yearEntry (string-to-number (match-string 2)))
 167           (setq monthEntry (string-to-number (match-string 3))))
 168         (setq year (string-to-number (format-time-string "%Y")))
 169         (setq month (string-to-number (format-time-string "%m")))
 170         (setq now (list month 1 year))
 171         (setq entryDate (list monthEntry 1 yearEntry))
 172         ;; Check to see if this is a repeating event
 173         (goto-char (point-min))
 174         (setq isRepeating (re-search-forward "^RRULE:" nil t))
 175         ;; Delete if outside range and not repeating
 176         (when (and
 177                (not isRepeating)
 178                (> (abs (- (calendar-absolute-from-gregorian now)
 179                           (calendar-absolute-from-gregorian entryDate)))
 180                   (* (/ org-mac-iCal-range 2) 30))
 181           (delete-region startEntry endEntry)))
 182           (goto-char (point-max))))
 183     (while
 184         (re-search-forward "^END:VEVENT$" nil t)
 185       (delete-blank-lines))
 186     (goto-line 1)
 187     (insert "BEGIN:VCALENDAR\n\n")
 188     (goto-line 2)
 189     (while
 190         (re-search-forward "^BEGIN:VCALENDAR$" nil t)
 191       (replace-match "\n"))
 192     (goto-line 2)
 193     (while
 194         (re-search-forward "^END:VCALENDAR$" nil t)
 195       (replace-match "\n"))
 196     (insert "END:VCALENDAR")
 197     (goto-line 1)
 198     (delete-blank-lines)
 199     (while
 200         (re-search-forward "^END:VEVENT$" nil t)
 201       (delete-blank-lines))
 202     (goto-line 1)
 203     (while
 204         (re-search-forward "^ORG.*" nil t)
 205       (replace-match "\n"))
 206     (goto-line 1)
 207     (write-region (point-min) (point-max) string))
 208
 209   (icalendar-import-file string diary-file))
 210
 211 (defun omi-kill-diary-buffer (list)
 212   (mapc
 213    (lambda (x)
 214      (if (string-match "^diary" x)
 215          (kill-buffer x)))
 216    list))
 217
 218 (defun omi-kill-ics-buffer (list)
 219   (mapc
 220    (lambda (x)
 221      (if (string-match "ics$" x)
 222          (kill-buffer x)))
 223    list))
 224
 225 (defun omi-delete-ics-file (list)
 226   (mapc
 227    (lambda (x)
 228      (delete-file x))
 229    list))
 230
 231 (defun omi-checked (directory)
 232   "Parse Info.plist in iCal.app calendar folder and determine
 233 whether Checked key is 1. If Checked key is not 1, remove
 234 calendar from list of calendars for import"
 235   (let* ((root (xml-parse-file (car (directory-files directory 1 "Info.plist"))))
 236          (plist (car root))
 237          (dict (car (xml-get-children plist 'dict)))
 238          (keys (cdr (xml-node-children dict)))
 239          (keys (mapcar
 240                 (lambda (x)
 241                   (cond ((listp x)
 242                          x)))
 243                 keys))
 244          (keys (delq 'nil keys)))
 245     (when (equal "1" (car (cddr (lax-plist-get keys '(key nil "Checked")))))
 246       directory)))
 247
 248 (provide 'org-mac-iCal)
 249
 250 ;;; org-mac-iCal.el ends here