org-mac-iCal.el 8.3 KB

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