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)))))

status-bar/sb-manual-sleep-locks

@@ -0,0 +1,74 @@
+#!/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:

system-menu/system-menu.sh

@@ -8,25 +8,19 @@ function is-desktop-p {
     ! is-laptop-p
 }
 
-systemctl --user --quiet is-active swayidle.service \
-    && swayidle_state="Enabled" || swayidle_state="Disabled"
-
 # Format: label action condition
 local entries=('Select system sound output' 'select-sound-output.sh' 'true'
-               "Enable or disable system sleep (Current: ${swayidle_state})" 'system-sleep-menu.sh' 'true'
+               "Enable or disable system sleep" 'system-sleep-menu.sh' 'true'
                'Enable or disable TV' 'tv-power-menu.sh' 'is-desktop-p'
                'Configure USB device access' 'usbguard-menu.py' 'pgrep usbguard-daemon'
                'Power settings (restart and shutdown)' 'system-power-menu.sh' 'true'
-               'Login to captive portal protected WiFi' 'login-to-wifi.sh' 'is-laptop-p'
+               'Login to captive portal protected WiFi' 'login-to-wifi.sh' 'is-laptop-p')
-               # I'm not using eww right now
-               # 'Restart top bar' 'river-restart-eww.sh' '[[ "${XDG_CURRENT_DESKTOP}" == river ]]'
-              )
 
 local entry_array=()
 local enabled_entries=()
 for ((i = 1; i <= ${#entries}; i+=3)); do
     if eval "${entries[${i} + 2]}" >/dev/null 2>&1; then
-        entry_array[$((${i} / 3 + 1))]="${entries[${i}]}"
+        entry_array[$((i / 3 + 1))]="${entries[i]}"
         enabled_entries+=(${entries[@]:${i} - 1:3})
     fi
 done

system-menu/system-sleep-menu.sh

@@ -1,31 +1,60 @@
 #!/usr/bin/env zsh
 
-let is_active=0
+zmodload zsh/datetime
-systemctl --user --quiet is-active swayidle.service && is_active=1
+zmodload zsh/mathfunc
+setopt typeset_silent
 
-local swayidle_state
+local TIMES=(1m 5m 10m 15m 30m 1h 2h 4h 1d forever)
-(( is_active )) && swayidle_state='Enabled' || swayidle_state='Disabled'
 
-choice="$(fuzzel --index -d -p "Cur: ${swayidle_state} > " <<'EOF'
+local -a running_locks
-Enable
-Disable
-EOF
-)"
 
-(( ${?} != 0 )) && exit
+() {
+    local IFS=$'\n '
+    running_locks=(${="$("${HOME}/scripts/cl/bin/list-manual-sleep-locks")"})
+}
 
-case "${choice}" in
+let base_time=${EPOCHSECONDS}
-    0)
+for ((i = 2; i <= ${#running_locks}; i+=2)); do
-        systemctl --user start swayidle.service
+    local nsecs="${running_locks[i]}"
-        ;;
+    if [[ "${nsecs}" == infinity ]]; then
-    1)
+        running_locks[i]="next reboot"
-        systemctl --user stop swayidle.service
+    else
-        ;;
+        running_locks[i]=$(strftime -n '%H:%M:%S %b %-e' \
-esac
+                                    $(( base_time + nsecs )))
+    fi
+done
 
-if [[ "${XDG_CURRENT_DESKTOP}" == 'river' ]]; then
+function is_valid_sleep_time() {
-    eww -c "${HOME}/.config/river/config/" update swayidle="$(( ! ${choice} ))"
+    [[ "${1}" = forever ]] \
-    pkill -RTMIN+3 waybar
+        || [[ "${1}" =~ ' *([0-9]+[smhd]? *)+' ]]
-elif [[ "${XDG_CURRENT_DESKTOP}" == 'Hyprland' ]]; then
+}
-    pkill -SIGRTMIN+1 waybar
+
+if (( ${#running_locks} )); then
+    # We have existing locks
+    local prompt plural_s
+    if (( ${#running_locks} > 2 )); then
+        let count_locks=$(( int(${#running_locks} / 2) ))
+        prompt="Locked by ${count_locks} locks until ${running_locks[2]}> "
+        plural_s='s'
+    else
+        prompt="Locked until ${running_locks[2]}> "
+    fi
+    local choice
+    choice="$(printf "Cancel lock${plural_s}\n" \
+              | fuzzel --dmenu --only-match --index -p "${prompt}")"
+    if (( ${?} == 0 )) && (( ${choice} == 0 )); then
+        systemctl --user stop 'manual-inhibit-sleep@*.service'
+    fi
+else
+    # No locks
+    local choice
+    choice="$(printf '%s\n' ${TIMES} | fuzzel -d -p "Inhibit sleep for> ")"
+    if (( ${?} )); then
+        exit
+    elif is_valid_sleep_time "${choice}"; then
+        [[ "${choice}" == forever ]] && choice=infinity
+        systemctl --user start "manual-inhibit-sleep@${choice}.service"
+    else
+        printf 'Invalid sleep time: %s\n' "${choice}" 1>&2
+    fi
 fi

systemd/manual-inhibit-sleep@.service

@@ -3,7 +3,9 @@ Description=Inhibit sleep for some period of time
 
 [Service]
 Type=exec
-ExecStart=systemd-inhibit --what=sleep:idle "--who=manual-inhibit-sleep@.service" --mode=block "--why=User manually inhibited sleep" sleep %i
+ExecStartPre=-pkill -f -SIGUSR1 '^(.*/)?emacs +-Q +--script +(.*/)?sb-manual-sleep-locks( +.+)?$'
+ExecStart=systemd-inhibit --what=sleep:idle "--who=manual-inhibit-sleep@%i.service" --mode=block "--why=User manually inhibited sleep" sleep %i
+ExecStopPost=-pkill -f -SIGUSR1 '^(.*/)?emacs +-Q +--script +(.*/)?sb-manual-sleep-locks( +.+)?$'
 
 [Install]
 WantedBy=default.target