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