lisp/org/org-icalendar.el

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