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