aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaroly Lorentey2005-02-04 13:56:51 +0000
committerKaroly Lorentey2005-02-04 13:56:51 +0000
commit6afdd33556870059458b19fb9f064f564cf15a4f (patch)
tree74d5f0f59c305d48daf76bec4b7a0826521d4962
parente5cdc72372df6f11c73a10c9f3eaec79cba65d61 (diff)
downloademacs-6afdd33556870059458b19fb9f064f564cf15a4f.tar.gz
emacs-6afdd33556870059458b19fb9f064f564cf15a4f.zip
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
-rw-r--r--lib-src/emacsclient.c17
-rw-r--r--lisp/frame.el2
-rw-r--r--lisp/server.el160
3 files changed, 149 insertions, 30 deletions
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 888c85e8685..fbe719772b9 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",
704 } 704 }
705 } 705 }
706 706
707 retry:
707 if (nowait) 708 if (nowait)
708 fprintf (out, "-nowait "); 709 fprintf (out, "-nowait ");
709 710
@@ -832,14 +833,25 @@ To start the server in Emacs, type \"M-x server-start\".\n",
832 833
833 if (strprefix ("-good-version ", str)) 834 if (strprefix ("-good-version ", str))
834 { 835 {
835 /* OK, we got the green light. */ 836 /* -good-version: The versions match. */
836 } 837 }
837 else if (strprefix ("-emacs-pid ", str)) 838 else if (strprefix ("-emacs-pid ", str))
838 { 839 {
840 /* -emacs-pid PID: The process id of the Emacs process. */
839 emacs_pid = strtol (string + strlen ("-emacs-pid"), NULL, 10); 841 emacs_pid = strtol (string + strlen ("-emacs-pid"), NULL, 10);
840 } 842 }
843 else if (strprefix ("-window-system-unsupported ", str))
844 {
845 /* -window-system-unsupported: Emacs was compiled without X
846 support. Try again on the terminal. */
847 window_system = 0;
848 nowait = 0;
849 tty = 1;
850 goto retry;
851 }
841 else if (strprefix ("-print ", str)) 852 else if (strprefix ("-print ", str))
842 { 853 {
854 /* -print STRING: Print STRING on the terminal. */
843 str = unquote_argument (str + strlen ("-print ")); 855 str = unquote_argument (str + strlen ("-print "));
844 if (needlf) 856 if (needlf)
845 printf ("\n"); 857 printf ("\n");
@@ -848,6 +860,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
848 } 860 }
849 else if (strprefix ("-error ", str)) 861 else if (strprefix ("-error ", str))
850 { 862 {
863 /* -error DESCRIPTION: Signal an error on the terminal. */
851 str = unquote_argument (str + strlen ("-error ")); 864 str = unquote_argument (str + strlen ("-error "));
852 if (needlf) 865 if (needlf)
853 printf ("\n"); 866 printf ("\n");
@@ -856,6 +869,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
856 } 869 }
857 else if (strprefix ("-suspend ", str)) 870 else if (strprefix ("-suspend ", str))
858 { 871 {
872 /* -suspend: Suspend this terminal, i.e., stop the process. */
859 if (needlf) 873 if (needlf)
860 printf ("\n"); 874 printf ("\n");
861 needlf = 0; 875 needlf = 0;
@@ -863,6 +877,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
863 } 877 }
864 else 878 else
865 { 879 {
880 /* Unknown command. */
866 if (needlf) 881 if (needlf)
867 printf ("\n"); 882 printf ("\n");
868 printf ("*ERROR*: Unknown message: %s", str); 883 printf ("*ERROR*: Unknown message: %s", str);
diff --git a/lisp/frame.el b/lisp/frame.el
index 3658cfc1879..dabc223fa9a 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -584,7 +584,7 @@ The optional second argument PARAMETERS specifies additional frame parameters."
584 (interactive "sMake frame on display: ") 584 (interactive "sMake frame on display: ")
585 (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display) 585 (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
586 (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) 586 (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
587 (unless x-initialized 587 (when (and (boundp 'x-initialized) (not x-initialized))
588 (setq x-display-name display) 588 (setq x-display-name display)
589 (x-initialize-window-system)) 589 (x-initialize-window-system))
590 (make-frame `((window-system . x) (display . ,display) . ,parameters))) 590 (make-frame `((window-system . x) (display . ,display) . ,parameters)))
diff --git a/lisp/server.el b/lisp/server.el
index baf07a87186..1cb85c9f07f 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -333,11 +333,12 @@ message."
333 (dolist (proc (server-clients-with 'display display)) 333 (dolist (proc (server-clients-with 'display display))
334 (server-log (format "server-handle-suspend-tty, display %s" display) proc) 334 (server-log (format "server-handle-suspend-tty, display %s" display) proc)
335 (condition-case err 335 (condition-case err
336 (process-send-string proc "-suspend \n") 336 (server-send-string proc "-suspend \n")
337 (file-error (condition-case nil (server-delete-client proc) (error nil)))))) 337 (file-error (condition-case nil (server-delete-client proc) (error nil))))))
338 338
339(defun server-unquote-arg (arg) 339(defun server-unquote-arg (arg)
340 "Remove &-quotation from ARG." 340 "Remove &-quotation from ARG.
341See `server-quote-arg' and `server-process-filter'."
341 (replace-regexp-in-string 342 (replace-regexp-in-string
342 "&." (lambda (s) 343 "&." (lambda (s)
343 (case (aref s 1) 344 (case (aref s 1)
@@ -350,7 +351,9 @@ message."
350(defun server-quote-arg (arg) 351(defun server-quote-arg (arg)
351 "In ARG, insert a & before each &, each space, each newline, and -. 352 "In ARG, insert a & before each &, each space, each newline, and -.
352Change spaces to underscores, too, so that the return value never 353Change spaces to underscores, too, so that the return value never
353contains a space." 354contains a space.
355
356See `server-unquote-arg' and `server-process-filter'."
354 (replace-regexp-in-string 357 (replace-regexp-in-string
355 "[-&\n ]" (lambda (s) 358 "[-&\n ]" (lambda (s)
356 (case (aref s 0) 359 (case (aref s 0)
@@ -360,6 +363,11 @@ contains a space."
360 (?\s "&_"))) 363 (?\s "&_")))
361 arg t t)) 364 arg t t))
362 365
366(defun server-send-string (proc string)
367 "A wrapper around `proc-send-string' for logging."
368 (server-log (concat "Sent " string) proc)
369 (process-send-string proc string))
370
363(defun server-ensure-safe-dir (dir) 371(defun server-ensure-safe-dir (dir)
364 "Make sure DIR is a directory with no race-condition issues. 372 "Make sure DIR is a directory with no race-condition issues.
365Creates the directory if necessary and makes sure: 373Creates the directory if necessary and makes sure:
@@ -443,8 +451,99 @@ Server mode runs a process that accepts commands from the
443 451
444(defun server-process-filter (proc string) 452(defun server-process-filter (proc string)
445 "Process a request from the server to edit some files. 453 "Process a request from the server to edit some files.
446PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." 454PROC is the server process. STRING consists of a sequence of
447 (server-log string proc) 455commands prefixed by a dash. Some commands have arguments; these
456are &-quoted and need to be decoded by `server-unquote-arg'. The
457filter parses and executes these commands.
458
459To illustrate the protocol, here is an example command that
460emacsclient sends to create a new X frame (note that the whole
461sequence is sent on a single line):
462
463 -version 21.3.50 xterm
464 -env HOME /home/lorentey
465 -env DISPLAY :0.0
466 ... lots of other -env commands
467 -display :0.0
468 -window-system
469
470The server normally sends back the single command `-good-version'
471as a response.
472
473The following commands are accepted by the server:
474
475`-version CLIENT-VERSION'
476 Check version numbers between server and client, and signal an
477 error if there is a mismatch. The server replies with
478 `-good-version' to confirm the match.
479
480`-env NAME VALUE'
481 An environment variable on the client side.
482
483`-nowait'
484 Request that the next frame created should not be
485 associated with this client.
486
487`-display DISPLAY'
488 Set the display name to open X frames on.
489
490`-position LINE[:COLUMN]'
491 Go to the given line and column number
492 in the next file opened.
493
494`-file FILENAME'
495 Load the given file in the current frame.
496
497`-eval EXPR'
498 Evaluate EXPR as a Lisp expression and return the
499 result in -print commands.
500
501`-window-system'
502 Open a new X frame.
503
504`-tty DEVICENAME TYPE'
505 Open a new tty frame at the client.
506
507`-resume'
508 Resume this tty frame. The client sends this string when it
509 gets the SIGCONT signal and it is the foreground process on its
510 controlling tty.
511
512`-suspend'
513 Suspend this tty frame. The client sends this string in
514 response to SIGTSTP and SIGTTOU. The server must cease all I/O
515 on this tty until it gets a -resume command.
516
517`-ignore COMMENT'
518 Do nothing, but put the comment in the server
519 log. Useful for debugging.
520
521
522The following commands are accepted by the client:
523
524`-good-version'
525 Signals a version match between the client and the server.
526
527`-emacs-pid PID'
528 Describes the process id of the Emacs process;
529 used to forward window change signals to it.
530
531`-window-system-unsupported'
532 Signals that the server does not
533 support creating X frames; the client must try again with a tty
534 frame.
535
536`-print STRING'
537 Print STRING on stdout. Used to send values
538 returned by -eval.
539
540`-error DESCRIPTION'
541 Signal an error (but continue processing).
542
543`-suspend'
544 Suspend this terminal, i.e., stop the client process. Sent
545 when the user presses C-z."
546 (server-log (concat "Received " string) proc)
448 (let ((prev (process-get proc 'previous-string))) 547 (let ((prev (process-get proc 'previous-string)))
449 (when prev 548 (when prev
450 (setq string (concat prev string)) 549 (setq string (concat prev string))
@@ -483,7 +582,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
483 (setq request (substring request (match-end 0))) 582 (setq request (substring request (match-end 0)))
484 (if (equal client-version truncated-emacs-version) 583 (if (equal client-version truncated-emacs-version)
485 (progn 584 (progn
486 (process-send-string proc "-good-version \n") 585 (server-send-string proc "-good-version \n")
487 (server-client-set client 'version client-version)) 586 (server-client-set client 'version client-version))
488 (error (concat "Version mismatch: Emacs is " 587 (error (concat "Version mismatch: Emacs is "
489 truncated-emacs-version 588 truncated-emacs-version
@@ -502,20 +601,26 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
502 ((equal "-window-system" arg) 601 ((equal "-window-system" arg)
503 (unless (server-client-get client 'version) 602 (unless (server-client-get client 'version)
504 (error "Protocol error; make sure to use the correct version of emacsclient")) 603 (error "Protocol error; make sure to use the correct version of emacsclient"))
505 (setq frame (make-frame-on-display 604 (if (fboundp 'x-create-frame)
506 (or display 605 (progn
507 (frame-parameter nil 'display) 606 (setq frame (make-frame-on-display
508 (getenv "DISPLAY") 607 (or display
509 (error "Please specify display")) 608 (frame-parameter nil 'display)
510 (list (cons 'client proc)))) 609 (getenv "DISPLAY")
511 ;; XXX We need to ensure the client parameter is 610 (error "Please specify display"))
512 ;; really set because Emacs forgets initialization 611 (list (cons 'client proc))))
513 ;; parameters for X frames at the moment. 612 ;; XXX We need to ensure the client parameter is
514 (modify-frame-parameters frame (list (cons 'client proc))) 613 ;; really set because Emacs forgets initialization
515 (select-frame frame) 614 ;; parameters for X frames at the moment.
516 (server-client-set client 'frame frame) 615 (modify-frame-parameters frame (list (cons 'client proc)))
517 (server-client-set client 'display (frame-display frame)) 616 (select-frame frame)
518 (setq dontkill t)) 617 (server-client-set client 'frame frame)
618 (server-client-set client 'display (frame-display frame))
619 (setq dontkill t))
620 ;; This emacs does not support X.
621 (server-log "Window system unsupported" proc)
622 (server-send-string proc "-window-system-unsupported \n")
623 (setq dontkill t)))
519 624
520 ;; -resume: Resume a suspended tty frame. 625 ;; -resume: Resume a suspended tty frame.
521 ((equal "-resume" arg) 626 ((equal "-resume" arg)
@@ -562,7 +667,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
562 ;; Set up display for the remote locale. 667 ;; Set up display for the remote locale.
563 (configure-display-for-locale) 668 (configure-display-for-locale)
564 ;; Reply with our pid. 669 ;; Reply with our pid.
565 (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) 670 (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
566 (setq dontkill t))) 671 (setq dontkill t)))
567 672
568 ;; -position LINE: Go to the given line in the next file. 673 ;; -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 (with-temp-buffer 703 (with-temp-buffer
599 (let ((standard-output (current-buffer))) 704 (let ((standard-output (current-buffer)))
600 (pp v) 705 (pp v)
601 (process-send-string proc "-print ") 706 (server-send-string
602 (process-send-string 707 proc (format "-print %s\n"
603 proc (server-quote-arg 708 (server-quote-arg
604 (buffer-substring-no-properties (point-min) 709 (buffer-substring-no-properties (point-min)
605 (point-max)))) 710 (point-max)))))))))
606 (process-send-string proc "\n")))))
607 (setq lineno 1 711 (setq lineno 1
608 columnno 0))) 712 columnno 0)))
609 713
@@ -657,7 +761,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
657 (process-put proc 'previous-string string))) 761 (process-put proc 'previous-string string)))
658 ;; condition-case 762 ;; condition-case
659 (error (ignore-errors 763 (error (ignore-errors
660 (process-send-string 764 (server-send-string
661 proc (concat "-error " (server-quote-arg (error-message-string err)))) 765 proc (concat "-error " (server-quote-arg (error-message-string err))))
662 (setq string "") 766 (setq string "")
663 (server-log (error-message-string err) proc) 767 (server-log (error-message-string err) proc)