Commit 6afdd335 authored by Karoly Lorentey's avatar Karoly Lorentey
Browse files

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
parent e5cdc723
...@@ -704,6 +704,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", ...@@ -704,6 +704,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
} }
} }
retry:
if (nowait) if (nowait)
fprintf (out, "-nowait "); fprintf (out, "-nowait ");
...@@ -832,14 +833,25 @@ To start the server in Emacs, type \"M-x server-start\".\n", ...@@ -832,14 +833,25 @@ To start the server in Emacs, type \"M-x server-start\".\n",
if (strprefix ("-good-version ", str)) if (strprefix ("-good-version ", str))
{ {
/* OK, we got the green light. */ /* -good-version: The versions match. */
} }
else if (strprefix ("-emacs-pid ", str)) 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); 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)) else if (strprefix ("-print ", str))
{ {
/* -print STRING: Print STRING on the terminal. */
str = unquote_argument (str + strlen ("-print ")); str = unquote_argument (str + strlen ("-print "));
if (needlf) if (needlf)
printf ("\n"); printf ("\n");
...@@ -848,6 +860,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", ...@@ -848,6 +860,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
} }
else if (strprefix ("-error ", str)) else if (strprefix ("-error ", str))
{ {
/* -error DESCRIPTION: Signal an error on the terminal. */
str = unquote_argument (str + strlen ("-error ")); str = unquote_argument (str + strlen ("-error "));
if (needlf) if (needlf)
printf ("\n"); printf ("\n");
...@@ -856,6 +869,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", ...@@ -856,6 +869,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
} }
else if (strprefix ("-suspend ", str)) else if (strprefix ("-suspend ", str))
{ {
/* -suspend: Suspend this terminal, i.e., stop the process. */
if (needlf) if (needlf)
printf ("\n"); printf ("\n");
needlf = 0; needlf = 0;
...@@ -863,6 +877,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", ...@@ -863,6 +877,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
} }
else else
{ {
/* Unknown command. */
if (needlf) if (needlf)
printf ("\n"); printf ("\n");
printf ("*ERROR*: Unknown message: %s", str); printf ("*ERROR*: Unknown message: %s", str);
......
...@@ -584,7 +584,7 @@ The optional second argument PARAMETERS specifies additional frame parameters." ...@@ -584,7 +584,7 @@ The optional second argument PARAMETERS specifies additional frame parameters."
(interactive "sMake frame on display: ") (interactive "sMake frame on display: ")
(or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display) (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
(error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) (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) (setq x-display-name display)
(x-initialize-window-system)) (x-initialize-window-system))
(make-frame `((window-system . x) (display . ,display) . ,parameters))) (make-frame `((window-system . x) (display . ,display) . ,parameters)))
......
...@@ -333,11 +333,12 @@ message." ...@@ -333,11 +333,12 @@ message."
(dolist (proc (server-clients-with 'display display)) (dolist (proc (server-clients-with 'display display))
(server-log (format "server-handle-suspend-tty, display %s" display) proc) (server-log (format "server-handle-suspend-tty, display %s" display) proc)
(condition-case err (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)))))) (file-error (condition-case nil (server-delete-client proc) (error nil))))))
(defun server-unquote-arg (arg) (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 (replace-regexp-in-string
"&." (lambda (s) "&." (lambda (s)
(case (aref s 1) (case (aref s 1)
...@@ -350,7 +351,9 @@ message." ...@@ -350,7 +351,9 @@ message."
(defun server-quote-arg (arg) (defun server-quote-arg (arg)
"In ARG, insert a & before each &, each space, each newline, and -. "In ARG, insert a & before each &, each space, each newline, and -.
Change spaces to underscores, too, so that the return value never 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 (replace-regexp-in-string
"[-&\n ]" (lambda (s) "[-&\n ]" (lambda (s)
(case (aref s 0) (case (aref s 0)
...@@ -360,6 +363,11 @@ contains a space." ...@@ -360,6 +363,11 @@ contains a space."
(?\s "&_"))) (?\s "&_")))
arg t t)) 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) (defun server-ensure-safe-dir (dir)
"Make sure DIR is a directory with no race-condition issues. "Make sure DIR is a directory with no race-condition issues.
Creates the directory if necessary and makes sure: Creates the directory if necessary and makes sure:
...@@ -443,8 +451,99 @@ Server mode runs a process that accepts commands from the ...@@ -443,8 +451,99 @@ Server mode runs a process that accepts commands from the
(defun server-process-filter (proc string) (defun server-process-filter (proc string)
"Process a request from the server to edit some files. "Process a request from the server to edit some files.
PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." PROC is the server process. STRING consists of a sequence of
(server-log string proc) 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))) (let ((prev (process-get proc 'previous-string)))
(when prev (when prev
(setq string (concat prev string)) (setq string (concat prev string))
...@@ -483,7 +582,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." ...@@ -483,7 +582,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(setq request (substring request (match-end 0))) (setq request (substring request (match-end 0)))
(if (equal client-version truncated-emacs-version) (if (equal client-version truncated-emacs-version)
(progn (progn
(process-send-string proc "-good-version \n") (server-send-string proc "-good-version \n")
(server-client-set client 'version client-version)) (server-client-set client 'version client-version))
(error (concat "Version mismatch: Emacs is " (error (concat "Version mismatch: Emacs is "
truncated-emacs-version truncated-emacs-version
...@@ -502,20 +601,26 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." ...@@ -502,20 +601,26 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
((equal "-window-system" arg) ((equal "-window-system" arg)
(unless (server-client-get client 'version) (unless (server-client-get client 'version)
(error "Protocol error; make sure to use the correct version of emacsclient")) (error "Protocol error; make sure to use the correct version of emacsclient"))
(setq frame (make-frame-on-display (if (fboundp 'x-create-frame)
(or display (progn
(frame-parameter nil 'display) (setq frame (make-frame-on-display
(getenv "DISPLAY") (or display
(error "Please specify display")) (frame-parameter nil 'display)
(list (cons 'client proc)))) (getenv "DISPLAY")
;; XXX We need to ensure the client parameter is (error "Please specify display"))
;; really set because Emacs forgets initialization (list (cons 'client proc))))
;; parameters for X frames at the moment. ;; XXX We need to ensure the client parameter is
(modify-frame-parameters frame (list (cons 'client proc))) ;; really set because Emacs forgets initialization
(select-frame frame) ;; parameters for X frames at the moment.
(server-client-set client 'frame frame) (modify-frame-parameters frame (list (cons 'client proc)))
(server-client-set client 'display (frame-display frame)) (select-frame frame)
(setq dontkill t)) (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. ;; -resume: Resume a suspended tty frame.
((equal "-resume" arg) ((equal "-resume" arg)
...@@ -562,7 +667,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." ...@@ -562,7 +667,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
;; Set up display for the remote locale. ;; Set up display for the remote locale.
(configure-display-for-locale) (configure-display-for-locale)
;; Reply with our pid. ;; 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))) (setq dontkill t)))
;; -position LINE: Go to the given line in the next file. ;; -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\"." ...@@ -598,12 +703,11 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(with-temp-buffer (with-temp-buffer
(let ((standard-output (current-buffer))) (let ((standard-output (current-buffer)))
(pp v) (pp v)
(process-send-string proc "-print ") (server-send-string
(process-send-string proc (format "-print %s\n"
proc (server-quote-arg (server-quote-arg
(buffer-substring-no-properties (point-min) (buffer-substring-no-properties (point-min)
(point-max)))) (point-max)))))))))
(process-send-string proc "\n")))))
(setq lineno 1 (setq lineno 1
columnno 0))) columnno 0)))
...@@ -657,7 +761,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." ...@@ -657,7 +761,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(process-put proc 'previous-string string))) (process-put proc 'previous-string string)))
;; condition-case ;; condition-case
(error (ignore-errors (error (ignore-errors
(process-send-string (server-send-string
proc (concat "-error " (server-quote-arg (error-message-string err)))) proc (concat "-error " (server-quote-arg (error-message-string err))))
(setq string "") (setq string "")
(server-log (error-message-string err) proc) (server-log (error-message-string err) proc)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment