lisp/org/org-icalendar.el

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