lisp/calendar/icalendar.el

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