all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Jim Porter <jporterbugs@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 58877@debbugs.gnu.org
Subject: bug#58877: 29.0.50; [PATCH] When killing Emacs from a client frame with no other frames, Emacs shows a useless error prompt
Date: Mon, 21 Nov 2022 21:06:31 -0800	[thread overview]
Message-ID: <a4d8971b-39fc-e57b-f05d-56aa42821734@gmail.com> (raw)
In-Reply-To: <13835614-c593-ba2d-5373-a9950f6f3dab@gmail.com>

[-- Attachment #1: Type: text/plain, Size: 579 bytes --]

On 10/30/2022 2:14 PM, Jim Porter wrote:
> Thanks for taking a look. I had hesitated to make any big changes to 
> this code since it doesn't have regression tests...
Since server.el could probably use more tests anyway, I added a few ERT 
tests covering the most common use cases (see the first patch), and then 
added another test for the second patch. The test in the second patch is 
pretty indirect, but that's because it's testing something that normally 
happens when killing Emacs; it'd be hard to kill the current Emacs 
instance and still be able to check test results!

[-- Attachment #2: 0001-Add-more-tests-for-the-Emacs-server.patch --]
[-- Type: text/plain, Size: 6581 bytes --]

From 339661e4f2876adef8f21d89c4e3c09e5e8df053 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sat, 19 Nov 2022 22:26:45 -0800
Subject: [PATCH 1/2] ; Add more tests for the Emacs server

* test/lisp/server-tests.el (server-tests/emacs-client)
(server-tests/max-wait-time): New constants.
(server-tests/start-emacsclient): New function.
(server-tests/with-server, server-tests/wait-until): New macros.
(server-tests/variable): New variable.
(server-test/server-start-sets-minor-mode): Rename to...
(server-tests/server-start/sets-minor-mode): ... this.
(server-tests/server-start/stop-prompt-with-client)
(server-tests/server-start/no-stop-prompt-without-client)
(server-tests/emacsclient/server-edit)
(server-tests/emacsclient/create-frame, server-test/emacsclient/eval):
New tests.

* test/lib-src/emacsclient-tests.el: Mention the above file.
---
 test/lib-src/emacsclient-tests.el |   4 +-
 test/lisp/server-tests.el         | 111 +++++++++++++++++++++++++++---
 2 files changed, 105 insertions(+), 10 deletions(-)

diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el
index 1302fbe30c..0fa3c6facf 100644
--- a/test/lib-src/emacsclient-tests.el
+++ b/test/lib-src/emacsclient-tests.el
@@ -19,7 +19,9 @@
 
 ;;; Commentary:
 
-;;
+;; Tests for the emacsclient executable.  For tests involving the
+;; interaction between emacsclient and an Emacs server, see
+;; test/lisp/server-tests.el.
 
 ;;; Code:
 
diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el
index 351b8ef8d1..48ef110943 100644
--- a/test/lisp/server-tests.el
+++ b/test/lisp/server-tests.el
@@ -22,20 +22,113 @@
 (require 'ert)
 (require 'server)
 
+(defconst server-tests/emacsclient
+  (if installation-directory
+      (expand-file-name "lib-src/emacsclient" installation-directory)
+    "emacsclient")
+  "The emacsclient binary to test.")
+
+(defun server-tests/start-emacsclient (&rest args)
+  "Run emacsclient, passing ARGS as arguments to it."
+  (let ((socket-name (process-get server-process :server-file)))
+    (make-process
+     :name server-tests/emacsclient
+     :command (append (list server-tests/emacsclient
+                            "--socket-name" socket-name)
+                      args))))
+
+(defmacro server-tests/with-server (&rest body)
+  "Start the Emacs server, evaluate BODY, and then stop the server."
+  (declare (indent 0))
+  `(progn
+     (server-start)
+     (unwind-protect
+         (progn (should (processp server-process))
+                ,@body)
+       (let ((inhibit-message t))
+         (server-start t t))
+       (should (null server-process))
+       (should (null server-clients)))))
+
+(defconst server-tests/max-wait-time 5
+  "The maximum time to wait in `server-tests/wait-until', in seconds.")
+
+(defmacro server-tests/wait-until (form)
+  "Wait until FORM is non-nil, timing out and failing if it takes too long."
+  `(let ((start (current-time)))
+    (while (not ,form)
+      (when (> (float-time (time-since start))
+               server-tests/max-wait-time)
+        (ert-fail (format "timed out waiting for %S to be non-nil" ',form)))
+      (sit-for 0.1))))
+
+(defvar server-tests/variable nil)
+
 ;;; Tests:
 
-(ert-deftest server-test/server-start-sets-minor-mode ()
+(ert-deftest server-tests/server-start/sets-minor-mode ()
   "Ensure that calling `server-start' also sets `server-mode' properly."
-  (server-start)
-  (unwind-protect
-      (progn
-        ;; Make sure starting the server activates the minor mode.
-        (should (eq server-mode t))
-        (should (memq 'server-mode global-minor-modes)))
-    ;; Always stop the server, even if the above checks fail.
-    (server-start t))
+  (server-tests/with-server
+    ;; Make sure starting the server activates the minor mode.
+    (should (eq server-mode t))
+    (should (memq 'server-mode global-minor-modes)))
   ;; Make sure stopping the server deactivates the minor mode.
   (should (eq server-mode nil))
   (should-not (memq 'server-mode global-minor-modes)))
 
+(ert-deftest server-tests/server-start/stop-prompt-with-client ()
+  "Ensure that stopping the server prompts when there are clients."
+  (server-tests/with-server
+    (let ((yes-or-no-p-called nil)
+          (emacsclient (server-tests/start-emacsclient "-c")))
+      (server-tests/wait-until (length= (frame-list) 2))
+      (cl-letf (((symbol-function 'yes-or-no-p)
+                 (lambda (_prompt)
+                   (setq yes-or-no-p-called t))))
+        (server-start t)
+        (should yes-or-no-p-called))
+      (server-tests/wait-until (eq (process-status emacsclient) 'exit)))))
+
+(ert-deftest server-tests/server-start/no-stop-prompt-without-client ()
+  "Ensure that stopping the server doesn't prompt when there are no clients."
+  (server-tests/with-server
+    (let ((yes-or-no-p-called nil))
+      (cl-letf (((symbol-function 'yes-or-no-p)
+                 (lambda (_prompt)
+                   (setq yes-or-no-p-called t))))
+        (let ((inhibit-message t))
+          (server-start t))
+        (should-not yes-or-no-p-called)))))
+
+(ert-deftest server-tests/emacsclient/server-edit ()
+  "Test that calling `server-edit' from a client buffer exits the client."
+  (server-tests/with-server
+    (let ((emacsclient (server-tests/start-emacsclient "file.txt")))
+      (server-tests/wait-until (get-buffer "file.txt"))
+      (should (eq (process-status emacsclient) 'run))
+      (should (length= server-clients 1))
+      (with-current-buffer "file.txt"
+        (server-edit))
+      (server-tests/wait-until (eq (process-status emacsclient) 'exit)))))
+
+(ert-deftest server-tests/emacsclient/create-frame ()
+  "Test that \"emacsclient -c\" creates a frame."
+  (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))
+      (should (length= server-clients 1))
+      (should (eq (frame-parameter (car (frame-list)) 'client)
+                  (car server-clients)))))
+  ;; The client frame should go away after the server stops.
+  (should (length= (frame-list) 1)))
+
+(ert-deftest server-tests/emacsclient/eval ()
+  "Test that \"emacsclient --eval\" works correctly."
+  (server-tests/with-server
+    (let ((value (random)))
+      (server-tests/start-emacsclient
+       "--eval" (format "(setq server-tests/variable %d)" value))
+      (server-tests/wait-until (eq server-tests/variable value)))))
+
 ;;; server-tests.el ends here
-- 
2.25.1


[-- Attachment #3: 0002-Don-t-explicitly-delete-client-frames-when-killing-E.patch --]
[-- Type: text/plain, Size: 10904 bytes --]

From ec8baf1595a27ef0aa9a90dea230af44419e987e Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
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


  reply	other threads:[~2022-11-22  5:06 UTC|newest]

Thread overview: 19+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-10-29 21:33 bug#58877: 29.0.50; [PATCH] When killing Emacs from a client frame with no other frames, Emacs shows a useless error prompt Jim Porter
2022-10-30  6:14 ` Eli Zaretskii
2022-10-30 21:14   ` Jim Porter
2022-11-22  5:06     ` Jim Porter [this message]
2022-11-24 11:51       ` Eli Zaretskii
2022-11-25  1:36         ` Jim Porter
2022-11-25 13:25           ` Eli Zaretskii
2022-11-25 19:31             ` Jim Porter
2022-11-25 20:18               ` Eli Zaretskii
2022-11-25 20:57                 ` Jim Porter
2022-11-26 14:43                   ` Eli Zaretskii
2022-11-26 19:04                     ` Jim Porter
2022-11-26 19:45                       ` Eli Zaretskii
2022-11-26 20:17                         ` Jim Porter
2022-11-26 20:35                           ` Eli Zaretskii
2022-11-26 21:44                             ` Jim Porter
2022-11-28  1:28                               ` Jim Porter
2022-11-28  3:31                                 ` Eli Zaretskii
2022-11-28  6:27                                   ` Jim Porter

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=a4d8971b-39fc-e57b-f05d-56aa42821734@gmail.com \
    --to=jporterbugs@gmail.com \
    --cc=58877@debbugs.gnu.org \
    --cc=eliz@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.