From ec8baf1595a27ef0aa9a90dea230af44419e987e Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 21 Nov 2022 11:47:08 -0800 Subject: [PATCH 2/2] Don't explicitly delete client frames when killing Emacs anyway This eliminates a useless error prompt when killing Emacs from a client frame when there are no other frames (bug#58877). * lisp/server.el (server-running-external): New error. (server--file-name): New function... (server-eval-at): ... use it. (server-start): Factor out server stopping code into... (server-stop): ... here. (server-force-stop): Use 'server-stop', and tell it not to delete frames. * test/lisp/server-tests.el (server-tests/server-force-stop/keeps-frames): New test. --- lisp/server.el | 130 ++++++++++++++++++++++---------------- test/lisp/server-tests.el | 35 ++++++++++ 2 files changed, 112 insertions(+), 53 deletions(-) diff --git a/lisp/server.el b/lisp/server.el index 553890ce29..6db33fadb1 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -287,6 +287,8 @@ server-socket-dir "The directory in which to place the server socket. If local sockets are not supported, this is nil.") +(define-error 'server-running-external "External server running") + (defun server-clients-with (property value) "Return a list of clients with PROPERTY set to VALUE." (let (result) @@ -610,6 +612,54 @@ server-get-auth-key (error "The key `%s' is invalid" server-auth-key)) (server-generate-key))) +(defsubst server--file-name () + "Return the file name to use for the server socket." + (let ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))) + (expand-file-name server-name server-dir))) + +(defun server-stop (&optional noframe) + "If this Emacs process has a server communication subprocess, stop it. +If the server is running in some other Emac process (see +`server-running-p'), signal a `server-running-external' error. + +If NOFRAME is non-nil, don't delete any existing frames +associated with a client process. This is useful, for example, +when killing Emacs, in which case the frames will get deleted +anyway." + (let ((server-file (server--file-name))) + (when server-process + ;; Kill it dead! + (ignore-errors (delete-process server-process)) + (unless noframe + (server-log (message "Server stopped"))) + (setq server-process nil + server-mode nil + global-minor-modes (delq 'server-mode global-minor-modes))) + (unwind-protect + ;; Delete the socket files made by previous server + ;; invocations. + (if (not (eq t (server-running-p server-name))) + ;; Remove any leftover socket or authentication file. + (ignore-errors + (let (delete-by-moving-to-trash) + (delete-file server-file) + ;; Also delete the directory that the server file was + ;; created in -- but only in /tmp (see bug#44644). + ;; There may be other servers running, too, so this may + ;; fail. + (when (equal (file-name-directory + (directory-file-name + (file-name-directory server-file))) + "/tmp/") + (ignore-errors + (delete-directory (file-name-directory server-file)))))) + (signal 'server-running-external + (list (format "There is an existing Emacs server, named %S" + server-name)))) + ;; If this Emacs already had a server, clear out associated status. + (while server-clients + (server-delete-client (car server-clients) noframe))))) + ;;;###autoload (defun server-start (&optional leave-dead inhibit-prompt) "Allow this Emacs process to be a server for client processes. @@ -643,55 +693,30 @@ server-start (inhibit-prompt t) (t (yes-or-no-p "The current server still has clients; delete them? ")))) - (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) - (server-file (expand-file-name server-name server-dir))) - (when server-process - ;; kill it dead! - (ignore-errors (delete-process server-process))) - ;; Check to see if an uninitialized external socket has been - ;; passed in, if that is the case, skip checking - ;; `server-running-p' as this will return the wrong result. - (if (and internal--daemon-sockname - (not server--external-socket-initialized)) - (setq server--external-socket-initialized t) - ;; Delete the socket files made by previous server invocations. - (if (not (eq t (server-running-p server-name))) - ;; Remove any leftover socket or authentication file. - (ignore-errors - (let (delete-by-moving-to-trash) - (delete-file server-file) - ;; Also delete the directory that the server file was - ;; created in -- but only in /tmp (see bug#44644). - ;; There may be other servers running, too, so this may - ;; fail. - (when (equal (file-name-directory - (directory-file-name - (file-name-directory server-file))) - "/tmp/") - (ignore-errors - (delete-directory (file-name-directory server-file)))))) - (display-warning - 'server - (concat "Unable to start the Emacs server.\n" - (format "There is an existing Emacs server, named %S.\n" - server-name) - (substitute-command-keys - "To start the server in this Emacs process, stop the existing -server or call `\\[server-force-delete]' to forcibly disconnect it.")) - :warning) - (setq leave-dead t))) - ;; If this Emacs already had a server, clear out associated status. - (while server-clients - (server-delete-client (car server-clients))) + ;; If a server is already running, try to stop it. + (condition-case err + ;; Check to see if an uninitialized external socket has been + ;; passed in. If that is the case, don't try to stop the + ;; server. (`server-stop' checks `server-running-p', which + ;; would return the wrong result). + (if (and internal--daemon-sockname + (not server--external-socket-initialized)) + (setq server--external-socket-initialized t) + (server-stop)) + (server-running-external + (display-warning + 'server + (concat "Unable to start the Emacs server.\n" + (cadr err) + (substitute-command-keys + "\nTo start the server in this Emacs process, stop the existingserver or call `\\[server-force-delete]' to forcibly disconnect it.")) + :warning) + (setq leave-dead t))) ;; Now any previous server is properly stopped. - (if leave-dead - (progn - (unless (eq t leave-dead) (server-log (message "Server stopped"))) - (setq server-mode nil - global-minor-modes (delq 'server-mode global-minor-modes) - server-process nil)) + (unless leave-dead + (let ((server-file (server--file-name))) ;; Make sure there is a safe directory in which to place the socket. - (server-ensure-safe-dir server-dir) + (server-ensure-safe-dir (file-name-directory server-file)) (when server-process (server-log (message "Restarting server"))) (with-file-modes ?\700 @@ -745,7 +770,7 @@ server-start (defun server-force-stop () "Kill all connections to the current server. This function is meant to be called from `kill-emacs-hook'." - (server-start t t)) + (ignore-errors (server-stop 'noframe))) ;;;###autoload (defun server-force-delete (&optional name) @@ -1866,11 +1891,10 @@ server-eval-at cannot contact the specified server. For example: (server-eval-at \"server\" \\='(emacs-pid)) returns the process ID of the Emacs instance running \"server\"." - (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) - (server-file (expand-file-name server server-dir)) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) - address port secret process) + (let ((server-file (server--file-name)) + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) + address port secret process) (unless (file-exists-p server-file) (error "No such server: %s" server)) (with-temp-buffer diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el index 48ef110943..370cf86148 100644 --- a/test/lisp/server-tests.el +++ b/test/lisp/server-tests.el @@ -131,4 +131,39 @@ server-tests/emacsclient/eval "--eval" (format "(setq server-tests/variable %d)" value)) (server-tests/wait-until (eq server-tests/variable value))))) +(ert-deftest server-tests/server-force-stop/keeps-frames () + "Ensure that `server-force-stop' doesn't delete frames. See bug#58877. +Note: since that bug is about a behavior when killing Emacs, this +test is somewhat indirect. (Killing the current Emacs instance +would make it hard to check test results!) Instead, it only +tests that `server-force-stop' doesn't delete frames (and even +then, requires a few tricks to run as a regression test). So +long as this works, the problem in bug#58877 shouldn't occur." + (let (terminal) + (unwind-protect + (server-tests/with-server + (let ((emacsclient (server-tests/start-emacsclient "-c"))) + (server-tests/wait-until (length= (frame-list) 2)) + (should (eq (process-status emacsclient) 'run)) + + ;; Don't delete the terminal for the client; that would + ;; kill its frame immediately too. (This is only an issue + ;; when running these tests via the command line; + ;; normally, in an interactive session, we don't need to + ;; worry about this. But since we want to check that + ;; `server-force-stop' doesn't delete frames under normal + ;; circumstances, we need to bypass terminal deletion + ;; here.) + (setq terminal (process-get (car server-clients) 'terminal)) + (process-put (car server-clients) 'no-delete-terminal t) + + (server-force-stop)) + ;; Ensure we didn't delete the frame. + (should (length= (frame-list) 2))) + ;; Clean up after ourselves and delete the terminal. + (when (and terminal + (eq (terminal-live-p terminal) t) + (not (eq system-type 'windows-nt))) + (delete-terminal terminal))))) + ;;; server-tests.el ends here -- 2.25.1