procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow comments to organizer in icalendar event replies (Bug#72831)

Browse source 
* lisp/gnus/gnus-icalendar.el
(gnus-icalendar-event--build-reply-event-body): Add optional COMMENT
argument to be inserted into the reply.
(gnus-icalendar-event-reply-from-buffer): Add COMMENT argument to be
passed through to gnus-icalendar-event--build-reply-event-body
(gnus-icalendar-reply-accept, gnus-icalendar-reply-tentative,
gnus-icalendar-reply-decline): If interactively called with a prefix
argument ask user for a COMMENT to add to the reply.

* test/lisp/gnus/gnus-icalendar-tests.el
(gnus-icalendar-accept-with-comment,
gnus-icalendar-decline-without-changing-comment): New tests.
This commit is contained in:
fpi 2024-08-28 18:33:20 +02:00 • committed by Robert Pluim
parent 69e1aca041
commit 8332b4dd07
3 changed files with 126 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
etc/NEWS
View file

@ -139,6 +139,14 @@ exactly below the text after the prefix on the first line.
If 'whitespace-style' includes 'missing-newline-at-eof' (which is the
default), the 'whitespace-cleanup' function will now add the newline.
** Gnus
---
*** Replying to icalendar events now supports specifying a comment.
When called with a prefix argument, accepting, declining, or tentatively
accepting an icalendar event will prompt for a comment to add to the
response.
** Eshell
---

64
lisp/gnus/gnus-icalendar.el
View file

@ -309,7 +309,7 @@ status will be retrieved from the first matching attendee record."
;;; gnus-icalendar-event-reply
;;;
(defun gnus-icalendar-event--build-reply-event-body (ical-request status identities)
(defun gnus-icalendar-event--build-reply-event-body (ical-request status identities &optional comment)
(let ((summary-status (capitalize (symbol-name status)))
(attendee-status (upcase (symbol-name status)))
reply-event-lines)
@ -319,6 +319,10 @@ status will be retrieved from the first matching attendee record."
(if (string-match "^[^:]+:" line)
(replace-match (format "\\&%s: " summary-status) t nil line)
line))
(update-comment
(line)
(if comment (format "COMMENT:%s" comment)
line))
(update-dtstamp ()
(format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t))
(attendee-matches-identity
@ -341,6 +345,7 @@ status will be retrieved from the first matching attendee record."
(cond
((string= key "ATTENDEE") (update-attendee-status line))
((string= key "SUMMARY") (update-summary line))
((string= key "COMMENT") (update-comment line))
((string= key "DTSTAMP") (update-dtstamp))
((member key '("ORGANIZER" "DTSTART" "DTEND"
"LOCATION" "DURATION" "SEQUENCE"
@ -363,16 +368,27 @@ status will be retrieved from the first matching attendee record."
attendee-status user-full-name user-mail-address)
reply-event-lines))
;; add comment line if not existing
(when (and comment
(not (gnus-icalendar-find-if
(lambda (x)
(string-match "^COMMENT" x))
reply-event-lines)))
(push (format "COMMENT:%s" comment) reply-event-lines))
(mapconcat #'identity `("BEGIN:VEVENT"
,@(nreverse reply-event-lines)
"END:VEVENT")
"\n"))))
(defun gnus-icalendar-event-reply-from-buffer (buf status identities)
(defun gnus-icalendar-event-reply-from-buffer (buf status identities &optional comment)
"Build a calendar event reply for request contained in BUF.
The reply will have STATUS (`accepted', `tentative' or `declined').
The reply will be composed for attendees matching any entry
on the IDENTITIES list."
on the IDENTITIES list.
Optional argument COMMENT will be placed in the comment field of the
reply.
"
(cl-labels
((extract-block
(blockname)
@ -396,7 +412,7 @@ on the IDENTITIES list."
"PRODID:Gnus"
"VERSION:2.0"
zone
(gnus-icalendar-event--build-reply-event-body event status identities)
(gnus-icalendar-event--build-reply-event-body event status identities comment)
"END:VCALENDAR")))
(mapconcat #'identity (delq nil contents) "\n"))))))
@ -878,13 +894,13 @@ These will be used to retrieve the RSVP information from ical events."
(insert "Subject: " subject)
(message-send-and-exit))))
(defun gnus-icalendar-reply (data)
(defun gnus-icalendar-reply (data &optional comment)
(let* ((handle (car data))
(status (cadr data))
(event (caddr data))
(reply (gnus-icalendar-with-decoded-handle handle
(gnus-icalendar-event-reply-from-buffer
(current-buffer) status (gnus-icalendar-identities))))
(current-buffer) status (gnus-icalendar-identities) comment)))
(organizer (gnus-icalendar-event:organizer event)))
(when reply
@ -1009,25 +1025,37 @@ These will be used to retrieve the RSVP information from ical events."
(when data
(gnus-icalendar-save-part data))))
(defun gnus-icalendar-reply-accept ()
"Accept invitation in the current article."
(interactive nil gnus-article-mode gnus-summary-mode)
(defun gnus-icalendar-reply-accept (&optional comment-p)
"Accept invitation in the current article.
Optional argument COMMENT-P non-nil (interactively `\\[universal-argument]')
means prompt for a comment to include in the reply."
(interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event))
(gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event)
(when comment-p (read-string "Comment: ")))
(setq-local gnus-icalendar-reply-status 'accepted)))
(defun gnus-icalendar-reply-tentative ()
"Send tentative response to invitation in the current article."
(interactive nil gnus-article-mode gnus-summary-mode)
(defun gnus-icalendar-reply-tentative (&optional comment-p)
"Send tentative response to invitation in the current article.
Optional argument COMMENT-P non-nil (interactively `\\[universal-argument]')
means prompt for a comment to include in the reply."
(interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event))
(gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event)
(when comment-p (read-string "Comment: ")))
(setq-local gnus-icalendar-reply-status 'tentative)))
(defun gnus-icalendar-reply-decline ()
"Decline invitation in the current article."
(interactive nil gnus-article-mode gnus-summary-mode)
(defun gnus-icalendar-reply-decline (&optional comment-p)
"Decline invitation in the current article.
Optional argument COMMENT-P non-nil (interactively `\\[universal-argument]')
means prompt for a comment to include in the reply."
(interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event))
(gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event)
(when comment-p (read-string "Comment: ")))
(setq-local gnus-icalendar-reply-status 'declined)))
(defun gnus-icalendar-event-export ()

72
test/lisp/gnus/gnus-icalendar-tests.el
View file

@ -255,5 +255,77 @@ END:VCALENDAR" (list "participant@anoncompany.com"))))
<2020-09-21 14:00-14:30 +1w>")))
(setenv "TZ" tz))))
(ert-deftest gnus-icalendar-accept-with-comment ()
""
(let ((event "BEGIN:VEVENT
DTSTART;TZID=Europe/Berlin:20200915T140000
DTEND;TZID=Europe/Berlin:20200915T143000
RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE
DTSTAMP:20200915T120627Z
ORGANIZER;CN=anon@anoncompany.com:mailto:anon@anoncompany.com
UID:7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com
ATTENDEE;CUTYPE=INDIVIDUAL;PARTSTAT=NEEDS-ACTION;RSVP=TRUE
;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com
CREATED:20200325T095723Z
DESCRIPTION:Coffee talk
LAST-MODIFIED:20200915T120623Z
LOCATION:
SEQUENCE:0
STATUS:CONFIRMED
SUMMARY:Casual coffee talk
TRANSP:OPAQUE
END:VEVENT")
(icalendar-identities '("participant@anoncompany.com")))
(unwind-protect
(progn
(let* ((reply (with-temp-buffer
(insert event)
(gnus-icalendar-event-reply-from-buffer
(current-buffer)
'accepted
icalendar-identities
"Can not stay long."))))
(should (string-match "^ATTENDEE;.*?\\(PARTSTAT=[^;]+\\)" reply))
(should (string-equal (match-string 1 reply) "PARTSTAT=ACCEPTED"))
(should (string-match "^COMMENT:\\(.*\\)$" reply))
(should (string-equal (match-string 1 reply) "Can not stay long.")))))))
(ert-deftest gnus-icalendar-decline-without-changing-comment ()
""
(let ((event "BEGIN:VEVENT
DTSTART;TZID=Europe/Berlin:20200915T140000
DTEND;TZID=Europe/Berlin:20200915T143000
RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE
DTSTAMP:20200915T120627Z
ORGANIZER;CN=anon@anoncompany.com:mailto:anon@anoncompany.com
UID:7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com
ATTENDEE;CUTYPE=INDIVIDUAL;PARTSTAT=NEEDS-ACTION;RSVP=TRUE
;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com
CREATED:20200325T095723Z
DESCRIPTION:Coffee talk
LAST-MODIFIED:20200915T120623Z
COMMENT:Only available at 2pm
LOCATION:
SEQUENCE:0
STATUS:CONFIRMED
SUMMARY:Casual coffee talk
TRANSP:OPAQUE
END:VEVENT")
(icalendar-identities '("participant@anoncompany.com")))
(unwind-protect
(progn
(let* ((reply (with-temp-buffer
(insert event)
(gnus-icalendar-event-reply-from-buffer
(current-buffer)
'declined
icalendar-identities
nil))))
(should (string-match "^ATTENDEE;.*?\\(PARTSTAT=[^;]+\\)" reply))
(should (string-equal (match-string 1 reply) "PARTSTAT=DECLINED"))
(should (string-match "^COMMENT:\\(.*\\)$" reply))
(should (string-equal (match-string 1 reply) "Only available at 2pm"))
)))))
(provide 'gnus-icalendar-tests)
;;; gnus-icalendar-tests.el ends here