From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/83870 Path: news.gmane.org!not-for-mail From: Jan Tatarik Newsgroups: gmane.emacs.gnus.general Subject: Re: iCalendar integration - time zone issue Date: Tue, 12 Nov 2013 14:08:12 +0100 Message-ID: <87zjp9n4xv.fsf@nb-jtatarik2.xing.hh> References: <87a9hbdlil.fsf@topper.koldfront.dk> <87mwlao89b.fsf@nb-jtatarik2.xing.hh> <874n7icya4.fsf@topper.koldfront.dk> <87eh6mng2t.fsf@nb-jtatarik2.xing.hh> <87wqkeuglx.fsf@topper.koldfront.dk> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1384261763 7921 80.91.229.3 (12 Nov 2013 13:09:23 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 12 Nov 2013 13:09:23 +0000 (UTC) To: ding@gnus.org Original-X-From: ding-owner+M32126@lists.math.uh.edu Tue Nov 12 14:09:27 2013 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VgDif-0003aO-Cs for ding-account@gmane.org; Tue, 12 Nov 2013 14:09:26 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1VgDhv-0008SC-8S; Tue, 12 Nov 2013 07:08:39 -0600 Original-Received: from mx1.math.uh.edu ([129.7.128.32]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1VgDhs-0008S1-MQ for ding@lists.math.uh.edu; Tue, 12 Nov 2013 07:08:36 -0600 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx1.math.uh.edu with esmtps (TLSv1:AES128-SHA:128) (Exim 4.76) (envelope-from ) id 1VgDho-0003nM-26 for ding@lists.math.uh.edu; Tue, 12 Nov 2013 07:08:34 -0600 Original-Received: from mail-ea0-f179.google.com ([209.85.215.179]) by quimby.gnus.org with esmtp (Exim 4.80) (envelope-from ) id 1VgDhm-0003y4-Jn for ding@gnus.org; Tue, 12 Nov 2013 14:08:30 +0100 Original-Received: by mail-ea0-f179.google.com with SMTP id r15so1328851ead.10 for ; Tue, 12 Nov 2013 05:08:25 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:subject:references:date:in-reply-to:message-id:user-agent :mime-version:content-type; bh=QTDaeOJ2pdD+YzhMMds7RQx2BP8Ee3/iQxFlJZazMfg=; b=i+0JK+2s3yTfgpHGXPgDnkfu9iPJyRYztUSodKLbHr1rI6WbDiljhqOLMv/Lt3lWNx zO7ER5wz5cCr8/CAhabdeA7CiOuA9421eto/aWQXqs4dtKuNIYs/Z2eo1WT88IazW4M2 lYHjsIewMKexGWr7PR6Z/qjwj/nlk2Fy+Y4HtnLcGOInagacCHs6fr6a4wWzTHvhTi4z FmmuuEf6EYZXR4W3EN3O3hYyK5hSY35ETMRr9VnZqjgtU6kFx3W0JRNc6LhFDXV91p7h +p3MOrTtpcjhFiobegwwLAAeSIT/DMlwKPTvUDwfxIVzFcV3ffL0LFS4hi03Q3X78C/G lzQw== X-Received: by 10.14.127.4 with SMTP id c4mr47107eei.144.1384261705179; Tue, 12 Nov 2013 05:08:25 -0800 (PST) Original-Received: from nb-jtatarik2.xing.hh (office.xing.com. [82.112.107.65]) by mx.google.com with ESMTPSA id 8sm75874642eem.15.2013.11.12.05.08.23 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Tue, 12 Nov 2013 05:08:24 -0800 (PST) In-Reply-To: <87wqkeuglx.fsf@topper.koldfront.dk> ("Adam \=\?utf-8\?Q\?Sj\?\= \=\?utf-8\?Q\?\=C3\=B8gren\=22's\?\= message of "Tue, 12 Nov 2013 10:14:18 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) X-Spam-Score: -2.2 (--) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:83870 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable On Tue, Nov 12 2013, Adam Sj=C3=B8gren wrote: > Jan Tatarik writes: >> No, it isn't. It's exactly the same as my W. Europe example, only the >> name is different. > Ok, good. It looks thoroughly confusing to me. >> Yes, this part of the code works fine, the problem occurs later in the >> pipeline, when the org timestamp is generated. The actual timezone is >> not used when creating the timestamp, so GMT is assumed by default, and >> the 1 hour shift happens. >> I'll fix that. OK, have something that works for me. Do you mind testing? You can try either a patch against the latest gnus --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=tz_handling.patch diff --git a/lisp/gnus-icalendar.el b/lisp/gnus-icalendar.el index 969c868b5647158922f9873a49425678c45fd42f..f3b62381b47e79b7f260d5ad8c46ad498096c7d9 100644 --- a/lisp/gnus-icalendar.el +++ b/lisp/gnus-icalendar.el @@ -69,14 +69,14 @@ :accessor gnus-icalendar-event:location :initform "" :type (or null string)) - (start :initarg :start - :accessor gnus-icalendar-event:start + (start-time :initarg :start-time + :accessor gnus-icalendar-event:start-time :initform "" - :type (or null string)) - (end :initarg :end - :accessor gnus-icalendar-event:end + :type (or null t)) + (end-time :initarg :end-time + :accessor gnus-icalendar-event:end-time :initform "" - :type (or null string)) + :type (or null t)) (recur :initarg :recur :accessor gnus-icalendar-event:recur :initform "" @@ -125,27 +125,15 @@ (or (match-string 1 rrule) default-interval))) -(defmethod gnus-icalendar-event:start-time ((event gnus-icalendar-event)) - "Return time value of the EVENT start date." - (date-to-time (gnus-icalendar-event:start event))) - -(defmethod gnus-icalendar-event:end-time ((event gnus-icalendar-event)) - "Return time value of the EVENT end date." - (date-to-time (gnus-icalendar-event:end event))) - +(defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) + (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) -(defun gnus-icalendar-event--decode-datefield (ical field zone-map &optional date-style) - (let* ((calendar-date-style (or date-style 'european)) - (date (icalendar--get-event-property ical field)) - (date-zone (icalendar--find-time-zone - (icalendar--get-event-property-attributes - ical field) - zone-map)) - (date-decoded (icalendar--decode-isodatetime date nil date-zone))) +(defun gnus-icalendar-event--decode-datefield (ical field) + (let* ((date (icalendar--get-event-property ical field)) + (date-props (icalendar--get-event-property-attributes ical field)) + (tz (plist-get date-props 'TZID))) - (concat (icalendar--datetime-to-iso-date date-decoded "-") - " " - (icalendar--datetime-to-colontime date-decoded)))) + (date-to-time (timezone-make-date-arpa-standard date nil tz)))) (defun gnus-icalendar-event--find-attendee (ical name-or-email) (let* ((event (car (icalendar--all-events ical))) @@ -166,7 +154,6 @@ (defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email) (let* ((event (car (icalendar--all-events ical))) - (zone-map (icalendar--convert-all-timezones ical)) (organizer (replace-regexp-in-string "^.*MAILTO:" "" (or (icalendar--get-event-property event 'ORGANIZER) ""))) @@ -180,8 +167,8 @@ (gnus-icalendar-event--find-attendee ical attendee-name-or-email))) (args (list :method method :organizer organizer - :start (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map) - :end (gnus-icalendar-event--decode-datefield event 'DTEND zone-map) + :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART) + :end-time (gnus-icalendar-event--decode-datefield event 'DTEND) :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE"))) (event-class (cond @@ -363,10 +350,10 @@ Return nil for non-recurring EVENT." "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." (let* ((start (gnus-icalendar-event:start-time event)) (end (gnus-icalendar-event:end-time event)) - (start-date (format-time-string "%Y-%m-%d %a" start t)) - (start-time (format-time-string "%H:%M" start t)) - (end-date (format-time-string "%Y-%m-%d %a" end t)) - (end-time (format-time-string "%H:%M" end t)) + (start-date (format-time-string "%Y-%m-%d %a" start)) + (start-time (format-time-string "%H:%M" start)) + (end-date (format-time-string "%Y-%m-%d %a" end)) + (end-time (format-time-string "%H:%M" end)) (org-repeat (gnus-icalendar-event:org-repeat event)) (repeat (if org-repeat (concat " " org-repeat) ""))) --=-=-= Content-Type: text/plain or just replace the whole gnus-icalendar.el file --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=gnus-icalendar.el Content-Transfer-Encoding: quoted-printable ;;; gnus-icalendar.el --- reply to iCalendar meeting requests ;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Author: Jan Tatarik ;; Keywords: mail, icalendar, org ;; 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: ;; To install: ;; (require 'gnus-icalendar) ;; (gnus-icalendar-setup) ;; to enable optional iCalendar->Org sync functionality ;; NOTE: both the capture file and the headline(s) inside must already exist ;; (setq gnus-icalendar-org-capture-file "~/org/notes.org") ;; (setq gnus-icalendar-org-capture-headline '("Calendar")) ;; (gnus-icalendar-org-setup) ;;; Code: (require 'icalendar) (require 'eieio) (require 'gmm-utils) (require 'mm-decode) (require 'gnus-sum) (eval-when-compile (require 'cl)) (defun gnus-icalendar-find-if (pred seq) (catch 'found (while seq (when (funcall pred (car seq)) (throw 'found (car seq))) (pop seq)))) ;;; ;;; ical-event ;;; (defclass gnus-icalendar-event () ((organizer :initarg :organizer :accessor gnus-icalendar-event:organizer :initform "" :type (or null string)) (summary :initarg :summary :accessor gnus-icalendar-event:summary :initform "" :type (or null string)) (description :initarg :description :accessor gnus-icalendar-event:description :initform "" :type (or null string)) (location :initarg :location :accessor gnus-icalendar-event:location :initform "" :type (or null string)) (start-time :initarg :start-time :accessor gnus-icalendar-event:start-time :initform "" :type (or null t)) (end-time :initarg :end-time :accessor gnus-icalendar-event:end-time :initform "" :type (or null t)) (recur :initarg :recur :accessor gnus-icalendar-event:recur :initform "" :type (or null string)) (uid :initarg :uid :accessor gnus-icalendar-event:uid :type string) (method :initarg :method :accessor gnus-icalendar-event:method :initform "PUBLISH" :type (or null string)) (rsvp :initarg :rsvp :accessor gnus-icalendar-event:rsvp :initform nil :type (or null boolean))) "generic iCalendar Event class") (defclass gnus-icalendar-event-request (gnus-icalendar-event) nil "iCalendar class for REQUEST events") (defclass gnus-icalendar-event-cancel (gnus-icalendar-event) nil "iCalendar class for CANCEL events") (defclass gnus-icalendar-event-reply (gnus-icalendar-event) nil "iCalendar class for REPLY events") (defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) "Return t if EVENT is recurring." (not (null (gnus-icalendar-event:recur event)))) (defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event= )) "Return recurring frequency of EVENT." (let ((rrule (gnus-icalendar-event:recur event))) (string-match "FREQ=3D\\([[:alpha:]]+\\)" rrule) (match-string 1 rrule))) (defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-e= vent)) "Return recurring interval of EVENT." (let ((rrule (gnus-icalendar-event:recur event)) (default-interval 1)) (string-match "INTERVAL=3D\\([[:digit:]]+\\)" rrule) (or (match-string 1 rrule) default-interval))) (defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time eve= nt))) (defun gnus-icalendar-event--decode-datefield (ical field) (let* ((date (icalendar--get-event-property ical field)) (date-props (icalendar--get-event-property-attributes ical field)) (tz (plist-get date-props 'TZID))) (date-to-time (timezone-make-date-arpa-standard date nil tz)))) (defun gnus-icalendar-event--find-attendee (ical name-or-email) (let* ((event (car (icalendar--all-events ical))) (event-props (caddr event))) (gmm-labels ((attendee-name (att) (plist-get (cadr att) 'CN)) (attendee-email (att) (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) (attendee-prop-matches-p (prop) (and (eq (car prop) 'ATTENDEE) (or (member (attendee-name prop) name-or-email) (let ((att-email (attendee-email prop))) (gnus-icalendar-find-if (lambda (email) (string-match email= att-email)) name-or-email)))))) (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) (defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-emai= l) (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-nam= e-or-email))) (args (list :method method :organizer organizer :start-time (gnus-icalendar-event--decode-datefield ev= ent 'DTSTART) :end-time (gnus-icalendar-event--decode-datefield even= t 'DTEND) :rsvp (string=3D (plist-get (cadr attendee) 'RSVP) "TRUE"))) (event-class (cond ((string=3D method "REQUEST") 'gnus-icalendar-event-= request) ((string=3D method "CANCEL") 'gnus-icalendar-event-c= ancel) ((string=3D method "REPLY") 'gnus-icalendar-event-re= ply) (t 'gnus-icalendar-event)))) (gmm-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 "\\;" (replace-regexp-in-string "\\\\," "," (replace-regexp-in-string "\\\\n" "\n" (substring-no-properties value)))))) (accumulate-args (mapping) (destructuring-bind (slot . ical-property) mapping (setq args (append (list (intern (concat ":" (symbol-name s= lot))) (map-property ical-property)) args))))) (mapc #'accumulate-args prop-map) (apply 'make-instance event-class args)))) (defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-ema= il) "Parse RFC5545 iCalendar in buffer BUF and return an event object. Return a gnus-icalendar-event object representing the first event contained in the invitation. Return nil for calendars without an event entr= y. ATTENDEE-NAME-OR-EMAIL is a list of strings that will be matched against the event's attendee names and emails. Invitation rsvp status will be retrieved from the first matching attendee record." (let ((ical (with-current-buffer (icalendar--get-unfolded-buffer (get-buf= fer buf)) (goto-char (point-min)) (icalendar--read-element nil nil)))) (when ical (gnus-icalendar-event-from-ical ical attendee-name-or-email)))) ;;; ;;; gnus-icalendar-event-reply ;;; (defun gnus-icalendar-event--build-reply-event-body (ical-request status id= entities) (let ((summary-status (capitalize (symbol-name status))) (attendee-status (upcase (symbol-name status))) reply-event-lines) (gmm-labels ((update-summary (line) (if (string-match "^[^:]+:" line) (replace-match (format "\\&%s: " summary-status) t n= il line) line)) (update-dtstamp () (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) (attendee-matches-identity (line) (gnus-icalendar-find-if (lambda (name) (string-match-p n= ame line)) identities)) (update-attendee-status (line) (when (and (attendee-matches-identity line) (string-match "\\(PARTSTAT=3D\\)[^;]+" line)) (replace-match (format "\\1%s" attendee-status) t nil = line))) (process-event-line (line) (when (string-match "^\\([^;:]+\\)" line) (let* ((key (match-string 0 line)) ;; NOTE: not all of the below fields are mandat= ory, ;; but they are often present in other clients' ;; replies. Can be helpful for debugging, too. (new-line (cond ((string=3D key "ATTENDEE") (update-attendee-= status line)) ((string=3D key "SUMMARY") (update-summary li= ne)) ((string=3D key "DTSTAMP") (update-dtstamp)) ((member key '("ORGANIZER" "DTSTART" "DTEND" "LOCATION" "DURATION" "SEQUENC= E" "RECURRENCE-ID" "UID")) line) (t nil)))) (when new-line (push new-line reply-event-lines)))))) (mapc #'process-event-line (split-string ical-request "\n")) (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE"= x)) reply-event-lines) (error "Could not find an event attendee matching given identity")) (mapconcat #'identity `("BEGIN:VEVENT" ,@(nreverse reply-event-lines) "END:VEVENT") "\n")))) (defun gnus-icalendar-event-reply-from-buffer (buf status identities) "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." (gmm-labels ((extract-block (blockname) (save-excursion (let ((block-start-re (format "^BEGIN:%s" blockname)) (block-end-re (format "^END:%s" blockname)) start) (when (re-search-forward block-start-re nil t) (setq start (line-beginning-position)) (re-search-forward block-end-re) (buffer-substring-no-properties start (line-end-positi= on))))))) (let (zone event) (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) (goto-char (point-min)) (setq zone (extract-block "VTIMEZONE") event (extract-block "VEVENT"))) (when event (let ((contents (list "BEGIN:VCALENDAR" "METHOD:REPLY" "PRODID:Gnus" "VERSION:2.0" zone (gnus-icalendar-event--build-reply-event-body= event status identities) "END:VCALENDAR"))) (mapconcat #'identity (delq nil contents) "\n")))))) ;;; ;;; gnus-icalendar-org ;;; ;;; TODO: this is an optional feature, and it's only available with org-mode ;;; 7+, so will need to properly handle emacsen with no/outdated org-mode (require 'org) (require 'org-capture) (defgroup gnus-icalendar-org nil "Settings for Calendar Event gnus/org integration." :group 'gnus-icalendar :prefix "gnus-icalendar-org-") (defcustom gnus-icalendar-org-capture-file nil "Target Org file for storing captured calendar events." :type '(choice (const nil) file) :group 'gnus-icalendar-org) (defcustom gnus-icalendar-org-capture-headline nil "Target outline in `gnus-icalendar-org-capture-file' for storing captured= events." :type '(repeat string) :group 'gnus-icalendar-org) (defcustom gnus-icalendar-org-template-name "used by gnus-icalendar-org" "Org-mode template name." :type '(string) :group 'gnus-icalendar-org) (defcustom gnus-icalendar-org-template-key "#" "Org-mode template hotkey." :type '(string) :group 'gnus-icalendar-org) (defvar gnus-icalendar-org-enabled-p nil) (defmethod gnus-icalendar-event:org-repeat ((event gnus-icalendar-event)) "Return `org-mode' timestamp repeater string for recurring EVENT. Return nil for non-recurring EVENT." (when (gnus-icalendar-event:recurring-p event) (let* ((freq-map '(("HOURLY" . "h") ("DAILY" . "d") ("WEEKLY" . "w") ("MONTHLY" . "m") ("YEARLY" . "y"))) (org-freq (cdr (assoc (gnus-icalendar-event:recurring-freq event= ) freq-map)))) (when org-freq (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org= -freq))))) (defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) "Build `org-mode' timestamp from EVENT start/end dates and recurrence inf= o." (let* ((start (gnus-icalendar-event:start-time event)) (end (gnus-icalendar-event:end-time event)) (start-date (format-time-string "%Y-%m-%d %a" start)) (start-time (format-time-string "%H:%M" start)) (end-date (format-time-string "%Y-%m-%d %a" end)) (end-time (format-time-string "%H:%M" end)) (org-repeat (gnus-icalendar-event:org-repeat event)) (repeat (if org-repeat (concat " " org-repeat) ""))) (if (equal start-date end-date) (format "<%s %s-%s%s>" start-date start-time end-time repeat) (format "<%s %s>--<%s %s>" start-date start-time end-date end-time)))) ;; TODO: make the template customizable (defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) re= ply-status) "Return string with new `org-mode' entry describing EVENT." (with-temp-buffer (org-mode) (with-slots (organizer summary description location recur uid) event (let* ((reply (if reply-status (capitalize (symbol-name reply-status)) "Not replied yet")) (props `(("ICAL_EVENT" . "t") ("ID" . ,uid) ("DT" . ,(gnus-icalendar-event:org-timestamp event)) ("ORGANIZER" . ,(gnus-icalendar-event:organizer event= )) ("LOCATION" . ,(gnus-icalendar-event:location event)) ("RRULE" . ,(gnus-icalendar-event:recur event)) ("REPLY" . ,reply)))) (insert (format "* %s (%s)\n\n" summary location)) (mapc (lambda (prop) (org-entry-put (point) (car prop) (cdr prop))) props)) (when description (save-restriction (narrow-to-region (point) (point)) (insert description) (indent-region (point-min) (point-max) 2) (fill-region (point-min) (point-max)))) (buffer-string)))) (defun gnus-icalendar--deactivate-org-timestamp (ts) (replace-regexp-in-string "[<>]" (lambda (m) (cond ((string=3D m "<") "[") ((string=3D m ">") "]"))) ts)) (defun gnus-icalendar-find-org-event-file (event &optional org-file) "Return the name of the file containing EVENT org entry. Return nil when not found. All org agenda files are searched for the EVENT entry. When the optional ORG-FILE argument is specified, only that one file is searched." (let ((uid (gnus-icalendar-event:uid event)) (files (or org-file (org-agenda-files t 'ifmode)))) (gmm-labels ((find-event-in (file) (org-check-agenda-file file) (with-current-buffer (find-file-noselect file) (let ((event-pos (org-find-entry-with-id uid))) (when (and event-pos (string=3D (cdr (assoc "ICAL_EVENT" (org-entry-pr= operties event-pos))) "t")) (throw 'found file)))))) (gnus-icalendar-find-if #'find-event-in files)))) (defun gnus-icalendar--show-org-event (event &optional org-file) (let ((file (gnus-icalendar-find-org-event-file event org-file))) (when file (switch-to-buffer (find-file file)) (goto-char (org-find-entry-with-id (gnus-icalendar-event:uid event))) (org-show-entry)))) (defun gnus-icalendar--update-org-event (event reply-status &optional org-f= ile) (let ((file (gnus-icalendar-find-org-event-file event org-file))) (when file (with-current-buffer (find-file-noselect file) (with-slots (uid summary description organizer location recur) event (let ((event-pos (org-find-entry-with-id uid))) (when event-pos (goto-char event-pos) ;; update the headline, keep todo, priority and tags, if any (save-excursion (let* ((priority (org-entry-get (point) "PRIORITY")) (headline (delq nil (list (org-entry-get (point) "TODO") (when priority (format "[#%s]" = priority)) (format "%s (%s)" summary locat= ion) (org-entry-get (point) "TAGS"))= ))) (re-search-forward "^\\*+ " (line-end-position)) (delete-region (point) (line-end-position)) (insert (mapconcat #'identity headline " ")))) ;; update props and description (let ((entry-end (org-entry-end-position)) (entry-outline-level (org-outline-level))) ;; delete body of the entry, leave org drawers intact (save-restriction (org-narrow-to-element) (goto-char entry-end) (re-search-backward "^[\t ]*:END:") (forward-line) (delete-region (point) entry-end)) ;; put new event description in the entry body (when description (save-restriction (narrow-to-region (point) (point)) (insert "\n" (replace-regexp-in-string "[\n]+$" "\n" de= scription) "\n") (indent-region (point-min) (point-max) (1+ entry-outlin= e-level)) (fill-region (point-min) (point-max)))) ;; update entry properties (org-entry-put event-pos "DT" (gnus-icalendar-event:org-tim= estamp event)) (org-entry-put event-pos "ORGANIZER" organizer) (org-entry-put event-pos "LOCATION" location) (org-entry-put event-pos "RRULE" recur) (when reply-status (org-entry-put event-pos "REPLY" (capitalize (symbol-name = reply-status)))) (save-buffer))))))))) (defun gnus-icalendar--cancel-org-event (event &optional org-file) (let ((file (gnus-icalendar-find-org-event-file event org-file))) (when file (with-current-buffer (find-file-noselect file) (let ((event-pos (org-find-entry-with-id (gnus-icalendar-event:uid = event)))) (when event-pos (let ((ts (org-entry-get event-pos "DT"))) (when ts (org-entry-put event-pos "DT" (gnus-icalendar--deactivate-o= rg-timestamp ts)) (save-buffer))))))))) (defun gnus-icalendar--get-org-event-reply-status (event &optional org-file) (let ((file (gnus-icalendar-find-org-event-file event org-file))) (when file (save-excursion (with-current-buffer (find-file-noselect file) (let ((event-pos (org-find-entry-with-id (gnus-icalendar-event:ui= d event)))) (org-entry-get event-pos "REPLY"))))))) (defun gnus-icalendar-insinuate-org-templates () (unless (gnus-icalendar-find-if (lambda (x) (string=3D (cadr x) gnus-ical= endar-org-template-name)) org-capture-templates) (setq org-capture-templates (append `((,gnus-icalendar-org-template-key ,gnus-icalendar-org-template-name entry (file+olp ,gnus-icalendar-org-capture-file ,@gnus-ical= endar-org-capture-headline) "%i" :immediate-finish t)) org-capture-templates)) ;; hide the template from interactive template selection list ;; (org-capture) ;; NOTE: doesn't work when capturing from string ;; (when (boundp 'org-capture-templates-contexts) ;; (push `(,gnus-icalendar-org-template-key "" ((in-mode . "gnus-arti= cle-mode"))) ;; org-capture-templates-contexts)) )) (defun gnus-icalendar:org-event-save (event reply-status) (with-temp-buffer (org-capture-string (gnus-icalendar-event->org-entry event reply-status) gnus-icalendar-org-template-key))) (defun gnus-icalendar-show-org-agenda (event) (let* ((time-delta (time-subtract (gnus-icalendar-event:end-time event) (gnus-icalendar-event:start-time event)= )) (duration-days (1+ (/ (+ (* (car time-delta) (expt 2 16)) (cadr time-delta)) 86400)))) (org-agenda-list nil (gnus-icalendar-event:start event) duration-days))) (defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-re= quest) reply-status) (if (gnus-icalendar-find-org-event-file event) (gnus-icalendar--update-org-event event reply-status) (gnus-icalendar:org-event-save event reply-status))) (defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-ca= ncel)) (when (gnus-icalendar-find-org-event-file event) (gnus-icalendar--cancel-org-event event))) (defun gnus-icalendar-org-setup () (if (and gnus-icalendar-org-capture-file gnus-icalendar-org-capture-headl= ine) (progn (gnus-icalendar-insinuate-org-templates) (setq gnus-icalendar-org-enabled-p t)) (message "Cannot enable Calendar->Org: missing capture file, headline")= )) ;;; ;;; gnus-icalendar ;;; (defgroup gnus-icalendar nil "Settings for inline display of iCalendar invitations." :group 'gnus-article :prefix "gnus-icalendar-") (defcustom gnus-icalendar-reply-bufname "*CAL*" "Buffer used for building iCalendar invitation reply." :type '(string) :group 'gnus-icalendar) (make-variable-buffer-local (defvar gnus-icalendar-reply-status nil)) (make-variable-buffer-local (defvar gnus-icalendar-event nil)) (make-variable-buffer-local (defvar gnus-icalendar-handle nil)) (defvar gnus-icalendar-identities (apply #'append (mapcar (lambda (x) (if (listp x) x (list x))) (list user-full-name (regexp-quote user-mail-address) ; NOTE: this one can be a list gnus-ignored-from-addresses)))) ;; TODO: make the template customizable (defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event= ) &optional reply-status) "Format an overview of EVENT details." (gmm-labels ((format-header (x) (format "%-12s%s" (propertize (concat (car x) ":") 'face 'bold) (cadr x)))) (with-slots (organizer summary description location recur uid method rs= vp) event (let ((headers `(("Summary" ,summary) ("Location" ,location) ("Time" ,(gnus-icalendar-event:org-timestamp event)) ("Organizer" ,organizer) ("Method" ,method)))) (when (and (not (gnus-icalendar-event-reply-p event)) rsvp) (setq headers (append headers `(("Status" ,(or reply-status "Not replied y= et")))))) (concat (mapconcat #'format-header headers "\n") "\n\n" description))))) (defmacro gnus-icalendar-with-decoded-handle (handle &rest body) "Execute BODY in buffer containing the decoded contents of HANDLE." (let ((charset (make-symbol "charset"))) `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) (with-temp-buffer (mm-insert-part ,handle) (when (string=3D ,charset "utf-8") (mm-decode-coding-region (point-min) (point-max) 'utf-8)) ,@body)))) (defun gnus-icalendar-event-from-handle (handle &optional attendee-name-or-= email) (gnus-icalendar-with-decoded-handle handle (gnus-icalendar-event-from-buffer (current-buffer) a= ttendee-name-or-email))) (defun gnus-icalendar-insert-button (text callback data) ;; FIXME: the gnus-mime-button-map keymap does not make sense for this ki= nd ;; of button. (let ((start (point))) (gnus-add-text-properties start (progn (insert "[ " text " ]") (point)) `(gnus-callback ,callback keymap ,gnus-mime-button-map face ,gnus-article-button-face gnus-data ,data)) (widget-convert-button 'link start (point) :action 'gnus-widget-press-button :button-keymap gnus-widget-button-keymap))) (defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) (let ((message-signature nil)) (with-current-buffer gnus-summary-buffer (gnus-summary-reply) (message-goto-body) (mml-insert-multipart "alternative") (mml-insert-empty-tag 'part 'type "text/plain") (mml-attach-buffer buffer-name "text/calendar; method=3DREPLY; charse= t=3DUTF-8") (message-goto-subject) (delete-region (line-beginning-position) (line-end-position)) (insert "Subject: " subject) (message-send-and-exit)))) (defun gnus-icalendar-reply (data) (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)))) (when reply (gmm-labels ((fold-icalendar-buffer () (goto-char (point-min)) (while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t) (replace-match "\\1\n \\2") (goto-char (line-beginning-position))))) (let ((subject (concat (capitalize (symbol-name status)) ": " (gnus-icalendar-event:summary event)))) (with-current-buffer (get-buffer-create gnus-icalendar-reply-bufn= ame) (delete-region (point-min) (point-max)) (insert reply) (fold-icalendar-buffer) (gnus-icalendar-send-buffer-by-mail (buffer-name) subject)) ;; Back in article buffer (setq-local gnus-icalendar-reply-status status) (when gnus-icalendar-org-enabled-p (gnus-icalendar--update-org-event event status) ;; refresh article buffer to update the reply status (with-current-buffer gnus-summary-buffer (gnus-summary-show-article)))))))) (defun gnus-icalendar-sync-event-to-org (event) (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) (defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar= -event) handle) (when (gnus-icalendar-event:rsvp event) `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) ("Decline" gnus-icalendar-reply (,handle declined ,event))))) (defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar= -event-reply) handle) "No buttons for REPLY events." nil) (defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-= event)) (or (when gnus-icalendar-org-enabled-p (gnus-icalendar--get-org-event-reply-status event)) "Not replied yet")) (defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-= event-reply)) "No reply status for REPLY events." nil) (defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-e= vent)) (let* ((org-entry-exists-p (gnus-icalendar-find-org-event-file event)) (export-button-text (if org-entry-exists-p "Update Org Entry" "Exp= ort to Org"))) (delq nil (list `("Show Agenda" gnus-icalendar-show-org-agenda ,event) (when (gnus-icalendar-event-request-p event) `(,export-button-text gnus-icalendar-sync-event-to-org ,ev= ent)) (when org-entry-exists-p `("Show Org Entry" gnus-icalendar--show-org-event ,event))= )))) (defun gnus-icalendar-mm-inline (handle) (let ((event (gnus-icalendar-event-from-handle handle gnus-icalendar-iden= tities))) (setq gnus-icalendar-reply-status nil) (when event (gmm-labels ((insert-button-group (buttons) (when buttons (mapc (lambda (x) (apply 'gnus-icalendar-insert-button x) (insert " ")) buttons) (insert "\n\n")))) (insert-button-group (gnus-icalendar-event:inline-reply-buttons event handle)) (when gnus-icalendar-org-enabled-p (insert-button-group (gnus-icalendar-event:inline-org-buttons eve= nt))) (setq gnus-icalendar-event event gnus-icalendar-handle handle) (insert (gnus-icalendar-event->gnus-calendar event (gnus-icalendar-event:inline-reply-status event))))))) (defun gnus-icalendar-save-part (handle) (let (event) (when (and (equal (car (mm-handle-type handle)) "text/calendar") (setq event (gnus-icalendar-event-from-handle handle gnus-ic= alendar-identities))) (gnus-icalendar-event:sync-to-org event)))) (defun gnus-icalendar-save-event () "Save the Calendar event in the text/calendar part under point." (interactive) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data (gnus-icalendar-save-part data)))) (defun gnus-icalendar-reply-accept () "Accept invitation in the current article." (interactive) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalen= dar-event)) (setq-local gnus-icalendar-reply-status 'accepted))) (defun gnus-icalendar-reply-tentative () "Send tentative response to invitation in the current article." (interactive) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icale= ndar-event)) (setq-local gnus-icalendar-reply-status 'tentative))) (defun gnus-icalendar-reply-decline () "Decline invitation in the current article." (interactive) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalen= dar-event)) (setq-local gnus-icalendar-reply-status 'declined))) (defun gnus-icalendar-event-export () "Export calendar event to `org-mode', or update existing agenda entry." (interactive) (with-current-buffer gnus-article-buffer (gnus-icalendar-sync-event-to-org gnus-icalendar-event)) ;; refresh article buffer in case the reply had been sent before initial = org ;; export (with-current-buffer gnus-summary-buffer (gnus-summary-show-article))) (defun gnus-icalendar-event-show () "Display `org-mode' agenda entry related to the calendar event." (interactive) (gnus-icalendar--show-org-event (with-current-buffer gnus-article-buffer gnus-icalendar-event))) (defun gnus-icalendar-event-check-agenda () "Display `org-mode' agenda for days between event start and end dates." (interactive) (gnus-icalendar-show-org-agenda (with-current-buffer gnus-article-buffer gnus-icalendar-event))) (defvar gnus-mime-action-alist) ; gnus-art (defun gnus-icalendar-setup () (add-to-list 'mm-inlined-types "text/calendar") (add-to-list 'mm-automatic-display "text/calendar") (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-i= nline identity)) (gnus-define-keys (gnus-summary-calendar-map "i" gnus-summary-mode-map) "a" gnus-icalendar-reply-accept "t" gnus-icalendar-reply-tentative "d" gnus-icalendar-reply-decline "c" gnus-icalendar-event-check-agenda "e" gnus-icalendar-event-export "s" gnus-icalendar-event-show) (require 'gnus-art) (add-to-list 'gnus-mime-action-alist (cons "save calendar event" 'gnus-icalendar-save-event) t)) (provide 'gnus-icalendar) ;;; gnus-icalendar.el ends here --=-=-= Content-Type: text/plain and restart emacs. --=-=-=--