lisp/calendar/icalendar.el

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