/* Asynchronous subprocess control for GNU Emacs.
Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
- 2001, 2002 Free Software Foundation, Inc.
+ 2001, 2002, 2003 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Lisp_Object QClocal, QCremote, QCcoding;
Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
+Lisp_Object QCfilter_multibyte;
Lisp_Object Qlast_nonmenu_event;
/* QCfamily is declared and initialized in xfaces.c,
QCfilter in keyboard.c. */
int
allocate_pty ()
{
- struct stat stb;
register int c, i;
int fd;
- /* Some systems name their pseudoterminals so that there are gaps in
- the usual sequence - for example, on HP9000/S700 systems, there
- are no pseudoterminals with names ending in 'f'. So we wait for
- three failures in a row before deciding that we've reached the
- end of the ptys. */
- int failed_count = 0;
-
#ifdef PTY_ITERATION
PTY_ITERATION
#else
for (i = 0; i < 16; i++)
#endif
{
+ struct stat stb; /* Used in some PTY_OPEN. */
#ifdef PTY_NAME_SPRINTF
PTY_NAME_SPRINTF
#else
#ifdef PTY_OPEN
PTY_OPEN;
#else /* no PTY_OPEN */
-#ifdef IRIS
- /* Unusual IRIS code */
- *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
- if (fd < 0)
- return -1;
- if (fstat (fd, &stb) < 0)
- return -1;
-#else /* not IRIS */
- if (stat (pty_name, &stb) < 0)
- {
- failed_count++;
- if (failed_count >= 3)
- return -1;
+ {
+# ifdef IRIS
+ /* Unusual IRIS code */
+ *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
+ if (fd < 0)
+ return -1;
+ if (fstat (fd, &stb) < 0)
+ return -1;
+# else /* not IRIS */
+ { /* Some systems name their pseudoterminals so that there are gaps in
+ the usual sequence - for example, on HP9000/S700 systems, there
+ are no pseudoterminals with names ending in 'f'. So we wait for
+ three failures in a row before deciding that we've reached the
+ end of the ptys. */
+ int failed_count = 0;
+
+ if (stat (pty_name, &stb) < 0)
+ {
+ failed_count++;
+ if (failed_count >= 3)
+ return -1;
+ }
+ else
+ failed_count = 0;
}
- else
- failed_count = 0;
-#ifdef O_NONBLOCK
- fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
-#else
- fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
-#endif
-#endif /* not IRIS */
+# ifdef O_NONBLOCK
+ fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
+# else
+ fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
+# endif
+# endif /* not IRIS */
+ }
#endif /* no PTY_OPEN */
if (fd >= 0)
if (access (pty_name, 6) != 0)
{
emacs_close (fd);
-#if !defined(IRIS) && !defined(__sgi)
+# if !defined(IRIS) && !defined(__sgi)
continue;
-#else
+# else
return -1;
-#endif /* IRIS */
+# endif /* IRIS */
}
#endif /* not UNIPLUS */
setup_pty (fd);
deactivate_process (proc);
}
+
+/* Setup coding systems of PROCESS. */
+
+void
+setup_process_coding_systems (process)
+ Lisp_Object process;
+{
+ struct Lisp_Process *p = XPROCESS (process);
+ int inch = XINT (p->infd);
+ int outch = XINT (p->outfd);
+
+ if (inch < 0 || outch < 0)
+ return;
+
+ if (!proc_decode_coding_system[inch])
+ proc_decode_coding_system[inch]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (p->decode_coding_system,
+ proc_decode_coding_system[inch]);
+ if (! NILP (p->filter))
+ {
+ if (NILP (p->filter_multibyte))
+ setup_raw_text_coding_system (proc_decode_coding_system[inch]);
+ }
+ else if (BUFFERP (p->buffer))
+ {
+ if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters))
+ setup_raw_text_coding_system (proc_decode_coding_system[inch]);
+ }
+
+ if (!proc_encode_coding_system[outch])
+ proc_encode_coding_system[outch]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (p->encode_coding_system,
+ proc_encode_coding_system[outch]);
+}
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
doc: /* Return t if OBJECT is a process. */)
p->buffer = buffer;
if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCbuffer, buffer);
+ setup_process_coding_systems (process);
return buffer;
}
p->filter = filter;
if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCfilter, filter);
+ setup_process_coding_systems (process);
return filter;
}
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
+ XPROCESS (proc)->filter_multibyte
+ = buffer_defaults.enable_multibyte_characters;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
/* Make the process marker point into the process buffer (if any). */
chan_process[inchannel] = process;
XSETINT (XPROCESS (process)->infd, inchannel);
XSETINT (XPROCESS (process)->outfd, outchannel);
- /* Record the tty descriptor used in the subprocess. */
- if (forkin < 0)
- XPROCESS (process)->subtty = Qnil;
- else
- XSETFASTINT (XPROCESS (process)->subtty, forkin);
+
+ /* Previously we recorded the tty descriptor used in the subprocess.
+ It was only used for getting the foreground tty process, so now
+ we just reopen the device (see emacs_get_tty_pgrp) as this is
+ more portable (see USG_SUBTTY_WORKS above). */
+
XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
XPROCESS (process)->status = Qrun;
- if (!proc_decode_coding_system[inchannel])
- proc_decode_coding_system[inchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (process)->decode_coding_system,
- proc_decode_coding_system[inchannel]);
- if (!proc_encode_coding_system[outchannel])
- proc_encode_coding_system[outchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (process)->encode_coding_system,
- proc_encode_coding_system[outchannel]);
+ setup_process_coding_systems (process);
/* Delay interrupts until we have a chance to store
the new fork's pid in its process structure */
EMACS_SET_SECS_USECS (offset, 1, 0);
timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
- XPROCESS (process)->subtty = Qnil;
if (forkin >= 0)
emacs_close (forkin);
int len;
{
register struct Lisp_Vector *p;
- register unsigned char *cp;
+ register unsigned char *cp = NULL;
register int i;
bzero (sa, len);
:filter FILTER -- Install FILTER as the process filter.
+:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
+process filter are multibyte, otherwise they are unibyte.
+If this keyword is not specified, the strings are multibyte iff
+`default-enable-multibyte-characters' is non-nil.
+
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
:log LOG -- Install LOG as the server process log function. This
p->buffer = buffer;
p->sentinel = sentinel;
p->filter = filter;
+ p->filter_multibyte = buffer_defaults.enable_multibyte_characters;
+ /* Override the above only if :filter-multibyte is specified. */
+ if (! NILP (Fplist_member (contact, QCfilter_multibyte)))
+ p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte);
p->log = Fplist_get (contact, QClog);
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = Qt;
}
p->encode_coding_system = val;
}
-
- if (!proc_decode_coding_system[inch])
- proc_decode_coding_system[inch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (p->decode_coding_system,
- proc_decode_coding_system[inch]);
- if (!proc_encode_coding_system[outch])
- proc_encode_coding_system[outch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (p->encode_coding_system,
- proc_encode_coding_system[outch]);
+ setup_process_coding_systems (proc);
p->decoding_buf = make_uninit_string (0);
p->decoding_carryover = make_number (0);
seconds = -1;
}
else
- {
- if (NILP (process))
- seconds = -1;
- else
- seconds = 0;
- }
+ seconds = NILP (process) ? -1 : 0;
if (NILP (process))
XSETFASTINT (process, 0);
p->decode_coding_system = ps->decode_coding_system;
p->encode_coding_system = ps->encode_coding_system;
-
- if (!proc_decode_coding_system[s])
- proc_decode_coding_system[s]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (p->decode_coding_system,
- proc_decode_coding_system[s]);
- if (!proc_encode_coding_system[s])
- proc_encode_coding_system[s]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (p->encode_coding_system,
- proc_encode_coding_system[s]);
+ setup_process_coding_systems (proc);
p->decoding_buf = make_uninit_string (0);
p->decoding_carryover = make_number (0);
EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
-#ifdef POLLING_PROBLEM_IN_SELECT
+#ifdef POLL_INTERRUPTED_SYS_CALL
/* AlainF 5-Jul-1996
HP-UX 10.10 seem to have problems with signals coming in
Causes "poll: interrupted system call" messages when Emacs is run
and then turn off any other atimers. */
stop_polling ();
turn_on_atimers (0);
-#endif
+#endif /* POLL_INTERRUPTED_SYS_CALL */
while (1)
{
but select says there is input. */
if (XINT (read_kbd) && interrupt_input
- && keyboard_bit_set (&Available))
+ && keyboard_bit_set (&Available) && ! noninteractive)
kill (getpid (), SIGIO);
#endif
clear_input_pending ();
QUIT;
}
-#ifdef hpux
+#ifdef POLL_INTERRUPTED_SYS_CALL
/* AlainF 5-Jul-1996
HP-UX 10.10 seems to have problems with signals coming in
Causes "poll: interrupted system call" messages when Emacs is run
in an X window
Turn periodic alarms back on */
start_polling ();
-#endif
+#endif /* POLL_INTERRUPTED_SYS_CALL */
return got_some_input;
}
text = decode_coding_string (make_unibyte_string (chars, nbytes),
coding, 0);
- if (NILP (buffer_defaults.enable_multibyte_characters))
- /* We had better return unibyte string. */
- text = string_make_unibyte (text);
-
Vlast_coding_system_used = coding->symbol;
/* A new coding system might be found. */
if (!EQ (p->decode_coding_system, coding->symbol))
bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
carryover);
XSETINT (p->decoding_carryover, carryover);
+ /* Adjust the multibyteness of TEXT to that of the filter. */
+ if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text))
+ text = (STRING_MULTIBYTE (text)
+ ? Fstring_as_unibyte (text)
+ : Fstring_to_multibyte (text));
nbytes = SBYTES (text);
nchars = SCHARS (text);
if (nbytes > 0)
!= ! STRING_MULTIBYTE (text))
text = (STRING_MULTIBYTE (text)
? Fstring_as_unibyte (text)
- : Fstring_as_multibyte (text));
+ : Fstring_to_multibyte (text));
nbytes = SBYTES (text);
nchars = SCHARS (text);
/* Insert before markers in case we are inserting where
return Qnil;
}
\f
+/* Return the foreground process group for the tty/pty that
+ the process P uses. */
+static int
+emacs_get_tty_pgrp (p)
+ struct Lisp_Process *p;
+{
+ int gid = -1;
+
+#ifdef TIOCGPGRP
+ if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
+ {
+ int fd;
+ /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
+ master side. Try the slave side. */
+ fd = emacs_open (XSTRING (p->tty_name)->data, O_RDONLY, 0);
+
+ if (fd != -1)
+ {
+ ioctl (fd, TIOCGPGRP, &gid);
+ emacs_close (fd);
+ }
+ }
+#endif /* defined (TIOCGPGRP ) */
+
+ return gid;
+}
+
DEFUN ("process-running-child-p", Fprocess_running_child_p,
Sprocess_running_child_p, 0, 1, 0,
doc: /* Return t if PROCESS has given the terminal to a child.
{
/* Initialize in case ioctl doesn't exist or gives an error,
in a way that will cause returning t. */
- int gid = 0;
+ int gid;
Lisp_Object proc;
struct Lisp_Process *p;
error ("Process %s is not active",
SDATA (p->name));
-#ifdef TIOCGPGRP
- if (!NILP (p->subtty))
- ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
- else
- ioctl (XINT (p->infd), TIOCGPGRP, &gid);
-#endif /* defined (TIOCGPGRP ) */
+ gid = emacs_get_tty_pgrp (p);
if (gid == XFASTINT (p->pid))
return Qnil;
But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
His patch indicates that if TIOCGPGRP returns an error, then
we should just assume that p->pid is also the process group id. */
- {
- int err;
-
- if (!NILP (p->subtty))
- err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
- else
- err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
- if (err == -1)
- /* If we can't get the information, assume
- the shell owns the tty. */
- gid = XFASTINT (p->pid);
- }
+ gid = emacs_get_tty_pgrp (p);
+
+ if (gid == -1)
+ /* If we can't get the information, assume
+ the shell owns the tty. */
+ gid = XFASTINT (p->pid);
/* It is not clear whether anything really can set GID to -1.
Perhaps on some system one of those ioctls can or could do so.
/* gid may be a pid, or minus a pgrp's number */
#ifdef TIOCSIGSEND
if (!NILP (current_group))
- ioctl (XINT (p->infd), TIOCSIGSEND, signo);
+ {
+ if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1)
+ EMACS_KILLPG (gid, signo);
+ }
else
{
gid = - XFASTINT (p->pid);
error ("Input file descriptor of %s closed", SDATA (p->name));
if (XINT (p->outfd) < 0)
error ("Output file descriptor of %s closed", SDATA (p->name));
+ Fcheck_coding_system (decoding);
+ Fcheck_coding_system (encoding);
- p->decode_coding_system = Fcheck_coding_system (decoding);
- p->encode_coding_system = Fcheck_coding_system (encoding);
- setup_coding_system (decoding,
- proc_decode_coding_system[XINT (p->infd)]);
- setup_coding_system (encoding,
- proc_encode_coding_system[XINT (p->outfd)]);
+ p->decode_coding_system = decoding;
+ p->encode_coding_system = encoding;
+ setup_process_coding_systems (proc);
return Qnil;
}
return Fcons (XPROCESS (proc)->decode_coding_system,
XPROCESS (proc)->encode_coding_system);
}
+
+DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
+ Sset_process_filter_multibyte, 2, 2, 0,
+ doc: /* Set multibyteness of the strings given to PROCESS's filter.
+If FLAG is non-nil, the filter is given multibyte strings.
+If FLAG is nil, the filter is given unibyte strings. In this case,
+all character code conversion except for end-of-line conversion is
+suppressed. */)
+ (proc, flag)
+ Lisp_Object proc, flag;
+{
+ register struct Lisp_Process *p;
+
+ CHECK_PROCESS (proc);
+ p = XPROCESS (proc);
+ p->filter_multibyte = flag;
+ setup_process_coding_systems (proc);
+
+ return Qnil;
+}
+
+DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
+ Sprocess_filter_multibyte_p, 1, 1, 0,
+ doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
+ (proc)
+ Lisp_Object proc;
+{
+ register struct Lisp_Process *p;
+
+ CHECK_PROCESS (proc);
+ p = XPROCESS (proc);
+
+ return (NILP (p->filter_multibyte) ? Qnil : Qt);
+}
+
+
\f
/* The first time this is called, assume keyboard input comes from DESC
instead of from where we used to expect it.
staticpro (&QCoptions);
QCplist = intern (":plist");
staticpro (&QCplist);
+ QCfilter_multibyte = intern (":filter-multibyte");
+ staticpro (&QCfilter_multibyte);
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
/* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
+ defsubr (&Sset_process_filter_multibyte);
+ defsubr (&Sprocess_filter_multibyte_p);
}
\f