Commit 0b0d3e0b authored by Karoly Lorentey's avatar Karoly Lorentey

Implemented suspending of emacsclient frames.

lib-src/emacsclient.c (quote_file_name): Renamed to quote_argument.
(unquote_argument, handle_sigcont, handle_sigtstp): New functions.
(out, in): New global variables for communicating with the Emacs process.
(init_signals): Set up handlers for SIGCONT, SIGTSTP and SIGTTOU.
(main): Changed out and in to global variables.  Prepend `-eval' or
'-file' to each argument.  Use fsync to force sending the strings to Emacs.
Removed obsolete -bad-version code.  Support the -suspend command.
Cleaned up newline handling.

lisp/frame.el (suspend-frame): New function.
Substitute key definition of suspend-emacs with suspend-frame.

lisp/server.el (server-log): Cosmetic change in log format.
(server-handle-delete-tty, server-handle-delete-frame): Added logging.
(server-handle-suspend-tty, server-quote-arg): New functions.
(server-start): Install server-handle-suspend-tty.
(server-process-filter): Reorganized source code for clarity.
Implemented -resume, -suspend and -ignore commands.

lisp/term/x-win.el (x-initialize-window-system): Don't change the
binding of C-z.

src/cm.c: Replaced TTY_INPUT, TTY_OUTPUT, TTY_TERMSCRIPT calls with
their macro expansion.
src/dispnew.c: Ditto.
src/frame.c: Ditto.
src/keyboard.c: Ditto.
src/sysdep.c: Ditto.

src/keyboard.c (tty_read_avail_input): Don't read if the terminal is
suspended.
src/sysdep.c (discard_tty_input, init_sys_modes, reset_sys_modes): Ditto.
src/term.c (tty_set_terminal_modes, tty_reset_terminal_modes): Ditto.

src/term.c (Vsuspend_tty_functions, Vresume_tty_functions): New hooks.
(syms_of_term): Defvar them.
(term_init): Don't allow opening a new frame on a suspended tty device.
(Fsuspend_tty, Fresume_tty): New functions.
(syms_of_term): Defsubr them.

src/termchar.c (struct tty_display_info): Update documentation of
input and output.
(TTY_INPUT, TTY_OUTPUT, TTY_TERMSCRIPT): Removed.


git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-105
parent 2fc0cf2a
......@@ -200,22 +200,50 @@ THINGS TO DO
argument-handling is done in Lisp, so this should be quite easy to
implement.
** Very strange bug: visible-bell does not work on secondary
terminals. This might be something xterm (konsole) specific.
** Make `struct display' accessible to Lisp programs. Accessor functions:
** Find out the best way to support suspending Emacs with multiple
ttys. My guess: disable it on the controlling tty, but from other
ttys pass it on to emacsclient somehow. (It is (I hope) trivial to
extend emacsclient to handle suspend/resume. A `kill -STOP' almost
works right now.)
(displayp OBJECT): Returns t if OBJECT is a display.
** Clean up the frame-local variable system. I think it's ugly and
error-prone. But maybe I just haven't yet fully understood it.
(selected-display): Returns the display object of the selected frame.
(frame-display FRAME): Returns the display object of FRAME.
(display-frames DISPLAY): Returns a list of frames on DISPLAY.
(display-type DISPLAY): Returns the type of DISPLAY, as a
symbol. (See `framep'.)
(display-device DISPLAY): Returns the name of the device that
DISPLAY uses, as a string. (E.g: "/dev/pts/16", or
":0.0")
See next issue why this is necessary.
** The following needs to be supported:
$ emacsclient -t
C-z
$ bg
$ emacsclient -t
(This fails now.)
The cleanest way to solve this is to allow multiple displays on the
same terminal device; each new emacsclient process should create
its own display. As displays are currently identified by their
device names, this is not possible until struct display becomes
accessible as a Lisp-level object.
** Add an elaborate mechanism for display-local variables. (There are
already a few of these; search for `terminal-local' in the Elisp
manual.)
** Very strange bug: visible-bell does not work on secondary
terminals in xterm and konsole. The screen does flicker a bit,
but it's so quick it isn't noticable.
** Clean up the frame-local variable system. I think it's ugly and
error-prone. But maybe I just haven't yet fully understood it.
** Move baud_rate to struct display.
** Implement support for starting an interactive Emacs session without
......@@ -667,4 +695,15 @@ DIARY OF CHANGES
complaints seem to be caused by bugs in term.el; they are not
related to multi-tty.)
-- Find out the best way to support suspending Emacs with multiple
ttys. My guess: disable it on the controlling tty, but from other
ttys pass it on to emacsclient somehow. (It is (I hope) trivial to
extend emacsclient to handle suspend/resume. A `kill -STOP' almost
works right now.)
(Done. I needed to play with signal handling and the server
protocol a bit to make emacsclient behave as a normal UNIX program
wrt foreground/background process groups.)
;;; arch-tag: 8da1619e-2e79-41a8-9ac9-a0485daad17d
......@@ -114,7 +114,7 @@ decode_options (argc, argv)
display = getenv ("DISPLAY");
if (display && strlen (display) == 0)
display = NULL;
if (display)
window_system = 1;
else
......@@ -169,7 +169,7 @@ decode_options (argc, argv)
window_system = 0;
tty = 0;
break;
case 'H':
print_help_and_exit ();
break;
......@@ -212,19 +212,21 @@ Report bugs to bug-gnu-emacs@gnu.org.\n", progname);
exit (0);
}
/* In NAME, insert a & before each &, each space, each newline, and
/* In STR, insert a & before each &, each space, each newline, and
any initial -. Change spaces to underscores, too, so that the
return value never contains a space. */
return value never contains a space.
Does not change the string. Outputs the result to STREAM. */
void
quote_file_name (name, stream)
char *name;
quote_argument (str, stream)
char *str;
FILE *stream;
{
char *copy = (char *) malloc (strlen (name) * 2 + 1);
char *copy = (char *) malloc (strlen (str) * 2 + 1);
char *p, *q;
p = name;
p = str;
q = copy;
while (*p)
{
......@@ -242,7 +244,7 @@ quote_file_name (name, stream)
}
else
{
if (*p == '&' || (*p == '-' && p == name))
if (*p == '&' || (*p == '-' && p == str))
*q++ = '&';
*q++ = *p++;
}
......@@ -254,6 +256,41 @@ quote_file_name (name, stream)
free (copy);
}
/* The inverse of quote_argument. Removes quoting in string STR by
modifying the string in place. Returns STR. */
char *
unquote_argument (str)
char *str;
{
char *p, *q;
if (! str)
return str;
p = str;
q = str;
while (*p)
{
if (*p == '&')
{
p++;
if (*p == '&')
*p = '&';
else if (*p == '_')
*p = ' ';
else if (*p == 'n')
*p = '\n';
else if (*p == '-')
*p = '-';
}
*q++ = *p++;
}
*q = 0;
return str;
}
/* Like malloc but get fatal error if memory is exhausted. */
long *
......@@ -288,8 +325,12 @@ fail (void)
}
}
/* The process id of Emacs. */
int emacs_pid;
/* File handles for communicating with Emacs. */
FILE *out, *in;
/* A signal handler that passes the signal to the Emacs process.
Useful for SIGWINCH. */
......@@ -305,8 +346,62 @@ pass_signal_to_emacs (int signalnum)
errno = old_errno;
}
/* Signal handler for SIGCONT; notify the Emacs process that it can
now resume our tty frame. */
SIGTYPE
handle_sigcont (int signalnum)
{
int old_errno = errno;
if (tcgetpgrp (1) == getpgrp ())
{
/* We are in the foreground. */
fprintf (out, "-resume \n");
fflush (out);
fsync (fileno (out));
}
else
{
/* We are in the background; cancel the continue. */
kill (getpid (), SIGSTOP);
}
errno = old_errno;
}
/* Signal handler for SIGTSTP; notify the Emacs process that we are
going to sleep. Normally the suspend is initiated by Emacs via
server-handle-suspend-tty, but if the server gets out of sync with
reality, we may get a SIGTSTP on C-z. Handling this signal and
notifying Emacs about it should get things under control again. */
SIGTYPE
handle_sigtstp (int signalnum)
{
int old_errno = errno;
sigset_t set;
if (out)
{
fprintf (out, "-suspend \n");
fflush (out);
fsync (fileno (out));
}
/* Unblock this signal and call the default handler by temprarily
changing the handler and resignalling. */
sigprocmask (SIG_BLOCK, NULL, &set);
sigdelset (&set, signalnum);
signal (signalnum, SIG_DFL);
kill (getpid (), signalnum);
sigprocmask (SIG_SETMASK, &set, NULL); /* Let's the above signal through. */
signal (signalnum, handle_sigtstp);
errno = old_errno;
}
/* Set up signal handlers before opening a frame on the current tty. */
void
init_signals (void)
{
......@@ -320,6 +415,10 @@ init_signals (void)
signal (SIGINT, pass_signal_to_emacs);
signal (SIGQUIT, pass_signal_to_emacs);
#endif
signal (SIGCONT, handle_sigcont);
signal (SIGTSTP, handle_sigtstp);
signal (SIGTTOU, handle_sigtstp);
}
......@@ -378,7 +477,7 @@ strprefix (char *prefix, char *string)
if (!string)
return 0;
for (i = 0; prefix[i]; i++)
if (!string[i] || string[i] != prefix[i])
return 0;
......@@ -391,7 +490,6 @@ main (argc, argv)
char **argv;
{
int s, i, needlf = 0;
FILE *out, *in;
struct sockaddr_un server;
char *cwd, *str;
char string[BUFSIZ];
......@@ -427,9 +525,9 @@ main (argc, argv)
int sock_status = 0;
int default_sock = !socket_name;
int saved_errno = 0;
char *server_name = "server";
if (socket_name && !index (socket_name, '/') && !index (socket_name, '\\'))
{ /* socket_name is a file name component. */
server_name = socket_name;
......@@ -571,17 +669,14 @@ To start the server in Emacs, type \"M-x server-start\".\n",
/* First of all, send our version number for verification. */
fprintf (out, "-version %s ", VERSION);
if (nowait)
fprintf (out, "-nowait ");
if (eval)
fprintf (out, "-eval ");
if (display)
{
fprintf (out, "-display ");
quote_file_name (display, out);
quote_argument (display, out);
fprintf (out, " ");
}
......@@ -589,7 +684,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
{
char *tty_name = ttyname (fileno (stdin));
char *type = getenv ("TERM");
if (! tty_name)
{
fprintf (stderr, "%s: could not get terminal name\n", progname);
......@@ -610,44 +705,60 @@ To start the server in Emacs, type \"M-x server-start\".\n",
" is not supported\n", progname);
fail ();
}
init_signals ();
fprintf (out, "-tty ");
quote_file_name (tty_name, out);
quote_argument (tty_name, out);
fprintf (out, " ");
quote_file_name (type, out);
quote_argument (type, out);
fprintf (out, " ");
}
if (window_system)
fprintf (out, "-window-system ");
if ((argc - optind > 0))
{
for (i = optind; i < argc; i++)
{
int relative = 0;
if (eval)
; /* Don't prepend any cwd or anything like that. */
else if (*argv[i] == '+')
{
{
/* Don't prepend any cwd or anything like that. */
fprintf (out, "-eval ");
quote_argument (argv[i], out);
fprintf (out, " ");
continue;
}
if (*argv[i] == '+')
{
char *p = argv[i] + 1;
while (isdigit ((unsigned char) *p) || *p == ':') p++;
if (*p != 0)
{
quote_file_name (cwd, out);
fprintf (out, "/");
}
}
else if (*argv[i] != '/')
{
quote_file_name (cwd, out);
fprintf (out, "/");
}
quote_file_name (argv[i], out);
fprintf (out, " ");
}
if (*p == 0)
{
fprintf (out, "-position ");
quote_argument (argv[i], out);
fprintf (out, " ");
continue;
}
else
relative = 1;
}
else if (*argv[i] != '/')
relative = 1;
fprintf (out, "-file ");
if (relative)
{
quote_argument (cwd, out);
fprintf (out, "/");
}
quote_argument (argv[i], out);
fprintf (out, " ");
}
}
else
{
......@@ -655,14 +766,19 @@ To start the server in Emacs, type \"M-x server-start\".\n",
{
while ((str = fgets (string, BUFSIZ, stdin)))
{
quote_file_name (str, out);
if (eval)
fprintf (out, "-eval ");
else
fprintf (out, "-file ");
quote_argument (str, out);
}
fprintf (out, " ");
}
}
fprintf (out, "\n");
fflush (out);
fsync (fileno (out));
/* Maybe wait for an answer. */
if (nowait)
......@@ -676,44 +792,49 @@ To start the server in Emacs, type \"M-x server-start\".\n",
needlf = 2;
}
fflush (stdout);
fsync (1);
/* Now, wait for an answer and print any messages. */
while ((str = fgets (string, BUFSIZ, in)))
{
char *p = str + strlen (str) - 1;
while (p > str && *p == '\n')
*p-- = 0;
if (strprefix ("-good-version ", str))
{
/* OK, we got the green light. */
}
else if (strprefix ("-bad-version ", str))
{
if (str[strlen (str) - 1] == '\n')
str[strlen (str) - 1] = 0;
fprintf (stderr, "%s: Version mismatch: Emacs is %s, but we are %s\n",
argv[0], str + strlen ("-bad-version "), VERSION);
fail ();
}
else if (strprefix ("-emacs-pid ", str))
{
emacs_pid = strtol (string + strlen ("-emacs-pid"), NULL, 10);
}
else if (strprefix ("-print ", str))
{
if (needlf == 2)
str = unquote_argument (str + strlen ("-print "));
if (needlf)
printf ("\n");
printf ("%s", str + strlen ("-print "));
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
printf ("%s", str);
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
}
else if (strprefix ("-error ", str))
{
if (needlf == 2)
str = unquote_argument (str + strlen ("-error "));
if (needlf)
printf ("\n");
printf ("*ERROR*: %s", str);
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
}
else if (strprefix ("-suspend ", str))
{
if (needlf)
printf ("\n");
printf ("*ERROR*: %s", str + strlen ("-print "));
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
needlf = 0;
kill (0, SIGSTOP);
}
else
{
if (needlf == 2)
if (needlf)
printf ("\n");
printf ("*ERROR*: Unknown message: %s", str);
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
......@@ -723,6 +844,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
if (needlf)
printf ("\n");
fflush (stdout);
fsync (1);
return 0;
}
......
......@@ -750,6 +750,22 @@ Otherwise, that variable should be nil."
(iconify-frame)
(make-frame-visible)))
(defun suspend-frame ()
"Do whatever is right to suspend the current frame.
Calls `suspend-emacs' if invoked from the controlling terminal,
`suspend-tty' from a secondary terminal, and
`iconify-or-deiconify-frame' from an X frame."
(interactive)
(let ((type (framep (selected-frame))))
(cond
((eq type 'x) (iconify-or-deiconify-frame))
((eq type t)
(if (frame-tty-name)
(suspend-tty)
(suspend-emacs)))
(t (suspend-emacs)))))
(defun make-frame-names-alist ()
(let* ((current-frame (selected-frame))
(falist
......@@ -1374,6 +1390,8 @@ Use Custom to set this variable to get the display updated."
(define-key ctl-x-5-map "0" 'delete-frame)
(define-key ctl-x-5-map "o" 'other-frame)
(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
(provide 'frame)
;;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56
......
......@@ -186,7 +186,7 @@ are done with it in the server.")
(with-current-buffer "*server*"
(goto-char (point-max))
(insert (current-time-string)
(if client (format " %s:" client) " ")
(if client (format " %s: " client) " ")
string)
(or (bolp) (newline)))))
......@@ -227,6 +227,7 @@ are done with it in the server.")
(term (nth 1 entry)))
(when (equal term tty)
(let ((client (assq proc server-clients)))
(server-log (format "server-handle-delete-tty, tty %s" tty) (car client))
(setq server-ttys (delq entry server-ttys))
(delete-process (car client))
(when (assq proc server-clients)
......@@ -234,6 +235,16 @@ are done with it in the server.")
;; `emacsclient -t -e '(delete-frame)'' correctly.
(setq server-clients (delq client server-clients))))))))
(defun server-handle-suspend-tty (tty)
"Notify the emacsclient process to suspend itself when its tty device is suspended."
(dolist (entry server-ttys)
(let ((proc (nth 0 entry))
(term (nth 1 entry)))
(when (equal term tty)
(let ((process (car (assq proc server-clients))))
(server-log (format "server-handle-suspend-tty, tty %s" tty) process)
(process-send-string process "-suspend \n"))))))
(defun server-handle-delete-frame (frame)
"Delete the client connection when the emacsclient frame is deleted."
(dolist (entry server-frames)
......@@ -241,6 +252,7 @@ are done with it in the server.")
(f (nth 1 entry)))
(when (equal frame f)
(let ((client (assq proc server-clients)))
(server-log (format "server-handle-delete-frame, frame %s" frame) (car client))
(setq server-frames (delq entry server-frames))
(delete-process (car client))
(when (assq proc server-clients)
......@@ -278,6 +290,19 @@ are done with it in the server.")
(t " ")))
arg t t))
(defun server-quote-arg (arg)
"In NAME, insert a & before each &, each space, each newline, and -.
Change spaces to underscores, too, so that the return value never
contains a space."
(replace-regexp-in-string
"[-&\n ]" (lambda (s)
(case (aref s 0)
(?& "&&")
(?- "&-")
(?\n "&n")
(?\s "&_")))
arg t t))
(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:
......@@ -325,6 +350,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 'suspend-tty-functions 'server-handle-suspend-tty)
(add-to-list 'delete-frame-functions 'server-handle-delete-frame)
(setq server-process
(make-network-process
......@@ -358,140 +384,182 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(setq string (concat prev string))
(process-put proc 'previous-string nil)))
(condition-case err
;; If the input is multiple lines,
;; process each line individually.
(while (string-match "\n" string)
(let ((request (substring string 0 (match-beginning 0)))
(coding-system (and default-enable-multibyte-characters
(or file-name-coding-system
default-file-name-coding-system)))
client nowait eval newframe display version-checked
registered ; t if the client is already added to server-clients.
(files nil)
(lineno 1)
(columnno 0))
;; Remove this line from STRING.
(setq string (substring string (match-end 0)))
(setq client (cons proc nil))
(while (string-match "[^ ]* " request)
(let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
(setq request (substring request (match-end 0)))
(cond
;; Check version numbers.
((and (equal "-version" arg) (string-match "\\([0-9.]+\\) " request))
(let* ((client-version (match-string 1 request))
(truncated-emacs-version (substring emacs-version 0 (length client-version))))
(setq request (substring request (match-end 0)))
(if (equal client-version truncated-emacs-version)
(progn
(process-send-string proc "-good-version \n")
(setq version-checked t))
(error (concat "Version mismatch: Emacs is " truncated-emacs-version ", emacsclient is " client-version)))))
((equal "-nowait" arg) (setq nowait t))
((equal "-eval" arg) (setq eval t))
((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
(setq display (match-string 1 request)
request (substring request (match-end 0))))