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