Files
random-scripts/status-bar/sb-manual-sleep-locks

77 lines
2.4 KiB
Plaintext
Executable File

#!/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: