dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

ox-icalendar.el (40017B)


      1 ;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2004-2023 Free Software Foundation, Inc.
      4 
      5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
      6 ;;      Nicolas Goaziou <mail@nicolasgoaziou.fr>
      7 ;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
      8 ;; Keywords: outlines, hypermedia, calendar, wp
      9 ;; URL: https://orgmode.org
     10 
     11 ;; This file is part of GNU Emacs.
     12 
     13 ;; GNU Emacs is free software: you can redistribute it and/or modify
     14 ;; it under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation, either version 3 of the License, or
     16 ;; (at your option) any later version.
     17 
     18 ;; GNU Emacs is distributed in the hope that it will be useful,
     19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     21 ;; GNU General Public License for more details.
     22 
     23 ;; You should have received a copy of the GNU General Public License
     24 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     25 
     26 ;;; Commentary:
     27 ;;
     28 ;; This library implements an iCalendar back-end for Org generic
     29 ;; exporter.  See Org manual for more information.
     30 ;;
     31 ;; It is expected to conform to RFC 5545.
     32 
     33 ;;; Code:
     34 
     35 (require 'org-macs)
     36 (org-assert-version)
     37 
     38 (require 'cl-lib)
     39 (require 'org-agenda)
     40 (require 'ox-ascii)
     41 (declare-function org-bbdb-anniv-export-ical "ol-bbdb" nil)
     42 (declare-function org-at-heading-p "org" (&optional _))
     43 (declare-function org-back-to-heading "org" (&optional invisible-ok))
     44 (declare-function org-next-visible-heading "org" (arg))
     45 
     46 
     47 
     48 ;;; User-Configurable Variables
     49 
     50 (defgroup org-export-icalendar nil
     51   "Options specific for iCalendar export back-end."
     52   :tag "Org Export iCalendar"
     53   :group 'org-export)
     54 
     55 (defcustom org-icalendar-combined-agenda-file "~/org.ics"
     56   "The file name for the iCalendar file covering all agenda files.
     57 This file is created with the command `\\[org-icalendar-combine-agenda-files]'.
     58 The file name should be absolute.  It will be overwritten without warning."
     59   :group 'org-export-icalendar
     60   :type 'file)
     61 
     62 (defcustom org-icalendar-alarm-time 0
     63   "Number of minutes for triggering an alarm for exported timed events.
     64 
     65 A zero value (the default) turns off the definition of an alarm trigger
     66 for timed events.  If non-zero, alarms are created.
     67 
     68 - a single alarm per entry is defined
     69 - The alarm will go off N minutes before the event
     70 - only a DISPLAY action is defined."
     71   :group 'org-export-icalendar
     72   :version "24.1"
     73   :type 'integer)
     74 
     75 (defcustom org-icalendar-force-alarm nil
     76   "Non-nil means alarm will be created even if is set to zero.
     77 
     78 This overrides default behavior where zero means no alarm.  With
     79 this set to non-nil and alarm set to zero, alarm will be created
     80 and will fire at the event start."
     81   :group 'org-export-icalendar
     82   :type 'boolean
     83   :package-version '(Org . "9.6")
     84   :safe #'booleanp)
     85 
     86 (defcustom org-icalendar-combined-name "OrgMode"
     87   "Calendar name for the combined iCalendar representing all agenda files."
     88   :group 'org-export-icalendar
     89   :type 'string)
     90 
     91 (defcustom org-icalendar-combined-description ""
     92   "Calendar description for the combined iCalendar (all agenda files)."
     93   :group 'org-export-icalendar
     94   :type 'string)
     95 
     96 (defcustom org-icalendar-exclude-tags nil
     97   "Tags that exclude a tree from export.
     98 This variable allows specifying different exclude tags from other
     99 back-ends.  It can also be set with the ICALENDAR_EXCLUDE_TAGS
    100 keyword."
    101   :group 'org-export-icalendar
    102   :type '(repeat (string :tag "Tag")))
    103 
    104 (defcustom org-icalendar-scheduled-summary-prefix "S: "
    105   "String prepended to exported scheduled headlines."
    106   :group 'org-export-icalendar
    107   :type 'string
    108   :package-version '(Org . "9.6")
    109   :safe #'stringp)
    110 
    111 
    112 (defcustom org-icalendar-deadline-summary-prefix "DL: "
    113   "String prepended to exported headlines with a deadline."
    114   :group 'org-export-icalendar
    115   :type 'string
    116   :package-version '(Org . "9.6")
    117   :safe #'stringp)
    118 
    119 (defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
    120   "Contexts where iCalendar export should use a deadline time stamp.
    121 
    122 This is a list with possibly several symbols in it.  Valid symbols are:
    123 
    124 `event-if-todo'
    125 
    126   Deadlines in TODO entries become calendar events.
    127 
    128 `event-if-todo-not-done'
    129 
    130   Deadlines in TODO entries with not-DONE state become events.
    131 
    132 `event-if-not-todo'
    133 
    134   Deadlines in non-TODO entries become calendar events.
    135 
    136 `todo-due'
    137 
    138   Use deadlines in TODO entries as due-dates."
    139   :group 'org-export-icalendar
    140   :type
    141   '(set :greedy t
    142 	(const :tag "DEADLINE in non-TODO entries become events"
    143 	       event-if-not-todo)
    144 	(const :tag "DEADLINE in TODO entries become events"
    145 	       event-if-todo)
    146 	(const :tag "DEADLINE in TODO entries with not-DONE state become events"
    147 	       event-if-todo-not-done)
    148 	(const :tag "DEADLINE in TODO entries become due-dates"
    149 	       todo-due)))
    150 
    151 (defcustom org-icalendar-use-scheduled '(todo-start)
    152   "Contexts where iCalendar export should use a scheduling time stamp.
    153 
    154 This is a list with possibly several symbols in it.  Valid symbols are:
    155 
    156 `event-if-todo'
    157 
    158   Scheduling time stamps in TODO entries become an event.
    159 
    160 `event-if-todo-not-done'
    161 
    162   Scheduling time stamps in TODO entries with not-DONE state
    163   become events.
    164 
    165 `event-if-not-todo'
    166 
    167   Scheduling time stamps in non-TODO entries become an event.
    168 
    169 `todo-start'
    170 
    171   Scheduling time stamps in TODO entries become start date.  Some
    172   calendar applications show TODO entries only after that date."
    173   :group 'org-export-icalendar
    174   :type
    175   '(set :greedy t
    176 	(const :tag "SCHEDULED timestamps in non-TODO entries become events"
    177 	       event-if-not-todo)
    178 	(const :tag "SCHEDULED timestamps in TODO entries become events"
    179 	       event-if-todo)
    180 	(const :tag "SCHEDULED in TODO entries with not-DONE state become events"
    181 	       event-if-todo-not-done)
    182 	(const :tag "SCHEDULED in TODO entries become start date"
    183 	       todo-start)))
    184 
    185 (defcustom org-icalendar-categories '(local-tags category)
    186   "Items that should be entered into the \"categories\" field.
    187 
    188 This is a list of symbols, the following are valid:
    189 `category'    The Org mode category of the current file or tree
    190 `todo-state'  The todo state, if any
    191 `local-tags'  The tags, defined in the current line
    192 `all-tags'    All tags, including inherited ones."
    193   :group 'org-export-icalendar
    194   :type '(repeat
    195 	  (choice
    196 	   (const :tag "The file or tree category" category)
    197 	   (const :tag "The TODO state" todo-state)
    198 	   (const :tag "Tags defined in current line" local-tags)
    199 	   (const :tag "All tags, including inherited ones" all-tags))))
    200 
    201 (defcustom org-icalendar-with-timestamps 'active
    202   "Non-nil means make an event from plain time stamps.
    203 
    204 It can be set to `active', `inactive', t or nil, in order to make
    205 an event from, respectively, only active timestamps, only
    206 inactive ones, all of them or none.
    207 
    208 This variable has precedence over `org-export-with-timestamps'.
    209 It can also be set with the #+OPTIONS line, e.g. \"<:t\"."
    210   :group 'org-export-icalendar
    211   :type '(choice
    212 	  (const :tag "All timestamps" t)
    213 	  (const :tag "Only active timestamps" active)
    214 	  (const :tag "Only inactive timestamps" inactive)
    215 	  (const :tag "No timestamp" nil)))
    216 
    217 (defcustom org-icalendar-include-todo nil
    218   "Non-nil means create VTODO components from TODO items.
    219 
    220 Valid values are:
    221 nil                  don't include any task.
    222 t                    include tasks that are not in DONE state.
    223 `unblocked'          include all TODO items that are not blocked.
    224 `all'                include both done and not done items."
    225   :group 'org-export-icalendar
    226   :type '(choice
    227 	  (const :tag "None" nil)
    228 	  (const :tag "Unfinished" t)
    229 	  (const :tag "Unblocked" unblocked)
    230 	  (const :tag "All" all)
    231 	  (repeat :tag "Specific TODO keywords"
    232 		  (string :tag "Keyword"))))
    233 
    234 (defcustom org-icalendar-include-bbdb-anniversaries nil
    235   "Non-nil means a combined iCalendar file should include anniversaries.
    236 The anniversaries are defined in the BBDB database."
    237   :group 'org-export-icalendar
    238   :type 'boolean)
    239 
    240 (defcustom org-icalendar-include-sexps t
    241   "Non-nil means export to iCalendar files should also cover sexp entries.
    242 These are entries like in the diary, but directly in an Org file."
    243   :group 'org-export-icalendar
    244   :type 'boolean)
    245 
    246 (defcustom org-icalendar-include-body t
    247   "Amount of text below headline to be included in iCalendar export.
    248 This is a number of characters that should maximally be included.
    249 Properties, scheduling and clocking lines will always be removed.
    250 The text will be inserted into the DESCRIPTION field."
    251   :group 'org-export-icalendar
    252   :type '(choice
    253 	  (const :tag "Nothing" nil)
    254 	  (const :tag "Everything" t)
    255 	  (integer :tag "Max characters")))
    256 
    257 (defcustom org-icalendar-store-UID nil
    258   "Non-nil means store any created UIDs in properties.
    259 
    260 The iCalendar standard requires that all entries have a unique identifier.
    261 Org will create these identifiers as needed.  When this variable is non-nil,
    262 the created UIDs will be stored in the ID property of the entry.  Then the
    263 next time this entry is exported, it will be exported with the same UID,
    264 superseding the previous form of it.  This is essential for
    265 synchronization services.
    266 
    267 This variable is not turned on by default because we want to avoid creating
    268 a property drawer in every entry if people are only playing with this feature,
    269 or if they are only using it locally."
    270   :group 'org-export-icalendar
    271   :type 'boolean)
    272 
    273 (defcustom org-icalendar-timezone (getenv "TZ")
    274   "The time zone string for iCalendar export.
    275 When nil or the empty string, use output
    276 from (current-time-zone)."
    277   :group 'org-export-icalendar
    278   :type '(choice
    279 	  (const :tag "Unspecified" nil)
    280 	  (string :tag "Time zone")))
    281 
    282 (defcustom org-icalendar-date-time-format ":%Y%m%dT%H%M%S"
    283   "Format-string for exporting icalendar DATE-TIME.
    284 
    285 See `format-time-string' for a full documentation.  The only
    286 difference is that `org-icalendar-timezone' is used for %Z.
    287 
    288 Interesting value are:
    289  - \":%Y%m%dT%H%M%S\" for local time
    290  - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone
    291  - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
    292   :group 'org-export-icalendar
    293   :version "24.1"
    294   :type '(choice
    295 	  (const :tag "Local time" ":%Y%m%dT%H%M%S")
    296 	  (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
    297 	  (const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
    298 	  (string :tag "Explicit format")))
    299 
    300 (defvar org-icalendar-after-save-hook nil
    301   "Hook run after an iCalendar file has been saved.
    302 This hook is run with the name of the file as argument.  A good
    303 way to use this is to tell a desktop calendar application to
    304 re-read the iCalendar file.")
    305 
    306 
    307 
    308 ;;; Define Back-End
    309 
    310 (org-export-define-derived-backend 'icalendar 'ascii
    311   :translate-alist '((clock . nil)
    312 		     (footnote-definition . nil)
    313 		     (footnote-reference . nil)
    314 		     (headline . org-icalendar-entry)
    315                      (inner-template . org-icalendar-inner-template)
    316 		     (inlinetask . nil)
    317 		     (planning . nil)
    318 		     (section . nil)
    319 		     (template . org-icalendar-template))
    320   :options-alist
    321   '((:exclude-tags
    322      "ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split)
    323     (:with-timestamps nil "<" org-icalendar-with-timestamps)
    324     ;; Other variables.
    325     (:icalendar-alarm-time nil nil org-icalendar-alarm-time)
    326     (:icalendar-categories nil nil org-icalendar-categories)
    327     (:icalendar-date-time-format nil nil org-icalendar-date-time-format)
    328     (:icalendar-include-bbdb-anniversaries nil nil org-icalendar-include-bbdb-anniversaries)
    329     (:icalendar-include-body nil nil org-icalendar-include-body)
    330     (:icalendar-include-sexps nil nil org-icalendar-include-sexps)
    331     (:icalendar-include-todo nil nil org-icalendar-include-todo)
    332     (:icalendar-store-UID nil nil org-icalendar-store-UID)
    333     (:icalendar-timezone nil nil org-icalendar-timezone)
    334     (:icalendar-use-deadline nil nil org-icalendar-use-deadline)
    335     (:icalendar-use-scheduled nil nil org-icalendar-use-scheduled)
    336     (:icalendar-scheduled-summary-prefix nil nil org-icalendar-scheduled-summary-prefix)
    337     (:icalendar-deadline-summary-prefix nil nil org-icalendar-deadline-summary-prefix))
    338   :filters-alist
    339   '((:filter-headline . org-icalendar-clear-blank-lines))
    340   :menu-entry
    341   '(?c "Export to iCalendar"
    342        ((?f "Current file" org-icalendar-export-to-ics)
    343 	(?a "All agenda files"
    344 	    (lambda (a s v b) (org-icalendar-export-agenda-files a)))
    345 	(?c "Combine all agenda files"
    346 	    (lambda (a s v b) (org-icalendar-combine-agenda-files a))))))
    347 
    348 
    349 
    350 ;;; Internal Functions
    351 
    352 (defun org-icalendar-create-uid (file &optional bell)
    353   "Set ID property on headlines missing it in FILE.
    354 When optional argument BELL is non-nil, inform the user with
    355 a message if the file was modified."
    356   (let (modified-flag)
    357     (org-map-entries
    358      (lambda ()
    359        (let ((entry (org-element-at-point)))
    360 	 (unless (org-element-property :ID entry)
    361 	   (org-id-get-create)
    362 	   (setq modified-flag t)
    363 	   (forward-line))))
    364      nil nil 'comment)
    365     (when (and bell modified-flag)
    366       (message "ID properties created in file \"%s\"" file)
    367       (sit-for 2))))
    368 
    369 (defun org-icalendar-blocked-headline-p (headline info)
    370   "Non-nil when HEADLINE is considered to be blocked.
    371 
    372 INFO is a plist used as a communication channel.
    373 
    374 A headline is blocked when either
    375 
    376   - it has children which are not all in a completed state;
    377 
    378   - it has a parent with the property :ORDERED:, and there are
    379     siblings prior to it with incomplete status;
    380 
    381   - its parent is blocked because it has siblings that should be
    382     done first or is a child of a blocked grandparent entry."
    383   (or
    384    ;; Check if any child is not done.
    385    (org-element-map (org-element-contents headline) 'headline
    386      (lambda (hl) (eq (org-element-property :todo-type hl) 'todo))
    387      info 'first-match)
    388    ;; Check :ORDERED: node property.
    389    (catch 'blockedp
    390      (let ((current headline))
    391        (dolist (parent (org-element-lineage headline))
    392 	 (cond
    393 	  ((not (org-element-property :todo-keyword parent))
    394 	   (throw 'blockedp nil))
    395 	  ((org-not-nil (org-element-property :ORDERED parent))
    396 	   (let ((sibling current))
    397 	     (while (setq sibling (org-export-get-previous-element
    398 				   sibling info))
    399 	       (when (eq (org-element-property :todo-type sibling) 'todo)
    400 		 (throw 'blockedp t)))))
    401 	  (t (setq current parent))))))))
    402 
    403 (defun org-icalendar-use-UTC-date-time-p ()
    404   "Non-nil when `org-icalendar-date-time-format' requires UTC time."
    405   (char-equal (elt org-icalendar-date-time-format
    406 		   (1- (length org-icalendar-date-time-format)))
    407 	      ?Z))
    408 
    409 (defun org-icalendar-convert-timestamp (timestamp keyword &optional end tz)
    410   "Convert TIMESTAMP to iCalendar format.
    411 
    412 TIMESTAMP is a timestamp object.  KEYWORD is added in front of
    413 it, in order to make a complete line (e.g. \"DTSTART\").
    414 
    415 When optional argument END is non-nil, use end of time range.
    416 Also increase the hour by two (if time string contains a time),
    417 or the day by one (if it does not contain a time) when no
    418 explicit ending time is specified.
    419 
    420 When optional argument TZ is non-nil, timezone data time will be
    421 added to the timestamp.  It can be the string \"UTC\", to use UTC
    422 time, or a string in the IANA TZ database
    423 format (e.g. \"Europe/London\").  In either case, the value of
    424 `org-icalendar-date-time-format' will be ignored."
    425   (let* ((year-start (org-element-property :year-start timestamp))
    426 	 (year-end (org-element-property :year-end timestamp))
    427 	 (month-start (org-element-property :month-start timestamp))
    428 	 (month-end (org-element-property :month-end timestamp))
    429 	 (day-start (org-element-property :day-start timestamp))
    430 	 (day-end (org-element-property :day-end timestamp))
    431 	 (hour-start (org-element-property :hour-start timestamp))
    432 	 (hour-end (org-element-property :hour-end timestamp))
    433 	 (minute-start (org-element-property :minute-start timestamp))
    434 	 (minute-end (org-element-property :minute-end timestamp))
    435 	 (with-time-p minute-start)
    436 	 (equal-bounds-p
    437 	  (equal (list year-start month-start day-start hour-start minute-start)
    438 		 (list year-end month-end day-end hour-end minute-end)))
    439 	 (mi (cond ((not with-time-p) 0)
    440 		   ((not end) minute-start)
    441 		   ((and org-agenda-default-appointment-duration equal-bounds-p)
    442 		    (+ minute-end org-agenda-default-appointment-duration))
    443 		   (t minute-end)))
    444 	 (h (cond ((not with-time-p) 0)
    445 		  ((not end) hour-start)
    446 		  ((or (not equal-bounds-p)
    447 		       org-agenda-default-appointment-duration)
    448 		   hour-end)
    449 		  (t (+ hour-end 2))))
    450 	 (d (cond ((not end) day-start)
    451 		  ((not with-time-p) (1+ day-end))
    452 		  (t day-end)))
    453 	 (m (if end month-end month-start))
    454 	 (y (if end year-end year-start)))
    455     (concat
    456      keyword
    457      (format-time-string
    458       (cond ((string-equal tz "UTC") ":%Y%m%dT%H%M%SZ")
    459 	    ((not with-time-p) ";VALUE=DATE:%Y%m%d")
    460 	    ((stringp tz) (concat ";TZID=" tz ":%Y%m%dT%H%M%S"))
    461 	    (t (replace-regexp-in-string "%Z"
    462 					 org-icalendar-timezone
    463 					 org-icalendar-date-time-format
    464 					 t)))
    465       ;; Convert timestamp into internal time in order to use
    466       ;; `format-time-string' and fix any mistake (i.e. MI >= 60).
    467       (org-encode-time 0 mi h d m y)
    468       (and (or (string-equal tz "UTC")
    469 	       (and (null tz)
    470 		    with-time-p
    471 		    (org-icalendar-use-UTC-date-time-p)))
    472 	   t)))))
    473 
    474 (defun org-icalendar-dtstamp ()
    475   "Return DTSTAMP property, as a string."
    476   (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t))
    477 
    478 (defun org-icalendar-get-categories (entry info)
    479   "Return categories according to `org-icalendar-categories'.
    480 ENTRY is a headline or an inlinetask element.  INFO is a plist
    481 used as a communication channel."
    482   (mapconcat
    483    #'identity
    484    (org-uniquify
    485     (let (categories)
    486       (dolist (type org-icalendar-categories (nreverse categories))
    487 	(cl-case type
    488 	  (category
    489 	   (push (org-export-get-category entry info) categories))
    490 	  (todo-state
    491 	   (let ((todo (org-element-property :todo-keyword entry)))
    492 	     (and todo (push todo categories))))
    493 	  (local-tags
    494 	   (setq categories
    495 		 (append (nreverse (org-export-get-tags entry info))
    496 			 categories)))
    497 	  (all-tags
    498 	   (setq categories
    499 		 (append (nreverse (org-export-get-tags entry info nil t))
    500 			 categories)))))))
    501    ","))
    502 
    503 (defun org-icalendar-transcode-diary-sexp (sexp uid summary)
    504   "Transcode a diary sexp into iCalendar format.
    505 SEXP is the diary sexp being transcoded, as a string.  UID is the
    506 unique identifier for the entry.  SUMMARY defines a short summary
    507 or subject for the event."
    508   (when (require 'icalendar nil t)
    509     (org-element-normalize-string
    510      (with-temp-buffer
    511        (let ((sexp (if (not (string-match "\\`<%%" sexp)) sexp
    512 		     (concat (substring sexp 1 -1) " " summary))))
    513 	 (put-text-property 0 1 'uid uid sexp)
    514 	 (insert sexp "\n"))
    515        (org-diary-to-ical-string (current-buffer))))))
    516 
    517 (defun org-icalendar-cleanup-string (s)
    518   "Cleanup string S according to RFC 5545."
    519   (when s
    520     ;; Protect "\", "," and ";" characters. and replace newline
    521     ;; characters with literal \n.
    522     (replace-regexp-in-string
    523      "[ \t]*\n" "\\n"
    524      (replace-regexp-in-string "[\\,;]" "\\\\\\&" s)
    525      nil t)))
    526 
    527 (defun org-icalendar-fold-string (s)
    528   "Fold string S according to RFC 5545."
    529   (org-element-normalize-string
    530    (mapconcat
    531     (lambda (line)
    532       ;; Limit each line to a maximum of 75 characters.  If it is
    533       ;; longer, fold it by using "\r\n " as a continuation marker.
    534       (let ((len (length line)))
    535 	(if (<= len 75) line
    536 	  (let ((folded-line (substring line 0 75))
    537 		(chunk-start 75)
    538 		chunk-end)
    539 	    ;; Since continuation marker takes up one character on the
    540 	    ;; line, real contents must be split at 74 chars.
    541 	    (while (< (setq chunk-end (+ chunk-start 74)) len)
    542 	      (setq folded-line
    543 		    (concat folded-line "\r\n "
    544 			    (substring line chunk-start chunk-end))
    545 		    chunk-start chunk-end))
    546 	    (concat folded-line "\r\n " (substring line chunk-start))))))
    547     (org-split-string s "\n") "\r\n")))
    548 
    549 
    550 
    551 ;;; Filters
    552 
    553 (defun org-icalendar-clear-blank-lines (headline _back-end _info)
    554   "Remove blank lines in HEADLINE export.
    555 HEADLINE is a string representing a transcoded headline.
    556 BACK-END and INFO are ignored."
    557   (replace-regexp-in-string "^\\(?:[ \t]*\n\\)+" "" headline))
    558 
    559 
    560 
    561 ;;; Transcode Functions
    562 
    563 ;;;; Headline and Inlinetasks
    564 
    565 ;; The main function is `org-icalendar-entry', which extracts
    566 ;; information from a headline or an inlinetask (summary,
    567 ;; description...) and then delegates code generation to
    568 ;; `org-icalendar--vtodo' and `org-icalendar--vevent', depending
    569 ;; on the component needed.
    570 
    571 ;; Obviously, `org-icalendar--valarm' handles alarms, which can
    572 ;; happen within a VTODO component.
    573 
    574 (defun org-icalendar-entry (entry contents info)
    575   "Transcode ENTRY element into iCalendar format.
    576 
    577 ENTRY is either a headline or an inlinetask.  CONTENTS is
    578 ignored.  INFO is a plist used as a communication channel.
    579 
    580 This function is called on every headline, the section below
    581 it (minus inlinetasks) being its contents.  It tries to create
    582 VEVENT and VTODO components out of scheduled date, deadline date,
    583 plain timestamps, diary sexps.  It also calls itself on every
    584 inlinetask within the section."
    585   (unless (org-element-property :footnote-section-p entry)
    586     (let* ((type (org-element-type entry))
    587 	   ;; Determine contents really associated to the entry.  For
    588 	   ;; a headline, limit them to section, if any.  For an
    589 	   ;; inlinetask, this is every element within the task.
    590 	   (inside
    591 	    (if (eq type 'inlinetask)
    592 		(cons 'org-data (cons nil (org-element-contents entry)))
    593 	      (let ((first (car (org-element-contents entry))))
    594 		(and (eq (org-element-type first) 'section)
    595 		     (cons 'org-data
    596 			   (cons nil (org-element-contents first))))))))
    597       (concat
    598        (let ((todo-type (org-element-property :todo-type entry))
    599 	     (uid (or (org-element-property :ID entry) (org-id-new)))
    600 	     (summary (org-icalendar-cleanup-string
    601 		       (or (org-element-property :SUMMARY entry)
    602 			   (org-export-data
    603 			    (org-element-property :title entry) info))))
    604 	     (loc (org-icalendar-cleanup-string
    605 		   (org-export-get-node-property
    606 		    :LOCATION entry
    607 		    (org-property-inherit-p "LOCATION"))))
    608 	     (class (org-icalendar-cleanup-string
    609 		     (org-export-get-node-property
    610 		      :CLASS entry
    611 		      (org-property-inherit-p "CLASS"))))
    612 	     ;; Build description of the entry from associated section
    613 	     ;; (headline) or contents (inlinetask).
    614 	     (desc
    615 	      (org-icalendar-cleanup-string
    616 	       (or (org-element-property :DESCRIPTION entry)
    617 		   (let ((contents (org-export-data inside info)))
    618 		     (cond
    619 		      ((not (org-string-nw-p contents)) nil)
    620 		      ((wholenump org-icalendar-include-body)
    621 		       (let ((contents (org-trim contents)))
    622 			 (substring
    623 			  contents 0 (min (length contents)
    624 					  org-icalendar-include-body))))
    625 		      (org-icalendar-include-body (org-trim contents)))))))
    626 	     (cat (org-icalendar-get-categories entry info))
    627 	     (tz (org-export-get-node-property
    628 		  :TIMEZONE entry
    629 		  (org-property-inherit-p "TIMEZONE"))))
    630 	 (concat
    631 	  ;; Events: Delegate to `org-icalendar--vevent' to generate
    632 	  ;; "VEVENT" component from scheduled, deadline, or any
    633 	  ;; timestamp in the entry.
    634 	  (let ((deadline (org-element-property :deadline entry))
    635 		(use-deadline (plist-get info :icalendar-use-deadline))
    636                 (deadline-summary-prefix (org-icalendar-cleanup-string
    637                                           (plist-get info :icalendar-deadline-summary-prefix))))
    638 	    (and deadline
    639 		 (pcase todo-type
    640 		   (`todo (or (memq 'event-if-todo-not-done use-deadline)
    641 			      (memq 'event-if-todo use-deadline)))
    642 		   (`done (memq 'event-if-todo use-deadline))
    643 		   (_ (memq 'event-if-not-todo use-deadline)))
    644 		 (org-icalendar--vevent
    645 		  entry deadline (concat "DL-" uid)
    646 		  (concat deadline-summary-prefix summary)
    647                   loc desc cat tz class)))
    648 	  (let ((scheduled (org-element-property :scheduled entry))
    649 		(use-scheduled (plist-get info :icalendar-use-scheduled))
    650                 (scheduled-summary-prefix (org-icalendar-cleanup-string
    651                                            (plist-get info :icalendar-scheduled-summary-prefix))))
    652 	    (and scheduled
    653 		 (pcase todo-type
    654 		   (`todo (or (memq 'event-if-todo-not-done use-scheduled)
    655 			      (memq 'event-if-todo use-scheduled)))
    656 		   (`done (memq 'event-if-todo use-scheduled))
    657 		   (_ (memq 'event-if-not-todo use-scheduled)))
    658 		 (org-icalendar--vevent
    659 		  entry scheduled (concat "SC-" uid)
    660 		  (concat scheduled-summary-prefix summary)
    661                   loc desc cat tz class)))
    662 	  ;; When collecting plain timestamps from a headline and its
    663 	  ;; title, skip inlinetasks since collection will happen once
    664 	  ;; ENTRY is one of them.
    665 	  (let ((counter 0))
    666 	    (mapconcat
    667 	     #'identity
    668 	     (org-element-map (cons (org-element-property :title entry)
    669 				    (org-element-contents inside))
    670 		 'timestamp
    671 	       (lambda (ts)
    672 		 (when (let ((type (org-element-property :type ts)))
    673 			 (cl-case (plist-get info :with-timestamps)
    674 			   (active (memq type '(active active-range)))
    675 			   (inactive (memq type '(inactive inactive-range)))
    676 			   ((t) t)))
    677 		   (let ((uid (format "TS%d-%s" (cl-incf counter) uid)))
    678 		     (org-icalendar--vevent
    679 		      entry ts uid summary loc desc cat tz class))))
    680 	       info nil (and (eq type 'headline) 'inlinetask))
    681 	     ""))
    682 	  ;; Task: First check if it is appropriate to export it.  If
    683 	  ;; so, call `org-icalendar--vtodo' to transcode it into
    684 	  ;; a "VTODO" component.
    685 	  (when (and todo-type
    686 		     (cl-case (plist-get info :icalendar-include-todo)
    687 		       (all t)
    688 		       (unblocked
    689 			(and (eq type 'headline)
    690 			     (not (org-icalendar-blocked-headline-p
    691 				   entry info))))
    692 		       ((t) (eq todo-type 'todo))))
    693 	    (org-icalendar--vtodo entry uid summary loc desc cat tz class))
    694 	  ;; Diary-sexp: Collect every diary-sexp element within ENTRY
    695 	  ;; and its title, and transcode them.  If ENTRY is
    696 	  ;; a headline, skip inlinetasks: they will be handled
    697 	  ;; separately.
    698 	  (when org-icalendar-include-sexps
    699 	    (let ((counter 0))
    700 	      (mapconcat #'identity
    701 			 (org-element-map
    702 			     (cons (org-element-property :title entry)
    703 				   (org-element-contents inside))
    704 			     'diary-sexp
    705 			   (lambda (sexp)
    706 			     (org-icalendar-transcode-diary-sexp
    707 			      (org-element-property :value sexp)
    708 			      (format "DS%d-%s" (cl-incf counter) uid)
    709 			      summary))
    710 			   info nil (and (eq type 'headline) 'inlinetask))
    711 			 "")))))
    712        ;; If ENTRY is a headline, call current function on every
    713        ;; inlinetask within it.  In agenda export, this is independent
    714        ;; from the mark (or lack thereof) on the entry.
    715        (when (eq type 'headline)
    716 	 (mapconcat #'identity
    717 		    (org-element-map inside 'inlinetask
    718 		      (lambda (task) (org-icalendar-entry task nil info))
    719 		      info) ""))
    720        ;; Don't forget components from inner entries.
    721        contents))))
    722 
    723 (defun org-icalendar--vevent
    724     (entry timestamp uid summary location description categories timezone class)
    725   "Create a VEVENT component.
    726 
    727 ENTRY is either a headline or an inlinetask element.  TIMESTAMP
    728 is a timestamp object defining the date-time of the event.  UID
    729 is the unique identifier for the event.  SUMMARY defines a short
    730 summary or subject for the event.  LOCATION defines the intended
    731 venue for the event.  DESCRIPTION provides the complete
    732 description of the event.  CATEGORIES defines the categories the
    733 event belongs to.  TIMEZONE specifies a time zone for this event
    734 only.  CLASS contains the visibility attribute.  Three of them
    735 (\"PUBLIC\", \"CONFIDENTIAL\", and \"PRIVATE\") are predefined, others
    736 should be treated as \"PRIVATE\" if they are unknown to the iCalendar server.
    737 
    738 Return VEVENT component as a string."
    739   (org-icalendar-fold-string
    740    (if (eq (org-element-property :type timestamp) 'diary)
    741        (org-icalendar-transcode-diary-sexp
    742 	(org-element-property :raw-value timestamp) uid summary)
    743      (concat "BEGIN:VEVENT\n"
    744 	     (org-icalendar-dtstamp) "\n"
    745 	     "UID:" uid "\n"
    746 	     (org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n"
    747 	     (org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n"
    748 	     ;; RRULE.
    749 	     (when (org-element-property :repeater-type timestamp)
    750 	       (format "RRULE:FREQ=%s;INTERVAL=%d\n"
    751 		       (cl-case (org-element-property :repeater-unit timestamp)
    752 			 (hour "HOURLY") (day "DAILY") (week "WEEKLY")
    753 			 (month "MONTHLY") (year "YEARLY"))
    754 		       (org-element-property :repeater-value timestamp)))
    755 	     "SUMMARY:" summary "\n"
    756 	     (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
    757 	     (and (org-string-nw-p class) (format "CLASS:%s\n" class))
    758 	     (and (org-string-nw-p description)
    759 		  (format "DESCRIPTION:%s\n" description))
    760 	     "CATEGORIES:" categories "\n"
    761 	     ;; VALARM.
    762 	     (org-icalendar--valarm entry timestamp summary)
    763 	     "END:VEVENT"))))
    764 
    765 (defun org-icalendar--vtodo
    766     (entry uid summary location description categories timezone class)
    767   "Create a VTODO component.
    768 
    769 ENTRY is either a headline or an inlinetask element.  UID is the
    770 unique identifier for the task.  SUMMARY defines a short summary
    771 or subject for the task.  LOCATION defines the intended venue for
    772 the task.  DESCRIPTION provides the complete description of the
    773 task.  CATEGORIES defines the categories the task belongs to.
    774 TIMEZONE specifies a time zone for this TODO only.
    775 
    776 Return VTODO component as a string."
    777   (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled)
    778 			(org-element-property :scheduled entry))
    779 		   ;; If we can't use a scheduled time for some
    780 		   ;; reason, start task now.
    781 		   (let ((now (decode-time)))
    782 		     (list 'timestamp
    783 			   (list :type 'active
    784 				 :minute-start (nth 1 now)
    785 				 :hour-start (nth 2 now)
    786 				 :day-start (nth 3 now)
    787 				 :month-start (nth 4 now)
    788 				 :year-start (nth 5 now)))))))
    789     (org-icalendar-fold-string
    790      (concat "BEGIN:VTODO\n"
    791 	     "UID:TODO-" uid "\n"
    792 	     (org-icalendar-dtstamp) "\n"
    793 	     (org-icalendar-convert-timestamp start "DTSTART" nil timezone) "\n"
    794 	     (and (memq 'todo-due org-icalendar-use-deadline)
    795 		  (org-element-property :deadline entry)
    796 		  (concat (org-icalendar-convert-timestamp
    797 			   (org-element-property :deadline entry) "DUE" nil timezone)
    798 			  "\n"))
    799 	     "SUMMARY:" summary "\n"
    800 	     (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
    801 	     (and (org-string-nw-p class) (format "CLASS:%s\n" class))
    802 	     (and (org-string-nw-p description)
    803 		  (format "DESCRIPTION:%s\n" description))
    804 	     "CATEGORIES:" categories "\n"
    805 	     "SEQUENCE:1\n"
    806 	     (format "PRIORITY:%d\n"
    807 		     (let ((pri (or (org-element-property :priority entry)
    808 				    org-priority-default)))
    809 		       (floor (- 9 (* 8. (/ (float (- org-priority-lowest pri))
    810 					    (- org-priority-lowest
    811 					       org-priority-highest)))))))
    812 	     (format "STATUS:%s\n"
    813 		     (if (eq (org-element-property :todo-type entry) 'todo)
    814 			 "NEEDS-ACTION"
    815 		       "COMPLETED"))
    816 	     "END:VTODO"))))
    817 
    818 (defun org-icalendar--valarm (entry timestamp summary)
    819   "Create a VALARM component.
    820 
    821 ENTRY is the calendar entry triggering the alarm.  TIMESTAMP is
    822 the start date-time of the entry.  SUMMARY defines a short
    823 summary or subject for the task.
    824 
    825 Return VALARM component as a string, or nil if it isn't allowed."
    826   ;; Create a VALARM entry if the entry is timed.  This is not very
    827   ;; general in that:
    828   ;; (a) only one alarm per entry is defined,
    829   ;; (b) only minutes are allowed for the trigger period ahead of the
    830   ;;     start time,
    831   ;; (c) only a DISPLAY action is defined.                       [ESF]
    832   (let ((alarm-time
    833 	 (let ((warntime
    834 		(org-element-property :APPT_WARNTIME entry)))
    835 	   (if warntime (string-to-number warntime) nil))))
    836     (and (or (and alarm-time
    837 		  (> alarm-time 0))
    838 	     (> org-icalendar-alarm-time 0)
    839 	     org-icalendar-force-alarm)
    840 	 (org-element-property :hour-start timestamp)
    841 	 (format "BEGIN:VALARM
    842 ACTION:DISPLAY
    843 DESCRIPTION:%s
    844 TRIGGER:-P0DT0H%dM0S
    845 END:VALARM\n"
    846 		 summary
    847                  (cond
    848                   ((and alarm-time org-icalendar-force-alarm) alarm-time)
    849                   ((and alarm-time (not (zerop alarm-time))) alarm-time)
    850                   (t org-icalendar-alarm-time))))))
    851 
    852 ;;;; Template
    853 
    854 (defun org-icalendar-inner-template (contents _)
    855   "Return document body string after iCalendar conversion.
    856 CONTENTS is the transcoded contents string."
    857   contents)
    858 
    859 (defun org-icalendar-template (contents info)
    860   "Return complete document string after iCalendar conversion.
    861 CONTENTS is the transcoded contents string.  INFO is a plist used
    862 as a communication channel."
    863   (org-icalendar--vcalendar
    864    ;; Name.
    865    (if (not (plist-get info :input-file)) (buffer-name (buffer-base-buffer))
    866      (file-name-nondirectory
    867       (file-name-sans-extension (plist-get info :input-file))))
    868    ;; Owner.
    869    (if (not (plist-get info :with-author)) ""
    870      (org-export-data (plist-get info :author) info))
    871    ;; Timezone.
    872    (or (org-string-nw-p org-icalendar-timezone) (format-time-string "%Z"))
    873    ;; Description.
    874    (org-export-data (plist-get info :title) info)
    875    contents))
    876 
    877 (defun org-icalendar--vcalendar (name owner tz description contents)
    878   "Create a VCALENDAR component.
    879 NAME, OWNER, TZ, DESCRIPTION and CONTENTS are all strings giving,
    880 respectively, the name of the calendar, its owner, the timezone
    881 used, a short description and the other components included."
    882   (concat (format "BEGIN:VCALENDAR
    883 VERSION:2.0
    884 X-WR-CALNAME:%s
    885 PRODID:-//%s//Emacs with Org mode//EN
    886 X-WR-TIMEZONE:%s
    887 X-WR-CALDESC:%s
    888 CALSCALE:GREGORIAN\n"
    889 		  (org-icalendar-cleanup-string name)
    890 		  (org-icalendar-cleanup-string owner)
    891 		  (org-icalendar-cleanup-string tz)
    892 		  (org-icalendar-cleanup-string description))
    893 	  contents
    894 	  "END:VCALENDAR\n"))
    895 
    896 
    897 
    898 ;;; Interactive Functions
    899 
    900 ;;;###autoload
    901 (defun org-icalendar-export-to-ics
    902     (&optional async subtreep visible-only body-only)
    903   "Export current buffer to an iCalendar file.
    904 
    905 If narrowing is active in the current buffer, only export its
    906 narrowed part.
    907 
    908 If a region is active, export that region.
    909 
    910 A non-nil optional argument ASYNC means the process should happen
    911 asynchronously.  The resulting file should be accessible through
    912 the `org-export-stack' interface.
    913 
    914 When optional argument SUBTREEP is non-nil, export the sub-tree
    915 at point, extracting information from the headline properties
    916 first.
    917 
    918 When optional argument VISIBLE-ONLY is non-nil, don't export
    919 contents of hidden elements.
    920 
    921 When optional argument BODY-ONLY is non-nil, only write code
    922 between \"BEGIN:VCALENDAR\" and \"END:VCALENDAR\".
    923 
    924 Return ICS file name."
    925   (interactive)
    926   (let ((file (buffer-file-name (buffer-base-buffer))))
    927     (when (and file org-icalendar-store-UID)
    928       (org-icalendar-create-uid file 'warn-user)))
    929   ;; Export part.  Since this back-end is backed up by `ascii', ensure
    930   ;; links will not be collected at the end of sections.
    931   (let ((outfile (org-export-output-file-name ".ics" subtreep)))
    932     (org-export-to-file 'icalendar outfile
    933       async subtreep visible-only body-only
    934       '(:ascii-charset utf-8 :ascii-links-to-notes nil)
    935       '(lambda (file)
    936 	 (run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
    937 
    938 ;;;###autoload
    939 (defun org-icalendar-export-agenda-files (&optional async)
    940   "Export all agenda files to iCalendar files.
    941 When optional argument ASYNC is non-nil, export happens in an
    942 external process."
    943   (interactive)
    944   (if async
    945       ;; Asynchronous export is not interactive, so we will not call
    946       ;; `org-check-agenda-file'.  Instead we remove any non-existent
    947       ;; agenda file from the list.
    948       (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t))))
    949 	(org-export-async-start
    950 	    (lambda (results)
    951 	      (dolist (f results) (org-export-add-to-stack f 'icalendar)))
    952 	  `(let (output-files)
    953 	     (dolist (file ',files outputfiles)
    954 	       (with-current-buffer (org-get-agenda-file-buffer file)
    955 		 (push (expand-file-name (org-icalendar-export-to-ics))
    956 		       output-files))))))
    957     (let ((files (org-agenda-files t)))
    958       (org-agenda-prepare-buffers files)
    959       (unwind-protect
    960 	  (dolist (file files)
    961 	    (catch 'nextfile
    962 	      (org-check-agenda-file file)
    963 	      (with-current-buffer (org-get-agenda-file-buffer file)
    964 		(org-icalendar-export-to-ics))))
    965 	(org-release-buffers org-agenda-new-buffers)))))
    966 
    967 ;;;###autoload
    968 (defun org-icalendar-combine-agenda-files (&optional async)
    969   "Combine all agenda files into a single iCalendar file.
    970 
    971 A non-nil optional argument ASYNC means the process should happen
    972 asynchronously.  The resulting file should be accessible through
    973 the `org-export-stack' interface.
    974 
    975 The file is stored under the name chosen in
    976 `org-icalendar-combined-agenda-file'."
    977   (interactive)
    978   (if async
    979       (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t))))
    980 	(org-export-async-start
    981 	    (lambda (_)
    982 	      (org-export-add-to-stack
    983 	       (expand-file-name org-icalendar-combined-agenda-file)
    984 	       'icalendar))
    985 	  `(apply #'org-icalendar--combine-files ',files)))
    986     (apply #'org-icalendar--combine-files (org-agenda-files t))))
    987 
    988 (defun org-icalendar-export-current-agenda (file)
    989   "Export current agenda view to an iCalendar FILE.
    990 This function assumes major mode for current buffer is
    991 `org-agenda-mode'."
    992   (let* ((org-export-use-babel)		;don't evaluate Babel blocks
    993 	 (contents
    994 	  (org-export-string-as
    995 	   (with-output-to-string
    996 	     (save-excursion
    997 	       (let ((p (point-min))
    998 		     (seen nil))	;prevent duplicates
    999 		 (while (setq p (next-single-property-change p 'org-hd-marker))
   1000 		   (let ((m (get-text-property p 'org-hd-marker)))
   1001 		     (when (and m (not (member m seen)))
   1002 		       (push m seen)
   1003 		       (with-current-buffer (marker-buffer m)
   1004 			 (org-with-wide-buffer
   1005 			  (goto-char (marker-position m))
   1006 			  (princ
   1007 			   (org-element-normalize-string
   1008 			    (buffer-substring (point)
   1009 					      (org-entry-end-position))))))))
   1010 		   (forward-line)))))
   1011 	   'icalendar t
   1012 	   '(:ascii-charset utf-8 :ascii-links-to-notes nil
   1013 			    :icalendar-include-todo all))))
   1014     (with-temp-file file
   1015       (insert
   1016        (org-icalendar--vcalendar
   1017 	org-icalendar-combined-name
   1018 	user-full-name
   1019 	(or (org-string-nw-p org-icalendar-timezone) (format-time-string "%Z"))
   1020 	org-icalendar-combined-description
   1021 	contents)))
   1022     (run-hook-with-args 'org-icalendar-after-save-hook file)))
   1023 
   1024 (defun org-icalendar--combine-files (&rest files)
   1025   "Combine entries from multiple files into an iCalendar file.
   1026 FILES is a list of files to build the calendar from."
   1027   ;; At the end of the process, all buffers related to FILES are going
   1028   ;; to be killed.  Make sure to only kill the ones opened in the
   1029   ;; process.
   1030   (let ((org-agenda-new-buffers nil))
   1031     (unwind-protect
   1032 	(progn
   1033 	  (with-temp-file org-icalendar-combined-agenda-file
   1034 	    (insert
   1035 	     (org-icalendar--vcalendar
   1036 	      ;; Name.
   1037 	      org-icalendar-combined-name
   1038 	      ;; Owner.
   1039 	      user-full-name
   1040 	      ;; Timezone.
   1041 	      (or (org-string-nw-p org-icalendar-timezone)
   1042 		  (format-time-string "%Z"))
   1043 	      ;; Description.
   1044 	      org-icalendar-combined-description
   1045 	      ;; Contents.
   1046 	      (concat
   1047 	       ;; Agenda contents.
   1048 	       (mapconcat
   1049 		(lambda (file)
   1050 		  (catch 'nextfile
   1051 		    (org-check-agenda-file file)
   1052 		    (with-current-buffer (org-get-agenda-file-buffer file)
   1053 		      ;; Create ID if necessary.
   1054 		      (when org-icalendar-store-UID
   1055 			(org-icalendar-create-uid file t))
   1056 		      (org-export-as
   1057 		       'icalendar nil nil t
   1058 		       '(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
   1059 		files "")
   1060 	       ;; BBDB anniversaries.
   1061 	       (when (and org-icalendar-include-bbdb-anniversaries
   1062 			  (require 'ol-bbdb nil t))
   1063 		 (with-output-to-string (org-bbdb-anniv-export-ical)))))))
   1064 	  (run-hook-with-args 'org-icalendar-after-save-hook
   1065 			      org-icalendar-combined-agenda-file))
   1066       (org-release-buffers org-agenda-new-buffers))))
   1067 
   1068 
   1069 (provide 'ox-icalendar)
   1070 
   1071 ;; Local variables:
   1072 ;; generated-autoload-file: "org-loaddefs.el"
   1073 ;; End:
   1074 
   1075 ;;; ox-icalendar.el ends here