;;; upower.el --- dbus-based interface to UPower manager

;; Author: Noah Friedman <friedman@splode.com>
;; Created: 2022-02-07
;; Public domain.

;; $Id: upower.el,v 1.3 2023/10/13 03:51:23 friedman Exp $

;;; Commentary:

;; WIP

;;; Code:

(require 'dbus)

(defconst upower-dbus-bus               :system)
(defconst upower-dbus-service            "org.freedesktop.UPower")
(defconst upower-dbus-path              "/org/freedesktop/UPower")
(defconst upower-dbus-interface          "org.freedesktop.UPower")

(defconst upower-dbus-devices-path      "/org/freedesktop/UPower/devices")
(defconst upower-dbus-devices-interface  "org.freedesktop.UPower.Device")

(defconst upower-dbus-wakeups-path      "/org/freedesktop/UPower/Wakeups")
(defconst upower-dbus-wakeups-interface  "org.freedesktop.UPower.Wakeups")

(defconst upower-device-constants
  (mapcar (lambda (category)
            (cons (car category)
                  (cons (cons 0 'unknown)
                        (let ((i 0))
                          (mapcar (lambda (sym)
                                    (cons (setq i (1+ i)) sym))
                                  (cdr category))))))
          ;; Order is significant
          '((type   line-power
                    battery
                    ups
                    monitor
                    mouse
                    keyboard
                    pda
                    phone
                    media-player
                    tablet
                    computer
                    gaming-input
                    pen
                    touchpad
                    modem
                    network
                    headset
                    speakers
                    headphones
                    video
                    other-audio
                    remote-control
                    printer
                    scanner
                    camera
                    wearable
                    toy
                    bluetooth-generic )

            (state  charging
                    discharging
                    empty
                    fully-charged
                    pending-charge
                    pending-discharge )

            (level  none
                    discharging
                    low
                    critical
                    action
                    normal
                    high
                    full )

            (tech   lithium-ion
	            lithium-polymer
	            lithium-iron-phosphate
	            lead-acid
	            nickel-cadmium
	            nickel-metal-hydride ))))


(defsubst upower-xlate-constant (type arg)
  (let ((alist (cdr (assq type upower-device-constants))))
    (or (cdr (assq   arg alist))
        (car (rassq  arg alist)))))


(defun upower-get-all-managed-objects (&optional path)
  (dbus-get-all-managed-objects upower-dbus-bus
                                upower-dbus-service
                                (or path upower-dbus-path)))

(defun upower-get-interface-names (&optional path)
  (dbus-introspect-get-interface-names upower-dbus-bus
                                       upower-dbus-service
                                       (or path upower-dbus-path)))


(defun upower-get-all-properties (&optional path interface)
  (dbus-get-all-properties upower-dbus-bus
                           upower-dbus-service
                           (or path      upower-dbus-path)
                           (or interface upower-dbus-interface)))


(defun upower-get-property (&optional path interface property)
  (dbus-get-property upower-dbus-bus
                     upower-dbus-service
                     (or path      upower-dbus-path)
                     (or interface upower-dbus-interface)
                     property))

(defun upower-get-method-names (&optional path interface)
  (dbus-introspect-get-method-names upower-dbus-bus
                                    upower-dbus-service
                                    (or path upower-dbus-path)
                                    (or interface upower-dbus-interface)))

(defun upower-get-argument-names (&optional path interface method)
  (dbus-introspect-get-argument-names upower-dbus-bus
                                      upower-dbus-service
                                      (or path upower-dbus-path)
                                      (or interface upower-dbus-interface)
                                      method))

(defun upower-call-method (&optional path interface method &rest args)
  (apply 'dbus-call-method upower-dbus-bus
                           upower-dbus-service
                           (or path      upower-dbus-path)
                           (or interface upower-dbus-interface)
                           method
                           args))


(defun upower-device-path (&optional device)
  (unless device (setq device "DisplayDevice"))
  (let* ((fp upower-dbus-devices-path)
         (fp-len (length fp)))
    (if (and (> (length device) fp-len)
             (equal fp (substring device 0 fp-len)))
        device
      (concat fp "/" device))))

(defun upower-device-get-names ()
  (dbus-introspect-get-node-names upower-dbus-bus
                                  upower-dbus-service
                                  upower-dbus-devices-path))

(defun upower-device-get-all-properties (&optional device)
  (upower-get-all-properties (upower-device-path device)
                             upower-dbus-devices-interface))

(defun upower-device-get-property (device property)
  (if (or (null device)
          (stringp device))
      (setq device (upower-device-get-all-properties device)))
  (cdr (assoc property device)))

(defun upower-device-get-method-names (&optional device)
  (upower-get-method-names (upower-device-path device)
                           upower-dbus-devices-interface))

(defun upower-device-argument-names (&optional device method)
  (upower-get-argument-names (upower-device-path device)
                             upower-dbus-devices-interface
                             method))

(defun upower-device-call-method (device method &rest args)
  (apply 'upower-call-method (upower-device-path device)
                             upower-dbus-devices-interface
                             method
                             args))


(defun upower-device-get-state (&optional device)
  (upower-xlate-constant 'state (upower-device-get-property device "State")))

(defun upower-device-get-type (&optional device)
  (upower-xlate-constant 'type (upower-device-get-property device "Type")))

(defun upower-device-get-warning-level (&optional device)
  (upower-xlate-constant 'level (upower-device-get-property device "WarningLevel")))

(defun upower-device-get-tech (&optional device)
  (upower-xlate-constant 'tech (upower-device-get-property device "Technology")))

(defun upower-device-get-history (&optional device type timespan resolution)
  (upower-device-call-method device "GetHistory"
                             (or type       "charge")
                             (or timespan       0)
                             (or resolution 65536)))


(defun upower-wakeups-get-capability ()
  (upower-get-property upower-dbus-wakeups-path
                       upower-dbus-wakeups-interface
                       "HasCapability"))

(defun upower-wakeups-get-total ()
  (upower-call-method  upower-dbus-wakeups-path
                       upower-dbus-wakeups-interface
                       "GetTotal"))

(defun upower-wakeups-get-data ()
  (upower-call-method  upower-dbus-wakeups-path
                       upower-dbus-wakeups-interface
                       "GetData"))


(defun upower-daemon-version ()
  (upower-get-property nil nil "DaemonVersion"))

(defun upower-on-battery-p ()
  (upower-get-property nil nil "OnBattery"))

(defun upower-lid-closed-p ()
  (upower-get-property nil nil "LidIsClosed"))

(defun upower-lid-closed-p ()
  (upower-get-property nil nil "LidIsPresent"))

(defun upower-get-critical-action ()
  (upower-call-method  nil nil "GetCriticalAction"))


(provide 'upower)

;; upower.el ends here