[Emacs-diffs] [emacs] 02/07: alarm export, first step

[Ulf Jasper]

branch: master
commit 6f20cde0117a181159eed4a1992ed8c536d8ecce
Author: Ulf Jasper <address@hidden>
Date:   Sat Nov 15 20:54:28 2014 +0100

    alarm export, first step
---
 lisp/calendar/icalendar.el        |   68 +++++++++++++++++++++++++-----------
 test/automated/icalendar-tests.el |   15 +++++++-
 2 files changed, 60 insertions(+), 23 deletions(-)

diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index cdda8f0..e00976d 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -270,28 +270,22 @@ other sexp entries are enumerated in any case."
 (defcustom icalendar-export-alarms
   nil
   "Determine if and how alarms are included in exported diary events.
-FIXME
-... appt-display-format
-... appt-audible
-.... appt-message-warning-time
-... appt-warning-time-regexp
-"
+FIXME"
   :version "25.1"
-  :type '(choice (const :tag "Do not include alarms in export" nil)
-                 (const :tag "Apply emacs defaults FIXME" 'default)
+  :type '(choice (const :tag "Do not include alarms in export"
+                        nil)
                  (list :tag "Create alarms in exported diary entries"
                        (integer :tag "Advance time (minutes)"
-                                ;; FIXME
-                                :value appt-message-warning-time)
-                       (choice :tag "Alarm type"
-                               (list :tag "Audio"
-                                     (string :tag "Audio file"))
-                               (cons :tag "Display"
-                                     (string :tag "Description"))
-                               (list :tag "Email"
-                                     (string :tag "Description")
-                                     (string :tag "Summary")
-                                     (string :tag "Attendees")))))
+                                :value 10)
+                       (set :tag "Alarm type"
+                            (list :tag "Audio"
+                                  (const audio :tag "Audio"))
+                            (list :tag "Display"
+                                  (const display :tag "Display"))
+                            (list :tag "Email"
+                                  (const email)
+                                  (repeat :tag "Attendees"
+                                          (string :tag "Email"))))))
   :group 'icalendar)
 
 
@@ -1055,6 +1049,7 @@ FExport diary data into iCalendar file: ")
         (header "")
         (contents-n-summary)
         (contents)
+        (alarm)
         (found-error nil)
         (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
                            "?"))
@@ -1117,8 +1112,10 @@ FExport diary data into iCalendar file: ")
                         (setq header (concat "\nBEGIN:VEVENT\nUID:"
                                              (or uid
                                                  (icalendar--create-uid
-                                                  entry-full contents)))))
-                      (setq result (concat result header contents
+                                                  entry-full contents))))
+                        (setq alarm (icalendar--create-ical-alarm
+                                     (car contents-n-summary))))
+                      (setq result (concat result header contents alarm
                                            "\nEND:VEVENT")))
                     (if (consp cns-cons-or-list)
                         (list cns-cons-or-list)
@@ -1293,6 +1290,35 @@ Returns an alist."
                     (if url (cons 'url url) nil)
                     (if uid (cons 'uid uid) nil))))))))
 
+(defun icalendar--create-ical-alarm (summary)
+  (when icalendar-export-alarms
+    (let* ((advance-time (car icalendar-export-alarms))
+           (alarm-specs (cadr icalendar-export-alarms))
+           (fun (lambda (spec)
+                  (icalendar--do-create-ical-alarm advance-time spec 
summary))))
+      (mapconcat fun alarm-specs "\n"))))
+
+(defun icalendar--do-create-ical-alarm (advance-time alarm-spec summary)
+  (let* ((action (car alarm-spec))
+         (act (format "ACTION:%s\n"
+                      (cdr (assoc action '((audio . "AUDIO")
+                                           (display . "DISPLAY")
+                                           (email . "EMAIL"))))))
+         (tri (format "TRIGGER:-PT%dM\n" advance-time))
+         (des (if (memq action '(display email))
+                  (format "DESCRIPTION:%s\n" summary)
+                ""))
+         (sum (if (eq action 'email)
+                  (format "SUMMARY:%s\n" summary)
+                ""))
+         (att (if (eq action 'email)
+                  (mapconcat (lambda (i)
+                               (format "ATTENDEE:MAILTO:%s\n" i))
+                             (cadr alarm-spec) "")
+                "")))
+
+    (concat "BEGIN:VALARM\n" act tri des sum att "END:VALARM")))
+
 ;; subroutines for icalendar-export-region
 (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
   "Convert \"ordinary\" diary entry to iCalendar format.
diff --git a/test/automated/icalendar-tests.el 
b/test/automated/icalendar-tests.el
index 23afb14..3e2fecf 100644
--- a/test/automated/icalendar-tests.el
+++ b/test/automated/icalendar-tests.el
@@ -503,6 +503,15 @@ END:VEVENT
       ;; restore time-zone even if something went terribly wrong
       (setenv "TZ" tz)))  )
 
+(ert-deftest icalendar--create-ical-alarm ()
+  "Test `icalendar--create-ical-alarms'."
+  (let ((icalendar-export-alarms))
+    ;; testcase: no alarms
+    (setq icalendar-export-alarm nil)
+    (should (equal nil
+                   (icalendar--create-ical-alarm "sumsum")))))
+
+
 ;; ======================================================================
 ;; Export tests
 ;; ======================================================================
@@ -519,7 +528,8 @@ European style input data must use german month names.  
American
 and ISO style input data must use english month names."
   (let ((tz (getenv "TZ"))
        (calendar-date-style 'iso)
-       (icalendar-recurring-start-year 2000))
+       (icalendar-recurring-start-year 2000)
+        (icalendar-export-alarms nil))
     (unwind-protect
        (progn
 ;;;      (message "Current time zone: %s" (current-time-zone))
@@ -1286,7 +1296,8 @@ Argument INPUT icalendar event string."
           (icalendar-import-format-status "\n Status: %s")
           (icalendar-import-format-url "\n URL: %s")
           (icalendar-import-format-class "\n Class: %s")
-          (icalendar-import-format-class "\n UID: %s"))
+          (icalendar-import-format-class "\n UID: %s")
+          (icalendar-export-alarms nil))
       (dolist (calendar-date-style '(iso european american))
         (icalendar-tests--do-test-cycle)))))