summaryrefslogtreecommitdiff
path: root/src/process.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/process.c')
-rw-r--r--src/process.c168
1 files changed, 113 insertions, 55 deletions
diff --git a/src/process.c b/src/process.c
index 8b587aaa4e1..08a02ad9423 100644
--- a/src/process.c
+++ b/src/process.c
@@ -261,7 +261,7 @@ static bool process_output_skip;
static void start_process_unwind (Lisp_Object);
static void create_process (Lisp_Object, char **, Lisp_Object);
-#ifdef USABLE_SIGIO
+#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
static bool keyboard_bit_set (fd_set *);
#endif
static void deactivate_process (Lisp_Object);
@@ -1752,7 +1752,7 @@ usage: (make-process &rest ARGS) */)
{
Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
Lisp_Object xstderr, stderrproc;
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
if (nargs == 0)
return Qnil;
@@ -2169,10 +2169,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
p->pty_flag = pty_flag;
pset_status (p, Qrun);
- if (!EQ (p->command, Qt))
+ if (!EQ (p->command, Qt)
+ && !EQ (p->filter, Qt))
add_process_read_fd (inchannel);
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
/* This may signal an error. */
setup_process_coding_systems (process);
@@ -2287,7 +2288,8 @@ create_pty (Lisp_Object process)
pset_status (p, Qrun);
setup_process_coding_systems (process);
- add_process_read_fd (pty_fd);
+ if (!EQ (p->filter, Qt))
+ add_process_read_fd (pty_fd);
pset_tty_name (p, build_string (pty_name));
}
@@ -2338,7 +2340,6 @@ usage: (make-pipe-process &rest ARGS) */)
struct Lisp_Process *p;
Lisp_Object name, buffer;
Lisp_Object tem;
- ptrdiff_t specpdl_count;
int inchannel, outchannel;
if (nargs == 0)
@@ -2349,7 +2350,7 @@ usage: (make-pipe-process &rest ARGS) */)
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
proc = make_process (name);
- specpdl_count = SPECPDL_INDEX ();
+ specpdl_ref specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
@@ -2396,7 +2397,8 @@ usage: (make-pipe-process &rest ARGS) */)
pset_command (p, Qt);
eassert (! p->pty_flag);
- if (!EQ (p->command, Qt))
+ if (!EQ (p->command, Qt)
+ && !EQ (p->filter, Qt))
add_process_read_fd (inchannel);
p->adaptive_read_buffering
= (NILP (Vprocess_adaptive_read_buffering) ? 0
@@ -2468,7 +2470,7 @@ usage: (make-pipe-process &rest ARGS) */)
eassert (p->decoding_carryover == 0);
pset_encoding_buf (p, empty_unibyte_string);
- specpdl_ptr = specpdl + specpdl_count;
+ specpdl_ptr = specpdl_ref_to_ptr (specpdl_count);
return proc;
}
@@ -3076,7 +3078,6 @@ usage: (make-serial-process &rest ARGS) */)
struct Lisp_Process *p;
Lisp_Object name, buffer;
Lisp_Object tem, val;
- ptrdiff_t specpdl_count;
if (nargs == 0)
return Qnil;
@@ -3098,7 +3099,7 @@ usage: (make-serial-process &rest ARGS) */)
name = port;
CHECK_STRING (name);
proc = make_process (name);
- specpdl_count = SPECPDL_INDEX ();
+ specpdl_ref specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
@@ -3131,7 +3132,8 @@ usage: (make-serial-process &rest ARGS) */)
pset_command (p, Qt);
eassert (! p->pty_flag);
- if (!EQ (p->command, Qt))
+ if (!EQ (p->command, Qt)
+ && !EQ (p->filter, Qt))
add_process_read_fd (fd);
update_process_mark (p);
@@ -3175,7 +3177,7 @@ usage: (make-serial-process &rest ARGS) */)
Fserial_process_configure (nargs, args);
- specpdl_ptr = specpdl + specpdl_count;
+ specpdl_ptr = specpdl_ref_to_ptr (specpdl_count);
return proc;
}
@@ -3337,9 +3339,9 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
s = -1;
struct sockaddr *sa = NULL;
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
record_unwind_protect_nothing ();
- ptrdiff_t count1 = SPECPDL_INDEX ();
+ specpdl_ref count1 = SPECPDL_INDEX ();
while (!NILP (addrinfos))
{
@@ -3524,7 +3526,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
#endif /* !WINDOWSNT */
/* Discard the unwind protect closing S. */
- specpdl_ptr = specpdl + count1;
+ specpdl_ptr = specpdl_ref_to_ptr (count1);
emacs_close (s);
s = -1;
if (0 <= socket_to_use)
@@ -3595,7 +3597,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
{
Lisp_Object data = get_file_errno_data (err, contact, xerrno);
- pset_status (p, list2 (Fcar (data), Fcdr (data)));
+ pset_status (p, list2 (Qfailed, data));
unbind_to (count, Qnil);
return;
}
@@ -3617,7 +3619,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
p->outfd = outch;
/* Discard the unwind protect for closing S, if any. */
- specpdl_ptr = specpdl + count1;
+ specpdl_ptr = specpdl_ref_to_ptr (count1);
if (p->is_server && p->socktype != SOCK_DGRAM)
pset_status (p, Qlisten);
@@ -3875,7 +3877,7 @@ usage: (make-network-process &rest ARGS) */)
#ifdef HAVE_GETADDRINFO_A
struct gaicb *dns_request = NULL;
#endif
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
if (nargs == 0)
return Qnil;
@@ -4204,7 +4206,7 @@ usage: (make-network-process &rest ARGS) */)
if (! postpone_connection)
connect_network_socket (proc, addrinfos, use_external_socket_p);
- specpdl_ptr = specpdl + count;
+ specpdl_ptr = specpdl_ref_to_ptr (count);
return proc;
}
@@ -4376,7 +4378,6 @@ network_interface_info (Lisp_Object ifname)
Lisp_Object elt;
int s;
bool any = false;
- ptrdiff_t count;
#if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
&& defined HAVE_GETIFADDRS && defined LLADDR)
struct ifaddrs *ifap;
@@ -4391,7 +4392,7 @@ network_interface_info (Lisp_Object ifname)
s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
- count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, s);
elt = Qnil;
@@ -4640,7 +4641,7 @@ error displays the error message. */)
struct addrinfo hints;
memset (&hints, 0, sizeof hints);
- if (EQ (family, Qnil))
+ if (NILP (family))
hints.ai_family = AF_UNSPEC;
else if (EQ (family, Qipv4))
hints.ai_family = AF_INET;
@@ -4835,7 +4836,6 @@ server_accept_connection (Lisp_Object server, int channel)
int s;
union u_sockaddr saddr;
socklen_t len = sizeof saddr;
- ptrdiff_t count;
s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
@@ -4857,7 +4857,7 @@ server_accept_connection (Lisp_Object server, int channel)
return;
}
- count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, s);
connect_counter++;
@@ -4976,7 +4976,7 @@ server_accept_connection (Lisp_Object server, int channel)
eassert (p->pid == 0);
/* Discard the unwind protect for closing S. */
- specpdl_ptr = specpdl + count;
+ specpdl_ptr = specpdl_ref_to_ptr (count);
p->open_fd[SUBPROCESS_STDIN] = s;
p->infd = s;
@@ -5173,7 +5173,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
bool retry_for_async;
#endif
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
/* Close to the current time if known, an invalid timespec otherwise. */
struct timespec now = invalid_timespec ();
@@ -5586,6 +5586,15 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
timeout = make_timespec (0, 0);
#endif
+#if !defined USABLE_SIGIO && !defined WINDOWSNT
+ /* If we're polling for input, don't get stuck in select for
+ more than 25 msec. */
+ struct timespec short_timeout = make_timespec (0, 25000000);
+ if ((read_kbd || !NILP (wait_for_cell))
+ && timespec_cmp (short_timeout, timeout) < 0)
+ timeout = short_timeout;
+#endif
+
/* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
#if defined HAVE_GLIB && !defined HAVE_NS
nfds = xg_select (max_desc + 1,
@@ -5719,7 +5728,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
-#ifdef USABLE_SIGIO
+#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
/* If we think we have keyboard input waiting, but didn't get SIGIO,
go read it. This can happen with X on BSD after logging out.
In that case, there really is no input and no SIGIO,
@@ -5727,7 +5736,11 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (read_kbd && interrupt_input
&& keyboard_bit_set (&Available) && ! noninteractive)
+#ifdef USABLE_SIGIO
handle_input_available_signal (SIGIO);
+#else
+ handle_input_available_signal (SIGPOLL);
+#endif
#endif
/* If checking input just got us a size-change event from X,
@@ -5979,7 +5992,8 @@ read_process_output_error_handler (Lisp_Object error_val)
cmd_error_internal (error_val, "error in process filter: ");
Vinhibit_quit = Qt;
update_echo_area ();
- Fsleep_for (make_fixnum (2), Qnil);
+ if (process_error_pause_time > 0)
+ Fsleep_for (make_fixnum (process_error_pause_time), Qnil);
return Qt;
}
@@ -6009,7 +6023,7 @@ read_process_output (Lisp_Object proc, int channel)
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = p->decoding_carryover;
ptrdiff_t readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX);
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object odeactivate;
char *chars;
@@ -6225,7 +6239,6 @@ Otherwise it discards the output. */)
{
Lisp_Object old_read_only;
ptrdiff_t old_begv, old_zv;
- ptrdiff_t old_begv_byte, old_zv_byte;
ptrdiff_t before, before_byte;
ptrdiff_t opoint_byte;
struct buffer *b;
@@ -6236,8 +6249,6 @@ Otherwise it discards the output. */)
old_read_only = BVAR (current_buffer, read_only);
old_begv = BEGV;
old_zv = ZV;
- old_begv_byte = BEGV_BYTE;
- old_zv_byte = ZV_BYTE;
bset_read_only (current_buffer, Qnil);
@@ -6285,15 +6296,9 @@ Otherwise it discards the output. */)
opoint_byte += PT_BYTE - before_byte;
}
if (old_begv > before)
- {
- old_begv += PT - before;
- old_begv_byte += PT_BYTE - before_byte;
- }
+ old_begv += PT - before;
if (old_zv >= before)
- {
- old_zv += PT - before;
- old_zv_byte += PT_BYTE - before_byte;
- }
+ old_zv += PT - before;
/* If the restriction isn't what it should be, set it. */
if (old_begv != BEGV || old_zv != ZV)
@@ -6406,7 +6411,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
if (p->raw_status_new)
update_status (p);
if (! EQ (p->status, Qrun))
- error ("Process %s not running", SDATA (p->name));
+ error ("Process %s not running: %s", SDATA (p->name), SDATA (status_message (p)));
if (p->outfd < 0)
error ("Output file descriptor of %s is closed", SDATA (p->name));
@@ -6916,7 +6921,8 @@ the order of the list, until one of them returns non-nil. */)
process, current_group);
}
-DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
+DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2,
+ "(list (read-process-name \"Kill process\"))",
doc: /* Kill process PROCESS. May be process or name of one.
See function `interrupt-process' for more details on usage. */)
(Lisp_Object process, Lisp_Object current_group)
@@ -7019,14 +7025,13 @@ abbr_to_signal (char const *name)
return -1;
}
-DEFUN ("signal-process", Fsignal_process, Ssignal_process,
- 2, 2, "sProcess (name or number): \nnSignal code: ",
- doc: /* Send PROCESS the signal with code SIGCODE.
-PROCESS may also be a number specifying the process id of the
-process to signal; in this case, the process need not be a child of
-this Emacs.
-SIGCODE may be an integer, or a symbol whose name is a signal name. */)
- (Lisp_Object process, Lisp_Object sigcode)
+DEFUN ("internal-default-signal-process",
+ Finternal_default_signal_process,
+ Sinternal_default_signal_process, 2, 3, 0,
+ doc: /* Default function to send PROCESS the signal with code SIGCODE.
+It shall be the last element in list `signal-process-functions'.
+See function `signal-process' for more details on usage. */)
+ (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote)
{
pid_t pid;
int signo;
@@ -7076,6 +7081,23 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */)
return make_fixnum (kill (pid, signo));
}
+DEFUN ("signal-process", Fsignal_process, Ssignal_process,
+ 2, 3, "sProcess (name or number): \nnSignal code: ",
+ doc: /* Send PROCESS the signal with code SIGCODE.
+PROCESS may also be a number specifying the process id of the
+process to signal; in this case, the process need not be a child of
+this Emacs.
+If PROCESS is a process object which contains the property
+`remote-pid', or PROCESS is a number and REMOTE is a remote file name,
+PROCESS is interpreted as process on the respective remote host, which
+will be the process to signal.
+SIGCODE may be an integer, or a symbol whose name is a signal name. */)
+ (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote)
+{
+ return CALLN (Frun_hook_with_args_until_success, Qsignal_process_functions,
+ process, sigcode, remote);
+}
+
DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
doc: /* Make PROCESS see end-of-file in its input.
EOF comes after any text already sent to it.
@@ -7110,7 +7132,7 @@ process has been transmitted to the serial port. */)
if (XPROCESS (proc)->raw_status_new)
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
- error ("Process %s not running", SDATA (XPROCESS (proc)->name));
+ error ("Process %s not running: %s", SDATA (XPROCESS (proc)->name), SDATA (status_message (XPROCESS (proc))));
if (coding && CODING_REQUIRE_FLUSHING (coding))
{
@@ -7409,7 +7431,8 @@ exec_sentinel_error_handler (Lisp_Object error_val)
cmd_error_internal (error_val, "error in process sentinel: ");
Vinhibit_quit = Qt;
update_echo_area ();
- Fsleep_for (make_fixnum (2), Qnil);
+ if (process_error_pause_time > 0)
+ Fsleep_for (make_fixnum (process_error_pause_time), Qnil);
return Qt;
}
@@ -7418,7 +7441,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
{
Lisp_Object sentinel, odeactivate;
struct Lisp_Process *p = XPROCESS (proc);
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
bool outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
@@ -7724,7 +7747,7 @@ delete_gpm_wait_descriptor (int desc)
# endif
-# ifdef USABLE_SIGIO
+#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
/* Return true if *MASK has a bit set
that corresponds to one of the keyboard input descriptors. */
@@ -8171,16 +8194,25 @@ DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
0, 0, 0,
doc: /* Return a list of numerical process IDs of all running processes.
If this functionality is unsupported, return nil.
+If `default-directory' is remote, return process IDs of the respective remote host.
See `process-attributes' for getting attributes of a process given its ID. */)
(void)
{
+ Lisp_Object handler
+ = Ffind_file_name_handler (BVAR (current_buffer, directory),
+ Qlist_system_processes);
+ if (!NILP (handler))
+ return call1 (handler, Qlist_system_processes);
+
return list_system_processes ();
}
DEFUN ("process-attributes", Fprocess_attributes,
Sprocess_attributes, 1, 1, 0,
doc: /* Return attributes of the process given by its PID, a number.
+If `default-directory' is remote, PID is regarded as process
+identifier on the respective remote host.
Value is an alist where each element is a cons cell of the form
@@ -8231,6 +8263,12 @@ integer or floating point values.
args -- command line which invoked the process (string). */)
( Lisp_Object pid)
{
+ Lisp_Object handler
+ = Ffind_file_name_handler (BVAR (current_buffer, directory),
+ Qprocess_attributes);
+ if (!NILP (handler))
+ return call2 (handler, Qprocess_attributes, pid);
+
return system_process_attributes (pid);
}
@@ -8406,6 +8444,8 @@ void
syms_of_process (void)
{
DEFSYM (Qmake_process, "make-process");
+ DEFSYM (Qlist_system_processes, "list-system-processes");
+ DEFSYM (Qprocess_attributes, "process-attributes");
#ifdef subprocesses
@@ -8564,6 +8604,13 @@ These functions are called in the order of the list, until one of them
returns non-nil. */);
Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
+ DEFVAR_LISP ("signal-process-functions", Vsignal_process_functions,
+ doc: /* List of functions to be called for `signal-process'.
+The arguments of the functions are the same as for `signal-process'.
+These functions are called in the order of the list, until one of them
+returns non-nil. */);
+ Vsignal_process_functions = list1 (Qinternal_default_signal_process);
+
DEFVAR_LISP ("internal--daemon-sockname", Vinternal__daemon_sockname,
doc: /* Name of external socket passed to Emacs, or nil if none. */);
Vinternal__daemon_sockname = Qnil;
@@ -8574,10 +8621,20 @@ Enlarge the value only if the subprocess generates very large (megabytes)
amounts of data in one go. */);
read_process_output_max = 4096;
+ DEFVAR_INT ("process-error-pause-time", process_error_pause_time,
+ doc: /* The number of seconds to pause after handling process errors.
+This isn't used for all process-related errors, but is used when a
+sentinel or a process filter function has an error. */);
+ process_error_pause_time = 1;
+
DEFSYM (Qinternal_default_interrupt_process,
"internal-default-interrupt-process");
DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
+ DEFSYM (Qinternal_default_signal_process,
+ "internal-default-signal-process");
+ DEFSYM (Qsignal_process_functions, "signal-process-functions");
+
DEFSYM (Qnull, "null");
DEFSYM (Qpipe_process_p, "pipe-process-p");
@@ -8632,6 +8689,7 @@ amounts of data in one go. */);
defsubr (&Scontinue_process);
defsubr (&Sprocess_running_child_p);
defsubr (&Sprocess_send_eof);
+ defsubr (&Sinternal_default_signal_process);
defsubr (&Ssignal_process);
defsubr (&Swaiting_for_user_input_p);
defsubr (&Sprocess_type);
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-24 13:23:41 +0000