branch: master
commit 1833a795fe978e53f574e8fb28ee294a25541dd3
Author: Thomas Fitzsimmons <fitz...@fitzsim.org>
Commit: Thomas Fitzsimmons <fitz...@fitzsim.org>
packages/excorporate: Add diary and appt integration
* packages/excorporate/excorporate-diary.el: New file.
* packages/excorporate/excorporate.el: Bump Emacs version
requirement to 24.4.
(exco-calendar-item-iterate): Silence a byte compilation warning.
---
packages/excorporate/excorporate-diary.el | 237 ++++++++++++++++++++++++++++++
packages/excorporate/excorporate.el | 4 +-
2 files changed, 240 insertions(+), 1 deletion(-)
diff --git a/packages/excorporate/excorporate-diary.el
b/packages/excorporate/excorporate-diary.el
new file mode 100644
index 0000000..dcd6cc2
--- /dev/null
+++ b/packages/excorporate/excorporate-diary.el
@@ -0,0 +1,237 @@
+;;; excorporate-diary.el --- Diary integration -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <fitz...@fitzsim.org>
+;; Keywords: calendar
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Wrap interactive `diary-lib' functions so that they query the
+;; Exchange server asynchronously, then display retrieved results
+;; interleaved with local diary entries.
+
+;;; Code:
+
+(require 'diary-lib)
+(require 'calendar)
+(require 'icalendar)
+(require 'appt)
+(require 'excorporate)
+
+(defun exco-diary-diary-make-entry (string &optional nonmarking file)
+ "Insert a diary entry STRING which may be NONMARKING in FILE.
+If omitted, NONMARKING defaults to nil and FILE defaults to
+`diary-file'."
+ (with-current-buffer (find-file-noselect (or file diary-file))
+ (when (eq major-mode (default-value 'major-mode)) (diary-mode))
+ (widen)
+ (diary-unhide-everything)
+ (goto-char (point-max))
+ (when (let ((case-fold-search t))
+ (search-backward "Local Variables:"
+ (max (- (point-max) 3000) (point-min))
+ t))
+ (beginning-of-line)
+ (insert "\n")
+ (forward-line -1))
+ (insert
+ (if (bolp) "" "\n")
+ (if nonmarking diary-nonmarking-symbol "")
+ string)))
+
+(defadvice icalendar--add-diary-entry (around
+ exco-diary-icalendar--add-diary-entry
+ activate)
+ "Prevent whitespace workaround from selecting diary buffer.
+Also prevent `diary-make-entry' from putting the diary file
+where (other-buffer (current-buffer)) will return it."
+ (cl-letf (((symbol-function #'find-file)
+ (symbol-function #'find-file-noselect))
+ ;; This override suppresses diary-make-entry's window
+ ;; and buffer manipulations.
+ ((symbol-function #'diary-make-entry)
+ (symbol-function #'exco-diary-diary-make-entry)))
+ ad-do-it))
+
+(defvar excorporate-diary-today-file
+ "~/.emacs.d/excorporate/diary-excorporate-today"
+ "The diary file where Excorporate should save today's meetings.
+This file will be #include'd in `diary-file' by
+`excorporate-diary-enable'.")
+
+(defvar excorporate-diary-transient-file
+ "~/.emacs.d/excorporate/diary-excorporate-transient"
+ "The diary file where Excorporate should save retrieved meetings.
+This file will be #include'd in `diary-file' by
+`excorporate-diary-enable'.")
+
+(defun exco-diary-initialize (today)
+ "Initialize diary files used by Excorporate.
+Run before retrieving diary entries from servers. TODAY is t to
+initialize for today's date, nil otherwise."
+ (message "Retrieving diary entries via Excorporate...")
+ ;; Keep today's entries if running on a day other than today. If
+ ;; retrieving results for today, delete results from days other than
+ ;; today, in case the transient file (having been filled in on a
+ ;; prior day) contains duplicate or stale results for today.
+ (let ((files (if today
+ (list excorporate-diary-today-file
+ excorporate-diary-transient-file)
+ (list excorporate-diary-transient-file))))
+ (dolist (file files)
+ (let ((directory (file-name-directory file)))
+ (unless (file-exists-p directory)
+ (make-directory directory))
+ (with-current-buffer (find-file-noselect file)
+ (delete-region (point-min) (point-max))
+ ;; Do not call `save-buffer' to avoid any hooks from being
+ ;; run. Otherwise `appt-update-list' in
+ ;; `write-file-functions' can cause an infinite
+ ;; connnection-callback loop.
+ (basic-save-buffer-1))))))
+
+(defun exco-diary-insert-meeting (finalize
+ subject start _end _location
+ _main-invitees _optional-invitees
+ icalendar-text)
+ "Insert a retrieved meeting into the diary.
+See also the documentation for `exco-calendar-item-iterate'. The
+arguments are SUBJECT, a string, the subject of the meeting,
+START, the start date and time in Emacs internal representation,
+and ICALENDAR-TEXT, iCalendar text representing the meeting.
+_END, _LOCATION, _MAIN-INVITEES, and _OPTIONAL-INVITEES are
+unused.
+
+Call FINALIZE after the meeting has been inserted."
+ (when (not (string-match "^Cancel[l]?ed: " subject))
+ ;; FIXME: Sometimes meetings are duplicated if they have
+ ;; overlapping (and (diary-cyclic ...) (diary-block ...)) ranges,
+ ;; e.g., on in the today file and one in the transient file.
+ ;; Maybe we should de-duplicate them in the final display. If the
+ ;; meeting start time is sometime today then put it in today's
+ ;; diary file, otherwise put it in the transient one.
+ (let* ((time (decode-time (current-time)))
+ (now (list (elt time 3) (elt time 4) (elt time 5)))
+ (dawn (apply #'encode-time 0 0 0 now))
+ (dusk (time-add dawn (seconds-to-time 86400)))
+ (file (if (and (time-less-p dawn start) (time-less-p start dusk))
+ excorporate-diary-today-file
+ excorporate-diary-transient-file)))
+ (with-temp-buffer
+ (insert icalendar-text)
+ (icalendar-import-buffer file t))))
+ (funcall finalize))
+
+;; Bound in appt-check.
+(defvar appt-display-diary)
+
+(defun exco-diary-diary-advice (today date advisee &rest arguments)
+ "Advise `diary' and `diary-view-entries' to add Excorporate support.
+TODAY is today's date in `calendar-current-date' format. DATE is
+the desired date to retrieve meetings for, in the same format.
+ADVISEE is the original function being advised. ARGUMENTS are
+the arguments to the advisee."
+ ;; FIXME: Currently numeric arguments to `diary' and
+ ;; `diary-view-entries' are ignored.
+ (exco-connection-iterate
+ (lambda ()
+ (exco-diary-initialize (calendar-date-equal today date)))
+ (lambda (identifier callback)
+ (cl-destructuring-bind (month day year) date
+ (exco-get-meetings-for-day identifier month day year callback)))
+ (lambda (identifier response finalizer)
+ (exco-calendar-item-with-details-iterate identifier response
+ #'exco-diary-insert-meeting
+ finalizer))
+ (lambda ()
+ (apply advisee arguments)
+ ;; Warning: It is crucial to set appt-display-diary to nil here,
+ ;; so that diary advice isn't entered repeatedly (ultimately via
+ ;; the `appt-update-list' hook in `write-file-functions'), which
+ ;; would create a connection-callback loop.
+ (let ((appt-display-diary nil))
+ (appt-check t))
+ (message "Done retrieving diary entries via Excorporate."))
+ t))
+
+(defun exco-diary-diary-around (original-diary &rest arguments)
+ "Call `diary' asynchronously.
+Retrieve diary entries via Excorporate before showing results.
+ORIGINAL-DIARY is the original `diary' function, and ARGUMENTS
+are the arguments to it."
+ (let ((today (calendar-current-date))
+ (date (calendar-current-date)))
+ (apply #'exco-diary-diary-advice today date original-diary arguments)))
+
+(defun exco-diary-diary-view-entries-override (&rest arguments)
+ "Override `diary-view-entries' to make it asynchronous.
+Retrieve diary entries via Excorporate before showing results.
+ARGUMENTS are the arguments to `diary-view-entries'."
+ (interactive "p")
+ (diary-check-diary-file)
+ (let ((today (calendar-current-date))
+ (date (calendar-cursor-to-date t)))
+ (apply #'exco-diary-diary-advice today date
+ #'diary-list-entries date arguments)))
+
+;;;###autoload
+(defun excorporate-diary-enable ()
+ "Enable Excorporate diary support."
+ (interactive)
+ ;; Remove these first so that `diary' will not be run by any save
+ ;; hooks.
+ (advice-remove #'diary #'exco-diary-diary-around)
+ (advice-remove #'diary-view-entries #'exco-diary-diary-view-entries-override)
+ (with-current-buffer (find-file-noselect diary-file)
+ (dolist (file (list excorporate-diary-transient-file
+ excorporate-diary-today-file))
+ (save-excursion
+ (goto-char (point-min))
+ (when (not (re-search-forward
+ (concat "^ *" diary-include-string " *\"" file "\"") nil t))
+ (exco-diary-diary-make-entry
+ (concat diary-include-string " \"" file "\""))
+ (save-buffer)))))
+ (advice-add #'diary :around #'exco-diary-diary-around)
+ (advice-add #'diary-view-entries :override
+ #'exco-diary-diary-view-entries-override)
+ (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
+ (add-hook 'diary-list-entries-hook 'diary-sort-entries)
+ (appt-activate 1)
+ (message "Excorporate diary support enabled."))
+
+;;;###autoload
+(defun excorporate-diary-disable ()
+ "Disable Excorporate diary support."
+ (interactive)
+ (advice-remove #'diary #'exco-diary-diary-around)
+ (advice-remove #'diary-view-entries #'exco-diary-diary-view-entries-override)
+ (with-current-buffer (find-file-noselect diary-file)
+ (dolist (file (list excorporate-diary-transient-file
+ excorporate-diary-today-file))
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward
+ (concat diary-include-string " \"" file "\"") nil t)
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point)))
+ (save-buffer)))))
+ (message "Excorporate diary support disabled."))
+
+(provide 'excorporate-diary)
+
+;;; excorporate-diary.el ends here
diff --git a/packages/excorporate/excorporate.el
b/packages/excorporate/excorporate.el
index 60b0cf6..e458028 100644
--- a/packages/excorporate/excorporate.el
+++ b/packages/excorporate/excorporate.el
@@ -8,7 +8,7 @@
;; Version: 0.7.7
;; Keywords: calendar
;; Homepage: https://www.fitzsim.org/blog/
-;; Package-Requires: ((emacs "24.1") (fsm "0.2") (soap-client "3.1.4")
(url-http-ntlm "2.0.3"))
+;; Package-Requires: ((emacs "24.4") (fsm "0.2") (soap-client "3.1.4")
(url-http-ntlm "2.0.3"))
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -754,6 +754,8 @@ OPTIONAL-INVITEES, a list of strings representing optional
participants."
RootFolder
Items)
response)
+ ;; Silence byte compiler unused warning.
+ item-identifier
(push (funcall callback subject start-internal end-internal
location main-invitees optional-invitees)
result-list))
