Commit 77134727 authored by Karoly Lorentey's avatar Karoly Lorentey

Added -w option to emacsclient for opening a new X frame.

lib-src/emacsclient.c (window_system): New variable.
(frame): Renamed to tty for consistency with the option name.
(longopts, print_help_and_exit): Added -w option. (Suggested by Ami
Fischman <ami at fischman dot org>.
(decode_options): Initialize display to $DISPLAY.  Handle -w option.
(main): Implement the -w option.  Changed to a more elaborate protocol
between Emacs and emacsclient, in preparation to suspend support.

lisp/server.el (server-frames): New variable.
(server-handle-delete-frame): New function.
(server-start): Add it to delete-frame-functions.
(server-select-display): Don't make the new frame invisible.
(server-with-errors-reported): New macro for brevity.
(server-process-filter): Implement the "-window-system" command.
Use server-with-errors-reported.  Fixed regexp for +line:column syntax.
Use the new protocol.

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-83
parent bfdfad92
......@@ -70,11 +70,14 @@ int nowait = 0;
/* Nonzero means args are expressions to be evaluated. --eval. */
int eval = 0;
/* Nonzero means open a new graphical frame. */
int window_system = 0;
/* The display on which Emacs should work. --display. */
char *display = NULL;
/* Nonzero means open a new Emacs frame on the current terminal. */
int frame = 0;
int tty = 0;
/* If non-NULL, the name of an editor to fallback to if the server
is not running. --alternate-editor. */
......@@ -92,6 +95,7 @@ struct option longopts[] =
{ "help", no_argument, NULL, 'H' },
{ "version", no_argument, NULL, 'V' },
{ "tty", no_argument, NULL, 't' },
{ "window-system", no_argument, NULL, 'w' },
{ "alternate-editor", required_argument, NULL, 'a' },
{ "socket-name", required_argument, NULL, 's' },
{ "display", required_argument, NULL, 'd' },
......@@ -107,11 +111,12 @@ decode_options (argc, argv)
char **argv;
{
alternate_editor = getenv ("ALTERNATE_EDITOR");
display = getenv ("DISPLAY");
while (1)
{
int opt = getopt_long (argc, argv,
"VHnea:s:d:t", longopts, 0);
"VHnea:s:d:tw", longopts, 0);
if (opt == EOF)
break;
......@@ -149,7 +154,13 @@ decode_options (argc, argv)
break;
case 't':
frame = 1;
tty = 1;
window_system = 0;
break;
case 'w':
window_system = 1;
tty = 0;
break;
case 'H':
......@@ -163,11 +174,10 @@ decode_options (argc, argv)
}
}
if (frame) {
if (tty) {
nowait = 0;
display = 0;
}
}
void
......@@ -182,6 +192,7 @@ The following OPTIONS are accepted:\n\
-V, --version Just print a version info and return\n\
-H, --help Print this usage information message\n\
-t, --tty Open a new Emacs frame on the current terminal\n\
-w, --window-system Open a new graphical Emacs frame\n\
-n, --no-wait Don't wait for the server to return\n\
-e, --eval Evaluate the FILE arguments as ELisp expressions\n\
-d, --display=DISPLAY Visit the file in the given display\n\
......@@ -272,16 +283,6 @@ fail (void)
int emacs_pid;
#ifdef nec_ews_svr4
extern char *_sobuf ;
#else
#if defined (USG) || defined (DGUX)
unsigned char _sobuf[BUFSIZ+8];
#else
char _sobuf[BUFSIZ];
#endif
#endif
/* A signal handler that passes the signal to the Emacs process.
Useful for SIGWINCH. */
......@@ -395,7 +396,7 @@ main (argc, argv)
/* Process options. */
decode_options (argc, argv);
if ((argc - optind < 1) && !eval && !frame)
if ((argc - optind < 1) && !eval && !tty && !window_system)
{
fprintf (stderr, "%s: file name or argument required\n", progname);
fprintf (stderr, "Try `%s --help' for more information\n", progname);
......@@ -574,7 +575,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
fprintf (out, " ");
}
if (frame)
if (tty)
{
char *tty_name = ttyname (fileno (stdin));
if (! tty_name)
......@@ -588,6 +589,9 @@ To start the server in Emacs, type \"M-x server-start\".\n",
quote_file_name (getenv("TERM"), out);
fprintf (out, " ");
}
if (window_system)
fprintf (out, "-window-system ");
if ((argc - optind > 0))
{
......@@ -617,7 +621,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
}
else
{
if (!frame)
if (!tty && !window_system)
{
while ((str = fgets (string, BUFSIZ, stdin)))
{
......@@ -636,7 +640,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
return 0;
}
if (!eval && !frame)
if (!eval && !tty)
{
printf ("Waiting for Emacs...");
needlf = 2;
......@@ -646,18 +650,29 @@ To start the server in Emacs, type \"M-x server-start\".\n",
/* Now, wait for an answer and print any messages. */
while ((str = fgets (string, BUFSIZ, in)))
{
if (frame)
if (strprefix ("-emacs-pid ", str))
{
if (strprefix ("emacs-pid ", str))
{
emacs_pid = strtol (string + strlen ("emacs-pid"), NULL, 10);
}
emacs_pid = strtol (string + strlen ("-emacs-pid"), NULL, 10);
}
else if (strprefix ("-print ", str))
{
if (needlf == 2)
printf ("\n");
printf ("%s", str + strlen ("-print "));
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
}
else if (strprefix ("-error ", str))
{
if (needlf == 2)
printf ("\n");
printf ("*ERROR*: %s", str + strlen ("-print "));
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
}
else
{
if (needlf == 2)
printf ("\n");
printf ("%s", str);
printf ("*ERROR*: Unknown message: %s", str);
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
}
}
......
......@@ -111,8 +111,18 @@ When a buffer is marked as \"done\", it is removed from this list.")
Each element is (CLIENTID TTY) where CLIENTID is a string
that can be given to the server process to identify a client.
TTY is the name of the tty device.
When all the buffers of the client are marked as \"done\",
the frame is deleted.")
When all frames on the device are deleted, the server quits the
connection to the client, and vice versa.")
(defvar server-frames nil
"List of current window-system frames used by the server.
Each element is (CLIENTID FRAME) where CLIENTID is a string
that can be given to the server process to identify a client.
FRAME is the frame that was opened by the client.
When the frame is deleted, the server closes the connection to
the client, and vice versa.")
(defvar server-buffer-clients nil
"List of client ids for clients requesting editing of current buffer.")
......@@ -211,7 +221,7 @@ are done with it in the server.")
(server-log (format "Status changed to %s" (process-status proc)) proc))
(defun server-handle-delete-tty (tty)
"Delete the client connection when the emacsclient frame is deleted."
"Delete the client connection when the emacsclient terminal device is closed."
(dolist (entry server-ttys)
(let ((proc (nth 0 entry))
(term (nth 1 entry)))
......@@ -224,6 +234,20 @@ are done with it in the server.")
;; `emacsclient -t -e '(delete-frame)'' correctly.
(setq server-clients (delq client server-clients))))))))
(defun server-handle-delete-frame (frame)
"Delete the client connection when the emacsclient frame is deleted."
(dolist (entry server-frames)
(let ((proc (nth 0 entry))
(f (nth 1 entry)))
(when (equal frame f)
(let ((client (assq proc server-clients)))
(setq server-frames (delq entry server-frames))
(delete-process (car client))
(when (assq proc server-clients)
;; This seems to be necessary to handle
;; `emacsclient -t -e '(delete-frame)'' correctly.
(setq server-clients (delq client server-clients))))))))
(defun server-select-display (display)
;; If the current frame is on `display' we're all set.
(unless (equal (frame-parameter (selected-frame) 'display) display)
......@@ -235,14 +259,14 @@ are done with it in the server.")
;; and select it.
(unless (equal (frame-parameter (selected-frame) 'display) display)
(select-frame
(make-frame-on-display
display
(make-frame-on-display display)))))
;; This frame is only there in place of an actual "current display"
;; setting, so we want it to be as unobtrusive as possible. That's
;; what the invisibility is for. The minibuffer setting is so that
;; we don't end up displaying a buffer in it (which noone would
;; notice).
'((visibility . nil) (minibuffer . only)))))))
;; XXX I have found this behaviour to be surprising and annoying. -- Lorentey
;; '((visibility . nil) (minibuffer . only)))))))
(defun server-unquote-arg (arg)
(replace-regexp-in-string
......@@ -301,6 +325,7 @@ Prefix arg means just kill any existing server communications subprocess."
(server-log (message "Restarting server")))
(letf (((default-file-modes) ?\700))
(add-to-list 'delete-tty-after-functions 'server-handle-delete-tty)
(add-to-list 'delete-frame-functions 'server-handle-delete-frame)
(setq server-process
(make-network-process
:name "server" :family 'local :server t :noquery t
......@@ -324,6 +349,17 @@ Server mode runs a process that accepts commands from the
;; nothing if there is one (for multiple Emacs sessions)?
(server-start (not server-mode)))
(defmacro server-with-errors-reported (&rest forms)
"Evaluate FORMS; if an error occurs, report it to the client
and return nil. Otherwise, return the result of the last form.
For use in server-process-filter only."
`(condition-case err
(progn ,@forms)
(error (ignore-errors
(process-send-string
proc (concat "-error " (error-message-string err)))
(setq request "")))))
(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\"."
......@@ -339,7 +375,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(coding-system (and default-enable-multibyte-characters
(or file-name-coding-system
default-file-name-coding-system)))
client nowait eval newframe
client nowait eval newframe display
registered ; t if the client is already added to server-clients.
(files nil)
(lineno 1)
......@@ -353,37 +389,53 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(cond
((equal "-nowait" arg) (setq nowait t))
((equal "-eval" arg) (setq eval t))
((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
(let ((display (server-unquote-arg (match-string 1 request))))
(setq request (substring request (match-end 0)))
(condition-case err
(server-select-display display)
(error (process-send-string proc (nth 1 err))
(setq request "")))))
;; Open a new frame at the client. ARG is the name of the pseudo tty.
(setq display (match-string 1 request)
request (substring request (match-end 0))))
;; Open a new X frame.
((equal "-window-system" arg)
(server-with-errors-reported
(let ((frame (make-frame-on-display
(or display
(frame-parameter nil 'display)
(getenv "DISPLAY")
(error "Please specify display")))))
(push (list proc frame) server-frames)
(select-frame frame)
;; This makes sure that `emacsclient -w -e '(delete-frame)'' works right.
(push client server-clients)
(setq registered t
newframe t))))
;; Open a new tty frame at the client. ARG is the name of the pseudo tty.
((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request))
(let ((tty (server-unquote-arg (match-string 1 request)))
(type (server-unquote-arg (match-string 2 request))))
(setq request (substring request (match-end 0)))
(condition-case err
(let ((frame (make-frame-on-tty tty type)))
(setq server-ttys (cons (list (car client) (frame-tty-name frame)) server-ttys))
(process-send-string proc (concat "emacs-pid " (number-to-string (emacs-pid)) "\n"))
(select-frame frame)
;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right.
(push client server-clients)
(setq registered t
newframe t))
(error (process-send-string proc (concat (nth 1 err) "\n"))
(setq request "")))))
(server-with-errors-reported
(let ((frame (make-frame-on-tty tty type)))
(push (list (car client) (frame-tty-name frame)) server-ttys)
(process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
(select-frame frame)
;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right.
(push client server-clients)
(setq registered t
newframe t)))))
;; ARG is a line number option.
((string-match "\\`\\+[0-9]+\\'" arg)
(setq lineno (string-to-int (substring arg 1))))
;; ARG is line number:column option.
((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
((string-match "\\`\\+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
(setq lineno (string-to-int (match-string 1 arg))
columnno (string-to-int (match-string 2 arg))))
;; ARG is a filename or a Lisp expression.
(t
;; Undo the quoting that emacsclient does
;; for certain special characters.
(setq arg (server-unquote-arg arg))
......@@ -391,17 +443,14 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(if coding-system
(setq arg (decode-coding-string arg coding-system)))
(if eval
(condition-case err
(let ((v (eval (car (read-from-string arg)))))
(when (and (not newframe) v)
(with-temp-buffer
(let ((standard-output (current-buffer)))
(pp v)
(process-send-region proc (point-min) (point-max))))))
(error
(ignore-errors
(process-send-string
proc (concat "*Error* " (error-message-string err))))))
(server-with-errors-reported
(let ((v (eval (car (read-from-string arg)))))
(when (and (not newframe) v)
(with-temp-buffer
(let ((standard-output (current-buffer)))
(pp v)
(process-send-string proc "-print ")
(process-send-region proc (point-min) (point-max)))))))
;; ARG is a file name.
;; Collapse multiple slashes to single slashes.
......@@ -409,6 +458,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(push (list arg lineno columnno) files))
(setq lineno 1)
(setq columnno 0)))))
(when files
(run-hooks 'pre-command-hook)
(server-visit-files files client nowait)
......@@ -506,15 +556,17 @@ FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
;; If client now has no pending buffers,
;; tell it that it is done, and forget it entirely.
(unless (cdr client)
(let ((tty (assq (car client) server-ttys)))
(if tty
;; Be careful, if we delete the process before the
;; tty, then the terminal modes will not be restored
;; correctly.
(delete-tty (cadr tty))
(delete-process (car client))
(server-log "Close" (car client))
(setq server-clients (delq client server-clients))))))
(let ((tty (cadr (assq (car client) server-ttys)))
(frame (cadr (assq (car client) server-frames))))
(cond
;; Be careful, if we delete the process before the
;; tty, then the terminal modes will not be restored
;; correctly.
(tty (delete-tty tty))
(frame (delete-frame frame))
(t (delete-process (car client))
(server-log "Close" (car client))
(setq server-clients (delq client server-clients)))))))
(setq old-clients (cdr old-clients)))
(if (and (bufferp buffer) (buffer-name buffer))
;; We may or may not kill this buffer;
......
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