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