diff options
| author | Karoly Lorentey | 2005-02-04 13:56:51 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2005-02-04 13:56:51 +0000 |
| commit | 6afdd33556870059458b19fb9f064f564cf15a4f (patch) | |
| tree | 74d5f0f59c305d48daf76bec4b7a0826521d4962 | |
| parent | e5cdc72372df6f11c73a10c9f3eaec79cba65d61 (diff) | |
| download | emacs-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.c | 17 | ||||
| -rw-r--r-- | lisp/frame.el | 2 | ||||
| -rw-r--r-- | lisp/server.el | 160 |
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. |
| 341 | See `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 -. |
| 352 | Change spaces to underscores, too, so that the return value never | 353 | Change spaces to underscores, too, so that the return value never |
| 353 | contains a space." | 354 | contains a space. |
| 355 | |||
| 356 | See `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. |
| 365 | Creates the directory if necessary and makes sure: | 373 | Creates 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. |
| 446 | PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." | 454 | PROC is the server process. STRING consists of a sequence of |
| 447 | (server-log string proc) | 455 | commands prefixed by a dash. Some commands have arguments; these |
| 456 | are &-quoted and need to be decoded by `server-unquote-arg'. The | ||
| 457 | filter parses and executes these commands. | ||
| 458 | |||
| 459 | To illustrate the protocol, here is an example command that | ||
| 460 | emacsclient sends to create a new X frame (note that the whole | ||
| 461 | sequence 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 | |||
| 470 | The server normally sends back the single command `-good-version' | ||
| 471 | as a response. | ||
| 472 | |||
| 473 | The 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 | |||
| 522 | The 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) |