75 lines
2.3 KiB
Plaintext
Executable File
75 lines
2.3 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
|
|
(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:
|