stumpwm/sensors.lisp @ 30faa48af4ce
default tip
More
author |
Steve Losh <steve@stevelosh.com> |
date |
Mon, 19 Aug 2024 08:56:24 -0400 |
parents |
e6e13bf8dad4 |
children |
(none) |
(in-package :stumpwm-user)
(defun ? (obj &rest keys)
(if (null keys)
obj
(apply #'? (etypecase obj
(hash-table (gethash (first keys) obj)))
(rest keys))))
(defun parse-sensors ()
;; sensors -j is stupid and will output errors before the actual output on
;; standard out, instead of putting them on standard err like a reasonable
;; program, e.g.:
;;
;; ERROR: Can't get value of subfeature temp1_input: Can't read
;; {
;; "iwlwifi_1-virtual-0":{ … },
;; …
;;
;; So we'll have to drop the `ERROR` lines before we can get to the actual
;; goddamn JSON. UNIX programs are so great.
(let ((s (losh:sh '("sensors" "-j") :result-type 'stream)))
(loop :while (char= #\E (peek-char nil s)) :do (read-line s))
(jarl:read t s)))
(defun sensors% (&aux (sensors (parse-sensors)))
(hostcase
(:ouroboros (format nil "[CPU ~D°C] [GPU ~D°C ~D°C ~D°C]"
(round (? sensors "nct6779-isa-0290" "CPUTIN" "temp2_input"))
(round (? sensors "amdgpu-pci-4500" "edge" "temp1_input"))
(round (? sensors "amdgpu-pci-4500" "junction" "temp2_input"))
(round (? sensors "amdgpu-pci-4500" "mem" "temp3_input"))))
((:gro :juss) (format nil "[CPU ~D°C] [GPU ~D°C]"
(round (? sensors "thinkpad-isa-0000" "CPU" "temp1_input"))
(round (? sensors "amdgpu-pci-0400" "edge" "temp1_input"))))
(t "?")))
(defcached (sensors :seconds 10.0)
(sensors%))
(defun sensors-modeline (ml)
(declare (ignore ml))
(sensors))
(add-screen-mode-line-formatter #\S #'sensors-modeline)
#; Scratch --------------------------------------------------------------------