lisp/calendar/icalendar.el

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