New mapping of message mail adresses to icalendar values

2 files changed, 60 insertions, 39 deletions

diff --git a/README.org b/README.org
index 6cebc33..a568b6b 100644
--- a/README.org
+++ b/README.org
@@ -16,6 +16,6 @@ Extension of gnus-icalendar to format icalendar event requests based on [[https:
 
 ** Code TODOs
 - [X] Cleanup description creation
-- [ ] Check attendee capturing from email ~From~ header.
+- [X] Check attendee capturing from email ~From~ header.
 - [ ] Based on insertion method remove the multipart section or switch ~multipart/alternative~ if ~text/plain~ contains the same data as the ~text/calendar~ part.
-- [ ] Split default attendee line format into a ~defvar~ in ~gnus-icalendar--format-attendee~.
+- [X] +Split default attendee line format into a ~defvar~ in ~gnus-icalendar--format-attendee~.+
diff --git a/gnus-icalendar-request.el b/gnus-icalendar-request.el
index 4711be1..b7e9613 100644
--- a/gnus-icalendar-request.el
+++ b/gnus-icalendar-request.el
@@ -27,26 +27,6 @@
 
 (require 'gnus-icalendar)
 
-(defun gnus-icalendar--format-attendee (attendee role)
-  (when (member role '("req" "opt"))
-    (format "ATTENDEE;PARTSTAT=NEEDS-ACTION;ROLE=%s-PARTICIPANT;RSVP=TRUE:mailto:%s" (upcase role) attendee)))
-
-(defun gnus-icalendar--create-attendee-list (req &optional opt role)
-  "Format a list of event attendees.
-
-REQ is a list of required attendees emails, OPT of optional
-attendees and ROLE can be used to override the REQ attendees
-role."
-  (concat
-   (when req
-     (mapconcat
-      (lambda (req) (gnus-icalendar--format-attendee req (or role "req")))
-      req "\n"))
-   (when opt
-     (concat
-      "\n"
-      (gnus-icalendar--create-attendee-list opt nil "opt")))))
-
 (defun gnus-icalendar--ical-from-event (event)
   (with-slots (summary description location organizer recur uid start-time end-time req-participants opt-participants) event
     (let ((dtstamp (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) ;; current UTC time
@@ -57,10 +37,15 @@ role."
                                  (string-replace "\n" "\\n" description))))
           (dtstart (format-time-string "DTSTART:%Y%m%dT%H%M%SZ" start-time t)) ;; in UTC -> suffix "Z"
           (dtend (format-time-string "DTEND:%Y%m%dT%H%M%SZ" end-time t))
-          (attendee (gnus-icalendar--create-attendee-list req-participants opt-participants))
+          (attendee (mapconcat
+                     (lambda (p)
+                       (format "ATTENDEE%s"
+                               (gnus-icalendar--format-ical-property-parameters p)))
+                     (append req-participants opt-participants)
+                     "\n"))
           (location (when (and (stringp location) (not (string-empty-p location)))
                       (format "LOCATION:%s" location)))
-          (organizer (format "ORGANIZER:mailto:%s" organizer))
+          (organizer (format "ORGANIZER%s" organizer))
           (uid (format "UID:%s" uid))
           (sequence "SEQUENCE:0") ;; TODO: Consider follow-up event modifications.
           ;; TODO: handle recur
@@ -102,6 +87,28 @@ role."
     (insert (gnus-icalendar--build-vcalendar-from-vevent
              (gnus-icalendar--ical-from-event event)))))
 
+(defun gnus-icalendar--format-ical-property-parameters (item)
+  "Format a cons ITEM according to RFC5545 rules.
+
+Car of ITEM is the value and the cdr is an alist of additional
+property parameters attached to the value."
+  (format "%s:%s"
+          (seq-reduce
+           (lambda (a b) (format "%s;%s=%s" a (car b) (cdr b)))
+           (cdr item) "")
+          (car item)))
+
+(defun gnus-icalendar--parse-message-email-to-alist (entry &optional alist)
+  "Parse a (mail . name) cons ENTRY as returned by
+ `mail-header-parse-addresses'.
+
+Optional argument ALIST specifies will be appended to the entry."
+  (cons (format "mailto:%s" (car entry))
+        (append
+         alist
+         (when (cdr entry)
+           `((CN . ,(cdr entry)))))))
+
 ;;;###autoload
 (defun gnus-icalendar-from-message-and-insert (&optional date location)
   "Create a event request based on the current message.
@@ -138,22 +145,36 @@ or will be asked for if nil. Same for location."
            (summary (save-restriction
                       (message-narrow-to-headers)
                       (message-fetch-field "Subject")))
-           (organizer (caar (mail-header-parse-addresses
-                            (save-restriction
-                              (message-narrow-to-headers)
-                              (message-fetch-field "From"))))) ;; TODO insert common name for "name <mail@address.net>" addresses
+           (organizer (gnus-icalendar--format-ical-property-parameters
+                       (gnus-icalendar--parse-message-email-to-alist
+                        (car (mail-header-parse-addresses
+                              (save-restriction
+                                (message-narrow-to-headers)
+                                (message-fetch-field "From")))))))
            (rsvp nil) ;; TODO
-           (participation-type 'non-participant) ;; TODO
-           (req-participants (mapcar #'car
-                                     (mail-header-parse-addresses
-                                      (save-restriction
-                                        (message-narrow-to-headers)
-                                        (message-fetch-field "To")))))
-           (opt-participants (mapcar #'car
-                                     (mail-header-parse-addresses
-                                      (save-restriction
-                                        (message-narrow-to-headers)
-                                        (message-fetch-field "Cc")))))
+           (participation-type 'non-participant)
+           (req-participants
+            (mapcar (lambda (entry)
+                      (gnus-icalendar--parse-message-email-to-alist
+                       entry
+                       '((PARTSTAT . "NEEDS-ACTION")
+                         (ROLE . "REQ-PARTICIPANT")
+                         (RSVP . "TRUE"))))
+                    (mail-header-parse-addresses
+                     (save-restriction
+                       (message-narrow-to-headers)
+                       (message-fetch-field "To")))))
+           (opt-participants
+            (mapcar (lambda (entry)
+                      (gnus-icalendar--parse-message-email-to-alist
+                       entry
+                       '((PARTSTAT . "NEEDS-ACTION")
+                         (ROLE . "OPT-PARTICIPANT")
+                         (RSVP . "TRUE"))))
+                    (mail-header-parse-addresses
+                     (save-restriction
+                       (message-narrow-to-headers)
+                       (message-fetch-field "Cc")))))
            (uid (icalendar--create-uid (format "%s%s%s%s"
                                                summary
                                                description