>From deafb5e9b2b9dcc50c0e543a4dfd82b0fe49a63a Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 11 Jun 2020 13:49:31 +0100 Subject: [PATCH] Improve battery.el UPower support For discussion, see the following threads: https://lists.gnu.org/archive/html/emacs-devel/2020-01/msg00843.html https://lists.gnu.org/archive/html/emacs-devel/2020-02/msg00042.html https://lists.gnu.org/archive/html/emacs-devel/2020-02/msg00282.html * etc/NEWS: Announce that battery-upower is enabled by default. * lisp/battery.el (battery-upower-device): Accept both battery and line power device names, or a list thereof (bug#39491). (battery-upower-line-power-device): Remove user option; superseded by battery-upower-device. (battery-upower-subscribe): New user option. (battery-status-function): Check whether a UPower service is provided without activating it. (display-battery-mode): Subscribe to UPower signals when using battery-upower. (battery-upower): Merge data from multiple power sources. Calculate terse battery status %b based on average battery load percentage rather than coarse and often missing BatteryLevel (bug#39491). Add support for average temperature %d. (battery-upower-dbus-service) (battery-upower-dbus-interface) (battery-upower-dbus-path) (battery-upower-dbus-device-interface) (battery-upower-dbus-device-path) (battery-upower-device-all-properties): Rename to... (battery-upower-service) (battery-upower-interface) (battery-upower-path) (battery-upower-device-interface) (battery-upower-device-path) (battery--upower-device-properties): ...these, respectively. (battery-upower-device-list): Rename to... (battery--upower-devices) ...this. Return a flat list of device names determined by battery-upower-device. (battery-upower-types, battery-upower-states) (battery-upower-device-property, battery-upower-device-autodetect): Remove. (battery--upower-signals): New variable. (battery--upower-signal-handler, battery--upower-props-changed) (battery--upower-unsubscribe, battery--upower-subsribe) (battery--upower-state): New functions. * test/lisp/battery-tests.el (battery-upower-state) (battery-upower-state-unknown): New tests. --- etc/NEWS | 12 ++ lisp/battery.el | 282 +++++++++++++++++++++++-------------- test/lisp/battery-tests.el | 63 +++++++++ 3 files changed, 252 insertions(+), 105 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b0c523672e..28617227cc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -451,6 +451,18 @@ https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. ** The metamail.el library is now marked obsolete. +** battery.el + +--- +*** UPower is now the default battery status backend when available. +UPower support via the function 'battery-upower' was added in Emacs +26.1, but was disabled by default. It is now the default value of +'battery-status-function' when the system provides a UPower D-Bus +service. The user options 'battery-upower-device' and +'battery-upower-subscribe' control which power sources to query and +whether to respond to status change notifications in addition to +polling, respectively. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/battery.el b/lisp/battery.el index b8855a8ce3..c663195ab0 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -44,21 +44,40 @@ battery :group 'hardware) (defcustom battery-upower-device nil - "UPower device of the `:battery' type. -Use `battery-upower-device-list' to list all available UPower devices. -If set to nil, then autodetect `:battery' device." - :version "28.1" - :type '(choice string (const :tag "Autodetect" nil))) + "Preferred UPower device name(s). +When `battery-status-function' is set to `battery-upower', this +user option specifies which power sources to query for status +information and merge into a single report. -(defcustom battery-upower-line-power-device nil - "UPower device of the `:line-power' type. -Use `battery-upower-device-list' to list all available UPower devices. -If set to nil, then autodetect `:battery' device." +When nil (the default), `battery-upower' queries all present +battery and line power devices as determined by the UPower +EnumerateDevices method. A string or a nonempty list of strings +names particular devices to query instead. UPower battery and +line power device names typically follow the patterns +\"battery_BATN\" and \"line_power_ACN\", respectively, with N +starting at 0 when present. Device names should not include the +leading D-Bus path \"/org/freedesktop/UPower/devices/\"." :version "28.1" - :type '(choice string (const :tag "Autodetect" nil))) + :type '(choice (const :tag "Autodetect all devices" nil) + (string :tag "Device") + (repeat :tag "Devices" string))) -(defconst battery-upower-dbus-service "org.freedesktop.UPower" - "Well-known UPower service name for the D-Bus system.") +(defcustom battery-upower-subscribe t + "Whether to subscribe to UPower device change signals. +When nil, battery status information is polled every +`battery-update-interval' seconds. When non-nil (the default), +the battery status is also updated whenever a power source is +added or removed, or when the system starts or stops running on +battery power. + +This only takes effect when `battery-status-function' is set to +`battery-upower' before enabling `display-battery-mode'." + :version "28.1" + :type 'boolean) + +(defconst battery-upower-service "org.freedesktop.UPower" + "Well-known name of the UPower D-Bus service. +See URL `https://upower.freedesktop.org/docs/ref-dbus.html'.") (defun battery--find-linux-sysfs-batteries () (let ((dirs nil)) @@ -70,7 +89,7 @@ battery--find-linux-sysfs-batteries (nreverse dirs))) (defcustom battery-status-function - (cond ((dbus-ping :system battery-upower-dbus-service) + (cond ((member battery-upower-service (dbus-list-activatable-names)) #'battery-upower) ((and (eq system-type 'gnu/linux) (file-readable-p "/proc/apm")) @@ -196,11 +215,15 @@ display-battery-mode (setq battery-mode-line-string "") (or global-mode-string (setq global-mode-string '(""))) (and battery-update-timer (cancel-timer battery-update-timer)) + (battery--upower-unsubscribe) (if (and battery-status-function battery-mode-line-format) (if (not display-battery-mode) (setq global-mode-string (delq 'battery-mode-line-string global-mode-string)) (add-to-list 'global-mode-string 'battery-mode-line-string t) + (and (eq battery-status-function #'battery-upower) + battery-upower-subscribe + (battery--upower-subsribe)) (setq battery-update-timer (run-at-time nil battery-update-interval 'battery-update-handler)) (battery-update)) @@ -555,123 +578,172 @@ battery-linux-sysfs (t "N/A")))))) -;;; `upowerd' interface. -(defconst battery-upower-dbus-interface "org.freedesktop.UPower" - "The interface to UPower. -See URL `https://upower.freedesktop.org/docs/'.") +;;; UPower interface. -(defconst battery-upower-dbus-path "/org/freedesktop/UPower" - "D-Bus path to talk to UPower service.") +(defconst battery-upower-interface "org.freedesktop.UPower" + "Name of the UPower D-Bus interface. +See URL `https://upower.freedesktop.org/docs/UPower.html'.") -(defconst battery-upower-dbus-device-interface - (concat battery-upower-dbus-interface ".Device") - "The Device interface of the UPower. +(defconst battery-upower-path "/org/freedesktop/UPower" + "D-Bus object providing `battery-upower-interface'.") + +(defconst battery-upower-device-interface "org.freedesktop.UPower.Device" + "Name of the UPower Device D-Bus interface. See URL `https://upower.freedesktop.org/docs/Device.html'.") -(defconst battery-upower-dbus-device-path - (concat battery-upower-dbus-path "/devices") - "D-Bus path to talk to devices part of the UPower service.") +(defconst battery-upower-device-path "/org/freedesktop/UPower/devices" + "D-Bus object providing `battery-upower-device-interface'.") -(defconst battery-upower-types - '((0 . :unknown) (1 . :line-power) (2 . :battery) - (3 . :ups) (4 . :monitor) (5 . :mouse) - (6 . :keyboard) (7 . :pda) (8 . :phone)) - "Type of the device.") +(defvar battery--upower-signals nil + "Handles for UPower signal subscriptions.") -(defconst battery-upower-states - '((0 . "unknown") (1 . "charging") (2 . "discharging") - (3 . "empty") (4 . "fully-charged") (5 . "pending-charge") - (6 . "pending-discharge")) - "Alist of battery power states. -Only valid for `:battery' devices.") +(defun battery--upower-signal-handler (&rest _) + "Update battery status on receiving a UPower D-Bus signal." + (timer-event-handler battery-update-timer)) -(defun battery-upower-device-property (device property) - "Get value of the single PROPERTY for the UPower DEVICE." - (dbus-get-property - :system battery-upower-dbus-service - (expand-file-name device battery-upower-dbus-device-path) - battery-upower-dbus-device-interface - property)) +(defun battery--upower-props-changed (_interface changed _invalidated) + "Update status when system starts/stops running on battery. +Intended as a UPower PropertiesChanged signal handler." + (when (assoc "OnBattery" changed) + (battery--upower-signal-handler))) -(defun battery-upower-device-all-properties (device) +(defun battery--upower-unsubscribe () + "Unsubscribe from UPower device change signals." + (mapc #'dbus-unregister-object battery--upower-signals) + (setq battery--upower-signals ())) + +(defun battery--upower-subsribe () + "Subscribe to UPower device change signals." + (push (dbus-register-signal :system battery-upower-service + battery-upower-path + dbus-interface-properties + "PropertiesChanged" + #'battery--upower-props-changed) + battery--upower-signals) + (dolist (method '("DeviceAdded" "DeviceRemoved")) + (push (dbus-register-signal :system battery-upower-service + battery-upower-path + battery-upower-interface + method #'battery--upower-signal-handler) + battery--upower-signals))) + +(defun battery--upower-device-properties (device) "Return value for all available properties for the UPower DEVICE." (dbus-get-all-properties - :system battery-upower-dbus-service - (expand-file-name device battery-upower-dbus-device-path) - battery-upower-dbus-device-interface)) + :system battery-upower-service + (expand-file-name device battery-upower-device-path) + battery-upower-device-interface)) -(defun battery-upower-device-list () - "Return list of all available UPower devices. -Each element is the cons cell in form: (DEVICE . DEVICE-TYPE)." - (mapcar (lambda (device-path) - (let* ((device (file-relative-name - device-path battery-upower-dbus-device-path)) - (type-num (battery-upower-device-property device "Type"))) - (cons device (or (cdr (assq type-num battery-upower-types)) - :unknown)))) - (dbus-call-method :system battery-upower-dbus-service - battery-upower-dbus-path - battery-upower-dbus-interface - "EnumerateDevices"))) +(defun battery--upower-devices () + "List all UPower devices according to `battery-upower-device'." + (cond ((stringp battery-upower-device) + (list battery-upower-device)) + (battery-upower-device) + ((dbus-call-method :system battery-upower-service + battery-upower-path + battery-upower-interface + "EnumerateDevices")))) -(defun battery-upower-device-autodetect (device-type) - "Return first matching UPower device of DEVICE-TYPE." - (car (rassq device-type (battery-upower-device-list)))) +(defun battery--upower-state (props state) + "Merge the UPower battery state in PROPS with STATE. +This is an extension of the UPower DisplayDevice algorithm for +merging multiple battery states into one. PROPS is an alist of +battery properties from `battery-upower-device-interface', and +STATE is a symbol representing the state to merge with." + ;; Map UPower enum into our printable symbols. + (let* ((new (pcase (cdr (assoc "State" props)) + (1 'charging) + (2 'discharging) + (3 'empty) + (4 'fully-charged) + (5 'pending-charge) + (6 'pending-discharge))) + ;; Unknown state represented by nil. + (either (delq nil (list new state)))) + ;; Earlier states override later ones. + (car (cond ((memq 'charging either)) + ((memq 'discharging either)) + ((memq 'pending-charge either)) + ((memq 'pending-discharge either)) + ;; Only options left are full or empty, + ;; but if they conflict return nil. + ((null (cdr either)) either) + ((apply #'eq either) either))))) (defun battery-upower () - "Get battery status from dbus Upower interface. -This function works only in systems with `upowerd' daemon -running. + "Get battery status from UPower D-Bus interface. +This function works only in systems that provide a UPower D-Bus +service. The following %-sequences are provided: %c Current capacity (mWh) -%p Battery load percentage -%r Current rate +%r Current rate of charge or discharge +%L AC line status (verbose) %B Battery status (verbose) %b Battery status: empty means high, `-' means low, `!' means critical, and `+' means charging -%L AC line status (verbose) +%d Temperature (in degrees Celsius) +%p Battery load percentage %s Remaining time (to charge or discharge) in seconds %m Remaining time (to charge or discharge) in minutes %h Remaining time (to charge or discharge) in hours %t Remaining time (to charge or discharge) in the form `h:min'" - (let* ((bat-device (or battery-upower-device - (battery-upower-device-autodetect :battery))) - (bat-props (when bat-device - (battery-upower-device-all-properties bat-device))) - (percents (cdr (assoc "Percentage" bat-props))) - (time-to-empty (cdr (assoc "TimeToEmpty" bat-props))) - (time-to-full (cdr (assoc "TimeToFull" bat-props))) - (state (cdr (assoc "State" bat-props))) - (level (cdr (assoc "BatteryLevel" bat-props))) - (energy (cdr (assoc "Energy" bat-props))) - (energy-rate (cdr (assoc "EnergyRate" bat-props))) - (lp-device (or battery-upower-line-power-device - (battery-upower-device-autodetect :line-power))) - (online-p (when lp-device - (battery-upower-device-property lp-device "Online"))) - (seconds (if online-p time-to-full time-to-empty)) - (minutes (when seconds (/ seconds 60))) - (hours (when minutes (/ minutes 60))) - (remaining-time (when hours - (format "%d:%02d" hours (mod minutes 60))))) - (list (cons ?c (if energy (number-to-string (round (* 1000 energy))) "N/A")) - (cons ?p (if percents (number-to-string (round percents)) "N/A")) - (cons ?r (if energy-rate - (concat (number-to-string energy-rate) " W") + (let ((count 0) props type line-status state load temperature + secs mins hrs total-energy total-rate total-tte total-ttf) + ;; Merge information from all available or specified UPower + ;; devices like other `battery-status-function's. + (dolist (device (battery--upower-devices)) + (setq props (battery--upower-device-properties device)) + (setq type (cdr (assoc "Type" props))) + (cond + ((and (eq type 1) (not (eq line-status 'online))) + ;; It's a line power device: `online' if currently providing + ;; power, any other non-nil value if simply present. + (setq line-status (if (cdr (assoc "Online" props)) 'online t))) + ((and (eq type 2) (cdr (assoc "IsPresent" props))) + ;; It's a battery. + (setq count (1+ count)) + (setq state (battery--upower-state props state)) + (let ((energy (cdr (assoc "Energy" props))) + (rate (cdr (assoc "EnergyRate" props))) + (percent (cdr (assoc "Percentage" props))) + (temp (cdr (assoc "Temperature" props))) + (tte (cdr (assoc "TimeToEmpty" props))) + (ttf (cdr (assoc "TimeToFull" props)))) + (when energy (setq total-energy (+ (or total-energy 0) energy))) + (when rate (setq total-rate (+ (or total-rate 0) rate))) + (when percent (setq load (+ (or load 0) percent))) + (when temp (setq temperature (+ (or temperature 0) temp))) + (when tte (setq total-tte (+ (or total-tte 0) tte))) + (when ttf (setq total-ttf (+ (or total-ttf 0) ttf))))))) + (when (> count 1) + ;; Averages over multiple batteries. + (when load (setq load (/ load count))) + (when temperature (setq temperature (/ temperature count)))) + (when (setq secs (if (eq line-status 'online) total-ttf total-tte)) + (setq mins (/ secs 60)) + (setq hrs (/ secs 3600))) + (list (cons ?c (if total-energy + (format "%.0f" (* total-energy 1000)) "N/A")) - (cons ?B (if state - (cdr (assq state battery-upower-states)) - "unknown")) - (cons ?b (cond ((= level 3) "-") - ((= level 4) "!") - (online-p "+") - (t ""))) - (cons ?L (if online-p "on-line" (if lp-device "off-line" "unknown"))) - (cons ?s (if seconds (number-to-string seconds) "N/A")) - (cons ?m (if minutes (number-to-string minutes) "N/A")) - (cons ?h (if hours (number-to-string hours) "N/A")) - (cons ?t (or remaining-time "N/A"))))) + (cons ?r (if total-rate (format "%.1f W" total-rate) "N/A")) + (cons ?L (cond ((eq line-status 'online) "on-line") + (line-status "off-line") + ("N/A"))) + (cons ?B (format "%s" (or state 'unknown))) + (cons ?b (cond ((eq state 'charging) "+") + ((and load (< load battery-load-critical)) "!") + ((and load (< load battery-load-low)) "-") + (""))) + ;; Zero usually means unknown. + (cons ?d (if (and temperature (/= temperature 0)) + (format "%.0f" temperature) + "N/A")) + (cons ?p (if load (format "%.0f" load) "N/A")) + (cons ?s (if secs (number-to-string secs) "N/A")) + (cons ?m (if mins (number-to-string mins) "N/A")) + (cons ?h (if hrs (number-to-string hrs) "N/A")) + (cons ?t (if hrs (format "%d:%02d" hrs (% mins 60)) "N/A"))))) ;;; `apm' interface for BSD. diff --git a/test/lisp/battery-tests.el b/test/lisp/battery-tests.el index 052ae49a80..8806047069 100644 --- a/test/lisp/battery-tests.el +++ b/test/lisp/battery-tests.el @@ -48,6 +48,69 @@ battery-linux-proc-apm-regexp (should (equal (match-string 8 str) "1792")) (should (equal (match-string 9 str) "min")))) +(ert-deftest battery-upower-state () + "Test `battery--upower-state'." + ;; Charging. + (dolist (total '(nil charging discharging empty fully-charged + pending-charge pending-discharge)) + (should (eq (battery--upower-state '(("State" . 1)) total) 'charging))) + (dolist (state '(nil 0 1 2 3 4 5 6)) + (should (eq (battery--upower-state `(("State" . ,state)) 'charging) + 'charging))) + ;; Discharging. + (dolist (total '(nil discharging empty fully-charged + pending-charge pending-discharge)) + (should (eq (battery--upower-state '(("State" . 2)) total) 'discharging))) + (dolist (state '(nil 0 2 3 4 5 6)) + (should (eq (battery--upower-state `(("State" . ,state)) 'discharging) + 'discharging))) + ;; Pending charge. + (dolist (total '(nil empty fully-charged pending-charge pending-discharge)) + (should (eq (battery--upower-state '(("State" . 5)) total) + 'pending-charge))) + (dolist (state '(nil 0 3 4 5 6)) + (should (eq (battery--upower-state `(("State" . ,state)) 'pending-charge) + 'pending-charge))) + ;; Pending discharge. + (dolist (total '(nil empty fully-charged pending-discharge)) + (should (eq (battery--upower-state '(("State" . 6)) total) + 'pending-discharge))) + (dolist (state '(nil 0 3 4 6)) + (should (eq (battery--upower-state `(("State" . ,state)) 'pending-discharge) + 'pending-discharge))) + ;; Empty. + (dolist (total '(nil empty)) + (should (eq (battery--upower-state '(("State" . 3)) total) 'empty))) + (dolist (state '(nil 0 3)) + (should (eq (battery--upower-state `(("State" . ,state)) 'empty) 'empty))) + ;; Fully charged. + (dolist (total '(nil fully-charged)) + (should (eq (battery--upower-state '(("State" . 4)) total) 'fully-charged))) + (dolist (state '(nil 0 4)) + (should (eq (battery--upower-state `(("State" . ,state)) 'fully-charged) + 'fully-charged)))) + +(ert-deftest battery-upower-state-unknown () + "Test `battery--upower-state' with unknown states." + ;; Unknown running total retains new state. + (should-not (battery--upower-state () nil)) + (should-not (battery--upower-state '(("State" . state)) nil)) + (should-not (battery--upower-state '(("State" . 0)) nil)) + (should (eq (battery--upower-state '(("State" . 1)) nil) 'charging)) + (should (eq (battery--upower-state '(("State" . 2)) nil) 'discharging)) + (should (eq (battery--upower-state '(("State" . 3)) nil) 'empty)) + (should (eq (battery--upower-state '(("State" . 4)) nil) 'fully-charged)) + (should (eq (battery--upower-state '(("State" . 5)) nil) 'pending-charge)) + (should (eq (battery--upower-state '(("State" . 6)) nil) 'pending-discharge)) + ;; Unknown new state retains running total. + (dolist (props '(() (("State" . state)) (("State" . 0)))) + (dolist (total '(nil charging discharging empty fully-charged + pending-charge pending-discharge)) + (should (eq (battery--upower-state props total) total)))) + ;; Conflicting empty and fully-charged. + (should-not (battery--upower-state '(("State" . 3)) 'fully-charged)) + (should-not (battery--upower-state '(("State" . 4)) 'empty))) + (ert-deftest battery-format () "Test `battery-format'." (should (equal (battery-format "" ()) "")) -- 2.26.2