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