Function: gnus-icalendar-event-from-ical

gnus-icalendar-event-from-ical is a byte-compiled function defined in gnus-icalendar.el.gz.

Signature

(gnus-icalendar-event-from-ical ICAL &optional ATTENDEE-NAME-OR-EMAIL)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-icalendar.el.gz
(defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email)
  (let* ((event (car (icalendar--all-events ical)))
         (organizer (replace-regexp-in-string
                     "^.*MAILTO:" ""
                     (or (icalendar--get-event-property event 'ORGANIZER) "")))
         (prop-map '((summary . SUMMARY)
                     (description . DESCRIPTION)
                     (location . LOCATION)
                     (recur . RRULE)
                     (uid . UID)))
         (method (caddr (assoc 'METHOD (caddr (car (nreverse ical))))))
         (attendee (when attendee-name-or-email
                     (gnus-icalendar-event--find-attendee
                      ical attendee-name-or-email)))
         (attendee-names (gnus-icalendar-event--get-attendee-names ical))
         ;; RFC5546: default ROLE is REQ-PARTICIPANT
         (role (and attendee
                    (or (plist-get (cadr attendee) 'ROLE)
                        "REQ-PARTICIPANT")))
         (participation-type (pcase role
                               ("REQ-PARTICIPANT" 'required)
                               ("OPT-PARTICIPANT" 'optional)
                               (_                 'non-participant)))
         (zone-map (icalendar--convert-all-timezones ical))
         (args
          (list :method method
                :organizer organizer
                :start-time (gnus-icalendar-event--decode-datefield
                             event 'DTSTART zone-map)
                :end-time (gnus-icalendar-event--decode-datefield
                           event 'DTEND zone-map)
                :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE")
                :participation-type participation-type
                :req-participants (car attendee-names)
                :opt-participants (cadr attendee-names)))
         (event-class
          (cond
           ((string= method "REQUEST") 'gnus-icalendar-event-request)
           ((string= method "CANCEL") 'gnus-icalendar-event-cancel)
           ((string= method "REPLY") 'gnus-icalendar-event-reply)
           (t 'gnus-icalendar-event))))
    (cl-labels
	((map-property
	  (prop)
	  (let ((value (icalendar--get-event-property event prop)))
	    (when value
	      ;; ugly, but cannot get
	      ;;replace-regexp-in-string work with "\\" as
	      ;;REP, plus we should also handle "\\;"
	      (string-replace
	       "\\," ","
	       (string-replace
		"\\n" "\n" (substring-no-properties value))))))
	 (accumulate-args
	  (mapping)
	  (cl-destructuring-bind (slot . ical-property) mapping
	    (setq args (append (list
				(intern (concat ":" (symbol-name slot)))
				(map-property ical-property))
			       args)))))
      (mapc #'accumulate-args prop-map)
      (apply
       #'make-instance
       event-class
       (cl-loop for slot in (eieio-class-slots event-class)
		for keyword = (intern
			       (format ":%s" (eieio-slot-descriptor-name slot)))
		when (plist-member args keyword)
		append (list keyword
                             (if (eq keyword :uid)
                                 ;; The UID has to be a string.
                                 (or (plist-get args keyword) "")
                               (plist-get args keyword))))))))