stumpwm/sensors.lisp @ 46fd11ae3808

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