Mercurial > emacs
changeset 101457:feab64c71ad0
icalendar: uid-format, bug fixes.
| author | Ulf Jasper <ulf.jasper@web.de> |
|---|---|
| date | Sun, 25 Jan 2009 13:38:14 +0000 |
| parents | 133f2b03479e |
| children | 36abe982e7cd |
| files | lisp/ChangeLog lisp/calendar/icalendar.el test/ChangeLog test/icalendar-testsuite.el |
| diffstat | 4 files changed, 148 insertions(+), 30 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Jan 25 12:10:52 2009 +0000 +++ b/lisp/ChangeLog Sun Jan 25 13:38:14 2009 +0000 @@ -1,3 +1,17 @@ +2009-01-25 Craig Markwardt <cbmarkwardt@gmail.com> + + * calendar/icalendar.el (icalendar-uid-format): New defcustom + variable to allow the user to choose icalendar UID format. + (icalendar--diarytime-to-isotime): Bug fix, now times in the range + 12:00am-12:59am are correctly converted to 0000-0059, instead of + 12pm. + (icalendar-export-region,icalendar--create-uid): Use custom + function to compute icalendar UID for each entry. + (icalendar--parse-summary-and-rest): Bug fix for parsing of lines + with description, location, etc. fields (need to keep active count + of fields encountered). Another bug fix to the regex that matches + multiple lines (need \' regex instead of $ to match end-of-entry). + 2009-01-25 Juri Linkov <juri@jurta.org> * progmodes/grep.el (grep-mode-map): Put grep-find before grep and
--- a/lisp/calendar/icalendar.el Sun Jan 25 12:10:52 2009 +0000 +++ b/lisp/calendar/icalendar.el Sun Jan 25 13:38:14 2009 +0000 @@ -210,6 +210,24 @@ :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 user-login-name. + +For example, a value of \"DTSTART_HASH@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.") @@ -844,6 +862,9 @@ ;; 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)) @@ -880,17 +901,36 @@ (defvar icalendar--uid-count 0 "Auxiliary counter for creating unique ids.") -(defun icalendar--create-uid () - "Create a unique identifier. -Use `current-time' and a counter to create unique ids. The -counter is necessary for systems which do not provide resolution -finer than a second." - (setq icalendar--uid-count (1+ icalendar--uid-count)) - (format "emacs%d%d%d%d" - (car (current-time)) - (cadr (current-time)) - (car (cddr (current-time))) - icalendar--uid-count)) +(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) @@ -907,6 +947,7 @@ (start 0) (entry-main "") (entry-rest "") + (entry-full "") (header "") (contents-n-summary) (contents) @@ -931,14 +972,14 @@ (if (match-beginning 2) (setq entry-rest (match-string 2)) (setq entry-rest "")) - (setq header (format "\nBEGIN:VEVENT\nUID:%s" - (icalendar--create-uid))) + (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))) @@ -962,6 +1003,9 @@ ;; (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 @@ -1034,22 +1078,31 @@ (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 @@ -1068,8 +1121,10 @@ (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))
--- a/test/ChangeLog Sun Jan 25 12:10:52 2009 +0000 +++ b/test/ChangeLog Sun Jan 25 13:38:14 2009 +0000 @@ -1,8 +1,19 @@ +2009-01-25 Ulf Jasper <ulf.jasper@web.de> + + * icalendar-testsuite.el + (icalendar-testsuite--run-function-tests): Added + icalendar-testsuite--test-diarytime-to-isotime. + (icalendar-testsuite--test-parse-summary-and-rest): Adjusted to + recent icalendar fixes. + (icalendar-testsuite--test-diarytime-to-isotime): New. + (icalendar-testsuite--test-create-uid): Adjusted to recent + icalendar changes. + 2008-11-30 Shigeru Fukaya <shigeru.fukaya@gmail.com> * bytecomp-testsuite.el: New file. -2008-10-31 Ulf Jasper <ulf@web.de> +2008-10-31 Ulf Jasper <ulf.jasper@web.de> * icalendar-testsuite.el (icalendar-testsuite--run-function-tests): Added `icalendar-testsuite--test-create-uid'.
--- a/test/icalendar-testsuite.el Sun Jan 25 12:10:52 2009 +0000 +++ b/test/icalendar-testsuite.el Sun Jan 25 13:38:14 2009 +0000 @@ -51,6 +51,7 @@ (icalendar-testsuite--test-first-weekday-of-year) (icalendar-testsuite--test-datestring-to-isodate) (icalendar-testsuite--test-datetime-to-diary-date) + (icalendar-testsuite--test-diarytime-to-isotime) (icalendar-testsuite--test-calendar-style) (icalendar-testsuite--test-create-uid)) @@ -104,12 +105,11 @@ (icalendar-import-format-url " URL %s") (icalendar-import-format-class " CLA %s") (result)) - ;; FIXME: need a trailing blank char! - (setq result (icalendar--parse-summary-and-rest "SUM sum ORG org ")) + (setq result (icalendar--parse-summary-and-rest "SUM sum ORG org")) (assert (string= (cdr (assoc 'org result)) "org")) (setq result (icalendar--parse-summary-and-rest - "SUM sum DES des LOC loc ORG org STA sta URL url CLA cla ")) + "SUM sum DES des LOC loc ORG org STA sta URL url CLA cla")) (assert (string= (cdr (assoc 'des result)) "des")) (assert (string= (cdr (assoc 'loc result)) "loc")) (assert (string= (cdr (assoc 'org result)) "org")) @@ -210,6 +210,31 @@ (assert (string= (icalendar--datetime-to-diary-date datetime) "12 31 2008")))) +(defun icalendar-testsuite--test-diarytime-to-isotime () + "Test method for `icalendar--diarytime-to-isotime'." + (assert (string= (icalendar--diarytime-to-isotime "0100" "") + "T010000")) + (assert (string= (icalendar--diarytime-to-isotime "0100" "am") + "T010000")) + (assert (string= (icalendar--diarytime-to-isotime "0100" "pm") + "T130000")) + (assert (string= (icalendar--diarytime-to-isotime "1200" "") + "T120000")) + (assert (string= (icalendar--diarytime-to-isotime "17:17" "") + "T171700")) + (assert (string= (icalendar--diarytime-to-isotime "1200" "am") + "T000000")) + (assert (string= (icalendar--diarytime-to-isotime "1201" "am") + "T000100")) + (assert (string= (icalendar--diarytime-to-isotime "1259" "am") + "T005900")) + (assert (string= (icalendar--diarytime-to-isotime "1200" "pm") + "T120000")) + (assert (string= (icalendar--diarytime-to-isotime "1201" "pm") + "T120100")) + (assert (string= (icalendar--diarytime-to-isotime "1259" "pm") + "T125900"))) + (defun icalendar-testsuite--test-calendar-style () "Test method for `icalendar--date-style'." (dolist (calendar-date-style '(iso american european)) @@ -224,17 +249,30 @@ (defun icalendar-testsuite--test-create-uid () "Test method for `icalendar--create-uid'." - (let (t-ct - (icalendar--uid-count 77)) + (let* ((icalendar-uid-format "xxx-%t-%c-%h-%u-%s") + t-ct + (icalendar--uid-count 77) + (entry-full "30.06.1964 07:01 blahblah") + (hash (format "%d" (abs (sxhash entry-full)))) + (contents "DTSTART:19640630T070100\nblahblah") + (username (or user-login-name "UNKNOWN_USER")) + ) ;; FIXME! If a test fails 'current-time is screwed. FIXME! (fset 't-ct (symbol-function 'current-time)) (fset 'current-time (lambda () '(1 2 3))) (assert (= 77 icalendar--uid-count)) - (assert (string= "emacs12378" (icalendar--create-uid))) + (assert (string= (concat "xxx-123-77-" hash "-" username "-19640630") + (icalendar--create-uid entry-full contents))) (assert (= 78 icalendar--uid-count)) (fset 'current-time (symbol-function 't-ct)) + + (setq contents "blahblah") + (setq icalendar-uid-format "yyy%syyy") + (assert (string= (concat "yyyDTSTARTyyy") + (icalendar--create-uid entry-full contents))) )) + ;; ====================================================================== ;; Test methods for exporting from diary to icalendar ;; ======================================================================