[gnu.emacs.sources] icalendar.el 0.01

FYI, a prototype icalendar to emacs-diary package.


Forwarded message 1

  • From: Ulf Jasper <ulf.jasper@web.de>
  • Date: 21 Mar 2003 22:25:32 +0100
  • Subject: icalendar.el 0.01
  • Message-ID: <87d6kkcsz7.fsf@web.de>
Here's a package for importing simple icalendar events into Emacs

Please note that this is a pre-alpha snapshot trial demo test
version. It should work correctly on ordinary, i.e. non-recurring,
events. But it will fail on most recurring events. Anyhow, I am
posting it here because I think that there may be someone who could
find it useful.

Best regards


;;; icalendar.el --- Emacs iCalendar implementation.
;;  Copyright (C) 2002, 2003 by Ulf Jasper
;;  This file is NOT part of GNU Emacs.
;;  Author:      Ulf Jasper <ulf.jasper@web.de>
;;  Filename:    icalendar.el
;;  Created:     August 2002
;;  Keywords:    Calendar Diary iCalendar vCalendar
;;  Time-stamp:  "21. März 2003, 22:19:49 (ulf)"
;;  CVS-Version: $Id: icalendar.el,v 1.2 2003/03/21 21:20:23 ulf Exp $

(defconst icalendar-version 0.01
  "Version number of icalendar.el. Version 0.01 is a pre-alpha snapshot!")

