lisp/org-icalendar.el

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