lisp/org-icalendar.el

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