[Emacs-diffs] emacs lisp/ChangeLog lisp/calendar/icalendar.el...

[Ulf Jasper]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Ulf Jasper <u11>        09/01/25 13:38:17

Modified files:
        lisp           : ChangeLog 
        lisp/calendar  : icalendar.el 
        test           : ChangeLog icalendar-testsuite.el 

Log message:
        icalendar: uid-format, bug fixes.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.15173&r2=1.15174
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calendar/icalendar.el?cvsroot=emacs&r1=1.35&r2=1.36
http://cvs.savannah.gnu.org/viewcvs/emacs/test/ChangeLog?cvsroot=emacs&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/emacs/test/icalendar-testsuite.el?cvsroot=emacs&r1=1.5&r2=1.6

Patches:
Index: lisp/ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.15173
retrieving revision 1.15174
diff -u -b -r1.15173 -r1.15174
--- lisp/ChangeLog      25 Jan 2009 01:20:28 -0000      1.15173
+++ lisp/ChangeLog      25 Jan 2009 13:38:14 -0000      1.15174
@@ -1,3 +1,17 @@
+2009-01-25  Craig Markwardt <address@hidden>
+
+       * 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  <address@hidden>
 
        * progmodes/grep.el (grep-mode-map): Put grep-find before grep and

Index: lisp/calendar/icalendar.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/icalendar.el,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -b -r1.35 -r1.36
--- lisp/calendar/icalendar.el  5 Jan 2009 03:20:40 -0000       1.35
+++ lisp/calendar/icalendar.el  25 Jan 2009 13:38:16 -0000      1.36
@@ -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 \"address@hidden" 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."
+(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))
-  (format "emacs%d%d%d%d"
-          (car (current-time))
+    (setq uid (replace-regexp-in-string 
+              "%t"
+              (format "%d%d%d" (car (current-time))
           (cadr (current-time))
-          (car (cddr (current-time)))
-          icalendar--uid-count))
+                      (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))

Index: test/ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/test/ChangeLog,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- test/ChangeLog      8 Jan 2009 02:56:31 -0000       1.10
+++ test/ChangeLog      25 Jan 2009 13:38:17 -0000      1.11
@@ -1,8 +1,19 @@
+2009-01-25  Ulf Jasper  <address@hidden>
+
+       * 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  <address@hidden>
 
        * bytecomp-testsuite.el: New file.
 
-2008-10-31  Ulf Jasper  <address@hidden>
+2008-10-31  Ulf Jasper  <address@hidden>
 
        * icalendar-testsuite.el (icalendar-testsuite--run-function-tests):
        Added `icalendar-testsuite--test-create-uid'.

Index: test/icalendar-testsuite.el
===================================================================
RCS file: /sources/emacs/emacs/test/icalendar-testsuite.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- test/icalendar-testsuite.el 8 Jan 2009 02:56:32 -0000       1.5
+++ test/icalendar-testsuite.el 25 Jan 2009 13:38:17 -0000      1.6
@@ -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
 ;; ======================================================================