From c20c43146a286a02b0ef5621a8d194cc6c0bb1e0 Mon Sep 17 00:00:00 2001 From: fpi Date: Sun, 15 Sep 2024 17:51:26 +0200 Subject: Initial version --- gnus-icalendar-request.el | 238 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 238 insertions(+) create mode 100644 gnus-icalendar-request.el diff --git a/gnus-icalendar-request.el b/gnus-icalendar-request.el new file mode 100644 index 0000000..d57249f --- /dev/null +++ b/gnus-icalendar-request.el @@ -0,0 +1,238 @@ +;;; gnus-icalendar-request.el --- Create icalendar events -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Ferdinand Pieper + +;; Author: Ferdinand Pieper +;; Keywords: mail, icalendar + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Functions to create icalendar events to be sent out to other +;; people. + +;;; Code: + +(require 'gnus-icalendar) + +(defun gnus-icalendar-event--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-event--create-attendee-list (req opt) + (concat + (mapconcat (lambda (req) (gnus-icalendar-event--format-attendee req "req")) req "\n") + (when opt + "\n" + (mapconcat (lambda (opt) (gnus-icalendar-event--format-attendee opt "opt")) opt "\n")))) + +(defun gnus-icalendar-event--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 + (summary (format "SUMMARY:%s" summary)) + (description (when (and (stringp description) (not (string-empty-p description))) + (format "DESCRIPTION:%s" + (with-temp-buffer + (insert description) + (beginning-of-buffer) + (while (re-search-forward "\n" nil t) + (replace-match "\\n" t t)) + (buffer-string))))) ;; TODO: How to do this properly? + (dtstart (format-time-string "DTSTART:%Y%m%dT%H%M%SZ" start-time t)) ;; start-time in UTC + (dtend (format-time-string "DTEND:%Y%m%dT%H%M%SZ" end-time t)) ;; end-time in UTC + (attendee (gnus-icalendar-event--create-attendee-list req-participants opt-participants)) + (location (when (and (stringp location) (not (string-empty-p location))) + (format "LOCATION:%s" location))) + (organizer (format "ORGANIZER:mailto:%s" organizer)) + (uid (format "UID:%s" uid)) + (sequence "SEQUENCE:0") ;; TODO: Consider follow-up event modifications. + ;; TODO: handle recur + ) + (with-temp-buffer + (insert + (mapconcat #'identity + (list "BEGIN:VEVENT" + dtstamp + dtstart + dtend + summary + description + attendee + location + organizer + uid + sequence + "END:VEVENT") "\n")) + (flush-lines "^$" (point-min) (point-max)) + (buffer-string))))) + +;; Vcalendar creation + +;; I have not yet found a good way to create vtimezone accurately from +;; scratch. For now hardcoded for CET/CEST and crude general +;; implementation below. +(defvar gnus-icalendar-vtimezone-times + '(CEST "BEGIN:DAYLIGHT +TZOFFSETFROM:+0100 +TZOFFSETTO:+0200 +TZNAME:CEST +DTSTART:19700329T020000 +RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=3 +END:DAYLIGHT +BEGIN:STANDARD +TZOFFSETFROM:+0200 +TZOFFSETTO:+0100 +TZNAME:CET +DTSTART:19701025T030000 +RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=10 +END:STANDARD" + CET "BEGIN:DAYLIGHT +TZOFFSETFROM:+0100 +TZOFFSETTO:+0200 +TZNAME:CEST +DTSTART:19700329T020000 +RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=3 +END:DAYLIGHT +BEGIN:STANDARD +TZOFFSETFROM:+0200 +TZOFFSETTO:+0100 +TZNAME:CET +DTSTART:19701025T030000 +RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=10 +END:STANDARD") + "Timezone information about standard and daylight savings time used in VCALENDAR parts.") + +(defun gnus-icalendar--default-vtimezone (&optional zone) + "Return default VTIMEZONE information for the current time zone or ZONE if provided." + (let ((time-zone (current-time-zone nil zone))) + (format "BEGIN:STANDARD +DTSTART:%s +TZOFFSETTO:%s +TZOFFSETFROM:+0000 +TZNAME:%s +END:STANDARD" + (format-time-string "%Y%m%dT%H%M%S" 0) ;; set effective timezone start date to epoch + (format-time-string "%z" (current-time) time-zone) ;; time zone offset + (cadr time-zone) + ))) + +(defun gnus-icalendar--build-vcalendar-from-vevent (event) + "Create VCALENDAR part with VEVENT part EVENT." + (let* ((time-zone (cadr (current-time-zone))) + (vtimezone (mapconcat #'identity `("BEGIN:VTIMEZONE" + ,(format "TZID:%s" time-zone) + ,(or (plist-get gnus-icalendar-vtimezone-times (intern time-zone)) + (gnus-icalendar--default-vtimezone)) + "END:VTIMEZONE") "\n"))) + (mapconcat #'identity `("BEGIN:VCALENDAR" + "PRODID:Gnus" + "VERSION:2.0" + "METHOD:REQUEST" + ,vtimezone + ,event + "END:VCALENDAR") "\n"))) + +(defun gnus-icalendar-event-message-insert-request (event) + "Insert text/calendar part into message with request for VEVENT + specified in EVENT." + (when (provided-mode-derived-p major-mode 'message-mode) + (mml-insert-part "text/calendar; method=\"REQUEST\"; charset=UTF-8") + (insert (gnus-icalendar--build-vcalendar-from-vevent + (gnus-icalendar-event--ical-from-event event))))) + +(defun gnus-icalendar-event-from-message-and-insert (&optional date location) + "Create a event request based on the current message. + +Direct recipients of the message (in To header) are interpreted +as required participants. Recipients in Cc are optional +participants. The From header is always converted to the event +organizer. Message subject is interpreted as summary and message +body (if existant) as description. Time and date of the event can +be provided as org formatted date range (only with time for now) +or will be asked for if nil. Same for location." + (interactive) + (if (not message-draft-article) ;; internally set by message-mode + (message "Not in a message draft") + (unless (or date (featurep 'org)) + (error "Timestamp creation requires org. Please load org or provide a org-styled date range")) + (message-check-recipients) ;; check for bogus recipients + (let* ((date (or date + (with-temp-buffer + (org-time-stamp nil) + (buffer-string)))) + (start-time (org-timestamp-to-time + (org-timestamp-from-string date) nil)) + (end-time (org-timestamp-to-time ;; set end-time if input was a time-range + (org-timestamp-from-string date) t)) + (end-time (if (equal end-time start-time) ;; ask for end-time if previous input was not a range + (org-read-date nil t nil "End time:" start-time) + end-time)) + ;; TODO: better differentiate date-time ranges and date (whole-day) ranges + (uid (if (featurep 'org-id) + (org-id-uuid) + (format "%s@%s" + (number-to-string (abs (random))) + (md5 (format "%s%s%s%s" + (emacs-pid) + user-full-name + user-mail-address + (system-name)))))) + (recur nil) ;; TODO + (location (or location (read-string "Event location: "))) + (description (when (message-goto-body) + (buffer-substring (point) (point-max)))) + (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 " addresses + (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"))))) + (event (gnus-icalendar-event-request :uid uid + :recur recur + :location location + :description description + :summary summary + :method "REQUEST" + :organizer organizer + :start-time start-time + :end-time end-time + :rsvp rsvp + :participation-type participation-type + :req-participants req-participants + :opt-participants opt-participants))) + (message-goto-body) + (delete-region (point) (point-max)) + (when (not (string-empty-p description)) + (mml-insert-multipart "mixed") + (mml-insert-part "text/plain") + (insert description "\n") + (re-search-forward "<#/part>\n")) + (gnus-icalendar-event-message-insert-request event)))) + +(provide 'gnus-icalendar-request) +;;; gnus-icalendar-request.el ends here -- cgit v1.2.3