code.delx.au - gnu-emacs/blob - lisp/calendar/icalendar.el

   1 ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
   2
   3 ;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
   4
   5 ;; Author:         Ulf Jasper <ulf.jasper@web.de>
   6 ;; Created:        August 2002
   7 ;; Keywords:       calendar
   8 ;; Human-Keywords: calendar, diary, iCalendar, vCalendar
   9 ;; Version:        0.19
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; This package is documented in the Emacs Manual.
  29
  30 ;;   Please note:
  31 ;; - Diary entries which have a start time but no end time are assumed to
  32 ;;   last for one hour when they are exported.
  33 ;; - Weekly diary entries are assumed to occur the first time in the first
  34 ;;   week of the year 2000 when they are exported.
  35 ;; - Yearly diary entries are assumed to occur the first time in the year
  36 ;;   1900 when they are exported.
  37 ;; - Float diary entries are assumed to occur the first time on the
  38 ;;   day when they are exported.
  39
  40 ;;; History:
  41
  42 ;;  0.07 onwards: see lisp/ChangeLog
  43
  44 ;;  0.06:  (2004-10-06)
  45 ;;  - Bugfixes regarding icalendar-import-format-*.
  46 ;;  - Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau.
  47
  48 ;;  0.05: (2003-06-19)
  49 ;;  - New import format scheme: Replaced icalendar-import-prefix-*,
  50 ;;    icalendar-import-ignored-properties, and
  51 ;;    icalendar-import-separator with icalendar-import-format(-*).
  52 ;;  - icalendar-import-file and icalendar-convert-diary-to-ical
  53 ;;    have an extra parameter which should prevent them from
  54 ;;    erasing their target files (untested!).
  55 ;;  - Tested with Emacs 21.3.2
  56
  57 ;;  0.04:
  58 ;;  - Bugfix: import: double quoted param values did not work
  59 ;;  - Read DURATION property when importing.
  60 ;;  - Added parameter icalendar-duration-correction.
  61
  62 ;;  0.03: (2003-05-07)
  63 ;;  - Export takes care of european-calendar-style.
  64 ;;  - Tested with Emacs 21.3.2 and XEmacs 21.4.12
  65
  66 ;;  0.02:
  67 ;;  - Should work in XEmacs now.  Thanks to Len Trigg for the XEmacs patches!
  68 ;;  - Added exporting from Emacs diary to ical.
  69 ;;  - Some bugfixes, after testing with calendars from http://icalshare.com.
  70 ;;  - Tested with Emacs 21.3.2 and XEmacs 21.4.12
  71
  72 ;;  0.01: (2003-03-21)
  73 ;;  - First published version.  Trial version.  Alpha version.
  74
  75 ;; ======================================================================
  76 ;; To Do:
  77
  78 ;;  * Import from ical to diary:
  79 ;;    + Need more properties for icalendar-import-format
  80 ;;      (added all that Mozilla Calendar uses)
  81 ;;      From iCal specifications (RFC2445: 4.8.1), icalendar.el lacks
  82 ;;      ATTACH, CATEGORIES, COMMENT, GEO, PERCENT-COMPLETE (VTODO),
  83 ;;      PRIORITY, RESOURCES) not considering date/time and time-zone
  84 ;;    + check vcalendar version
  85 ;;    + check (unknown) elements
  86 ;;    + recurring events!
  87 ;;    + works for european style calendars only! Does it?
  88 ;;    + alarm
  89 ;;    + exceptions in recurring events
  90 ;;    + the parser is too soft
  91 ;;    + error log is incomplete
  92 ;;    + nice to have: #include "webcal://foo.com/some-calendar.ics"
  93 ;;    + timezones probably still need some improvements.
  94
  95 ;;  * Export from diary to ical
  96 ;;    + diary-date, diary-float, and self-made sexp entries are not
  97 ;;      understood
  98
  99 ;;  * Other things
 100 ;;    + clean up all those date/time parsing functions
 101 ;;    + Handle todo items?
 102 ;;    + Check iso 8601 for datetime and period
 103 ;;    + Which chars to (un)escape?
 104
 105
 106 ;;; Code:
 107
 108 (defconst icalendar-version "0.19"
 109   "Version number of icalendar.el.")
 110
 111 ;; ======================================================================
 112 ;; Customizables
 113 ;; ======================================================================
 114 (defgroup icalendar nil
 115   "iCalendar support."
 116   :prefix "icalendar-"
 117   :group 'calendar)
 118
 119 (defcustom icalendar-import-format
 120   "%s%d%l%o"
 121   "Format for importing events from iCalendar into Emacs diary.
 122 It defines how iCalendar events are inserted into diary file.
 123 This may either be a string or a function.
 124
 125 In case of a formatting STRING the following specifiers can be used:
 126 %c Class, see `icalendar-import-format-class'
 127 %d Description, see `icalendar-import-format-description'
 128 %l Location, see `icalendar-import-format-location'
 129 %o Organizer, see `icalendar-import-format-organizer'
 130 %s Summary, see `icalendar-import-format-summary'
 131 %t Status, see `icalendar-import-format-status'
 132 %u URL, see `icalendar-import-format-url'
 133 %U UID, see `icalendar-import-format-uid'
 134
 135 A formatting FUNCTION will be called with a VEVENT as its only
 136 argument.  It must return a string.  See
 137 `icalendar-import-format-sample' for an example."
 138   :type '(choice
 139           (string :tag "String")
 140           (function :tag "Function"))
 141   :group 'icalendar)
 142
 143 (defcustom icalendar-import-format-summary
 144   "%s"
 145   "Format string defining how the summary element is formatted.
 146 This applies only if the summary is not empty! `%s' is replaced
 147 by the summary."
 148   :type 'string
 149   :group 'icalendar)
 150
 151 (defcustom icalendar-import-format-description
 152   "\n Desc: %s"
 153   "Format string defining how the description element is formatted.
 154 This applies only if the description is not empty! `%s' is
 155 replaced by the description."
 156   :type 'string
 157   :group 'icalendar)
 158
 159 (defcustom icalendar-import-format-location
 160   "\n Location: %s"
 161   "Format string defining how the location element is formatted.
 162 This applies only if the location is not empty! `%s' is replaced
 163 by the location."
 164   :type 'string
 165   :group 'icalendar)
 166
 167 (defcustom icalendar-import-format-organizer
 168   "\n Organizer: %s"
 169   "Format string defining how the organizer element is formatted.
 170 This applies only if the organizer is not empty! `%s' is
 171 replaced by the organizer."
 172   :type 'string
 173   :group 'icalendar)
 174
 175 (defcustom icalendar-import-format-url
 176   "\n URL: %s"
 177   "Format string defining how the URL element is formatted.
 178 This applies only if the URL is not empty! `%s' is replaced by
 179 the URL."
 180   :type 'string
 181   :group 'icalendar)
 182
 183 (defcustom icalendar-import-format-uid
 184   "\n UID: %s"
 185   "Format string defining how the UID element is formatted.
 186 This applies only if the UID is not empty! `%s' is replaced by
 187 the UID."
 188   :type 'string
 189   :version "24.3"
 190   :group 'icalendar)
 191
 192 (defcustom icalendar-import-format-status
 193   "\n Status: %s"
 194   "Format string defining how the status element is formatted.
 195 This applies only if the status is not empty! `%s' is replaced by
 196 the status."
 197   :type 'string
 198   :group 'icalendar)
 199
 200 (defcustom icalendar-import-format-class
 201   "\n Class: %s"
 202   "Format string defining how the class element is formatted.
 203 This applies only if the class is not empty! `%s' is replaced by
 204 the class."
 205   :type 'string
 206   :group 'icalendar)
 207
 208 (defcustom icalendar-recurring-start-year
 209   2005
 210   "Start year for recurring events.
 211 Some calendar browsers only propagate recurring events for
 212 several years beyond the start time.  Set this string to a year
 213 just before the start of your personal calendar."
 214   :type 'integer
 215   :group 'icalendar)
 216
 217 (defcustom icalendar-export-hidden-diary-entries
 218   t
 219   "Determines whether hidden diary entries are exported.
 220 If non-nil hidden diary entries (starting with `&') get exported,
 221 if nil they are ignored."
 222   :type 'boolean
 223   :group 'icalendar)
 224
 225 (defcustom icalendar-uid-format
 226   "emacs%t%c"
 227   "Format of unique ID code (UID) for each iCalendar object.
 228 The following specifiers are available:
 229 %c COUNTER, an integer value that is increased each time a uid is
 230    generated.  This may be necessary for systems which do not
 231    provide time-resolution finer than a second.
 232 %h HASH, a hash value of the diary entry,
 233 %s DTSTART, the start date (excluding time) of the diary entry,
 234 %t TIMESTAMP, a unique creation timestamp,
 235 %u USERNAME, the variable `user-login-name'.
 236
 237 For example, a value of \"%s_%h@mydomain.com\" will generate a
 238 UID code for each entry composed of the time of the event, a hash
 239 code for the event, and your personal domain name."
 240   :type 'string
 241   :group 'icalendar)
 242
 243 (defvar icalendar-debug nil
 244   "Enable icalendar debug messages.")
 245
 246 ;; ======================================================================
 247 ;; NO USER SERVICEABLE PARTS BELOW THIS LINE
 248 ;; ======================================================================
 249
 250 (defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
 251
 252 ;; ======================================================================
 253 ;; all the other libs we need
 254 ;; ======================================================================
 255 (require 'calendar)
 256 (require 'diary-lib)
 257
 258 ;; ======================================================================
 259 ;; misc
 260 ;; ======================================================================
 261 (defun icalendar--dmsg (&rest args)
 262   "Print message ARGS if `icalendar-debug' is non-nil."
 263   (if icalendar-debug
 264       (apply 'message args)))
 265
 266 ;; ======================================================================
 267 ;; Core functionality
 268 ;; Functions for parsing icalendars, importing and so on
 269 ;; ======================================================================
 270
 271 (defun icalendar--get-unfolded-buffer (folded-ical-buffer)
 272   "Return a new buffer containing the unfolded contents of a buffer.
 273 Folding is the iCalendar way of wrapping long lines.  In the
 274 created buffer all occurrences of CR LF BLANK are replaced by the
 275 empty string.  Argument FOLDED-ICAL-BUFFER is the unfolded input
 276 buffer."
 277   (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
 278     (save-current-buffer
 279       (set-buffer unfolded-buffer)
 280       (erase-buffer)
 281       (insert-buffer-substring folded-ical-buffer)
 282       (goto-char (point-min))
 283       (while (re-search-forward "\r?\n[ \t]" nil t)
 284         (replace-match "" nil nil)))
 285     unfolded-buffer))
 286
 287 (defsubst icalendar--rris (regexp rep string &optional fixedcase literal)
 288   "Replace regular expression in string.
 289 Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
 290 `replace-regexp-in-string' (Emacs) or to `replace-in-string' (XEmacs)."
 291   (cond ((fboundp 'replace-regexp-in-string)
 292          ;; Emacs:
 293          (replace-regexp-in-string regexp rep string fixedcase literal))
 294         ((fboundp 'replace-in-string)
 295          ;; XEmacs:
 296          (save-match-data ;; apparently XEmacs needs save-match-data
 297            (replace-in-string string regexp rep literal)))))
 298
 299 (defun icalendar--read-element (invalue inparams)
 300   "Recursively read the next iCalendar element in the current buffer.
 301 INVALUE gives the current iCalendar element we are reading.
 302 INPARAMS gives the current parameters.....
 303 This function calls itself recursively for each nested calendar element
 304 it finds."
 305   (let (element children line name params param param-name param-value
 306                 value
 307                 (continue t))
 308     (setq children '())
 309     (while (and continue
 310                 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
 311       (setq name (intern (match-string 1)))
 312       (backward-char 1)
 313       (setq params '())
 314       (setq line '())
 315       (while (looking-at ";")
 316         (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
 317         (setq param-name (intern (match-string 1)))
 318         (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
 319                            nil t)
 320         (backward-char 1)
 321         (setq param-value (or (match-string 2) (match-string 3)))
 322         (setq param (list param-name param-value))
 323         (while (looking-at ",")
 324           (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
 325                              nil t)
 326           (if (match-string 2)
 327               (setq param-value (match-string 2))
 328             (setq param-value (match-string 3)))
 329           (setq param (append param param-value)))
 330         (setq params (append params param)))
 331       (unless (looking-at ":")
 332         (error "Oops"))
 333       (forward-char 1)
 334       (re-search-forward  "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t)
 335       (setq value (icalendar--rris "\r?\n[ \t]" "" (match-string 0)))
 336       (setq line (list name params value))
 337       (cond ((eq name 'BEGIN)
 338              (setq children
 339                    (append children
 340                            (list (icalendar--read-element (intern value)
 341                                                           params)))))
 342             ((eq name 'END)
 343              (setq continue nil))
 344             (t
 345              (setq element (append element (list line))))))
 346     (if invalue
 347         (list invalue inparams element children)
 348       children)))
 349
 350 ;; ======================================================================
 351 ;; helper functions for examining events
 352 ;; ======================================================================
 353
 354 ;;(defsubst icalendar--get-all-event-properties (event)
 355 ;;  "Return the list of properties in this EVENT."
 356 ;;  (car (cddr event)))
 357
 358 (defun icalendar--get-event-property (event prop)
 359   "For the given EVENT return the value of the first occurrence of PROP."
 360   (catch 'found
 361     (let ((props (car (cddr event))) pp)
 362       (while props
 363         (setq pp (car props))
 364         (if (eq (car pp) prop)
 365             (throw 'found (car (cddr pp))))
 366         (setq props (cdr props))))
 367     nil))
 368
 369 (defun icalendar--get-event-property-attributes (event prop)
 370   "For the given EVENT return attributes of the first occurrence of PROP."
 371   (catch 'found
 372     (let ((props (car (cddr event))) pp)
 373       (while props
 374         (setq pp (car props))
 375         (if (eq (car pp) prop)
 376             (throw 'found (cadr pp)))
 377         (setq props (cdr props))))
 378     nil))
 379
 380 (defun icalendar--get-event-properties (event prop)
 381   "For the given EVENT return a list of all values of the property PROP."
 382   (let ((props (car (cddr event))) pp result)
 383     (while props
 384       (setq pp (car props))
 385       (if (eq (car pp) prop)
 386           (setq result (append (split-string (car (cddr pp)) ",") result)))
 387       (setq props (cdr props)))
 388     result))
 389
 390 ;; (defun icalendar--set-event-property (event prop new-value)
 391 ;;   "For the given EVENT set the property PROP to the value NEW-VALUE."
 392 ;;   (catch 'found
 393 ;;     (let ((props (car (cddr event))) pp)
 394 ;;       (while props
 395 ;;         (setq pp (car props))
 396 ;;         (when (eq (car pp) prop)
 397 ;;           (setcdr (cdr pp) new-value)
 398 ;;           (throw 'found (car (cddr pp))))
 399 ;;         (setq props (cdr props)))
 400 ;;       (setq props (car (cddr event)))
 401 ;;       (setcar (cddr event)
 402 ;;               (append props (list (list prop nil new-value)))))))
 403
 404 (defun icalendar--get-children (node name)
 405   "Return all children of the given NODE which have a name NAME.
 406 For instance the VCALENDAR node can have VEVENT children as well as VTODO
 407 children."
 408   (let ((result nil)
 409         (children (cadr (cddr node))))
 410     (when (eq (car node) name)
 411       (setq result node))
 412     ;;(message "%s" node)
 413     (when children
 414       (let ((subresult
 415              (delq nil
 416                    (mapcar (lambda (n)
 417                              (icalendar--get-children n name))
 418                            children))))
 419         (if subresult
 420             (if result
 421                 (setq result (append result subresult))
 422               (setq result subresult)))))
 423     result))
 424
 425 ;; private
 426 (defun icalendar--all-events (icalendar)
 427   "Return the list of all existing events in the given ICALENDAR."
 428   (let ((result '()))
 429     (mapc (lambda (elt)
 430             (setq result (append (icalendar--get-children elt 'VEVENT)
 431                                  result)))
 432           (nreverse icalendar))
 433     result))
 434
 435 (defun icalendar--split-value (value-string)
 436   "Split VALUE-STRING at ';='."
 437   (let ((result '())
 438         param-name param-value)
 439     (when value-string
 440       (save-current-buffer
 441         (set-buffer (get-buffer-create " *icalendar-work*"))
 442         (set-buffer-modified-p nil)
 443         (erase-buffer)
 444         (insert value-string)
 445         (goto-char (point-min))
 446         (while
 447             (re-search-forward
 448              "\\([A-Za-z0-9-]+\\)=\\(\\([^;:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
 449              nil t)
 450           (setq param-name (intern (match-string 1)))
 451           (setq param-value (match-string 2))
 452           (setq result
 453                 (append result (list (list param-name param-value)))))))
 454     result))
 455
 456 (defun icalendar--convert-tz-offset (alist dst-p)
 457   "Return a cons of two strings representing a timezone start.
 458 ALIST is an alist entry from a VTIMEZONE, like STANDARD.
 459 DST-P is non-nil if this is for daylight savings time.
 460 The strings are suitable for assembling into a TZ variable."
 461   (let ((offset (car (cddr (assq 'TZOFFSETTO alist))))
 462         (rrule-value (car (cddr (assq 'RRULE alist))))
 463         (dtstart (car (cddr (assq 'DTSTART alist)))))
 464     ;; FIXME: for now we only handle RRULE and not RDATE here.
 465     (when (and offset rrule-value dtstart)
 466       (let* ((rrule (icalendar--split-value rrule-value))
 467              (freq (cadr (assq 'FREQ rrule)))
 468              (bymonth (cadr (assq 'BYMONTH rrule)))
 469              (byday (cadr (assq 'BYDAY rrule))))
 470         ;; FIXME: we don't correctly handle WKST here.
 471         (if (and (string= freq "YEARLY") bymonth)
 472             (cons
 473              (concat
 474               ;; Fake a name.
 475               (if dst-p "DST" "STD")
 476               ;; For TZ, OFFSET is added to the local time.  So,
 477               ;; invert the values.
 478               (if (eq (aref offset 0) ?-) "+" "-")
 479               (substring offset 1 3)
 480               ":"
 481               (substring offset 3 5))
 482              ;; The start time.
 483              (let* ((day (icalendar--get-weekday-number (substring byday -2)))
 484                     (week (if (eq day -1)
 485                               byday
 486                             (substring byday 0 -2))))
 487                ;; "Translate" the iCalendar way to specify the last
 488                ;; (sun|mon|...)day in month to the tzset way.
 489                (if (string= week "-1")  ; last day as iCalendar calls it
 490                    (setq week "5"))     ; last day as tzset calls it
 491                (concat "M" bymonth "." week "." (if (eq day -1) "0"
 492                                                   (int-to-string day))
 493                        ;; Start time.
 494                        "/"
 495                        (substring dtstart -6 -4)
 496                        ":"
 497                        (substring dtstart -4 -2)
 498                        ":"
 499                        (substring dtstart -2)))))))))
 500
 501 (defun icalendar--parse-vtimezone (alist)
 502   "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
 503 Return nil if timezone cannot be parsed."
 504   (let* ((tz-id (icalendar--convert-string-for-import
 505                  (icalendar--get-event-property alist 'TZID)))
 506          (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
 507          (day (and daylight (icalendar--convert-tz-offset daylight t)))
 508          (standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
 509          (std (and standard (icalendar--convert-tz-offset standard nil))))
 510     (if (and tz-id std)
 511         (cons tz-id
 512               (if day
 513                   (concat (car std) (car day)
 514                           "," (cdr day) "," (cdr std))
 515                 (car std))))))
 516
 517 (defun icalendar--convert-all-timezones (icalendar)
 518   "Convert all timezones in the ICALENDAR into an alist.
 519 Each element of the alist is a cons (ID . TZ-STRING),
 520 like `icalendar--parse-vtimezone'."
 521   (let (result)
 522     (dolist (zone (icalendar--get-children (car icalendar) 'VTIMEZONE))
 523       (setq zone (icalendar--parse-vtimezone zone))
 524       (if zone
 525           (setq result (cons zone result))))
 526     result))
 527
 528 (defun icalendar--find-time-zone (prop-list zone-map)
 529   "Return a timezone string for the time zone in PROP-LIST, or nil if none.
 530 ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
 531   (let ((id (plist-get prop-list 'TZID)))
 532     (if id
 533         (cdr (assoc id zone-map)))))
 534
 535 (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
 536                                                         zone)
 537   "Return ISODATETIMESTRING in format like `decode-time'.
 538 Converts from ISO-8601 to Emacs representation.  If
 539 ISODATETIMESTRING specifies UTC time (trailing letter Z) the
 540 decoded time is given in the local time zone!  If optional
 541 parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
 542 days.
 543 ZONE, if provided, is the timezone, in any format understood by `encode-time'.
 544
 545 FIXME: multiple comma-separated values should be allowed!"
 546   (icalendar--dmsg isodatetimestring)
 547   (if isodatetimestring
 548       ;; day/month/year must be present
 549       (let ((year  (read (substring isodatetimestring 0 4)))
 550             (month (read (substring isodatetimestring 4 6)))
 551             (day   (read (substring isodatetimestring 6 8)))
 552             (hour 0)
 553             (minute 0)
 554             (second 0))
 555         (when (> (length isodatetimestring) 12)
 556           ;; hour/minute present
 557           (setq hour (read (substring isodatetimestring 9 11)))
 558           (setq minute (read (substring isodatetimestring 11 13))))
 559         (when (> (length isodatetimestring) 14)
 560           ;; seconds present
 561           (setq second (read (substring isodatetimestring 13 15))))
 562         (when (and (> (length isodatetimestring) 15)
 563                    ;; UTC specifier present
 564                    (char-equal ?Z (aref isodatetimestring 15)))
 565           ;; if not UTC add current-time-zone offset
 566           (setq second (+ (car (current-time-zone)) second)))
 567         ;; shift if necessary
 568         (if day-shift
 569             (let ((mdy (calendar-gregorian-from-absolute
 570                         (+ (calendar-absolute-from-gregorian
 571                             (list month day year))
 572                            day-shift))))
 573               (setq month (nth 0 mdy))
 574               (setq day   (nth 1 mdy))
 575               (setq year  (nth 2 mdy))))
 576         ;; create the decoded date-time
 577         ;; FIXME!?!
 578         (condition-case nil
 579             (decode-time (encode-time second minute hour day month year zone))
 580           (error
 581            (message "Cannot decode \"%s\"" isodatetimestring)
 582            ;; hope for the best...
 583            (list second minute hour day month year 0 nil 0))))
 584     ;; isodatetimestring == nil
 585     nil))
 586
 587 (defun icalendar--decode-isoduration (isodurationstring
 588                                       &optional duration-correction)
 589   "Convert ISODURATIONSTRING into format provided by `decode-time'.
 590 Converts from ISO-8601 to Emacs representation.  If ISODURATIONSTRING
 591 specifies UTC time (trailing letter Z) the decoded time is given in
 592 the local time zone!
 593
 594 Optional argument DURATION-CORRECTION shortens result by one day.
 595
 596 FIXME: TZID-attributes are ignored....!
 597 FIXME: multiple comma-separated values should be allowed!"
 598   (if isodurationstring
 599       (save-match-data
 600         (string-match
 601          (concat
 602           "^P[+-]?\\("
 603           "\\(\\([0-9]+\\)D\\)"         ; days only
 604           "\\|"
 605           "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
 606           "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)"  ; mand. time
 607           "\\|"
 608           "\\(\\([0-9]+\\)W\\)"         ; weeks only
 609           "\\)$") isodurationstring)
 610         (let ((seconds 0)
 611               (minutes 0)
 612               (hours 0)
 613               (days 0)
 614               (months 0)
 615               (years 0))
 616           (cond
 617            ((match-beginning 2)         ;days only
 618             (setq days (read (substring isodurationstring
 619                                         (match-beginning 3)
 620                                         (match-end 3))))
 621             (when duration-correction
 622               (setq days (1- days))))
 623            ((match-beginning 4)         ;days and time
 624             (if (match-beginning 5)
 625                 (setq days (* 7 (read (substring isodurationstring
 626                                                  (match-beginning 6)
 627                                                  (match-end 6))))))
 628             (if (match-beginning 7)
 629                 (setq hours (read (substring isodurationstring
 630                                              (match-beginning 8)
 631                                              (match-end 8)))))
 632             (if (match-beginning 9)
 633                 (setq minutes (read (substring isodurationstring
 634                                                (match-beginning 10)
 635                                                (match-end 10)))))
 636             (if (match-beginning 11)
 637                 (setq seconds (read (substring isodurationstring
 638                                                (match-beginning 12)
 639                                                (match-end 12))))))
 640            ((match-beginning 13)        ;weeks only
 641             (setq days (* 7 (read (substring isodurationstring
 642                                              (match-beginning 14)
 643                                              (match-end 14)))))))
 644           (list seconds minutes hours days months years)))
 645     ;; isodatetimestring == nil
 646     nil))
 647
 648 (defun icalendar--add-decoded-times (time1 time2)
 649   "Add TIME1 to TIME2.
 650 Both times must be given in decoded form.  One of these times must be
 651 valid (year > 1900 or something)."
 652   ;; FIXME: does this function exist already?
 653   (decode-time (encode-time
 654                 (+ (nth 0 time1) (nth 0 time2))
 655                 (+ (nth 1 time1) (nth 1 time2))
 656                 (+ (nth 2 time1) (nth 2 time2))
 657                 (+ (nth 3 time1) (nth 3 time2))
 658                 (+ (nth 4 time1) (nth 4 time2))
 659                 (+ (nth 5 time1) (nth 5 time2))
 660                 nil
 661                 nil
 662                 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
 663                 )))
 664
 665 (defun icalendar--datetime-to-american-date (datetime &optional separator)
 666   "Convert the decoded DATETIME to American-style format.
 667 Optional argument SEPARATOR gives the separator between month,
 668 day, and year.  If nil a blank character is used as separator.
 669 American format: \"month day year\"."
 670   (if datetime
 671       (format "%d%s%d%s%d" (nth 4 datetime) ;month
 672               (or separator " ")
 673               (nth 3 datetime)          ;day
 674               (or separator " ")
 675               (nth 5 datetime))         ;year
 676     ;; datetime == nil
 677     nil))
 678
 679 (define-obsolete-function-alias 'icalendar--datetime-to-noneuropean-date
 680   'icalendar--datetime-to-american-date "icalendar 0.19")
 681
 682 (defun icalendar--datetime-to-european-date (datetime &optional separator)
 683   "Convert the decoded DATETIME to European format.
 684 Optional argument SEPARATOR gives the separator between month,
 685 day, and year.  If nil a blank character is used as separator.
 686 European format: (day month year).
 687 FIXME"
 688   (if datetime
 689       (format "%d%s%d%s%d" (nth 3 datetime) ;day
 690               (or separator " ")
 691               (nth 4 datetime)            ;month
 692               (or separator " ")
 693               (nth 5 datetime))           ;year
 694     ;; datetime == nil
 695     nil))
 696
 697 (defun icalendar--datetime-to-iso-date (datetime &optional separator)
 698   "Convert the decoded DATETIME to ISO format.
 699 Optional argument SEPARATOR gives the separator between month,
 700 day, and year.  If nil a blank character is used as separator.
 701 ISO format: (year month day)."
 702   (if datetime
 703       (format "%d%s%d%s%d" (nth 5 datetime) ;year
 704               (or separator " ")
 705               (nth 4 datetime)            ;month
 706               (or separator " ")
 707               (nth 3 datetime))           ;day
 708     ;; datetime == nil
 709     nil))
 710
 711 (defun icalendar--date-style ()
 712   "Return current calendar date style.
 713 Convenience function to handle transition from old
 714 `european-calendar-style' to new `calendar-date-style'."
 715   (if (boundp 'calendar-date-style)
 716       calendar-date-style
 717     (if (with-no-warnings european-calendar-style)
 718         'european
 719       'american)))
 720
 721 (defun icalendar--datetime-to-diary-date (datetime &optional separator)
 722   "Convert the decoded DATETIME to diary format.
 723 Optional argument SEPARATOR gives the separator between month,
 724 day, and year.  If nil a blank character is used as separator.
 725 Call icalendar--datetime-to-*-date according to the current
 726 calendar date style."
 727   (funcall (intern-soft (format "icalendar--datetime-to-%s-date"
 728                                 (icalendar--date-style)))
 729            datetime separator))
 730
 731 (defun icalendar--datetime-to-colontime (datetime)
 732   "Extract the time part of a decoded DATETIME into 24-hour format.
 733 Note that this silently ignores seconds."
 734   (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
 735
 736 (defun icalendar--get-month-number (monthname)
 737   "Return the month number for the given MONTHNAME."
 738   (catch 'found
 739     (let ((num 1)
 740           (m (downcase monthname)))
 741       (mapc (lambda (month)
 742               (let ((mm (downcase month)))
 743                 (if (or (string-equal mm m)
 744                         (string-equal (substring mm 0 3) m))
 745                     (throw 'found num))
 746                 (setq num (1+ num))))
 747             calendar-month-name-array))
 748     ;; Error:
 749     -1))
 750
 751 (defun icalendar--get-weekday-number (abbrevweekday)
 752   "Return the number for the ABBREVWEEKDAY."
 753   (if abbrevweekday
 754       (catch 'found
 755         (let ((num 0)
 756               (aw (downcase abbrevweekday)))
 757           (mapc (lambda (day)
 758                   (let ((d (downcase day)))
 759                     (if (string-equal d aw)
 760                         (throw 'found num))
 761                     (setq num (1+ num))))
 762                 icalendar--weekday-array)))
 763     ;; Error:
 764     -1))
 765
 766 (defun icalendar--get-weekday-numbers (abbrevweekdays)
 767   "Return the list of numbers for the comma-separated ABBREVWEEKDAYS."
 768   (when abbrevweekdays
 769     (let* ((num -1)
 770            (weekday-alist (mapcar (lambda (day)
 771                                     (progn
 772                                       (setq num (1+ num))
 773                                       (cons (downcase day) num)))
 774                                   icalendar--weekday-array)))
 775       (delq nil
 776             (mapcar (lambda (abbrevday)
 777                       (cdr (assoc abbrevday weekday-alist)))
 778                     (split-string (downcase abbrevweekdays) ","))))))
 779
 780 (defun icalendar--get-weekday-abbrev (weekday)
 781   "Return the abbreviated WEEKDAY."
 782   (catch 'found
 783     (let ((num 0)
 784           (w (downcase weekday)))
 785       (mapc (lambda (day)
 786               (let ((d (downcase day)))
 787                 (if (or (string-equal d w)
 788                         (string-equal (substring d 0 3) w))
 789                     (throw 'found (aref icalendar--weekday-array num)))
 790                 (setq num (1+ num))))
 791             calendar-day-name-array))
 792     ;; Error:
 793     nil))
 794
 795 (defun icalendar--date-to-isodate (date &optional day-shift)
 796   "Convert DATE to iso-style date.
 797 DATE must be a list of the form (month day year).
 798 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
 799   (let ((mdy (calendar-gregorian-from-absolute
 800               (+ (calendar-absolute-from-gregorian date)
 801                  (or day-shift 0)))))
 802     (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
 803
 804
 805 (defun icalendar--datestring-to-isodate (datestring &optional day-shift)
 806   "Convert diary-style DATESTRING to iso-style date.
 807 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
 808 -- DAY-SHIFT must be either nil or an integer.  This function
 809 tries to figure the date style from DATESTRING itself.  If that
 810 is not possible it uses the current calendar date style."
 811   (let ((day -1) month year)
 812     (save-match-data
 813       (cond ( ;; iso-style numeric date
 814              (string-match (concat "\\s-*"
 815                                    "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
 816                                    "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
 817                                    "0?\\([1-9][0-9]?\\)")
 818                            datestring)
 819              (setq year (read (substring datestring (match-beginning 1)
 820                                          (match-end 1))))
 821              (setq month (read (substring datestring (match-beginning 2)
 822                                           (match-end 2))))
 823              (setq day (read (substring datestring (match-beginning 3)
 824                                         (match-end 3)))))
 825             ( ;; non-iso numeric date -- must rely on configured
 826               ;; calendar style
 827              (string-match (concat "\\s-*"
 828                                    "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
 829                                    "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
 830                                    "\\([0-9]\\{4\\}\\)")
 831                            datestring)
 832              (setq day (read (substring datestring (match-beginning 1)
 833                                         (match-end 1))))
 834              (setq month (read (substring datestring (match-beginning 2)
 835                                           (match-end 2))))
 836              (setq year (read (substring datestring (match-beginning 3)
 837                                          (match-end 3))))
 838              (if (eq (icalendar--date-style) 'american)
 839                  (let ((x month))
 840                    (setq month day)
 841                    (setq day x))))
 842             ( ;; date contains month names -- iso style
 843              (string-match (concat "\\s-*"
 844                                    "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
 845                                    "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 846                                    "0?\\([123]?[0-9]\\)")
 847                            datestring)
 848              (setq year (read (substring datestring (match-beginning 1)
 849                                         (match-end 1))))
 850              (setq month (icalendar--get-month-number
 851                           (substring datestring (match-beginning 2)
 852                                      (match-end 2))))
 853              (setq day (read (substring datestring (match-beginning 3)
 854                                         (match-end 3)))))
 855             ( ;; date contains month names -- european style
 856              (string-match (concat "\\s-*"
 857                                    "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
 858                                    "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 859                                    "\\([0-9]\\{4\\}\\)")
 860                            datestring)
 861              (setq day (read (substring datestring (match-beginning 1)
 862                                         (match-end 1))))
 863              (setq month (icalendar--get-month-number
 864                           (substring datestring (match-beginning 2)
 865                                      (match-end 2))))
 866              (setq year (read (substring datestring (match-beginning 3)
 867                                          (match-end 3)))))
 868             ( ;; date contains month names -- american style
 869              (string-match (concat "\\s-*"
 870                                    "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 871                                    "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
 872                                    "\\([0-9]\\{4\\}\\)")
 873                            datestring)
 874              (setq day (read (substring datestring (match-beginning 2)
 875                                         (match-end 2))))
 876              (setq month (icalendar--get-month-number
 877                           (substring datestring (match-beginning 1)
 878                                      (match-end 1))))
 879              (setq year (read (substring datestring (match-beginning 3)
 880                                          (match-end 3)))))
 881             (t
 882              nil)))
 883     (if (> day 0)
 884         (let ((mdy (calendar-gregorian-from-absolute
 885                     (+ (calendar-absolute-from-gregorian (list month day
 886                                                                year))
 887                        (or day-shift 0)))))
 888           (icalendar--dmsg (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
 889           (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
 890       nil)))
 891
 892 (defun icalendar--diarytime-to-isotime (timestring ampmstring)
 893   "Convert a time like 9:30pm to an iso-conform string like T213000.
 894 In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
 895 would be \"pm\"."
 896   (if timestring
 897       (let ((starttimenum (read (icalendar--rris ":" "" timestring))))
 898         ;; take care of am/pm style
 899         ;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
 900         (if (and ampmstring (string= "pm" ampmstring) (< starttimenum 1200))
 901             (setq starttimenum (+ starttimenum 1200)))
 902         ;; Similar effect with 12:00am - 12:59am (need to convert to 0000-0059)
 903         (if (and ampmstring (string= "am" ampmstring) (>= starttimenum 1200))
 904             (setq starttimenum (- starttimenum 1200)))
 905         (format "T%04d00" starttimenum))
 906     nil))
 907
 908 (defun icalendar--convert-string-for-export (string)
 909   "Escape comma and other critical characters in STRING."
 910   (icalendar--rris "," "\\\\," string))
 911
 912 (defun icalendar--convert-string-for-import (string)
 913   "Remove escape chars for comma, semicolon etc. from STRING."
 914   (icalendar--rris
 915    "\\\\n" "\n " (icalendar--rris
 916                   "\\\\\"" "\"" (icalendar--rris
 917                                  "\\\\;" ";" (icalendar--rris
 918                                               "\\\\," "," string)))))
 919
 920 ;; ======================================================================
 921 ;; Export -- convert emacs-diary to iCalendar
 922 ;; ======================================================================
 923
 924 ;;;###autoload
 925 (defun icalendar-export-file (diary-filename ical-filename)
 926   "Export diary file to iCalendar format.
 927 All diary entries in the file DIARY-FILENAME are converted to iCalendar
 928 format.  The result is appended to the file ICAL-FILENAME."
 929   (interactive "FExport diary data from file: \n\
 930 Finto iCalendar file: ")
 931   (save-current-buffer
 932     (set-buffer (find-file diary-filename))
 933     (icalendar-export-region (point-min) (point-max) ical-filename)))
 934
 935 (define-obsolete-function-alias 'icalendar-convert-diary-to-ical
 936   'icalendar-export-file "22.1")
 937
 938 (defvar icalendar--uid-count 0
 939   "Auxiliary counter for creating unique ids.")
 940
 941 (defun icalendar--create-uid (entry-full contents)
 942   "Construct a unique iCalendar UID for a diary entry.
 943 ENTRY-FULL is the full diary entry string.  CONTENTS is the
 944 current iCalendar object, as a string.  Increase
 945 `icalendar--uid-count'.  Returns the UID string."
 946   (let ((uid icalendar-uid-format))
 947     (if
 948         ;; Allow other apps (such as org-mode) to create its own uid
 949         (get-text-property 0 'uid entry-full)
 950         (setq uid (get-text-property 0 'uid entry-full))
 951       (setq uid (replace-regexp-in-string
 952                  "%c"
 953                  (format "%d" icalendar--uid-count)
 954                  uid t t))
 955       (setq icalendar--uid-count (1+ icalendar--uid-count))
 956       (setq uid (replace-regexp-in-string
 957                  "%t"
 958                  (format "%d%d%d" (car (current-time))
 959                          (cadr (current-time))
 960                          (car (cddr (current-time))))
 961                  uid t t))
 962       (setq uid (replace-regexp-in-string
 963                  "%h"
 964                  (format "%d" (abs (sxhash entry-full))) uid t t))
 965       (setq uid (replace-regexp-in-string
 966                  "%u" (or user-login-name "UNKNOWN_USER") uid t t))
 967       (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents)
 968                          (substring contents (match-beginning 1) (match-end 1))
 969                        "DTSTART")))
 970         (setq uid (replace-regexp-in-string "%s" dtstart uid t t))))
 971
 972     ;; Return the UID string
 973     uid))
 974
 975 ;;;###autoload
 976 (defun icalendar-export-region (min max ical-filename)
 977   "Export region in diary file to iCalendar format.
 978 All diary entries in the region from MIN to MAX in the current buffer are
 979 converted to iCalendar format.  The result is appended to the file
 980 ICAL-FILENAME.
 981 This function attempts to return t if something goes wrong.  In this
 982 case an error string which describes all the errors and problems is
 983 written into the buffer `*icalendar-errors*'."
 984   (interactive "r
 985 FExport diary data into iCalendar file: ")
 986   (let ((result "")
 987         (start 0)
 988         (entry-main "")
 989         (entry-rest "")
 990         (entry-full "")
 991         (header "")
 992         (contents-n-summary)
 993         (contents)
 994         (found-error nil)
 995         (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
 996                            "?"))
 997         (other-elements nil))
 998     ;; prepare buffer with error messages
 999     (save-current-buffer
1000       (set-buffer (get-buffer-create "*icalendar-errors*"))
1001       (erase-buffer))
1002
1003     ;; here we go
1004     (save-excursion
1005       (goto-char min)
1006       (while (re-search-forward
1007               ;; possibly ignore hidden entries beginning with "&"
1008               (if icalendar-export-hidden-diary-entries
1009                   "^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
1010                 "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)") max t)
1011         (setq entry-main (match-string 1))
1012         (if (match-beginning 2)
1013             (setq entry-rest (match-string 2))
1014           (setq entry-rest ""))
1015         (setq entry-full (concat entry-main entry-rest))
1016
1017         (condition-case error-val
1018             (progn
1019               (setq contents-n-summary
1020                     (icalendar--convert-to-ical nonmarker entry-main))
1021               (setq other-elements (icalendar--parse-summary-and-rest
1022                                     entry-full))
1023               (setq contents (concat (car contents-n-summary)
1024                                      "\nSUMMARY:" (cadr contents-n-summary)))
1025               (let ((cla (cdr (assoc 'cla other-elements)))
1026                     (des (cdr (assoc 'des other-elements)))
1027                     (loc (cdr (assoc 'loc other-elements)))
1028                     (org (cdr (assoc 'org other-elements)))
1029                     (sta (cdr (assoc 'sta other-elements)))
1030                     (sum (cdr (assoc 'sum other-elements)))
1031                     (url (cdr (assoc 'url other-elements)))
1032                     (uid (cdr (assoc 'uid other-elements))))
1033                 (if cla
1034                     (setq contents (concat contents "\nCLASS:" cla)))
1035                 (if des
1036                     (setq contents (concat contents "\nDESCRIPTION:" des)))
1037                 (if loc
1038                     (setq contents (concat contents "\nLOCATION:" loc)))
1039                 (if org
1040                     (setq contents (concat contents "\nORGANIZER:" org)))
1041                 (if sta
1042                     (setq contents (concat contents "\nSTATUS:" sta)))
1043                 ;;(if sum
1044                 ;;    (setq contents (concat contents "\nSUMMARY:" sum)))
1045                 (if url
1046                     (setq contents (concat contents "\nURL:" url)))
1047
1048                 (setq header (concat "\nBEGIN:VEVENT\nUID:"
1049                                      (or uid
1050                                          (icalendar--create-uid entry-full
1051                                                                 contents)))))
1052               (setq result (concat result header contents "\nEND:VEVENT")))
1053           ;; handle errors
1054           (error
1055            (setq found-error t)
1056            (save-current-buffer
1057              (set-buffer (get-buffer-create "*icalendar-errors*"))
1058              (insert (format "Error in line %d -- %s: `%s'\n"
1059                              (count-lines (point-min) (point))
1060                              error-val
1061                              entry-main))))))
1062
1063       ;; we're done, insert everything into the file
1064       (save-current-buffer
1065         (let ((coding-system-for-write 'utf-8))
1066           (set-buffer (find-file ical-filename))
1067           (goto-char (point-max))
1068           (insert "BEGIN:VCALENDAR")
1069           (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
1070           (insert "\nVERSION:2.0")
1071           (insert result)
1072           (insert "\nEND:VCALENDAR\n")
1073           ;; save the diary file
1074           (save-buffer)
1075           (unless found-error
1076             (bury-buffer)))))
1077     found-error))
1078
1079 (defun icalendar--convert-to-ical (nonmarker entry-main)
1080   "Convert a diary entry to iCalendar format.
1081 NONMARKER is a regular expression matching the start of non-marking
1082 entries.  ENTRY-MAIN is the first line of the diary entry."
1083   (or
1084    ;; anniversaries -- %%(diary-anniversary ...)
1085    (icalendar--convert-anniversary-to-ical nonmarker entry-main)
1086    ;; cyclic events -- %%(diary-cyclic ...)
1087    (icalendar--convert-cyclic-to-ical nonmarker entry-main)
1088    ;; diary-date -- %%(diary-date ...)
1089    (icalendar--convert-date-to-ical nonmarker entry-main)
1090    ;; float events -- %%(diary-float ...)
1091    (icalendar--convert-float-to-ical nonmarker entry-main)
1092    ;; block events -- %%(diary-block ...)
1093    (icalendar--convert-block-to-ical nonmarker entry-main)
1094    ;; other sexp diary entries
1095    (icalendar--convert-sexp-to-ical nonmarker entry-main)
1096    ;; weekly by day -- Monday 8:30 Team meeting
1097    (icalendar--convert-weekly-to-ical nonmarker entry-main)
1098    ;; yearly by day -- 1 May Tag der Arbeit
1099    (icalendar--convert-yearly-to-ical nonmarker entry-main)
1100    ;; "ordinary" events, start and end time given
1101    ;; 1 Feb 2003 blah
1102    (icalendar--convert-ordinary-to-ical nonmarker entry-main)
1103    ;; everything else
1104    ;; Oops! what's that?
1105    (error "Could not parse entry")))
1106
1107 (defun icalendar--parse-summary-and-rest (summary-and-rest)
1108   "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
1109 Returns an alist."
1110   (save-match-data
1111     (if (functionp icalendar-import-format)
1112         ;; can't do anything
1113         nil
1114       ;; split summary-and-rest
1115       (let* ((case-fold-search nil)
1116              (s icalendar-import-format)
1117              (p-cla (or (string-match "%c" icalendar-import-format) -1))
1118              (p-des (or (string-match "%d" icalendar-import-format) -1))
1119              (p-loc (or (string-match "%l" icalendar-import-format) -1))
1120              (p-org (or (string-match "%o" icalendar-import-format) -1))
1121              (p-sum (or (string-match "%s" icalendar-import-format) -1))
1122              (p-sta (or (string-match "%t" icalendar-import-format) -1))
1123              (p-url (or (string-match "%u" icalendar-import-format) -1))
1124              (p-uid (or (string-match "%U" icalendar-import-format) -1))
1125              (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid) '<))
1126              (ct 0)
1127              pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url pos-uid)
1128         (dotimes (i (length p-list))
1129           ;; Use 'ct' to keep track of current position in list
1130           (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
1131                  (setq ct (+ ct 1))
1132                  (setq pos-cla (* 2 ct)))
1133                 ((and (>= p-des 0) (= (nth i p-list) p-des))
1134                  (setq ct (+ ct 1))
1135                  (setq pos-des (* 2 ct)))
1136                 ((and (>= p-loc 0) (= (nth i p-list) p-loc))
1137                  (setq ct (+ ct 1))
1138                  (setq pos-loc (* 2 ct)))
1139                 ((and (>= p-org 0) (= (nth i p-list) p-org))
1140                  (setq ct (+ ct 1))
1141                  (setq pos-org (* 2 ct)))
1142                 ((and (>= p-sta 0) (= (nth i p-list) p-sta))
1143                  (setq ct (+ ct 1))
1144                  (setq pos-sta (* 2 ct)))
1145                 ((and (>= p-sum 0) (= (nth i p-list) p-sum))
1146                  (setq ct (+ ct 1))
1147                  (setq pos-sum (* 2 ct)))
1148                 ((and (>= p-url 0) (= (nth i p-list) p-url))
1149                  (setq ct (+ ct 1))
1150                  (setq pos-url (* 2 ct)))
1151                 ((and (>= p-uid 0) (= (nth i p-list) p-uid))
1152                  (setq ct (+ ct 1))
1153                  (setq pos-uid (* 2 ct)))) )
1154         (mapc (lambda (ij)
1155                 (setq s (icalendar--rris (car ij) (cadr ij) s t t)))
1156               (list
1157                ;; summary must be first! because of %s
1158                (list "%s"
1159                      (concat "\\(" icalendar-import-format-summary "\\)??"))
1160                (list "%c"
1161                      (concat "\\(" icalendar-import-format-class "\\)??"))
1162                (list "%d"
1163                      (concat "\\(" icalendar-import-format-description "\\)??"))
1164                (list "%l"
1165                      (concat "\\(" icalendar-import-format-location "\\)??"))
1166                (list "%o"
1167                      (concat "\\(" icalendar-import-format-organizer "\\)??"))
1168                (list "%t"
1169                      (concat "\\(" icalendar-import-format-status "\\)??"))
1170                (list "%u"
1171                      (concat "\\(" icalendar-import-format-url "\\)??"))
1172                (list "%U"
1173                      (concat "\\(" icalendar-import-format-uid "\\)??"))))
1174         ;; Need the \' regexp in order to detect multi-line items
1175         (setq s (concat "\\`"
1176                            (icalendar--rris "%s" "\\(.*?\\)" s nil t)
1177                         "\\'"))
1178         (if (string-match s summary-and-rest)
1179             (let (cla des loc org sta sum url uid)
1180               (if (and pos-sum (match-beginning pos-sum))
1181                   (setq sum (substring summary-and-rest
1182                                        (match-beginning pos-sum)
1183                                        (match-end pos-sum))))
1184               (if (and pos-cla (match-beginning pos-cla))
1185                   (setq cla (substring summary-and-rest
1186                                        (match-beginning pos-cla)
1187                                        (match-end pos-cla))))
1188               (if (and pos-des (match-beginning pos-des))
1189                   (setq des (substring summary-and-rest
1190                                        (match-beginning pos-des)
1191                                        (match-end pos-des))))
1192               (if (and pos-loc (match-beginning pos-loc))
1193                   (setq loc (substring summary-and-rest
1194                                        (match-beginning pos-loc)
1195                                        (match-end pos-loc))))
1196               (if (and pos-org (match-beginning pos-org))
1197                   (setq org (substring summary-and-rest
1198                                        (match-beginning pos-org)
1199                                        (match-end pos-org))))
1200               (if (and pos-sta (match-beginning pos-sta))
1201                   (setq sta (substring summary-and-rest
1202                                        (match-beginning pos-sta)
1203                                        (match-end pos-sta))))
1204               (if (and pos-url (match-beginning pos-url))
1205                   (setq url (substring summary-and-rest
1206                                        (match-beginning pos-url)
1207                                        (match-end pos-url))))
1208               (if (and pos-uid (match-beginning pos-uid))
1209                   (setq uid (substring summary-and-rest
1210                                        (match-beginning pos-uid)
1211                                        (match-end pos-uid))))
1212               (list (if cla (cons 'cla cla) nil)
1213                     (if des (cons 'des des) nil)
1214                     (if loc (cons 'loc loc) nil)
1215                     (if org (cons 'org org) nil)
1216                     (if sta (cons 'sta sta) nil)
1217                     ;;(if sum (cons 'sum sum) nil)
1218                     (if url (cons 'url url) nil)
1219                     (if uid (cons 'uid uid) nil))))))))
1220
1221 ;; subroutines for icalendar-export-region
1222 (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
1223   "Convert \"ordinary\" diary entry to iCalendar format.
1224 NONMARKER is a regular expression matching the start of non-marking
1225 entries.  ENTRY-MAIN is the first line of the diary entry."
1226   (if (string-match
1227        (concat nonmarker
1228                "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
1229                "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" ; start time
1230                "\\("
1231                "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" ; end time
1232                "\\)?"
1233                "\\s-*\\(.*?\\) ?$")
1234        entry-main)
1235       (let* ((datetime (substring entry-main (match-beginning 1)
1236                                   (match-end 1)))
1237              (startisostring (icalendar--datestring-to-isodate
1238                               datetime))
1239              (endisostring (icalendar--datestring-to-isodate
1240                             datetime 1))
1241              (endisostring1)
1242              (starttimestring (icalendar--diarytime-to-isotime
1243                                (if (match-beginning 3)
1244                                    (substring entry-main
1245                                               (match-beginning 3)
1246                                               (match-end 3))
1247                                  nil)
1248                                (if (match-beginning 4)
1249                                    (substring entry-main
1250                                               (match-beginning 4)
1251                                               (match-end 4))
1252                                  nil)))
1253              (endtimestring (icalendar--diarytime-to-isotime
1254                              (if (match-beginning 6)
1255                                  (substring entry-main
1256                                             (match-beginning 6)
1257                                             (match-end 6))
1258                                nil)
1259                              (if (match-beginning 7)
1260                                  (substring entry-main
1261                                             (match-beginning 7)
1262                                             (match-end 7))
1263                                nil)))
1264              (summary (icalendar--convert-string-for-export
1265                        (substring entry-main (match-beginning 8)
1266                                   (match-end 8)))))
1267         (icalendar--dmsg "ordinary %s" entry-main)
1268
1269         (unless startisostring
1270           (error "Could not parse date"))
1271
1272         ;; If only start-date is specified, then end-date is next day,
1273         ;; otherwise it is same day.
1274         (setq endisostring1 (if starttimestring
1275                                 startisostring
1276                               endisostring))
1277
1278         (when starttimestring
1279           (unless endtimestring
1280             (let ((time
1281                    (read (icalendar--rris "^T0?" ""
1282                                           starttimestring))))
1283               (if (< time 230000)
1284                   ;; Case: ends on same day
1285               (setq endtimestring (format "T%06d"
1286                                               (+ 10000 time)))
1287                 ;; Case: ends on next day
1288                 (setq endtimestring (format "T%06d"
1289                                               (- time 230000)))
1290                 (setq endisostring1 endisostring)) )))
1291
1292         (list (concat "\nDTSTART;"
1293                       (if starttimestring "VALUE=DATE-TIME:"
1294                         "VALUE=DATE:")
1295                       startisostring
1296                       (or starttimestring "")
1297                       "\nDTEND;"
1298                       (if endtimestring "VALUE=DATE-TIME:"
1299                         "VALUE=DATE:")
1300                       endisostring1
1301                       (or endtimestring ""))
1302               summary))
1303     ;; no match
1304     nil))
1305
1306 (defun icalendar-first-weekday-of-year (abbrevweekday year)
1307   "Find the first ABBREVWEEKDAY in a given YEAR.
1308 Returns day number."
1309   (let* ((day-of-week-jan01 (calendar-day-of-week (list 1 1 year)))
1310          (result (+ 1
1311                     (- (icalendar--get-weekday-number abbrevweekday)
1312                        day-of-week-jan01))))
1313     (cond ((<= result 0)
1314            (setq result (+ result 7)))
1315           ((> result 7)
1316            (setq result (- result 7))))
1317     result))
1318
1319 (defun icalendar--convert-weekly-to-ical (nonmarker entry-main)
1320   "Convert weekly diary entry to iCalendar format.
1321 NONMARKER is a regular expression matching the start of non-marking
1322 entries.  ENTRY-MAIN is the first line of the diary entry."
1323   (if (and (string-match (concat nonmarker
1324                                  "\\([a-z]+\\)\\s-+"
1325                                  "\\(\\([0-9][0-9]?:[0-9][0-9]\\)"
1326                                  "\\([ap]m\\)?"
1327                                  "\\(-"
1328                                  "\\([0-9][0-9]?:[0-9][0-9]\\)"
1329                                  "\\([ap]m\\)?\\)?"
1330                                  "\\)?"
1331                                  "\\s-*\\(.*?\\) ?$")
1332                          entry-main)
1333            (icalendar--get-weekday-abbrev
1334             (substring entry-main (match-beginning 1)
1335                        (match-end 1))))
1336       (let* ((day (icalendar--get-weekday-abbrev
1337                    (substring entry-main (match-beginning 1)
1338                               (match-end 1))))
1339              (starttimestring (icalendar--diarytime-to-isotime
1340                                (if (match-beginning 3)
1341                                    (substring entry-main
1342                                               (match-beginning 3)
1343                                               (match-end 3))
1344                                  nil)
1345                                (if (match-beginning 4)
1346                                    (substring entry-main
1347                                               (match-beginning 4)
1348                                               (match-end 4))
1349                                  nil)))
1350              (endtimestring (icalendar--diarytime-to-isotime
1351                              (if (match-beginning 6)
1352                                  (substring entry-main
1353                                             (match-beginning 6)
1354                                             (match-end 6))
1355                                nil)
1356                              (if (match-beginning 7)
1357                                  (substring entry-main
1358                                             (match-beginning 7)
1359                                             (match-end 7))
1360                                nil)))
1361              (summary (icalendar--convert-string-for-export
1362                        (substring entry-main (match-beginning 8)
1363                                   (match-end 8)))))
1364         (icalendar--dmsg "weekly %s" entry-main)
1365
1366         (when starttimestring
1367           (unless endtimestring
1368             (let ((time (read
1369                          (icalendar--rris "^T0?" ""
1370                                           starttimestring))))
1371               (setq endtimestring (format "T%06d"
1372                                           (+ 10000 time))))))
1373         (list (concat "\nDTSTART;"
1374                       (if starttimestring
1375                           "VALUE=DATE-TIME:"
1376                         "VALUE=DATE:")
1377                       ;; Find the first requested weekday of the
1378                       ;; start year
1379                       (funcall 'format "%04d%02d%02d"
1380                                icalendar-recurring-start-year 1
1381                                (icalendar-first-weekday-of-year
1382                                 day icalendar-recurring-start-year))
1383                       (or starttimestring "")
1384                       "\nDTEND;"
1385                       (if endtimestring
1386                           "VALUE=DATE-TIME:"
1387                         "VALUE=DATE:")
1388                       (funcall 'format "%04d%02d%02d"
1389                                ;; end is non-inclusive!
1390                                icalendar-recurring-start-year 1
1391                                (+ (icalendar-first-weekday-of-year
1392                                    day icalendar-recurring-start-year)
1393                           (if endtimestring 0 1)))
1394                       (or endtimestring "")
1395                       "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
1396                       day)
1397               summary))
1398     ;; no match
1399     nil))
1400
1401 (defun icalendar--convert-yearly-to-ical (nonmarker entry-main)
1402   "Convert yearly diary entry to iCalendar format.
1403 NONMARKER is a regular expression matching the start of non-marking
1404 entries.  ENTRY-MAIN is the first line of the diary entry."
1405   (if (string-match (concat nonmarker
1406                             (if (eq (icalendar--date-style) 'european)
1407                                 "\\([0-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
1408                               "\\([a-z]+\\)\\s-+\\([0-9]+[0-9]?\\)\\s-+")
1409                             "\\*?\\s-*"
1410                             "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1411                             "\\("
1412                             "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1413                             "\\)?"
1414                             "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
1415                             )
1416                     entry-main)
1417       (let* ((daypos (if (eq (icalendar--date-style) 'european) 1 2))
1418              (monpos (if (eq (icalendar--date-style) 'european) 2 1))
1419              (day (read (substring entry-main
1420                                    (match-beginning daypos)
1421                                    (match-end daypos))))
1422              (month (icalendar--get-month-number
1423                      (substring entry-main
1424                                 (match-beginning monpos)
1425                                 (match-end monpos))))
1426              (starttimestring (icalendar--diarytime-to-isotime
1427                                (if (match-beginning 4)
1428                                    (substring entry-main
1429                                               (match-beginning 4)
1430                                               (match-end 4))
1431                                  nil)
1432                                (if (match-beginning 5)
1433                                    (substring entry-main
1434                                               (match-beginning 5)
1435                                               (match-end 5))
1436                                  nil)))
1437              (endtimestring (icalendar--diarytime-to-isotime
1438                              (if (match-beginning 7)
1439                                  (substring entry-main
1440                                             (match-beginning 7)
1441                                             (match-end 7))
1442                                nil)
1443                              (if (match-beginning 8)
1444                                  (substring entry-main
1445                                             (match-beginning 8)
1446                                             (match-end 8))
1447                                nil)))
1448              (summary (icalendar--convert-string-for-export
1449                        (substring entry-main (match-beginning 9)
1450                                   (match-end 9)))))
1451         (icalendar--dmsg "yearly %s" entry-main)
1452
1453         (when starttimestring
1454           (unless endtimestring
1455             (let ((time (read
1456                          (icalendar--rris "^T0?" ""
1457                                           starttimestring))))
1458               (setq endtimestring (format "T%06d"
1459                                           (+ 10000 time))))))
1460         (list (concat "\nDTSTART;"
1461                       (if starttimestring "VALUE=DATE-TIME:"
1462                         "VALUE=DATE:")
1463                       (format "1900%02d%02d" month day)
1464                       (or starttimestring "")
1465                       "\nDTEND;"
1466                       (if endtimestring "VALUE=DATE-TIME:"
1467                         "VALUE=DATE:")
1468                       ;; end is not included! shift by one day
1469                       (icalendar--date-to-isodate
1470                        (list month day 1900)
1471                        (if endtimestring 0 1))
1472                       (or endtimestring "")
1473                       "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
1474                       (format "%d" month)
1475                       ";BYMONTHDAY="
1476                       (format "%d" day))
1477               summary))
1478     ;; no match
1479     nil))
1480
1481 (defun icalendar--convert-sexp-to-ical (nonmarker entry-main)
1482   "Convert complex sexp diary entry to iCalendar format -- unsupported!
1483
1484 FIXME!
1485
1486 NONMARKER is a regular expression matching the start of non-marking
1487 entries.  ENTRY-MAIN is the first line of the diary entry."
1488   (cond ((string-match (concat nonmarker
1489                                "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
1490                        entry-main)
1491          ;; simple sexp entry as generated by icalendar.el: strip off the
1492          ;; unnecessary (and)
1493          (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main)
1494          (icalendar--convert-to-ical
1495           nonmarker
1496           (concat "%%"
1497                   (substring entry-main (match-beginning 1) (match-end 1))
1498                   (substring entry-main (match-beginning 2) (match-end 2)))))
1499         ((string-match (concat nonmarker
1500                                "%%([^)]+)\\s-*.*")
1501                        entry-main)
1502          (icalendar--dmsg "diary-sexp %s" entry-main)
1503          (error "Sexp-entries are not supported yet"))
1504         (t
1505          ;; no match
1506          nil)))
1507
1508 (defun icalendar--convert-block-to-ical (nonmarker entry-main)
1509   "Convert block diary entry to iCalendar format.
1510 NONMARKER is a regular expression matching the start of non-marking
1511 entries.  ENTRY-MAIN is the first line of the diary entry."
1512   (if (string-match (concat nonmarker
1513                             "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
1514                             " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1515                             "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1516                             "\\("
1517                             "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1518                             "\\)?"
1519                             "\\s-*\\(.*?\\) ?$")
1520                     entry-main)
1521       (let* ((startstring (substring entry-main
1522                                      (match-beginning 1)
1523                                      (match-end 1)))
1524              (endstring (substring entry-main
1525                                    (match-beginning 2)
1526                                    (match-end 2)))
1527              (startisostring (icalendar--datestring-to-isodate
1528                               startstring))
1529              (endisostring (icalendar--datestring-to-isodate
1530                             endstring))
1531              (endisostring+1 (icalendar--datestring-to-isodate
1532                               endstring 1))
1533              (starttimestring (icalendar--diarytime-to-isotime
1534                                (if (match-beginning 4)
1535                                    (substring entry-main
1536                                               (match-beginning 4)
1537                                               (match-end 4))
1538                                  nil)
1539                                (if (match-beginning 5)
1540                                    (substring entry-main
1541                                               (match-beginning 5)
1542                                               (match-end 5))
1543                                  nil)))
1544              (endtimestring (icalendar--diarytime-to-isotime
1545                              (if (match-beginning 7)
1546                                  (substring entry-main
1547                                             (match-beginning 7)
1548                                             (match-end 7))
1549                                nil)
1550                              (if (match-beginning 8)
1551                                  (substring entry-main
1552                                             (match-beginning 8)
1553                                             (match-end 8))
1554                                nil)))
1555              (summary (icalendar--convert-string-for-export
1556                        (substring entry-main (match-beginning 9)
1557                                   (match-end 9)))))
1558         (icalendar--dmsg "diary-block %s" entry-main)
1559         (when starttimestring
1560           (unless endtimestring
1561             (let ((time
1562                    (read (icalendar--rris "^T0?" ""
1563                                           starttimestring))))
1564               (setq endtimestring (format "T%06d"
1565                                           (+ 10000 time))))))
1566         (if starttimestring
1567             ;; with time -> write rrule
1568             (list (concat "\nDTSTART;VALUE=DATE-TIME:"
1569                           startisostring
1570                           starttimestring
1571                           "\nDTEND;VALUE=DATE-TIME:"
1572                           startisostring
1573                           endtimestring
1574                           "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
1575                           endisostring)
1576                   summary)
1577           ;; no time -> write long event
1578           (list (concat "\nDTSTART;VALUE=DATE:" startisostring
1579                         "\nDTEND;VALUE=DATE:" endisostring+1)
1580                 summary)))
1581     ;; no match
1582     nil))
1583
1584 (defun icalendar--convert-float-to-ical (nonmarker entry-main)
1585   "Convert float diary entry to iCalendar format -- partially unsupported!
1586
1587   FIXME! DAY from diary-float yet unimplemented.
1588
1589   NONMARKER is a regular expression matching the start of non-marking
1590   entries.  ENTRY-MAIN is the first line of the diary entry."
1591   (if (string-match (concat nonmarker "%%\\((diary-float .+\\) ?$") entry-main)
1592       (with-temp-buffer
1593         (insert (match-string 1 entry-main))
1594         (goto-char (point-min))
1595         (let* ((sexp (read (current-buffer))) ;using `read' here
1596                                               ;easier than regexp
1597                                               ;matching, esp. with
1598                                               ;different forms of
1599                                               ;MONTH
1600                (month (nth 1 sexp))
1601                (dayname (nth 2 sexp))
1602                (n (nth 3 sexp))
1603                (day (nth 4 sexp))
1604                (summary
1605                 (replace-regexp-in-string
1606                  "\\(^\s+\\|\s+$\\)" ""
1607                  (buffer-substring (point) (point-max)))))
1608
1609           (when day
1610             (progn
1611               (icalendar--dmsg "diary-float %s" entry-main)
1612               (error "Don't know if or how to implement day in `diary-float'")))
1613
1614           (list (concat
1615                  ;;Start today (yes this is an arbitrary choice):
1616                  "\nDTSTART;VALUE=DATE:"
1617                  (format-time-string "%Y%m%d" (current-time))
1618                  ;;BUT remove today if `diary-float'
1619                  ;;expression does not hold true for today:
1620                  (when
1621                      (null (let ((date (calendar-current-date))
1622                                  (entry entry-main))
1623                              (diary-float month dayname n)))
1624                    (concat
1625                     "\nEXDATE;VALUE=DATE:"
1626                     (format-time-string "%Y%m%d" (current-time))))
1627                  "\nRRULE:"
1628                  (if (or (numberp month) (listp month))
1629                      "FREQ=YEARLY;BYMONTH="
1630                    "FREQ=MONTHLY")
1631                  (when
1632                      (listp month)
1633                    (mapconcat
1634                     (lambda (m)
1635                       (number-to-string m))
1636                     (cadr month) ","))
1637                  (when
1638                      (numberp month)
1639                    (number-to-string month))
1640                  ";BYDAY="
1641                  (number-to-string n)
1642                  (aref icalendar--weekday-array dayname))
1643                 summary)))
1644     ;; no match
1645     nil))
1646
1647 (defun icalendar--convert-date-to-ical (nonmarker entry-main)
1648   "Convert `diary-date' diary entry to iCalendar format -- unsupported!
1649
1650 FIXME!
1651
1652 NONMARKER is a regular expression matching the start of non-marking
1653 entries.  ENTRY-MAIN is the first line of the diary entry."
1654   (if (string-match (concat nonmarker
1655                             "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1656                     entry-main)
1657       (progn
1658         (icalendar--dmsg "diary-date %s" entry-main)
1659         (error "`diary-date' is not supported yet"))
1660     ;; no match
1661     nil))
1662
1663 (defun icalendar--convert-cyclic-to-ical (nonmarker entry-main)
1664   "Convert `diary-cyclic' diary entry to iCalendar format.
1665 NONMARKER is a regular expression matching the start of non-marking
1666 entries.  ENTRY-MAIN is the first line of the diary entry."
1667   (if (string-match (concat nonmarker
1668                             "%%(diary-cyclic \\([^ ]+\\) +"
1669                             "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1670                             "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1671                             "\\("
1672                             "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1673                             "\\)?"
1674                             "\\s-*\\(.*?\\) ?$")
1675                     entry-main)
1676       (let* ((frequency (substring entry-main (match-beginning 1)
1677                                    (match-end 1)))
1678              (datetime (substring entry-main (match-beginning 2)
1679                                   (match-end 2)))
1680              (startisostring (icalendar--datestring-to-isodate
1681                               datetime))
1682              (endisostring (icalendar--datestring-to-isodate
1683                             datetime))
1684              (endisostring+1 (icalendar--datestring-to-isodate
1685                               datetime 1))
1686              (starttimestring (icalendar--diarytime-to-isotime
1687                                (if (match-beginning 4)
1688                                    (substring entry-main
1689                                               (match-beginning 4)
1690                                               (match-end 4))
1691                                  nil)
1692                                (if (match-beginning 5)
1693                                    (substring entry-main
1694                                               (match-beginning 5)
1695                                               (match-end 5))
1696                                  nil)))
1697              (endtimestring (icalendar--diarytime-to-isotime
1698                              (if (match-beginning 7)
1699                                  (substring entry-main
1700                                             (match-beginning 7)
1701                                             (match-end 7))
1702                                nil)
1703                              (if (match-beginning 8)
1704                                  (substring entry-main
1705                                             (match-beginning 8)
1706                                             (match-end 8))
1707                                nil)))
1708              (summary (icalendar--convert-string-for-export
1709                        (substring entry-main (match-beginning 9)
1710                                   (match-end 9)))))
1711         (icalendar--dmsg "diary-cyclic %s" entry-main)
1712         (when starttimestring
1713           (unless endtimestring
1714             (let ((time
1715                    (read (icalendar--rris "^T0?" ""
1716                                           starttimestring))))
1717               (setq endtimestring (format "T%06d"
1718                                           (+ 10000 time))))))
1719         (list (concat "\nDTSTART;"
1720                       (if starttimestring "VALUE=DATE-TIME:"
1721                         "VALUE=DATE:")
1722                       startisostring
1723                       (or starttimestring "")
1724                       "\nDTEND;"
1725                       (if endtimestring "VALUE=DATE-TIME:"
1726                         "VALUE=DATE:")
1727                       (if endtimestring endisostring endisostring+1)
1728                       (or endtimestring "")
1729                       "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
1730                       ;; strange: korganizer does not expect
1731                       ;; BYSOMETHING here...
1732                       )
1733               summary))
1734     ;; no match
1735     nil))
1736
1737 (defun icalendar--convert-anniversary-to-ical (nonmarker entry-main)
1738   "Convert `diary-anniversary' diary entry to iCalendar format.
1739 NONMARKER is a regular expression matching the start of non-marking
1740 entries.  ENTRY-MAIN is the first line of the diary entry."
1741   (if (string-match (concat nonmarker
1742                             "%%(diary-anniversary \\([^)]+\\))\\s-*"
1743                             "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1744                             "\\("
1745                             "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1746                             "\\)?"
1747                             "\\s-*\\(.*?\\) ?$")
1748                     entry-main)
1749       (let* ((datetime (substring entry-main (match-beginning 1)
1750                                   (match-end 1)))
1751              (startisostring (icalendar--datestring-to-isodate
1752                               datetime))
1753              (endisostring (icalendar--datestring-to-isodate
1754                             datetime 1))
1755              (starttimestring (icalendar--diarytime-to-isotime
1756                                (if (match-beginning 3)
1757                                    (substring entry-main
1758                                               (match-beginning 3)
1759                                               (match-end 3))
1760                                  nil)
1761                                (if (match-beginning 4)
1762                                    (substring entry-main
1763                                               (match-beginning 4)
1764                                               (match-end 4))
1765                                  nil)))
1766              (endtimestring (icalendar--diarytime-to-isotime
1767                              (if (match-beginning 6)
1768                                  (substring entry-main
1769                                             (match-beginning 6)
1770                                             (match-end 6))
1771                                nil)
1772                              (if (match-beginning 7)
1773                                  (substring entry-main
1774                                             (match-beginning 7)
1775                                             (match-end 7))
1776                                nil)))
1777              (summary (icalendar--convert-string-for-export
1778                        (substring entry-main (match-beginning 8)
1779                                   (match-end 8)))))
1780         (icalendar--dmsg "diary-anniversary %s" entry-main)
1781         (when starttimestring
1782           (unless endtimestring
1783             (let ((time
1784                    (read (icalendar--rris "^T0?" ""
1785                                           starttimestring))))
1786               (setq endtimestring (format "T%06d"
1787                                           (+ 10000 time))))))
1788         (list (concat "\nDTSTART;"
1789                       (if starttimestring "VALUE=DATE-TIME:"
1790                         "VALUE=DATE:")
1791                       startisostring
1792                       (or starttimestring "")
1793                       "\nDTEND;"
1794                       (if endtimestring "VALUE=DATE-TIME:"
1795                         "VALUE=DATE:")
1796                       endisostring
1797                       (or endtimestring "")
1798                       "\nRRULE:FREQ=YEARLY;INTERVAL=1"
1799                       ;; the following is redundant,
1800                       ;; but korganizer seems to expect this... ;(
1801                       ;; and evolution doesn't understand it... :(
1802                       ;; so... who is wrong?!
1803                       ";BYMONTH="
1804                       (substring startisostring 4 6)
1805                       ";BYMONTHDAY="
1806                       (substring startisostring 6 8))
1807               summary))
1808     ;; no match
1809     nil))
1810
1811 ;; ======================================================================
1812 ;; Import -- convert iCalendar to emacs-diary
1813 ;; ======================================================================
1814
1815 ;;;###autoload
1816 (defun icalendar-import-file (ical-filename diary-filename
1817                                             &optional non-marking)
1818   "Import an iCalendar file and append to a diary file.
1819 Argument ICAL-FILENAME output iCalendar file.
1820 Argument DIARY-FILENAME input `diary-file'.
1821 Optional argument NON-MARKING determines whether events are created as
1822 non-marking or not."
1823   (interactive "fImport iCalendar data from file: \n\
1824 Finto diary file:
1825 P")
1826   ;; clean up the diary file
1827   (save-current-buffer
1828     ;; now load and convert from the ical file
1829     (set-buffer (find-file ical-filename))
1830     (icalendar-import-buffer diary-filename t non-marking)))
1831
1832 ;;;###autoload
1833 (defun icalendar-import-buffer (&optional diary-file do-not-ask
1834                                           non-marking)
1835   "Extract iCalendar events from current buffer.
1836
1837 This function searches the current buffer for the first iCalendar
1838 object, reads it and adds all VEVENT elements to the diary
1839 DIARY-FILE.
1840
1841 It will ask for each appointment whether to add it to the diary
1842 unless DO-NOT-ASK is non-nil.  When called interactively,
1843 DO-NOT-ASK is nil, so that you are asked for each event.
1844
1845 NON-MARKING determines whether diary events are created as
1846 non-marking.
1847
1848 Return code t means that importing worked well, return code nil
1849 means that an error has occurred.  Error messages will be in the
1850 buffer `*icalendar-errors*'."
1851   (interactive)
1852   (save-current-buffer
1853     ;; prepare ical
1854     (message "Preparing iCalendar...")
1855     (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
1856     (goto-char (point-min))
1857     (message "Preparing iCalendar...done")
1858     (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
1859         (let (ical-contents ical-errors)
1860           ;; read ical
1861           (message "Reading iCalendar...")
1862           (beginning-of-line)
1863           (setq ical-contents (icalendar--read-element nil nil))
1864           (message "Reading iCalendar...done")
1865           ;; convert ical
1866           (message "Converting iCalendar...")
1867           (setq ical-errors (icalendar--convert-ical-to-diary
1868                              ical-contents
1869                              diary-file do-not-ask non-marking))
1870           (when diary-file
1871             ;; save the diary file if it is visited already
1872             (let ((b (find-buffer-visiting diary-file)))
1873               (when b
1874                 (save-current-buffer
1875                   (set-buffer b)
1876                   (save-buffer)))))
1877           (message "Converting iCalendar...done")
1878           ;; return t if no error occurred
1879           (not ical-errors))
1880       (message
1881        "Current buffer does not contain iCalendar contents!")
1882       ;; return nil, i.e. import did not work
1883       nil)))
1884
1885 (define-obsolete-function-alias 'icalendar-extract-ical-from-buffer
1886   'icalendar-import-buffer "22.1")
1887
1888 (defun icalendar--format-ical-event (event)
1889   "Create a string representation of an iCalendar EVENT."
1890   (if (functionp icalendar-import-format)
1891       (funcall icalendar-import-format event)
1892     (let ((string icalendar-import-format)
1893           (case-fold-search nil)
1894         (conversion-list
1895          '(("%c" CLASS       icalendar-import-format-class)
1896            ("%d" DESCRIPTION icalendar-import-format-description)
1897            ("%l" LOCATION    icalendar-import-format-location)
1898            ("%o" ORGANIZER   icalendar-import-format-organizer)
1899            ("%s" SUMMARY     icalendar-import-format-summary)
1900            ("%t" STATUS      icalendar-import-format-status)
1901            ("%u" URL         icalendar-import-format-url)
1902            ("%U" UID         icalendar-import-format-uid))))
1903     ;; convert the specifiers in the format string
1904     (mapc (lambda (i)
1905             (let* ((spec (car i))
1906                    (prop (cadr i))
1907                    (format (car (cddr i)))
1908                    (contents (icalendar--get-event-property event prop))
1909                    (formatted-contents ""))
1910               (when (and contents (> (length contents) 0))
1911                 (setq formatted-contents
1912                       (icalendar--rris "%s"
1913                                        (icalendar--convert-string-for-import
1914                                         contents)
1915                                        (symbol-value format)
1916                                        t t)))
1917               (setq string (icalendar--rris spec
1918                                             formatted-contents
1919                                             string
1920                                             t t))))
1921           conversion-list)
1922     string)))
1923
1924 (defun icalendar--convert-ical-to-diary (ical-list diary-file
1925                                                    &optional do-not-ask
1926                                                    non-marking)
1927   "Convert iCalendar data to an Emacs diary file.
1928 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1929 DIARY-FILE.  If DO-NOT-ASK is nil the user is asked for each event
1930 whether to actually import it.  NON-MARKING determines whether diary
1931 events are created as non-marking.
1932 This function attempts to return t if something goes wrong.  In this
1933 case an error string which describes all the errors and problems is
1934 written into the buffer `*icalendar-errors*'."
1935   (let* ((ev (icalendar--all-events ical-list))
1936          (error-string "")
1937          (event-ok t)
1938          (found-error nil)
1939          (zone-map (icalendar--convert-all-timezones ical-list))
1940          e diary-string)
1941     ;; step through all events/appointments
1942     (while ev
1943       (setq e (car ev))
1944       (setq ev (cdr ev))
1945       (setq event-ok nil)
1946       (condition-case error-val
1947           (let* ((dtstart (icalendar--get-event-property e 'DTSTART))
1948                  (dtstart-zone (icalendar--find-time-zone
1949                                 (icalendar--get-event-property-attributes
1950                                  e 'DTSTART)
1951                                 zone-map))
1952                  (dtstart-dec (icalendar--decode-isodatetime dtstart nil
1953                                                              dtstart-zone))
1954                  (start-d (icalendar--datetime-to-diary-date
1955                            dtstart-dec))
1956                  (start-t (icalendar--datetime-to-colontime dtstart-dec))
1957                  (dtend (icalendar--get-event-property e 'DTEND))
1958                  (dtend-zone (icalendar--find-time-zone
1959                               (icalendar--get-event-property-attributes
1960                                e 'DTEND)
1961                               zone-map))
1962                  (dtend-dec (icalendar--decode-isodatetime dtend
1963                                                            nil dtend-zone))
1964                  (dtend-1-dec (icalendar--decode-isodatetime dtend -1
1965                                                              dtend-zone))
1966                  end-d
1967                  end-1-d
1968                  end-t
1969                  (summary (icalendar--convert-string-for-import
1970                            (or (icalendar--get-event-property e 'SUMMARY)
1971                                "No summary")))
1972                  (rrule (icalendar--get-event-property e 'RRULE))
1973                  (rdate (icalendar--get-event-property e 'RDATE))
1974                  (duration (icalendar--get-event-property e 'DURATION)))
1975             (icalendar--dmsg "%s: `%s'" start-d summary)
1976             ;; check whether start-time is missing
1977             (if  (and dtstart
1978                       (string=
1979                        (cadr (icalendar--get-event-property-attributes
1980                               e 'DTSTART))
1981                        "DATE"))
1982                 (setq start-t nil))
1983             (when duration
1984               (let ((dtend-dec-d (icalendar--add-decoded-times
1985                                   dtstart-dec
1986                                   (icalendar--decode-isoduration duration)))
1987                     (dtend-1-dec-d (icalendar--add-decoded-times
1988                                     dtstart-dec
1989                                     (icalendar--decode-isoduration duration
1990                                                                    t))))
1991                 (if (and dtend-dec (not (eq dtend-dec dtend-dec-d)))
1992                     (message "Inconsistent endtime and duration for %s"
1993                              summary))
1994                 (setq dtend-dec dtend-dec-d)
1995                 (setq dtend-1-dec dtend-1-dec-d)))
1996             (setq end-d (if dtend-dec
1997                             (icalendar--datetime-to-diary-date dtend-dec)
1998                           start-d))
1999             (setq end-1-d (if dtend-1-dec
2000                               (icalendar--datetime-to-diary-date dtend-1-dec)
2001                             start-d))
2002             (setq end-t (if (and
2003                              dtend-dec
2004                              (not (string=
2005                                    (cadr
2006                                     (icalendar--get-event-property-attributes
2007                                      e 'DTEND))
2008                                    "DATE")))
2009                             (icalendar--datetime-to-colontime dtend-dec)
2010                           start-t))
2011             (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
2012             (cond
2013              ;; recurring event
2014              (rrule
2015               (setq diary-string
2016                     (icalendar--convert-recurring-to-diary e dtstart-dec start-t
2017                                                            end-t))
2018               (setq event-ok t))
2019              (rdate
2020               (icalendar--dmsg "rdate event")
2021               (setq diary-string "")
2022               (mapc (lambda (datestring)
2023                       (setq diary-string
2024                             (concat diary-string
2025                                     (format "......"))))
2026                     (icalendar--split-value rdate)))
2027              ;; non-recurring event
2028              ;; all-day event
2029              ((not (string= start-d end-d))
2030               (setq diary-string
2031                     (icalendar--convert-non-recurring-all-day-to-diary
2032                      e start-d end-1-d))
2033               (setq event-ok t))
2034              ;; not all-day
2035              ((and start-t (or (not end-t)
2036                                (not (string= start-t end-t))))
2037               (setq diary-string
2038                     (icalendar--convert-non-recurring-not-all-day-to-diary
2039                      e dtstart-dec dtend-dec start-t end-t))
2040               (setq event-ok t))
2041              ;; all-day event
2042              (t
2043               (icalendar--dmsg "all day event")
2044               (setq diary-string (icalendar--datetime-to-diary-date
2045                                   dtstart-dec "/"))
2046               (setq event-ok t)))
2047             ;; add all other elements unless the user doesn't want to have
2048             ;; them
2049             (if event-ok
2050                 (progn
2051                   (setq diary-string
2052                         (concat diary-string " "
2053                                 (icalendar--format-ical-event e)))
2054                   (if do-not-ask (setq summary nil))
2055                   ;; add entry to diary and store actual name of diary
2056                   ;; file (in case it was nil)
2057                   (setq diary-file
2058                         (icalendar--add-diary-entry diary-string diary-file
2059                                                     non-marking summary)))
2060               ;; event was not ok
2061               (setq found-error t)
2062               (setq error-string
2063                     (format "%s\nCannot handle this event:%s"
2064                             error-string e))))
2065         ;; FIXME: inform user about ignored event properties
2066         ;; handle errors
2067         (error
2068          (message "Ignoring event \"%s\"" e)
2069          (setq found-error t)
2070          (setq error-string (format "%s\n%s\nCannot handle this event: %s"
2071                                     error-val error-string e))
2072          (message "%s" error-string))))
2073
2074     ;; insert final newline
2075     (if diary-file
2076         (let ((b (find-buffer-visiting diary-file)))
2077           (when b
2078             (save-current-buffer
2079               (set-buffer b)
2080               (goto-char (point-max))
2081               (insert "\n")))))
2082     (if found-error
2083         (save-current-buffer
2084           (set-buffer (get-buffer-create "*icalendar-errors*"))
2085           (erase-buffer)
2086           (insert error-string)))
2087     (message "Converting iCalendar...done")
2088     found-error))
2089
2090 ;; subroutines for importing
2091 (defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t)
2092   "Convert recurring iCalendar event E to diary format.
2093
2094 DTSTART-DEC is the DTSTART property of E.
2095 START-T is the event's start time in diary format.
2096 END-T is the event's end time in diary format."
2097   (icalendar--dmsg "recurring event")
2098   (let* ((rrule        (icalendar--get-event-property e 'RRULE))
2099          (rrule-props  (icalendar--split-value rrule))
2100          (frequency    (cadr (assoc 'FREQ rrule-props)))
2101          (until        (cadr (assoc 'UNTIL rrule-props)))
2102          (count        (cadr (assoc 'COUNT rrule-props)))
2103          (interval     (read (or (cadr (assoc 'INTERVAL rrule-props)) "1")))
2104          (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec))
2105          (until-conv   (icalendar--datetime-to-diary-date
2106                         (icalendar--decode-isodatetime until)))
2107          (until-1-conv (icalendar--datetime-to-diary-date
2108                         (icalendar--decode-isodatetime until -1)))
2109          (result  ""))
2110
2111     ;; FIXME FIXME interval!!!!!!!!!!!!!
2112
2113     (when count
2114       (if until
2115           (message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
2116         (let ((until-1 0))
2117           (cond ((string-equal frequency "DAILY")
2118                  (setq until (icalendar--add-decoded-times
2119                               dtstart-dec
2120                               (list 0 0 0 (* (read count) interval) 0 0)))
2121                  (setq until-1 (icalendar--add-decoded-times
2122                                 dtstart-dec
2123                                 (list 0 0 0 (* (- (read count) 1) interval)
2124                                       0 0)))
2125                  )
2126                 ((string-equal frequency "WEEKLY")
2127                  (setq until (icalendar--add-decoded-times
2128                               dtstart-dec
2129                               (list 0 0 0 (* (read count) 7 interval) 0 0)))
2130                  (setq until-1 (icalendar--add-decoded-times
2131                                 dtstart-dec
2132                                 (list 0 0 0 (* (- (read count) 1) 7
2133                                                interval) 0 0)))
2134                  )
2135                 ((string-equal frequency "MONTHLY")
2136                  (setq until (icalendar--add-decoded-times
2137                               dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
2138                                                            interval) 0)))
2139                  (setq until-1 (icalendar--add-decoded-times
2140                                 dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
2141                                                              interval) 0)))
2142                  )
2143                 ((string-equal frequency "YEARLY")
2144                  (setq until (icalendar--add-decoded-times
2145                               dtstart-dec (list 0 0 0 0 0 (* (- (read count) 1)
2146                                                              interval))))
2147                  (setq until-1 (icalendar--add-decoded-times
2148                                 dtstart-dec
2149                                 (list 0 0 0 0 0 (* (- (read count) 1)
2150                                                    interval))))
2151                  )
2152                 (t
2153                  (message "Cannot handle COUNT attribute for `%s' events."
2154                           frequency)))
2155           (setq until-conv (icalendar--datetime-to-diary-date until))
2156           (setq until-1-conv (icalendar--datetime-to-diary-date until-1))
2157           ))
2158       )
2159     (cond ((string-equal frequency "WEEKLY")
2160            (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
2161                   (weekdays
2162                    (icalendar--get-weekday-numbers byday))
2163                   (weekday-clause
2164                    (when (> (length weekdays) 1)
2165                      (format "(memq (calendar-day-of-week date) '%s) "
2166                              weekdays))))
2167              (if (not start-t)
2168                  (progn
2169                    ;; weekly and all-day
2170                    (icalendar--dmsg "weekly all-day")
2171                    (if until
2172                        (setq result
2173                              (format
2174                               (concat "%%%%(and "
2175                                       "%s"
2176                                       "(diary-block %s %s))")
2177                               (or weekday-clause
2178                                   (format "(diary-cyclic %d %s) "
2179                                           (* interval 7)
2180                                           dtstart-conv))
2181                               dtstart-conv
2182                               (if count until-1-conv until-conv)
2183                               ))
2184                        (setq result
2185                              (format "%%%%(and %s(diary-cyclic %d %s))"
2186                                      (or weekday-clause "")
2187                                      (if weekday-clause 1 (* interval 7))
2188                                      dtstart-conv))))
2189                ;; weekly and not all-day
2190                (icalendar--dmsg "weekly not-all-day")
2191                (if until
2192                    (setq result
2193                          (format
2194                           (concat "%%%%(and "
2195                                   "%s"
2196                                   "(diary-block %s %s)) "
2197                                   "%s%s%s")
2198                           (or weekday-clause
2199                               (format "(diary-cyclic %d %s) "
2200                                       (* interval 7)
2201                                       dtstart-conv))
2202                           dtstart-conv
2203                           until-conv
2204                           (or start-t "")
2205                           (if end-t "-" "") (or end-t "")))
2206                  ;; no limit
2207                  ;; FIXME!!!!
2208                  ;; DTSTART;VALUE=DATE-TIME:20030919T090000
2209                  ;; DTEND;VALUE=DATE-TIME:20030919T113000
2210                  (setq result
2211                        (format
2212                         "%%%%(and %s(diary-cyclic %d %s)) %s%s%s"
2213                         (or weekday-clause "")
2214                         (if weekday-clause 1 (* interval 7))
2215                         dtstart-conv
2216                         (or start-t "")
2217                         (if end-t "-" "") (or end-t "")))))))
2218           ;; yearly
2219           ((string-equal frequency "YEARLY")
2220            (icalendar--dmsg "yearly")
2221            (if until
2222                (let ((day (nth 3 dtstart-dec))
2223                      (month (nth 4 dtstart-dec)))
2224                  (setq result (concat "%%(and (diary-date "
2225                                       (cond ((eq (icalendar--date-style) 'iso)
2226                                              (format "t %d %d" month day))
2227                                             ((eq (icalendar--date-style) 'european)
2228                                              (format "%d %d t" day month))
2229                                             ((eq (icalendar--date-style) 'american)
2230                                              (format "%d %d t" month day)))
2231                                       ") (diary-block "
2232                                       dtstart-conv
2233                                       " "
2234                                       until-conv
2235                                       ")) "
2236                                       (or start-t "")
2237                                       (if end-t "-" "")
2238                                       (or end-t ""))))
2239              (setq result (format
2240                            "%%%%(and (diary-anniversary %s)) %s%s%s"
2241                            dtstart-conv
2242                            (or start-t "")
2243                            (if end-t "-" "") (or end-t "")))))
2244           ;; monthly
2245           ((string-equal frequency "MONTHLY")
2246            (icalendar--dmsg "monthly")
2247            (setq result
2248                  (format
2249                   "%%%%(and (diary-date %s) (diary-block %s %s)) %s%s%s"
2250                   (let ((day (nth 3 dtstart-dec)))
2251                     (cond ((eq (icalendar--date-style) 'iso)
2252                            (format "t t %d" day))
2253                           ((eq (icalendar--date-style) 'european)
2254                            (format "%d t t" day))
2255                           ((eq (icalendar--date-style) 'american)
2256                            (format "t %d t" day))))
2257                   dtstart-conv
2258                   (if until
2259                       until-conv
2260                     (if (eq (icalendar--date-style) 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
2261                   (or start-t "")
2262                   (if end-t "-" "") (or end-t ""))))
2263           ;; daily
2264           ((and (string-equal frequency "DAILY"))
2265            (if until
2266                (setq result
2267                      (format
2268                       (concat "%%%%(and (diary-cyclic %s %s) "
2269                               "(diary-block %s %s)) %s%s%s")
2270                       interval dtstart-conv dtstart-conv
2271                       (if count until-1-conv until-conv)
2272                       (or start-t "")
2273                       (if end-t "-" "") (or end-t "")))
2274              (setq result
2275                    (format
2276                     "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2277                     interval
2278                     dtstart-conv
2279                     (or start-t "")
2280                     (if end-t "-" "") (or end-t ""))))))
2281     ;; Handle exceptions from recurrence rules
2282     (let ((ex-dates (icalendar--get-event-properties e 'EXDATE)))
2283       (while ex-dates
2284         (let* ((ex-start (icalendar--decode-isodatetime
2285                           (car ex-dates)))
2286                (ex-d (icalendar--datetime-to-diary-date
2287                       ex-start)))
2288           (setq result
2289                 (icalendar--rris "^%%(\\(and \\)?"
2290                                  (format
2291                                   "%%%%(and (not (diary-date %s)) "
2292                                   ex-d)
2293                                  result)))
2294         (setq ex-dates (cdr ex-dates))))
2295     ;; FIXME: exception rules are not recognized
2296     (if (icalendar--get-event-property e 'EXRULE)
2297         (setq result
2298               (concat result
2299                       "\n Exception rules: "
2300                       (icalendar--get-event-properties
2301                        e 'EXRULE))))
2302     result))
2303
2304 (defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d)
2305   "Convert non-recurring iCalendar EVENT to diary format.
2306
2307 DTSTART is the decoded DTSTART property of E.
2308 Argument START-D gives the first day.
2309 Argument END-D gives the last day."
2310   (icalendar--dmsg "non-recurring all-day event")
2311   (format "%%%%(and (diary-block %s %s))" start-d end-d))
2312
2313 (defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
2314                                                                     dtend-dec
2315                                                                     start-t
2316                                                                     end-t)
2317   "Convert recurring icalendar EVENT to diary format.
2318
2319 DTSTART-DEC is the decoded DTSTART property of E.
2320 DTEND-DEC is the decoded DTEND property of E.
2321 START-T is the event's start time in diary format.
2322 END-T is the event's end time in diary format."
2323   (icalendar--dmsg "not all day event")
2324   (cond (end-t
2325          (format "%s %s-%s"
2326                  (icalendar--datetime-to-diary-date
2327                   dtstart-dec "/")
2328                  start-t end-t))
2329         (t
2330          (format "%s %s"
2331                  (icalendar--datetime-to-diary-date
2332                   dtstart-dec "/")
2333                  start-t))))
2334
2335 (defun icalendar--add-diary-entry (string diary-file non-marking
2336                                           &optional summary)
2337   "Add STRING to the diary file DIARY-FILE.
2338 STRING must be a properly formatted valid diary entry.  NON-MARKING
2339 determines whether diary events are created as non-marking.  If
2340 SUMMARY is not nil it must be a string that gives the summary of the
2341 entry.  In this case the user will be asked whether he wants to insert
2342 the entry."
2343   (when (or (not summary)
2344             (y-or-n-p (format "Add appointment for `%s' to diary? "
2345                               summary)))
2346     (when summary
2347       (setq non-marking
2348             (y-or-n-p (format "Make appointment non-marking? "))))
2349     (save-window-excursion
2350       (unless diary-file
2351         (setq diary-file
2352               (read-file-name "Add appointment to this diary file: ")))
2353       ;; Note: diary-make-entry will add a trailing blank char.... :(
2354       (funcall (if (fboundp 'diary-make-entry)
2355                    'diary-make-entry
2356                  'make-diary-entry)
2357                string non-marking diary-file)))
2358   ;; Würgaround to remove the trailing blank char
2359   (with-current-buffer (find-file diary-file)
2360     (goto-char (point-max))
2361     (if (= (char-before) ? )
2362         (delete-char -1)))
2363   ;; return diary-file in case it has been changed interactively
2364   diary-file)
2365
2366 ;; ======================================================================
2367 ;; Examples
2368 ;; ======================================================================
2369 (defun icalendar-import-format-sample (event)
2370   "Example function for formatting an iCalendar EVENT."
2371   (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
2372                   "STATUS=`%s' URL=`%s' CLASS=`%s'")
2373           (or (icalendar--get-event-property event 'SUMMARY) "")
2374           (or (icalendar--get-event-property event 'DESCRIPTION) "")
2375           (or (icalendar--get-event-property event 'LOCATION) "")
2376           (or (icalendar--get-event-property event 'ORGANIZER) "")
2377           (or (icalendar--get-event-property event 'STATUS) "")
2378           (or (icalendar--get-event-property event 'URL) "")
2379           (or (icalendar--get-event-property event 'CLASS) "")))
2380
2381 (provide 'icalendar)
2382
2383 ;;; icalendar.el ends here