lisp/org-icalendar.el

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