#!/usr/bin/env -S emacs -Q --script
;; -*- lexical-binding: t -*-

(require 'cl-lib)
(require 'json)

(defconst list-sleep-locks-bin
  (expand-file-name "~/scripts/cl/bin/list-manual-sleep-locks"))

(defun make-pretty-timestamp (offset)
  "Return a pretty-printed string timestamp of UTC + offset (in seconds)."
  (format-time-string "%H:%M:%S %b %-e"
                      (+ (time-convert nil 'integer) offset)))

(defun list-running-locks ()
  "List all running manual sleep locks."
  (with-temp-buffer
    (when-let ((rval (call-process list-sleep-locks-bin nil t))
               ((eql rval 0)))
      (goto-char (point-min))
      (cl-loop
       while (not (eobp))
       for (length sec-str) = (split-string
                               (buffer-substring (point) (pos-eol)) " ")
       when (equal length "infinity")
       collect (cons "infinity" "next restart")
       else
       collect (cons length (make-pretty-timestamp (cl-parse-integer sec-str)))
       do (forward-line)))))

(defun format-tooltip (locks)
  "Format a tooltip for a list of LOCKS."
  (cond
   ((null locks) "No manual sleep locks")
   ((length= locks 1)
    (format "Sleep manually locked until %s" (cdar locks)))
   (t
    (with-temp-buffer
      (insert "<tt>\n")
      (cl-loop
       for lock in locks
       maximize (length (car lock)) into first-col-len
       maximize (length (cdr lock)) into second-col-len
       finally
       (progn
         (setq first-col-len (max first-col-len (length "Length"))
               second-col-len (max second-col-len (length "Until")))
         (insert (string-pad "Length" first-col-len) "  Until\n")
         (insert (make-string (+ first-col-len 2 second-col-len) ?-) "\n")
         (dolist (lock locks)
           (cl-destructuring-bind (length . end) lock
             (insert (string-pad length first-col-len) "  " end "\n")))))
      (insert "</tt>")
      (buffer-substring-no-properties (point-min) (point-max))))))

(defun format-output-line (locks)
  "Format a line of output for LOCKS."
  (json-encode `(:text ,(if locks "󱙱 " "")
                 :tooltip ,(format-tooltip locks))))

(defun print-running-locks ()
  "Print running locks in JSON."
  (interactive)
  (princ (format-output-line (list-running-locks)))
  (terpri)
  (flush-standard-output))

(define-key special-event-map '[sigusr1] #'print-running-locks)

(print-running-locks)
(while t
  (read-event))

;; Local Variables:
;; flycheck-disabled-checkers: (emacs-lisp-checkdoc)
;; End:
