;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Created: August 2002
;; week of the year 2000 when they are exported.
;; - Yearly diary entries are assumed to occur the first time in the year
;; 1900 when they are exported.
+;; - Float diary entries are assumed to occur the first time on the
+;; day when they are exported.
;;; History:
;; Customizables
;; ======================================================================
(defgroup icalendar nil
- "Icalendar support."
+ "iCalendar support."
:prefix "icalendar-"
:group 'calendar)
%s Summary, see `icalendar-import-format-summary'
%t Status, see `icalendar-import-format-status'
%u URL, see `icalendar-import-format-url'
+%U UID, see `icalendar-import-format-uid'
A formatting FUNCTION will be called with a VEVENT as its only
argument. It must return a string. See
:type 'string
:group 'icalendar)
+(defcustom icalendar-import-format-uid
+ "\n UID: %s"
+ "Format string defining how the UID element is formatted.
+This applies only if the UID is not empty! `%s' is replaced by
+the UID."
+ :type 'string
+ :version "24.3"
+ :group 'icalendar)
+
(defcustom icalendar-import-format-status
"\n Status: %s"
"Format string defining how the status element is formatted.
"Enable icalendar debug messages.")
;; ======================================================================
-;; NO USER SERVICABLE PARTS BELOW THIS LINE
+;; NO USER SERVICEABLE PARTS BELOW THIS LINE
;; ======================================================================
(defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
;; all the other libs we need
;; ======================================================================
(require 'calendar)
+(require 'diary-lib)
;; ======================================================================
;; misc
(setq result subresult)))))
result))
- ; private
+;; private
(defun icalendar--all-events (icalendar)
"Return the list of all existing events in the given ICALENDAR."
- (icalendar--get-children (car icalendar) 'VEVENT))
+ (let ((result '()))
+ (mapc (lambda (elt)
+ (setq result (append (icalendar--get-children elt 'VEVENT)
+ result)))
+ (nreverse icalendar))
+ result))
(defun icalendar--split-value (value-string)
"Split VALUE-STRING at ';='."
(week (if (eq day -1)
byday
(substring byday 0 -2))))
- ;; "Translate" the icalendar way to specify the last
+ ;; "Translate" the iCalendar way to specify the last
;; (sun|mon|...)day in month to the tzset way.
- (if (string= week "-1") ; last day as icalendar calls it
+ (if (string= week "-1") ; last day as iCalendar calls it
(setq week "5")) ; last day as tzset calls it
(concat "M" bymonth "." week "." (if (eq day -1) "0"
(int-to-string day))
(defun icalendar--parse-vtimezone (alist)
"Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
Return nil if timezone cannot be parsed."
- (let* ((tz-id (icalendar--get-event-property alist 'TZID))
+ (let* ((tz-id (icalendar--convert-string-for-import
+ (icalendar--get-event-property alist 'TZID)))
(daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
(day (and daylight (icalendar--convert-tz-offset daylight t)))
(standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
"\\\\," "," string)))))
;; ======================================================================
-;; Export -- convert emacs-diary to icalendar
+;; Export -- convert emacs-diary to iCalendar
;; ======================================================================
;;;###autoload
"Export diary file to iCalendar format.
All diary entries in the file DIARY-FILENAME are converted to iCalendar
format. The result is appended to the file ICAL-FILENAME."
- (interactive "FExport diary data from file:
+ (interactive "FExport diary data from file: \n\
Finto iCalendar file: ")
(save-current-buffer
(set-buffer (find-file diary-filename))
(icalendar-export-region (point-min) (point-max) ical-filename)))
-(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
-(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file "22.1")
+(define-obsolete-function-alias 'icalendar-convert-diary-to-ical
+ 'icalendar-export-file "22.1")
(defvar icalendar--uid-count 0
"Auxiliary counter for creating unique ids.")
current iCalendar object, as a string. Increase
`icalendar--uid-count'. Returns the UID string."
(let ((uid icalendar-uid-format))
-
- (setq uid (replace-regexp-in-string
- "%c"
- (format "%d" icalendar--uid-count)
- uid t t))
- (setq icalendar--uid-count (1+ icalendar--uid-count))
- (setq uid (replace-regexp-in-string
- "%t"
- (format "%d%d%d" (car (current-time))
- (cadr (current-time))
- (car (cddr (current-time))))
- uid t t))
- (setq uid (replace-regexp-in-string
- "%h"
- (format "%d" (abs (sxhash entry-full))) uid t t))
- (setq uid (replace-regexp-in-string
- "%u" (or user-login-name "UNKNOWN_USER") uid t t))
- (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents)
- (substring contents (match-beginning 1) (match-end 1))
- "DTSTART")))
- (setq uid (replace-regexp-in-string "%s" dtstart uid t t)))
+ (if
+ ;; Allow other apps (such as org-mode) to create its own uid
+ (get-text-property 0 'uid entry-full)
+ (setq uid (get-text-property 0 'uid entry-full))
+ (setq uid (replace-regexp-in-string
+ "%c"
+ (format "%d" icalendar--uid-count)
+ uid t t))
+ (setq icalendar--uid-count (1+ icalendar--uid-count))
+ (setq uid (replace-regexp-in-string
+ "%t"
+ (format "%d%d%d" (car (current-time))
+ (cadr (current-time))
+ (car (cddr (current-time))))
+ uid t t))
+ (setq uid (replace-regexp-in-string
+ "%h"
+ (format "%d" (abs (sxhash entry-full))) uid t t))
+ (setq uid (replace-regexp-in-string
+ "%u" (or user-login-name "UNKNOWN_USER") uid t t))
+ (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents)
+ (substring contents (match-beginning 1) (match-end 1))
+ "DTSTART")))
+ (setq uid (replace-regexp-in-string "%s" dtstart uid t t))))
;; Return the UID string
uid))
(org (cdr (assoc 'org other-elements)))
(sta (cdr (assoc 'sta other-elements)))
(sum (cdr (assoc 'sum other-elements)))
- (url (cdr (assoc 'url other-elements))))
+ (url (cdr (assoc 'url other-elements)))
+ (uid (cdr (assoc 'uid other-elements))))
(if cla
(setq contents (concat contents "\nCLASS:" cla)))
(if des
;;(if sum
;; (setq contents (concat contents "\nSUMMARY:" sum)))
(if url
- (setq contents (concat contents "\nURL:" url))))
+ (setq contents (concat contents "\nURL:" url)))
- (setq header (concat "\nBEGIN:VEVENT\nUID:"
- (icalendar--create-uid entry-full contents)))
+ (setq header (concat "\nBEGIN:VEVENT\nUID:"
+ (or uid
+ (icalendar--create-uid entry-full
+ contents)))))
(setq result (concat result header contents "\nEND:VEVENT")))
;; handle errors
(error
found-error))
(defun icalendar--convert-to-ical (nonmarker entry-main)
- "Convert a diary entry to icalendar format.
+ "Convert a diary entry to iCalendar format.
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(or
;; can't do anything
nil
;; split summary-and-rest
- (let* ((s icalendar-import-format)
+ (let* ((case-fold-search nil)
+ (s icalendar-import-format)
(p-cla (or (string-match "%c" icalendar-import-format) -1))
(p-des (or (string-match "%d" icalendar-import-format) -1))
(p-loc (or (string-match "%l" icalendar-import-format) -1))
(p-sum (or (string-match "%s" icalendar-import-format) -1))
(p-sta (or (string-match "%t" icalendar-import-format) -1))
(p-url (or (string-match "%u" icalendar-import-format) -1))
- (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<))
+ (p-uid (or (string-match "%U" icalendar-import-format) -1))
+ (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid) '<))
(ct 0)
- pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url)
+ pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url pos-uid)
(dotimes (i (length p-list))
;; Use 'ct' to keep track of current position in list
(cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
(setq pos-sum (* 2 ct)))
((and (>= p-url 0) (= (nth i p-list) p-url))
(setq ct (+ ct 1))
- (setq pos-url (* 2 ct)))) )
+ (setq pos-url (* 2 ct)))
+ ((and (>= p-uid 0) (= (nth i p-list) p-uid))
+ (setq ct (+ ct 1))
+ (setq pos-uid (* 2 ct)))) )
(mapc (lambda (ij)
(setq s (icalendar--rris (car ij) (cadr ij) s t t)))
(list
(list "%t"
(concat "\\(" icalendar-import-format-status "\\)??"))
(list "%u"
- (concat "\\(" icalendar-import-format-url "\\)??"))))
+ (concat "\\(" icalendar-import-format-url "\\)??"))
+ (list "%U"
+ (concat "\\(" icalendar-import-format-uid "\\)??"))))
;; Need the \' regexp in order to detect multi-line items
(setq s (concat "\\`"
(icalendar--rris "%s" "\\(.*?\\)" s nil t)
"\\'"))
(if (string-match s summary-and-rest)
- (let (cla des loc org sta sum url)
+ (let (cla des loc org sta sum url uid)
(if (and pos-sum (match-beginning pos-sum))
(setq sum (substring summary-and-rest
(match-beginning pos-sum)
(setq url (substring summary-and-rest
(match-beginning pos-url)
(match-end pos-url))))
+ (if (and pos-uid (match-beginning pos-uid))
+ (setq uid (substring summary-and-rest
+ (match-beginning pos-uid)
+ (match-end pos-uid))))
(list (if cla (cons 'cla cla) nil)
(if des (cons 'des des) nil)
(if loc (cons 'loc loc) nil)
(if org (cons 'org org) nil)
(if sta (cons 'sta sta) nil)
;;(if sum (cons 'sum sum) nil)
- (if url (cons 'url url) nil))))))))
+ (if url (cons 'url url) nil)
+ (if uid (cons 'uid uid) nil))))))))
;; subroutines for icalendar-export-region
(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
- "Convert \"ordinary\" diary entry to icalendar format.
+ "Convert \"ordinary\" diary entry to iCalendar format.
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match
result))
(defun icalendar--convert-weekly-to-ical (nonmarker entry-main)
- "Convert weekly diary entry to icalendar format.
+ "Convert weekly diary entry to iCalendar format.
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(if (and (string-match (concat nonmarker
nil))
(defun icalendar--convert-yearly-to-ical (nonmarker entry-main)
- "Convert yearly diary entry to icalendar format.
+ "Convert yearly diary entry to iCalendar format.
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match (concat nonmarker
nil))
(defun icalendar--convert-sexp-to-ical (nonmarker entry-main)
- "Convert complex sexp diary entry to icalendar format -- unsupported!
+ "Convert complex sexp diary entry to iCalendar format -- unsupported!
FIXME!
nil)))
(defun icalendar--convert-block-to-ical (nonmarker entry-main)
- "Convert block diary entry to icalendar format.
+ "Convert block diary entry to iCalendar format.
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match (concat nonmarker
nil))
(defun icalendar--convert-float-to-ical (nonmarker entry-main)
- "Convert float diary entry to icalendar format -- unsupported!
+ "Convert float diary entry to iCalendar format -- partially unsupported!
-FIXME!
+ FIXME! DAY from diary-float yet unimplemented.
-NONMARKER is a regular expression matching the start of non-marking
-entries. ENTRY-MAIN is the first line of the diary entry."
- (if (string-match (concat nonmarker
- "%%(diary-float \\([^)]+\\))\\s-*\\(.*?\\) ?$")
- entry-main)
- (progn
- (icalendar--dmsg "diary-float %s" entry-main)
- (error "`diary-float' is not supported yet"))
+ NONMARKER is a regular expression matching the start of non-marking
+ entries. ENTRY-MAIN is the first line of the diary entry."
+ (if (string-match (concat nonmarker "%%\\((diary-float .+\\) ?$") entry-main)
+ (with-temp-buffer
+ (insert (match-string 1 entry-main))
+ (goto-char (point-min))
+ (let* ((sexp (read (current-buffer))) ;using `read' here
+ ;easier than regexp
+ ;matching, esp. with
+ ;different forms of
+ ;MONTH
+ (month (nth 1 sexp))
+ (dayname (nth 2 sexp))
+ (n (nth 3 sexp))
+ (day (nth 4 sexp))
+ (summary
+ (replace-regexp-in-string
+ "\\(^\s+\\|\s+$\\)" ""
+ (buffer-substring (point) (point-max)))))
+
+ (when day
+ (progn
+ (icalendar--dmsg "diary-float %s" entry-main)
+ (error "Don't know if or how to implement day in `diary-float'")))
+
+ (list (concat
+ ;;Start today (yes this is an arbitrary choice):
+ "\nDTSTART;VALUE=DATE:"
+ (format-time-string "%Y%m%d" (current-time))
+ ;;BUT remove today if `diary-float'
+ ;;expression does not hold true for today:
+ (when
+ (null (let ((date (calendar-current-date))
+ (entry entry-main))
+ (diary-float month dayname n)))
+ (concat
+ "\nEXDATE;VALUE=DATE:"
+ (format-time-string "%Y%m%d" (current-time))))
+ "\nRRULE:"
+ (if (or (numberp month) (listp month))
+ "FREQ=YEARLY;BYMONTH="
+ "FREQ=MONTHLY")
+ (when
+ (listp month)
+ (mapconcat
+ (lambda (m)
+ (number-to-string m))
+ (cadr month) ","))
+ (when
+ (numberp month)
+ (number-to-string month))
+ ";BYDAY="
+ (number-to-string n)
+ (aref icalendar--weekday-array dayname))
+ summary)))
;; no match
nil))
(defun icalendar--convert-date-to-ical (nonmarker entry-main)
- "Convert `diary-date' diary entry to icalendar format -- unsupported!
+ "Convert `diary-date' diary entry to iCalendar format -- unsupported!
FIXME!
nil))
(defun icalendar--convert-cyclic-to-ical (nonmarker entry-main)
- "Convert `diary-cyclic' diary entry to icalendar format.
+ "Convert `diary-cyclic' diary entry to iCalendar format.
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match (concat nonmarker
nil))
(defun icalendar--convert-anniversary-to-ical (nonmarker entry-main)
- "Convert `diary-anniversary' diary entry to icalendar format.
+ "Convert `diary-anniversary' diary entry to iCalendar format.
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match (concat nonmarker
nil))
;; ======================================================================
-;; Import -- convert icalendar to emacs-diary
+;; Import -- convert iCalendar to emacs-diary
;; ======================================================================
;;;###autoload
Argument DIARY-FILENAME input `diary-file'.
Optional argument NON-MARKING determines whether events are created as
non-marking or not."
- (interactive "fImport iCalendar data from file:
-Finto diary file:
+ (interactive "fImport iCalendar data from file: \n\
+Finto diary file:
p")
;; clean up the diary file
(save-current-buffer
(interactive)
(save-current-buffer
;; prepare ical
- (message "Preparing icalendar...")
+ (message "Preparing iCalendar...")
(set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
(goto-char (point-min))
- (message "Preparing icalendar...done")
+ (message "Preparing iCalendar...done")
(if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
(let (ical-contents ical-errors)
;; read ical
- (message "Reading icalendar...")
+ (message "Reading iCalendar...")
(beginning-of-line)
(setq ical-contents (icalendar--read-element nil nil))
- (message "Reading icalendar...done")
+ (message "Reading iCalendar...done")
;; convert ical
- (message "Converting icalendar...")
+ (message "Converting iCalendar...")
(setq ical-errors (icalendar--convert-ical-to-diary
ical-contents
diary-file do-not-ask non-marking))
(save-current-buffer
(set-buffer b)
(save-buffer)))))
- (message "Converting icalendar...done")
+ (message "Converting iCalendar...done")
;; return t if no error occurred
(not ical-errors))
(message
- "Current buffer does not contain icalendar contents!")
+ "Current buffer does not contain iCalendar contents!")
;; return nil, i.e. import did not work
nil)))
-(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
-(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer "22.1")
+(define-obsolete-function-alias 'icalendar-extract-ical-from-buffer
+ 'icalendar-import-buffer "22.1")
(defun icalendar--format-ical-event (event)
"Create a string representation of an iCalendar EVENT."
(if (functionp icalendar-import-format)
(funcall icalendar-import-format event)
(let ((string icalendar-import-format)
+ (case-fold-search nil)
(conversion-list
'(("%c" CLASS icalendar-import-format-class)
("%d" DESCRIPTION icalendar-import-format-description)
("%o" ORGANIZER icalendar-import-format-organizer)
("%s" SUMMARY icalendar-import-format-summary)
("%t" STATUS icalendar-import-format-status)
- ("%u" URL icalendar-import-format-url))))
+ ("%u" URL icalendar-import-format-url)
+ ("%U" UID icalendar-import-format-uid))))
;; convert the specifiers in the format string
(mapc (lambda (i)
(let* ((spec (car i))
(set-buffer (get-buffer-create "*icalendar-errors*"))
(erase-buffer)
(insert error-string)))
- (message "Converting icalendar...done")
+ (message "Converting iCalendar...done")
found-error))
;; subroutines for importing
(defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t)
- "Convert recurring icalendar event E to diary format.
+ "Convert recurring iCalendar event E to diary format.
DTSTART-DEC is the DTSTART property of E.
START-T is the event's start time in diary format.
result))
(defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d)
- "Convert non-recurring icalendar EVENT to diary format.
+ "Convert non-recurring iCalendar EVENT to diary format.
DTSTART is the decoded DTSTART property of E.
Argument START-D gives the first day.
;; Examples
;; ======================================================================
(defun icalendar-import-format-sample (event)
- "Example function for formatting an icalendar EVENT."
+ "Example function for formatting an iCalendar EVENT."
(format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
"STATUS=`%s' URL=`%s' CLASS=`%s'")
(or (icalendar--get-event-property event 'SUMMARY) "")
HCoop / bpt / emacs.git / blobdiff