Index: ifi-ckout.el ================================================================== --- ifi-ckout.el +++ ifi-ckout.el @@ -223,11 +223,12 @@ (ifi-lib-fossil-output-to-string "all" "list" "--ckout") "\n")) (defun ifi-ckout-refresh-stanza-state (checkout) (let ((s (ifi-state checkout))) (ifi-lib-refresh-headline-state s) - (ifi-state-parse-changes-differ s))) + (ifi-state-parse-changes-differ s) + (ifi-state-parse-ls s))) (defun ifi-ckout-checkout-states () ;; ifi-ckout-all-checkouts is bound in #'ifi-ckout-update-buffer (mapcar (lambda (c) (ifi-state c)) ifi-ckout-all-checkouts)) Index: ifi-lib.el ================================================================== --- ifi-lib.el +++ ifi-lib.el @@ -24,10 +24,11 @@ ;; ;; • IFI functions used in more than one ifi-*.el file. ;;; Code: +(require 'filenotify) (require 'ifi-custom) (require 'ifi-state) ;;; utils Index: ifi-state.el ================================================================== --- ifi-state.el +++ ifi-state.el @@ -57,12 +57,12 @@ (defvar ifi-states nil) (cl-defstruct ifi-state ;; IFI data - canonical-directory headline-marker change-markers - shell-buffer ui-buffer ui-port + canonical-directory canonical-subdirectories directory-watchers events + headline-marker change-markers shell-buffer ui-buffer ui-port ;; Fossil info project-name repository local-root config-db project-code checkout parent tags comment check-ins ;; Other fossil data autosync default-remote current-branch timeline-position changes) @@ -181,9 +181,167 @@ (output (ifi-lib-fossil-output-to-string "changes" "--differ"))) (setf (ifi-state-changes s) (split-string output "\n")) output)) +(defun ifi-state-parse-ls (s) + (let* ((default-directory (ifi-state-canonical-directory s)) + (output (ifi-lib-fossil-output-to-string "ls" ))) + (setf (ifi-state-canonical-subdirectories s) + (mapcar (lambda (f) (mapconcat #'identity f "/")) + (remove nil (cl-remove-duplicates + (mapcar (lambda (f) + (butlast + (split-string f "/" t))) + (split-string output "\n")) + :test #'equal)))) + output)) + + +;;; Notifications +;;; +;;; • Implementation +;;; +;;; Function `ifi-state-start-watchers' employs Emacs' +;;; `file-notify-add-watch' to add a watch for the canonical directory +;;; and any subdirectories to slot `directory-watchers'. A single +;;; callback function; `ifi-state--watcher-callback', receives _all_ +;;; events from _every_ watch, and adds a cons cell of the form +;;; (TIME . "FILE ACTION") to the `events' slot of the applicable +;;; `ifi-state'. Special variable `ifi-state--watcher-file-filter' +;;; is a regular expression employed in +;;; `ifi-state--watcher-callback' to decide which FILEs should be +;;; ignored. One ACTION is also ignored; the 'stopped' action. +;;; +;;; When events are being monitored, variable +;;; `ifi-state--event-monitor' is bound to an idle timer which calls +;;; function `ifi-state--event-monitor' every +;;; `ifi-state--event-monitor-frequency' seconds (default value 1). +;;; +;;; Function `ifi-state--event-monitor' maps function +;;; `ifi-state--act-on-events' across ALL `ifi-state's. Function +;;; `ifi-state--act-on-events' looks at the most recent event in +;;; each `events' slot and passes the `ifi-state' to each function +;;; in the list variable `ifi-state-event-actions' when the age of +;;; the most recent event is greater than +;;; `ifi-state--event-age-limit' (default value 1). If the +;;; `ifi-state--event-age-limit' has not been reached, nothing is +;;; done and events may continue to accumulate. Thus +;;; `ifi-state-event-actions' are not performed multiple times in +;;; rapid succession when bursts of events occur, e.g. on checkouts. +;;; +;;; Functions in `ifi-state-event-actions' must accept an +;;; `ifi-state' argument and should immediately consider the +;;; contents of the `events' slot. The contents will be erased by +;;; what should always be the final action in the list; +;;; `ifi-state--discard-events'. +;;; +;;; • Example usage (in a checkout directory) +;;; +;;; (ifi-state-start-watchers (ifi-state "~/workspace/foo")) +;;; (ifi-state-start-event-monitor) ; monitors ALL ifi-states +;;; (push ACTION ifi-state-event-actions) +;;; ... +;;; (ifi-state-stop-event-monitor) +;;; (ifi-state-stop-watchers (ifi-state "~/workspace/foo")) +;;; +;;; ACTION is a function accepting a single `ifi-state' argument. +;;; Adding function `ifi-state-event-debugger' to +;;; `ifi-state-event-actions', e.g. +;;; +;;; (push 'ifi-state-event-debugger ifi-state-event-actions) +;;; +;;; is a good way to see what's going on. + +(defvar ifi-state--watcher-file-filter + (let ((emacs-autosave-files "\\.?#.+") + (fossil-bookkeeping-files "\\.fslckout.*") + (fossil-comment-files ".+-comment-[0-9A-F]+\\.txt")) + (format ".+/\\(%s\\|%s\\|%s\\)" + emacs-autosave-files + fossil-bookkeeping-files + fossil-comment-files))) + +(defvar ifi-state--event-age-limit 1) +(defvar ifi-state--event-monitor-frequency 1) +(defvar ifi-state--event-monitor nil) ; for `cancel-timer' + +;;; utils + +(defun ifi-state--watcher-state (watcher) + (catch 'found + (dolist (s ifi-states) + (when (member watcher (ifi-state-directory-watchers s)) + (throw 'found s))) + nil)) ; '--- return value + +(defun ifi-state--watcher-callback (event) + (cl-destructuring-bind (watcher action &rest files) event + (dolist (file files) + (unless (or (string-match ifi-state--watcher-file-filter file) + (string= action "stopped")) + (push (cons (float-time (current-time)) + (format "%s %s" file action)) + (ifi-state-events + (ifi-state--watcher-state watcher))))))) + +(defun ifi-state--discard-events (s) + (setf (ifi-state-events s) nil)) + +(defun ifi-state--act-on-events (s) + (let* ((most-recent-event (car (ifi-state-events s))) + (age (float-time (time-subtract + nil (car most-recent-event))))) + (when (> age ifi-state--event-age-limit) + (dolist (action ifi-state-event-actions) (funcall action s))))) + +(defun ifi-state--event-monitor () + (mapc #'ifi-state--act-on-events ifi-states)) + +;;; API + +(defvar ifi-state-event-actions '(ifi-state--discard-events)) + +(defun ifi-state-start-watchers (s) + ;; should the watchers report changes to file attributes? + (unless (ifi-state-directory-watchers s) + (setf (ifi-state-directory-watchers s) + (list (file-notify-add-watch + (ifi-state-canonical-directory s) + '(change) ; attribute-change + #'ifi-state--watcher-callback))) + (dolist (d (ifi-state-canonical-subdirectories s)) + (push (file-notify-add-watch + d '(change) ; attribute-change + #'ifi-state--watcher-callback) + (ifi-state-directory-watchers s))) + (length (ifi-state-directory-watchers s)))) + +(defun ifi-state-stop-watchers (s) + (mapc #'file-notify-rm-watch (ifi-state-directory-watchers s)) + (setf (ifi-state-directory-watchers s) nil)) + +(defun ifi-state-start-event-monitor () + (unless ifi-state--event-monitor + (setq ifi-state--event-monitor + (run-with-timer + ifi-state--event-monitor-frequency + ifi-state--event-monitor-frequency + #'ifi-state--event-monitor)))) + +(defun ifi-state-stop-event-monitor () + (when ifi-state--event-monitor + (setf ifi-state--event-monitor + (cancel-timer ; returns NIL + ifi-state--event-monitor)))) + +(defun ifi-state-event-debugger (s) ; for `ifi-state-event-actions' + (with-current-buffer (get-buffer-create "*fossil notifications*") + (goto-char (point-max)) + (dolist (e (ifi-state-events s)) + (insert (format "%-18s %s\n" (car e) (cdr e)))) + (display-buffer (current-buffer)))) + (provide 'ifi-state) ;;; ifi-state.el ends here