From: Jim Porter Date: Mon, 21 Nov 2022 19:47:08 +0000 (-0800) Subject: Don't explicitly delete client frames when killing Emacs anyway X-Git-Tag: emacs-29.0.90~1516 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=28c444f72a9843ce335032db1fa0f484dfeb4833;p=emacs.git 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. --- diff --git a/lisp/server.el b/lisp/server.el index 2973b783e64..f7aaf6a6c6e 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -287,6 +287,8 @@ If nil, no instructions are displayed." "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 @@ If the key is not valid, signal an error." (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 Emacs 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 @@ the `server-process' variable." (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 @@ -748,7 +773,7 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) (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) @@ -1869,11 +1894,10 @@ Returns the result of the evaluation, or signals an error if it 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 48ef110943e..370cf86148a 100644 --- a/test/lisp/server-tests.el +++ b/test/lisp/server-tests.el @@ -131,4 +131,39 @@ "--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