From: Peter Feigl <craven@gmx.net>
To: notmuch@notmuchmail.org
Subject: Re: converting notmuch email to 'TODO' entry in org-mode
In-Reply-To: <87txls7f8r.fsf@krugs.de>
References: <uaxbo803kqx.fsf@beesknees.cern.ch> <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="=-=-="
Precedence: list

--=-=-=
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")




--=-=-=--