;;; vm-vcal.el --- vcal/ical parsing and formatting routines for VM

;; Author: Noah Friedman <friedman@splode.com>
;; Created: 2014-05-09
;; Public domain

;; $Id: vm-vcal.el,v 1.2 2016/11/19 00:24:13 friedman Exp $

;;; Commentary:

;; The icalendar.el API needs a major overhaul.  Probably a rewrite.
;; For one thing it could stand to do more parsing of fields with
;; standardized formats into native elisp data structures.

;;; Code:

(require 'icalendar)

;;;###autoload
(defvar vm-vcal-format-function 'vm-vcal-format-ical-event
  "*Function to use for formatting vcal/ical entries; if nil, use default.")

;;;###autoload
(defun vm-mime-display-internal-text/calendar (layout)
  (let ((inhibit-read-only t)
        (buffer-read-only nil))
    (apply 'insert (vm-vcal-format-layout layout)))
  t)

(defun vm-vcal-format-layout (layout)
  ;;(setq vm-ical-data (vm-vcal-parse layout))
  (mapcar vm-vcal-format-function
          (icalendar--all-events (vm-vcal-parse layout))))

(defun vm-vcal-parse (layout)
  (let* ((beg (vm-mm-layout-body-start layout))
         (end (vm-mm-layout-body-end   layout))
         (obuf (if (markerp beg) (marker-buffer beg) (current-buffer)))
         (str (save-current-buffer
                (set-buffer obuf)
                (save-restriction
                  (widen)
                  (buffer-substring-no-properties beg end))))
         (tbuf (generate-new-buffer " *vcal decoding*")))
    (save-current-buffer
      (set-buffer tbuf)
      (insert str)
      (vm-mime-transfer-decode-region layout (point-min) (point-max))
      (kill-buffer (prog1
                       tbuf
                     (setq tbuf (icalendar--get-unfolded-buffer tbuf))))
      (set-buffer tbuf)
      (goto-char (point-min))
      (prog1
          (icalendar--read-element nil nil)
        (kill-buffer tbuf)))))

(defun vm-vcal-property-attributes (event propname &optional propval)
  (if (null propval)
      (icalendar--get-event-property-attributes event prop)
    (catch 'found
      (let ((props (caddr event)) pp)
        (while props
          (setq pp (car props))
          (if (and (eq (car pp) prop)
                   (equal (caddr pp) propval))
              (throw 'found (cadr pp)))
          (setq props (cdr props)))))))

(defun vm-vcal-fetch (event prop)
  (save-match-data
    (let ((l (mapcar 'icalendar--convert-string-for-import
                     (icalendar--get-event-properties event prop)))
          (s ""))
      (cond ((null l))

            ((and (memq prop '(DTSTART DTEND))
                  (string-match "^\\(....\\)\\(..\\)\\(..\\)T\\(..\\)\\(..\\)\\(..\\)" (car l)))
             (let* ((plist (vm-vcal-property-attributes event prop))
                    (tz (plist-get plist 'TZID)))
               (setq s (apply 'format "%s-%s-%s %s:%s:%s"
                              (mapcar (lambda (n) (match-string n (car l)))
                                      '(1 2 3 4 5 6))))
               (when tz
                 (if (string-match "(UTC\\([-+][0-9]+\\):\\([0-9]+\\))" tz)
                     (setq s (concat s " " (match-string 1 tz) (match-string 2 tz)))
                   (setq s (concat s " " tz))))))


            ((and (memq prop '(ORGANIZER ATTENDEE)))
             (setq s (mapconcat (lambda (val)
                                  (let* ((plist (vm-vcal-property-attributes event prop val))
                                         (cn (plist-get plist 'CN)))
                                    (when (string-match "^mailto:" val)
                                      (setq val (substring val (match-end 0))))
                                    (if cn
                                        (format "%s <%s>" cn val)
                                      val)))
                                l "\n")))

            (t
             (setq s (mapconcat 'identity l ", " ))))
      s)))

(defun vm-vcal-format-ical-event (event)
  (let* ((att-fmt "Attendees  : ")
         (att (mapconcat 'identity
                         (split-string (vm-vcal-fetch event 'ATTENDEE) "\n" t)
                         (concat "\n" (make-string (length att-fmt) #x20))))
         (s (apply 'format "\
%s
\n %s
Location   : %s
Time start : %s
Time end   : %s
Status     : %s
Organizer  : %s"
                   (mapcar (lambda (prop) (vm-vcal-fetch event prop))
                           '(SUMMARY DESCRIPTION LOCATION DTSTART DTEND STATUS ORGANIZER ATTENDEE)))))
    (if att
        (concat s "\n" att-fmt att)
      s)))

(provide 'vm-vcal)

;;; vm-vcal.el ends here.