;;  This program is free software; you can redistribute it and/or modify it
;;  under the terms of the GNU General Public License as published by the
;;  Free Software Foundation; either version 2 of the License, or (at your
;;  option) any later version.
;;  This program is distributed in the hope that it will be useful, but
;;  WITHOUT ANY WARRANTY; without even the implied warranty of
;;  General Public License for more details.
;;  You should have received a copy of the GNU General Public License along
;;  with this program; if not, write to the Free Software Foundation, Inc.,
;;  59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; Commentary:
;;  icalendar.el aims at providing an implementation of the iCalendar
;;  standard as defined in "RFC 2445 -- Internet Calendaring and
;;  Scheduling Core Object Specification (iCalendar)". 
;;  icalendar.el is in a very early pre-alpha stage. API may change
;;  without further notice.
;;  Right now it allows for importing [iv]cal data into Emacs diary
;;  files. Actually, importing from icalendar to emacs diary is the
;;  only thing, that has been used and tested. Recurring events most
;;  certainly will not be imported correctly, if they are imported at
;;  all. "Ordinary" events should be imported correctly. 
;;; Usage:
;;  (require 'icalendar)
;;  Use `icalendar-extract-ical-from-buffer' for interactively
;;  extracting ical data from the current buffer. Example:
;;  (add-hook 'vm-select-new-message-hook 'icalendar-extract-ical-from-buffer)
;;  Or use `icalendar-import-file' for non-interactively importing an
;;  ical file. (Careful: the contents of the target diary file are
;;  DELETED!) Example:
;;  (icalendar-import-file "/home/ulf/.kde/share/apps/korganizer/calendar.ics"
;;	                   "/home/ulf/mail/ical-diary")
;;  It is highly recommended to use a dedicated diary file for
;;  importing.  You will probably want to add the follwing to your
;;  .emacs.
;;  (add-hook 'list-diary-entries-hook 'include-other-diary-files)
;;  (add-hook 'mark-diary-entries-hook 'mark-included-diary-files)
;;; History:
;;  0.01: First published version. Trial version. Alpha version.
;;; To Do:
;;  check vcalendar version 
;;  check (unknown) elements
;;  recurring events!
;;  works for european style calendars only!
;;  alarm
;;  exceptions in recurring events
;;  the parser is too soft
;;  error log is incomplete
;;; Code:

;; Customizables
(defgroup icalendar nil

(defcustom icalendar-import-ignored-properties
  '(("DTSTART" t) ("DTEND" t) ("SUMMARY" t) ("CREATED" t) ("UID" t) 
    ("SEQUENCE" t)
    ("DESCRIPTION" nil) ("LOCATION" nil) ("ORGANIZER" nil) ("ATTENDEE" nil) 
    ("CLASS" nil) ("CATEGORIES" nil) ("RRULE" nil) ("ALARM" nil))
  "Event properties which shall NOT be used when importing from an
icalendar to Emacs diary. All properties which are set to t are
silently ignored. They will not be imported into the Emacs diary. All
properties which are set to nil and all properties which are not
listed here will be included when importing from an icalendar into the
Emacs diary."
  :type '(alist :key-type string :value-type (group boolean))
  :options '("DTSTART" "DTEND" "SUMMARY"
  :group 'icalendar)

(defcustom icalendar-import-prefix-subject
  "Icalendar: "
  "A string which is put in front of the subject of an icalendar event
when the event is imported into Emacs diary. If
`icalendar-import-prefix-subject' is set to nil no prefix will be
inserted at all. This is probably only useful if you want to mark
diary entries which are imported from icalendar files. See also
  :type '(choice (const nil) (string :tag "Prefix"))
  :group 'icalendar)

(defcustom icalendar-import-prefix-property
  "Icalendar: "
  "A string which is put in front of each property of an icalendar
event when the event is imported into Emacs diary. If
`icalendar-import-prefix-property' is set to nil no prefix will be
inserted at all. This is probably only useful if you want to mark
diary entries which are imported from icalendar files. See also
  :type '(choice (const nil) (string :tag "Prefix"))
  :group 'icalendar)

(defcustom icalendar-import-separator
  "\n "
  "A string which is put inbetween each two properties of an icalendar
event when the event is imported into Emacs diary. If
you use newlines here, please add whitespace after the newline character, e.g. \"\n \". Otherwise the diary might get confused."
  :type 'string
  :group 'icalendar)

;; ======================================================================
;; ======================================================================

(defconst icalendar-weekdays
  '(("MO" "Monday") ("TU" "Tuesday") ("WE" "Wednesday")
    ("TH" "Thursday") ("FR" "Friday") ("SA" "Saturday")
    ("SU" "Sunday"))
  "Translation table for weekdays")

;; ======================================================================
;; all the other libs we need
;; ======================================================================
(require 'calendar)
(require 'appt)

;; ======================================================================
;; Core functionality
;; Functions for parsing icalendars, importing and so on
;; ======================================================================

(defun icalendar-get-unfolded-buffer (folded-ical-buffer) 
  "Returns a new buffer containing the unfolded contents of the input buffer.
Folding is the ical way of wrapping long lines. In the created buffer all
occurrences of CR LF BLANK are replaced by the empty string."
  (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
    (message "Preparing icalendar file...")
      (set-buffer unfolded-buffer)
      (insert-buffer folded-ical-buffer)
      (replace-regexp "\r?\n[ \t]" "" nil (point-min) (point-max))
    (message "Preparing icalendar file... done")

(defsubst icalendar-read-element (invalue inparams)
  "Recursively reads the next icalendar element in the current buffer. 
INVALUE gives the current icalendar element we are reading.
INPARAMS gives the current parameters.....
This function calls itself recursively for each nested calendar element
it finds"
  (let (element children line name params param param-name param-value value
	(continue t))
    (setq children '())
    (while (and continue
		(re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
      (setq name (match-string 1))
      (backward-char 1)
      (setq params (list))
      (setq line (list))
      (while (looking-at ";")
	(re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
	(setq param-name (intern (match-string 1)))
	(re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)" nil t)
	(if (match-string 2)
	    (setq param-value (match-string 2))
	  (setq param-value (match-string 3)))
	(setq param (list param-name param-value))
	(while (looking-at ",")
	  (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
			     nil t)
	  (if (match-string 2)
	      (setq param-value (match-string 2))
	    (setq param-value (match-string 3)))
	  (setq param (append param param-value)))
	(setq params (append params param))
      (unless (looking-at ":")
	(error "Oops"))
      (forward-char 1)
      (re-search-forward  "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t)
      (setq value (match-string 0))
      (setq value (replace-regexp-in-string "\r?\n[ \t]" "" value))
      (setq line (list (intern name) params value))
      (cond ((string= name "BEGIN")
	     (setq children
		   (append children
			   (list (icalendar-read-element (intern value)
	    ((string= name "END")
	     (setq continue nil)
	     (setq element (append element (list line)))))
    (if invalue
	(list invalue inparams element children)

;; ======================================================================
;; helper functions for examining events
;; ======================================================================

(defsubst icalendar-get-all-event-properties (event)
  (car (cddr event)))

(defsubst icalendar-get-event-property (event prop)
  (catch 'found
    (let ((props (car (cddr event))) pp)
      (while props
	(setq pp (car props))
	(if (eq (car pp) prop)
	    (throw 'found (car (cddr pp))))
	(setq props (cdr props))))

(defsubst icalendar-set-event-property (event prop new-value)
  (catch 'found
    (let ((props (car (cddr event))) pp)
      (while props
	(setq pp (car props))
	(when (eq (car pp) prop)
	  (setcdr (cdr pp) new-value)
	  (throw 'found (car (cddr pp))))
	(setq props (cdr props)))
      (setq props (car (cddr event)))
      (setcar (cddr event) (append props (list (list prop nil new-value)))))))

(defun icalendar-get-children (node name)
  (let ((result nil)
	(children (car (cdddr node))))
    (when (eq (car node) name)
      (setq result node))
    ;;(message "%s" node)
    (when children
      (let ((subresult
	     (delq nil (mapcar (lambda (n)
				 (icalendar-get-children n name)) children))))
	(if subresult
	    (if result
		(setq result (append result subresult))
	      (setq result subresult)))))
    ;;(message "%s" result)

; private
(defun icalendar-all-events (ical)
  "Returns the list of all existing events."
  (interactive "")
  (icalendar-get-children (car ical) 'VEVENT))

;; (defun icalendar-get-event-for-uid (icalendar-file uid)
;;   (let ((e (icalendar-all-events (icalendar-read-icalfile icalendar-file))))
;;     (catch 'found
;;       (while e
;; 	(if (string= uid (icalendar-get-event-property (car e) 'UID))
;; 	    (throw 'found (car e)))
;; 	(setq e (cdr e)))
;;       nil)))

(defsubst icalendar-split-value (value-string)
  "splits ;="
  (let ((result '())
	param-name param-value)
    (when value-string
      ;;(message "splitting: %s " value-string)
	(set-buffer (get-buffer-create " *ical-temp*"))
	(set-buffer-modified-p nil)
	(insert value-string)
	(goto-char (point-min))
	(while (re-search-forward
		nil t)
	  (setq param-name (intern (match-string 1)))
	  (setq param-value (match-string 2))
	  (setq result (append result (list (list param-name param-value)))))))

(defsubst icalendar-decode-datetimestring (datetimestring)
  "returns datetime in format like decode-time. 
FIXME: cannot handle tzid-attribute....!"
  ;; day/month/year must be present
  (let ((year  (read (substring datetimestring 0 4)))
	(month (read (substring datetimestring 4 6)))
	(day   (read (substring datetimestring 6 8)))
	(hour 0)
	(minute 0)
	(second 0))
    (when (> (length datetimestring) 12) ;; hour/minute
      (setq hour (read (substring datetimestring 9 11)))
      (setq minute (read (substring datetimestring 11 13))))
    (when (> (length datetimestring) 14) ;; seconds
      (setq second (read (substring datetimestring 13 15))))
    (when (and (> (length datetimestring) 15) ;; utc specifier
	       (char-equal ?Z (aref datetimestring 15)))
      (setq second (+ (car (current-time-zone)) second)))
    ;; create the decoded date-time
    (decode-time (encode-time second minute hour day month year))))

(defsubst icalendar-datetime-to-noneuropean-date (datetime)
  "Converts a decoded datetime to non-european-style format: (month day year)."
  (list (nth 4 datetime) ;month
	(nth 3 datetime) ;day
	(nth 5 datetime)));year

(defsubst icalendar-datetime-to-european-date (datetime)
  "Converts a decoded datetime to european format: (day month year).
  (format "%d %d %d" (nth 3 datetime); day
	  (nth 4 datetime) ;month
	  (nth 5 datetime));year

(defsubst icalendar-datetime-to-colontime (datetime)
  "Extracts the time part of a decoded date into 24-hour format, ignoring
  (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))

(defun icalendar-print-children-names (node)
  (let ((children (car (cdddr node))))
    (print ">>>")
    (print (car node))
    (when children
      (mapcar 'icalendar-print-children-names children)))
    (print "<<<"))

;; ======================================================================
;; export -- convert emacs-diary to icalendar -- mostly untested....
;; ======================================================================
(defun icalendar-convert-diary-to-ical (diary-filename ical-filename)
  "Export diary file to icalendar format.
Argument DIARY-FILENAME input `diary-file'.
Argument ICAL-FILENAME output icalendar file."
  (interactive "FExport diary data from file:
Finto ical file: ")
  (let ((result "")
	(start 0)
	(entry-main "")
	(entry-rest ""))
      (set-buffer (find-file diary-filename))
      (goto-char (point-min))
      (while (re-search-forward
	      "^\\([^ \t\n].*\\)\\(\n[ \t].*\\)*" nil t)
	(setq entry-main (match-string 1))
	(if (match-beginning 1)
	    (setq entry-rest (match-string 2))
	  (setq entry-rest ""))
	(cond ((string-match
		"%%(diary-anniversary \\([^)]+\\)"
	       ;; anniversary
	       (setq result (concat result "\n--anniversary\n"
				    entry-main entry-rest))
	       ;; start and end time given
	       (let ((starttime (substring entry-main (match-beginning 1)
					   (match-end 1)))
		     (endtime (substring entry-main (match-beginning 2)
					 (match-end 2))))
		 (setq result (concat result "\n***\n" starttime "--" endtime)))
	       (setq result (concat result "\n--\n" entry-main entry-rest))
	      ((string-match "[0-9][0-9]:[0-9][0-9]" entry-main)
	       ;; start time only -- ?!
	       (setq result (concat result "\n***\n"
				    (substring entry-main
					       (match-beginning 0)
					       (match-end 0))))
	       (setq result (concat result "\n--\n" entry-main entry-rest))
	       ;; Oops! what's that?
	       (message "Cannot convert...!")
    (set-buffer (find-file ical-filename))
    (insert "BEGIN: VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN\n")
    (insert "VERSION: 1.0\n")
    (insert result)
    (insert "END: VCALENDAR\n")

;; ======================================================================
;; import -- convert icalendar to emacs-diary
;; ======================================================================

;; user function
(defun icalendar-import-file (ical-filename diary-filename)
  "Import a icalendar file and save to a diary file -- erases DIARY-FILENAME!!!
Argument ICAL-FILENAME output icalendar file.
Argument DIARY-FILENAME input `diary-file'."
  (interactive "FImport ical data from file: 
Finto diary file (will be erased): ")
  ;; clean up the diary file
    ;; clear the target diary file
    (set-buffer (find-file diary-filename))
    ;; now load and convert from the ical file
    (set-buffer (find-file ical-filename))
    (icalendar-extract-ical-from-buffer diary-filename t)

; user function
(defun icalendar-extract-ical-from-buffer (&optional diary-file do-not-ask) 
  "Searches the current buffer for the first iCalendar object, reads
it and adds all VEVENT elements to the diary. Will ask for each
appointment when called interactively. Will notify when problems occur."
    (message "Preparing icalendar...")
    (set-buffer (icalendar-get-unfolded-buffer (current-buffer)))
    (goto-char (point-min))
    (message "Preparing icalendar... done")
    (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
	  (let ((found-errors (icalendar-convert-ical-to-diary 
			       (icalendar-read-element nil nil) 
			       diary-file do-not-ask)))
	    ;; finally save the diary file
	    (when diary-file
		(set-buffer (find-buffer-visiting diary-file))
	    (if (and found-errors (y-or-n-p (concat "Something went wrong -- "
						    "do you want to see the "
						    "error log? ")))
		(switch-to-buffer " *icalendar-errors*"))))
      (message "Current buffer does not contain icalendar contents!"))))

;; ----------------------------------------------------------------------
;; private area
;; ----------------------------------------------------------------------
(defsubst icalendar-property-is-ignored (propertyname)
  "Indicates wether the given icalendar PROPERTYNAME is imported into emacs
  (cadr (assoc propertyname icalendar-import-ignored-properties)))

;; (defun icalendar-create-diary-string-nonrecurring (dtstart dtend)
;;   "*..."
;;   (let ((start))
;;   ((not (string= start-d end-d))
;;    (let ((ds (icalendar-datetime-to-noneuropean-date 
;; 	      (icalendar-decode-datetimestring
;; 	       (icalendar-get-event-property e 'DTSTART))))
;; 	 (de (icalendar-datetime-to-noneuropean-date
;; 	      (icalendar-decode-datetimestring
;; 	       (icalendar-get-event-property e 'DTEND)))))
;;      (setq diary-string 
;; 	   (format "%%%%(diary-block %d %d %d   %d %d %d) %s"
;; 		   (nth 1 ds) (nth 0 ds) (nth 2 ds)
;; 		   (nth 1 de) (nth 0 de) (nth 2 de)
;; 		   subject))))
;;   ;; not all-day
;;   (start-t
;;    (cond (end-t
;; 	  (setq diary-string (format "%s %s-%s %s" start-d start-t 
;; 				     end-t subject)))
;; 	 (t
;; 	  (setq diary-string (format "%s %s %s" start-d start-t 
;; 				     subject)))))
;;   ;; all-day event
;;   (t
;;    (setq diary-string (format "%s %s" start-d subject))))

; private
(defun icalendar-convert-ical-to-diary (ical-list diary-file 
						  &optional do-not-ask)
  "Imports VEVENTS from the icalendar object ICAL-LIST and saves them
to a diary file. Returns t if something went wrong. In this case an
error string which describes all the errors and problems is written
into the buffer ` *icalendar-errors*'."
  (message "Converting icalendar...")
  (let* ((ev (icalendar-all-events ical-list))
	 (error-string "")
	 (event-ok t)
	 (found-error nil)
	 e diary-string)
    ;; step through all events/appointments
    (while ev
      (setq e (car ev))
      (setq ev (cdr ev))
      (setq event-ok nil)
      (let* ((dtstart (icalendar-decode-datetimestring
		       (icalendar-get-event-property e 'DTSTART)))
	     (start-d (calendar-date-string 
		       (icalendar-datetime-to-noneuropean-date dtstart)
		       t t))
	     (start-t (icalendar-datetime-to-colontime dtstart))
	     (dtend (icalendar-decode-datetimestring
		     (icalendar-get-event-property e 'DTEND)))
	     (end-d (calendar-date-string
		     (icalendar-datetime-to-noneuropean-date dtend)
		     t t))
	     (end-t (icalendar-datetime-to-colontime dtend))
	     (subject (or (icalendar-get-event-property e 'SUMMARY)
			  "No Subject"))
	     (rrule (icalendar-get-event-property e 'RRULE))
	     (rdate (icalendar-get-event-property e 'RDATE)))
	(when icalendar-import-prefix-subject
	  (setq subject (concat icalendar-import-prefix-subject subject)))
	 ;; recurring event
	  (let* ((rrule-props (icalendar-split-value rrule))
		 (frequency (car (cdr (assoc 'FREQ rrule-props))))
		 (interval  (read (car (cdr (assoc 'INTERVAL rrule-props))))))
	    (cond ((string-equal frequency "WEEKLY")
		   (if (not start-t)
		       ;; weekly and all-day
		       (setq diary-string
			     (format "%%%%(diary-cyclic %d %s) %s"
				     (* interval 7) 
		   ;; weekly and not all-day
		   (let ((byday (cadr (assoc 'BYDAY rrule-props))))
		     (setq diary-string
			   (format "%s %s%s%s %s" 
				   (cadr (assoc byday icalendar-weekdays))
				   start-t (if end-t "-" "") (or end-t "")
		   (setq event-ok t))
		  ;; yearly
		  ((string-equal frequency "YEARLY")
		   (setq diary-string 
			 (format "%%%%(diary-anniversary %s) %s"
				 (icalendar-datetime-to-european-date dtstart)
		   (setq event-ok t)))
		  ;;  ((and (string-equal frequency "DAILY")
		  ;;	(not (string= start-d end-d))
		  ;;	(not start-t)
		  ;;	(not end-t))
		  ;;   (let ((ds (icalendar-datetime-to-noneuropean-date 
		  ;;	      (icalendar-decode-datetimestring
		  ;;	       (icalendar-get-event-property e 'DTSTART))))
		  ;;	 (de (icalendar-datetime-to-noneuropean-date
		  ;;	      (icalendar-decode-datetimestring
		  ;;	       (icalendar-get-event-property e 'DTEND)))))
		  ;;     (format "%%%%(diary-block %d %d %d  %d %d %d) %s"
		  ;;	     (nth 1 ds) (nth 0 ds) (nth 2 ds)
		  ;;	     (nth 1 de) (nth 0 de) (nth 2 de)
		  ;;	     subject)))
	  (setq diary-string "")
	  (mapcar (lambda (datestring)
		    (setq diary-string 
			  (concat diary-string
				  (format "......"))))
		  (icalendar-split-value rdate)))
	 ;; non-recurring event
	 ;; long event
	 ((not (string= start-d end-d))
	  (let ((ds (icalendar-datetime-to-noneuropean-date 
		      (icalendar-get-event-property e 'DTSTART))))
		(de (icalendar-datetime-to-noneuropean-date
		      (icalendar-get-event-property e 'DTEND)))))
	    (setq diary-string 
		  (format "%%%%(diary-block %d %d %d   %d %d %d) %s"
			  (nth 1 ds) (nth 0 ds) (nth 2 ds)
			  (nth 1 de) (nth 0 de) (nth 2 de)
	  (setq event-ok t))
	 ;; not all-day
	  (cond (end-t
		 (setq diary-string (format "%s %s-%s %s" start-d start-t 
					    end-t subject)))
		 (setq diary-string (format "%s %s %s" start-d start-t 
	  (setq event-ok t))
	 ;; all-day event
	  (setq diary-string (format "%s %s" start-d subject))
	  (setq event-ok t)))
	;; add all other elements unless the user doesn't want to have
	;; them
	(if event-ok
	      (let ((separator "\n ")
		    (nseparator icalendar-import-separator))
		(when icalendar-import-prefix-property
		  (setq separator 
			(concat icalendar-import-separator
		(mapcar (lambda (property)
			  (let* ((propname (symbol-name (car property)))
				 (value (car (cddr property))))
			    (unless (icalendar-property-is-ignored propname)
			      (setq diary-string (concat diary-string separator
							 propname ": " value))
			      (setq separator nseparator))))
			(icalendar-get-all-event-properties e)))
	      (if do-not-ask (setq subject nil))
	      (icalendar-add-diary-entry diary-string diary-file subject))
	  ;; event was not ok
	  (setq found-error t)
	  (setq error-string (format "%s\nCannot handle this event:%s"
				     error-string e)))))
    (if found-error
	  (set-buffer (get-buffer-create " *icalendar-errors*"))
	  (insert error-string)))
    (message "Converting icalendar... done")

;; private
(defun icalendar-add-diary-entry (string diary-file &optional subject)
  "Adds STRING to the diary file DIARY. STRING must be a properly
formatted valid diary entry.  If SUBJECT is not nil it must be a
string that gives the subject of the entry. In this case the user will
be asked whether he wants to insert the entry."
  (if (or (not subject)			;
	  (y-or-n-p (format "Add appointment for `%s' to diary? " subject)))
	(unless diary-file
	  (setq diary-file
		(read-file-name "Add appointment to this diary file: ")))
	(make-diary-entry string nil diary-file))))

;; ======================================================================
(provide 'icalendar)
;;; icalendar.el ends here

                        Like it would be hello. -- J. Selbiger

Received on Saturday, 22 March 2003 05:37:55 UTC