diff options
Diffstat (limited to 'varuga.el')
| -rw-r--r-- | varuga.el | 181 |
1 files changed, 181 insertions, 0 deletions
diff --git a/varuga.el b/varuga.el new file mode 100644 index 0000000..d17e1aa --- /dev/null +++ b/varuga.el @@ -0,0 +1,181 @@ +;;; varuga.el --- Send ical calendar invites by email -*- lexical-binding: t -*- + +;; Send ical calendar invites by email +;; Copyright © 2024 by Arun I +;; +;; Author: Arun Isaac <arunisaac@systemreboot.net> +;; Version: 0.1.0 +;; Homepage: https://git.systemreboot.net/varuga +;; Package-Requires: ((emacs "26.1")) + +;; This file is part of varuga. + +;; varuga 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. + +;; varuga 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 varuga. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Send ical calendar invites using your Emacs mail client. These +;; invites are similar to those produced by Google Calendar, Outlook +;; Calendar, etc. and are compatible with them. +;; +;; varuga populates a message mode buffer with an ical MIME part +;; (using MML, the MIME Meta Language). It also adds a plain text +;; part listing the time of the event in various configured timezones. + +;;; Code: + +(require 'cl-lib) +(require 'message) +(require 'org) +(require 'org-duration) +(require 'org-id) +(require 'time) + +(cl-defstruct (varuga-calendar (:constructor varuga-calendar) + (:copier nil)) + components) + +(cl-defstruct (varuga-calendar-event (:constructor varuga-calendar-event) + (:copier nil)) + organizer + organizer-email-address + time-start + time-end + summary + location) + +(defvar varuga-product-identifier + "-//systemreboot//varuga//NONSGML v1.0//EN") + +(defvar varuga-clock-list + (if (listp world-clock-list) + world-clock-list + zoneinfo-style-world-list)) + +(defvar varuga-time-format + world-clock-time-format) + +(defun varuga-insert-calendar-line (key value) + "Insert ical calendar line. +KEY is the name of the ical property and VALUE is its value." + ;; Limit content line length to 75 octets as required by RFC 5545. + (let ((maximum-octets-per-line 75) + (octets-so-far 0)) + (seq-do (lambda (c) + (let* (;; Escape the linefeed character. + (str (if (eql c ?\n) + "\\N" + (string c))) + (next-octets (+ octets-so-far + (string-bytes str)))) + (if (< next-octets maximum-octets-per-line) + (progn + (insert str) + (setq octets-so-far next-octets)) + (progn + (insert "\r\n ") + ;; Set octets so far to 1 to account for the + ;; folding space. + (setq octets-so-far 1))))) + (format "%s:%s" + (upcase (symbol-name key)) + value))) + (insert "\r\n")) + +(defun varuga-format-time-string (time) + "Format TIME to ical specification." + (format-time-string "%Y%m%dT%H%M%SZ" time t)) + +(defun varuga-insert-calendar-event (event) + "Insert ical calendar EVENT at point." + (varuga-insert-calendar-line 'begin "VEVENT") + (varuga-insert-calendar-line 'uid (org-id-uuid)) + (varuga-insert-calendar-line 'organizer + (format "CN=%s:MAILTO:%s" + (varuga-calendar-event-organizer event) + (varuga-calendar-event-organizer-email-address event))) + (varuga-insert-calendar-line 'dtstart + (varuga-format-time-string + (varuga-calendar-event-time-start event))) + (varuga-insert-calendar-line 'dtend + (varuga-format-time-string + (varuga-calendar-event-time-end event))) + (varuga-insert-calendar-line 'summary + (varuga-calendar-event-summary event)) + (varuga-insert-calendar-line 'location + (varuga-calendar-event-location event)) + (varuga-insert-calendar-line 'end "VEVENT")) + +(defun varuga-insert-calendar (calendar) + "Insert ical CALENDAR at point." + (varuga-insert-calendar-line 'begin "VCALENDAR") + (varuga-insert-calendar-line 'version "2.0") + (varuga-insert-calendar-line 'prodid varuga-product-identifier) + (seq-do 'varuga-insert-calendar-event + (varuga-calendar-components calendar)) + (varuga-insert-calendar-line 'end "VCALENDAR")) + +(defun varuga-invite (summary location when duration) + "Insert calendar invitation into current email message buffer. +SUMMARY is a short description of the event. LOCATION is the +location of the event (typically a URI for online meetings). +WHEN is the encoded time when the event is scheduled. DURATION +is the length of the event in minutes." + (interactive (list (read-string "Event Summary: ") + (read-string "Location: ") + (org-read-date t t nil "When?") + (org-duration-to-minutes + (read-string "Duration: ")))) + (save-excursion + ;; Fill Subject header. + (save-restriction + (message-narrow-to-headers) + (re-search-forward "^Subject:") + (message-narrow-to-field) + (end-of-line) + ;; TODO: Allow customization of the Subject format. + (insert (format "Invitation: %s" summary))) + ;; Fill email body. + (goto-char (point-max)) + (insert "<#multipart type=mixed>\n") + ;; Add human-readable time in configured timezones. TODO: Allow + ;; customization of this format. + (insert "<#part type=text/plain>\n\n") + (seq-do (pcase-lambda (`(,zone ,place)) + (insert place) + (insert " — ") + (insert (let ((system-time-locale "C")) + (format-time-string varuga-time-format when zone))) + (insert "\n")) + varuga-clock-list) + ;; Insert ical part. + (insert "<#part type=text/calendar>\n") + (varuga-insert-calendar + (varuga-calendar + :components (list (pcase (mail-extract-address-components + (message-fetch-field "From")) + (`(,organizer ,organizer-email-address) + (varuga-calendar-event + :organizer organizer + :organizer-email-address organizer-email-address + :time-start when + :time-end (time-add when + (* 60 (org-duration-to-minutes duration))) + :summary summary + :location location)))))) + (insert "<#/multipart>\n"))) + +(provide 'varuga) + +;;; varuga.el ends here |