lisp/org/org-icalendar.el

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