4 files changed, 178 insertions, 5 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c30a2dd9b4d..b232210f3c7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2014-11-17  Ulf Jasper  <ulf.jasper@web.de>
+
+        * calendar/icalendar.el (icalendar-export-alarms): New
+        customizable variable.
+        (icalendar-export-region): Export alarms as specified in
+        `icalendar-export-alarms'.
+        (icalendar--create-ical-alarm, icalendar--do-create-ical-alarm):
+        New functions for exporting alarms.
+
 2014-11-17  Paul Eggert  <eggert@cs.ucla.edu>
 
         Port new time stamp handling to old Emacs and to XEmacs.
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 9dba6ff2dcf..0bd126d9520 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -267,6 +267,28 @@ other sexp entries are enumerated in any case."
   :type 'boolean
   :group 'icalendar)
 
+
+(defcustom icalendar-export-alarms
+  nil
+  "Determine if and how alarms are included in exported diary events."
+  :version "25.1"
+  :type '(choice (const :tag "Do not include alarms in export"
+                        nil)
+                 (list :tag "Create alarms in exported diary entries"
+                       (integer :tag "Advance time (minutes)"
+                                :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)
+
+
 (defvar icalendar-debug nil
   "Enable icalendar debug messages.")
 
@@ -1026,6 +1048,7 @@ FExport diary data into iCalendar file: ")
         (header "")
         (contents-n-summary)
         (contents)
+        (alarm)
         (found-error nil)
         (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
                            "?"))
@@ -1088,8 +1111,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
+                                     (cdr contents-n-summary))))
+                      (setq result (concat result header contents alarm
                                            "\nEND:VEVENT")))
                     (if (consp cns-cons-or-list)
                         (list cns-cons-or-list)
@@ -1264,6 +1289,43 @@ Returns an alist."
                     (if url (cons 'url url) nil)
                     (if uid (cons 'uid uid) nil))))))))
 
+(defun icalendar--create-ical-alarm (summary)
+  "Return VALARM blocks for the given 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 ""))))
+
+(defun icalendar--do-create-ical-alarm (advance-time alarm-spec summary)
+  "Return a VALARM block.
+Argument ADVANCE-TIME is a number giving the time when the alarm
+fires (minutes before the respective event).  Argument ALARM-SPEC
+is a list which must be one of '(audio), '(display) or
+'(email (ADDRESS1 ...)), see `icalendar-export-alarms'.  Argument
+SUMMARY is a string which contains a short description for the
+alarm."
+  (let* ((action (car alarm-spec))
+         (act (format "\nACTION:%s"
+                      (cdr (assoc action '((audio . "AUDIO")
+                                           (display . "DISPLAY")
+                                           (email . "EMAIL"))))))
+         (tri (format "\nTRIGGER:-PT%dM" advance-time))
+         (des (if (memq action '(display email))
+                  (format "\nDESCRIPTION:%s" summary)
+                ""))
+         (sum (if (eq action 'email)
+                  (format "\nSUMMARY:%s" summary)
+                ""))
+         (att (if (eq action 'email)
+                  (mapconcat (lambda (i)
+                               (format "\nATTENDEE:MAILTO:%s" i))
+                             (cadr alarm-spec) "")
+                "")))
+
+    (concat "\nBEGIN:VALARM" act tri des sum att "\nEND: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/ChangeLog b/test/ChangeLog
index 47bbfb36a10..6e350cf8ec1 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,13 @@
 2014-11-17  Ulf Jasper  <ulf.jasper@web.de>
 
+        * automated/icalendar-tests.el (icalendar-tests--test-export): New
+        optional parameter `alarms'.
+        (icalendar-export-alarms): New test for exporting icalendar
+        alarms.
+        (icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil.
+
+2014-11-17  Ulf Jasper  <ulf.jasper@web.de>
+
         * automated/icalendar-tests.el (icalendar-tests--test-import):
         Mention timezone in doc string.  Clean up.
         (icalendar-real-world): Add another test case for no-dst
diff --git a/test/automated/icalendar-tests.el b/test/automated/icalendar-tests.el
index b45806e9777..54546722c8c 100644
--- a/test/automated/icalendar-tests.el
+++ b/test/automated/icalendar-tests.el
@@ -508,18 +508,20 @@ END:VEVENT
 ;; ======================================================================
 
 (defun icalendar-tests--test-export (input-iso input-european input-american
-                                               expected-output)
+                                               expected-output &optional alarms)
   "Perform an export test.
 Argument INPUT-ISO iso style diary string.
 Argument INPUT-EUROPEAN european style diary string.
 Argument INPUT-AMERICAN american style diary string.
 Argument EXPECTED-OUTPUT expected iCalendar result string.
+Optional argument ALARMS the value of `icalendar-export-alarms' for this test.
 
 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 alarms))
     (unwind-protect
         (progn
 ;;;       (message "Current time zone: %s" (current-time-zone))
@@ -753,6 +755,97 @@ RRULE:FREQ=DAILY;INTERVAL=1;UNTIL=20010706
 SUMMARY:block no end time
 "))
 
+(ert-deftest icalendar-export-alarms ()
+  "Perform export test with different settings for exporting alarms."
+  ;; no alarm
+  (icalendar-tests--test-export
+   "2014 Nov 17 19:30 no alarm"
+   "17 Nov 2014 19:30 no alarm"
+   "Nov 17 2014 19:30 no alarm"
+   "DTSTART;VALUE=DATE-TIME:20141117T193000
+DTEND;VALUE=DATE-TIME:20141117T203000
+SUMMARY:no alarm
+"
+   nil)
+
+    ;; 10 minutes in advance, audio
+    (icalendar-tests--test-export
+     "2014 Nov 17 19:30 audio alarm"
+     "17 Nov 2014 19:30 audio alarm"
+     "Nov 17 2014 19:30 audio alarm"
+     "DTSTART;VALUE=DATE-TIME:20141117T193000
+DTEND;VALUE=DATE-TIME:20141117T203000
+SUMMARY:audio alarm
+BEGIN:VALARM
+ACTION:AUDIO
+TRIGGER:-PT10M
+END:VALARM
+"
+     '(10 ((audio))))
+
+    ;; 20 minutes in advance, display
+    (icalendar-tests--test-export
+     "2014 Nov 17 19:30 display alarm"
+     "17 Nov 2014 19:30 display alarm"
+     "Nov 17 2014 19:30 display alarm"
+     "DTSTART;VALUE=DATE-TIME:20141117T193000
+DTEND;VALUE=DATE-TIME:20141117T203000
+SUMMARY:display alarm
+BEGIN:VALARM
+ACTION:DISPLAY
+TRIGGER:-PT20M
+DESCRIPTION:display alarm
+END:VALARM
+"
+     '(20 ((display))))
+
+    ;; 66 minutes in advance, email
+    (icalendar-tests--test-export
+     "2014 Nov 17 19:30 email alarm"
+     "17 Nov 2014 19:30 email alarm"
+     "Nov 17 2014 19:30 email alarm"
+     "DTSTART;VALUE=DATE-TIME:20141117T193000
+DTEND;VALUE=DATE-TIME:20141117T203000
+SUMMARY:email alarm
+BEGIN:VALARM
+ACTION:EMAIL
+TRIGGER:-PT66M
+DESCRIPTION:email alarm
+SUMMARY:email alarm
+ATTENDEE:MAILTO:att.one@email.com
+ATTENDEE:MAILTO:att.two@email.com
+END:VALARM
+"
+     '(66 ((email ("att.one@email.com" "att.two@email.com")))))
+
+    ;; 2 minutes in advance, all alarms
+    (icalendar-tests--test-export
+     "2014 Nov 17 19:30 all alarms"
+     "17 Nov 2014 19:30 all alarms"
+     "Nov 17 2014 19:30 all alarms"
+     "DTSTART;VALUE=DATE-TIME:20141117T193000
+DTEND;VALUE=DATE-TIME:20141117T203000
+SUMMARY:all alarms
+BEGIN:VALARM
+ACTION:EMAIL
+TRIGGER:-PT2M
+DESCRIPTION:all alarms
+SUMMARY:all alarms
+ATTENDEE:MAILTO:att.one@email.com
+ATTENDEE:MAILTO:att.two@email.com
+END:VALARM
+BEGIN:VALARM
+ACTION:AUDIO
+TRIGGER:-PT2M
+END:VALARM
+BEGIN:VALARM
+ACTION:DISPLAY
+TRIGGER:-PT2M
+DESCRIPTION:all alarms
+END:VALARM
+"
+     '(2 ((email ("att.one@email.com" "att.two@email.com")) (audio) (display)))))
+
 ;; ======================================================================
 ;; Import tests
 ;; ======================================================================
@@ -1285,7 +1378,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)))))