[Emacs-diffs] /srv/bzr/emacs/trunk r104028: Applied icalendar patches from Niels Giesen.

[Ulf Jasper]

------------------------------------------------------------
revno: 104028
committer: Ulf Jasper <address@hidden>
branch nick: trunk
timestamp: Wed 2011-04-27 19:48:35 +0200
message:
  Applied icalendar patches from Niels Giesen.
  
  lisp/ChangeLog:
  
  2011-04-27  Niels Giesen <address@hidden>
  
        * calendar/icalendar.el (diary-lib): Added require statement.
        (icalendar--create-uid): Read out a uid from a text-property on
        the first character in the entry. This allows for code to add its
        own uid to the entry.
        (icalendar--convert-float-to-ical): Add export of
        `diary-float'-entries save for those with the optional DAY
modified:
  lisp/ChangeLog
  lisp/calendar/icalendar.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-04-27 07:56:55 +0000
+++ b/lisp/ChangeLog    2011-04-27 17:48:35 +0000
@@ -1,3 +1,13 @@
+2011-04-27  Niels Giesen <address@hidden>
+
+       * calendar/icalendar.el (diary-lib): Added require statement.
+       (icalendar--create-uid): Read out a uid from a text-property on
+       the first character in the entry. This allows for code to add its
+       own uid to the entry.
+       (icalendar--convert-float-to-ical): Add export of
+       `diary-float'-entries save for those with the optional DAY
+       argument.
+
 2011-04-27  Daniel Colascione  <address@hidden>
 
        * subr.el (shell-quote-argument): Use alternate escaping strategy

=== modified file 'lisp/calendar/icalendar.el'
--- a/lisp/calendar/icalendar.el        2011-01-26 08:36:39 +0000
+++ b/lisp/calendar/icalendar.el        2011-04-27 17:48:35 +0000
@@ -34,6 +34,8 @@
 ;;   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:
 
@@ -241,6 +243,7 @@
 ;; all the other libs we need
 ;; ======================================================================
 (require 'calendar)
+(require 'diary-lib)
 
 ;; ======================================================================
 ;; misc
@@ -925,27 +928,30 @@
 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))
@@ -1545,18 +1551,65 @@
     nil))
 
 (defun icalendar--convert-float-to-ical (nonmarker entry-main)
-  "Convert float diary entry to icalendar format -- unsupported!
-
-FIXME!
-
-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"))
+  "Convert float diary entry to icalendar format -- partially unsupported!
+  
+  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 .+\\) ?$") 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))