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