dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

org-mac-iCal.el (8550B)


      1 ;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
      2 
      3 ;; Copyright (C) 2009-2014, 2021 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 <https://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