;; 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=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;
 CN=\"%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" 'method "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=\"" 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 data."
  (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-address-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=DATE:%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 depth declared-type)
  (let ((button))
    (setq button
	  (insert-button 
	   (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="text/calendar" method="REPLY" disposition=inline>
;; BEGIN:VCALENDAR
;; METHOD:REPLY
;; PRODID:Emacs
;; VERSION:2.0
;; BEGIN:VEVENT
;; ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=ACCEPTED;RSVP=TRUE;CN=craven@gmx
;;  .net:MAILTO:craven@gmx.net
;; DTSTART:20120321T130000Z
;; DTEND:20120321T140000Z
;; UID:040000008200E00074C5B7101A82E008000000005AE3DDCF5E07CD01000000000000000
;;  010000000A0757F7AAED41D4D8ABFCEFCA035BA3A
;; CLASS:PUBLIC
;; PRIORITY:5
;; DTSTAMP:20120321T123325Z
;; TRANSP:OPAQUE
;; STATUS:CONFIRMED
;; SEQUENCE:0
;; END:VEVENT
;; END:VCALENDAR