org-icalendar.el 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687
  1. ;;; org-icalendar.el --- iCalendar export for Org-mode
  2. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
  3. ;; Free Software Foundation, Inc.
  4. ;; Author: Carsten Dominik <carsten at orgmode dot org>
  5. ;; Keywords: outlines, hypermedia, calendar, wp
  6. ;; Homepage: http://orgmode.org
  7. ;; Version: 7.5
  8. ;;
  9. ;; This file is part of GNU Emacs.
  10. ;;
  11. ;; GNU Emacs 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 of the License, or
  14. ;; (at your option) any later version.
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22. ;;
  23. ;;; Commentary:
  24. ;;; Code:
  25. (require 'org-exp)
  26. (eval-when-compile
  27. (require 'cl))
  28. (declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
  29. (defgroup org-export-icalendar nil
  30. "Options specific for iCalendar export of Org-mode files."
  31. :tag "Org Export iCalendar"
  32. :group 'org-export)
  33. (defcustom org-combined-agenda-icalendar-file "~/org.ics"
  34. "The file name for the iCalendar file covering all agenda files.
  35. This file is created with the command \\[org-export-icalendar-all-agenda-files].
  36. The file name should be absolute, the file will be overwritten without warning."
  37. :group 'org-export-icalendar
  38. :type 'file)
  39. (defcustom org-icalendar-alarm-time 0
  40. "Number of minutes for triggering an alarm for exported timed events.
  41. A zero value (the default) turns off the definition of an alarm trigger
  42. for timed events. If non-zero, alarms are created.
  43. - a single alarm per entry is defined
  44. - The alarm will go off N minutes before the event
  45. - only a DISPLAY action is defined."
  46. :group 'org-export-icalendar
  47. :type 'integer)
  48. (defcustom org-icalendar-combined-name "OrgMode"
  49. "Calendar name for the combined iCalendar representing all agenda files."
  50. :group 'org-export-icalendar
  51. :type 'string)
  52. (defcustom org-icalendar-combined-description nil
  53. "Calendar description for the combined iCalendar (all agenda files)."
  54. :group 'org-export-icalendar
  55. :type 'string)
  56. (defcustom org-icalendar-use-plain-timestamp t
  57. "Non-nil means make an event from every plain time stamp."
  58. :group 'org-export-icalendar
  59. :type 'boolean)
  60. (defcustom org-icalendar-honor-noexport-tag nil
  61. "Non-nil means don't export entries with a tag in `org-export-exclude-tags'."
  62. :group 'org-export-icalendar
  63. :type 'boolean)
  64. (defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
  65. "Contexts where iCalendar export should use a deadline time stamp.
  66. This is a list with several symbols in it. Valid symbol are:
  67. event-if-todo Deadlines in TODO entries become calendar events.
  68. event-if-not-todo Deadlines in non-TODO entries become calendar events.
  69. todo-due Use deadlines in TODO entries as due-dates"
  70. :group 'org-export-icalendar
  71. :type '(set :greedy t
  72. (const :tag "Deadlines in non-TODO entries become events"
  73. event-if-not-todo)
  74. (const :tag "Deadline in TODO entries become events"
  75. event-if-todo)
  76. (const :tag "Deadlines in TODO entries become due-dates"
  77. todo-due)))
  78. (defcustom org-icalendar-use-scheduled '(todo-start)
  79. "Contexts where iCalendar export should use a scheduling time stamp.
  80. This is a list with several symbols in it. Valid symbol are:
  81. event-if-todo Scheduling time stamps in TODO entries become an event.
  82. event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
  83. todo-start Scheduling time stamps in TODO entries become start date.
  84. Some calendar applications show TODO entries only after
  85. that date."
  86. :group 'org-export-icalendar
  87. :type '(set :greedy t
  88. (const :tag
  89. "SCHEDULED timestamps in non-TODO entries become events"
  90. event-if-not-todo)
  91. (const :tag "SCHEDULED timestamps in TODO entries become events"
  92. event-if-todo)
  93. (const :tag "SCHEDULED in TODO entries become start date"
  94. todo-start)))
  95. (defcustom org-icalendar-categories '(local-tags category)
  96. "Items that should be entered into the categories field.
  97. This is a list of symbols, the following are valid:
  98. category The Org-mode category of the current file or tree
  99. todo-state The todo state, if any
  100. local-tags The tags, defined in the current line
  101. all-tags All tags, including inherited ones."
  102. :group 'org-export-icalendar
  103. :type '(repeat
  104. (choice
  105. (const :tag "The file or tree category" category)
  106. (const :tag "The TODO state" todo-state)
  107. (const :tag "Tags defined in current line" local-tags)
  108. (const :tag "All tags, including inherited ones" all-tags))))
  109. (defcustom org-icalendar-include-todo nil
  110. "Non-nil means export to iCalendar files should also cover TODO items.
  111. Valid values are:
  112. nil don't include any TODO items
  113. t include all TODO items that are not in a DONE state
  114. unblocked include all TODO items that are not blocked
  115. all include both done and not done items."
  116. :group 'org-export-icalendar
  117. :type '(choice
  118. (const :tag "None" nil)
  119. (const :tag "Unfinished" t)
  120. (const :tag "Unblocked" unblocked)
  121. (const :tag "All" all)))
  122. (defvar org-icalendar-verify-function nil
  123. "Function to verify entries for iCalendar export.
  124. This can be set to a function that will be called at each entry that
  125. is considered for export to iCalendar. When the function returns nil,
  126. the entry will be skipped. When it returns a non-nil value, the entry
  127. will be considered for export.
  128. This is used internally when an agenda buffer is exported to an ics file,
  129. to make sure that only entries currently listed in the agenda will end
  130. up in the ics file. But for normal iCalendar export, you can use this
  131. for whatever you need.")
  132. (defcustom org-icalendar-include-bbdb-anniversaries nil
  133. "Non-nil means a combined iCalendar files should include anniversaries.
  134. The anniversaries are define in the BBDB database."
  135. :group 'org-export-icalendar
  136. :type 'boolean)
  137. (defcustom org-icalendar-include-sexps t
  138. "Non-nil means export to iCalendar files should also cover sexp entries.
  139. These are entries like in the diary, but directly in an Org-mode file."
  140. :group 'org-export-icalendar
  141. :type 'boolean)
  142. (defcustom org-icalendar-include-body 100
  143. "Amount of text below headline to be included in iCalendar export.
  144. This is a number of characters that should maximally be included.
  145. Properties, scheduling and clocking lines will always be removed.
  146. The text will be inserted into the DESCRIPTION field."
  147. :group 'org-export-icalendar
  148. :type '(choice
  149. (const :tag "Nothing" nil)
  150. (const :tag "Everything" t)
  151. (integer :tag "Max characters")))
  152. (defcustom org-icalendar-store-UID nil
  153. "Non-nil means store any created UIDs in properties.
  154. The iCalendar standard requires that all entries have a unique identifier.
  155. Org will create these identifiers as needed. When this variable is non-nil,
  156. the created UIDs will be stored in the ID property of the entry. Then the
  157. next time this entry is exported, it will be exported with the same UID,
  158. superseding the previous form of it. This is essential for
  159. synchronization services.
  160. This variable is not turned on by default because we want to avoid creating
  161. a property drawer in every entry if people are only playing with this feature,
  162. or if they are only using it locally."
  163. :group 'org-export-icalendar
  164. :type 'boolean)
  165. (defcustom org-icalendar-timezone (getenv "TZ")
  166. "The time zone string for iCalendar export.
  167. When nil of the empty string, use the abbreviation retrieved from Emacs."
  168. :group 'org-export-icalendar
  169. :type '(choice
  170. (const :tag "Unspecified" nil)
  171. (string :tag "Time zone")))
  172. ;; Backward compatibility with previous variable
  173. (defvar org-icalendar-use-UTC-date-time nil)
  174. (defcustom org-icalendar-date-time-format
  175. (if org-icalendar-use-UTC-date-time
  176. ":%Y%m%dT%H%M%SZ"
  177. ":%Y%m%dT%H%M%S")
  178. "Format-string for exporting icalendar DATE-TIME.
  179. See `format-time-string' for a full documentation. The only
  180. difference is that `org-icalendar-timezone' is used for %Z.
  181. Interesting value are:
  182. - \":%Y%m%dT%H%M%S\" for local time
  183. - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone
  184. - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
  185. :group 'org-export-icalendar
  186. :type '(choice
  187. (const :tag "Local time" ":%Y%m%dT%H%M%S")
  188. (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
  189. (const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
  190. (string :tag "Explicit format")))
  191. (defun org-icalendar-use-UTC-date-timep ()
  192. (char-equal (elt org-icalendar-date-time-format
  193. (1- (length org-icalendar-date-time-format))) ?Z))
  194. ;;; iCalendar export
  195. ;;;###autoload
  196. (defun org-export-icalendar-this-file ()
  197. "Export current file as an iCalendar file.
  198. The iCalendar file will be located in the same directory as the Org-mode
  199. file, but with extension `.ics'."
  200. (interactive)
  201. (org-export-icalendar nil buffer-file-name))
  202. ;;;###autoload
  203. (defun org-export-icalendar-all-agenda-files ()
  204. "Export all files in the variable `org-agenda-files' to iCalendar .ics files.
  205. Each iCalendar file will be located in the same directory as the Org-mode
  206. file, but with extension `.ics'."
  207. (interactive)
  208. (apply 'org-export-icalendar nil (org-agenda-files t)))
  209. ;;;###autoload
  210. (defun org-export-icalendar-combine-agenda-files ()
  211. "Export all files in `org-agenda-files' to a single combined iCalendar file.
  212. The file is stored under the name `org-combined-agenda-icalendar-file'."
  213. (interactive)
  214. (apply 'org-export-icalendar t (org-agenda-files t)))
  215. (defun org-export-icalendar (combine &rest files)
  216. "Create iCalendar files for all elements of FILES.
  217. If COMBINE is non-nil, combine all calendar entries into a single large
  218. file and store it under the name `org-combined-agenda-icalendar-file'."
  219. (save-excursion
  220. (org-prepare-agenda-buffers files)
  221. (let* ((dir (org-export-directory
  222. :ical (list :publishing-directory
  223. org-export-publishing-directory)))
  224. file ical-file ical-buffer category started org-agenda-new-buffers)
  225. (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
  226. (when combine
  227. (setq ical-file
  228. (if (file-name-absolute-p org-combined-agenda-icalendar-file)
  229. org-combined-agenda-icalendar-file
  230. (expand-file-name org-combined-agenda-icalendar-file dir))
  231. ical-buffer (org-get-agenda-file-buffer ical-file))
  232. (set-buffer ical-buffer) (erase-buffer))
  233. (while (setq file (pop files))
  234. (catch 'nextfile
  235. (org-check-agenda-file file)
  236. (set-buffer (org-get-agenda-file-buffer file))
  237. (unless combine
  238. (setq ical-file (concat (file-name-as-directory dir)
  239. (file-name-sans-extension
  240. (file-name-nondirectory buffer-file-name))
  241. ".ics"))
  242. (setq ical-buffer (org-get-agenda-file-buffer ical-file))
  243. (with-current-buffer ical-buffer (erase-buffer)))
  244. (setq category (or org-category
  245. (file-name-sans-extension
  246. (file-name-nondirectory buffer-file-name))))
  247. (if (symbolp category) (setq category (symbol-name category)))
  248. (let ((standard-output ical-buffer))
  249. (if combine
  250. (and (not started) (setq started t)
  251. (org-start-icalendar-file org-icalendar-combined-name))
  252. (org-start-icalendar-file category))
  253. (org-print-icalendar-entries combine)
  254. (when (or (and combine (not files)) (not combine))
  255. (when (and combine org-icalendar-include-bbdb-anniversaries)
  256. (require 'org-bbdb)
  257. (org-bbdb-anniv-export-ical))
  258. (org-finish-icalendar-file)
  259. (set-buffer ical-buffer)
  260. (run-hooks 'org-before-save-iCalendar-file-hook)
  261. (save-buffer)
  262. (run-hooks 'org-after-save-iCalendar-file-hook)
  263. (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
  264. ))))
  265. (org-release-buffers org-agenda-new-buffers))))
  266. (defvar org-before-save-iCalendar-file-hook nil
  267. "Hook run before an iCalendar file has been saved.
  268. This can be used to modify the result of the export.")
  269. (defvar org-after-save-iCalendar-file-hook nil
  270. "Hook run after an iCalendar file has been saved.
  271. The iCalendar buffer is still current when this hook is run.
  272. A good way to use this is to tell a desktop calendar application to re-read
  273. the iCalendar file.")
  274. (defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
  275. (defun org-print-icalendar-entries (&optional combine)
  276. "Print iCalendar entries for the current Org-mode file to `standard-output'.
  277. When COMBINE is non nil, add the category to each line."
  278. (require 'org-agenda)
  279. (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
  280. (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
  281. (dts (org-ical-ts-to-string
  282. (format-time-string (cdr org-time-stamp-formats) (current-time))
  283. "DTSTART"))
  284. hd ts ts2 state status (inc t) pos b sexp rrule
  285. scheduledp deadlinep todo prefix due start tags
  286. tmp pri categories location summary desc uid alarm
  287. (sexp-buffer (get-buffer-create "*ical-tmp*")))
  288. (org-refresh-category-properties)
  289. (save-excursion
  290. (goto-char (point-min))
  291. (while (re-search-forward re1 nil t)
  292. (catch :skip
  293. (org-agenda-skip)
  294. (when org-icalendar-verify-function
  295. (unless (save-match-data (funcall org-icalendar-verify-function))
  296. (outline-next-heading)
  297. (backward-char 1)
  298. (throw :skip nil)))
  299. (setq pos (match-beginning 0)
  300. ts (match-string 0)
  301. tags (org-get-tags-at)
  302. inc t
  303. hd (condition-case nil
  304. (org-icalendar-cleanup-string
  305. (org-get-heading t))
  306. (error (throw :skip nil)))
  307. summary (org-icalendar-cleanup-string
  308. (org-entry-get nil "SUMMARY"))
  309. desc (org-icalendar-cleanup-string
  310. (or (org-entry-get nil "DESCRIPTION")
  311. (and org-icalendar-include-body (org-get-entry)))
  312. t org-icalendar-include-body)
  313. location (org-icalendar-cleanup-string
  314. (org-entry-get nil "LOCATION" 'selective))
  315. uid (if org-icalendar-store-UID
  316. (org-id-get-create)
  317. (or (org-id-get) (org-id-new)))
  318. categories (org-export-get-categories)
  319. alarm ""
  320. deadlinep nil scheduledp nil)
  321. (if (looking-at re2)
  322. (progn
  323. (goto-char (match-end 0))
  324. (setq ts2 (match-string 1)
  325. inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
  326. (setq tmp (buffer-substring (max (point-min)
  327. (- pos org-ds-keyword-length))
  328. pos)
  329. ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
  330. (progn
  331. (setq inc nil)
  332. (replace-match "\\1" t nil ts))
  333. ts)
  334. deadlinep (string-match org-deadline-regexp tmp)
  335. scheduledp (string-match org-scheduled-regexp tmp)
  336. todo (org-get-todo-state)
  337. ;; donep (org-entry-is-done-p)
  338. ))
  339. (when (and (not org-icalendar-use-plain-timestamp)
  340. (not deadlinep) (not scheduledp))
  341. (throw :skip t))
  342. ;; don't export entries with a :noexport: tag
  343. (when (and org-icalendar-honor-noexport-tag
  344. (delq nil (mapcar (lambda(x)
  345. (member x org-export-exclude-tags)) tags)))
  346. (throw :skip t))
  347. (when (and
  348. deadlinep
  349. (if todo
  350. (not (memq 'event-if-todo org-icalendar-use-deadline))
  351. (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
  352. (throw :skip t))
  353. (when (and
  354. scheduledp
  355. (if todo
  356. (not (memq 'event-if-todo org-icalendar-use-scheduled))
  357. (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
  358. (throw :skip t))
  359. (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
  360. (if (or (string-match org-tr-regexp hd)
  361. (string-match org-ts-regexp hd))
  362. (setq hd (replace-match "" t t hd)))
  363. (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
  364. (setq rrule
  365. (concat "\nRRULE:FREQ="
  366. (cdr (assoc
  367. (match-string 2 ts)
  368. '(("d" . "DAILY")("w" . "WEEKLY")
  369. ("m" . "MONTHLY")("y" . "YEARLY"))))
  370. ";INTERVAL=" (match-string 1 ts)))
  371. (setq rrule ""))
  372. (setq summary (or summary hd))
  373. ;; create an alarm entry if the entry is timed. this is not very general in that:
  374. ;; (a) only one alarm per entry is defined,
  375. ;; (b) only minutes are allowed for the trigger period ahead of the start time, and
  376. ;; (c) only a DISPLAY action is defined.
  377. ;; [ESF]
  378. (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault))))
  379. (if (and (> org-icalendar-alarm-time 0)
  380. (car t1) (nth 1 t1) (nth 2 t1))
  381. (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0D0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time))
  382. (setq alarm ""))
  383. )
  384. (if (string-match org-bracket-link-regexp summary)
  385. (setq summary
  386. (replace-match (if (match-end 3)
  387. (match-string 3 summary)
  388. (match-string 1 summary))
  389. t t summary)))
  390. (if deadlinep (setq summary (concat "DL: " summary)))
  391. (if scheduledp (setq summary (concat "S: " summary)))
  392. (if (string-match "\\`<%%" ts)
  393. (with-current-buffer sexp-buffer
  394. (insert (substring ts 1 -1) " " summary "\n"))
  395. (princ (format "BEGIN:VEVENT
  396. UID: %s
  397. %s
  398. %s%s
  399. SUMMARY:%s%s%s
  400. CATEGORIES:%s%s
  401. END:VEVENT\n"
  402. (concat prefix uid)
  403. (org-ical-ts-to-string ts "DTSTART")
  404. (org-ical-ts-to-string ts2 "DTEND" inc)
  405. rrule summary
  406. (if (and desc (string-match "\\S-" desc))
  407. (concat "\nDESCRIPTION: " desc) "")
  408. (if (and location (string-match "\\S-" location))
  409. (concat "\nLOCATION: " location) "")
  410. categories
  411. alarm)))))
  412. (when (and org-icalendar-include-sexps
  413. (condition-case nil (require 'icalendar) (error nil))
  414. (fboundp 'icalendar-export-region))
  415. ;; Get all the literal sexps
  416. (goto-char (point-min))
  417. (while (re-search-forward "^&?%%(" nil t)
  418. (catch :skip
  419. (org-agenda-skip)
  420. (when org-icalendar-verify-function
  421. (unless (save-match-data (funcall org-icalendar-verify-function))
  422. (outline-next-heading)
  423. (backward-char 1)
  424. (throw :skip nil)))
  425. (setq b (match-beginning 0))
  426. (goto-char (1- (match-end 0)))
  427. (forward-sexp 1)
  428. (end-of-line 1)
  429. (setq sexp (buffer-substring b (point)))
  430. (with-current-buffer sexp-buffer
  431. (insert sexp "\n"))))
  432. (princ (org-diary-to-ical-string sexp-buffer))
  433. (kill-buffer sexp-buffer))
  434. (when org-icalendar-include-todo
  435. (setq prefix "TODO-")
  436. (goto-char (point-min))
  437. (while (re-search-forward org-complex-heading-regexp nil t)
  438. (catch :skip
  439. (org-agenda-skip)
  440. (when org-icalendar-verify-function
  441. (unless (save-match-data
  442. (funcall org-icalendar-verify-function))
  443. (outline-next-heading)
  444. (backward-char 1)
  445. (throw :skip nil)))
  446. (setq state (match-string 2))
  447. (setq status (if (member state org-done-keywords)
  448. "COMPLETED" "NEEDS-ACTION"))
  449. (when (and state
  450. (cond
  451. ;; check if the state is one we should use
  452. ((eq org-icalendar-include-todo 'all)
  453. ;; all should be included
  454. t)
  455. ((eq org-icalendar-include-todo 'unblocked)
  456. ;; only undone entries that are not blocked
  457. (and (member state org-not-done-keywords)
  458. (or (not org-blocker-hook)
  459. (save-match-data
  460. (run-hook-with-args-until-failure
  461. 'org-blocker-hook
  462. (list :type 'todo-state-change
  463. :position (point-at-bol)
  464. :from 'todo
  465. :to 'done))))))
  466. ((eq org-icalendar-include-todo t)
  467. ;; include everything that is not done
  468. (member state org-not-done-keywords))))
  469. (setq hd (match-string 4)
  470. summary (org-icalendar-cleanup-string
  471. (org-entry-get nil "SUMMARY"))
  472. desc (org-icalendar-cleanup-string
  473. (or (org-entry-get nil "DESCRIPTION")
  474. (and org-icalendar-include-body (org-get-entry)))
  475. t org-icalendar-include-body)
  476. location (org-icalendar-cleanup-string
  477. (org-entry-get nil "LOCATION" 'selective))
  478. due (and (member 'todo-due org-icalendar-use-deadline)
  479. (org-entry-get nil "DEADLINE"))
  480. start (and (member 'todo-start org-icalendar-use-scheduled)
  481. (org-entry-get nil "SCHEDULED"))
  482. categories (org-export-get-categories)
  483. uid (if org-icalendar-store-UID
  484. (org-id-get-create)
  485. (or (org-id-get) (org-id-new))))
  486. (and due (setq due (org-ical-ts-to-string due "DUE")))
  487. (and start (setq start (org-ical-ts-to-string start "DTSTART")))
  488. (if (string-match org-bracket-link-regexp hd)
  489. (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
  490. (match-string 1 hd))
  491. t t hd)))
  492. (if (string-match org-priority-regexp hd)
  493. (setq pri (string-to-char (match-string 2 hd))
  494. hd (concat (substring hd 0 (match-beginning 1))
  495. (substring hd (match-end 1))))
  496. (setq pri org-default-priority))
  497. (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
  498. (- org-lowest-priority org-highest-priority))))))
  499. (princ (format "BEGIN:VTODO
  500. UID: %s
  501. %s
  502. SUMMARY:%s%s%s%s
  503. CATEGORIES:%s
  504. SEQUENCE:1
  505. PRIORITY:%d
  506. STATUS:%s
  507. END:VTODO\n"
  508. (concat prefix uid)
  509. (or start dts)
  510. (or summary hd)
  511. (if (and location (string-match "\\S-" location))
  512. (concat "\nLOCATION: " location) "")
  513. (if (and desc (string-match "\\S-" desc))
  514. (concat "\nDESCRIPTION: " desc) "")
  515. (if due (concat "\n" due) "")
  516. categories
  517. pri status)))))))))
  518. (defun org-export-get-categories ()
  519. "Get categories according to `org-icalendar-categories'."
  520. (let ((cs org-icalendar-categories) c rtn tmp)
  521. (while (setq c (pop cs))
  522. (cond
  523. ((eq c 'category) (push (org-get-category) rtn))
  524. ((eq c 'todo-state)
  525. (setq tmp (org-get-todo-state))
  526. (and tmp (push tmp rtn)))
  527. ((eq c 'local-tags)
  528. (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
  529. ((eq c 'all-tags)
  530. (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
  531. (mapconcat 'identity (nreverse rtn) ",")))
  532. (defun org-icalendar-cleanup-string (s &optional is-body maxlength)
  533. "Take out stuff and quote what needs to be quoted.
  534. When IS-BODY is non-nil, assume that this is the body of an item, clean up
  535. whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
  536. characters."
  537. (if (not s)
  538. nil
  539. (if is-body
  540. (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
  541. (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
  542. (while (string-match re s) (setq s (replace-match "" t t s)))
  543. (while (string-match re2 s) (setq s (replace-match "" t t s))))
  544. (setq s (replace-regexp-in-string "[[:space:]]+" " " s)))
  545. (let ((start 0))
  546. (while (string-match "\\([,;]\\)" s start)
  547. (setq start (+ (match-beginning 0) 2)
  548. s (replace-match "\\\\\\1" nil nil s))))
  549. (setq s (org-trim s))
  550. (when is-body
  551. (while (string-match "[ \t]*\n[ \t]*" s)
  552. (setq s (replace-match "\\n" t t s))))
  553. (if is-body
  554. (if maxlength
  555. (if (and (numberp maxlength)
  556. (> (length s) maxlength))
  557. (setq s (substring s 0 maxlength)))))
  558. s))
  559. (defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
  560. "Take out stuff and quote what needs to be quoted.
  561. When IS-BODY is non-nil, assume that this is the body of an item, clean up
  562. whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
  563. characters.
  564. This seems to be more like RFC 2455, but it causes problems, so it is
  565. not used right now."
  566. (if (not s)
  567. nil
  568. (if is-body
  569. (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
  570. (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
  571. (while (string-match re s) (setq s (replace-match "" t t s)))
  572. (while (string-match re2 s) (setq s (replace-match "" t t s)))
  573. (setq s (org-trim s))
  574. (while (string-match "[ \t]*\n[ \t]*" s)
  575. (setq s (replace-match "\\n" t t s)))
  576. (if maxlength
  577. (if (and (numberp maxlength)
  578. (> (length s) maxlength))
  579. (setq s (substring s 0 maxlength)))))
  580. (setq s (org-trim s)))
  581. (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
  582. (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
  583. s))
  584. (defun org-start-icalendar-file (name)
  585. "Start an iCalendar file by inserting the header."
  586. (let ((user user-full-name)
  587. (name (or name "unknown"))
  588. (timezone (if (> (length org-icalendar-timezone) 0)
  589. org-icalendar-timezone
  590. (cadr (current-time-zone))))
  591. (description org-icalendar-combined-description))
  592. (princ
  593. (format "BEGIN:VCALENDAR
  594. VERSION:2.0
  595. X-WR-CALNAME:%s
  596. PRODID:-//%s//Emacs with Org-mode//EN
  597. X-WR-TIMEZONE:%s
  598. X-WR-CALDESC:%s
  599. CALSCALE:GREGORIAN\n" name user timezone description))))
  600. (defun org-finish-icalendar-file ()
  601. "Finish an iCalendar file by inserting the END statement."
  602. (princ "END:VCALENDAR\n"))
  603. (defun org-ical-ts-to-string (s keyword &optional inc)
  604. "Take a time string S and convert it to iCalendar format.
  605. KEYWORD is added in front, to make a complete line like DTSTART....
  606. When INC is non-nil, increase the hour by two (if time string contains
  607. a time), or the day by one (if it does not contain a time)."
  608. (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault)))
  609. t2 fmt have-time time)
  610. (if (not t1)
  611. ""
  612. (if (and (car t1) (nth 1 t1) (nth 2 t1))
  613. (setq t2 t1 have-time t)
  614. (setq t2 (org-parse-time-string s)))
  615. (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
  616. (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
  617. (when inc
  618. (if have-time
  619. (if org-agenda-default-appointment-duration
  620. (setq mi (+ org-agenda-default-appointment-duration mi))
  621. (setq h (+ 2 h)))
  622. (setq d (1+ d))))
  623. (setq time (encode-time s mi h d m y)))
  624. (setq fmt (if have-time
  625. (replace-regexp-in-string "%Z"
  626. org-icalendar-timezone
  627. org-icalendar-date-time-format)
  628. ";VALUE=DATE:%Y%m%d"))
  629. (concat keyword (format-time-string fmt time
  630. (and (org-icalendar-use-UTC-date-timep)
  631. have-time))))))
  632. (provide 'org-icalendar)
  633. ;; arch-tag: 2dee2b6e-9211-4aee-8a47-a3c7e5bc30cf
  634. ;;; org-icalendar.el ends here