HEmP

(defun ifi-ckout-fossil-all-checkouts ()
  (split-string
   (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-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))

(defun ifi-ckout-forget-all-stanza-markers ()
  ;; #'ifi-state-headline-marker returns nil when

;;; Commentary:
;;
;; • IFI functions used in more than one ifi-*.el file.

;;; Code:

(require 'filenotify)
(require 'ifi-custom)
(require 'ifi-state)


;;; utils
(defun ifi-lib-strip-trailing-whitespace (string)
  (if (string-match "[ \t\n\r]+\\'" string)

(require 'cl-macs)


(defvar ifi-states nil)

(cl-defstruct ifi-state
  ;; IFI data
  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)

(defun ifi-state-get-state (dir)

(defun ifi-state-parse-changes-differ (s)
  (let* ((default-directory (ifi-state-canonical-directory s))
         (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