changeset 83246:5bc762f84335

Prevent emacsclient errors when Emacs is compiled without X support. * lisp/frame.el (make-frame-on-display): Protect condition on x-initialized when x-win.el is not loaded. * lib-src/emacsclient.c (main): Handle -window-system-unsupported command. Doc update. * lisp/server.el (server-process-filter): Don't try to create an X frame when Emacs does not support it. Improve logging. * lisp/server.el (server-send-string): New function. (server-handle-suspend-tty, server-process-filter): Use it. * lisp/server.el (server-process-filter, server-unquote-arg) (server-quote-arg): Doc updates. git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-286
author Karoly Lorentey <lorentey@elte.hu>
date Fri, 04 Feb 2005 13:56:51 +0000
parents 8e31483da0e5
children a257c9edb57b
files lib-src/emacsclient.c lisp/frame.el lisp/server.el
diffstat 3 files changed, 149 insertions(+), 30 deletions(-) [+]
line wrap: on
line diff
--- a/lib-src/emacsclient.c	Fri Feb 04 00:09:46 2005 +0000
+++ b/lib-src/emacsclient.c	Fri Feb 04 13:56:51 2005 +0000
@@ -704,6 +704,7 @@
       }
   }
 
+ retry:
   if (nowait)
     fprintf (out, "-nowait ");
 
@@ -832,14 +833,25 @@
 
       if (strprefix ("-good-version ", str))
         {
-          /* OK, we got the green light. */
+          /* -good-version: The versions match. */
         }
       else if (strprefix ("-emacs-pid ", str))
         {
+          /* -emacs-pid PID: The process id of the Emacs process. */
           emacs_pid = strtol (string + strlen ("-emacs-pid"), NULL, 10);
         }
