lisp/calendar/icalendar.el

   1 ;;; icalendar.el --- iCalendar implementation
   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.06  Bugfixes regarding icalendar-import-format-*.
  35 ;;        Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau.
  36
  37 ;;  0.05: New import format scheme: Replaced icalendar-import-prefix-*,
  38 ;;        icalendar-import-ignored-properties, and
  39 ;;        icalendar-import-separator with icalendar-import-format(-*).
  40 ;;        icalendar-import-file and icalendar-convert-diary-to-ical
  41 ;;        have an extra parameter which should prevent them from
  42 ;;        erasing their target files (untested!).
  43 ;;        Tested with Emacs 21.3.2
  44
  45 ;;  0.04: Bugfix: import: double quoted param values did not work
  46 ;;        Read DURATION property when importing.
  47 ;;        Added parameter icalendar-duration-correction.
  48
  49 ;;  0.03: Export takes care of european-calendar-style.
  50 ;;        Tested with Emacs 21.3.2 and XEmacs 21.4.12
  51
  52 ;;  0.02: Should work in XEmacs now.  Thanks to Len Trigg for the
  53 ;;        XEmacs patches!
  54 ;;        Added exporting from Emacs diary to ical.
  55 ;;        Some bugfixes, after testing with calendars from
  56 ;;        http://icalshare.com.
  57 ;;        Tested with Emacs 21.3.2 and XEmacs 21.4.12
  58
  59 ;;  0.01: First published version.  Trial version.  Alpha version.
  60
  61 ;; ======================================================================
  62 ;; To Do:
  63
  64 ;;  * Import from ical:
  65 ;;    + Need more properties for icalendar-import-format
  66 ;;    + check vcalendar version
  67 ;;    + check (unknown) elements
  68 ;;    + recurring events!
  69 ;;    + works for european style calendars only! Does it?
  70 ;;    + alarm
  71 ;;    + exceptions in recurring events
  72 ;;    + the parser is too soft
  73 ;;    + error log is incomplete
  74 ;;    + nice to have: #include "webcal://foo.com/some-calendar.ics"
  75
  76 ;;  * Export into ical
  77 ;;    + diary-date, diary-float, and self-made sexp entries are not
  78 ;;      understood
  79 ;;    + timezones, currently all times are local!
  80
  81 ;;  * Other things
  82 ;;    + defcustom icalendar-import-ignored-properties does not work with
  83 ;;      XEmacs.
  84 ;;    + clean up all those date/time parsing functions
  85 ;;    + Handle todo items?
  86 ;;    + Check iso 8601 for datetime and period
  87 ;;    + Which chars to (un)escape?
  88 ;;    + Time to find out how the profiler works?
  89
  90
  91 ;;; Code:
  92
  93 (defconst icalendar-version 0.06
  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-weekdayabbrev-table
 164   '(("mon\\(day\\)?"    . "MO")
 165     ("tue\\(sday\\)?"   . "TU")
 166     ("wed\\(nesday\\)?" . "WE")
 167     ("thu\\(rsday\\)?"  . "TH")
 168     ("fri\\(day\\)?"    . "FR")
 169     ("sat\\(urday\\)?"  . "SA")
 170     ("sun\\(day\\)?"    . "SU"))
 171   "Translation table for weekdays.")
 172
 173 (defconst icalendar-monthnumber-table
 174   '(("^jan\\(uar\\)?y?$"       . 1)
 175     ("^feb\\(ruar\\)?y?$"      . 2)
 176     ("^mar\\(ch\\)?\\|märz?$" . 3)
 177     ("^apr\\(il\\)?$"          . 4)
 178     ("^ma[iy]$"                . 5)
 179     ("^jun[ie]?$"              . 6)
 180     ("^jul[iy]?$"              . 7)
 181     ("^aug\\(ust\\)?$"         . 8)
 182     ("^sep\\(tember\\)?$"      . 9)
 183     ("^o[ck]t\\(ober\\)?$"     . 10)
 184     ("^nov\\(ember\\)?$"       . 11)
 185     ("^de[cz]\\(ember\\)?$"    . 12))
 186   "Regular expressions for month names.
 187 Currently this matches only German and English.")
 188
 189 (defvar icalendar-debug nil ".")
 190
 191 ;; ======================================================================
 192 ;; all the other libs we need
 193 ;; ======================================================================
 194 (require 'calendar)
 195 (require 'appt)
 196
 197 ;; ======================================================================
 198 ;; Core functionality
 199 ;; Functions for parsing icalendars, importing and so on
 200 ;; ======================================================================
 201
 202 (defun icalendar-get-unfolded-buffer (folded-ical-buffer)
 203   "Return a new buffer containing the unfolded contents of a buffer.
 204 Folding is the iCalendar way of wrapping long lines.  In the
 205 created buffer all occurrences of CR LF BLANK are replaced by the
 206 empty string.  Argument FOLDED-ICAL-BUFFER is the unfolded input
 207 buffer."
 208   (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
 209     (save-current-buffer
 210       (set-buffer unfolded-buffer)
 211       (erase-buffer)
 212       (insert-buffer folded-ical-buffer)
 213       (while (re-search-forward "\r?\n[ \t]" nil t)
 214         (replace-match "" nil nil))
 215       )
 216     unfolded-buffer))
 217
 218 ;; Replace regexp RE with RP in string ST and return the new string.
 219 ;; This is here for compatibility with XEmacs.
 220 (defsubst icalendar-rris (re rp st)
 221   ;; XEmacs:
 222   (if (fboundp 'replace-in-string)
 223       (save-match-data ;; apparently XEmacs needs save-match-data
 224         (replace-in-string st re rp))
 225     ;; Emacs:
 226     (replace-regexp-in-string re rp st)))
 227
 228 (defun icalendar-read-element (invalue inparams)
 229   "Recursively read the next iCalendar element in the current buffer.
 230 INVALUE gives the current iCalendar element we are reading.
 231 INPARAMS gives the current parameters.....
 232 This function calls itself recursively for each nested calendar element
 233 it finds"
 234   (let (element children line name params param param-name param-value
 235                 value
 236         (continue t))
 237     (setq children '())
 238     (while (and continue
 239                 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
 240       (setq name (intern (match-string 1)))
 241       (backward-char 1)
 242       (setq params '())
 243       (setq line '())
 244       (while (looking-at ";")
 245         (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
 246         (setq param-name (intern (match-string 1)))
 247         (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
 248                            nil t)
 249         (backward-char 1)
 250         (setq param-value (or (match-string 2) (match-string 3)))
 251         (setq param (list param-name param-value))
 252         (while (looking-at ",")
 253           (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
 254                              nil t)
 255           (if (match-string 2)
 256               (setq param-value (match-string 2))
 257             (setq param-value (match-string 3)))
 258           (setq param (append param param-value)))
 259         (setq params (append params param)))
 260       (unless (looking-at ":")
 261         (error "Oops"))
 262       (forward-char 1)
 263       (re-search-forward  "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t)
 264       (setq value (icalendar-rris "\r?\n[ \t]" "" (match-string 0)))
 265       (setq line (list name params value))
 266       (cond ((eq name 'BEGIN)
 267              (setq children
 268                    (append children
 269                            (list (icalendar-read-element (intern value)
 270                                                          params)))))
 271             ((eq name 'END)
 272              (setq continue nil))
 273             (t
 274              (setq element (append element (list line))))))
 275     (if invalue
 276         (list invalue inparams element children)
 277       children)))
 278
 279 ;; ======================================================================
 280 ;; helper functions for examining events
 281 ;; ======================================================================
 282
 283 (defsubst icalendar-get-all-event-properties (event)
 284   "Return the list of properties in this EVENT."
 285   (car (cddr event)))
 286
 287 (defun icalendar-get-event-property (event prop)
 288   "For the given EVENT return the value of the property PROP."
 289   (catch 'found
 290     (let ((props (car (cddr event))) pp)
 291       (while props
 292         (setq pp (car props))
 293         (if (eq (car pp) prop)
 294             (throw 'found (car (cddr pp))))
 295         (setq props (cdr props))))
 296     nil))
 297
 298 (defun icalendar-set-event-property (event prop new-value)
 299   "For the given EVENT set the property PROP to the value NEW-VALUE."
 300   (catch 'found
 301     (let ((props (car (cddr event))) pp)
 302       (while props
 303         (setq pp (car props))
 304         (when (eq (car pp) prop)
 305           (setcdr (cdr pp) new-value)
 306           (throw 'found (car (cddr pp))))
 307         (setq props (cdr props)))
 308       (setq props (car (cddr event)))
 309       (setcar (cddr event)
 310               (append props (list (list prop nil new-value)))))))
 311
 312 (defun icalendar-get-children (node name)
 313   "Return all children of the given NODE which have a name NAME.
 314 For instance the VCALENDAR node can have VEVENT children as well as VTODO
 315 children."
 316   (let ((result nil)
 317         (children (cadr (cddr node))))
 318     (when (eq (car node) name)
 319       (setq result node))
 320     ;;(message "%s" node)
 321     (when children
 322       (let ((subresult
 323              (delq nil
 324                    (mapcar (lambda (n)
 325                              (icalendar-get-children n name))
 326                            children))))
 327         (if subresult
 328             (if result
 329                 (setq result (append result subresult))
 330               (setq result subresult)))))
 331     result))
 332
 333 ; private
 334 (defun icalendar-all-events (icalendar)
 335   "Return the list of all existing events in the given ICALENDAR."
 336   (interactive "")
 337   (icalendar-get-children (car icalendar) 'VEVENT))
 338
 339 (defun icalendar-split-value (value-string)
 340   "Splits VALUE-STRING at ';='."
 341   (let ((result '())
 342         param-name param-value)
 343     (when value-string
 344       (save-current-buffer
 345         (set-buffer (get-buffer-create " *ical-temp*"))
 346         (set-buffer-modified-p nil)
 347         (erase-buffer)
 348         (insert value-string)
 349         (goto-char (point-min))
 350         (while
 351             (re-search-forward
 352              "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
 353              nil t)
 354           (setq param-name (intern (match-string 1)))
 355           (setq param-value (match-string 2))
 356           (setq result
 357                 (append result (list (list param-name param-value)))))))
 358     result))
 359
 360 (defun icalendar-decode-isodatetime (isodatetimestring)
 361   "Return ISODATETIMESTRING in format like `decode-time'.
 362 Converts from ISO-8601 to Emacs representation.  If ISODATETIMESTRING
 363 specifies UTC time (trailing letter Z) the decoded time is given in
 364 the local time zone! FIXME: TZID-attributes are ignored....! FIXME:
 365 multiple comma-separated values should be allowed!"
 366   (icalendar-dmsg isodatetimestring)
 367   (if isodatetimestring
 368       ;; day/month/year must be present
 369       (let ((year  (read (substring isodatetimestring 0 4)))
 370             (month (read (substring isodatetimestring 4 6)))
 371             (day   (read (substring isodatetimestring 6 8)))
 372             (hour 0)
 373             (minute 0)
 374             (second 0))
 375         (when (> (length isodatetimestring) 12)
 376           ;; hour/minute present
 377           (setq hour (read (substring isodatetimestring 9 11)))
 378           (setq minute (read (substring isodatetimestring 11 13))))
 379         (when (> (length isodatetimestring) 14)
 380           ;; seconds present
 381           (setq second (read (substring isodatetimestring 13 15))))
 382         (when (and (> (length isodatetimestring) 15)
 383                    ;; UTC specifier present
 384                    (char-equal ?Z (aref isodatetimestring 15)))
 385           ;; if not UTC add current-time-zone offset
 386           (setq second (+ (car (current-time-zone)) second)))
 387         ;; create the decoded date-time
 388         ;; FIXME!?!
 389         (condition-case nil
 390             (decode-time (encode-time second minute hour day month year))
 391           (error
 392            (message "Cannot decode \"%s\"" isodatetimestring)
 393            ;; hope for the best...
 394            (list second minute hour day month year 0 nil 0))))
 395     ;; isodatetimestring == nil
 396     nil))
 397
 398 (defun icalendar-decode-isoduration (isodurationstring)
 399   "Return ISODURATIONSTRING in format like `decode-time'.
 400 Converts from ISO-8601 to Emacs representation.  If ISODURATIONSTRING
 401 specifies UTC time (trailing letter Z) the decoded time is given in
 402 the local time zone! FIXME: TZID-attributes are ignored....! FIXME:
 403 multiple comma-separated values should be allowed!"
 404   (if isodurationstring
 405       (save-match-data
 406         (string-match
 407          (concat
 408           "^P[+-]?\\("
 409           "\\(\\([0-9]+\\)D\\)"         ; days only
 410           "\\|"
 411           "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
 412           "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
 413           "\\|"
 414           "\\(\\([0-9]+\\)W\\)"         ; weeks only
 415           "\\)$") isodurationstring)
 416         (let ((seconds 0)
 417               (minutes 0)
 418               (hours 0)
 419               (days 0)
 420               (months 0)
 421               (years 0))
 422         (cond
 423          ((match-beginning 2)           ;days only
 424           (setq days (read (substring isodurationstring
 425                                       (match-beginning 3)
 426                                       (match-end 3))))
 427           (when icalendar-duration-correction
 428             (setq days (1- days))))
 429          ((match-beginning 4)           ;days and time
 430           (if (match-beginning 5)
 431               (setq days (* 7 (read (substring isodurationstring
 432                                                (match-beginning 6)
 433                                                (match-end 6))))))
 434           (if (match-beginning 7)
 435               (setq hours (read (substring isodurationstring
 436                                            (match-beginning 8)
 437                                            (match-end 8)))))
 438           (if (match-beginning 9)
 439               (setq minutes (read (substring isodurationstring
 440                                              (match-beginning 10)
 441                                              (match-end 10)))))
 442           (if (match-beginning 11)
 443               (setq seconds (read (substring isodurationstring
 444                                              (match-beginning 12)
 445                                              (match-end 12)))))
 446           )
 447          ((match-beginning 13)          ;weeks only
 448           (setq days (* 7 (read (substring isodurationstring
 449                                            (match-beginning 14)
 450                                            (match-end 14))))))
 451          )
 452         (list seconds minutes hours days months years)))
 453     ;; isodatetimestring == nil
 454     nil))
 455
 456 (defun icalendar-add-decoded-times (time1 time2)
 457   "Add TIME1 to TIME2.
 458 Both times must be given in decoded form.  One of these times must be
 459 valid (year > 1900 or something)."
 460   ;; FIXME: does this function exist already?
 461   (decode-time (encode-time
 462                 (+ (nth 0 time1) (nth 0 time2))
 463                 (+ (nth 1 time1) (nth 1 time2))
 464                 (+ (nth 2 time1) (nth 2 time2))
 465                 (+ (nth 3 time1) (nth 3 time2))
 466                 (+ (nth 4 time1) (nth 4 time2))
 467                 (+ (nth 5 time1) (nth 5 time2))
 468                 nil
 469                 nil
 470                 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
 471                 )))
 472
 473 (defun icalendar-datetime-to-noneuropean-date (datetime)
 474   "Convert the decoded DATETIME to non-european-style format.
 475 Non-European format: (month day year)."
 476   (if datetime
 477       (list (nth 4 datetime) ;month
 478             (nth 3 datetime) ;day
 479             (nth 5 datetime));year
 480     ;; datetime == nil
 481     nil))
 482
 483 (defun icalendar-datetime-to-european-date (datetime)
 484   "Convert the decoded DATETIME to European format.
 485 European format: (day month year).
 486 FIXME"
 487   (if datetime
 488       (format "%d %d %d" (nth 3 datetime); day
 489               (nth 4 datetime) ;month
 490               (nth 5 datetime));year
 491     ;; datetime == nil
 492     nil))
 493
 494 (defun icalendar-datetime-to-colontime (datetime)
 495   "Extract the time part of a decoded DATETIME into 24-hour format.
 496 Note that this silently ignores seconds."
 497   (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
 498
 499 (defun icalendar-get-month-number (monthname)
 500   "Return the month number for the given MONTHNAME."
 501   (save-match-data
 502     (let ((case-fold-search t))
 503       (assoc-default monthname icalendar-monthnumber-table
 504                      'string-match))))
 505
 506 (defun icalendar-get-weekday-abbrev (weekday)
 507   "Return the abbreviated WEEKDAY."
 508   ;;FIXME: ISO-like(?).
 509   (save-match-data
 510     (let ((case-fold-search t))
 511       (assoc-default weekday icalendar-weekdayabbrev-table
 512                      'string-match))))
 513
 514 (defun icalendar-datestring-to-isodate (datestring &optional day-shift)
 515   "Convert diary-style DATESTRING to iso-style date.
 516 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
 517 -- DAY-SHIFT must be either nil or an integer.  This function
 518 takes care of european-style."
 519   (let ((day -1) month year)
 520     (save-match-data
 521       (cond (;; numeric date
 522              (string-match (concat "\\s-*"
 523                                    "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
 524                                    "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
 525                                    "\\([0-9]\\{4\\}\\)")
 526                            datestring)
 527              (setq day (read (substring datestring (match-beginning 1)
 528                                         (match-end 1))))
 529              (setq month (read (substring datestring (match-beginning 2)
 530                                           (match-end 2))))
 531              (setq year (read (substring datestring (match-beginning 3)
 532                                          (match-end 3))))
 533              (unless european-calendar-style
 534                (let ((x month))
 535                  (setq month day)
 536                  (setq day x))))
 537             (;; date contains month names -- european-style
 538              (and european-calendar-style
 539                   (string-match (concat "\\s-*"
 540                                         "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
 541                                         "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 542                                         "\\([0-9]\\{4\\}\\)")
 543                                 datestring))
 544                  (setq day (read (substring datestring (match-beginning 1)
 545                                             (match-end 1))))
 546                  (setq month (icalendar-get-month-number
 547                               (substring datestring (match-beginning 2)
 548                                          (match-end 2))))
 549                  (setq year (read (substring datestring (match-beginning 3)
 550                                              (match-end 3)))))
 551             (;; date contains month names -- non-european-style
 552              (and (not european-calendar-style)
 553                   (string-match (concat "\\s-*"
 554                                         "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
 555                                         "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
 556                                         "\\([0-9]\\{4\\}\\)")
 557                                 datestring))
 558              (setq day (read (substring datestring (match-beginning 2)
 559                                         (match-end 2))))
 560              (setq month (icalendar-get-month-number
 561                           (substring datestring (match-beginning 1)
 562                                      (match-end 1))))
 563              (setq year (read (substring datestring (match-beginning 3)
 564                                          (match-end 3)))))
 565             (t
 566              nil)))
 567     (if (> day 0)
 568         (let ((mdy (calendar-gregorian-from-absolute
 569                     (+ (calendar-absolute-from-gregorian (list month day year))
 570                        (or day-shift 0)))))
 571           (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
 572       nil)))
 573
 574 (defun icalendar-dmsg (&rest args)
 575   "Print message ARGS if `icalendar-debug' is non-nil."
 576   (if icalendar-debug
 577       (apply 'message args)))
 578
 579 (defun icalendar-diarytime-to-isotime (timestring ampmstring)
 580   "Convert a a time like 9:30pm to an iso-conform string like T213000.
 581 In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
 582 would be \"pm\"."
 583   (if timestring
 584       (let ((starttimenum (read (icalendar-rris ":" "" timestring))))
 585         ;; take care of am/pm style
 586         (if (and ampmstring (string= "pm" ampmstring))
 587             (setq starttimenum (+ starttimenum 1200)))
 588         (format "T%04d00" starttimenum))
 589     nil))
 590
 591 (defun icalendar-convert-string-for-export (s)
 592   "Escape comma and other critical characters in string S."
 593   (icalendar-rris "," "\\\\," s))
 594
 595 (defun icalendar-convert-for-import (string)
 596   "Remove escape chars for comma, semicolon etc. from STRING."
 597   (icalendar-rris
 598    "\\\\n" "\n " (icalendar-rris
 599                "\\\\\"" "\"" (icalendar-rris
 600                               "\\\\;" ";" (icalendar-rris
 601                                            "\\\\," "," string)))))
 602
 603 ;; ======================================================================
 604 ;; export -- convert emacs-diary to icalendar
 605 ;; ======================================================================
 606
 607 (defun icalendar-convert-diary-to-ical (diary-filename ical-filename
 608                                         &optional do-not-clear-diary-file)
 609   "Export diary file to iCalendar format -- erases ical-filename!!!.
 610 Argument DIARY-FILENAME is the input `diary-file'.
 611 Argument ICAL-FILENAME is the output iCalendar file.
 612 If DO-NOT-CLEAR-DIARY-FILE is not nil the target iCalendar file
 613 is not erased."
 614   (interactive "FExport diary data from file:
 615 Finto iCalendar file: ")
 616   (let ((result "")
 617         (start 0)
 618         (entry-main "")
 619         (entry-rest "")
 620         (header "")
 621         (contents)
 622         (oops nil)
 623         (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
 624                            "?")))
 625     (save-current-buffer
 626       (set-buffer (find-file diary-filename))
 627       (goto-char (point-min))
 628       (while (re-search-forward
 629               "^\\([^ \t\n].*\\)\\(\n[ \t].*\\)*" nil t)
 630         (setq entry-main (match-string 1))
 631         (if (match-beginning 2)
 632             (setq entry-rest (match-string 2))
 633           (setq entry-rest ""))
 634         (setq header (format "\nBEGIN:VEVENT\nUID:emacs%d%d%d"
 635                              (car (current-time))
 636                              (cadr (current-time))
 637                              (car (cddr (current-time)))))
 638         (setq oops nil)
 639         (cond
 640          ;; anniversaries
 641          ((string-match
 642            (concat nonmarker
 643                    "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)")
 644            entry-main)
 645           (icalendar-dmsg "diary-anniversary %s" entry-main)
 646           (let* ((datetime (substring entry-main (match-beginning 1)
 647                                       (match-end 1)))
 648                  (summary (icalendar-convert-string-for-export
 649                            (substring entry-main (match-beginning 2)
 650                                       (match-end 2))))
 651                  (startisostring (icalendar-datestring-to-isodate
 652                                   datetime))
 653                  (endisostring (icalendar-datestring-to-isodate
 654                                 datetime 1)))
 655             (setq contents
 656                   (concat "\nDTSTART;VALUE=DATE:" startisostring
 657                           "\nDTEND;VALUE=DATE:" endisostring
 658                           "\nSUMMARY:" summary
 659                           "\nRRULE:FREQ=YEARLY;INTERVAL=1"
 660                           ;; the following is redundant,
 661                           ;; but korganizer seems to expect this... ;(
 662                           ;; and evolution doesn't understand it... :(
 663                           ;; so... who is wrong?!
 664                           ";BYMONTH=" (substring startisostring 4 6)
 665                           ";BYMONTHDAY=" (substring startisostring 6 8)
 666                           )))
 667           (unless (string= entry-rest "")
 668             (setq contents (concat contents "\nDESCRIPTION:"
 669                                    (icalendar-convert-string-for-export
 670                                     entry-rest)))))
 671          ;; cyclic events
 672          ;; %%(diary-cyclic )
 673          ((string-match
 674            (concat nonmarker
 675                    "%%(diary-cyclic \\([^ ]+\\) +"
 676                    "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
 677            entry-main)
 678           (icalendar-dmsg "diary-cyclic %s" entry-main)
 679           (let* ((frequency (substring entry-main (match-beginning 1)
 680                                        (match-end 1)))
 681                  (datetime (substring entry-main (match-beginning 2)
 682                                       (match-end 2)))
 683                  (summary (icalendar-convert-string-for-export
 684                            (substring entry-main (match-beginning 3)
 685                                       (match-end 3))))
 686                  (startisostring (icalendar-datestring-to-isodate
 687                                   datetime))
 688                  (endisostring (icalendar-datestring-to-isodate
 689                                 datetime 1)))
 690             (setq contents
 691                   (concat "\nDTSTART;VALUE=DATE:" startisostring
 692                           "\nDTEND;VALUE=DATE:" endisostring
 693                           "\nSUMMARY:" summary
 694                           "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
 695                           ;; strange: korganizer does not expect
 696                           ;; BYSOMETHING here...
 697                           )))
 698           (unless (string= entry-rest "")
 699             (setq contents (concat contents "\nDESCRIPTION:"
 700                                    (icalendar-convert-string-for-export
 701                                     entry-rest)))))
 702          ;; diary-date -- FIXME
 703          ((string-match
 704            (concat nonmarker
 705                    "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)")
 706            entry-main)
 707           (icalendar-dmsg "diary-date %s" entry-main)
 708           (setq oops t))
 709          ;; float events -- FIXME
 710          ((string-match
 711            (concat nonmarker
 712                    "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)")
 713            entry-main)
 714           (icalendar-dmsg "diary-float %s" entry-main)
 715           (setq oops t))
 716          ;; block events
 717          ((string-match
 718            (concat nonmarker
 719                    "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +"
 720                    "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
 721            entry-main)
 722           (icalendar-dmsg "diary-block %s" entry-main)
 723           (let* ((startstring (substring entry-main (match-beginning 1)
 724                                          (match-end 1)))
 725                  (endstring (substring entry-main (match-beginning 2)
 726                                        (match-end 2)))
 727                  (summary (icalendar-convert-string-for-export
 728                            (substring entry-main (match-beginning 3)
 729                                       (match-end 3))))
 730                  (startisostring (icalendar-datestring-to-isodate
 731                                   startstring))
 732                  (endisostring (icalendar-datestring-to-isodate
 733                                 endstring 1)))
 734             (setq contents
 735                   (concat "\nDTSTART;VALUE=DATE:" startisostring
 736                           "\nDTEND;VALUE=DATE:" endisostring
 737                           "\nSUMMARY:" summary
 738                           ))
 739             (unless (string= entry-rest "")
 740               (setq contents (concat contents "\nDESCRIPTION:"
 741                                      (icalendar-convert-string-for-export
 742                                       entry-rest))))))
 743          ;; other sexp diary entries -- FIXME
 744          ((string-match
 745            (concat nonmarker
 746                    "%%(\\([^)]+\\))\\s-*\\(.*\\)")
 747            entry-main)
 748           (icalendar-dmsg "diary-sexp %s" entry-main)
 749           (setq oops t))
 750          ;; weekly by day
 751          ;; Monday 8:30 Team meeting
 752          ((and (string-match
 753                 (concat nonmarker
 754                         "\\([a-z]+\\)\\s-+"
 755                         "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
 756                         "\\(-0?"
 757                         "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
 758                         "\\)?"
 759                         "\\s-*\\(.*\\)$")
 760                 entry-main)
 761                (icalendar-get-weekday-abbrev
 762                 (substring entry-main (match-beginning 1) (match-end 1))))
 763           (icalendar-dmsg "weekly %s" entry-main)
 764           (let* ((day (icalendar-get-weekday-abbrev
 765                        (substring entry-main (match-beginning 1)
 766                                   (match-end 1))))
 767                  (starttimestring (icalendar-diarytime-to-isotime
 768                                    (if (match-beginning 3)
 769                                        (substring entry-main
 770                                                   (match-beginning 3)
 771                                                   (match-end 3))
 772                                      nil)
 773                                    (if (match-beginning 4)
 774                                        (substring entry-main
 775                                                   (match-beginning 4)
 776                                                   (match-end 4))
 777                                      nil)))
 778                  (endtimestring (icalendar-diarytime-to-isotime
 779                                  (if (match-beginning 6)
 780                                      (substring entry-main
 781                                                 (match-beginning 6)
 782                                                 (match-end 6))
 783                                    nil)
 784                                  (if (match-beginning 7)
 785                                      (substring entry-main
 786                                                 (match-beginning 7)
 787                                                 (match-end 7))
 788                                    nil)))
 789                  (summary (icalendar-convert-string-for-export
 790                            (substring entry-main (match-beginning 8)
 791                                       (match-end 8)))))
 792             (when starttimestring
 793               (unless endtimestring
 794                 (let ((time (read (icalendar-rris "^T0?" ""
 795                                                   starttimestring))))
 796                   (setq endtimestring (format "T%06d" (+ 10000 time))))))
 797             (setq contents
 798                   (concat "\nDTSTART"
 799                           (if starttimestring "" ";VALUE=DATE")
 800                           ":19000101" ;; FIXME? Probability that this
 801                           ;; is the right day is 1/7
 802                           (or starttimestring "")
 803                           "\nDTEND"
 804                           (if endtimestring "" ";VALUE=DATE")
 805                           ":19000101" ;; FIXME?
 806                           (or endtimestring "")
 807                           "\nSUMMARY:" summary
 808                           "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day
 809                           )))
 810           (unless (string= entry-rest "")
 811             (setq contents (concat contents "\nDESCRIPTION:"
 812                                    (icalendar-convert-string-for-export
 813                                     entry-rest)))))
 814          ;; yearly by day
 815          ;; 1 May Tag der Arbeit
 816          ((string-match
 817            (concat nonmarker
 818                    (if european-calendar-style
 819                        "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
 820                      "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
 821                    "\\*?\\s-*"
 822                    "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
 823                    "\\("
 824                    "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
 825                    "\\)?"
 826                    "\\s-*\\([^0-9]+.*\\)$"; must not match years
 827                    )
 828            entry-main)
 829           (icalendar-dmsg "yearly %s" entry-main)
 830           (let* ((daypos (if european-calendar-style 1 2))
 831                  (monpos (if european-calendar-style 2 1))
 832                  (day (read (substring entry-main (match-beginning daypos)
 833                                        (match-end daypos))))
 834                  (month (icalendar-get-month-number
 835                          (substring entry-main (match-beginning monpos)
 836                                     (match-end monpos))))
 837                  (starttimestring (icalendar-diarytime-to-isotime
 838                                    (if (match-beginning 4)
 839                                        (substring entry-main
 840                                                   (match-beginning 4)
 841                                                   (match-end 4))
 842                                      nil)
 843                                    (if (match-beginning 5)
 844                                        (substring entry-main
 845                                                   (match-beginning 5)
 846                                                   (match-end 5))
 847                                      nil)))
 848                  (endtimestring (icalendar-diarytime-to-isotime
 849                                  (if (match-beginning 7)
 850                                      (substring entry-main
 851                                                 (match-beginning 7)
 852                                                 (match-end 7))
 853                                    nil)
 854                                  (if (match-beginning 8)
 855                                      (substring entry-main
 856                                                 (match-beginning 8)
 857                                                 (match-end 8))
 858                                    nil)))
 859                  (summary (icalendar-convert-string-for-export
 860                            (substring entry-main (match-beginning 9)
 861                                       (match-end 9)))))
 862             (when starttimestring
 863               (unless endtimestring
 864                 (let ((time (read (icalendar-rris "^T0?" ""
 865                                                   starttimestring))))
 866                   (setq endtimestring (format "T%06d" (+ 10000 time))))))
 867             (setq contents
 868                   (concat "\nDTSTART"
 869                           (if starttimestring "" ";VALUE=DATE")
 870                           (format ":1900%02d%02d" month day)
 871                           (or starttimestring "")
 872                           "\nDTEND"
 873                           (if endtimestring "" ";VALUE=DATE")
 874                           (format ":1900%02d%02d" month day)
 875                           (or endtimestring "")
 876                           "\nSUMMARY:" summary
 877                           "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
 878                           (format "%2d" month)
 879                           ";BYMONTHDAY="
 880                           (format "%2d" day)
 881                           )))
 882           (unless (string= entry-rest "")
 883             (setq contents (concat contents "\nDESCRIPTION:"
 884                                    (icalendar-convert-string-for-export
 885                                     entry-rest)))))
 886          ;; "ordinary" events, start and end time given
 887          ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich
 888          ((string-match
 889            (concat nonmarker
 890                    "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+"
 891                    "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
 892                    "\\("
 893                    "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
 894                    "\\)?"
 895                    "\\s-*\\(.*\\)")
 896            entry-main)
 897           (icalendar-dmsg "ordinary %s" entry-main)
 898           (let* ((datestring (icalendar-datestring-to-isodate
 899                               (substring entry-main (match-beginning 1)
 900                                          (match-end 1))))
 901                  (starttimestring (icalendar-diarytime-to-isotime
 902                                    (if (match-beginning 3)
 903                                        (substring entry-main
 904                                                   (match-beginning 3)
 905                                                   (match-end 3))
 906                                      nil)
 907                                    (if (match-beginning 4)
 908                                        (substring entry-main
 909                                                   (match-beginning 4)
 910                                                   (match-end 4))
 911                                      nil)))
 912                  (endtimestring (icalendar-diarytime-to-isotime
 913                                  (if (match-beginning 6)
 914                                      (substring entry-main
 915                                                 (match-beginning 6)
 916                                                 (match-end 6))
 917                                    nil)
 918                                  (if (match-beginning 7)
 919                                      (substring entry-main
 920                                                 (match-beginning 7)
 921                                                 (match-end 7))
 922                                    nil)))
 923                  (summary (icalendar-convert-string-for-export
 924                            (substring entry-main (match-beginning 8)
 925                                       (match-end 8)))))
 926             (when starttimestring
 927               (unless endtimestring
 928                 (let ((time (read (icalendar-rris "^T0?" ""
 929                                                   starttimestring))))
 930                   (setq endtimestring (format "T%06d" (+ 10000 time))))))
 931             (setq contents (format
 932                             "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s"
 933                             (if starttimestring "" ";VALUE=DATE")
 934                             datestring
 935                             (or starttimestring "")
 936                             (if endtimestring ""
 937                               ";VALUE=DATE")
 938                             datestring
 939                             (or endtimestring "")
 940                             summary))
 941             (unless (string= entry-rest "")
 942               (setq contents (concat contents "\nDESCRIPTION:"
 943                                      (icalendar-convert-string-for-export
 944                                       entry-rest))))))
 945          ;; everything else
 946          (t
 947           ;; Oops! what's that?
 948           (setq oops t)))
 949         (if oops
 950             (message "Cannot export entry on line %d"
 951                      (count-lines (point-min) (point)))
 952           (setq result (concat result header contents "\nEND:VEVENT"))))
 953       ;; we're done, insert everything into the file
 954       (let ((coding-system-for-write 'utf8))
 955         (set-buffer (find-file ical-filename))
 956         (unless do-not-clear-diary-file
 957           (erase-buffer))
 958         (insert
 959          "BEGIN:VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
 960         (insert "\nVERSION:2.0")
 961         (insert result)
 962         (insert "\nEND:VCALENDAR\n")))))
 963
 964
 965 ;; ======================================================================
 966 ;; import -- convert icalendar to emacs-diary
 967 ;; ======================================================================
 968
 969 ;; user function
 970 (defun icalendar-import-file (ical-filename diary-filename
 971                                             &optional non-marking
 972                                             do-not-clear-diary-file)
 973   "Import a iCalendar file and save to a diary file -- erases diary-file!
 974 Argument ICAL-FILENAME output iCalendar file.
 975 Argument DIARY-FILENAME input `diary-file'.
 976 Optional argument NON-MARKING determines whether events are created as
 977 non-marking or not.
 978 If DO-NOT-CLEAR-DIARY-FILE is not nil the target diary file is
 979 not erased."
 980   (interactive "fImport iCalendar data from file:
 981 Finto diary file (will be erased!):
 982 p")
 983   ;; clean up the diary file
 984   (save-current-buffer
 985     (unless do-not-clear-diary-file
 986       ;; clear the target diary file
 987       (set-buffer (find-file diary-filename))
 988       (erase-buffer))
 989     ;; now load and convert from the ical file
 990     (set-buffer (find-file ical-filename))
 991     (icalendar-extract-ical-from-buffer diary-filename t non-marking)))
 992
 993 ; user function
 994 (defun icalendar-extract-ical-from-buffer (&optional
 995                                            diary-file do-not-ask
 996                                            non-marking)
 997   "Extract iCalendar events from current buffer.
 998
 999 This function searches the current buffer for the first iCalendar
1000 object, reads it and adds all VEVENT elements to the diary
1001 DIARY-FILE.
1002
1003 It will ask for each appointment whether to add it to the diary
1004 when DO-NOT-ASK is non-nil.  When called interactively,
1005 DO-NOT-ASK is set to t, so that you are asked fore each event.
1006
1007 NON-MARKING determines whether diary events are created as
1008 non-marking.
1009
1010 This function attempts to notify about problems that occur when
1011 reading, parsing, or converting iCalendar data!"
1012   (interactive)
1013   (save-current-buffer
1014     ;; prepare ical
1015     (message "Preparing icalendar...")
1016     (set-buffer (icalendar-get-unfolded-buffer (current-buffer)))
1017     (goto-char (point-min))
1018     (message "Preparing icalendar...done")
1019     (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
1020         (let (ical-contents ical-errors)
1021           ;; read ical
1022           (message "Reading icalendar...")
1023           (beginning-of-line)
1024           (setq ical-contents (icalendar-read-element nil nil))
1025           (message "Reading icalendar...done")
1026           ;; convert ical
1027           (message "Converting icalendar...")
1028           (setq ical-errors (icalendar-convert-ical-to-diary
1029                              ical-contents
1030                              diary-file do-not-ask non-marking))
1031           (when diary-file
1032             ;; save the diary file
1033             (save-current-buffer
1034               (set-buffer (find-buffer-visiting diary-file))
1035               (save-buffer)))
1036           (message "Converting icalendar...done")
1037           (if (and ical-errors (y-or-n-p
1038                                 (concat "Something went wrong -- "
1039                                         "do you want to see the "
1040                                         "error log? ")))
1041               (switch-to-buffer " *icalendar-errors*")))
1042       (message
1043        "Current buffer does not contain icalendar contents!"))))
1044
1045 ;; ----------------------------------------------------------------------
1046 ;; private area
1047 ;; ----------------------------------------------------------------------
1048 (defun icalendar-format-ical-event (event)
1049   "Create a string representation of an iCalendar EVENT."
1050   (let ((string icalendar-import-format)
1051         (conversion-list
1052          '(("%d" DESCRIPTION icalendar-import-format-description)
1053            ("%s" SUMMARY     icalendar-import-format-subject)
1054            ("%l" LOCATION    icalendar-import-format-location)
1055            ("%o" ORGANIZER   icalendar-import-format-organizer))))
1056     ;; convert the specifiers in the format string
1057     (mapcar (lambda (i)
1058               (let* ((spec (car i))
1059                      (prop (cadr i))
1060                      (format (car (cddr i)))
1061                      (contents (icalendar-get-event-property event prop))
1062                      (formatted-contents ""))
1063                 ;;(message "%s" event)
1064                 ;;(message "contents%s = %s" prop contents)
1065                 (when (and contents (> (length contents) 0))
1066                   (setq formatted-contents
1067                         (icalendar-rris "%s"
1068                                         (icalendar-convert-for-import
1069                                          contents)
1070                                         (symbol-value format))))
1071                 (setq string (icalendar-rris spec
1072                                              formatted-contents
1073                                              string))))
1074             conversion-list)
1075     string))
1076
1077 (defun icalendar-convert-ical-to-diary (ical-list diary-file
1078                                                   &optional do-not-ask
1079                                                   non-marking)
1080   "Convert an iCalendar file to an Emacs diary file.
1081 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1082 DIARY-FILE.  If DO-NOT-ASK is nil the user is asked for each event
1083 whether to actually import it.  NON-MARKING determines whether diary
1084 events are created as non-marking.
1085 This function attempts to return t if something goes wrong.  In this
1086 case an error string which describes all the errors and problems is
1087 written into the buffer ` *icalendar-errors*'."
1088   (let* ((ev (icalendar-all-events ical-list))
1089          (error-string "")
1090          (event-ok t)
1091          (found-error nil)
1092          e diary-string)
1093     ;; step through all events/appointments
1094     (while ev
1095       (setq e (car ev))
1096       (setq ev (cdr ev))
1097       (setq event-ok nil)
1098       (condition-case error-val
1099           (let* ((dtstart (icalendar-decode-isodatetime
1100                            (icalendar-get-event-property e 'DTSTART)))
1101                  (start-d (calendar-date-string
1102                            (icalendar-datetime-to-noneuropean-date
1103                             dtstart)
1104                            t t))
1105                  (start-t (icalendar-datetime-to-colontime dtstart))
1106                  (dtend (icalendar-decode-isodatetime
1107                          (icalendar-get-event-property e 'DTEND)))
1108                  end-d
1109                  end-t
1110                  (subject (icalendar-convert-for-import
1111                            (or (icalendar-get-event-property e 'SUMMARY)
1112                                "No Subject")))
1113                  (rrule (icalendar-get-event-property e 'RRULE))
1114                  (rdate (icalendar-get-event-property e 'RDATE))
1115                  (duration (icalendar-get-event-property e 'DURATION)))
1116             (icalendar-dmsg "%s: %s" start-d subject)
1117             (when duration
1118               (let ((dtend2 (icalendar-add-decoded-times
1119                              dtstart
1120                              (icalendar-decode-isoduration duration))))
1121                 (if (and dtend (not (eq dtend dtend2)))
1122                     (message "Inconsistent endtime and duration for %s"
1123                              subject))
1124                 (setq dtend dtend2)))
1125             (setq end-d (if dtend
1126                             (calendar-date-string
1127                              (icalendar-datetime-to-noneuropean-date
1128                               dtend)
1129                              t t)
1130                           start-d))
1131             (setq end-t (if dtend
1132                             (icalendar-datetime-to-colontime dtend)
1133                           start-t))
1134             (icalendar-dmsg "start-d: %s, end-d: %s" start-d end-d)
1135             (cond
1136              ;; recurring event
1137              (rrule
1138               (icalendar-dmsg "recurring event")
1139               (let* ((rrule-props (icalendar-split-value rrule))
1140                      (frequency (car (cdr (assoc 'FREQ rrule-props))))
1141                      (until (car (cdr (assoc 'UNTIL rrule-props))))
1142                      (interval  (read (car (cdr (assoc 'INTERVAL
1143                                                        rrule-props))))))
1144                 (cond ((string-equal frequency "WEEKLY")
1145                        (if (not start-t)
1146                            (progn
1147                              ;; weekly and all-day
1148                              (icalendar-dmsg "weekly all-day")
1149                              (setq diary-string
1150                                    (format
1151                                     "%%%%(diary-cyclic %d %s)"
1152                                     (* interval 7)
1153                                     (icalendar-datetime-to-european-date
1154                                      dtstart))))
1155                          ;; weekly and not all-day
1156                          (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
1157                                 (weekday
1158                                  (cdr (rassoc
1159                                        byday
1160                                        icalendar-weekdayabbrev-table))))
1161                            (icalendar-dmsg "weekly not-all-day")
1162                            (if weekday
1163                                (setq diary-string
1164                                      (format "%s %s%s%s" weekday
1165                                              start-t (if end-t "-" "")
1166                                              (or end-t "")))
1167                              ;; FIXME!!!!
1168                              ;; DTSTART;VALUE=DATE-TIME:20030919T090000
1169                              ;; DTEND;VALUE=DATE-TIME:20030919T113000
1170                              (setq diary-string
1171                                    (format
1172                                     "%%%%(diary-cyclic %s %s) %s%s%s"
1173                                     (* interval 7)
1174                                     (icalendar-datetime-to-european-date
1175                                      dtstart)
1176                                     start-t (if end-t "-" "") (or end-t ""))))
1177                            (setq event-ok t))))
1178                       ;; yearly
1179                       ((string-equal frequency "YEARLY")
1180                        (icalendar-dmsg "yearly")
1181                        (setq diary-string
1182                              (format
1183                               "%%%%(diary-anniversary %s)"
1184                               (icalendar-datetime-to-european-date dtstart)))
1185                        (setq event-ok t))
1186                       ;; FIXME: war auskommentiert:
1187                       ((and (string-equal frequency "DAILY")
1188                             ;;(not (string= start-d end-d))
1189                             ;;(not start-t)
1190                             ;;(not end-t)
1191                             )
1192                        (let ((ds (icalendar-datetime-to-noneuropean-date
1193                                   (icalendar-decode-isodatetime
1194                                    (icalendar-get-event-property e
1195                                                                  'DTSTART))))
1196                              (de (icalendar-datetime-to-noneuropean-date
1197                                   (icalendar-decode-isodatetime
1198                                    until))))
1199                          (setq diary-string
1200                                (format
1201                                 "%%%%(diary-block %d %d %d  %d %d %d)"
1202                                 (nth 1 ds) (nth 0 ds) (nth 2 ds)
1203                                 (nth 1 de) (nth 0 de) (nth 2 de))))
1204                        (setq event-ok t)))
1205                 ))
1206              (rdate
1207               (icalendar-dmsg "rdate event")
1208               (setq diary-string "")
1209               (mapcar (lambda (datestring)
1210                         (setq diary-string
1211                               (concat diary-string
1212                                       (format "......"))))
1213                       (icalendar-split-value rdate)))
1214              ;; non-recurring event
1215              ;; long event
1216              ((not (string= start-d end-d))
1217               (icalendar-dmsg "non-recurring event")
1218               (let ((ds (icalendar-datetime-to-noneuropean-date dtstart))
1219                     (de (icalendar-datetime-to-noneuropean-date dtend)))
1220                 (setq diary-string
1221                       (format "%%%%(diary-block %d %d %d   %d %d %d)"
1222                               (nth 1 ds) (nth 0 ds) (nth 2 ds)
1223                               (nth 1 de) (nth 0 de) (nth 2 de))))
1224               (setq event-ok t))
1225              ;; not all-day
1226              ((and start-t (or (not end-t)
1227                                (not (string= start-t end-t))))
1228               (icalendar-dmsg "not all day event")
1229               (cond (end-t
1230                      (setq diary-string (format "%s %s-%s" start-d
1231                                                 start-t end-t)))
1232                     (t
1233                      (setq diary-string (format "%s %s" start-d
1234                                                 start-t))))
1235               (setq event-ok t))
1236              ;; all-day event
1237              (t
1238               (icalendar-dmsg "all day event")
1239               (setq diary-string start-d)
1240               (setq event-ok t)))
1241             ;; add all other elements unless the user doesn't want to have
1242             ;; them
1243             (if event-ok
1244                 (progn
1245                   (setq diary-string
1246                         (concat diary-string " "
1247                                 (icalendar-format-ical-event e)))
1248                   (if do-not-ask (setq subject nil))
1249                   (icalendar-add-diary-entry diary-string diary-file
1250                                              non-marking subject))
1251               ;; event was not ok
1252               (setq found-error t)
1253               (setq error-string
1254                     (format "%s\nCannot handle this event:%s"
1255                             error-string e))))
1256         ;; handle errors
1257         (error
1258          (message "Ignoring event \"%s\"" e)
1259          (setq found-error t)
1260          (setq error-string (format "%s\nCannot handle this event: %s"
1261                                     error-string e)))))
1262     (if found-error
1263         (save-current-buffer
1264           (set-buffer (get-buffer-create " *icalendar-errors*"))
1265           (erase-buffer)
1266           (insert error-string)))
1267     (message "Converting icalendar...done")
1268     found-error))
1269
1270 (defun icalendar-add-diary-entry (string diary-file non-marking
1271                                          &optional subject)
1272   "Add STRING to the diary file DIARY-FILE.
1273 STRING must be a properly formatted valid diary entry.  NON-MARKING
1274 determines whether diary events are created as non-marking.  If
1275 SUBJECT is not nil it must be a string that gives the subject of the
1276 entry.  In this case the user will be asked whether he wants to insert
1277 the entry."
1278   (when (or (not subject)                       ;
1279             (y-or-n-p (format "Add appointment for `%s' to diary? "
1280                               subject)))
1281     (when subject
1282       (setq non-marking
1283             (y-or-n-p (format "Make appointment non-marking? "))))
1284     (save-window-excursion
1285       (unless diary-file
1286         (setq diary-file
1287               (read-file-name "Add appointment to this diary file: ")))
1288       (make-diary-entry string non-marking diary-file))))
1289
1290 ;; ======================================================================
1291 ;; (add-hook 'list-diary-entries-hook 'include-icalendar-files)
1292 ;; ======================================================================
1293 (defun include-icalendar-files ()
1294   "Not yet implemented.")
1295
1296 (provide 'icalendar)
1297
1298 ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
1299 ;;; icalendar.el ends here