;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Created: August 2002
;; Keywords: calendar
;; Human-Keywords: calendar, diary, iCalendar, vCalendar
+;; Version: 0.19
;; This file is part of GNU Emacs.
:type 'boolean
:group 'icalendar)
+(defcustom icalendar-uid-format
+ "emacs%t%c"
+ "Format of unique ID code (UID) for each iCalendar object.
+The following specifiers are available:
+%c COUNTER, an integer value that is increased each time a uid is
+ generated. This may be necessary for systems which do not
+ provide time-resolution finer than a second.
+%h HASH, a hash value of the diary entry,
+%s DTSTART, the start date (excluding time) of the diary entry,
+%t TIMESTAMP, a unique creation timestamp,
+%u USERNAME, the variable `user-login-name'.
+
+For example, a value of \"%s_%h@mydomain.com\" will generate a
+UID code for each entry composed of the time of the event, a hash
+code for the event, and your personal domain name."
+ :type 'string
+ :group 'icalendar)
+
(defvar icalendar-debug nil
"Enable icalendar debug messages.")
(goto-char (point-min))
(while
(re-search-forward
- "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
+ "\\([A-Za-z0-9-]+\\)=\\(\\([^;:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
nil t)
(setq param-name (intern (match-string 1)))
(setq param-value (match-string 2))
(cons
(concat
;; Fake a name.
- (if dst-p "(DST?)" "(STD?)")
+ (if dst-p "DST" "STD")
;; For TZ, OFFSET is added to the local time. So,
;; invert the values.
(if (eq (aref offset 0) ?-) "+" "-")
(week (if (eq day -1)
byday
(substring byday 0 -2))))
+ ;; "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
+ (setq week "5")) ; last day as tzset calls it
(concat "M" bymonth "." week "." (if (eq day -1) "0"
(int-to-string day))
;; Start time.
;; Error:
-1))
+(defun icalendar--get-weekday-numbers (abbrevweekdays)
+ "Return the list of numbers for the comma-separated ABBREVWEEKDAYS."
+ (when abbrevweekdays
+ (let* ((num -1)
+ (weekday-alist (mapcar (lambda (day)
+ (progn
+ (setq num (1+ num))
+ (cons (downcase day) num)))
+ icalendar--weekday-array)))
+ (delq nil
+ (mapcar (lambda (abbrevday)
+ (cdr (assoc abbrevday weekday-alist)))
+ (split-string (downcase abbrevweekdays) ","))))))
+
(defun icalendar--get-weekday-abbrev (weekday)
"Return the abbreviated WEEKDAY."
(catch 'found
;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
(if (and ampmstring (string= "pm" ampmstring) (< starttimenum 1200))
(setq starttimenum (+ starttimenum 1200)))
+ ;; Similar effect with 12:00am - 12:59am (need to convert to 0000-0059)
+ (if (and ampmstring (string= "am" ampmstring) (>= starttimenum 1200))
+ (setq starttimenum (- starttimenum 1200)))
(format "T%04d00" starttimenum))
nil))
(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)
+(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file "22.1")
+
+(defvar icalendar--uid-count 0
+ "Auxiliary counter for creating unique ids.")
+
+(defun icalendar--create-uid (entry-full contents)
+ "Construct a unique iCalendar UID for a diary entry.
+ENTRY-FULL is the full diary entry string. CONTENTS is the
+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)))
+
+ ;; Return the UID string
+ uid))
;;;###autoload
(defun icalendar-export-region (min max ical-filename)
(start 0)
(entry-main "")
(entry-rest "")
+ (entry-full "")
(header "")
(contents-n-summary)
(contents)
(if (match-beginning 2)
(setq entry-rest (match-string 2))
(setq entry-rest ""))
- (setq header (format "\nBEGIN:VEVENT\nUID:emacs%d%d%d"
- (car (current-time))
- (cadr (current-time))
- (car (cddr (current-time)))))
+ (setq entry-full (concat entry-main entry-rest))
+
(condition-case error-val
(progn
(setq contents-n-summary
(icalendar--convert-to-ical nonmarker entry-main))
(setq other-elements (icalendar--parse-summary-and-rest
- (concat entry-main entry-rest)))
+ entry-full))
(setq contents (concat (car contents-n-summary)
"\nSUMMARY:" (cadr contents-n-summary)))
(let ((cla (cdr (assoc 'cla other-elements)))
;; (setq contents (concat contents "\nSUMMARY:" sum)))
(if url
(setq contents (concat contents "\nURL:" url))))
+
+ (setq header (concat "\nBEGIN:VEVENT\nUID:"
+ (icalendar--create-uid entry-full contents)))
(setq result (concat result header contents "\nEND:VEVENT")))
;; handle errors
(error
(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) '<))
+ (ct 0)
pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url)
(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-cla (+ 2 (* 2 i))))
+ (setq ct (+ ct 1))
+ (setq pos-cla (* 2 ct)))
((and (>= p-des 0) (= (nth i p-list) p-des))
- (setq pos-des (+ 2 (* 2 i))))
+ (setq ct (+ ct 1))
+ (setq pos-des (* 2 ct)))
((and (>= p-loc 0) (= (nth i p-list) p-loc))
- (setq pos-loc (+ 2 (* 2 i))))
+ (setq ct (+ ct 1))
+ (setq pos-loc (* 2 ct)))
((and (>= p-org 0) (= (nth i p-list) p-org))
- (setq pos-org (+ 2 (* 2 i))))
+ (setq ct (+ ct 1))
+ (setq pos-org (* 2 ct)))
((and (>= p-sta 0) (= (nth i p-list) p-sta))
- (setq pos-sta (+ 2 (* 2 i))))
+ (setq ct (+ ct 1))
+ (setq pos-sta (* 2 ct)))
((and (>= p-sum 0) (= (nth i p-list) p-sum))
- (setq pos-sum (+ 2 (* 2 i))))
+ (setq ct (+ ct 1))
+ (setq pos-sum (* 2 ct)))
((and (>= p-url 0) (= (nth i p-list) p-url))
- (setq pos-url (+ 2 (* 2 i))))))
+ (setq ct (+ ct 1))
+ (setq pos-url (* 2 ct)))) )
(mapc (lambda (ij)
(setq s (icalendar--rris (car ij) (cadr ij) s t t)))
(list
(concat "\\(" icalendar-import-format-status "\\)??"))
(list "%u"
(concat "\\(" icalendar-import-format-url "\\)??"))))
- (setq s (concat "^" (icalendar--rris "%s" "\\(.*?\\)" s nil t)
- " $"))
+ ;; 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)
(if (and pos-sum (match-beginning pos-sum))
(if (string-match
(concat nonmarker
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
- "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" ; start time
+ "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" ; start time
"\\("
- "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" ; end time
+ "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" ; end time
"\\)?"
"\\s-*\\(.*?\\) ?$")
entry-main)
entries. ENTRY-MAIN is the first line of the diary entry."
(if (and (string-match (concat nonmarker
"\\([a-z]+\\)\\s-+"
- "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)"
+ "\\(\\([0-9][0-9]?:[0-9][0-9]\\)"
"\\([ap]m\\)?"
- "\\(-0?"
- "\\([1-9][0-9]?:[0-9][0-9]\\)"
+ "\\(-"
+ "\\([0-9][0-9]?:[0-9][0-9]\\)"
"\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\(.*?\\) ?$")
entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match (concat nonmarker
(if (eq (icalendar--date-style) 'european)
- "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
- "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
+ "\\([0-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
+ "\\([a-z]+\\)\\s-+\\([0-9]+[0-9]?\\)\\s-+")
"\\*?\\s-*"
- "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
+ "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\("
- "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
+ "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
)
(if (string-match (concat nonmarker
"%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
" +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
- "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
+ "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\("
- "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
+ "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\(.*?\\) ?$")
entry-main)
(if (string-match (concat nonmarker
"%%(diary-cyclic \\([^ ]+\\) +"
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
- "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
+ "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\("
- "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
+ "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\(.*?\\) ?$")
entry-main)
entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match (concat nonmarker
"%%(diary-anniversary \\([^)]+\\))\\s-*"
- "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
+ "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\("
- "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
+ "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\(.*?\\) ?$")
entry-main)
nil)))
(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
-(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
+(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer "22.1")
(defun icalendar--format-ical-event (event)
"Create a string representation of an iCalendar EVENT."
))
)
(cond ((string-equal frequency "WEEKLY")
- (if (not start-t)
- (progn
- ;; weekly and all-day
- (icalendar--dmsg "weekly all-day")
- (if until
- (setq result
- (format
- (concat "%%%%(and "
- "(diary-cyclic %d %s) "
- "(diary-block %s %s))")
- (* interval 7)
- dtstart-conv
- dtstart-conv
- (if count until-1-conv until-conv)
- ))
- (setq result
- (format "%%%%(and (diary-cyclic %d %s))"
- (* interval 7)
- dtstart-conv))))
- ;; weekly and not all-day
- (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
- (weekday
- (icalendar--get-weekday-number byday)))
+ (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
+ (weekdays
+ (icalendar--get-weekday-numbers byday))
+ (weekday-clause
+ (when (> (length weekdays) 1)
+ (format "(memq (calendar-day-of-week date) '%s) "
+ weekdays))))
+ (if (not start-t)
+ (progn
+ ;; weekly and all-day
+ (icalendar--dmsg "weekly all-day")
+ (if until
+ (setq result
+ (format
+ (concat "%%%%(and "
+ "%s"
+ "(diary-block %s %s))")
+ (or weekday-clause
+ (format "(diary-cyclic %d %s) "
+ (* interval 7)
+ dtstart-conv))
+ dtstart-conv
+ (if count until-1-conv until-conv)
+ ))
+ (setq result
+ (format "%%%%(and %s(diary-cyclic %d %s))"
+ (or weekday-clause "")
+ (if weekday-clause 1 (* interval 7))
+ dtstart-conv))))
+ ;; weekly and not all-day
(icalendar--dmsg "weekly not-all-day")
(if until
(setq result
(format
(concat "%%%%(and "
- "(diary-cyclic %d %s) "
+ "%s"
"(diary-block %s %s)) "
"%s%s%s")
- (* interval 7)
- dtstart-conv
+ (or weekday-clause
+ (format "(diary-cyclic %d %s) "
+ (* interval 7)
+ dtstart-conv))
dtstart-conv
until-conv
(or start-t "")
;; DTEND;VALUE=DATE-TIME:20030919T113000
(setq result
(format
- "%%%%(and (diary-cyclic %s %s)) %s%s%s"
- (* interval 7)
- dtstart-conv
- (or start-t "")
+ "%%%%(and %s(diary-cyclic %d %s)) %s%s%s"
+ (or weekday-clause "")
+ (if weekday-clause 1 (* interval 7))
+ dtstart-conv
+ (or start-t "")
(if end-t "-" "") (or end-t "")))))))
;; yearly
((string-equal frequency "YEARLY")
'diary-make-entry
'make-diary-entry)
string non-marking diary-file)))
+ ;; Würgaround to remove the trailing blank char
+ (with-current-buffer (find-file diary-file)
+ (goto-char (point-max))
+ (if (= (char-before) ? )
+ (delete-char -1)))
;; return diary-file in case it has been changed interactively
diary-file)
HCoop / bpt / emacs.git / blobdiff