From: Niels Giesen <niels.giesen@gmail.com>
To: emacs-orgmode@gnu.org
Subject: More entries able to export to icalendar format
Date: Fri, 04 Feb 2011 12:43:19 +0100 [thread overview]
Message-ID: <87fws4f2js.fsf@gmail.com> (raw)
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
next reply other threads:[~2011-02-04 12:36 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-02-04 11:43 Niels Giesen [this message]
2011-02-11 11:43 ` More entries able to export to icalendar format Bastien
2011-02-11 18:46 ` Niels Giesen
2011-02-11 19:43 ` Bastien
2011-02-12 17:30 ` Niels Giesen
2011-02-13 0:34 ` Bastien
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87fws4f2js.fsf@gmail.com \
--to=niels.giesen@gmail.com \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).