#!/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 "\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 "") (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: