From 6206e1543b14f0129a29ea0022b982e4b0c118cf Mon Sep 17 00:00:00 2001 From: Peter Feigl Date: Fri, 24 May 2013 18:37:12 +0200 Subject: [PATCH] Re: converting notmuch email to 'TODO' entry in org-mode --- fd/fed68e49b2a757641ce5afc8974a37841995c3 | 561 ++++++++++++++++++++++ 1 file changed, 561 insertions(+) create mode 100644 fd/fed68e49b2a757641ce5afc8974a37841995c3 diff --git a/fd/fed68e49b2a757641ce5afc8974a37841995c3 b/fd/fed68e49b2a757641ce5afc8974a37841995c3 new file mode 100644 index 000000000..95031355d --- /dev/null +++ b/fd/fed68e49b2a757641ce5afc8974a37841995c3 @@ -0,0 +1,561 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by olra.theworths.org (Postfix) with ESMTP id CCFB5431FC7 + for ; Fri, 24 May 2013 09:37:27 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: 0.001 +X-Spam-Level: +X-Spam-Status: No, score=0.001 tagged_above=-999 required=5 + tests=[FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001] + autolearn=disabled +Received: from olra.theworths.org ([127.0.0.1]) + by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id DeQ6fIh-PCUv for ; + Fri, 24 May 2013 09:37:20 -0700 (PDT) +Received: from mout.gmx.net (mout.gmx.net [212.227.17.22]) + by olra.theworths.org (Postfix) with ESMTP id DDF0F431FAE + for ; Fri, 24 May 2013 09:37:19 -0700 (PDT) +Received: from mailout-de.gmx.net ([10.1.76.17]) by mrigmx.server.lan + (mrigmx002) with ESMTP (Nemesis) id 0LkDn2-1U3q9A3tW6-00cBfD for + ; Fri, 24 May 2013 18:37:14 +0200 +Received: (qmail invoked by alias); 24 May 2013 16:37:14 -0000 +Received: from www.nexoid.at (EHLO mail.nexoid.at) [178.79.130.240] + by mail.gmx.net (mp017) with SMTP; 24 May 2013 18:37:14 +0200 +X-Authenticated: #201305 +X-Provags-ID: V01U2FsdGVkX186+zce4as6Z48LsepOVZYzq/j7l8/jCJpKZwbjeQ + +MxNV8H4UzIfv/ +Received: from nexoid (localhost [127.0.0.1]) + by mail.nexoid.at (Postfix) with ESMTP id C78B9E36C + for ; Fri, 24 May 2013 18:37:12 +0200 (CEST) +From: Peter Feigl +To: notmuch@notmuchmail.org +Subject: Re: converting notmuch email to 'TODO' entry in org-mode +In-Reply-To: <87txls7f8r.fsf@krugs.de> +References: <87txls7f8r.fsf@krugs.de> +User-Agent: Notmuch/0.11+77~gad6d0d5 (http://notmuchmail.org) Emacs/24.1.50.2 + (i686-pc-linux-gnu) +Date: Fri, 24 May 2013 18:37:12 +0200 +Message-ID: <87d2sgl4g7.fsf@nexoid.at> +MIME-Version: 1.0 +Content-Type: multipart/mixed; boundary="=-=-=" +X-Y-GMX-Trusted: 0 +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.13 +Precedence: list +List-Id: "Use and development of the notmuch mail system." + +List-Unsubscribe: , + +List-Archive: +List-Post: +List-Help: +List-Subscribe: , + +X-List-Received-Date: Fri, 24 May 2013 16:37:27 -0000 + +--=-=-= +Content-Type: text/plain + +This is rather bad but working code I use to import meeting requests +into org. I've been wanting to improve it and put it on github, but +haven't gotten around to doing that yet :-/ +Just (require '..) both of them, then you should have an additional +button for vCalendar attachments, allowing you to import it. +Replying, Accepting and Rejecting are WIP, parts are there, but they +don't work reliably with Microsoft Outlook yet (which doesn't really +honour the standards at all :-/) + +Good luck with it :) + +Peter + +--=-=-= +Content-Type: application/emacs-lisp +Content-Disposition: attachment; filename=notmuch-ical.el +Content-Transfer-Encoding: quoted-printable + +;; provide ical-create for inserting an ical attachment into e-mails +(defun ical-create (record) + (interactive (list (ical-read-new-record))) + (let* ((start (first record)) + (end (second record)) + (event (third record)) + (location (fourth record)) + (organizer-email (cadr (fifth record))) + (organizer-name (car (fifth record))) + (attendees (sixth record)) + (attendees-formatted (mapconcat (lambda (x) (format "ATTENDEE;ROLE=3DREQ-= +PARTICIPANT;PARTSTAT=3DNEEDS-ACTION;RSVP=3DTRUE; + CN=3D\"%s\": + MAILTO:%s" (car x) (cadr x))) attendees "\n")) + (description (seventh record)) + (dtstamp (format-zulu-time (decode-time (current-time)))) + (dtstart (format-zulu-time (parse-time-string start))) + (dtend (format-zulu-time (parse-time-string end))) + (uid (uuid-create)) + (created dtstamp)) + + (mml-insert-multipart "alternative") + (mml-insert-part "text/plain") + (insert "Event: " event "\nStart: " start "\nEnd: " end "\nOrganizer: "= + organizer-name "\nAttendees: " (string-join ", " (mapcar #'car attendees))= + "\n") + (mml-insert-tag 'part 'type "text/calendar" 'disposition "inline" 'meth= +od "REQUEST" 'encoding "8bit") + (insert "BEGIN:VCALENDAR +METHOD:REQUEST +PRODID:Emacs +VERSION:2.0 +BEGIN:VEVENT +DTSTAMP:" dtstamp " +DTSTART:" dtstart " +SUMMARY:" event " +UID:" uid " +" attendees-formatted " +ORGANIZER;CN=3D\"" organizer-name "\":MAILTO:" organizer-email " +LOCATION:" location " +DTEND:" dtend " +DESCRIPTION:" description " +SEQUENCE:0 +PRIORITY:5 +CLASS: +CREATED:" created " +STATUS:CONFIRMED +TRANSP:OPAQUE +X-MICROSOFT-CDO-BUSYSTATUS:BUSY +X-MICROSOFT-CDO-INSTTYPE:0 +X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY +X-MICROSOFT-CDO-IMPORTANCE:1 +X-MICROSOFT-CDO-APPT-SEQUENCE:0 +END:VEVENT +END:VCALENDAR +"))) + +(defun ical-read-new-record () + (let* ((start (org-read-date nil nil nil "Start date (and time): ")) + (end (org-read-date nil nil nil "End date (and time): ")) + (event (bbdb-read-string "Event: ")) + (location (bbdb-read-string "Location: ")) + (from+to (message-extract-from-to-headers)) + (organizer (caar from+to)) ;; todo: read from header + (attendees (cdr from+to)) ;; todo: read from header + (description (bbdb-read-string "Description: "))) + (list start end event location organizer attendees description))) + +(defun uuid-create () + "Return a newly generated UUID. This uses a simple hashing of variable da= +ta." + (let ((s (md5 (format "%s%s%s%s%s%s%s%s%s%s" + (user-uid) + (emacs-pid) + (system-name) + (user-full-name) + user-mail-address + (current-time) + (emacs-uptime) + (garbage-collect) + (random) + (recent-keys))))) + (format "%s-%s-3%s-%s-%s" + (substring s 0 8) + (substring s 8 12) + (substring s 13 16) + (substring s 16 20) + (substring s 20 32)))) + +(defun message-extract-from-to-headers () + (interactive) + (save-excursion + (message-narrow-to-headers) + (beginning-of-buffer) + (search-forward-regexp "^From: ") + (let ((pt (point))) + (message-next-header) + (let ((from-header (buffer-substring pt (point)))) + (beginning-of-buffer) + (search-forward-regexp "^To: ") + (let ((pt (point))) + (message-next-header) + (let ((to-header (remove-from-string (buffer-substring pt (point)) "\n")= +)) + (widen) + (cons (mail-extract-address-components from-header t) (mail-extract-ad= +dress-components to-header t)))))))) + +;;; fix to *not* increase the day by one +(defun org-ical-ts-to-string (s keyword &optional inc) + "Take a time string S and convert it to iCalendar format. +KEYWORD is added in front, to make a complete line like DTSTART.... +When INC is non-nil, increase the hour by two (if time string contains +a time), or the day by one (if it does not contain a time)." + (let ((t1 (org-parse-time-string s 'nodefault)) + t2 fmt have-time time) + (if (and (car t1) (nth 1 t1) (nth 2 t1)) + (setq t2 t1 have-time t) + (setq t2 (org-parse-time-string s))) + (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) + (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) + (when inc + (if have-time + (if org-agenda-default-appointment-duration + (setq mi (+ org-agenda-default-appointment-duration mi)) + (setq h (+ 2 h))) + (setq d d))) + (setq time (encode-time s mi h d m y))) + (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=3DDATE:%Y%m%d")) + (concat keyword (format-time-string fmt time)))) + +;;;; **** show "import with org-ical" button in e-mails +(defun notmuch-show-insert-part-text/calendar (msg part content-type nth de= +pth declared-type) + (let ((button)) + (setq button + (insert-button=20 + (concat "[ Import with org-ical ]") + :type 'notmuch-show-import-org-ical-button-type + :notmuch-part nth + :notmuch-filename (plist-get part :filename) + :notmuch-content-type content-type)) + (insert "\n") + nil)) + +(define-button-type 'notmuch-show-import-org-ical-button-type + 'action 'notmuch-show-import-org-ical-default + 'keymap 'notmuch-show-import-org-ical-map + 'follow-link t + 'face 'message-mml) + +(defvar notmuch-show-import-org-ical-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map button-map) + ;; (define-key map "s" 'notmuch-show-part-button-save) + ;; (define-key map "v" 'notmuch-show-part-button-view) + ;; (define-key map "o" 'notmuch-show-part-button-interactively-view) + map) + "Submap for button commands") +(fset 'notmuch-show-import-org-ical-map notmuch-show-import-org-ical-map) + +(defun notmuch-show-import-org-ical-default (&optional button) + (interactive) + (let ((button (or button (button-at (point))))) + (if button + (let ((nth (button-get button :notmuch-part))) + (if nth + (let ((id (notmuch-show-get-message-id))) + (notmuch-with-temp-part-buffer id nth + (let ((file (make-temp-file "notmuch-ical"))) + (write-region (point-min) (point-max) file) + (message "importing...") + (org-ical-insert-or-update-event file) + (message "done.")))) + (message "no part number"))) + (message "no button")))) + + +;; notes for reply: + +;; <#part type=3D"text/calendar" method=3D"REPLY" disposition=3Dinline> +;; BEGIN:VCALENDAR +;; METHOD:REPLY +;; PRODID:Emacs +;; VERSION:2.0 +;; BEGIN:VEVENT +;; ATTENDEE;ROLE=3DREQ-PARTICIPANT;PARTSTAT=3DACCEPTED;RSVP=3DTRUE;CN=3Dcra= +ven@gmx +;; .net:MAILTO:craven@gmx.net +;; DTSTART:20120321T130000Z +;; DTEND:20120321T140000Z +;; UID:040000008200E00074C5B7101A82E008000000005AE3DDCF5E07CD01000000000000= +000 +;; 010000000A0757F7AAED41D4D8ABFCEFCA035BA3A +;; CLASS:PUBLIC +;; PRIORITY:5 +;; DTSTAMP:20120321T123325Z +;; TRANSP:OPAQUE +;; STATUS:CONFIRMED +;; SEQUENCE:0 +;; END:VEVENT +;; END:VCALENDAR + +--=-=-= +Content-Type: application/emacs-lisp +Content-Disposition: attachment; filename=org-ical.el +Content-Transfer-Encoding: quoted-printable + +(require 'icalendar) + +;;; add this to org-capture-templates: + +;; ("K" "Kill Ring Head" entry +;; (file+headline "~/.org/life.org" "Dates") +;; "%c") + +(defun icalendar--get-event-properties-full (event prop) + "For the given EVENT return a list of all occurrences of the property PRO= +P." + (let ((props (car (cddr event))) pp result) + (while props + (setq pp (car props)) + (if (eq (car pp) prop) + (setq result (cons pp result))) + (setq props (cdr props))) + result)) + +(defun ical-parse-important-data (ical-list) + "Return important data from an ical-list (which is returned from icalenda= +r--read-element)" + (let* ((ev (icalendar--all-events ical-list)) + (error-string "") + (event-ok t) + (found-error nil) + (zone-map (icalendar--convert-all-timezones ical-list)) + e result) + ;; step through all events/appointments + (while ev + (setq e (car ev)) + (setq ev (cdr ev)) + (setq event-ok nil) + (condition-case error-val + (let* ((dtstart (icalendar--get-event-property e 'DTSTART)) + (dtstart-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + e 'DTSTART) + zone-map)) + (dtstart-dec (icalendar--decode-isodatetime dtstart nil + dtstart-zone)) + (start-d dtstart-dec) + (start-t dtstart-dec) + (dtend (icalendar--get-event-property e 'DTEND)) + (dtend-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + e 'DTEND) + zone-map)) + (dtend-dec (icalendar--decode-isodatetime dtend + nil dtend-zone)) + (dtend-1-dec (icalendar--decode-isodatetime dtend -1 + dtend-zone)) + end-d + end-1-d + end-t + (summary (icalendar--convert-string-for-import + (or (icalendar--get-event-property e 'SUMMARY) + "No summary"))) + (rrule (icalendar--get-event-property e 'RRULE)) + (rdate (icalendar--get-event-property e 'RDATE)) + (duration (icalendar--get-event-property e 'DURATION))) + (icalendar--dmsg "%s: `%s'" start-d summary) + ;; check whether start-time is missing + (if (and dtstart + (string=3D + (cadr (icalendar--get-event-property-attributes + e 'DTSTART)) + "DATE")) + (setq start-t nil)) + (when duration + (let ((dtend-dec-d (icalendar--add-decoded-times + dtstart-dec + (icalendar--decode-isoduration duration))) + (dtend-1-dec-d (icalendar--add-decoded-times + dtstart-dec + (icalendar--decode-isoduration duration + t)))) + (if (and dtend-dec (not (eq dtend-dec dtend-dec-d))) + (message "Inconsistent endtime and duration for %s" + summary)) + (setq dtend-dec dtend-dec-d) + (setq dtend-1-dec dtend-1-dec-d))) + (setq end-d (if dtend-dec + dtend-dec + start-d)) + (setq end-1-d (if dtend-1-dec + (icalendar--datetime-to-diary-date dtend-1-dec) + start-d)) + (setq end-t (if (and + dtend-dec + (not (string=3D + (cadr + (icalendar--get-event-property-attributes + e 'DTEND)) + "DATE"))) + dtend-dec + start-t)) + (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d) + (let ((location (icalendar--get-event-property e 'LOCATION)) + (organizer (icalendar--get-event-properties-full e 'ORGANIZER)) + (summary (icalendar--get-event-property e 'SUMMARY)) + (description (icalendar--get-event-property e 'DESCRIPTION)) + (attendees (icalendar--get-event-properties-full e 'ATTENDEE)) + (uid (icalendar--get-event-property e 'UID)) + (sequence (icalendar--get-event-property e 'SEQUENCE)) + (created (icalendar--decode-isodatetime (icalendar--get-event-property = +e 'CREATED))) + (last-modified (icalendar--decode-isodatetime (icalendar--get-event-pro= +perty e 'LAST-MODIFIED)))) + (setq result (cons `(start ,start-d + end ,end-d + location ,location + organizer ,organizer + summary ,summary + description ,description=20 + attendees ,attendees + uid ,uid + sequence ,sequence + created ,created + last-modified ,last-modified) result))) + ;; (cond + ;; ;; recurring event + ;; (rrule + ;; (setq diary-string + ;; (icalendar--convert-recurring-to-diary e dtstart-dec start-t + ;; end-t)) + ;; (setq event-ok t)) + ;; (rdate + ;; (icalendar--dmsg "rdate event") + ;; (setq diary-string "") + ;; (mapc (lambda (datestring) + ;; (setq diary-string + ;; (concat diary-string + ;; (format "......")))) + ;; (icalendar--split-value rdate))) + ;; ;; non-recurring event + ;; ;; all-day event + ;; ((not (string=3D start-d end-d)) + ;; (setq diary-string + ;; (icalendar--convert-non-recurring-all-day-to-diary + ;; e start-d end-1-d)) + ;; (setq event-ok t)) + ;; ;; not all-day + ;; ((and start-t (or (not end-t) + ;; (not (string=3D start-t end-t)))) + ;; (setq diary-string + ;; (icalendar--convert-non-recurring-not-all-day-to-diary + ;; e dtstart-dec dtend-dec start-t end-t)) + ;; (setq event-ok t)) + ;; ;; all-day event + ;; (t + ;; (icalendar--dmsg "all day event") + ;; (setq diary-string (icalendar--datetime-to-diary-date + ;; dtstart-dec "/")) + ;; (setq event-ok t))) + ;; add all other elements unless the user doesn't want to have + ;; them + ;; (if event-ok + ;; (progn + ;; ;; (setq diary-string + ;; ;; (concat diary-string " " + ;; ;; (icalendar--format-ical-event e))) + ;; ;; (if do-not-ask (setq summary nil)) + ;; ;; ;; add entry to diary and store actual name of diary + ;; ;; ;; file (in case it was nil) + ;; ;; (setq diary-file + ;; ;; (icalendar--add-diary-entry diary-string diary-file + ;; ;; non-marking summary)) + ;; (format ) + ;; ) + ;; ;; event was not ok + ;; (setq found-error t) + ;; (setq error-string + ;; (format "%s\nCannot handle this event:%s" + ;; error-string e))) + ))) + result)) + + +(defun org-ical-format-contact (organizer-list) + (let ((e-mail (car (last organizer-list))) + (cn (find 'CN organizer-list :test (lambda (key item) (and (listp item) (= +eq (car item) key)))))) + (if (string-prefix-p "mailto:" e-mail t) + (setq e-mail (substring e-mail (length "mailto:")))) + (format "%s<%s>" (if cn (format "\"%s\" " (cadr cn)) "") e-mail))) + +(defun org-ical-parse-file (filename) + (save-current-buffer + (set-buffer (find-file filename)) + (prog1=20 + (ical-parse-important-data (icalendar--read-element nil nil)) + (kill-buffer)))) + +(defun org-ical-create-entry (event) + (let* ((start (plist-get event 'start)) + (end (plist-get event 'end)) + (uid (plist-get event 'uid)) + (description (plist-get event 'description)) + (location (plist-get event 'location)) + (organizer (plist-get event 'organizer)) + (summary (plist-get event 'summary)) + (created (plist-get event 'created)) + (last-modified (plist-get event 'last-modified)) + (sequence (plist-get event 'sequence)) + (priority (plist-get event 'priority)) + (attendees (plist-get event 'attendees))) + (cons uid (replace-regexp-in-string "\\\\n" "\n" + (replace-regexp-in-string "\\\\," "," (substring-no-properties (format= +=20 + "* %s + :PROPERTIES: + :ID: %s + :START-TIME: %s + :END-TIME: %s + :LOCATION: %s + :ORGANIZER: %S + :ATTENDEES: %S + :CREATED: %s + :LAST-MODIFIED: %s + :SEQUENCE: %s + :PRIORITY: %s + :END: + %s + %s--%s" + summary + uid + (apply 'encode-time start) + (apply 'encode-time end) + location + (org-ical-format-contact (car organizer)) + (mapcar 'org-ical-format-contact attendees) + (if created (format-time-string (org-time-stamp-format t t) (a= +pply 'encode-time created)) nil)=20 + (if last-modified (format-time-string (org-time-stamp-format t= + t) (apply 'encode-time last-modified)) nil)=20 + sequence + priority + description + (format-time-string (org-time-stamp-format t) (apply 'encode-t= +ime start)) + (format-time-string (org-time-stamp-format t) (apply 'encode-t= +ime end)) +))))))) + +(defun org-ical-insert-or-update-event (filename) + (let* ((events (org-ical-parse-file filename)) + (uid+org-entries (mapcar 'org-ical-create-entry events))) + (dolist (uid+entry uid+org-entries) + (let ((uid (car uid+entry)) + (entry (cdr uid+entry))) + (let ((org-entry (org-id-find uid))) + (if org-entry + (org-ical-update-event entry org-entry) + (org-ical-insert-event entry))))))) + +(defun org-ical-insert-event (new-entry) + (kill-new (substring-no-properties new-entry)) + (org-capture nil "K")) + +(defun org-ical-update-event (new-entry org-entry) +;; use org-narrow-to-subtree or org-tree-to-indirect-buffer + (error "Not implemented yet, updating event %S with existing entry %S" ne= +w-entry org-entry)) + +(provide 'org-ical) + +;(org-ical-insert-or-update-event "/tmp/test.ical") +;(org-ical-parse-file "/tmp/test.ical") + + + + +--=-=-=-- -- 2.26.2