stumpwm/sensors.lisp @ dedc81b8510c

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

(defparameter *sensors-refresh-delay* 5.0 "How long between sensor refreshes (in seconds).")
(defparameter *sensors-next-refresh* nil)
(defparameter *sensors-cache* nil)

(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-0600"   "edge" "temp1_input"))))
    (t "?")))

(defun sensors (&aux (now (get-internal-real-time)))
  (if (or (null *sensors-next-refresh*)
          (>= now *sensors-next-refresh*))
      (setf *sensors-next-refresh* (+ now (* internal-time-units-per-second *sensors-refresh-delay*))
            *sensors-cache* (sensors%))
      *sensors-cache*))

(defun sensors-modeline (ml)
  (declare (ignore ml))
  (sensors))

(add-screen-mode-line-formatter #\S #'sensors-modeline)