lisp/calendar/icalendar.el

   1 ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author:         Ulf Jasper <ulf.jasper@web.de>
   7 ;; Created:        August 2002
   8 ;; Keywords:       calendar
   9 ;; Human-Keywords: calendar, diary, iCalendar, vCalendar
  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, or (at your option)
  16 ;; 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; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This package is documented in the Emacs Manual.
  31
  32 ;;   Please note:
  33 ;; - Diary entries which have a start time but no end time are assumed to
  34 ;;   last for one hour when they are exported.
  35 ;; - Weekly diary entries are assumed to occur the first time in the first
  36 ;;   week of the year 2000 when they are exported.
  37 ;; - Yearly diary entries are assumed to occur the first time in the year
  38 ;;   1900 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.17"
 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
 134 A formatting FUNCTION will be called with a VEVENT as its only
 135 argument.  It must return a string.  See
 136 `icalendar-import-format-sample' for an example."
 137   :type '(choice
 138           (string :tag "String")
 139           (function :tag "Function"))
 140   :group 'icalendar)
 141
 142 (defcustom icalendar-import-format-summary
 143   "%s"
 144   "Format string defining how the summary element is formatted.
 145 This applies only if the summary is not empty! `%s' is replaced
 146 by the summary."
 147   :type 'string
 148   :group 'icalendar)
 149
 150 (defcustom icalendar-import-format-description
 151   "\n Desc: %s"
 152   "Format string defining how the description element is formatted.
 153 This applies only if the description is not empty! `%s' is
 154 replaced by the description."
 155   :type 'string
 156   :group 'icalendar)
 157
 158 (defcustom icalendar-import-format-location
 159   "\n Location: %s"
 160   "Format string defining how the location element is formatted.
 161 This applies only if the location is not empty! `%s' is replaced
 162 by the location."
 163   :type 'string
 164   :group 'icalendar)
 165
 166 (defcustom icalendar-import-format-organizer
 167   "\n Organizer: %s"
 168   "Format string defining how the organizer element is formatted.
 169 This applies only if the organizer is not empty! `%s' is
 170 replaced by the organizer."
 171   :type 'string
 172   :group 'icalendar)
 173
 174 (defcustom icalendar-import-format-url
 175   "\n URL: %s"
 176   "Format string defining how the URL element is formatted.
 177 This applies only if the URL is not empty! `%s' is replaced by
 178 the URL."
 179   :type 'string
 180   :group 'icalendar)
 181
 182 (defcustom icalendar-import-format-status
 183   "\n Status: %s"
 184   "Format string defining how the status element is formatted.
 185 This applies only if the status is not empty! `%s' is replaced by
 186 the status."
 187   :type 'string
 188   :group 'icalendar)
 189
 190 (defcustom icalendar-import-format-class
 191   "\n Class: %s"
 192   "Format string defining how the class element is formatted.
 193 This applies only if the class is not empty! `%s' is replaced by
 194 the class."
 195   :type 'string
 196   :group 'icalendar)
 197
 198 (defvar icalendar-debug nil
 199   "Enable icalendar debug messages.")
 200
 201 ;; ======================================================================
 202 ;; NO USER SERVICABLE PARTS BELOW THIS LINE
 203 ;; ======================================================================
 204
 205 (defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
 206
 207 ;; ======================================================================
 208 ;; all the other libs we need
 209 ;; ======================================================================
 210 (require 'calendar)
 211
 212 ;; ======================================================================
 213 ;; misc
 214 ;; ======================================================================
 215 (defun icalendar--dmsg (&rest args)
 216   "Print message ARGS if `icalendar-debug' is non-nil."
 217   (if icalendar-debug
 218       (apply 'message args)))
 219
 220 ;; ======================================================================
 221 ;; Core functionality
 222 ;; Functions for parsing icalendars, importing and so on
 223 ;; ======================================================================
 224
 225 (defun icalendar--get-unfolded-buffer (folded-ical-buffer)
 226   "Return a new buffer containing the unfolded contents of a buffer.
 227 Folding is the iCalendar way of wrapping long lines.  In the
 228 created buffer all occurrences of CR LF BLANK are replaced by the
 229 empty string.  Argument FOLDED-ICAL-BUFFER is the unfolded input
 230 buffer."
 231   (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
 232     (save-current-buffer
 233       (set-buffer unfolded-buffer)
 234       (erase-buffer)
 235       (insert-buffer-substring folded-ical-buffer)
 236       (goto-char (point-min))
 237       (while (re-search-forward "\r?\n[ \t]" nil t)
 238         (replace-match "" nil nil)))
 239     unfolded-buffer))
 240
 241 (defsubst icalendar--rris (regexp rep string &optional fixedcase literal)
 242   "Replace regular expression in string.
 243 Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
 244 `replace-regexp-in-string' (Emacs) or to `replace-in-string' (XEmacs)."
 245   (cond ((fboundp 'replace-regexp-in-string)
 246          ;; Emacs:
 247          (replace-regexp-in-string regexp rep string fixedcase literal))
 248         ((fboundp 'replace-in-string)
 249          ;; XEmacs:
 250          (save-match-data ;; apparently XEmacs needs save-match-data
 251            (replace-in-string string regexp rep literal)))))
 252
 253 (defun icalendar--read-element (invalue inparams)
 254   "Recursively read the next iCalendar element in the current buffer.
 255 INVALUE gives the current iCalendar element we are reading.
 256 INPARAMS gives the current parameters.....
 257 This function calls itself recursively for each nested calendar element
 258 it finds."
 259   (let (element children line name params param param-name param-value
 260                 value
 261                 (continue t))
 262     (setq children '())
 263     (while (and continue
 264                 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
 265       (setq name (intern (match-string 1)))
 266       (backward-char 1)
 267       (setq params '())
 268       (setq line '())
 269       (while (looking-at ";")
 270         (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
 271         (setq param-name (intern (match-string 1)))
 272         (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
 273                            nil t)
 274         (backward-char 1)
 275         (setq param-value (or (match-string 2) (match-string 3)))
 276         (setq param (list param-name param-value))
 277         (while (looking-at ",")
 278           (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
 279                              nil t)
 280           (if (match-string 2)
 281               (setq param-value (match-string 2))
 282             (setq param-value (match-string 3)))
 283           (setq param (append param param-value)))
 284         (setq params (append params param)))
 285       (unless (looking-at ":")
 286         (error "Oops"))
 287       (forward-char 1)
 288       (re-search-forward  "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t)
 289       (setq value (icalendar--rris "\r?\n[ \t]" "" (match-string 0)))
 290       (setq line (list name params value))
 291       (cond ((eq name 'BEGIN)
 292              (setq children
 293                    (append children
 294                            (list (icalendar--read-element (intern value)
 295                                                           params)))))
 296             ((eq name 'END)
 297              (setq continue nil))
 298             (t
 299              (setq element (append element (list line))))))
 300     (if invalue
 301         (list invalue inparams element children)
 302       children)))
 303
 304 ;; ======================================================================
 305 ;; helper functions for examining events
 306 ;; ======================================================================
 307
 308 ;;(defsubst icalendar--get-all-event-properties (event)
 309 ;;  "Return the list of properties in this EVENT."
 310 ;;  (car (cddr event)))
 311
 312 (defun icalendar--get-event-property (event prop)
 313   "For the given EVENT return the value of the first occurrence of PROP."
 314   (catch 'found
 315     (let ((props (car (cddr event))) pp)
 316       (while props
 317         (setq pp (car props))
 318         (if (eq (car pp) prop)
 319             (throw 'found (car (cddr pp))))
 320         (setq props (cdr props))))
 321     nil))
 322
 323 (defun icalendar--get-event-property-attributes (event prop)
 324   "For the given EVENT return attributes of the first occurrence of PROP."
 325   (catch 'found
 326     (let ((props (car (cddr event))) pp)
 327       (while props
 328         (setq pp (car props))
 329         (if (eq (car pp) prop)
 330             (throw 'found (cadr pp)))
 331         (setq props (cdr props))))
 332     nil))
 333
 334 (defun icalendar--get-event-properties (event prop)
 335   "For the given EVENT return a list of all values of the property PROP."
 336   (let ((props (car (cddr event))) pp result)
 337     (while props
 338       (setq pp (car props))
 339       (if (eq (car pp) prop)
 340           (setq result (append (split-string (car (cddr pp)) ",") result)))
 341       (setq props (cdr props)))
 342     result))
 343
 344 ;; (defun icalendar--set-event-property (event prop new-value)
 345 ;;   "For the given EVENT set the property PROP to the value NEW-VALUE."
 346 ;;   (catch 'found
 347 ;;     (let ((props (car (cddr event))) pp)
 348 ;;       (while props
 349 ;;         (setq pp (car props))
 350 ;;         (when (eq (car pp) prop)
 351 ;;           (setcdr (cdr pp) new-value)
 352 ;;           (throw 'found (car (cddr pp))))
 353 ;;         (setq props (cdr props)))
 354 ;;       (setq props (car (cddr event)))
 355 ;;       (setcar (cddr event)
 356 ;;               (append props (list (list prop nil new-value)))))))
 357
 358 (defun icalendar--get-children (node name)
 359   "Return all children of the given NODE which have a name NAME.
 360 For instance the VCALENDAR node can have VEVENT children as well as VTODO
 361 children."
 362   (let ((result nil)
 363         (children (cadr (cddr node))))
 364     (when (eq (car node) name)
 365       (setq result node))
 366     ;;(message "%s" node)
 367     (when children
 368       (let ((subresult
 369              (delq nil
 370                    (mapcar (lambda (n)
 371                              (icalendar--get-children n name))
 372                            children))))
 373         (if subresult
 374             (if result
 375                 (setq result (append result subresult))
 376               (setq result subresult)))))
 377     result))
 378
 379                                         ; private
 380 (defun icalendar--all-events (icalendar)
 381   "Return the list of all existing events in the given ICALENDAR."
 382   (icalendar--get-children (car icalendar) 'VEVENT))
 383
 384 (defun icalendar--split-value (value-string)
 385   "Split VALUE-STRING at ';='."
 386   (let ((result '())
 387         param-name param-value)
 388     (when value-string
 389       (save-current-buffer
 390         (set-buffer (get-buffer-create " *icalendar-work*"))
 391         (set-buffer-modified-p nil)
 392         (erase-buffer)
 393         (insert value-string)
 394         (goto-char (point-min))
 395         (while
 396             (re-search-forward
 397              "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
 398              nil t)
 399           (setq param-name (intern (match-string 1)))
 400           (setq param-value (match-string 2))
 401           (setq result
 402                 (append result (list (list param-name param-value)))))))
 403     result))
 404
 405 (defun icalendar--convert-tz-offset (alist dst-p)
 406   "Return a cons of two strings representing a timezone start.
 407 ALIST is an alist entry from a VTIMEZONE, like STANDARD.
 408 DST-P is non-nil if this is for daylight savings time.
 409 The strings are suitable for assembling into a TZ variable."
 410   (let ((offset (car (cddr (assq 'TZOFFSETTO alist))))
 411         (rrule-value (car (cddr (assq 'RRULE alist))))
 412         (dtstart (car (cddr (assq 'DTSTART alist)))))
 413     ;; FIXME: for now we only handle RRULE and not RDATE here.
 414     (when (and offset rrule-value dtstart)
 415       (let* ((rrule (icalendar--split-value rrule-value))
 416              (freq (cadr (assq 'FREQ rrule)))
 417              (bymonth (cadr (assq 'BYMONTH rrule)))
 418              (byday (cadr (assq 'BYDAY rrule))))
 419         ;; FIXME: we don't correctly handle WKST here.
 420         (if (and (string= freq "YEARLY") bymonth)
 421             (cons
 422              (concat
 423               ;; Fake a name.
 424               (if dst-p "(DST?)" "(STD?)")
 425               ;; For TZ, OFFSET is added to the local time.  So,
 426               ;; invert the values.
 427               (if (eq (aref offset 0) ?-) "+" "-")
 428               (substring offset 1 3)
 429               ":"
 430               (substring offset 3 5))
 431              ;; The start time.
 432              (let* ((day (icalendar--get-weekday-number (substring byday -2)))
 433                     (week (if (eq day -1)
 434                               byday
 435                             (substring byday 0 -2))))
 436                (concat "M" bymonth "." week "." (if (eq day -1) "0"
 437                                                   (int-to-string day))
 438                        ;; Start time.
 439                        "/"
 440                        (substring dtstart -6 -4)
 441                        ":"
 442                        (substring dtstart -4 -2)
 443                        ":"
 444                        (substring dtstart -2)))))))))
 445
 446 (defun icalendar--parse-vtimezone (alist)
 447   "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
 448 Return nil if timezone cannot be parsed."
 449   (let* ((tz-id (icalendar--get-event-property alist 'TZID))
 450          (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
 451          (day (and daylight (icalendar--convert-tz-offset daylight t)))
 452          (standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
 453          (std (and standard (icalendar--convert-tz-offset standard nil))))
 454     (if (and tz-id std)
 455         (cons tz-id
 456               (if day
 457                   (concat (car std) (car day)
 458                           "," (cdr day) "," (cdr std))
 459                 (car std))))))
 460
 461 (defun icalendar--convert-all-timezones (icalendar)
 462   "Convert all timezones in the ICALENDAR into an alist.
 463 Each element of the alist is a cons (ID . TZ-STRING),
 464 like `icalendar--parse-vtimezone'."
 465   (let (result)
 466     (dolist (zone (icalendar--get-children (car icalendar) 'VTIMEZONE))
 467       (setq zone (icalendar--parse-vtimezone zone))
 468       (if zone
 469           (setq result (cons zone result))))
 470     result))
 471
 472 (defun icalendar--find-time-zone (prop-list zone-map)
 473   "Return a timezone string for the time zone in PROP-LIST, or nil if none.
 474 ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
 475   (let ((id (plist-get prop-list 'TZID)))
 476     (if id
 477         (cdr (assoc id zone-map)))))
 478
 479 (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
 480                                                         zone)
 481   "Return ISODATETIMESTRING in format like `decode-time'.
 482 Converts from ISO-8601 to Emacs representation.  If
 483 ISODATETIMESTRING specifies UTC time (trailing letter Z) the
 484 decoded time is given in the local time zone!  If optional
 485 parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
 486 days.
 487 ZONE, if provided, is the timezone, in any format understood by `encode-time'.
 488
 489 FIXME: multiple comma-separated values should be allowed!"
 490   (icalendar--dmsg isodatetimestring)
 491   (if isodatetimestring
 492       ;; day/month/year must be present
 493       (let ((year  (read (substring isodatetimestring 0 4)))
 494             (month (read (substring isodatetimestring 4 6)))
 495             (day   (read (substring isodatetimestring 6 8)))
 496             (hour 0)
 497             (minute 0)
 498             (second 0))
 499         (when (> (length isodatetimestring) 12)
 500           ;; hour/minute present
 501           (setq hour (read (substring isodatetimestring 9 11)))
 502           (setq minute (read (substring isodatetimestring 11 13))))
 503         (when (> (length isodatetimestring) 14)
 504           ;; seconds present
 505           (setq second (read (substring isodatetimestring 13 15))))
 506         (when (and (> (length isodatetimestring) 15)
 507                    ;; UTC specifier present
 508                    (char-equal ?Z (aref isodatetimestring 15)))
 509           ;; if not UTC add current-time-zone offset
 510           (setq second (+ (car (current-time-zone)) second)))
 511         ;; shift if necessary
 512         (if day-shift
 513             (let ((mdy (calendar-gregorian-from-absolute
 514                         (+ (calendar-absolute-from-gregorian
 515                             (list month day year))
 516                            day-shift))))
 517               (setq month (nth 0 mdy))
 518               (setq day   (nth 1 mdy))
 519               (setq year  (nth 2 mdy))))
 520         ;; create the decoded date-time
 521         ;; FIXME!?!
 522         (condition-case nil
 523             (decode-time (encode-time second minute hour day month year zone))
 524           (error
 525            (message "Cannot decode \"%s\"" isodatetimestring)
 526            ;; hope for the best...
 527            (list second minute hour day month year 0 nil 0))))
 528     ;; isodatetimestring == nil
 529     nil))
 530
 531 (defun icalendar--decode-isoduration (isodurationstring
 532                                       &optional duration-correction)
 533   "Convert ISODURATIONSTRING into format provided by `decode-time'.
 534 Converts from ISO-8601 to Emacs representation.  If ISODURATIONSTRING
 535 specifies UTC time (trailing letter Z) the decoded time is given in
 536 the local time zone!
 537
 538 Optional argument DURATION-CORRECTION shortens result by one day.
 539
 540 FIXME: TZID-attributes are ignored....!
 541 FIXME: multiple comma-separated values should be allowed!"
 542   (if isodurationstring
 543       (save-match-data
 544         (string-match
 545          (concat
 546           "^P[+-]?\\("
 547           "\\(\\([0-9]+\\)D\\)"         ; days only
 548           "\\|"
 549           "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
 550           "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)"  ; mand. time
 551           "\\|"
 552           "\\(\\([0-9]+\\)W\\)"         ; weeks only
 553           "\\)$") isodurationstring)
 554         (let ((seconds 0)
 555               (minutes 0)
 556               (hours 0)
 557               (days 0)
 558               (months 0)
 559               (years 0))
 560           (cond
 561            ((match-beginning 2)         ;days only
 562             (setq days (read (substring isodurationstring
 563                                         (match-beginning 3)
 564                                         (match-end 3))))
 565             (when duration-correction
 566               (setq days (1- days))))
 567            ((match-beginning 4)         ;days and time
 568             (if (match-beginning 5)
 569                 (setq days (* 7 (read (substring isodurationstring
 570                                                  (match-beginning 6)
 571                                                  (match-end 6))))))
 572             (if (match-beginning 7)
 573                 (setq hours (read (substring isodurationstring
 574                                              (match-beginning 8)
 575                                              (match-end 8)))))
 576             (if (match-beginning 9)
 577                 (setq minutes (read (substring isodurationstring
 578                                                (match-beginning 10)
 579                                                (match-end 10)))))
 580             (if (match-beginning 11)
 581                 (setq seconds (read (substring isodurationstring
 582                                                (match-beginning 12)
 583                                                (match-end 12))))))
 584            ((match-beginning 13)        ;weeks only
 585             (setq days (* 7 (read (substring isodurationstring
 586                                              (match-beginning 14)
 587                                              (match-end 14)))))))
 588           (list seconds minutes hours days months years)))
 589     ;; isodatetimestring == nil
 590     nil))
 591
 592 (defun icalendar--add-decoded-times (time1 time2)
 593   "Add TIME1 to TIME2.
 594 Both times must be given in decoded form.  One of these times must be
 595 valid (year > 1900 or something)."
 596   ;; FIXME: does this function exist already?
 597   (decode-time (encode-time
 598                 (+ (nth 0 time1) (nth 0 time2))
 599                 (+ (nth 1 time1) (nth 1 time2))
 600                 (+ (nth 2 time1) (nth 2 time2))
 601                 (+ (nth 3 time1) (nth 3 time2))
 602                 (+ (nth 4 time1) (nth 4 time2))
 603                 (+ (nth 5 time1) (nth 5 time2))
 604                 nil
 605                 nil
 606                 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
 607                 )))
 608
 609 (defun icalendar--datetime-to-noneuropean-date (datetime &optional separator)
 610   "Convert the decoded DATETIME to non-european-style format.
 611 Optional argument SEPARATOR gives the separator between month,
 612 day, and year.  If nil a blank character is used as separator.
 613 Non-European format: \"month day year\"."
 614   (if datetime
 615       (format "%d%s%d%s%d" (nth 4 datetime) ;month
 616               (or separator " ")
 617               (nth 3 datetime)          ;day
 618               (or separator " ")
 619               (nth 5 datetime))         ;year
 620     ;; datetime == nil
 621     nil))
 622
 623 (defun icalendar--datetime-to-european-date (datetime &optional separator)
 624   "Convert the decoded DATETIME to European format.
 625 Optional argument SEPARATOR gives the separator between month,
 626 day, and year.  If nil a blank character is used as separator.
 627 European format: (day month year).
 628 FIXME"
 629   (if datetime
 630       (format "%d%s%d%s%d" (nth 3 datetime) ;day
 631               (or separator " ")
 632               (nth 4 datetime)            ;month
 633               (or separator " ")
 634               (nth 5 datetime))           ;year
 635     ;; datetime == nil
 636     nil))
 637
 638 (defun icalendar--datetime-to-diary-date (datetime &optional separator)
 639   "Convert the decoded DATETIME to diary format.
 640 Optional argument SEPARATOR gives the separator between month,
 641 day, and year.  If nil a blank character is used as separator.
 642 Call icalendar--datetime-to-(non)-european-date according to
 643 value of `european-calendar-style'."
 644   (if european-calendar-style
 645       (icalendar--datetime-to-european-date datetime separator)
 646     (icalendar--datetime-to-noneuropean-date datetime separator)))
 647
 648 (defun icalendar--datetime-to-colontime (datetime)
 649   "Extract the time part of a decoded DATETIME into 24-hour format.
 650 Note that this silently ignores seconds."
 651   (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
 652
 653 (defun icalendar--get-month-number (monthname)
 654   "Return the month number for the given MONTHNAME."
 655   (catch 'found
 656     (let ((num 1)
 657           (m (downcase monthname)))
 658       (mapc (lambda (month)
 659               (let ((mm (downcase month)))
 660                 (if (or (string-equal mm m)
 661                         (string-equal (substring mm 0 3) m))
 662                     (throw 'found num))
 663                 (setq num (1+ num))))
 664             calendar-month-name-array))
 665     ;; Error:
 666     -1))
 667
 668 (defun icalendar--get-weekday-number (abbrevweekday)
 669   "Return the number for the ABBREVWEEKDAY."
 670   (if abbrevweekday
 671       (catch 'found
 672         (let ((num 0)
 673               (aw (downcase abbrevweekday)))
 674           (mapc (lambda (day)
 675                   (let ((d (downcase day)))
 676                     (if (string-equal d aw)
 677                         (throw 'found num))
 678                     (setq num (1+ num))))
 679                 icalendar--weekday-array)))
 680     ;; Error:
 681     -1))
 682
 683 (defun icalendar--get-weekday-abbrev (weekday)
 684   "Return the abbreviated WEEKDAY."
 685   (catch 'found
 686     (let ((num 0)
 687           (w (downcase weekday)))
 688       (mapc (lambda (day)
 689               (let ((d (downcase day)))
 690                 (if (or (string-equal d w)
 691                         (string-equal (substring d 0 3) w))
 692                     (throw 'found (aref icalendar--weekday-array num)))
 693                 (setq num (1+ num))))
 694             calendar-day-name-array))
 695     ;; Error:
 696     nil))
 697
 698 (defun icalendar--date-to-isodate (date &optional day-shift)
 699   "Convert DATE to iso-style date.
 700 DATE must be a list of the form (month day year).
 701 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
 702   (let ((mdy (calendar-gregorian-from-absolute
 703               (+ (calendar-absolute-from-gregorian date)
 704                  (or day-shift 0)))))
 705     (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
 706
 707
 708 (defun icalendar--datestring-to-isodate (datestring &optional day-shift)
 709   "Convert diary-style DATESTRING to iso-style date.
 710 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
 711 -- DAY-SHIFT must be either nil or an integer.  This function
 712 takes care of european-style."
 713   (let ((day -1) month year)
 714     (save-match-data
 715       (cond ( ;; numeric date
 716              (string-match (concat "\\s-*"
 717                                    "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
 718                                    "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
 719                                    "\\([0-9]\\{4\\}\\)")
 720                            datestring)
 721              (setq day (read (substring datestring (match-beginning 1)
 722                                         (match-end 1))))
 723              (setq month (read (substring datestring (match-beginning 2)
 724                                           (match-end 2))))
 725              (setq year (read (substring datestring (match-beginning 3)
 726                                          (match-end 3))))
 727              (unless european-calendar-style
 728                (let ((x month))
 729                  (setq month day)
 730                  (setq day x))))
 731             ( ;; date contains month names -- european-style
 732              (string-match (concat "\\s-*"
 733                                    "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
 734                                    "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 735                                    "\\([0-9]\\{4\\}\\)")
 736                            datestring)
 737              (setq day (read (substring datestring (match-beginning 1)
 738                                         (match-end 1))))
 739              (setq month (icalendar--get-month-number
 740                           (substring datestring (match-beginning 2)
 741                                      (match-end 2))))
 742              (setq year (read (substring datestring (match-beginning 3)
 743                                          (match-end 3)))))
 744             ( ;; date contains month names -- non-european-style
 745              (string-match (concat "\\s-*"
 746                                    "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 747                                    "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
 748                                    "\\([0-9]\\{4\\}\\)")
 749                            datestring)
 750              (setq day (read (substring datestring (match-beginning 2)
 751                                         (match-end 2))))
 752              (setq month (icalendar--get-month-number
 753                           (substring datestring (match-beginning 1)
 754                                      (match-end 1))))
 755              (setq year (read (substring datestring (match-beginning 3)
 756                                          (match-end 3)))))
 757             (t
 758              nil)))
 759     (if (> day 0)
 760         (let ((mdy (calendar-gregorian-from-absolute
 761                     (+ (calendar-absolute-from-gregorian (list month day
 762                                                                year))
 763                        (or day-shift 0)))))
 764           (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
 765       nil)))
 766
 767 (defun icalendar--diarytime-to-isotime (timestring ampmstring)
 768   "Convert a time like 9:30pm to an iso-conform string like T213000.
 769 In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
 770 would be \"pm\"."
 771   (if timestring
 772       (let ((starttimenum (read (icalendar--rris ":" "" timestring))))
 773         ;; take care of am/pm style
 774         (if (and ampmstring (string= "pm" ampmstring))
 775             (setq starttimenum (+ starttimenum 1200)))
 776         (format "T%04d00" starttimenum))
 777     nil))
 778
 779 (defun icalendar--convert-string-for-export (string)
 780   "Escape comma and other critical characters in STRING."
 781   (icalendar--rris "," "\\\\," string))
 782
 783 (defun icalendar--convert-string-for-import (string)
 784   "Remove escape chars for comma, semicolon etc. from STRING."
 785   (icalendar--rris
 786    "\\\\n" "\n " (icalendar--rris
 787                   "\\\\\"" "\"" (icalendar--rris
 788                                  "\\\\;" ";" (icalendar--rris
 789                                               "\\\\," "," string)))))
 790
 791 ;; ======================================================================
 792 ;; Export -- convert emacs-diary to icalendar
 793 ;; ======================================================================
 794
 795 ;;;###autoload
 796 (defun icalendar-export-file (diary-filename ical-filename)
 797   "Export diary file to iCalendar format.
 798 All diary entries in the file DIARY-FILENAME are converted to iCalendar
 799 format.  The result is appended to the file ICAL-FILENAME."
 800   (interactive "FExport diary data from file:
 801 Finto iCalendar file: ")
 802   (save-current-buffer
 803     (set-buffer (find-file diary-filename))
 804     (icalendar-export-region (point-min) (point-max) ical-filename)))
 805
 806 (defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
 807 (make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file)
 808
 809 ;;;###autoload
 810 (defun icalendar-export-region (min max ical-filename)
 811   "Export region in diary file to iCalendar format.
 812 All diary entries in the region from MIN to MAX in the current buffer are
 813 converted to iCalendar format.  The result is appended to the file
 814 ICAL-FILENAME.
 815 This function attempts to return t if something goes wrong.  In this
 816 case an error string which describes all the errors and problems is
 817 written into the buffer `*icalendar-errors*'."
 818   (interactive "r
 819 FExport diary data into iCalendar file: ")
 820   (let ((result "")
 821         (start 0)
 822         (entry-main "")
 823         (entry-rest "")
 824         (header "")
 825         (contents-n-summary)
 826         (contents)
 827         (found-error nil)
 828         (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
 829                            "?"))
 830         (other-elements nil))
 831     ;; prepare buffer with error messages
 832     (save-current-buffer
 833       (set-buffer (get-buffer-create "*icalendar-errors*"))
 834       (erase-buffer))
 835
 836     ;; here we go
 837     (save-excursion
 838       (goto-char min)
 839       (while (re-search-forward
 840               "^\\([^ \t\n].+\\)\\(\\(\n[ \t].*\\)*\\)" max t)
 841         (setq entry-main (match-string 1))
 842         (if (match-beginning 2)
 843             (setq entry-rest (match-string 2))
 844           (setq entry-rest ""))
 845         (setq header (format "\nBEGIN:VEVENT\nUID:emacs%d%d%d"
 846                              (car (current-time))
 847                              (cadr (current-time))
 848                              (car (cddr (current-time)))))
 849         (condition-case error-val
 850             (progn
 851               (setq contents-n-summary
 852                     (icalendar--convert-to-ical nonmarker entry-main))
 853               (setq other-elements (icalendar--parse-summary-and-rest
 854                                     (concat entry-main entry-rest)))
 855               (setq contents (concat (car contents-n-summary)
 856                                      "\nSUMMARY:" (cadr contents-n-summary)))
 857               (let ((cla (cdr (assoc 'cla other-elements)))
 858                     (des (cdr (assoc 'des other-elements)))
 859                     (loc (cdr (assoc 'loc other-elements)))
 860                     (org (cdr (assoc 'org other-elements)))
 861                     (sta (cdr (assoc 'sta other-elements)))
 862                     (sum (cdr (assoc 'sum other-elements)))
 863                     (url (cdr (assoc 'url other-elements))))
 864                 (if cla
 865                     (setq contents (concat contents "\nCLASS:" cla)))
 866                 (if des
 867                     (setq contents (concat contents "\nDESCRIPTION:" des)))
 868                 (if loc
 869                     (setq contents (concat contents "\nLOCATION:" loc)))
 870                 (if org
 871                     (setq contents (concat contents "\nORGANIZER:" org)))
 872                 (if sta
 873                     (setq contents (concat contents "\nSTATUS:" sta)))
 874                 ;;(if sum
 875                 ;;    (setq contents (concat contents "\nSUMMARY:" sum)))
 876                 (if url
 877                     (setq contents (concat contents "\nURL:" url))))
 878               (setq result (concat result header contents "\nEND:VEVENT")))
 879           ;; handle errors
 880           (error
 881            (setq found-error t)
 882            (save-current-buffer
 883              (set-buffer (get-buffer-create "*icalendar-errors*"))
 884              (insert (format "Error in line %d -- %s: `%s'\n"
 885                              (count-lines (point-min) (point))
 886                              (cadr error-val)
 887                              entry-main))))))
 888
 889       ;; we're done, insert everything into the file
 890       (save-current-buffer
 891         (let ((coding-system-for-write 'utf-8))
 892           (set-buffer (find-file ical-filename))
 893           (goto-char (point-max))
 894           (insert "BEGIN:VCALENDAR")
 895           (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
 896           (insert "\nVERSION:2.0")
 897           (insert result)
 898           (insert "\nEND:VCALENDAR\n")
 899           ;; save the diary file
 900           (save-buffer)
 901           (unless found-error
 902             (bury-buffer)))))
 903     found-error))
 904
 905 (defun icalendar--convert-to-ical (nonmarker entry-main)
 906   "Convert a diary entry to icalendar format.
 907 NONMARKER is a regular expression matching the start of non-marking
 908 entries.  ENTRY-MAIN is the first line of the diary entry."
 909   (or
 910    ;; anniversaries -- %%(diary-anniversary ...)
 911    (icalendar--convert-anniversary-to-ical nonmarker entry-main)
 912    ;; cyclic events -- %%(diary-cyclic ...)
 913    (icalendar--convert-cyclic-to-ical nonmarker entry-main)
 914    ;; diary-date -- %%(diary-date ...)
 915    (icalendar--convert-date-to-ical nonmarker entry-main)
 916    ;; float events -- %%(diary-float ...)
 917    (icalendar--convert-float-to-ical nonmarker entry-main)
 918    ;; block events -- %%(diary-block ...)
 919    (icalendar--convert-block-to-ical nonmarker entry-main)
 920    ;; other sexp diary entries
 921    (icalendar--convert-sexp-to-ical nonmarker entry-main)
 922    ;; weekly by day -- Monday 8:30 Team meeting
 923    (icalendar--convert-weekly-to-ical nonmarker entry-main)
 924    ;; yearly by day -- 1 May Tag der Arbeit
 925    (icalendar--convert-yearly-to-ical nonmarker entry-main)
 926    ;; "ordinary" events, start and end time given
 927    ;; 1 Feb 2003 blah
 928    (icalendar--convert-ordinary-to-ical nonmarker entry-main)
 929    ;; everything else
 930    ;; Oops! what's that?
 931    (error "Could not parse entry")))
 932
 933 (defun icalendar--parse-summary-and-rest (summary-and-rest)
 934   "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
 935 Returns an alist."
 936   (save-match-data
 937     (if (functionp icalendar-import-format)
 938         ;; can't do anything
 939         nil
 940       ;; split summary-and-rest
 941       (let* ((s icalendar-import-format)
 942              (p-cla (or (string-match "%c" icalendar-import-format) -1))
 943              (p-des (or (string-match "%d" icalendar-import-format) -1))
 944              (p-loc (or (string-match "%l" icalendar-import-format) -1))
 945              (p-org (or (string-match "%o" icalendar-import-format) -1))
 946              (p-sum (or (string-match "%s" icalendar-import-format) -1))
 947              (p-sta (or (string-match "%t" icalendar-import-format) -1))
 948              (p-url (or (string-match "%u" icalendar-import-format) -1))
 949              (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<))
 950              pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url)
 951         (dotimes (i (length p-list))
 952           (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
 953                  (setq pos-cla (+ 2 (* 2 i))))
 954                 ((and (>= p-des 0) (= (nth i p-list) p-des))
 955                  (setq pos-des (+ 2 (* 2 i))))
 956                 ((and (>= p-loc 0) (= (nth i p-list) p-loc))
 957                  (setq pos-loc (+ 2 (* 2 i))))
 958                 ((and (>= p-org 0) (= (nth i p-list) p-org))
 959                  (setq pos-org (+ 2 (* 2 i))))
 960                 ((and (>= p-sta 0) (= (nth i p-list) p-sta))
 961                  (setq pos-sta (+ 2 (* 2 i))))
 962                 ((and (>= p-sum 0) (= (nth i p-list) p-sum))
 963                  (setq pos-sum (+ 2 (* 2 i))))
 964                 ((and (>= p-url 0) (= (nth i p-list) p-url))
 965                  (setq pos-url (+ 2 (* 2 i))))))
 966         (mapc (lambda (ij)
 967                 (setq s (icalendar--rris (car ij) (cadr ij) s t t)))
 968               (list
 969                ;; summary must be first! because of %s
 970                (list "%s"
 971                      (concat "\\(" icalendar-import-format-summary "\\)??"))
 972                (list "%c"
 973                      (concat "\\(" icalendar-import-format-class "\\)??"))
 974                (list "%d"
 975                      (concat "\\(" icalendar-import-format-description "\\)??"))
 976                (list "%l"
 977                      (concat "\\(" icalendar-import-format-location "\\)??"))
 978                (list "%o"
 979                      (concat "\\(" icalendar-import-format-organizer "\\)??"))
 980                (list "%t"
 981                      (concat "\\(" icalendar-import-format-status "\\)??"))
 982                (list "%u"
 983                      (concat "\\(" icalendar-import-format-url "\\)??"))))
 984         (setq s (concat "^" (icalendar--rris "%s" "\\(.*?\\)" s nil t)
 985                         " $"))
 986         (if (string-match s summary-and-rest)
 987             (let (cla des loc org sta sum url)
 988               (if (and pos-sum (match-beginning pos-sum))
 989                   (setq sum (substring summary-and-rest
 990                                        (match-beginning pos-sum)
 991                                        (match-end pos-sum))))
 992               (if (and pos-cla (match-beginning pos-cla))
 993                   (setq cla (substring summary-and-rest
 994                                        (match-beginning pos-cla)
 995                                        (match-end pos-cla))))
 996               (if (and pos-des (match-beginning pos-des))
 997                   (setq des (substring summary-and-rest
 998                                        (match-beginning pos-des)
 999                                        (match-end pos-des))))
1000               (if (and pos-loc (match-beginning pos-loc))
1001                   (setq loc (substring summary-and-rest
1002                                        (match-beginning pos-loc)
1003                                        (match-end pos-loc))))
1004               (if (and pos-org (match-beginning pos-org))
1005                   (setq org (substring summary-and-rest
1006                                        (match-beginning pos-org)
1007                                        (match-end pos-org))))
1008               (if (and pos-sta (match-beginning pos-sta))
1009                   (setq sta (substring summary-and-rest
1010                                        (match-beginning pos-sta)
1011                                        (match-end pos-sta))))
1012               (if (and pos-url (match-beginning pos-url))
1013                   (setq url (substring summary-and-rest
1014                                        (match-beginning pos-url)
1015                                        (match-end pos-url))))
1016               (list (if cla (cons 'cla cla) nil)
1017                     (if des (cons 'des des) nil)
1018                     (if loc (cons 'loc loc) nil)
1019                     (if org (cons 'org org) nil)
1020                     (if sta (cons 'sta sta) nil)
1021                     ;;(if sum (cons 'sum sum) nil)
1022                     (if url (cons 'url url) nil))))))))
1023
1024 ;; subroutines for icalendar-export-region
1025 (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
1026   "Convert \"ordinary\" diary entry to icalendar format.
1027 NONMARKER is a regular expression matching the start of non-marking
1028 entries.  ENTRY-MAIN is the first line of the diary entry."
1029   (if (string-match (concat nonmarker
1030                             "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*"
1031                             "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1032                             "\\("
1033                             "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1034                             "\\)?"
1035                             "\\s-*\\(.*?\\) ?$")
1036                     entry-main)
1037       (let* ((datetime (substring entry-main (match-beginning 1)
1038                                   (match-end 1)))
1039              (startisostring (icalendar--datestring-to-isodate
1040                               datetime))
1041              (endisostring (icalendar--datestring-to-isodate
1042                             datetime 1))
1043              (starttimestring (icalendar--diarytime-to-isotime
1044                                (if (match-beginning 3)
1045                                    (substring entry-main
1046                                               (match-beginning 3)
1047                                               (match-end 3))
1048                                  nil)
1049                                (if (match-beginning 4)
1050                                    (substring entry-main
1051                                               (match-beginning 4)
1052                                               (match-end 4))
1053                                  nil)))
1054              (endtimestring (icalendar--diarytime-to-isotime
1055                              (if (match-beginning 6)
1056                                  (substring entry-main
1057                                             (match-beginning 6)
1058                                             (match-end 6))
1059                                nil)
1060                              (if (match-beginning 7)
1061                                  (substring entry-main
1062                                             (match-beginning 7)
1063                                             (match-end 7))
1064                                nil)))
1065              (summary (icalendar--convert-string-for-export
1066                        (substring entry-main (match-beginning 8)
1067                                   (match-end 8)))))
1068         (icalendar--dmsg "ordinary %s" entry-main)
1069
1070         (unless startisostring
1071           (error "Could not parse date"))
1072         (when starttimestring
1073           (unless endtimestring
1074             (let ((time
1075                    (read (icalendar--rris "^T0?" ""
1076                                           starttimestring))))
1077               (setq endtimestring (format "T%06d"
1078                                           (+ 10000 time))))))
1079         (list (concat "\nDTSTART;"
1080                       (if starttimestring "VALUE=DATE-TIME:"
1081                         "VALUE=DATE:")
1082                       startisostring
1083                       (or starttimestring "")
1084                       "\nDTEND;"
1085                       (if endtimestring "VALUE=DATE-TIME:"
1086                         "VALUE=DATE:")
1087                       (if starttimestring
1088                           startisostring
1089                         endisostring)
1090                       (or endtimestring ""))
1091               summary))
1092     ;; no match
1093     nil))
1094
1095 (defun icalendar--convert-weekly-to-ical (nonmarker entry-main)
1096   "Convert weekly diary entry to icalendar format.
1097 NONMARKER is a regular expression matching the start of non-marking
1098 entries.  ENTRY-MAIN is the first line of the diary entry."
1099   (if (and (string-match (concat nonmarker
1100                                  "\\([a-z]+\\)\\s-+"
1101                                  "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)"
1102                                  "\\([ap]m\\)?"
1103                                  "\\(-0?"
1104                                  "\\([1-9][0-9]?:[0-9][0-9]\\)"
1105                                  "\\([ap]m\\)?\\)?"
1106                                  "\\)?"
1107                                  "\\s-*\\(.*?\\) ?$")
1108                          entry-main)
1109            (icalendar--get-weekday-abbrev
1110             (substring entry-main (match-beginning 1)
1111                        (match-end 1))))
1112       (let* ((day (icalendar--get-weekday-abbrev
1113                    (substring entry-main (match-beginning 1)
1114                               (match-end 1))))
1115              (starttimestring (icalendar--diarytime-to-isotime
1116                                (if (match-beginning 3)
1117                                    (substring entry-main
1118                                               (match-beginning 3)
1119                                               (match-end 3))
1120                                  nil)
1121                                (if (match-beginning 4)
1122                                    (substring entry-main
1123                                               (match-beginning 4)
1124                                               (match-end 4))
1125                                  nil)))
1126              (endtimestring (icalendar--diarytime-to-isotime
1127                              (if (match-beginning 6)
1128                                  (substring entry-main
1129                                             (match-beginning 6)
1130                                             (match-end 6))
1131                                nil)
1132                              (if (match-beginning 7)
1133                                  (substring entry-main
1134                                             (match-beginning 7)
1135                                             (match-end 7))
1136                                nil)))
1137              (summary (icalendar--convert-string-for-export
1138                        (substring entry-main (match-beginning 8)
1139                                   (match-end 8)))))
1140         (icalendar--dmsg "weekly %s" entry-main)
1141
1142         (when starttimestring
1143           (unless endtimestring
1144             (let ((time (read
1145                          (icalendar--rris "^T0?" ""
1146                                           starttimestring))))
1147               (setq endtimestring (format "T%06d"
1148                                           (+ 10000 time))))))
1149         (list (concat "\nDTSTART;"
1150                       (if starttimestring
1151                           "VALUE=DATE-TIME:"
1152                         "VALUE=DATE:")
1153                       ;; find the correct week day,
1154                       ;; 1st january 2000 was a saturday
1155                       (format
1156                        "200001%02d"
1157                        (+ (icalendar--get-weekday-number day) 2))
1158                       (or starttimestring "")
1159                       "\nDTEND;"
1160                       (if endtimestring
1161                           "VALUE=DATE-TIME:"
1162                         "VALUE=DATE:")
1163                       (format
1164                        "200001%02d"
1165                        ;; end is non-inclusive!
1166                        (+ (icalendar--get-weekday-number day)
1167                           (if endtimestring 2 3)))
1168                       (or endtimestring "")
1169                       "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
1170                       day)
1171               summary))
1172     ;; no match
1173     nil))
1174
1175 (defun icalendar--convert-yearly-to-ical (nonmarker entry-main)
1176   "Convert yearly diary entry to icalendar format.
1177 NONMARKER is a regular expression matching the start of non-marking
1178 entries.  ENTRY-MAIN is the first line of the diary entry."
1179   (if (string-match (concat nonmarker
1180                             (if european-calendar-style
1181                                 "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
1182                               "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
1183                             "\\*?\\s-*"
1184                             "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1185                             "\\("
1186                             "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1187                             "\\)?"
1188                             "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
1189                             )
1190                     entry-main)
1191       (let* ((daypos (if european-calendar-style 1 2))
1192              (monpos (if european-calendar-style 2 1))
1193              (day (read (substring entry-main
1194                                    (match-beginning daypos)
1195                                    (match-end daypos))))
1196              (month (icalendar--get-month-number
1197                      (substring entry-main
1198                                 (match-beginning monpos)
1199                                 (match-end monpos))))
1200              (starttimestring (icalendar--diarytime-to-isotime
1201                                (if (match-beginning 4)
1202                                    (substring entry-main
1203                                               (match-beginning 4)
1204                                               (match-end 4))
1205                                  nil)
1206                                (if (match-beginning 5)
1207                                    (substring entry-main
1208                                               (match-beginning 5)
1209                                               (match-end 5))
1210                                  nil)))
1211              (endtimestring (icalendar--diarytime-to-isotime
1212                              (if (match-beginning 7)
1213                                  (substring entry-main
1214                                             (match-beginning 7)
1215                                             (match-end 7))
1216                                nil)
1217                              (if (match-beginning 8)
1218                                  (substring entry-main
1219                                             (match-beginning 8)
1220                                             (match-end 8))
1221                                nil)))
1222              (summary (icalendar--convert-string-for-export
1223                        (substring entry-main (match-beginning 9)
1224                                   (match-end 9)))))
1225         (icalendar--dmsg "yearly %s" entry-main)
1226
1227         (when starttimestring
1228           (unless endtimestring
1229             (let ((time (read
1230                          (icalendar--rris "^T0?" ""
1231                                           starttimestring))))
1232               (setq endtimestring (format "T%06d"
1233                                           (+ 10000 time))))))
1234         (list (concat "\nDTSTART;"
1235                       (if starttimestring "VALUE=DATE-TIME:"
1236                         "VALUE=DATE:")
1237                       (format "1900%02d%02d" month day)
1238                       (or starttimestring "")
1239                       "\nDTEND;"
1240                       (if endtimestring "VALUE=DATE-TIME:"
1241                         "VALUE=DATE:")
1242                       ;; end is not included! shift by one day
1243                       (icalendar--date-to-isodate
1244                        (list month day 1900)
1245                        (if endtimestring 0 1))
1246                       (or endtimestring "")
1247                       "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
1248                       (format "%2d" month)
1249                       ";BYMONTHDAY="
1250                       (format "%2d" day))
1251               summary))
1252     ;; no match
1253     nil))
1254
1255 (defun icalendar--convert-sexp-to-ical (nonmarker entry-main)
1256   "Convert complex sexp diary entry to icalendar format -- unsupported!
1257
1258 FIXME!
1259
1260 NONMARKER is a regular expression matching the start of non-marking
1261 entries.  ENTRY-MAIN is the first line of the diary entry."
1262   (cond ((string-match (concat nonmarker
1263                                "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
1264                        entry-main)
1265          ;; simple sexp entry as generated by icalendar.el: strip off the
1266          ;; unnecessary (and)
1267          (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main)
1268          (icalendar--convert-to-ical
1269           nonmarker
1270           (concat "%%"
1271                   (substring entry-main (match-beginning 1) (match-end 1))
1272                   (substring entry-main (match-beginning 2) (match-end 2)))))
1273         ((string-match (concat nonmarker
1274                                "%%([^)]+)\\s-*.*")
1275                        entry-main)
1276          (icalendar--dmsg "diary-sexp %s" entry-main)
1277          (error "Sexp-entries are not supported yet"))
1278         (t
1279          ;; no match
1280          nil)))
1281
1282 (defun icalendar--convert-block-to-ical (nonmarker entry-main)
1283   "Convert block diary entry to icalendar format.
1284 NONMARKER is a regular expression matching the start of non-marking
1285 entries.  ENTRY-MAIN is the first line of the diary entry."
1286   (if (string-match (concat nonmarker
1287                             "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
1288                             " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1289                             "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1290                             "\\("
1291                             "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1292                             "\\)?"
1293                             "\\s-*\\(.*?\\) ?$")
1294                     entry-main)
1295       (let* ((startstring (substring entry-main
1296                                      (match-beginning 1)
1297                                      (match-end 1)))
1298              (endstring (substring entry-main
1299                                    (match-beginning 2)
1300                                    (match-end 2)))
1301              (startisostring (icalendar--datestring-to-isodate
1302                               startstring))
1303              (endisostring (icalendar--datestring-to-isodate
1304                             endstring))
1305              (endisostring+1 (icalendar--datestring-to-isodate
1306                               endstring 1))
1307              (starttimestring (icalendar--diarytime-to-isotime
1308                                (if (match-beginning 4)
1309                                    (substring entry-main
1310                                               (match-beginning 4)
1311                                               (match-end 4))
1312                                  nil)
1313                                (if (match-beginning 5)
1314                                    (substring entry-main
1315                                               (match-beginning 5)
1316                                               (match-end 5))
1317                                  nil)))
1318              (endtimestring (icalendar--diarytime-to-isotime
1319                              (if (match-beginning 7)
1320                                  (substring entry-main
1321                                             (match-beginning 7)
1322                                             (match-end 7))
1323                                nil)
1324                              (if (match-beginning 8)
1325                                  (substring entry-main
1326                                             (match-beginning 8)
1327                                             (match-end 8))
1328                                nil)))
1329              (summary (icalendar--convert-string-for-export
1330                        (substring entry-main (match-beginning 9)
1331                                   (match-end 9)))))
1332         (icalendar--dmsg "diary-block %s" entry-main)
1333         (when starttimestring
1334           (unless endtimestring
1335             (let ((time
1336                    (read (icalendar--rris "^T0?" ""
1337                                           starttimestring))))
1338               (setq endtimestring (format "T%06d"
1339                                           (+ 10000 time))))))
1340         (if starttimestring
1341             ;; with time -> write rrule
1342             (list (concat "\nDTSTART;VALUE=DATE-TIME:"
1343                           startisostring
1344                           starttimestring
1345                           "\nDTEND;VALUE=DATE-TIME:"
1346                           startisostring
1347                           endtimestring
1348                           "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
1349                           endisostring)
1350                   summary)
1351           ;; no time -> write long event
1352           (list (concat "\nDTSTART;VALUE=DATE:" startisostring
1353                         "\nDTEND;VALUE=DATE:" endisostring+1)
1354                 summary)))
1355     ;; no match
1356     nil))
1357
1358 (defun icalendar--convert-float-to-ical (nonmarker entry-main)
1359   "Convert float diary entry to icalendar format -- unsupported!
1360
1361 FIXME!
1362
1363 NONMARKER is a regular expression matching the start of non-marking
1364 entries.  ENTRY-MAIN is the first line of the diary entry."
1365   (if (string-match (concat nonmarker
1366                             "%%(diary-float \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1367                     entry-main)
1368       (progn
1369         (icalendar--dmsg "diary-float %s" entry-main)
1370         (error "`diary-float' is not supported yet"))
1371     ;; no match
1372     nil))
1373
1374 (defun icalendar--convert-date-to-ical (nonmarker entry-main)
1375   "Convert `diary-date' diary entry to icalendar format -- unsupported!
1376
1377 FIXME!
1378
1379 NONMARKER is a regular expression matching the start of non-marking
1380 entries.  ENTRY-MAIN is the first line of the diary entry."
1381   (if (string-match (concat nonmarker
1382                             "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1383                     entry-main)
1384       (progn
1385         (icalendar--dmsg "diary-date %s" entry-main)
1386         (error "`diary-date' is not supported yet"))
1387     ;; no match
1388     nil))
1389
1390 (defun icalendar--convert-cyclic-to-ical (nonmarker entry-main)
1391   "Convert `diary-cyclic' diary entry to icalendar format.
1392 NONMARKER is a regular expression matching the start of non-marking
1393 entries.  ENTRY-MAIN is the first line of the diary entry."
1394   (if (string-match (concat nonmarker
1395                             "%%(diary-cyclic \\([^ ]+\\) +"
1396                             "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1397                             "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1398                             "\\("
1399                             "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1400                             "\\)?"
1401                             "\\s-*\\(.*?\\) ?$")
1402                     entry-main)
1403       (let* ((frequency (substring entry-main (match-beginning 1)
1404                                    (match-end 1)))
1405              (datetime (substring entry-main (match-beginning 2)
1406                                   (match-end 2)))
1407              (startisostring (icalendar--datestring-to-isodate
1408                               datetime))
1409              (endisostring (icalendar--datestring-to-isodate
1410                             datetime))
1411              (endisostring+1 (icalendar--datestring-to-isodate
1412                               datetime 1))
1413              (starttimestring (icalendar--diarytime-to-isotime
1414                                (if (match-beginning 4)
1415                                    (substring entry-main
1416                                               (match-beginning 4)
1417                                               (match-end 4))
1418                                  nil)
1419                                (if (match-beginning 5)
1420                                    (substring entry-main
1421                                               (match-beginning 5)
1422                                               (match-end 5))
1423                                  nil)))
1424              (endtimestring (icalendar--diarytime-to-isotime
1425                              (if (match-beginning 7)
1426                                  (substring entry-main
1427                                             (match-beginning 7)
1428                                             (match-end 7))
1429                                nil)
1430                              (if (match-beginning 8)
1431                                  (substring entry-main
1432                                             (match-beginning 8)
1433                                             (match-end 8))
1434                                nil)))
1435              (summary (icalendar--convert-string-for-export
1436                        (substring entry-main (match-beginning 9)
1437                                   (match-end 9)))))
1438         (icalendar--dmsg "diary-cyclic %s" entry-main)
1439         (when starttimestring
1440           (unless endtimestring
1441             (let ((time
1442                    (read (icalendar--rris "^T0?" ""
1443                                           starttimestring))))
1444               (setq endtimestring (format "T%06d"
1445                                           (+ 10000 time))))))
1446         (list (concat "\nDTSTART;"
1447                       (if starttimestring "VALUE=DATE-TIME:"
1448                         "VALUE=DATE:")
1449                       startisostring
1450                       (or starttimestring "")
1451                       "\nDTEND;"
1452                       (if endtimestring "VALUE=DATE-TIME:"
1453                         "VALUE=DATE:")
1454                       (if endtimestring endisostring endisostring+1)
1455                       (or endtimestring "")
1456                       "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
1457                       ;; strange: korganizer does not expect
1458                       ;; BYSOMETHING here...
1459                       )
1460               summary))
1461     ;; no match
1462     nil))
1463
1464 (defun icalendar--convert-anniversary-to-ical (nonmarker entry-main)
1465   "Convert `diary-anniversary' diary entry to icalendar format.
1466 NONMARKER is a regular expression matching the start of non-marking
1467 entries.  ENTRY-MAIN is the first line of the diary entry."
1468   (if (string-match (concat nonmarker
1469                             "%%(diary-anniversary \\([^)]+\\))\\s-*"
1470                             "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1471                             "\\("
1472                             "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1473                             "\\)?"
1474                             "\\s-*\\(.*?\\) ?$")
1475                     entry-main)
1476       (let* ((datetime (substring entry-main (match-beginning 1)
1477                                   (match-end 1)))
1478              (startisostring (icalendar--datestring-to-isodate
1479                               datetime))
1480              (endisostring (icalendar--datestring-to-isodate
1481                             datetime 1))
1482              (starttimestring (icalendar--diarytime-to-isotime
1483                                (if (match-beginning 3)
1484                                    (substring entry-main
1485                                               (match-beginning 3)
1486                                               (match-end 3))
1487                                  nil)
1488                                (if (match-beginning 4)
1489                                    (substring entry-main
1490                                               (match-beginning 4)
1491                                               (match-end 4))
1492                                  nil)))
1493              (endtimestring (icalendar--diarytime-to-isotime
1494                              (if (match-beginning 6)
1495                                  (substring entry-main
1496                                             (match-beginning 6)
1497                                             (match-end 6))
1498                                nil)
1499                              (if (match-beginning 7)
1500                                  (substring entry-main
1501                                             (match-beginning 7)
1502                                             (match-end 7))
1503                                nil)))
1504              (summary (icalendar--convert-string-for-export
1505                        (substring entry-main (match-beginning 8)
1506                                   (match-end 8)))))
1507         (icalendar--dmsg "diary-anniversary %s" entry-main)
1508         (when starttimestring
1509           (unless endtimestring
1510             (let ((time
1511                    (read (icalendar--rris "^T0?" ""
1512                                           starttimestring))))
1513               (setq endtimestring (format "T%06d"
1514                                           (+ 10000 time))))))
1515         (list (concat "\nDTSTART;"
1516                       (if starttimestring "VALUE=DATE-TIME:"
1517                         "VALUE=DATE:")
1518                       startisostring
1519                       (or starttimestring "")
1520                       "\nDTEND;"
1521                       (if endtimestring "VALUE=DATE-TIME:"
1522                         "VALUE=DATE:")
1523                       endisostring
1524                       (or endtimestring "")
1525                       "\nRRULE:FREQ=YEARLY;INTERVAL=1"
1526                       ;; the following is redundant,
1527                       ;; but korganizer seems to expect this... ;(
1528                       ;; and evolution doesn't understand it... :(
1529                       ;; so... who is wrong?!
1530                       ";BYMONTH="
1531                       (substring startisostring 4 6)
1532                       ";BYMONTHDAY="
1533                       (substring startisostring 6 8))
1534               summary))
1535     ;; no match
1536     nil))
1537
1538 ;; ======================================================================
1539 ;; Import -- convert icalendar to emacs-diary
1540 ;; ======================================================================
1541
1542 ;;;###autoload
1543 (defun icalendar-import-file (ical-filename diary-filename
1544                                             &optional non-marking)
1545   "Import an iCalendar file and append to a diary file.
1546 Argument ICAL-FILENAME output iCalendar file.
1547 Argument DIARY-FILENAME input `diary-file'.
1548 Optional argument NON-MARKING determines whether events are created as
1549 non-marking or not."
1550   (interactive "fImport iCalendar data from file:
1551 Finto diary file:
1552 p")
1553   ;; clean up the diary file
1554   (save-current-buffer
1555     ;; now load and convert from the ical file
1556     (set-buffer (find-file ical-filename))
1557     (icalendar-import-buffer diary-filename t non-marking)))
1558
1559 ;;;###autoload
1560 (defun icalendar-import-buffer (&optional diary-file do-not-ask
1561                                           non-marking)
1562   "Extract iCalendar events from current buffer.
1563
1564 This function searches the current buffer for the first iCalendar
1565 object, reads it and adds all VEVENT elements to the diary
1566 DIARY-FILE.
1567
1568 It will ask for each appointment whether to add it to the diary
1569 unless DO-NOT-ASK is non-nil.  When called interactively,
1570 DO-NOT-ASK is nil, so that you are asked for each event.
1571
1572 NON-MARKING determines whether diary events are created as
1573 non-marking.
1574
1575 Return code t means that importing worked well, return code nil
1576 means that an error has occurred.  Error messages will be in the
1577 buffer `*icalendar-errors*'."
1578   (interactive)
1579   (save-current-buffer
1580     ;; prepare ical
1581     (message "Preparing icalendar...")
1582     (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
1583     (goto-char (point-min))
1584     (message "Preparing icalendar...done")
1585     (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
1586         (let (ical-contents ical-errors)
1587           ;; read ical
1588           (message "Reading icalendar...")
1589           (beginning-of-line)
1590           (setq ical-contents (icalendar--read-element nil nil))
1591           (message "Reading icalendar...done")
1592           ;; convert ical
1593           (message "Converting icalendar...")
1594           (setq ical-errors (icalendar--convert-ical-to-diary
1595                              ical-contents
1596                              diary-file do-not-ask non-marking))
1597           (when diary-file
1598             ;; save the diary file if it is visited already
1599             (let ((b (find-buffer-visiting diary-file)))
1600               (when b
1601                 (save-current-buffer
1602                   (set-buffer b)
1603                   (save-buffer)))))
1604           (message "Converting icalendar...done")
1605           ;; return t if no error occurred
1606           (not ical-errors))
1607       (message
1608        "Current buffer does not contain icalendar contents!")
1609       ;; return nil, i.e. import did not work
1610       nil)))
1611
1612 (defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1613 (make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1614
1615 (defun icalendar--format-ical-event (event)
1616   "Create a string representation of an iCalendar EVENT."
1617   (if (functionp icalendar-import-format)
1618       (funcall icalendar-import-format event)
1619     (let ((string icalendar-import-format)
1620         (conversion-list
1621          '(("%c" CLASS       icalendar-import-format-class)
1622            ("%d" DESCRIPTION icalendar-import-format-description)
1623            ("%l" LOCATION    icalendar-import-format-location)
1624            ("%o" ORGANIZER   icalendar-import-format-organizer)
1625            ("%s" SUMMARY     icalendar-import-format-summary)
1626            ("%t" STATUS      icalendar-import-format-status)
1627            ("%u" URL         icalendar-import-format-url))))
1628     ;; convert the specifiers in the format string
1629     (mapc (lambda (i)
1630             (let* ((spec (car i))
1631                    (prop (cadr i))
1632                    (format (car (cddr i)))
1633                    (contents (icalendar--get-event-property event prop))
1634                    (formatted-contents ""))
1635               (when (and contents (> (length contents) 0))
1636                 (setq formatted-contents
1637                       (icalendar--rris "%s"
1638                                        (icalendar--convert-string-for-import
1639                                         contents)
1640                                        (symbol-value format)
1641                                        t t)))
1642               (setq string (icalendar--rris spec
1643                                             formatted-contents
1644                                             string
1645                                             t t))))
1646           conversion-list)
1647     string)))
1648
1649 (defun icalendar--convert-ical-to-diary (ical-list diary-file
1650                                                    &optional do-not-ask
1651                                                    non-marking)
1652   "Convert iCalendar data to an Emacs diary file.
1653 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1654 DIARY-FILE.  If DO-NOT-ASK is nil the user is asked for each event
1655 whether to actually import it.  NON-MARKING determines whether diary
1656 events are created as non-marking.
1657 This function attempts to return t if something goes wrong.  In this
1658 case an error string which describes all the errors and problems is
1659 written into the buffer `*icalendar-errors*'."
1660   (let* ((ev (icalendar--all-events ical-list))
1661          (error-string "")
1662          (event-ok t)
1663          (found-error nil)
1664          (zone-map (icalendar--convert-all-timezones ical-list))
1665          e diary-string)
1666     ;; step through all events/appointments
1667     (while ev
1668       (setq e (car ev))
1669       (setq ev (cdr ev))
1670       (setq event-ok nil)
1671       (condition-case error-val
1672           (let* ((dtstart (icalendar--get-event-property e 'DTSTART))
1673                  (dtstart-zone (icalendar--find-time-zone
1674                                 (icalendar--get-event-property-attributes
1675                                  e 'DTSTART)
1676                                 zone-map))
1677                  (dtstart-dec (icalendar--decode-isodatetime dtstart nil
1678                                                              dtstart-zone))
1679                  (start-d (icalendar--datetime-to-diary-date
1680                            dtstart-dec))
1681                  (start-t (icalendar--datetime-to-colontime dtstart-dec))
1682                  (dtend (icalendar--get-event-property e 'DTEND))
1683                  (dtend-zone (icalendar--find-time-zone
1684                               (icalendar--get-event-property-attributes
1685                                e 'DTEND)
1686                               zone-map))
1687                  (dtend-dec (icalendar--decode-isodatetime dtend
1688                                                            nil dtend-zone))
1689                  (dtend-1-dec (icalendar--decode-isodatetime dtend -1
1690                                                              dtend-zone))
1691                  end-d
1692                  end-1-d
1693                  end-t
1694                  (summary (icalendar--convert-string-for-import
1695                            (or (icalendar--get-event-property e 'SUMMARY)
1696                                "No summary")))
1697                  (rrule (icalendar--get-event-property e 'RRULE))
1698                  (rdate (icalendar--get-event-property e 'RDATE))
1699                  (duration (icalendar--get-event-property e 'DURATION)))
1700             (icalendar--dmsg "%s: `%s'" start-d summary)
1701             ;; check whether start-time is missing
1702             (if  (and dtstart
1703                       (string=
1704                        (cadr (icalendar--get-event-property-attributes
1705                               e 'DTSTART))
1706                        "DATE"))
1707                 (setq start-t nil))
1708             (when duration
1709               (let ((dtend-dec-d (icalendar--add-decoded-times
1710                                   dtstart-dec
1711                                   (icalendar--decode-isoduration duration)))
1712                     (dtend-1-dec-d (icalendar--add-decoded-times
1713                                     dtstart-dec
1714                                     (icalendar--decode-isoduration duration
1715                                                                    t))))
1716                 (if (and dtend-dec (not (eq dtend-dec dtend-dec-d)))
1717                     (message "Inconsistent endtime and duration for %s"
1718                              summary))
1719                 (setq dtend-dec dtend-dec-d)
1720                 (setq dtend-1-dec dtend-1-dec-d)))
1721             (setq end-d (if dtend-dec
1722                             (icalendar--datetime-to-diary-date dtend-dec)
1723                           start-d))
1724             (setq end-1-d (if dtend-1-dec
1725                               (icalendar--datetime-to-diary-date dtend-1-dec)
1726                             start-d))
1727             (setq end-t (if (and
1728                              dtend-dec
1729                              (not (string=
1730                                    (cadr
1731                                     (icalendar--get-event-property-attributes
1732                                      e 'DTEND))
1733                                    "DATE")))
1734                             (icalendar--datetime-to-colontime dtend-dec)
1735                           start-t))
1736             (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
1737             (cond
1738              ;; recurring event
1739              (rrule
1740               (setq diary-string
1741                     (icalendar--convert-recurring-to-diary e dtstart-dec start-t
1742                                                            end-t))
1743               (setq event-ok t))
1744              (rdate
1745               (icalendar--dmsg "rdate event")
1746               (setq diary-string "")
1747               (mapc (lambda (datestring)
1748                       (setq diary-string
1749                             (concat diary-string
1750                                     (format "......"))))
1751                     (icalendar--split-value rdate)))
1752              ;; non-recurring event
1753              ;; all-day event
1754              ((not (string= start-d end-d))
1755               (setq diary-string
1756                     (icalendar--convert-non-recurring-all-day-to-diary
1757                      e start-d end-1-d))
1758               (setq event-ok t))
1759              ;; not all-day
1760              ((and start-t (or (not end-t)
1761                                (not (string= start-t end-t))))
1762               (setq diary-string
1763                     (icalendar--convert-non-recurring-not-all-day-to-diary
1764                      e dtstart-dec dtend-dec start-t end-t))
1765               (setq event-ok t))
1766              ;; all-day event
1767              (t
1768               (icalendar--dmsg "all day event")
1769               (setq diary-string (icalendar--datetime-to-diary-date
1770                                   dtstart-dec "/"))
1771               (setq event-ok t)))
1772             ;; add all other elements unless the user doesn't want to have
1773             ;; them
1774             (if event-ok
1775                 (progn
1776                   (setq diary-string
1777                         (concat diary-string " "
1778                                 (icalendar--format-ical-event e)))
1779                   (if do-not-ask (setq summary nil))
1780                   ;; add entry to diary and store actual name of diary
1781                   ;; file (in case it was nil)
1782                   (setq diary-file
1783                         (icalendar--add-diary-entry diary-string diary-file
1784                                                     non-marking summary)))
1785               ;; event was not ok
1786               (setq found-error t)
1787               (setq error-string
1788                     (format "%s\nCannot handle this event:%s"
1789                             error-string e))))
1790         ;; FIXME: inform user about ignored event properties
1791         ;; handle errors
1792         (error
1793          (message "Ignoring event \"%s\"" e)
1794          (setq found-error t)
1795          (setq error-string (format "%s\n%s\nCannot handle this event: %s"
1796                                     error-val error-string e))
1797          (message "%s" error-string))))
1798
1799     ;; insert final newline
1800     (if diary-file
1801         (let ((b (find-buffer-visiting diary-file)))
1802           (when b
1803             (save-current-buffer
1804               (set-buffer b)
1805               (goto-char (point-max))
1806               (insert "\n")))))
1807     (if found-error
1808         (save-current-buffer
1809           (set-buffer (get-buffer-create "*icalendar-errors*"))
1810           (erase-buffer)
1811           (insert error-string)))
1812     (message "Converting icalendar...done")
1813     found-error))
1814
1815 ;; subroutines for importing
1816 (defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t)
1817   "Convert recurring icalendar event E to diary format.
1818
1819 DTSTART-DEC is the DTSTART property of E.
1820 START-T is the event's start time in diary format.
1821 END-T is the event's end time in diary format."
1822   (icalendar--dmsg "recurring event")
1823   (let* ((rrule        (icalendar--get-event-property e 'RRULE))
1824          (rrule-props  (icalendar--split-value rrule))
1825          (frequency    (cadr (assoc 'FREQ rrule-props)))
1826          (until        (cadr (assoc 'UNTIL rrule-props)))
1827          (count        (cadr (assoc 'COUNT rrule-props)))
1828          (interval     (read (or (cadr (assoc 'INTERVAL rrule-props)) "1")))
1829          (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec))
1830          (until-conv   (icalendar--datetime-to-diary-date
1831                         (icalendar--decode-isodatetime until)))
1832          (until-1-conv (icalendar--datetime-to-diary-date
1833                         (icalendar--decode-isodatetime until -1)))
1834          (result  ""))
1835
1836     ;; FIXME FIXME interval!!!!!!!!!!!!!
1837
1838     (when count
1839       (if until
1840           (message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
1841         (let ((until-1 0))
1842           (cond ((string-equal frequency "DAILY")
1843                  (setq until (icalendar--add-decoded-times
1844                               dtstart-dec
1845                               (list 0 0 0 (* (read count) interval) 0 0)))
1846                  (setq until-1 (icalendar--add-decoded-times
1847                                 dtstart-dec
1848                                 (list 0 0 0 (* (- (read count) 1) interval)
1849                                       0 0)))
1850                  )
1851                 ((string-equal frequency "WEEKLY")
1852                  (setq until (icalendar--add-decoded-times
1853                               dtstart-dec
1854                               (list 0 0 0 (* (read count) 7 interval) 0 0)))
1855                  (setq until-1 (icalendar--add-decoded-times
1856                                 dtstart-dec
1857                                 (list 0 0 0 (* (- (read count) 1) 7
1858                                                interval) 0 0)))
1859                  )
1860                 ((string-equal frequency "MONTHLY")
1861                  (setq until (icalendar--add-decoded-times
1862                               dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
1863                                                            interval) 0)))
1864                  (setq until-1 (icalendar--add-decoded-times
1865                                 dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
1866                                                              interval) 0)))
1867                  )
1868                 ((string-equal frequency "YEARLY")
1869                  (setq until (icalendar--add-decoded-times
1870                               dtstart-dec (list 0 0 0 0 0 (* (- (read count) 1)
1871                                                              interval))))
1872                  (setq until-1 (icalendar--add-decoded-times
1873                                 dtstart-dec
1874                                 (list 0 0 0 0 0 (* (- (read count) 1)
1875                                                    interval))))
1876                  )
1877                 (t
1878                  (message "Cannot handle COUNT attribute for `%s' events."
1879                           frequency)))
1880           (setq until-conv (icalendar--datetime-to-diary-date until))
1881           (setq until-1-conv (icalendar--datetime-to-diary-date until-1))
1882           ))
1883       )
1884     (cond ((string-equal frequency "WEEKLY")
1885            (if (not start-t)
1886                (progn
1887                  ;; weekly and all-day
1888                  (icalendar--dmsg "weekly all-day")
1889                  (if until
1890                      (setq result
1891                            (format
1892                             (concat "%%%%(and "
1893                                     "(diary-cyclic %d %s) "
1894                                     "(diary-block %s %s))")
1895                             (* interval 7)
1896                             dtstart-conv
1897                             dtstart-conv
1898                             (if count until-1-conv until-conv)
1899                             ))
1900                    (setq result
1901                          (format "%%%%(and (diary-cyclic %d %s))"
1902                                  (* interval 7)
1903                                  dtstart-conv))))
1904              ;; weekly and not all-day
1905              (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
1906                     (weekday
1907                      (icalendar--get-weekday-number byday)))
1908                (icalendar--dmsg "weekly not-all-day")
1909                (if until
1910                    (setq result
1911                          (format
1912                           (concat "%%%%(and "
1913                                   "(diary-cyclic %d %s) "
1914                                   "(diary-block %s %s)) "
1915                                   "%s%s%s")
1916                           (* interval 7)
1917                           dtstart-conv
1918                           dtstart-conv
1919                           until-conv
1920                           (or start-t "")
1921                           (if end-t "-" "") (or end-t "")))
1922                  ;; no limit
1923                  ;; FIXME!!!!
1924                  ;; DTSTART;VALUE=DATE-TIME:20030919T090000
1925                  ;; DTEND;VALUE=DATE-TIME:20030919T113000
1926                  (setq result
1927                        (format
1928                         "%%%%(and (diary-cyclic %s %s)) %s%s%s"
1929                         (* interval 7)
1930                         dtstart-conv
1931                         (or start-t "")
1932                         (if end-t "-" "") (or end-t "")))))))
1933           ;; yearly
1934           ((string-equal frequency "YEARLY")
1935            (icalendar--dmsg "yearly")
1936            (if until
1937                (setq result (format
1938                              (concat "%%%%(and (diary-date %s %s t) "
1939                                      "(diary-block %s %s)) %s%s%s")
1940                              (if european-calendar-style (nth 3 dtstart-dec)
1941                                (nth 4 dtstart-dec))
1942                              (if european-calendar-style (nth 4 dtstart-dec)
1943                                (nth 3 dtstart-dec))
1944                              dtstart-conv
1945                              until-conv
1946                              (or start-t "")
1947                              (if end-t "-" "") (or end-t "")))
1948              (setq result (format
1949                            "%%%%(and (diary-anniversary %s)) %s%s%s"
1950                            dtstart-conv
1951                            (or start-t "")
1952                            (if end-t "-" "") (or end-t "")))))
1953           ;; monthly
1954           ((string-equal frequency "MONTHLY")
1955            (icalendar--dmsg "monthly")
1956            (setq result
1957                  (format
1958                   "%%%%(and (diary-date %s %s %s) (diary-block %s %s)) %s%s%s"
1959                   (if european-calendar-style (nth 3 dtstart-dec) "t")
1960                   (if european-calendar-style "t" (nth 3 dtstart-dec))
1961                   "t"
1962                   dtstart-conv
1963                   (if until
1964                       until-conv
1965                     "1 1 9999") ;; FIXME: should be unlimited
1966                   (or start-t "")
1967                   (if end-t "-" "") (or end-t ""))))
1968           ;; daily
1969           ((and (string-equal frequency "DAILY"))
1970            (if until
1971                (setq result
1972                      (format
1973                       (concat "%%%%(and (diary-cyclic %s %s) "
1974                               "(diary-block %s %s)) %s%s%s")
1975                       interval dtstart-conv dtstart-conv
1976                       (if count until-1-conv until-conv)
1977                       (or start-t "")
1978                       (if end-t "-" "") (or end-t "")))
1979              (setq result
1980                    (format
1981                     "%%%%(and (diary-cyclic %s %s)) %s%s%s"
1982                     interval
1983                     dtstart-conv
1984                     (or start-t "")
1985                     (if end-t "-" "") (or end-t ""))))))
1986     ;; Handle exceptions from recurrence rules
1987     (let ((ex-dates (icalendar--get-event-properties e 'EXDATE)))
1988       (while ex-dates
1989         (let* ((ex-start (icalendar--decode-isodatetime
1990                           (car ex-dates)))
1991                (ex-d (icalendar--datetime-to-diary-date
1992                       ex-start)))
1993           (setq result
1994                 (icalendar--rris "^%%(\\(and \\)?"
1995                                  (format
1996                                   "%%%%(and (not (diary-date %s)) "
1997                                   ex-d)
1998                                  result)))
1999         (setq ex-dates (cdr ex-dates))))
2000     ;; FIXME: exception rules are not recognized
2001     (if (icalendar--get-event-property e 'EXRULE)
2002         (setq result
2003               (concat result
2004                       "\n Exception rules: "
2005                       (icalendar--get-event-properties
2006                        e 'EXRULE))))
2007     result))
2008
2009 (defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d)
2010   "Convert non-recurring icalendar EVENT to diary format.
2011
2012 DTSTART is the decoded DTSTART property of E.
2013 Argument START-D gives the first day.
2014 Argument END-D gives the last day."
2015   (icalendar--dmsg "non-recurring all-day event")
2016   (format "%%%%(and (diary-block %s %s))" start-d end-d))
2017
2018 (defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
2019                                                                     dtend-dec
2020                                                                     start-t
2021                                                                     end-t)
2022   "Convert recurring icalendar EVENT to diary format.
2023
2024 DTSTART-DEC is the decoded DTSTART property of E.
2025 DTEND-DEC is the decoded DTEND property of E.
2026 START-T is the event's start time in diary format.
2027 END-T is the event's end time in diary format."
2028   (icalendar--dmsg "not all day event")
2029   (cond (end-t
2030          (format "%s %s-%s"
2031                  (icalendar--datetime-to-diary-date
2032                   dtstart-dec "/")
2033                  start-t end-t))
2034         (t
2035          (format "%s %s"
2036                  (icalendar--datetime-to-diary-date
2037                   dtstart-dec "/")
2038                  start-t))))
2039
2040 (defun icalendar--add-diary-entry (string diary-file non-marking
2041                                           &optional summary)
2042   "Add STRING to the diary file DIARY-FILE.
2043 STRING must be a properly formatted valid diary entry.  NON-MARKING
2044 determines whether diary events are created as non-marking.  If
2045 SUMMARY is not nil it must be a string that gives the summary of the
2046 entry.  In this case the user will be asked whether he wants to insert
2047 the entry."
2048   (when (or (not summary)
2049             (y-or-n-p (format "Add appointment for `%s' to diary? "
2050                               summary)))
2051     (when summary
2052       (setq non-marking
2053             (y-or-n-p (format "Make appointment non-marking? "))))
2054     (save-window-excursion
2055       (unless diary-file
2056         (setq diary-file
2057               (read-file-name "Add appointment to this diary file: ")))
2058       ;; Note: make-diary-entry will add a trailing blank char.... :(
2059       (make-diary-entry string non-marking diary-file)))
2060   ;; return diary-file in case it has been changed interactively
2061   diary-file)
2062
2063 ;; ======================================================================
2064 ;; Examples
2065 ;; ======================================================================
2066 (defun icalendar-import-format-sample (event)
2067   "Example function for formatting an icalendar EVENT."
2068   (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
2069                   "STATUS=`%s' URL=`%s' CLASS=`%s'")
2070           (or (icalendar--get-event-property event 'SUMMARY) "")
2071           (or (icalendar--get-event-property event 'DESCRIPTION) "")
2072           (or (icalendar--get-event-property event 'LOCATION) "")
2073           (or (icalendar--get-event-property event 'ORGANIZER) "")
2074           (or (icalendar--get-event-property event 'STATUS) "")
2075           (or (icalendar--get-event-property event 'URL) "")
2076           (or (icalendar--get-event-property event 'CLASS) "")))
2077
2078 (provide 'icalendar)
2079
2080 ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
2081 ;;; icalendar.el ends here