Update waybar config

cl/build-binary.sh

@@ -8,6 +8,7 @@ fi
 bin_name="$(basename "$1" .lisp)"
 
 sbcl --load "$1" \
+     --eval "(sb-ext:disable-debugger)" \
      --eval "(sb-ext:save-lisp-and-die \"$bin_name\"
                :executable t
                :save-runtime-options t

cl/list-manual-sleep-locks.lisp

@@ -0,0 +1,158 @@
+(defpackage list-manual-sleep-locks
+  (:use :cl)
+  (:export #:toplevel))
+
+(in-package :list-manual-sleep-locks)
+
+(defclass running-lock ()
+  ((start-time :type integer
+               :accessor running-lock-start-time
+               :initarg :start-time
+               :initform 0
+               :documentation "The start time of the lock in microseconds. This
+is relative to the CLOCK_MONOTONIC clock id.")
+   (length :type (or integer null)
+           :accessor running-lock-length
+           :initarg :length
+           :initform 0
+           :documentation "The length of the lock in microseconds. A value of
+nil means forever."))
+  (:documentation "An object representing a running lock."))
+
+(defun monotonic-microseconds ()
+  "Return the value of the CLOCK_MONOTONIC clock in microseconds."
+  (multiple-value-bind (sec nanosec)
+      (sb-unix:clock-gettime sb-unix:clock-monotonic)
+    (+ (* sec 1000 1000)
+       (floor (/ nanosec 1000)))))
+
+(defun lock-microseconds-left (lock &key (from (monotonic-microseconds)))
+  "Return the number of microseconds left in LOCK. FROM is the point in time
+from which to calculate."
+  (with-slots (start-time length) lock
+    (when length
+      (- (+ start-time length) from))))
+
+(defun format-seconds (seconds)
+  "Return a string representing SECONDS in a human readable way."
+  (if (zerop seconds)
+      "0s"
+      (let* ((hours (floor (/ (abs seconds) 60 60)))
+             (mins (floor (/ (- (abs seconds) (* hours 60 60)) 60)))
+             (secs (- (abs seconds) (* mins 60) (* hours 60 60))))
+        (format nil "~@[~*-~]~[~:;~:*~Sh~]~[~:;~:*~Sm~]~[~:;~:*~Ss~]"
+                (minusp seconds) hours mins secs))))
+
+(defun split-key-value-line (line)
+  "Split LINE, in the form of key=vale, into a list of (key value)."
+  (let ((index (position #\= line :test #'eql)))
+    (list (subseq line 0 index)
+          (subseq line (1+ index)))))
+
+(defun extract-lock-length-string-from-service-name (name)
+  "Extract the lock length string from a service name NAME of the form
+\"NAME@TIME.service\"."
+  (let ((start-idx (1+ (position #\@ name)))
+        (end-idx (when (uiop:string-suffix-p name ".service")
+                   (- (length name) (length ".service")))))
+    (subseq name start-idx end-idx)))
+
+(defparameter *lock-length-string-units*
+  `((#\d . ,(* 24 60 60 1000 1000))
+    (#\h . ,(* 60 60 1000 1000))
+    (#\m . ,(* 60 1000 1000))
+    (#\s . ,(* 1000 1000)))
+  "Table mapping units (as characters) to microsecond lengths.")
+
+(defun lock-length-string-to-usecs (str)
+  "Convert the lock length string STR to microseconds (usec). Return nil if the
+string means infinite length."
+  (unless (equal str "infinity")
+    (loop with sum = 0
+          for i below (length str)
+          for c = (aref str i)
+          unless (eql c #\Space)
+            do (multiple-value-bind (num chars)
+                   (parse-integer str :start i :junk-allowed t)
+                 (unless num
+                   (error "Invalid time interval!"))
+                 (incf i chars)
+                 (let ((scale (assoc (if (< i (length str))
+                                         (aref str i)
+                                         #\s)
+                                     *lock-length-string-units*)))
+                   (unless scale
+                     (error "Invalid time interval!"))
+                   (incf sum (* num (cdr scale))))
+                 ;; (incf i) implied
+                 )
+          finally (return sum))))
+
+(defun list-locks-from-systemctl-show-output (stream)
+  "List all running locks in STREAM, which contains the output from systemctl's
+show command."
+  (let ((cur-params (cons nil nil))
+        (cur-params-count 0)
+        output)
+    (loop
+      for line = (read-line stream nil)
+      while line
+      do (if (zerop (length line))
+             (progn
+               (when (= cur-params-count 2)
+                 (push (make-instance 'running-lock
+                                      :start-time (cdr cur-params)
+                                      :length (car cur-params))
+                       output))
+               (setq cur-params-count 0))
+             (destructuring-bind (key value)
+                 (split-key-value-line line)
+               (cond
+                 ((equal key "Id")
+                  (ignore-errors
+                   (setf (car cur-params)
+                         (lock-length-string-to-usecs
+                          (extract-lock-length-string-from-service-name value)))
+                   (incf cur-params-count)))
+                 ((equal key "ExecMainStartTimestampMonotonic")
+                  (setf (cdr cur-params) (parse-integer value))
+                  (incf cur-params-count))))))
+    (when (= cur-params-count 2)
+      (push (make-instance 'running-lock
+                           :start-time (cdr cur-params)
+                           :length (car cur-params))
+            output))
+    output))
+
+(defun list-running-locks ()
+  "Return a list of running locks."
+  (with-input-from-string
+      (stream (uiop:run-program '("systemctl" "--user" "--no-pager" "--full"
+                                  "show" "manual-inhibit-sleep@*.service")
+                                :output :string
+                                :error-output :interactive
+                                :input nil))
+    (list-locks-from-systemctl-show-output stream)))
+
+(defun sort-running-locks (locks &optional (start-usecs (monotonic-microseconds)))
+  "Sort a list of running locks with one's ending sooner sorting after."
+  (sort locks (lambda (lock1 lock2)
+                (let ((usec1 (lock-microseconds-left
+                              lock1 :from start-usecs))
+                      (usec2 (lock-microseconds-left
+                              lock2 :from start-usecs)))
+                  (or (not usec1)
+                      (and usec2 (> usec1 usec2)))))))
+
+(defun toplevel ()
+  "Main program entry point."
+  (loop with start-usecs = (monotonic-microseconds)
+        for lock in (sort-running-locks (list-running-locks) start-usecs)
+        for rem-usec = (lock-microseconds-left lock :from start-usecs)
+        when (not rem-usec)
+          do (format t "infinity infinity~%")
+        else when (plusp rem-usec)
+               do (format t "~A ~A~%"
+                          (format-seconds
+                           (floor (/ (running-lock-length lock) 1000 1000)))
+                          (floor (/ rem-usec 1000 1000)))))