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

   1 ;;; excorporate-org.el --- Exchange Org Mode view     -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 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 Org Mode to display daily meetings.
  24
  25 ;;; Code:
  26
  27 (require 'org)
  28 (require 'excorporate)
  29
  30 (defvar excorporate-org-buffer-name "*Excorporate*"
  31   "The buffer into which Org Mode output is inserted.")
  32
  33 (defun exco-org-initialize-buffer ()
  34   "Add initial text to the destination buffer."
  35   (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
  36       (setq buffer-read-only t)
  37       ;; Some Org mode configurations need `buffer-file-name' to be
  38       ;; non-nil, or they'll make `org-mode' error out, for example
  39       ;; `org-startup-with-latex-preview'.  Set `buffer-file-name' to
  40       ;; something non-nil temporarily during initialization.  Don't
  41       ;; leave it set or `save-some-buffers' will always prompt about
  42       ;; *Excorporate*.
  43       (let ((buffer-file-name excorporate-org-buffer-name))
  44         (org-mode))
  45       (use-local-map (copy-keymap org-mode-map))
  46       (local-set-key "q" 'quit-window)
  47       (display-buffer (current-buffer))
  48       (let ((inhibit-read-only t))
  49         (delete-region (point-min) (point-max))
  50         (goto-char 1)
  51         (insert "# Updated...\n"))))
  52
  53 (defun exco-org-format-headline (identifier)
  54   "Format an Org headline using IDENTIFIER."
  55   (format "* Calendar (%s)\n" identifier))
  56
  57 (defun exco-org-insert-meeting-headline (subject start-time end-time)
  58   "Insert and schedule a meeting.
  59 SUBJECT is the meeting's subject, START-TIME and END-TIME are the
  60 meeting's start and end times in the same format as is returned
  61 by `current-time'."
  62   (let* ((now (current-time))
  63          (keyword (if (time-less-p now end-time)
  64                       "TODO"
  65                     "DONE")))
  66     (insert (format "** %s %s\n" keyword subject))
  67     (org-schedule nil (format-time-string "<%Y-%m-%d %a %H:%M>"
  68                                           start-time))
  69     (forward-line -1)
  70     (end-of-line)
  71     (insert  "--" (format-time-string "<%Y-%m-%d %a %H:%M>" end-time))
  72     (forward-line)
  73     (org-insert-time-stamp (current-time) t t "+ Retrieved " "\n")))
  74
  75 (defun exco-org-insert-invitees (invitees)
  76   "Parse and insert a list of invitees, INVITEES."
  77   (dolist (invitee invitees)
  78     (insert (format "  + %s\n" invitee))))
  79
  80 (defun exco-org-insert-headline (identifier month day year)
  81   "Insert Org headline for IDENTIFIER on date MONTH DAY YEAR."
  82   (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
  83     (let ((inhibit-read-only t))
  84       (insert (exco-org-format-headline identifier))
  85       (org-insert-time-stamp (encode-time 0 0 0 day month year)
  86                              nil t "  + Date " "\n"))))
  87
  88 (defun exco-org-insert-meeting (subject start end location
  89                                         main-invitees optional-invitees)
  90   "Insert a scheduled meeting.
  91 SUBJECT is a string, the subject of the meeting.  START is the
  92 meeting start time in Emacs internal date time format, and END is
  93 the end of the meeting in the same format.  LOCATION is a string
  94 representing the location.  MAIN-INVITEES and OPTIONAL-INVITEES
  95 are the requested participants."
  96   (exco-org-insert-meeting-headline subject start end)
  97   (insert (format "+ Duration: %d minutes\n"
  98                   (round (/ (float-time (time-subtract end start)) 60.0))))
  99   (insert (format "+ Location: %s\n" location))
 100   (when main-invitees
 101     (insert "+ Invitees:\n")
 102     (exco-org-insert-invitees main-invitees))
 103   (when optional-invitees
 104     (insert "+ Optional invitees:\n")
 105     (exco-org-insert-invitees optional-invitees)))
 106
 107 (defun exco-org-insert-meetings (identifier response)
 108   "Insert the connection IDENTIFIER's meetings from RESPONSE."
 109   (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
 110     (let ((inhibit-read-only t)
 111           (name-regexp (concat "\\" (exco-org-format-headline identifier))))
 112       (goto-char 1)
 113       (end-of-line)
 114       (insert (format "%s..." identifier))
 115       (goto-char (point-max))
 116       (re-search-backward name-regexp nil)
 117       (forward-line 2)
 118       (org-insert-time-stamp (current-time) t t "  + Last checked " "\n")
 119       (exco-calendar-item-iterate response #'exco-org-insert-meeting)
 120       (re-search-backward name-regexp nil)
 121       (if (save-excursion (org-goto-first-child))
 122           (org-sort-entries t ?s)
 123         (forward-line 3)
 124         (insert "`♘")))))
 125
 126 (defun exco-org-finalize-buffer ()
 127   "Finalize text in buffer after all connections have responded."
 128   (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
 129     ;; Sort top-level entries alphabetically.
 130     (let ((inhibit-read-only t))
 131       (goto-char (point-min))
 132       (end-of-line)
 133       (insert "done.")
 134       (org-sort-entries t ?a))))
 135
 136 ;;;###autoload
 137 (defun exco-org-show-day (month day year)
 138   "Show meetings for the date specified by MONTH DAY YEAR."
 139   (exco-connection-iterate #'exco-org-initialize-buffer
 140                            (lambda (identifier callback)
 141                              (exco-org-insert-headline identifier
 142                                                        month day year)
 143                              (exco-get-meetings-for-day identifier
 144                                                         month day year
 145                                                         callback))
 146                            #'exco-org-insert-meetings
 147                            #'exco-org-finalize-buffer))
 148
 149 (provide 'excorporate-org)
 150
 151 ;;; excorporate-org.el ends here