+      else if (strprefix ("-window-system-unsupported ", str))
+        {
+          /* -window-system-unsupported: Emacs was compiled without X
+              support.  Try again on the terminal. */
+          window_system = 0;
+          nowait = 0;
+          tty = 1;
+          goto retry;
+        }
       else if (strprefix ("-print ", str))
         {
+          /* -print STRING: Print STRING on the terminal. */
           str = unquote_argument (str + strlen ("-print "));
           if (needlf)
             printf ("\n");
@@ -848,6 +860,7 @@
         }
       else if (strprefix ("-error ", str))
         {
+          /* -error DESCRIPTION: Signal an error on the terminal. */
           str = unquote_argument (str + strlen ("-error "));
           if (needlf)
             printf ("\n");
@@ -856,6 +869,7 @@
         }
       else if (strprefix ("-suspend ", str))
         {
+          /* -suspend: Suspend this terminal, i.e., stop the process. */
           if (needlf)
             printf ("\n");
           needlf = 0;
@@ -863,6 +877,7 @@
         }
       else
         {
+          /* Unknown command. */
           if (needlf)
             printf ("\n");
           printf ("*ERROR*: Unknown message: %s", str);
--- a/lisp/frame.el	Fri Feb 04 00:09:46 2005 +0000
+++ b/lisp/frame.el	Fri Feb 04 13:56:51 2005 +0000
@@ -584,7 +584,7 @@
   (interactive "sMake frame on display: ")
   (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
       (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
-  (unless x-initialized
+  (when (and (boundp 'x-initialized) (not x-initialized))
     (setq x-display-name display)
     (x-initialize-window-system))
   (make-frame `((window-system . x) (display . ,display) . ,parameters)))
--- a/lisp/server.el	Fri Feb 04 00:09:46 2005 +0000
+++ b/lisp/server.el	Fri Feb 04 13:56:51 2005 +0000
@@ -333,11 +333,12 @@
   (dolist (proc (server-clients-with 'display display))
     (server-log (format "server-handle-suspend-tty, display %s" display) proc)
     (condition-case err
-	(process-send-string proc "-suspend \n")
+	(server-send-string proc "-suspend \n")
       (file-error (condition-case nil (server-delete-client proc) (error nil))))))
 
 (defun server-unquote-arg (arg)
-  "Remove &-quotation from ARG."
+  "Remove &-quotation from ARG.
+See `server-quote-arg' and `server-process-filter'."
   (replace-regexp-in-string
    "&." (lambda (s)
 	  (case (aref s 1)
@@ -350,7 +351,9 @@
 (defun server-quote-arg (arg)
   "In ARG, insert a & before each &, each space, each newline, and -.
 Change spaces to underscores, too, so that the return value never
-contains a space."
+contains a space.
+
+See `server-unquote-arg' and `server-process-filter'."
   (replace-regexp-in-string
    "[-&\n ]" (lambda (s)
 	       (case (aref s 0)
@@ -360,6 +363,11 @@
 		 (?\s "&_")))
    arg t t))
 
+(defun server-send-string (proc string)
+  "A wrapper around `proc-send-string' for logging."
+  (server-log (concat "Sent " string) proc)
+  (process-send-string proc string))
+
 (defun server-ensure-safe-dir (dir)
   "Make sure DIR is a directory with no race-condition issues.
 Creates the directory if necessary and makes sure:
@@ -443,8 +451,99 @@
 
 (defun server-process-filter (proc string)
   "Process a request from the server to edit some files.
-PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
-  (server-log string proc)
+PROC is the server process.  STRING consists of a sequence of
+commands prefixed by a dash.  Some commands have arguments; these
+are &-quoted and need to be decoded by `server-unquote-arg'.  The
+filter parses and executes these commands.
+
+To illustrate the protocol, here is an example command that
+emacsclient sends to create a new X frame (note that the whole
+sequence is sent on a single line):
+
+	-version 21.3.50 xterm
+	-env HOME /home/lorentey
+	-env DISPLAY :0.0
+	... lots of other -env commands
+	-display :0.0
+	-window-system
+
+The server normally sends back the single command `-good-version'
+as a response.
+
+The following commands are accepted by the server:
+
+`-version CLIENT-VERSION'
+  Check version numbers between server and client, and signal an
+  error if there is a mismatch.  The server replies with
+  `-good-version' to confirm the match.
+
+`-env NAME VALUE'
+  An environment variable on the client side.
+
+`-nowait'
+  Request that the next frame created should not be
+  associated with this client.
+
+`-display DISPLAY'
+  Set the display name to open X frames on.
+
+`-position LINE[:COLUMN]'
+  Go to the given line and column number
+  in the next file opened.
+
+`-file FILENAME'
+  Load the given file in the current frame.
+
+`-eval EXPR'
+  Evaluate EXPR as a Lisp expression and return the
+  result in -print commands.
+
+`-window-system'
+  Open a new X frame.
+
+`-tty DEVICENAME TYPE'
+  Open a new tty frame at the client.
+
+`-resume'
+  Resume this tty frame. The client sends this string when it
+  gets the SIGCONT signal and it is the foreground process on its
+  controlling tty.
+
+`-suspend'
+  Suspend this tty frame.  The client sends this string in
+  response to SIGTSTP and SIGTTOU.  The server must cease all I/O
+  on this tty until it gets a -resume command.
+
+`-ignore COMMENT'
+  Do nothing, but put the comment in the server
+  log.  Useful for debugging.
+
+
+The following commands are accepted by the client:
+
+`-good-version'
+  Signals a version match between the client and the server.
+
+`-emacs-pid PID'
+  Describes the process id of the Emacs process;
+  used to forward window change signals to it.
+
+`-window-system-unsupported'
+  Signals that the server does not
+  support creating X frames; the client must try again with a tty
+  frame.
+
+`-print STRING'
+  Print STRING on stdout.  Used to send values
+  returned by -eval.
+
+`-error DESCRIPTION'
+  Signal an error (but continue processing).
+
+`-suspend'
+  Suspend this terminal, i.e., stop the client process.  Sent
+  when the user presses C-z."
+  (server-log (concat "Received " string) proc)
   (let ((prev (process-get proc 'previous-string)))
     (when prev
       (setq string (concat prev string))
@@ -483,7 +582,7 @@
 		    (setq request (substring request (match-end 0)))
 		    (if (equal client-version truncated-emacs-version)
 			(progn
-			  (process-send-string proc "-good-version \n")
+			  (server-send-string proc "-good-version \n")
 			  (server-client-set client 'version client-version))
 		      (error (concat "Version mismatch: Emacs is "
 				     truncated-emacs-version
@@ -502,20 +601,26 @@
 		 ((equal "-window-system" arg)
 		  (unless (server-client-get client 'version)
 		    (error "Protocol error; make sure to use the correct version of emacsclient"))
-		  (setq frame (make-frame-on-display
-			       (or display
-				   (frame-parameter nil 'display)
-				   (getenv "DISPLAY")
-				   (error "Please specify display"))
-			       (list (cons 'client proc))))
-		  ;; XXX We need to ensure the client parameter is
-		  ;; really set because Emacs forgets initialization
-		  ;; parameters for X frames at the moment.
-		  (modify-frame-parameters frame (list (cons 'client proc)))
-		  (select-frame frame)
-		  (server-client-set client 'frame frame)
-		  (server-client-set client 'display (frame-display frame))
-		  (setq dontkill t))
+		  (if (fboundp 'x-create-frame)
+		      (progn
+			(setq frame (make-frame-on-display
+				     (or display
+					 (frame-parameter nil 'display)
+					 (getenv "DISPLAY")
+					 (error "Please specify display"))
+				     (list (cons 'client proc))))
+			;; XXX We need to ensure the client parameter is
+			;; really set because Emacs forgets initialization
+			;; parameters for X frames at the moment.
+			(modify-frame-parameters frame (list (cons 'client proc)))
+			(select-frame frame)
+			(server-client-set client 'frame frame)
+			(server-client-set client 'display (frame-display frame))
+			(setq dontkill t))
+		    ;; This emacs does not support X.
+		    (server-log "Window system unsupported" proc)
+		    (server-send-string proc "-window-system-unsupported \n")
+		    (setq dontkill t)))
 
 		 ;; -resume:  Resume a suspended tty frame.
 		 ((equal "-resume" arg)
@@ -562,7 +667,7 @@
 		    ;; Set up display for the remote locale.
 		    (configure-display-for-locale)
 		    ;; Reply with our pid.
-		    (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
+		    (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
 		    (setq dontkill t)))
 
 		 ;; -position LINE:  Go to the given line in the next file.
@@ -598,12 +703,11 @@
 			(with-temp-buffer
 			  (let ((standard-output (current-buffer)))
 			    (pp v)
-			    (process-send-string proc "-print ")
-			    (process-send-string
-			     proc (server-quote-arg
-				   (buffer-substring-no-properties (point-min)
-								   (point-max))))
-			    (process-send-string proc "\n")))))
+			    (server-send-string
+			     proc (format "-print %s\n"
+					  (server-quote-arg
+					   (buffer-substring-no-properties (point-min)
+									   (point-max)))))))))
 		    (setq lineno 1
 			  columnno 0)))
 
@@ -657,7 +761,7 @@
 	  (process-put proc 'previous-string string)))
     ;; condition-case
     (error (ignore-errors
-	     (process-send-string
+	     (server-send-string
 	      proc (concat "-error " (server-quote-arg (error-message-string err))))
 	     (setq string "")
 	     (server-log (error-message-string err) proc)