mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-03-12 01:42:37 -07:00
Code Issues Projects Releases Wiki Activity

; Minor updates to system-sleep (bug#80348)

Browse source 
- Add several autoload cookies.
- Separate public API hook used internally into a private hook.
- Fix thinko in setting up the special event sleep-event handler.
- Probe the D-Bus session bus for screen saver support during
enable.

* lisp/system-sleep.el (system-sleep--set-back-end): Move dbus
endpoint tests into the system-sleep--enable dbus
implementation.
(system-sleep--event-after-hook-functions): New private hook.
(system-sleep--dbus-has-screensaver): New defvar.
(system-sleep--sleep-event-handler): Call the new private hook.
(system-sleep--sleep-event-function): Remove.  Use
'system-sleep--sleep-event-handler'.
(system-sleep--enable): Use the internal hook.
(system-sleep--enable): [dbus] Probe session bus for screen
saver support.
(system-sleep--disable): Remove the new internal hook.
(system-sleep--block-sleep): Call screen saver dbus endpoint
only when screen saver support is known to exist.
This commit is contained in:
Stéphane Marks 2026-02-15 14:49:54 -05:00 • committed by Michael Albinus
parent f84fb38a82
commit 3beb804e3a
1 changed files with 38 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

72
lisp/system-sleep.el
View file

@ -108,6 +108,7 @@
"A list of active sleep-block tokens.
If non-nil, idle sleep is inhibited by `system-sleep'.")
;;;###autoload
(cl-defstruct
(sleep-event (:type list) :named
(:constructor nil)
@ -159,6 +160,7 @@ complete. See `with-system-sleep-block' for an easy way to do that."
(when system-sleep--back-end
(system-sleep--block-sleep (or why "Emacs") allow-display-sleep)))
;;;###autoload
(defun system-sleep-unblock-sleep (token)
"Unblock the system sleep block associated with TOKEN.
Return non-nil TOKEN was unblocked, or nil if not.
@ -203,17 +205,34 @@ The block is unblocked when BODY completes."
(cond ((featurep 'ns) 'ns)
((featurep 'w32) 'w32)
((and (require 'dbus)
(featurep 'dbusbind)
(member "org.freedesktop.login1"
(dbus-list-activatable-names :system)))
(featurep 'dbusbind))
'dbus)
(t nil))))
(defvar system-sleep--event-after-hook-functions nil)
(defvar system-sleep--event-in-progress nil)
(defvar system-sleep--event-queue nil)
(defun system-sleep--sleep-event-handler (event)
"`sleep-event' EVENT handler."
"Handle <sleep-event> special events and avoid races."
(declare (completion ignore))
(interactive "e")
(run-hook-with-args 'system-sleep-event-functions event))
;; Queue incoming event.
(setq system-sleep--event-queue
(append system-sleep--event-queue (list event)))
;; If an event is already in progress, return right away.
;; Otherwise, process queued events.
(while (and (not system-sleep--event-in-progress)
system-sleep--event-queue)
(let ((current-event (pop system-sleep--event-queue)))
(setq system-sleep--event-in-progress current-event)
(unwind-protect
(progn
(run-hook-with-args 'system-sleep-event-functions
current-event)
(run-hook-with-args 'system-sleep--event-after-hook-functions
current-event))
(setq system-sleep--event-in-progress nil)))))
(defun system-sleep-enable ()
"Enable `system-sleep'."
@ -252,25 +271,6 @@ Return a sleep-block token.")
"Unblock the system sleep block associated with TOKEN.
Return non-nil TOKEN was unblocked, or nil if not.")
(defvar system-sleep--event-in-progress nil)
(defvar system-sleep--event-queue nil)
(defun system-sleep--sleep-event-function (event)
"Handle <sleep-event> special events and avoid races."
;; Queue incoming event.
(setq system-sleep--event-queue
(append system-sleep--event-queue (list event)))
;; If an event is already in progress, return right away.
;; Otherwise, process queued events.
(while (and (not system-sleep--event-in-progress)
system-sleep--event-queue)
(let ((current-event (pop system-sleep--event-queue)))
(setq system-sleep--event-in-progress current-event)
(unwind-protect
(run-hook-with-args 'system-sleep-event-functions
current-event)
(setq system-sleep--event-in-progress nil)))))
;; D-Bus support.
@ -282,6 +282,7 @@ The default is \"sleep\" which is compatible with the other supported
(defvar system-sleep--dbus-delay-lock nil)
(defvar system-sleep--dbus-pre-sleep-signal nil)
(defvar system-sleep--dbus-has-screensaver nil)
(defun system-sleep--dbus-delay-lock (make-or-close)
(cond (make-or-close
@ -335,20 +336,22 @@ The default is \"sleep\" which is compatible with the other supported
(cl-defmethod system-sleep--enable (&context
(system-sleep--back-end (eql 'dbus)))
;; Order matters.
(add-hook 'system-sleep-event-functions
#'system-sleep--dbus-prepare-for-sleep-function
;; This must run last.
99)
(system-sleep--dbus-delay-lock t)
(system-sleep--dbus-prepare-for-sleep-watcher t)
t)
(when (member "org.freedesktop.login1"
(dbus-list-activatable-names :system))
(setq system-sleep--dbus-has-screensaver
(member "org.freedesktop.ScreenSaver"
(dbus-list-activatable-names :session)))
(add-hook 'system-sleep--event-after-hook-functions
#'system-sleep--dbus-prepare-for-sleep-function)
(system-sleep--dbus-delay-lock t)
(system-sleep--dbus-prepare-for-sleep-watcher t)
t))
(cl-defmethod system-sleep--disable (&context
(system-sleep--back-end (eql 'dbus)))
(system-sleep--dbus-prepare-for-sleep-watcher nil)
(system-sleep--dbus-delay-lock nil)
(remove-hook 'system-sleep-event-functions
(remove-hook 'system-sleep--event-after-hook-functions
#'system-sleep--dbus-prepare-for-sleep-function))
(cl-defmethod system-sleep--block-sleep (why
@ -370,7 +373,8 @@ The default is \"sleep\" which is compatible with the other supported
(progn
(let ((inhibit-quit t))
(push (cons 'dbus-inhibitor-lock sleep-cookie) subtokens))
(unless allow-display-sleep
(unless (or allow-display-sleep
(not system-sleep--dbus-has-screensaver))
(if-let* ((screen-cookie
(dbus-call-method
:session