From 6f20cde0117a181159eed4a1992ed8c536d8ecce Mon Sep 17 00:00:00 2001 From: Ulf Jasper Date: Sat, 15 Nov 2014 20:54:28 +0100 Subject: [PATCH] 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 cdda8f0fba2..e00976da349 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 23afb14792d..3e2fecff1cd 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))))) -- 2.39.5