lisp/calendar/icalendar.el

   1 ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
   2
   3 ;; Copyright (C) 2002, 2003, 2004  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.08
  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 property 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--set-event-property (event prop new-value)
 282 ;;   "For the given EVENT set the property PROP to the value NEW-VALUE."
 283 ;;   (catch 'found
 284 ;;     (let ((props (car (cddr event))) pp)
 285 ;;       (while props
 286 ;;         (setq pp (car props))
 287 ;;         (when (eq (car pp) prop)
 288 ;;           (setcdr (cdr pp) new-value)
 289 ;;           (throw 'found (car (cddr pp))))
 290 ;;         (setq props (cdr props)))
 291 ;;       (setq props (car (cddr event)))
 292 ;;       (setcar (cddr event)
 293 ;;               (append props (list (list prop nil new-value)))))))
 294
 295 (defun icalendar--get-children (node name)
 296   "Return all children of the given NODE which have a name NAME.
 297 For instance the VCALENDAR node can have VEVENT children as well as VTODO
 298 children."
 299   (let ((result nil)
 300         (children (cadr (cddr node))))
 301     (when (eq (car node) name)
 302       (setq result node))
 303     ;;(message "%s" node)
 304     (when children
 305       (let ((subresult
 306              (delq nil
 307                    (mapcar (lambda (n)
 308                              (icalendar--get-children n name))
 309                            children))))
 310         (if subresult
 311             (if result
 312                 (setq result (append result subresult))
 313               (setq result subresult)))))
 314     result))
 315
 316                                         ; private
 317 (defun icalendar--all-events (icalendar)
 318   "Return the list of all existing events in the given ICALENDAR."
 319   (icalendar--get-children (car icalendar) 'VEVENT))
 320
 321 (defun icalendar--split-value (value-string)
 322   "Splits VALUE-STRING at ';='."
 323   (let ((result '())
 324         param-name param-value)
 325     (when value-string
 326       (save-current-buffer
 327         (set-buffer (get-buffer-create " *icalendar-work*"))
 328         (set-buffer-modified-p nil)
 329         (erase-buffer)
 330         (insert value-string)
 331         (goto-char (point-min))
 332         (while
 333             (re-search-forward
 334              "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
 335              nil t)
 336           (setq param-name (intern (match-string 1)))
 337           (setq param-value (match-string 2))
 338           (setq result
 339                 (append result (list (list param-name param-value)))))))
 340     result))
 341
 342 (defun icalendar--decode-isodatetime (isodatetimestring)
 343   "Return ISODATETIMESTRING in format like `decode-time'.
 344 Converts from ISO-8601 to Emacs representation.  If ISODATETIMESTRING
 345 specifies UTC time (trailing letter Z) the decoded time is given in
 346 the local time zone! FIXME: TZID-attributes are ignored....! FIXME:
 347 multiple comma-separated values should be allowed!"
 348   (icalendar--dmsg isodatetimestring)
 349   (if isodatetimestring
 350       ;; day/month/year must be present
 351       (let ((year  (read (substring isodatetimestring 0 4)))
 352             (month (read (substring isodatetimestring 4 6)))
 353             (day   (read (substring isodatetimestring 6 8)))
 354             (hour 0)
 355             (minute 0)
 356             (second 0))
 357         (when (> (length isodatetimestring) 12)
 358           ;; hour/minute present
 359           (setq hour (read (substring isodatetimestring 9 11)))
 360           (setq minute (read (substring isodatetimestring 11 13))))
 361         (when (> (length isodatetimestring) 14)
 362           ;; seconds present
 363           (setq second (read (substring isodatetimestring 13 15))))
 364         (when (and (> (length isodatetimestring) 15)
 365                    ;; UTC specifier present
 366                    (char-equal ?Z (aref isodatetimestring 15)))
 367           ;; if not UTC add current-time-zone offset
 368           (setq second (+ (car (current-time-zone)) second)))
 369         ;; create the decoded date-time
 370         ;; FIXME!?!
 371         (condition-case nil
 372             (decode-time (encode-time second minute hour day month year))
 373           (error
 374            (message "Cannot decode \"%s\"" isodatetimestring)
 375            ;; hope for the best...
 376            (list second minute hour day month year 0 nil 0))))
 377     ;; isodatetimestring == nil
 378     nil))
 379
 380 (defun icalendar--decode-isoduration (isodurationstring)
 381   "Return ISODURATIONSTRING in format like `decode-time'.
 382 Converts from ISO-8601 to Emacs representation.  If ISODURATIONSTRING
 383 specifies UTC time (trailing letter Z) the decoded time is given in
 384 the local time zone! FIXME: TZID-attributes are ignored....! FIXME:
 385 multiple comma-separated values should be allowed!"
 386   (if isodurationstring
 387       (save-match-data
 388         (string-match
 389          (concat
 390           "^P[+-]?\\("
 391           "\\(\\([0-9]+\\)D\\)"         ; days only
 392           "\\|"
 393           "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
 394           "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)"  ; mand. time
 395           "\\|"
 396           "\\(\\([0-9]+\\)W\\)"         ; weeks only
 397           "\\)$") isodurationstring)
 398         (let ((seconds 0)
 399               (minutes 0)
 400               (hours 0)
 401               (days 0)
 402               (months 0)
 403               (years 0))
 404           (cond
 405            ((match-beginning 2)         ;days only
 406             (setq days (read (substring isodurationstring
 407                                         (match-beginning 3)
 408                                         (match-end 3))))
 409             (when icalendar-duration-correction
 410               (setq days (1- days))))
 411            ((match-beginning 4)         ;days and time
 412             (if (match-beginning 5)
 413                 (setq days (* 7 (read (substring isodurationstring
 414                                                  (match-beginning 6)
 415                                                  (match-end 6))))))
 416             (if (match-beginning 7)
 417                 (setq hours (read (substring isodurationstring
 418                                              (match-beginning 8)
 419                                              (match-end 8)))))
 420             (if (match-beginning 9)
 421                 (setq minutes (read (substring isodurationstring
 422                                                (match-beginning 10)
 423                                                (match-end 10)))))
 424             (if (match-beginning 11)
 425                 (setq seconds (read (substring isodurationstring
 426                                                (match-beginning 12)
 427                                                (match-end 12)))))
 428             )
 429            ((match-beginning 13)        ;weeks only
 430             (setq days (* 7 (read (substring isodurationstring
 431                                              (match-beginning 14)
 432                                              (match-end 14))))))
 433            )
 434           (list seconds minutes hours days months years)))
 435     ;; isodatetimestring == nil
 436     nil))
 437
 438 (defun icalendar--add-decoded-times (time1 time2)
 439   "Add TIME1 to TIME2.
 440 Both times must be given in decoded form.  One of these times must be
 441 valid (year > 1900 or something)."
 442   ;; FIXME: does this function exist already?
 443   (decode-time (encode-time
 444                 (+ (nth 0 time1) (nth 0 time2))
 445                 (+ (nth 1 time1) (nth 1 time2))
 446                 (+ (nth 2 time1) (nth 2 time2))
 447                 (+ (nth 3 time1) (nth 3 time2))
 448                 (+ (nth 4 time1) (nth 4 time2))
 449                 (+ (nth 5 time1) (nth 5 time2))
 450                 nil
 451                 nil
 452                 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
 453                 )))
 454
 455 (defun icalendar--datetime-to-noneuropean-date (datetime)
 456   "Convert the decoded DATETIME to non-european-style format.
 457 Non-European format: (month day year)."
 458   (if datetime
 459       (list (nth 4 datetime)            ;month
 460             (nth 3 datetime)            ;day
 461             (nth 5 datetime))           ;year
 462     ;; datetime == nil
 463     nil))
 464
 465 (defun icalendar--datetime-to-european-date (datetime)
 466   "Convert the decoded DATETIME to European format.
 467 European format: (day month year).
 468 FIXME"
 469   (if datetime
 470       (format "%d %d %d" (nth 3 datetime) ; day
 471               (nth 4 datetime)            ;month
 472               (nth 5 datetime))           ;year
 473     ;; datetime == nil
 474     nil))
 475
 476 (defun icalendar--datetime-to-colontime (datetime)
 477   "Extract the time part of a decoded DATETIME into 24-hour format.
 478 Note that this silently ignores seconds."
 479   (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
 480
 481 (defun icalendar--get-month-number (monthname)
 482   "Return the month number for the given MONTHNAME."
 483   (catch 'found
 484     (let ((num 1)
 485           (m (downcase monthname)))
 486       (mapc (lambda (month)
 487               (let ((mm (downcase month)))
 488                 (if (or (string-equal mm m)
 489                         (string-equal (substring mm 0 3) m))
 490                     (throw 'found num))
 491                 (setq num (1+ num))))
 492             calendar-month-name-array))
 493     ;; Error:
 494     -1))
 495
 496 (defun icalendar--get-weekday-number (abbrevweekday)
 497   "Return the number for the ABBREVWEEKDAY."
 498   (catch 'found
 499     (let ((num 0)
 500           (aw (downcase abbrevweekday)))
 501       (mapc (lambda (day)
 502               (let ((d (downcase day)))
 503                 (if (string-equal d aw)
 504                     (throw 'found num))
 505                 (setq num (1+ num))))
 506             icalendar--weekday-array))
 507     ;; Error:
 508     -1))
 509
 510 (defun icalendar--get-weekday-abbrev (weekday)
 511   "Return the abbreviated WEEKDAY."
 512   (catch 'found
 513     (let ((num 0)
 514           (w (downcase weekday)))
 515       (mapc (lambda (day)
 516               (let ((d (downcase day)))
 517                 (if (or (string-equal d w)
 518                         (string-equal (substring d 0 3) w))
 519                     (throw 'found (aref icalendar--weekday-array num)))
 520                 (setq num (1+ num))))
 521             calendar-day-name-array))
 522     ;; Error:
 523     nil))
 524
 525 (defun icalendar--date-to-isodate (date &optional day-shift)
 526   "Convert DATE to iso-style date.
 527 DATE must be a list of the form (month day year).
 528 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
 529   (let ((mdy (calendar-gregorian-from-absolute
 530               (+ (calendar-absolute-from-gregorian date)
 531                  (or day-shift 0)))))
 532     (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
 533
 534
 535 (defun icalendar--datestring-to-isodate (datestring &optional day-shift)
 536   "Convert diary-style DATESTRING to iso-style date.
 537 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
 538 -- DAY-SHIFT must be either nil or an integer.  This function
 539 takes care of european-style."
 540   (let ((day -1) month year)
 541     (save-match-data
 542       (cond ( ;; numeric date
 543              (string-match (concat "\\s-*"
 544                                    "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
 545                                    "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
 546                                    "\\([0-9]\\{4\\}\\)")
 547                            datestring)
 548              (setq day (read (substring datestring (match-beginning 1)
 549                                         (match-end 1))))
 550              (setq month (read (substring datestring (match-beginning 2)
 551                                           (match-end 2))))
 552              (setq year (read (substring datestring (match-beginning 3)
 553                                          (match-end 3))))
 554              (unless european-calendar-style
 555                (let ((x month))
 556                  (setq month day)
 557                  (setq day x))))
 558             ( ;; date contains month names -- european-style
 559              (and european-calendar-style
 560                   (string-match (concat "\\s-*"
 561                                         "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
 562                                         "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 563                                         "\\([0-9]\\{4\\}\\)")
 564                                 datestring))
 565              (setq day (read (substring datestring (match-beginning 1)
 566                                         (match-end 1))))
 567              (setq month (icalendar--get-month-number
 568                           (substring datestring (match-beginning 2)
 569                                      (match-end 2))))
 570              (setq year (read (substring datestring (match-beginning 3)
 571                                          (match-end 3)))))
 572             ( ;; date contains month names -- non-european-style
 573              (and (not european-calendar-style)
 574                   (string-match (concat "\\s-*"
 575                                         "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 576                                         "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
 577                                         "\\([0-9]\\{4\\}\\)")
 578                                 datestring))
 579              (setq day (read (substring datestring (match-beginning 2)
 580                                         (match-end 2))))
 581              (setq month (icalendar--get-month-number
 582                           (substring datestring (match-beginning 1)
 583                                      (match-end 1))))
 584              (setq year (read (substring datestring (match-beginning 3)
 585                                          (match-end 3)))))
 586             (t
 587              nil)))
 588     (if (> day 0)
 589         (let ((mdy (calendar-gregorian-from-absolute
 590                     (+ (calendar-absolute-from-gregorian (list month day
 591                                                                year))
 592                        (or day-shift 0)))))
 593           (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
 594       nil)))
 595
 596 (defun icalendar--diarytime-to-isotime (timestring ampmstring)
 597   "Convert a a time like 9:30pm to an iso-conform string like T213000.
 598 In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
 599 would be \"pm\"."
 600   (if timestring
 601       (let ((starttimenum (read (icalendar--rris ":" "" timestring))))
 602         ;; take care of am/pm style
 603         (if (and ampmstring (string= "pm" ampmstring))
 604             (setq starttimenum (+ starttimenum 1200)))
 605         (format "T%04d00" starttimenum))
 606     nil))
 607
 608 (defun icalendar--convert-string-for-export (s)
 609   "Escape comma and other critical characters in string S."
 610   (icalendar--rris "," "\\\\," s))
 611
 612 (defun icalendar--convert-string-for-import (string)
 613   "Remove escape chars for comma, semicolon etc. from STRING."
 614   (icalendar--rris
 615    "\\\\n" "\n " (icalendar--rris
 616                   "\\\\\"" "\"" (icalendar--rris
 617                                  "\\\\;" ";" (icalendar--rris
 618                                               "\\\\," "," string)))))
 619
 620 ;; ======================================================================
 621 ;; Export -- convert emacs-diary to icalendar
 622 ;; ======================================================================
 623
 624 ;; User function
 625 (defun icalendar-export-file (diary-filename ical-filename)
 626   "Export diary file to iCalendar format.
 627 All diary entries in the file DIARY-FILENAME are converted to iCalendar
 628 format.  The result is appended to the file ICAL-FILENAME."
 629   (interactive "FExport diary data from file:
 630 Finto iCalendar file: ")
 631   (save-current-buffer
 632     (set-buffer (find-file diary-filename))
 633     (icalendar-export-region (point-min) (point-max) ical-filename)))
 634
 635 (defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
 636 (make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file)
 637
 638 ;; User function
 639 (defun icalendar-export-region (min max ical-filename)
 640   "Export region in diary file to iCalendar format.
 641 All diary entries in the region from MIN to MAX in the current buffer are
 642 converted to iCalendar format.  The result is appended to the file
 643 ICAL-FILENAME.
 644
 645 Returns non-nil if an error occurred.  In this case an error message is
 646 written to the buffer ` *icalendar-errors*'."
 647   (interactive "r
 648 FExport diary data into iCalendar file: ")
 649   (let ((result "")
 650         (start 0)
 651         (entry-main "")
 652         (entry-rest "")
 653         (header "")
 654         (contents)
 655         (found-error nil)
 656         (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
 657                            "?")))
 658     ;; prepare buffer with error messages
 659     (save-current-buffer
 660       (set-buffer (get-buffer-create " *icalendar-errors*"))
 661       (erase-buffer))
 662     ;; here we go
 663     (save-excursion
 664       (goto-char min)
 665       (while (re-search-forward
 666               "^\\([^ \t\n].*\\)\\(\\(\n[ \t].*\\)*\\)" max t)
 667         (setq entry-main (match-string 1))
 668         (if (match-beginning 2)
 669             (setq entry-rest (match-string 2))
 670           (setq entry-rest ""))
 671         (setq header (format "\nBEGIN:VEVENT\nUID:emacs%d%d%d"
 672                              (car (current-time))
 673                              (cadr (current-time))
 674                              (car (cddr (current-time)))))
 675         (condition-case error-val
 676             (progn
 677               (cond
 678                ;; anniversaries
 679                ((string-match
 680                  (concat nonmarker
 681                          "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)")
 682                  entry-main)
 683                 (icalendar--dmsg "diary-anniversary %s" entry-main)
 684                 (let* ((datetime (substring entry-main (match-beginning 1)
 685                                             (match-end 1)))
 686                        (summary (icalendar--convert-string-for-export
 687                                  (substring entry-main (match-beginning 2)
 688                                             (match-end 2))))
 689                        (startisostring (icalendar--datestring-to-isodate
 690                                         datetime))
 691                        (endisostring (icalendar--datestring-to-isodate
 692                                       datetime 1)))
 693                   (setq contents
 694                         (concat "\nDTSTART;VALUE=DATE:" startisostring
 695                                 "\nDTEND;VALUE=DATE:" endisostring
 696                                 "\nSUMMARY:" summary
 697                                 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
 698                                 ;; the following is redundant,
 699                                 ;; but korganizer seems to expect this... ;(
 700                                 ;; and evolution doesn't understand it... :(
 701                                 ;; so... who is wrong?!
 702                                 ";BYMONTH=" (substring startisostring 4 6)
 703                                 ";BYMONTHDAY=" (substring startisostring 6 8)
 704                                 )))
 705                 (unless (string= entry-rest "")
 706                   (setq contents (concat contents "\nDESCRIPTION:"
 707                                          (icalendar--convert-string-for-export
 708                                           entry-rest)))))
 709                ;; cyclic events
 710                ;; %%(diary-cyclic )
 711                ((string-match
 712                  (concat nonmarker
 713                          "%%(diary-cyclic \\([^ ]+\\) +"
 714                          "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
 715                  entry-main)
 716                 (icalendar--dmsg "diary-cyclic %s" entry-main)
 717                 (let* ((frequency (substring entry-main (match-beginning 1)
 718                                              (match-end 1)))
 719                        (datetime (substring entry-main (match-beginning 2)
 720                                             (match-end 2)))
 721                        (summary (icalendar--convert-string-for-export
 722                                  (substring entry-main (match-beginning 3)
 723                                             (match-end 3))))
 724                        (startisostring (icalendar--datestring-to-isodate
 725                                         datetime))
 726                        (endisostring (icalendar--datestring-to-isodate
 727                                       datetime 1)))
 728                   (setq contents
 729                         (concat "\nDTSTART;VALUE=DATE:" startisostring
 730                                 "\nDTEND;VALUE=DATE:" endisostring
 731                                 "\nSUMMARY:" summary
 732                                 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
 733                                 ;; strange: korganizer does not expect
 734                                 ;; BYSOMETHING here...
 735                                 )))
 736                 (unless (string= entry-rest "")
 737                   (setq contents (concat contents "\nDESCRIPTION:"
 738                                          (icalendar--convert-string-for-export
 739                                           entry-rest)))))
 740                ;; diary-date -- FIXME
 741                ((string-match
 742                  (concat nonmarker
 743                          "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)")
 744                  entry-main)
 745                 (icalendar--dmsg "diary-date %s" entry-main)
 746                 (error "`diary-date' is not supported yet"))
 747                ;; float events -- FIXME
 748                ((string-match
 749                  (concat nonmarker
 750                          "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)")
 751                  entry-main)
 752                 (icalendar--dmsg "diary-float %s" entry-main)
 753                 (error "`diary-float' is not supported yet"))
 754                ;; block events
 755                ((string-match
 756                  (concat nonmarker
 757                          "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +"
 758                          "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
 759                  entry-main)
 760                 (icalendar--dmsg "diary-block %s" entry-main)
 761                 (let* ((startstring (substring entry-main (match-beginning 1)
 762                                                (match-end 1)))
 763                        (endstring (substring entry-main (match-beginning 2)
 764                                              (match-end 2)))
 765                        (summary (icalendar--convert-string-for-export
 766                                  (substring entry-main (match-beginning 3)
 767                                             (match-end 3))))
 768                        (startisostring (icalendar--datestring-to-isodate
 769                                         startstring))
 770                        (endisostring (icalendar--datestring-to-isodate
 771                                       endstring 1)))
 772                   (setq contents
 773                         (concat "\nDTSTART;VALUE=DATE:" startisostring
 774                                 "\nDTEND;VALUE=DATE:" endisostring
 775                                 "\nSUMMARY:" summary
 776                                 ))
 777                   (unless (string= entry-rest "")
 778                     (setq contents (concat contents "\nDESCRIPTION:"
 779                                            (icalendar--convert-string-for-export
 780                                             entry-rest))))))
 781                ;; other sexp diary entries -- FIXME
 782                ((string-match
 783                  (concat nonmarker
 784                          "%%(\\([^)]+\\))\\s-*\\(.*\\)")
 785                  entry-main)
 786                 (icalendar--dmsg "diary-sexp %s" entry-main)
 787                 (error "sexp-entries are not supported yet"))
 788                ;; weekly by day
 789                ;; Monday 8:30 Team meeting
 790                ((and (string-match
 791                       (concat nonmarker
 792                               "\\([a-z]+\\)\\s-+"
 793                               "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
 794                               "\\(-0?"
 795                               "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
 796                               "\\)?"
 797                               "\\s-*\\(.*\\)$")
 798                       entry-main)
 799                      (icalendar--get-weekday-abbrev
 800                       (substring entry-main (match-beginning 1) (match-end 1))))
 801                 (icalendar--dmsg "weekly %s" entry-main)
 802                 (let* ((day (icalendar--get-weekday-abbrev
 803                              (substring entry-main (match-beginning 1)
 804                                         (match-end 1))))
 805                        (starttimestring (icalendar--diarytime-to-isotime
 806                                          (if (match-beginning 3)
 807                                              (substring entry-main
 808                                                         (match-beginning 3)
 809                                                         (match-end 3))
 810                                            nil)
 811                                          (if (match-beginning 4)
 812                                              (substring entry-main
 813                                                         (match-beginning 4)
 814                                                         (match-end 4))
 815                                            nil)))
 816                        (endtimestring (icalendar--diarytime-to-isotime
 817                                        (if (match-beginning 6)
 818                                            (substring entry-main
 819                                                       (match-beginning 6)
 820                                                       (match-end 6))
 821                                          nil)
 822                                        (if (match-beginning 7)
 823                                            (substring entry-main
 824                                                       (match-beginning 7)
 825                                                       (match-end 7))
 826                                          nil)))
 827                        (summary (icalendar--convert-string-for-export
 828                                  (substring entry-main (match-beginning 8)
 829                                             (match-end 8)))))
 830                   (when starttimestring
 831                     (unless endtimestring
 832                       (let ((time (read (icalendar--rris "^T0?" ""
 833                                                          starttimestring))))
 834                         (setq endtimestring (format "T%06d" (+ 10000 time))))))
 835                   (setq contents
 836                         (concat "\nDTSTART;"
 837                                 (if starttimestring
 838                                     "VALUE=DATE-TIME:"
 839                                   "VALUE=DATE:")
 840                                 ;; find the correct week day,
 841                                 ;; 1st january 2000 was a saturday
 842                                 (format
 843                                  "200001%02d"
 844                                  (+ (icalendar--get-weekday-number day) 2))
 845                                 (or starttimestring "")
 846                                 "\nDTEND;"
 847                                 (if endtimestring
 848                                     "VALUE=DATE-TIME:"
 849                                   "VALUE=DATE:")
 850                                 (format
 851                                  "200001%02d"
 852                                  ;; end is non-inclusive!
 853                                  (+ (icalendar--get-weekday-number day)
 854                                     (if endtimestring 2 3)))
 855                                 (or endtimestring "")
 856                                 "\nSUMMARY:" summary
 857                                 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day
 858                                 )))
 859                 (unless (string= entry-rest "")
 860                   (setq contents (concat contents "\nDESCRIPTION:"
 861                                          (icalendar--convert-string-for-export
 862                                           entry-rest)))))
 863                ;; yearly by day
 864                ;; 1 May Tag der Arbeit
 865                ((string-match
 866                  (concat nonmarker
 867                          (if european-calendar-style
 868                              "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
 869                            "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
 870                          "\\*?\\s-*"
 871                          "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
 872                          "\\("
 873                          "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
 874                          "\\)?"
 875                          "\\s-*\\([^0-9]+.*\\)$" ; must not match years
 876                          )
 877                  entry-main)
 878                 (icalendar--dmsg "yearly %s" entry-main)
 879                 (let* ((daypos (if european-calendar-style 1 2))
 880                        (monpos (if european-calendar-style 2 1))
 881                        (day (read (substring entry-main (match-beginning daypos)
 882                                              (match-end daypos))))
 883                        (month (icalendar--get-month-number
 884                                (substring entry-main (match-beginning monpos)
 885                                           (match-end monpos))))
 886                        (starttimestring (icalendar--diarytime-to-isotime
 887                                          (if (match-beginning 4)
 888                                              (substring entry-main
 889                                                         (match-beginning 4)
 890                                                         (match-end 4))
 891                                            nil)
 892                                          (if (match-beginning 5)
 893                                              (substring entry-main
 894                                                         (match-beginning 5)
 895                                                         (match-end 5))
 896                                            nil)))
 897                        (endtimestring (icalendar--diarytime-to-isotime
 898                                        (if (match-beginning 7)
 899                                            (substring entry-main
 900                                                       (match-beginning 7)
 901                                                       (match-end 7))
 902                                          nil)
 903                                        (if (match-beginning 8)
 904                                            (substring entry-main
 905                                                       (match-beginning 8)
 906                                                       (match-end 8))
 907                                          nil)))
 908                        (summary (icalendar--convert-string-for-export
 909                                  (substring entry-main (match-beginning 9)
 910                                             (match-end 9)))))
 911                   (when starttimestring
 912                     (unless endtimestring
 913                       (let ((time (read (icalendar--rris "^T0?" ""
 914                                                          starttimestring))))
 915                         (setq endtimestring (format "T%06d" (+ 10000 time))))))
 916                   (setq contents
 917                         (concat "\nDTSTART;"
 918                                 (if starttimestring "VALUE=DATE-TIME:"
 919                                   "VALUE=DATE:")
 920                                 (format "1900%02d%02d" month day)
 921                                 (or starttimestring "")
 922                                 "\nDTEND;"
 923                                 (if endtimestring "VALUE=DATE-TIME:"
 924                                   "VALUE=DATE:")
 925                                 ;; end is not included! shift by one day
 926                                 (icalendar--date-to-isodate
 927                                  (list month day 1900) (if endtimestring 0 1))
 928                                 (or endtimestring "")
 929                                 "\nSUMMARY:"
 930                                 summary
 931                                 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
 932                                 (format "%2d" month)
 933                                 ";BYMONTHDAY="
 934                                 (format "%2d" day)
 935                                 )))
 936                 (unless (string= entry-rest "")
 937                   (setq contents (concat contents "\nDESCRIPTION:"
 938                                          (icalendar--convert-string-for-export
 939                                           entry-rest)))))
 940                ;; "ordinary" events, start and end time given
 941                ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich
 942                ((string-match
 943                  (concat nonmarker
 944                          "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+"
 945                          "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
 946                          "\\("
 947                          "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
 948                          "\\)?"
 949                          "\\s-*\\(.*\\)")
 950                  entry-main)
 951                 (icalendar--dmsg "ordinary %s" entry-main)
 952                 (let* ((startdatestring (icalendar--datestring-to-isodate
 953                                          (substring entry-main
 954                                                     (match-beginning 1)
 955                                                     (match-end 1))))
 956                        (starttimestring (icalendar--diarytime-to-isotime
 957                                          (if (match-beginning 3)
 958                                              (substring entry-main
 959                                                         (match-beginning 3)
 960                                                         (match-end 3))
 961                                            nil)
 962                                          (if (match-beginning 4)
 963                                              (substring entry-main
 964                                                         (match-beginning 4)
 965                                                         (match-end 4))
 966                                            nil)))
 967                        (endtimestring (icalendar--diarytime-to-isotime
 968                                        (if (match-beginning 6)
 969                                            (substring entry-main
 970                                                       (match-beginning 6)
 971                                                       (match-end 6))
 972                                          nil)
 973                                        (if (match-beginning 7)
 974                                            (substring entry-main
 975                                                       (match-beginning 7)
 976                                                       (match-end 7))
 977                                          nil)))
 978                        (summary (icalendar--convert-string-for-export
 979                                  (substring entry-main (match-beginning 8)
 980                                             (match-end 8)))))
 981                   (unless startdatestring
 982                     (error "Could not parse date"))
 983                   (when starttimestring
 984                     (unless endtimestring
 985                       (let ((time (read (icalendar--rris "^T0?" ""
 986                                                          starttimestring))))
 987                         (setq endtimestring (format "T%06d" (+ 10000 time))))))
 988                   (setq contents (concat
 989                                   "\nDTSTART;"
 990                                   (if starttimestring "VALUE=DATE-TIME:"
 991                                     "VALUE=DATE:")
 992                                   startdatestring
 993                                   (or starttimestring "")
 994                                   "\nDTEND;"
 995                                   (if endtimestring "VALUE=DATE-TIME:"
 996                                     "VALUE=DATE:")
 997                                   (icalendar--datestring-to-isodate
 998                                    (substring entry-main
 999                                               (match-beginning 1)
1000                                               (match-end 1))
1001                                    (if endtimestring 0 1))
1002                                   (or endtimestring "")
1003                                   "\nSUMMARY:"
1004                                   summary))
1005                   ;; could not parse the date
1006                   (unless (string= entry-rest "")
1007                     (setq contents (concat contents "\nDESCRIPTION:"
1008                                            (icalendar--convert-string-for-export
1009                                             entry-rest))))))
1010                ;; everything else
1011                (t
1012                 ;; Oops! what's that?
1013                 (error "Could not parse entry")))
1014               (setq result (concat result header contents "\nEND:VEVENT")))
1015           ;; handle errors
1016           (error
1017            (setq found-error t)
1018            (save-current-buffer
1019              (set-buffer (get-buffer-create " *icalendar-errors*"))
1020              (insert (format "Error in line %d -- %s: `%s'\n"
1021                              (count-lines (point-min) (point))
1022                              (cadr error-val)
1023                              entry-main))))))
1024
1025       ;; we're done, insert everything into the file
1026       (let ((coding-system-for-write 'utf8))
1027         (set-buffer (find-file ical-filename))
1028         (goto-char (point-max))
1029         (insert "BEGIN:VCALENDAR")
1030         (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
1031         (insert "\nVERSION:2.0")
1032         (insert result)
1033         (insert "\nEND:VCALENDAR\n")))
1034     found-error))
1035
1036 ;; ======================================================================
1037 ;; Import -- convert icalendar to emacs-diary
1038 ;; ======================================================================
1039
1040 ;; User function
1041 (defun icalendar-import-file (ical-filename diary-filename
1042                                             &optional non-marking)
1043   "Import a iCalendar file and append to a diary file.
1044 Argument ICAL-FILENAME output iCalendar file.
1045 Argument DIARY-FILENAME input `diary-file'.
1046 Optional argument NON-MARKING determines whether events are created as
1047 non-marking or not."
1048   (interactive "fImport iCalendar data from file:
1049 Finto diary file:
1050 p")
1051   ;; clean up the diary file
1052   (save-current-buffer
1053     ;; now load and convert from the ical file
1054     (set-buffer (find-file ical-filename))
1055     (icalendar-import-buffer diary-filename t non-marking)))
1056
1057 ;; User function
1058 (defun icalendar-import-buffer (&optional diary-file do-not-ask
1059                                           non-marking)
1060   "Extract iCalendar events from current buffer.
1061
1062 This function searches the current buffer for the first iCalendar
1063 object, reads it and adds all VEVENT elements to the diary
1064 DIARY-FILE.
1065
1066 It will ask for each appointment whether to add it to the diary
1067 when DO-NOT-ASK is non-nil.  When called interactively,
1068 DO-NOT-ASK is set to t, so that you are asked fore each event.
1069
1070 NON-MARKING determines whether diary events are created as
1071 non-marking.
1072
1073 This function attempts to notify about problems that occur when
1074 reading, parsing, or converting iCalendar data!"
1075   (interactive)
1076   (save-current-buffer
1077     ;; prepare ical
1078     (message "Preparing icalendar...")
1079     (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
1080     (goto-char (point-min))
1081     (message "Preparing icalendar...done")
1082     (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
1083         (let (ical-contents ical-errors)
1084           ;; read ical
1085           (message "Reading icalendar...")
1086           (beginning-of-line)
1087           (setq ical-contents (icalendar--read-element nil nil))
1088           (message "Reading icalendar...done")
1089           ;; convert ical
1090           (message "Converting icalendar...")
1091           (setq ical-errors (icalendar--convert-ical-to-diary
1092                              ical-contents
1093                              diary-file do-not-ask non-marking))
1094           (when diary-file
1095             ;; save the diary file
1096             (save-current-buffer
1097               (set-buffer (find-buffer-visiting diary-file))
1098               (save-buffer)))
1099           (message "Converting icalendar...done")
1100           (if (and ical-errors (y-or-n-p
1101                                 (concat "Something went wrong -- "
1102                                         "do you want to see the "
1103                                         "error log? ")))
1104               (switch-to-buffer " *icalendar-errors*")))
1105       (message
1106        "Current buffer does not contain icalendar contents!"))))
1107
1108 (defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1109 (make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1110
1111 ;; ======================================================================
1112 ;; private area
1113 ;; ======================================================================
1114
1115 (defun icalendar--format-ical-event (event)
1116   "Create a string representation of an iCalendar EVENT."
1117   (let ((string icalendar-import-format)
1118         (conversion-list
1119          '(("%d" DESCRIPTION icalendar-import-format-description)
1120            ("%s" SUMMARY     icalendar-import-format-subject)
1121            ("%l" LOCATION    icalendar-import-format-location)
1122            ("%o" ORGANIZER   icalendar-import-format-organizer))))
1123     ;; convert the specifiers in the format string
1124     (mapcar (lambda (i)
1125               (let* ((spec (car i))
1126                      (prop (cadr i))
1127                      (format (car (cddr i)))
1128                      (contents (icalendar--get-event-property event prop))
1129                      (formatted-contents ""))
1130                 (when (and contents (> (length contents) 0))
1131                   (setq formatted-contents
1132                         (icalendar--rris "%s"
1133                                          (icalendar--convert-string-for-import
1134                                           contents)
1135                                          (symbol-value format))))
1136                 (setq string (icalendar--rris spec
1137                                               formatted-contents
1138                                               string))))
1139             conversion-list)
1140     string))
1141
1142 (defun icalendar--convert-ical-to-diary (ical-list diary-file
1143                                                    &optional do-not-ask
1144                                                    non-marking)
1145   "Convert an iCalendar file to an Emacs diary file.
1146 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1147 DIARY-FILE.  If DO-NOT-ASK is nil the user is asked for each event
1148 whether to actually import it.  NON-MARKING determines whether diary
1149 events are created as non-marking.
1150 This function attempts to return t if something goes wrong.  In this
1151 case an error string which describes all the errors and problems is
1152 written into the buffer ` *icalendar-errors*'."
1153   (let* ((ev (icalendar--all-events ical-list))
1154          (error-string "")
1155          (event-ok t)
1156          (found-error nil)
1157          e diary-string)
1158     ;; step through all events/appointments
1159     (while ev
1160       (setq e (car ev))
1161       (setq ev (cdr ev))
1162       (setq event-ok nil)
1163       (condition-case error-val
1164           (let* ((dtstart (icalendar--decode-isodatetime
1165                            (icalendar--get-event-property e 'DTSTART)))
1166                  (start-d (calendar-date-string
1167                            (icalendar--datetime-to-noneuropean-date
1168                             dtstart)
1169                            t t))
1170                  (start-t (icalendar--datetime-to-colontime dtstart))
1171                  (dtend (icalendar--decode-isodatetime
1172                          (icalendar--get-event-property e 'DTEND)))
1173                  end-d
1174                  end-t
1175                  (subject (icalendar--convert-string-for-import
1176                            (or (icalendar--get-event-property e 'SUMMARY)
1177                                "No Subject")))
1178                  (rrule (icalendar--get-event-property e 'RRULE))
1179                  (rdate (icalendar--get-event-property e 'RDATE))
1180                  (duration (icalendar--get-event-property e 'DURATION)))
1181             (icalendar--dmsg "%s: %s" start-d subject)
1182             (when duration
1183               (let ((dtend2 (icalendar--add-decoded-times
1184                              dtstart
1185                              (icalendar--decode-isoduration duration))))
1186                 (if (and dtend (not (eq dtend dtend2)))
1187                     (message "Inconsistent endtime and duration for %s"
1188                              subject))
1189                 (setq dtend dtend2)))
1190             (setq end-d (if dtend
1191                             (calendar-date-string
1192                              (icalendar--datetime-to-noneuropean-date
1193                               dtend)
1194                              t t)
1195                           start-d))
1196             (setq end-t (if dtend
1197                             (icalendar--datetime-to-colontime dtend)
1198                           start-t))
1199             (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
1200             (cond
1201              ;; recurring event
1202              (rrule
1203               (icalendar--dmsg "recurring event")
1204               (let* ((rrule-props (icalendar--split-value rrule))
1205                      (frequency (car (cdr (assoc 'FREQ rrule-props))))
1206                      (until (car (cdr (assoc 'UNTIL rrule-props))))
1207                      (interval  (read (car (cdr (assoc 'INTERVAL
1208                                                        rrule-props))))))
1209                 (cond ((string-equal frequency "WEEKLY")
1210                        (if (not start-t)
1211                            (progn
1212                              ;; weekly and all-day
1213                              (icalendar--dmsg "weekly all-day")
1214                              (setq diary-string
1215                                    (format
1216                                     "%%%%(diary-cyclic %d %s)"
1217                                     (* interval 7)
1218                                     (icalendar--datetime-to-european-date
1219                                      dtstart))))
1220                          ;; weekly and not all-day
1221                          (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
1222                                 (weekday
1223                                  (icalendar--get-weekday-number byday)))
1224                            (icalendar--dmsg "weekly not-all-day")
1225                            (if (> weekday -1)
1226                                (setq diary-string
1227                                      (format "%s %s%s%s"
1228                                              (aref calendar-day-name-array
1229                                                    weekday)
1230                                              start-t (if end-t "-" "")
1231                                              (or end-t "")))
1232                              ;; FIXME!!!!
1233                              ;; DTSTART;VALUE=DATE-TIME:20030919T090000
1234                              ;; DTEND;VALUE=DATE-TIME:20030919T113000
1235                              (setq diary-string
1236                                    (format
1237                                     "%%%%(diary-cyclic %s %s) %s%s%s"
1238                                     (* interval 7)
1239                                     (icalendar--datetime-to-european-date
1240                                      dtstart)
1241                                     start-t (if end-t "-" "") (or end-t ""))))
1242                            (setq event-ok t))))
1243                       ;; yearly
1244                       ((string-equal frequency "YEARLY")
1245                        (icalendar--dmsg "yearly")
1246                        (setq diary-string
1247                              (format
1248                               "%%%%(diary-anniversary %s)"
1249                               (icalendar--datetime-to-european-date dtstart)))
1250                        (setq event-ok t))
1251                       ;; FIXME: war auskommentiert:
1252                       ((and (string-equal frequency "DAILY")
1253                             ;;(not (string= start-d end-d))
1254                             ;;(not start-t)
1255                             ;;(not end-t)
1256                             )
1257                        (let ((ds (icalendar--datetime-to-noneuropean-date
1258                                   (icalendar--decode-isodatetime
1259                                    (icalendar--get-event-property e
1260                                                                   'DTSTART))))
1261                              (de (icalendar--datetime-to-noneuropean-date
1262                                   (icalendar--decode-isodatetime
1263                                    until))))
1264                          (setq diary-string
1265                                (format
1266                                 "%%%%(diary-block %d %d %d  %d %d %d)"
1267                                 (nth 1 ds) (nth 0 ds) (nth 2 ds)
1268                                 (nth 1 de) (nth 0 de) (nth 2 de))))
1269                        (setq event-ok t)))
1270                 ))
1271              (rdate
1272               (icalendar--dmsg "rdate event")
1273               (setq diary-string "")
1274               (mapcar (lambda (datestring)
1275                         (setq diary-string
1276                               (concat diary-string
1277                                       (format "......"))))
1278                       (icalendar--split-value rdate)))
1279              ;; non-recurring event
1280              ;; long event
1281              ((not (string= start-d end-d))
1282               (icalendar--dmsg "non-recurring event")
1283               (let ((ds (icalendar--datetime-to-noneuropean-date dtstart))
1284                     (de (icalendar--datetime-to-noneuropean-date dtend)))
1285                 (setq diary-string
1286                       (format "%%%%(diary-block %d %d %d   %d %d %d)"
1287                               (nth 1 ds) (nth 0 ds) (nth 2 ds)
1288                               (nth 1 de) (nth 0 de) (nth 2 de))))
1289               (setq event-ok t))
1290              ;; not all-day
1291              ((and start-t (or (not end-t)
1292                                (not (string= start-t end-t))))
1293               (icalendar--dmsg "not all day event")
1294               (cond (end-t
1295                      (setq diary-string (format "%s %s-%s" start-d
1296                                                 start-t end-t)))
1297                     (t
1298                      (setq diary-string (format "%s %s" start-d
1299                                                 start-t))))
1300               (setq event-ok t))
1301              ;; all-day event
1302              (t
1303               (icalendar--dmsg "all day event")
1304               (setq diary-string start-d)
1305               (setq event-ok t)))
1306             ;; add all other elements unless the user doesn't want to have
1307             ;; them
1308             (if event-ok
1309                 (progn
1310                   (setq diary-string
1311                         (concat diary-string " "
1312                                 (icalendar--format-ical-event e)))
1313                   (if do-not-ask (setq subject nil))
1314                   (icalendar--add-diary-entry diary-string diary-file
1315                                               non-marking subject))
1316               ;; event was not ok
1317               (setq found-error t)
1318               (setq error-string
1319                     (format "%s\nCannot handle this event:%s"
1320                             error-string e))))
1321         ;; handle errors
1322         (error
1323          (message "Ignoring event \"%s\"" e)
1324          (setq found-error t)
1325          (setq error-string (format "%s\nCannot handle this event: %s"
1326                                     error-string e)))))
1327     (if found-error
1328         (save-current-buffer
1329           (set-buffer (get-buffer-create " *icalendar-errors*"))
1330           (erase-buffer)
1331           (insert error-string)))
1332     (message "Converting icalendar...done")
1333     found-error))
1334
1335 (defun icalendar--add-diary-entry (string diary-file non-marking
1336                                           &optional subject)
1337   "Add STRING to the diary file DIARY-FILE.
1338 STRING must be a properly formatted valid diary entry.  NON-MARKING
1339 determines whether diary events are created as non-marking.  If
1340 SUBJECT is not nil it must be a string that gives the subject of the
1341 entry.  In this case the user will be asked whether he wants to insert
1342 the entry."
1343   (when (or (not subject)               ;
1344             (y-or-n-p (format "Add appointment for `%s' to diary? "
1345                               subject)))
1346     (when subject
1347       (setq non-marking
1348             (y-or-n-p (format "Make appointment non-marking? "))))
1349     (save-window-excursion
1350       (unless diary-file
1351         (setq diary-file
1352               (read-file-name "Add appointment to this diary file: ")))
1353       (make-diary-entry string non-marking diary-file))))
1354
1355 (provide 'icalendar)
1356
1357 ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
1358 ;;; icalendar.el ends here