From 6afdd33556870059458b19fb9f064f564cf15a4f Mon Sep 17 00:00:00 2001 From: Karoly Lorentey Date: Fri, 4 Feb 2005 13:56:51 +0000 Subject: [PATCH] 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 --- lib-src/emacsclient.c | 17 ++++- lisp/frame.el | 2 +- lisp/server.el | 160 ++++++++++++++++++++++++++++++++++-------- 3 files changed, 149 insertions(+), 30 deletions(-) diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 888c85e868..fbe719772b 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -704,6 +704,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", } } + retry: if (nowait) fprintf (out, "-nowait "); @@ -832,14 +833,25 @@ To start the server in Emacs, type \"M-x server-start\".\n", 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 @@ To start the server in Emacs, type \"M-x server-start\".\n", } 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 @@ To start the server in Emacs, type \"M-x server-start\".\n", } else if (strprefix ("-suspend ", str)) { + /* -suspend: Suspend this terminal, i.e., stop the process. */ if (needlf) printf ("\n"); needlf = 0; @@ -863,6 +877,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", } else { + /* Unknown command. */ if (needlf) printf ("\n"); printf ("*ERROR*: Unknown message: %s", str); diff --git a/lisp/frame.el b/lisp/frame.el index 3658cfc187..dabc223fa9 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -584,7 +584,7 @@ The optional second argument PARAMETERS specifies additional frame parameters." (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))) diff --git a/lisp/server.el b/lisp/server.el index baf07a8718..1cb85c9f07 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -333,11 +333,12 @@ message." (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 @@ message." (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 @@ contains a space." (?\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 @@ Server mode runs a process that accepts commands from the (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 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (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 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." ((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 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." ;; 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 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (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 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (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) -- 2.20.1