code.delx.au - gnu-emacs-elpa/blob - packages/excorporate/excorporate-calfw.el.txt

   1 ;;; excorporate-calfw.el --- Exchange calendar view   -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org>
   6 ;; Keywords: calendar
   7
   8 ;; This program is free software: you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; Use the Calfw calendar framework to display daily meetings.
  24
  25 ;; To use this handler, set excorporate-calendar-show-day to
  26 ;; exco-calfw-show-day using `customize-variable'.
  27
  28 ;; This Excorporate handler requires the Calfw package, which is not
  29 ;; included in GNU ELPA because not all Calfw contributors have
  30 ;; copyright assignment papers on file with the FSF.
  31
  32 ;;; Code:
  33
  34 (require 'calfw)
  35 (require 'excorporate)
  36
  37 (defvar excorporate-calfw-buffer-name "*Excorporate*"
  38   "The buffer into which Calfw output is inserted.")
  39
  40 (defun exco-calfw-initialize-buffer (month day year)
  41   "Set up an initial blank Calfw buffer for date MONTH DAY YEAR."
  42   (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
  43     (display-buffer (current-buffer))
  44     (let ((status-source (make-cfw:source :name "Updating..."
  45                                           :data (lambda (_b _e) nil))))
  46       (cfw:create-calendar-component-buffer
  47        :date (cfw:date month day year) :view 'day
  48        :contents-sources (list status-source)
  49        :buffer (current-buffer)))))
  50
  51 (defun exco-calfw-add-meeting (subject start end location
  52                                        main-invitees optional-invitees)
  53   "Add a scheduled meeting to the event list.
  54 SUBJECT is a string, the subject of the meeting.  START is the
  55 meeting start time in Emacs internal date time format, and END is
  56 the end of the meeting in the same format.  LOCATION is a string
  57 representing the location.  MAIN-INVITEES and OPTIONAL-INVITEES
  58 are the requested participants."
  59   (let ((start-list (decode-time start))
  60         (end-list (decode-time end)))
  61     (make-cfw:event :title (concat
  62                             (format "\n\t%s" subject)
  63                             (format "\n\tLocation: %s" location)
  64                             (when main-invitees
  65                               (format "\n\tInvitees: %s"
  66                                       (mapconcat 'identity
  67                                                  main-invitees "; ")))
  68                             (when optional-invitees
  69                               (format "\n\tOptional: %s"
  70                                       (mapconcat 'identity
  71                                                  optional-invitees "; "))))
  72                     :start-date  (list (elt start-list 4)
  73                                        (elt start-list 3)
  74                                        (elt start-list 5))
  75                     :start-time  (list (elt start-list 2)
  76                                        (elt start-list 1))
  77                     :end-date    (list (elt end-list 4)
  78                                        (elt end-list 3)
  79                                        (elt end-list 5))
  80                     :end-time    (list (elt end-list 2)
  81                                        (elt end-list 1)))))
  82
  83 (defun exco-calfw-add-meetings (identifier response)
  84   "Add the connection IDENTIFIER's meetings from RESPONSE."
  85   (let ((event-list (exco-calendar-item-iterate response
  86                                                 #'exco-calfw-add-meeting)))
  87     (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
  88       (declare (special cfw:component))
  89       (let* ((new-source (make-cfw:source
  90                           :name (format "%S (as of %s)"
  91                                         identifier
  92                                         (format-time-string "%F %H:%M"))
  93                           :data (lambda (_b _e)
  94                                   event-list)))
  95              (sources (cfw:cp-get-contents-sources cfw:component))
  96              (new-sources (append sources (list new-source))))
  97         (cfw:cp-set-contents-sources cfw:component new-sources)))))
  98
  99 (defun exco-calfw-finalize-buffer ()
 100   "Finalize the Calfw widget after retrievals have completed."
 101   (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
 102     (declare (special cfw:component))
 103     (let ((sources (cfw:cp-get-contents-sources cfw:component))
 104           (status-source (make-cfw:source :name "Done."
 105                                           :data (lambda (_b _e) nil))))
 106       (cfw:cp-set-contents-sources cfw:component
 107                                    (cons status-source (cdr sources))))
 108     (cfw:cp-add-selection-change-hook cfw:component
 109                                       (lambda ()
 110                                         (apply #'exco-calfw-show-day
 111                                                (cfw:cursor-to-nearest-date))))
 112     (cfw:refresh-calendar-buffer nil)))
 113
 114 ;;;###autoload
 115 (defun exco-calfw-show-day (month day year)
 116   "Show meetings for the date specified by MONTH DAY YEAR."
 117   (exco-connection-iterate
 118    (lambda ()
 119      (exco-calfw-initialize-buffer month day year))
 120    (lambda (identifier callback)
 121      (exco-get-meetings-for-day identifier month day year
 122                                 callback))
 123    #'exco-calfw-add-meetings
 124    #'exco-calfw-finalize-buffer))
 125
 126 (provide 'excorporate-calfw)
 127
 128 ;;; excorporate-calfw.el ends here