From mboxrd@z Thu Jan 1 00:00:00 1970 From: Niels Giesen Subject: More entries able to export to icalendar format Date: Fri, 04 Feb 2011 12:43:19 +0100 Message-ID: <87fws4f2js.fsf@gmail.com> Mime-Version: 1.0 Content-Type: text/plain Return-path: Received: from [140.186.70.92] (port=41756 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PlKuG-0002Be-GD for emacs-orgmode@gnu.org; Fri, 04 Feb 2011 07:36:58 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PlKYp-000879-71 for emacs-orgmode@gnu.org; Fri, 04 Feb 2011 07:14:49 -0500 Received: from mail-ew0-f41.google.com ([209.85.215.41]:45716) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PlKYo-00086s-Rn for emacs-orgmode@gnu.org; Fri, 04 Feb 2011 07:14:47 -0500 Received: by ewy27 with SMTP id 27so1145323ewy.0 for ; Fri, 04 Feb 2011 04:14:45 -0800 (PST) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org When exporting to icalendar format, not all of the <%%(diary-* )> style entries are supported. It concerns the functions =icalendar--convert-float-to-ical= and =icalendar--convert-date-to-ical= in icalendar.el. I took a stab at ameliorating =icalendar--convert-float-to-ical=, and would like your early comments before going further. Some issues arised when implementing: 1. What start date should be used? It now uses todays date, and EXDATEs that date again when it does not conform to the given rule. This means that when updating a calendar via this method, all past days are lost. This is probably what I would want, as I would be more interested in the reminders than in history. An alternative might be to set a date in the past, e.g. 1-1-1970. I believe there is no way in the diary entry itself to set start and end days for this. In the comments in =icalendar.el= it says #+begin_src emacs-lisp ;; Please note: ;; - Diary entries which have a start time but no end time are assumed to ;; last for one hour when they are exported. ;; - Weekly diary entries are assumed to occur the first time in the first ;; week of the year 2000 when they are exported. ;; - Yearly diary entries are assumed to occur the first time in the year ;; 1900 when they are exported. #+end_src It seems all options are a bit arbitrary. Too bad one cannot specify the start (and end) date in the sexp itself. 2. I do not see a way in the icalendar specs to implement the day argument to =diary-float=. 3. UIDs are generated by icalendar.el while we probably would like to use the UIDs org-mode generates, as that would allow synchronization. This problem holds true for other already working diary-* entries as well. To tackle this, I also hacked at =org-print-icalendar-entries= to add the UID as a text property and =icalendar--create-uid= to read it out if existing. Although it works, it does feel kinda hackish. 4. Above UID solution leaves a problem when there are multiple "timestamps" set for an entry. For instance, part my job is to act as a helpdesk every week on wednesday *and* on each third thursday of the month (yes, sad sad me), so I like an entry like #+begin_src org ,** Helpdesk , :PROPERTIES: , :ID: 4705-5861-79a741ea-8408-c3236f5a472b , :END: , <2011-02-02 wo +1w> , <%%(diary-float t 4 3)> #+end_src To overcome this problem one could - use two separate entries (ugly, but effective and easy (out-of-the-box), also probably the best way to go for a two-way sync), - find some way to merge ical entries with the same UID, or - add something (an index or so for each date entry) to the UID - 5. I wouldn't know if or how to accomodate for timezones. As I have been doing my hacks via litterate programming style in an org-mode file, true patches are lacking at the moment. I hope you'll excuse me the ensuing longevity of this post. I am interested in your thoughts, especially on how this may best work with a two-way sync system. The function that started it: =icalendar--convert-float-to-ical= #+begin_src emacs-lisp :tangle yes (defun icalendar--convert-float-to-ical (nonmarker entry-main) "Convert float diary entry to icalendar format -- partially unsupported! FIXME! DAY from diary-float yet unimplemented. NONMARKER is a regular expression matching the start of non-marking entries. ENTRY-MAIN is the first line of the diary entry." (if (string-match (concat nonmarker "%%\\((diary-float \\([^)]+\\))\\s-*\\(.*?\\)\\) ?$") entry-main) (with-temp-buffer (insert (match-string 1 entry-main)) (goto-char (point-min)) (let* ((sexp (read (current-buffer))) (month (nth 1 sexp)) (dayname (nth 2 sexp)) (n (nth 3 sexp)) (day (nth 4 sexp)) (summary (buffer-substring (point) (point-max)))) (list sexp month dayname n day summary) (when day (progn (icalendar--dmsg "diary-float %s" entry-main) (error "Don't know if or how to implement day in `diary-float'"))) (list (concat ;;Start today: "\nDTSTART;" "VALUE=DATE:" (format-time-string "%Y%m%d" (current-time)) ;;BUT remove today if diary-float ;;expression does not hold true for today: (when (null (let ((date (calendar-current-date))) (diary-float month dayname n))) (concat "\nEXDATE;" "VALUE=DATE:" (format-time-string "%Y%m%d" (current-time)))) "\nRRULE:" (if (or (numberp month) (listp month)) "FREQ=YEARLY;BYMONTH=" "FREQ=MONTHLY") (when (listp month) (mapconcat (lambda (m) (number-to-string m)) (cadr month) ",")) (when (numberp month) (number-to-string month)) ";BYDAY=" (number-to-string n) (symbol-name (nth dayname '(SU MO TU WE TH FR SA)))) (replace-regexp-in-string "\\(^\s+\\|\s+$\\)" "" summary)))) ;; no match nil)) #+end_src Use text-properties to transport org uid in =org-print-icalendar-entries=: #+begin_src emacs-lisp :tangle yes (defun org-print-icalendar-entries (&optional combine) "Print iCalendar entries for the current Org-mode file to `standard-output'. When COMBINE is non nil, add the category to each line." (require 'org-agenda) (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) (dts (org-ical-ts-to-string (format-time-string (cdr org-time-stamp-formats) (current-time)) "DTSTART")) hd ts ts2 state status (inc t) pos b sexp rrule scheduledp deadlinep todo prefix due start tmp pri categories location summary desc uid alarm (sexp-buffer (get-buffer-create "*ical-tmp*"))) (org-refresh-category-properties) (save-excursion (goto-char (point-min)) (while (re-search-forward re1 nil t) (catch :skip (org-agenda-skip) (when org-icalendar-verify-function (unless (save-match-data (funcall org-icalendar-verify-function)) (outline-next-heading) (backward-char 1) (throw :skip nil))) (setq pos (match-beginning 0) ts (match-string 0) inc t hd (condition-case nil (org-icalendar-cleanup-string (org-get-heading t)) (error (throw :skip nil))) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) desc (org-icalendar-cleanup-string (or (org-entry-get nil "DESCRIPTION") (and org-icalendar-include-body (org-get-entry))) t org-icalendar-include-body) location (org-icalendar-cleanup-string (org-entry-get nil "LOCATION" 'selective)) uid (if org-icalendar-store-UID (org-id-get-create) (or (org-id-get) (org-id-new))) categories (org-export-get-categories) alarm "" deadlinep nil scheduledp nil) (if (looking-at re2) (progn (goto-char (match-end 0)) (setq ts2 (match-string 1) inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos) ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) (progn (setq inc nil) (replace-match "\\1" t nil ts)) ts) deadlinep (string-match org-deadline-regexp tmp) scheduledp (string-match org-scheduled-regexp tmp) todo (org-get-todo-state) ;; donep (org-entry-is-done-p) )) (when (and (not org-icalendar-use-plain-timestamp) (not deadlinep) (not scheduledp)) (throw :skip t)) (when (and deadlinep (if todo (not (memq 'event-if-todo org-icalendar-use-deadline)) (not (memq 'event-if-not-todo org-icalendar-use-deadline)))) (throw :skip t)) (when (and scheduledp (if todo (not (memq 'event-if-todo org-icalendar-use-scheduled)) (not (memq 'event-if-not-todo org-icalendar-use-scheduled)))) (throw :skip t)) (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-"))) (if (or (string-match org-tr-regexp hd) (string-match org-ts-regexp hd)) (setq hd (replace-match "" t t hd))) (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) (setq rrule (concat "\nRRULE:FREQ=" (cdr (assoc (match-string 2 ts) '(("d" . "DAILY")("w" . "WEEKLY") ("m" . "MONTHLY")("y" . "YEARLY")))) ";INTERVAL=" (match-string 1 ts))) (setq rrule "")) (setq summary (or summary hd)) ;; create an alarm entry if the entry is timed. this is not very general in that: ;; (a) only one alarm per entry is defined, ;; (b) only minutes are allowed for the trigger period ahead of the start time, and ;; (c) only a DISPLAY action is defined. ;; [ESF] (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) (if (and (> org-icalendar-alarm-time 0) (car t1) (nth 1 t1) (nth 2 t1)) (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0D0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time)) (setq alarm "")) ) (if (string-match org-bracket-link-regexp summary) (setq summary (replace-match (if (match-end 3) (match-string 3 summary) (match-string 1 summary)) t t summary))) (if deadlinep (setq summary (concat "DL: " summary))) (if scheduledp (setq summary (concat "S: " summary))) (if (string-match "\\`<%%" ts) (with-current-buffer sexp-buffer (let ((entry (substring ts 1 -1))) (put-text-property 0 1 'uid (concat " " prefix uid) entry) (insert entry " " summary "\n"))) (princ (format "BEGIN:VEVENT UID: %s %s %s%s SUMMARY:%s%s%s CATEGORIES:%s%s END:VEVENT\n" (concat prefix uid) (org-ical-ts-to-string ts "DTSTART") (org-ical-ts-to-string ts2 "DTEND" inc) rrule summary (if (and desc (string-match "\\S-" desc)) (concat "\nDESCRIPTION: " desc) "") (if (and location (string-match "\\S-" location)) (concat "\nLOCATION: " location) "") categories alarm))))) (when (and org-icalendar-include-sexps (condition-case nil (require 'icalendar) (error nil)) (fboundp 'icalendar-export-region)) ;; Get all the literal sexps (goto-char (point-min)) (while (re-search-forward "^&?%%(" nil t) (catch :skip (org-agenda-skip) (when org-icalendar-verify-function (unless (save-match-data (funcall org-icalendar-verify-function)) (outline-next-heading) (backward-char 1) (throw :skip nil))) (setq b (match-beginning 0)) (goto-char (1- (match-end 0))) (forward-sexp 1) (end-of-line 1) (setq sexp (buffer-substring b (point))) (with-current-buffer sexp-buffer (insert sexp "\n")))) (princ (org-diary-to-ical-string sexp-buffer)) (kill-buffer sexp-buffer)) (when org-icalendar-include-todo (setq prefix "TODO-") (goto-char (point-min)) (while (re-search-forward org-complex-heading-regexp nil t) (catch :skip (org-agenda-skip) (when org-icalendar-verify-function (unless (save-match-data (funcall org-icalendar-verify-function)) (outline-next-heading) (backward-char 1) (throw :skip nil))) (setq state (match-string 2)) (setq status (if (member state org-done-keywords) "COMPLETED" "NEEDS-ACTION")) (when (and state (cond ;; check if the state is one we should use ((eq org-icalendar-include-todo 'all) ;; all should be included t) ((eq org-icalendar-include-todo 'unblocked) ;; only undone entries that are not blocked (and (member state org-not-done-keywords) (or (not org-blocker-hook) (save-match-data (run-hook-with-args-until-failure 'org-blocker-hook (list :type 'todo-state-change :position (point-at-bol) :from 'todo :to 'done)))))) ((eq org-icalendar-include-todo t) ;; include everything that is not done (member state org-not-done-keywords)))) (setq hd (match-string 4) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) desc (org-icalendar-cleanup-string (or (org-entry-get nil "DESCRIPTION") (and org-icalendar-include-body (org-get-entry))) t org-icalendar-include-body) location (org-icalendar-cleanup-string (org-entry-get nil "LOCATION" 'selective)) due (and (member 'todo-due org-icalendar-use-deadline) (org-entry-get nil "DEADLINE")) start (and (member 'todo-start org-icalendar-use-scheduled) (org-entry-get nil "SCHEDULED")) categories (org-export-get-categories) uid (if org-icalendar-store-UID (org-id-get-create) (or (org-id-get) (org-id-new)))) (and due (setq due (org-ical-ts-to-string due "DUE"))) (and start (setq start (org-ical-ts-to-string start "DTSTART"))) (if (string-match org-bracket-link-regexp hd) (setq hd (replace-match (if (match-end 3) (match-string 3 hd) (match-string 1 hd)) t t hd))) (if (string-match org-priority-regexp hd) (setq pri (string-to-char (match-string 2 hd)) hd (concat (substring hd 0 (match-beginning 1)) (substring hd (match-end 1)))) (setq pri org-default-priority)) (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) (- org-lowest-priority org-highest-priority)))))) (princ (format "BEGIN:VTODO UID: %s %s SUMMARY:%s%s%s%s CATEGORIES:%s SEQUENCE:1 PRIORITY:%d STATUS:%s END:VTODO\n" (concat prefix uid) (or start dts) (or summary hd) (if (and location (string-match "\\S-" location)) (concat "\nLOCATION: " location) "") (if (and desc (string-match "\\S-" desc)) (concat "\nDESCRIPTION: " desc) "") (if due (concat "\n" due) "") categories pri status))))))))) #+end_src Pick it up in =icalendar--create-uid= #+begin_src emacs-lisp :tangle yes (defun icalendar--create-uid (entry-full contents) "Construct a unique iCalendar UID for a diary entry. ENTRY-FULL is the full diary entry string. CONTENTS is the current iCalendar object, as a string. Increase `icalendar--uid-count'. Returns the UID string." (let ((uid icalendar-uid-format)) (if ;;Allow other apps (such as org-mode) to create its own uid (get-text-property 0 'uid entry-full) (setq uid (get-text-property 0 'uid entry-full)) (setq uid (replace-regexp-in-string "%c" (format "%d" icalendar--uid-count) uid t t)) (setq icalendar--uid-count (1+ icalendar--uid-count)) (setq uid (replace-regexp-in-string "%t" (format "%d%d%d" (car (current-time)) (cadr (current-time)) (car (cddr (current-time)))) uid t t)) (setq uid (replace-regexp-in-string "%h" (format "%d" (abs (sxhash entry-full))) uid t t)) (setq uid (replace-regexp-in-string "%u" (or user-login-name "UNKNOWN_USER") uid t t)) (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents) (substring contents (match-beginning 1) (match-end 1)) "DTSTART"))) (setq uid (replace-regexp-in-string "%s" dtstart uid t t)))) ;; Return the UID string uid)) #+end_src Regards, niels -- http://pft.github.com