From 0bee754a7204f911f934d750f6f1870c929ccdb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Marks?= Date: Wed, 4 Feb 2026 18:20:55 -0500 Subject: [PATCH] system-sleep sleep blocker and sleep/wake event package (bug#80348) This package provides platform-neutral interfaces to block your system from entering idle sleep and a hook to process pre-sleep and post-wake events. Implementations are for D-Bus on GNU/Linux, macOS/GNUstep, and MS-Windows. * lisp/system-sleep.el: New package. * src/fns.c: Qpre_sleep, Qpost_wake: New DEFSYM. * src/nsfns.m (Fns_block_system_sleep, Fns_unblock_system_sleep) (syms_of_nsfns): New functions. * src/nsterm.m (applicationDidFinishLaunching): Subscribe to pre-sleep and post-wake notifications. (systemWillSleep, systemDidWake): New function. * src/w32fns.c (Fw32_block_system_sleep) (Fw32_unblock_system_sleep, Fw32_system_sleep_block_count) (sleep_notification_callback) (w32_register_for_sleep_notifications): New function. (syms_of_w32fns): Sw32_unblock_system_sleep Sw32_block_system_sleep Sw32_system_sleep_block_count: New defsubr. * src/w32term.h (Fw32_block_system_sleep): New extern. * src/w32term.c (w32_initialize): Call w32_register_for_sleep_notifications. * doc/lispref/os.texi: Document the system-sleep package. * doc/lispref/commands.texi: Update sleep-event special documentation. * etc/NEWS: Announce the new package. --- doc/lispref/commands.texi | 10 +- doc/lispref/os.texi | 68 +++++ etc/NEWS | 16 ++ lisp/system-sleep.el | 513 ++++++++++++++++++++++++++++++++++++++ src/fns.c | 4 + src/nsfns.m | 84 +++++++ src/nsterm.m | 48 +++- src/w32fns.c | 145 +++++++++++ src/w32term.c | 1 + src/w32term.h | 1 + 10 files changed, 876 insertions(+), 14 deletions(-) create mode 100644 lisp/system-sleep.el diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index b907ba96bed..0583179ed31 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2778,12 +2778,12 @@ To test the signal handler, you can make Emacs send a signal to itself: @end smallexample @cindex @code{sleep-event} event -@item (sleep-event @var{sleep-wake}) -This event is injected when the device Emacs is running on enters or -leaves the sleep state. A non-@code{nil} @var{sleep-wake} indicates -entering the sleep state. +@item (sleep-event @var{state}) +This event is injected when the device Emacs is running on is about to +enter a sleep state, or has just awoken from one. @var{state} will be +the symbol @code{pre-sleep} or @code{post-wake}. -This is implemented only on GNU/Linux. +This is implemented on GNU/Linux, macOS, and MS-Windows. @cindex @code{language-change} event @item language-change diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index c5ba86dddee..0e669c70592 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -35,6 +35,7 @@ terminal and the screen. * Session Management:: Saving and restoring state with X Session Management. * Desktop Notifications:: Desktop notifications. * System Taskbar:: Controlling system GUI taskbar features. +* System Sleep:: Block system sleep and process sleep events. * File Notifications:: File notifications. * Dynamic Libraries:: On-demand loading of support libraries. * Security Considerations:: Running Emacs in an unfriendly environment. @@ -3493,6 +3494,73 @@ Examples of system taskbar functions: @end group @end lisp +@node System Sleep +@section Block System Sleep and Process Sleep Events +@cindex system sleep +@cindex mode, system sleep + +@defun system-sleep-block-sleep &optional why allow-display-sleep +This function blocks the system from entering its idle sleep state. + +It returns a token that must be passed to +@code{system-sleep-unblock-sleep} to unblock this specific block (other +sleep blocks may be simultaneously in force for other purposes). +Otherwise, it returns @code{nil} if the sleep blocking fails. + +@var{why} is a string and, when non-nil, is used to identify the sleep +block as it may appear on the system's inspectable block lists. It +defaults to ``Emacs''. + +If @var{allow-display-sleep} is non-nil, allow the display to sleep. By +default, the display is kept active. + +Note: ​When the Emacs process dies, blocks are released on all platforms. +@end defun + +@defun system-sleep-unblock-sleep token +This function unblocks the sleep block associated with @var{token}. It +returns non-@code{nil} on success, otherwise returns @code{nil}. +@end defun + +@defmac with-system-sleep-block (&optional why allow-display-sleep) body@dots{} +This is a convenience macro that lets you wrap the forms in @var{body} +with a sleep block that is unblocked for you when @var{body} completes. +The arguments have the same meaning as in +@code{system-sleep-block-sleep}, above. +@end defmac + +@defun system-sleep-sleep-blocked-p +This predicate function returns non-@code{nil} on if there are any +active @code{system-sleep} blocks, otherwise returns @code{nil}. +@end defun + +@defun system-sleep-unblock-all-sleep-blocks +This function unblocks all active sleep blocks. It is unlikely that you +will need to call this function. +@end defun + +@defopt system-sleep-event-functions +When the system is about to enter a sleep state or after it wakes from +one, each function on this abnormal hook is called with one argument, +@var{event}, a sleep event. Its state can be retrieved via +@samp{@code{(sleep-event-state event)}}. State will be one of the +symbols @code{pre-sleep} or @code{post-wake}. + +Handling @code{pre-sleep} events should be done as fast as possible and +avoid user prompting. Systems often grant a very short pre-sleep +processing interval, typically ranging between 2 and 5 seconds. The +system may sleep even if your processing is not complete, so be sure you +do as little as possible. For example, your function could close active +connections or serial ports. + +Handling @code{post-wake} events offers more leeway. Use this, for +example, to reestablish connections. + +Note: Your code, or the functions it calls, should not raise any signals +or all hooks will be halted. You can wrap your code in a +@code{condition-case} block (@pxref{Errors}). +@end defopt + @node File Notifications @section Notifications on File Changes @cindex file notifications diff --git a/etc/NEWS b/etc/NEWS index 757a84070ac..abf4b3d10a3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3597,6 +3597,22 @@ On GNU/Linux systems, shell extensions or similar helpers such as and . ++++ +** New package 'system-sleep'. +This package provides platform-neutral interfaces to block your system +from entering idle sleep and a hook to process pre-sleep and post-wake +events. You can use this to avoid the system entering an idle sleep +state and interrupting a long-running process due to lack of user +activity. The sleep event hook lets you, for example close external +connections or serial ports before sleeping, and reestablish them when +the system wakes up. + +Supported capable systems are GNU/Linux via D-Bus (sleep blocking and +events require the org.freedesktop.login1 service, display sleep +blocking requires org.freedesktop.Screensaver service), macOS +(sleep/display blocking requires 10.9+, sleep events are supported on +all versions), MS-Windows (sleep blocking is supported on all versions, +sleep events require 8+). * Incompatible Lisp Changes in Emacs 31.1 diff --git a/lisp/system-sleep.el b/lisp/system-sleep.el new file mode 100644 index 00000000000..bd14e9d0e50 --- /dev/null +++ b/lisp/system-sleep.el @@ -0,0 +1,513 @@ +;;; system-sleep.el --- System sleep/wake event management -*- lexical-binding: t -*- + +;; Copyright (C) 2025-2026 Free Software Foundation, Inc. + +;; Author: Stephane Marks +;; Maintainer: emacs-devel@gnu.org +;; Keywords: convenience +;; Package-Requires: ((emacs "31.1")) + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Call `system-sleep-block-sleep' to inhibit system-wide idle sleep. +;; Idle sleep is typically triggered when the system does not detect +;; user activity and is independent of any processing that may be on +;; going. This function is useful to block idle sleep for long-running +;; operations, for example, when a compilation is running. You have the +;; option of keeping the system active while letting the display sleep. +;; This function returns a token which you must use to unblock this +;; request. +;; +;; Call `system-sleep-unblock-sleep' with the token from +;; `system-sleep-block-sleep' to unblock system-wide idle sleep for this +;; request. There may be other active requests which will prevent the +;; system from sleeping. +;; +;; The function `system-sleep-sleep-blocked-p' will tell you if +;; `system-sleep' has any active system sleep blocks. +;; +;; Note: ​When the Emacs process dies, blocks are released on all +;; platforms. +;; +;; You can register functions on the abnormal hook +;; `system-sleep-event-functions'. Each function will be called when +;; the system is preparing for sleep and when the system wakes from +;; sleep. These functions are useful when you want to close (and +;; potentially reopen) external connections or serial ports. +;; +;; On supported GNU/Linux systems, the implementation is via D-Bus to +;; inhibit idle sleep, keep the display active, and forward events from +;; logind for system sleep events. +;; +;; On macOS and MS-Windows, native APIs are used to block idle sleep, +;; keep the display active, and provide sleep event notifications. +;; +;; On MS-Windows, an idle sleep block that keeps the display active may +;; not inhibit the screen saver. +;; +;; Externally to Emacs, there are system utility functions that you can +;; use to inspect all processes on your system that might be blocking it +;; from sleeping. +;; +;; On D-Bus systems, you can use the commands: +;; +;; systemd-inhibit --list +;; or +;; dbus-send --system --print-reply --dest=org.freedesktop.login1 \ +;; /org/freedesktop/login1 \ +;; org.freedesktop.login1.Manager.ListInhibitors +;; +;; Note: You can find the sleep/shutdown delay InhibitDelayMaxUSec in +;; the file logind.conf(5) which typically defaults to 5 seconds. +;; +;; On macOS, you can use the command: +;; +;; pmset -g assertions +;; +;; On MS-Windows, you can use the following command which may need to be +;; run as an administrator: +;; +;; powercfg -requests + +;;; Code: + +(require 'cl-lib) + +;; Pacify the byte compiler. +(declare-function dbus--fd-close "dbusbind.c") +(declare-function dbus-unregister-object "dbus.el") +(declare-function dbus-register-signal "dbus.el") +(declare-function dbus-call-method "dbus.el") +(declare-function dbus-list-activatable-names "dbus.el") +(defvar dbus-service-emacs) + +(defgroup system-sleep nil + "System sleep/wake blocking and event management." + :group 'system-interface + :version "31.1") + +(defvar system-sleep--back-end nil + "Generic sleep-wake method system dispatcher.") + +(defvar system-sleep--sleep-block-tokens nil + "A list of active sleep-block tokens. +If non-nil, idle sleep is inhibited by `system-sleep'.") + +(cl-defstruct + (sleep-event (:type list) :named + (:constructor nil) + (:constructor make-sleep-event (state))) + state) + +;;;###autoload +(defcustom system-sleep-event-functions nil + "Abnormal hook invoked on system sleep events. +Each function is called with one argument EVENT, a sleep event. EVENT +state can be retrieved via \\+`(sleep-event-state EVENT)'. It will be +one of the symbols \\+`pre-sleep' or \\+`post-wake'. + +Handling \\+`pre-sleep' events should be done as fast as possible, do as +little as possible and avoid user prompts. Systems often grant a very +short pre-sleep processing interval, typically ranging between 2 and 5 +seconds. The system may sleep even if your processing is not complete. +For example, your function could close active connections or serial +ports. + +Handling \\+`post-wake' events offers more leeway. Your function could +reestablish connections. + +Note: Your code, or the functions it calls, should not raise any signals +or all hooks will be halted preventing other hook functions from +cleaning up or waking up. You can wrap your code in a `condition-case' +block." + :type 'hook + :version "31.1") + +;;;###autoload +(defun system-sleep-block-sleep (&optional why allow-display-sleep) + "Inhibit system idle sleep. +Optional WHY is a string that identifies a sleep block to system utility +commands that inspect system-wide blocks. WHY defaults to \"Emacs\". + +Optional ALLOW-DISPLAY-SLEEP, when non-nil, allows the display to sleep +or a screen saver to run while the system idle sleep is blocked. The +default is to keep the display active. + +Return a sleep blocking token. You must retain this value and provide +it to `system-sleep-unblock-sleep' to unblock its associated block. + +Return nil if system sleep cannot be inhibited. + +Note: All active blocks are released when the Emacs process dies. +Despite this, you should unblock your blocks when your processing is +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))) + +(defun system-sleep-unblock-sleep (token) + "Unblock the system sleep block associated with TOKEN. +Return non-nil TOKEN was unblocked, or nil if not. +In the unlikely event that unblock fails, the block will be released +when the Emacs process dies." + (when system-sleep--back-end + (system-sleep--unblock-sleep token))) + +;;;###autoload +(defmacro with-system-sleep-block (&optional why allow-display-sleep &rest body) + "Execute the forms in BODY while blocking system sleep. +The optional arguments WHY and ALLOW-DISPLAY-SLEEP have the same meaning +as in `system-sleep-block-sleep', which see. +The block is unblocked when BODY completes." + (declare (indent 1) (debug t)) + (let ((token (make-symbol "--sleep-token--"))) + `(let ((,token (system-sleep-block-sleep ,why ,allow-display-sleep))) + (unwind-protect + (progn + ,@body) + (system-sleep-unblock-sleep ,token))))) + +(defun system-sleep-unblock-all-sleep-blocks () + "Unblock all `system-sleep' blocks." + (while system-sleep--sleep-block-tokens + (system-sleep-unblock-sleep (car system-sleep--sleep-block-tokens)))) + +;;;###autoload +(defun system-sleep-sleep-blocked-p () + "Return non-nil if there are active sleep blocks." + (and system-sleep--back-end + system-sleep--sleep-block-tokens)) + + +;; Internal implementation. + +(defun system-sleep--set-back-end () + "Determine sleep/wake host system type." + ;; Order matters to accommodate the cases where an NS or MS-Windows + ;; build have the dbus feature. + (setq system-sleep--back-end + (cond ((featurep 'ns) 'ns) + ((featurep 'w32) 'w32) + ((and (require 'dbus) + (featurep 'dbusbind) + (member "org.freedesktop.login1" + (dbus-list-activatable-names :system))) + 'dbus) + (t nil)))) + +(defun system-sleep--sleep-event-handler (event) + "`sleep-event' EVENT handler." + (declare (completion ignore)) + (interactive "e") + (run-hook-with-args 'system-sleep-event-functions event)) + +(defun system-sleep-enable () + "Enable `system-sleep'." + (unless system-sleep--back-end + (if (and (system-sleep--set-back-end) + (system-sleep--enable)) + (keymap-set special-event-map "" + #'system-sleep--sleep-event-handler) + (warn "`system-sleep' could not be initialized")))) + +(defun system-sleep-disable () + "Disable `system-sleep'." + (when system-sleep--back-end + (keymap-set special-event-map "" #'ignore) + (system-sleep-unblock-all-sleep-blocks) + (system-sleep--disable) + (setq system-sleep--back-end nil))) + +(cl-defgeneric system-sleep--enable () + "Enable the `system-sleep' back end. +Return t if the back end is initialized, or nil.") + +(cl-defgeneric system-sleep--disable () + "Disable the sleep/wake back end.") + +(cl-defgeneric system-sleep--block-sleep (why allow-display-sleep) + "Inhibit system idle sleep. +WHY is a string that identifies a sleep block to system utility commands +that inspect system-wide blocks. +When non-nil, ALLOW-DISPLAY-SLEEP allows the display to sleep or a +screen saver to run while the system idle sleep is blocked. The default +is to keep the display active. +Return a sleep-block token.") + +(cl-defgeneric system-sleep--unblock-sleep (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 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. + +(defvar system-sleep--dbus-sleep-inhibitor-types "sleep" + "This is a colon-separated list of options. +The default is \"sleep\" which is compatible with the other supported +`system-sleep' platforms. This could also be +\"sleep:shutdown\". Shutdown is available only on D-Bus systems.") + +(defvar system-sleep--dbus-delay-lock nil) +(defvar system-sleep--dbus-pre-sleep-signal nil) + +(defun system-sleep--dbus-delay-lock (make-or-close) + (cond (make-or-close + (if system-sleep--dbus-delay-lock + (error "Delay lock should be nil") + (setq system-sleep--dbus-delay-lock + (dbus-call-method + :system + "org.freedesktop.login1" + "/org/freedesktop/login1" + "org.freedesktop.login1.Manager" + "Inhibit" + :keep-fd + system-sleep--dbus-sleep-inhibitor-types + dbus-service-emacs + "Emacs sleep event watcher" + "delay")))) + (t + (when system-sleep--dbus-delay-lock + (dbus--fd-close system-sleep--dbus-delay-lock) + (setq system-sleep--dbus-delay-lock nil))))) + +(defun system-sleep--dbus-prepare-for-sleep-callback (sleep-or-wake) + (cond (sleep-or-wake + (insert-special-event (make-sleep-event 'pre-sleep))) + (t + (insert-special-event (make-sleep-event 'post-wake))))) + +(defun system-sleep--dbus-prepare-for-sleep-watcher (make-or-close) + (cond (make-or-close + (if system-sleep--dbus-pre-sleep-signal + (error "PrepareForSleep watcher should be nil") + (setq system-sleep--dbus-pre-sleep-signal + (dbus-register-signal + :system + "org.freedesktop.login1" + "/org/freedesktop/login1" + "org.freedesktop.login1.Manager" + "PrepareForSleep" + #'system-sleep--dbus-prepare-for-sleep-callback)))) + (t + (dbus-unregister-object system-sleep--dbus-pre-sleep-signal) + (setq system-sleep--dbus-pre-sleep-signal nil)))) + +(defun system-sleep--dbus-prepare-for-sleep-function (event) + (pcase (sleep-event-state event) + ('pre-sleep + (system-sleep--dbus-delay-lock nil)) + ('post-wake + (system-sleep--dbus-delay-lock t)))) + +(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) + +(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 + #'system-sleep--dbus-prepare-for-sleep-function)) + +(cl-defmethod system-sleep--block-sleep (why + allow-display-sleep + &context + (system-sleep--back-end (eql 'dbus))) + (let ((subtokens)) + (if-let* ((sleep-cookie (dbus-call-method + :system + "org.freedesktop.login1" + "/org/freedesktop/login1" + "org.freedesktop.login1.Manager" + "Inhibit" + :keep-fd + system-sleep--dbus-sleep-inhibitor-types + dbus-service-emacs + why + "block"))) + (progn + (let ((inhibit-quit t)) + (push (cons 'dbus-inhibitor-lock sleep-cookie) subtokens)) + (unless allow-display-sleep + (if-let* ((screen-cookie + (dbus-call-method + :session + "org.freedesktop.ScreenSaver" + "/org/freedesktop/ScreenSaver" + "org.freedesktop.ScreenSaver" + "Inhibit" + dbus-service-emacs + "Screen Saver Block"))) + (let ((inhibit-quit t)) + (push (cons 'dbus-screensaver-lock screen-cookie) subtokens)) + (warn "Unable to block the screen saver"))) + (let ((inhibit-quit t)) + (let ((token (list :system 'dbus :why why :subtokens subtokens))) + (push token system-sleep--sleep-block-tokens) + token))) + (warn "Unable to block system sleep")))) + +(cl-defmethod system-sleep--unblock-sleep (token + &context + (system-sleep--back-end (eql 'dbus))) + + (if (memq token system-sleep--sleep-block-tokens) + (progn + (let ((inhibit-quit t)) + (setq system-sleep--sleep-block-tokens + (remq token system-sleep--sleep-block-tokens))) + (dolist (subtoken (plist-get token :subtokens)) + (pcase (car subtoken) + ('dbus-inhibitor-lock + (dbus--fd-close (cdr subtoken))) + ('dbus-screensaver-lock + (dbus-call-method + :session + "org.freedesktop.ScreenSaver" + "/org/freedesktop/ScreenSaver" + "org.freedesktop.ScreenSaver" + "UnInhibit" + (cdr subtoken))))) + t) + (warn "Unknown `system-sleep' sleep token") + nil)) + + +;; macOS/GNUstep NS support. + +(declare-function ns-block-system-sleep "nsfns.m") +(declare-function ns-unblock-system-sleep "nsfns.m") + +(cl-defmethod system-sleep--enable (&context + (system-sleep--back-end (eql 'ns))) + t) + +(cl-defmethod system-sleep--disable (&context + (system-sleep--back-end (eql 'ns))) + (ignore)) + +(cl-defmethod system-sleep--block-sleep (why + allow-display-sleep + &context + (system-sleep--back-end (eql 'ns))) + (if-let* ((cookie (ns-block-system-sleep why allow-display-sleep)) + (token (list :system 'ns :why why + :token (cons 'ns-sleep-block cookie)))) + (progn + (let ((inhibit-quit t)) + (push token system-sleep--sleep-block-tokens)) + token) + (warn "Unable to block system sleep"))) + +(cl-defmethod system-sleep--unblock-sleep (token + &context + (system-sleep--back-end (eql 'ns))) + (if (memq token system-sleep--sleep-block-tokens) + (progn + (let ((inhibit-quit t)) + (setq system-sleep--sleep-block-tokens + (remq token system-sleep--sleep-block-tokens))) + (if (ns-unblock-system-sleep (cdr (plist-get token :token))) + t + (warn "Unable to unblock system sleep (blocks are released when Emacs dies)") + nil)) + (warn "Unknown `system-sleep' sleep token") + nil)) + + +;; MS-Windows support. + +(declare-function w32-block-system-sleep "w32fns.c") +(declare-function w32-unblock-system-sleep "w32fns.c") +(declare-function w32-system-sleep-block-count "w32fns.c") + +(defvar system-sleep--w32-sleep-block-count 0) + +(cl-defmethod system-sleep--enable (&context + (system-sleep--back-end (eql 'w32))) + t) + +(cl-defmethod system-sleep--disable (&context + (system-sleep--back-end (eql 'w32))) + (ignore)) + +(cl-defmethod system-sleep--block-sleep (why + allow-display-sleep + &context + (system-sleep--back-end (eql 'w32))) + (if-let* ((cookie (w32-block-system-sleep allow-display-sleep)) + (token (list :system 'w32 :why why + :token (cons 'w32-sleep-block cookie)))) + (progn + (let ((inhibit-quit t)) + (push token system-sleep--sleep-block-tokens)) + token) + (warn "Unable to block system sleep"))) + +(cl-defmethod system-sleep--unblock-sleep (token + &context + (system-sleep--back-end (eql 'w32))) + (if (memq token system-sleep--sleep-block-tokens) + (progn + (let ((inhibit-quit t)) + (setq system-sleep--sleep-block-tokens + (remq token system-sleep--sleep-block-tokens))) + (if (eq 0 (w32-system-sleep-block-count)) + (warn "Unable to unblock system sleep (no active tokens)") + (if (w32-unblock-system-sleep) + t + (warn "Unable to unblock system sleep (blocks are released when Emacs dies)") + nil))) + (warn "Unknown `system-sleep' sleep token") + nil)) + + +;; Initialize system-sleep. + +(system-sleep-enable) + +(provide 'system-sleep) + +;;; system-sleep.el ends here diff --git a/src/fns.c b/src/fns.c index 5c30d950cff..c29f9fa8cd1 100644 --- a/src/fns.c +++ b/src/fns.c @@ -6891,4 +6891,8 @@ For best results this should end in a space. */); DEFSYM (QCin_place, ":in-place"); DEFSYM (QCreverse, ":reverse"); DEFSYM (Qvaluelt, "value<"); + + /* sleep-event states. */ + DEFSYM (Qpre_sleep, "pre-sleep"); + DEFSYM (Qpost_wake, "post-wake"); } diff --git a/src/nsfns.m b/src/nsfns.m index cf685630ab7..3d3d5ec1bde 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -3805,6 +3805,88 @@ If PROGRESS is nil, remove the progress indicator. */) return Qnil; } +/* A unique integer sleep block id and a hash map of its id to opaque + NSObject sleep block activity tokens. */ +static unsigned int sleep_block_id = 0; +static NSMutableDictionary *sleep_block_map = NULL; + +DEFUN ("ns-block-system-sleep", + Fns_block_system_sleep, + Sns_block_system_sleep, + 2, 2, 0, + doc: /* Block system idle sleep. +WHY is a string reason for the block. +If ALLOW-DISPLAY-SLEEP is non-nil, block the screen from sleeping. +Return a token to unblock this block using `ns-unblock-system-sleep', +or nil if the block fails. */) + (Lisp_Object why, Lisp_Object allow_display_sleep) +{ + block_input (); + + NSString *reason = @"Emacs"; + if (!NILP (why)) + { + CHECK_STRING (why); + reason = [NSString stringWithLispString: why]; + } + + unsigned long activity_options = + NSActivityUserInitiated | NSActivityIdleSystemSleepDisabled; + if (NILP (allow_display_sleep)) + activity_options |= NSActivityIdleDisplaySleepDisabled; + + NSProcessInfo *processInfo = [NSProcessInfo processInfo]; + NSObject *activity_id = nil; + if ([processInfo respondsToSelector:@selector(beginActivityWithOptions:reason:)]) + activity_id = [[NSProcessInfo processInfo] + beginActivityWithOptions: activity_options + reason: reason]; + unblock_input (); + + if (!sleep_block_map) + sleep_block_map = [[NSMutableDictionary alloc] initWithCapacity: 25]; + + if (activity_id) + { + [sleep_block_map setObject: activity_id + forKey: [NSNumber numberWithInt: ++sleep_block_id]]; + return make_fixnum (sleep_block_id); + } + else + return Qnil; +} + +DEFUN ("ns-unblock-system-sleep", + Fns_unblock_system_sleep, + Sns_unblock_system_sleep, + 1, 1, 0, + doc: /* Unblock system idle sleep. +TOKEN is an object returned by `ns-block-system-sleep'. +Return non-nil if the TOKEN block was unblocked. */) + (Lisp_Object token) +{ + block_input (); + Lisp_Object res = Qnil; + CHECK_FIXNAT (token); + if (sleep_block_map) + { + NSNumber *key = [NSNumber numberWithInt: XFIXNAT (token)]; + NSObject *activity_id = [sleep_block_map objectForKey: key]; + if (activity_id) + { + NSProcessInfo *processInfo = [NSProcessInfo processInfo]; + if ([processInfo respondsToSelector:@selector(endActivity:)]) + { + [[NSProcessInfo processInfo] endActivity: activity_id]; + res = Qt; + } + [sleep_block_map removeObjectForKey: key]; + } + } + unblock_input (); + return res; +} + #ifdef NS_IMPL_COCOA DEFUN ("ns-send-items", @@ -4091,6 +4173,8 @@ The default value is t. */); defsubr (&Sns_badge); defsubr (&Sns_request_user_attention); defsubr (&Sns_progress_indicator); + defsubr (&Sns_block_system_sleep); + defsubr (&Sns_unblock_system_sleep); #ifdef NS_IMPL_COCOA defsubr (&Sns_send_items); #endif diff --git a/src/nsterm.m b/src/nsterm.m index c852b70be74..d0bbd1b4660 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5838,15 +5838,6 @@ ns_term_init (Lisp_Object display_name) ns_pending_service_names = [[NSMutableArray alloc] init]; ns_pending_service_args = [[NSMutableArray alloc] init]; -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 260000 - /* Disable problematic event processing on macOS 26 (Tahoe) to avoid - scrolling lag and input handling issues. These are undocumented - options as of macOS 26.0. */ - [NSUserDefaults.standardUserDefaults - registerDefaults:@{@"NSEventConcurrentProcessingEnabled" : @"NO", - @"NSApplicationUpdateCycleEnabled" : @"NO"}]; -#endif - /* Start app and create the main menu, window, view. Needs to be here because ns_initialize_display_info () uses AppKit classes. The view will then ask the NSApp to stop and return to Emacs. */ @@ -6383,6 +6374,20 @@ ns_term_shutdown (int sig) object:nil]; #endif +#ifdef NS_IMPL_COCOA + /* Sleep event notification. */ + [[[NSWorkspace sharedWorkspace] notificationCenter] + addObserver: self + selector:@selector(systemWillSleep:) + name: NSWorkspaceWillSleepNotification + object: nil]; + [[[NSWorkspace sharedWorkspace] notificationCenter] + addObserver: self + selector: @selector(systemDidWake:) + name: NSWorkspaceDidWakeNotification + object: nil]; +#endif + #ifdef NS_IMPL_COCOA /* Some functions/methods in CoreFoundation/Foundation increase the maximum number of open files for the process in their first call. @@ -6421,6 +6426,31 @@ ns_term_shutdown (int sig) #endif } +/* Sleep event notification. */ + +- (void) systemWillSleep:(NSNotification *)notification +{ +#ifdef NS_IMPL_COCOA + NSTRACE ("[EmacsApp systemWillSleep:]"); + struct input_event ie; + EVENT_INIT (ie); + ie.kind = SLEEP_EVENT; + ie.arg = list1 (Qpre_sleep); + kbd_buffer_store_event (&ie); +#endif +} + +- (void) systemDidWake:(NSNotification *)notification +{ +#ifdef NS_IMPL_COCOA + NSTRACE ("[EmacsApp systemDidWake:]"); + struct input_event ie; + EVENT_INIT (ie); + ie.kind = SLEEP_EVENT; + ie.arg = list1 (Qpost_wake); + kbd_buffer_store_event (&ie); +#endif +} /* Termination sequences: C-x C-c: diff --git a/src/w32fns.c b/src/w32fns.c index b75bce8d1a2..3a32d046132 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -11325,6 +11325,136 @@ if the selected frame is not (yet) associated with a window handle */) #endif /* WINDOWSNT */ +/*********************************************************************** + System Sleep Support + ***********************************************************************/ + +typedef ULONG (WINAPI * SetThreadExecutionState_Proc) + (IN ULONG); +static SetThreadExecutionState_Proc SetThreadExecutionState_fn = NULL; + +static unsigned int sleep_block_id = 0; +static unsigned int sleep_block_count = 0; + +DEFUN ("w32-block-system-sleep", + Fw32_block_system_sleep, + Sw32_block_system_sleep, + 1, 1, 0, + doc: /* Block system idle sleep. +If ALLOW-DISPLAY-SLEEP is non-nil, block the screen from sleeping. +Return a token to unblock this block using `w32-unblock-system-sleep', +or nil if the block fails. */) + (Lisp_Object allow_display_sleep) +{ + if (SetThreadExecutionState_fn == NULL) + return Qnil; + + /* ES_CONTINUOUS keeps the state until cleared. */ + EXECUTION_STATE new_state = ES_SYSTEM_REQUIRED | ES_CONTINUOUS; + if (NILP (allow_display_sleep)) + new_state |= ES_DISPLAY_REQUIRED; + + if (SetThreadExecutionState (new_state) == 0) + return Qnil; + else + { + /* One more block and next id. */ + ++sleep_block_count; + ++sleep_block_id; + + /* Synthesize a token. */ + return make_fixnum (sleep_block_id); + } +} + +DEFUN ("w32-unblock-system-sleep", + Fw32_unblock_system_sleep, + Sw32_unblock_system_sleep, + 0, 0, 0, + doc: /* Unblock system idle sleep. +Return non-nil if the TOKEN block was unblocked. */) + (void) +{ + if (SetThreadExecutionState_fn == NULL) + return Qnil; + + /* No blocks to unblock. */ + if (sleep_block_count == 0) + return Qnil; + + /* One fewer block. */ + if (--sleep_block_count == 0 + && SetThreadExecutionState (ES_CONTINUOUS) == 0) + return Qnil; + else + return Qt; +} + +DEFUN ("w32-system-sleep-block-count", + Fw32_system_sleep_block_count, + Sw32_system_sleep_block_count, + 0, 0, 0, + doc: /* Return the w32 sleep block count. */) + (void) +{ + return make_fixnum (sleep_block_count); +} + +typedef ULONG (CALLBACK *PMY_DEVICE_NOTIFY_CALLBACK_ROUTINE) + (PVOID Context, ULONG Type, PVOID Setting); + +static ULONG ALIGN_STACK +sleep_notification_callback(PVOID _Context, ULONG Type, PVOID _Setting) +{ + struct input_event ie; + EVENT_INIT (ie); + ie.kind = SLEEP_EVENT; + + switch (Type) + { + case PBT_APMRESUMEAUTOMATIC: + /* Ignore this event. No user is present. */ + break; + case PBT_APMSUSPEND: + ie.arg = list1 (Qpre_sleep); + kbd_buffer_store_event (&ie); + break; + case PBT_APMRESUMESUSPEND: + ie.arg = list1 (Qpost_wake); + kbd_buffer_store_event (&ie); + break; + } + return 0; +} + +typedef HPOWERNOTIFY (WINAPI * RegisterSuspendResumeNotification_Proc) + (IN HANDLE, IN DWORD); +static RegisterSuspendResumeNotification_Proc RegisterSuspendResumeNotification_fn = NULL; + +static HPOWERNOTIFY sleep_notification_handle = 0; + +typedef struct _MY_DEVICE_NOTIFY_SUBSCRIBE_PARAMETERS { + PMY_DEVICE_NOTIFY_CALLBACK_ROUTINE Callback; + PVOID Context; +} MY_DEVICE_NOTIFY_SUBSCRIBE_PARAMETERS, *PMY_DEVICE_NOTIFY_SUBSCRIBE_PARAMETERS; + +void +w32_register_for_sleep_notifications() +{ + /* PowerRegisterSuspendResumeNotification is not a user-space call so + we use RegisterSuspendResumeNotification. */ + if (RegisterSuspendResumeNotification_fn) + { + MY_DEVICE_NOTIFY_SUBSCRIBE_PARAMETERS params; + params.Callback = sleep_notification_callback; + params.Context = NULL; + + /* DEVICE_NOTIFY_CALLBACK = 2 */ + sleep_notification_handle = + RegisterSuspendResumeNotification_fn (¶ms, 2); + } +} + /*********************************************************************** Initialization ***********************************************************************/ @@ -11834,6 +11964,10 @@ keys when IME input is received. */); defsubr (&Sw32_request_user_attention); DEFSYM (Qinformational, "informational"); DEFSYM (Qcritical, "critical"); + /* System sleep support. */ + defsubr (&Sw32_unblock_system_sleep); + defsubr (&Sw32_block_system_sleep); + defsubr (&Sw32_system_sleep_block_count); #endif } @@ -12094,6 +12228,7 @@ void globals_of_w32fns (void) { HMODULE user32_lib = GetModuleHandle ("user32.dll"); + HMODULE kernel32_lib = GetModuleHandle ("kernel32.dll"); /* TrackMouseEvent not available in all versions of Windows, so must load it dynamically. Do it once, here, instead of every time it is used. @@ -12120,6 +12255,16 @@ globals_of_w32fns (void) RegisterTouchWindow_fn = (RegisterTouchWindow_proc) get_proc_addr (user32_lib, "RegisterTouchWindow"); + /* For system sleep support. */ + SetThreadExecutionState_fn + = (SetThreadExecutionState_Proc) + get_proc_addr (kernel32_lib, + "SetThreadExecutionState"); + RegisterSuspendResumeNotification_fn + = (RegisterSuspendResumeNotification_Proc) + get_proc_addr (user32_lib, + "RegisterSuspendResumeNotification"); + SetGestureConfig_fn = (SetGestureConfig_proc) get_proc_addr (user32_lib, "SetGestureConfig"); diff --git a/src/w32term.c b/src/w32term.c index 091a1fbd5f1..5b7d9c5f17d 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -8249,6 +8249,7 @@ w32_initialize (void) } w32_get_mouse_wheel_vertical_delta (); + w32_register_for_sleep_notifications (); } void diff --git a/src/w32term.h b/src/w32term.h index 91db0b6e249..cb9d59371a4 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -274,6 +274,7 @@ extern const char *w32_get_string_resource (void *v_rdb, extern frame_parm_handler w32_frame_parm_handlers[]; extern void w32_default_font_parameter (struct frame* f, Lisp_Object parms); extern Lisp_Object w32_process_dnd_data (int format, void *pDataObj); +extern void w32_register_for_sleep_notifications(); #define PIX_TYPE COLORREF