lisp/org-icalendar.el

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