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