master 28c444f72a 2/2: Don't explicitly delete client frames when killing Emacs anyway

[Jim Porter]

branch: master
commit 28c444f72a9843ce335032db1fa0f484dfeb4833
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    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 2973b783e6..f7aaf6a6c6 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 48ef110943..370cf86148 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