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