blob: d57249f2abf57333b82a3783654e1696af126110 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
;;; gnus-icalendar-request.el --- Create icalendar events -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Ferdinand Pieper
;; Author: Ferdinand Pieper <mail@pie.tf>
;; 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 <https://www.gnu.org/licenses/>.
;;; 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 <mail@address.net>" 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
|
