lisp/calendar/icalendar.el

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